(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Советы по программированию на DELPHI (ч.5)

Михаил Христосенко

Как узнать имя пользователя версию windows и т.д.

В uses пpописываешь модуль registry и дальше так:
var
r:tregistry;
no:string;
begin
r:=tregistry.create;
r.rootkey:=hkey_local_machine;
r.openkey('\software\microsoft\windows\currentversion', false) {если false то пытается откpыть не создавая}
no:=r.readstring('versionnumber');
if no=..... then ...... else ......
end;
Кроме того, обязательно посмотрите на список функций winapi, имена которых начинаются с get.... Например, getcomputername, getversionex, getsysteminfo, systemparametersinfo.

Как скопировать экран в tcanvas?

var
bmp: tbitmap;
dc: hdc;
begin
bmp:=tbitmap.create;
bmp.height:=screen.height;
bmp.width:=screen.width;
dc:=getdc(0); //Дескpиптоp экpана
bitblt(bmp.canvas.handle, 0, 0, screen.width, screen.height,
dc, 0, 0, srccopy);
bmp.savetofile('screen.bmp');
releasedc(0, dc);
end;

Как извлечь иконку из exe или dll

Процесс получения иконок из .exe, .dll или .ico файлов полностью идентичен.
Различие только в том, что в .ico файле может храниться только одна иконка, а в
.exe и .dll несколько. Для получения иконок из файлов, в модуле shellapi, есть
функция:
function extracticon(inst: thandle; filename: pchar; iconindex: word): hicon;
где
inst - указатель на приложение вызвавшее функцию, filename - имя файла
из которого необходимо получить иконку, iconindex - номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть следующая иконка.
В данном примере в компонент image1 выводится иконка запущенного файла.
uses shellapi;
procedure tform1.formcreate(sender: tobject);
var a: array [0..78] of char;
begin

{Получение имени запущенного файла}
strpcopy(a, paramstr(0));
{Вывод на экран нулевой иконки из файла}
image1.picture.icon.handle := extracticon(hinstance, a, 0);
end;

Как преобразовать ico в bmp?

var
icon : ticon;
bitmap : tbitmap;
begin
icon := ticon.create;
bitmap := tbitmap.create;
icon.loadfromfile('c:\picture.ico');
bitmap.width := icon.width;
bitmap.height := icon.height;
bitmap.canvas.draw(0, 0, icon );
bitmap.savetofile('c:\picture.bmp');
icon.free;
bitmap.free;
end;

Как преобразовать bmp (32x32) в ico?

unit main;

interface

uses
windows, messages, sysutils, classes, graphics, controls,
forms,dialogs,extctrls, stdctrls;

type
tform1 = class(tform)
button1: tbutton;
image1: timage;
image2: timage;
procedure button1click(sender: tobject);
procedure formcreate(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;

var
form1: tform1;

implementation

{$r *.dfm}

procedure tform1.button1click(sender: tobject);
var windc, srcdc, destdc : hdc;
oldbitmap : hbitmap;
iinfo : ticoninfo;
begin
geticoninfo(image1.picture.icon.handle, iinfo);

windc := getdc(handle);
srcdc := createcompatibledc(windc);
destdc := createcompatibledc(windc);
oldbitmap := selectobject(destdc, iinfo.hbmcolor);
oldbitmap := selectobject(srcdc, iinfo.hbmmask);

bitblt(destdc, 0, 0, image1.picture.icon.width,
image1.picture.icon.height,
srcdc, 0, 0, srcpaint);
image2.picture.bitmap.handle := selectobject(destdc, oldbitmap);
deletedc(destdc);
deletedc(srcdc);
deletedc(windc);

image2.picture.bitmap.savetofile(extractfilepath(application.exename)
+ 'myfile.bmp');
end;

procedure tform1.formcreate(sender: tobject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.

Реестр. Свое расширение

//use the registry to register your own filetype. uses registry;

procedure tform1.registerfiletype(prefix:string; exepfad:string);
var reg:tregistry;
begin
reg:=tregistry.create;
reg.rootkey:=hkey_classes_root;
//create a new key --> .pci
reg.openkey('.'+prefix,true);
//create a new value for this key --> pcifile
reg.writestring('',prefix+'file');
reg.closekey; //create a new key --> pcifile
reg.createkey(prefix+'file');
//create a new key pcifile\defaulticon
reg.openkey(prefix+'file\defaulticon',true);
//and create a value where the icon is stored --> c:\project1.exe,0 reg.writestring('',exepfad+',0');
reg.closekey;
reg.openkey(prefix+'file\shell\open\command',true);
//create value where exefile is stored --> c:\project1.exe "%1"
reg.writestring('',exepfad+' "%1"'); reg.closekey;
reg.free;
end;
procedure tform1.button1click(sender: tobject);
begin
registerfiletype('pci','c:\project1.exe');
end;

64-битное кодирование/декодирование

const
base64table='abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz0123456789+/';

function base64decode(cstr:string):string;
var resstr:string;
decstr:string;
recodeline : array [1..76] of byte;
f1,f2 : word;
l:integer;
begin
l :=length(cstr);
resstr:='';
for f1:=1 to l do
if cstr[f1]='=' then recodeline[f1]:=0
else recodeline[f1]:=pos(cstr[f1],base64table)-1;
f1:=1;
while f1<length(cstr) do
begin
decstr:=chr(byte(recodeline[f1] shl 2)+recodeline[f1+1] shr 4)+
chr(byte(recodeline[f1+1] shl 4)+recodeline[f1+2] shr 2)+
chr(byte(recodeline[f1+2] shl 6)+recodeline[f1+3]);
resstr:=resstr+decstr;
inc(f1,4);
end;
base64decode:=resstr;
end;

Как программным путем включить num lock?

procedure tmyform.button1click(sender: tobject);
var
keystate : tkeyboardstate;
begin
getkeyboardstate(keystate);
if (keystate[vk_numlock] = 0) then
keystate[vk_numlock] := 1
else
keystate[vk_numlock] := 0;
setkeyboardstate(keystate);
end;
Для caps lock замените vk_numlock на vk_capital.

drag & drop с timage

procedure tform1.panel1dragdrop(sender, source: tobject; x, y: integer);
begin
with source as timage do
begin
left := x;
top := y;
end;
end;
procedure tform1.panel1dragover(sender, source: tobject; x, y: integer;
state: tdragstate; var accept: boolean);
begin
accept := source is timage;
end;
procedure tform1.formcreate(sender: tobject);
begin
with timage.create(self) do
begin
parent := panel1;
autosize := true;
picture.loadfromfile('...');
dragmode := dmautomatic;
ondragover := panel1dragover;
ondragdrop := panel1dragdrop;
end;
end

Быстрое копирование файлов

procedure copyfile( source, dest : string );
var
srcfile : integer;
destfile : integer;
s : string;
retcode : longint;
openfilebuf : tofstruct;
fname : array[ 0..255 ] of char;
begin
strpcopy( fname, source );
srcfile := lzopenfile( fname, openfilebuf, of_read );
strpcopy( fname, dest );
destfile := lzopenfile( fname, openfilebuf, of_create );

retcode := lzcopy( srcfile, destfile );
if retcode >= 0 then
begin
lzclose( srcfile );
lzclose( destfile );
end
else
begin
str( retcode, s );
messagedlg( 'Не могу скопировать ' + source + ' в ' +
dest + #13 + 'Код ошибки = ' + s, mterror, [mbok], 0 );
end;
end;



 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 10.02.2007 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Oracle Database Standard Edition 2 Named User Plus License
TeeBI for RAD Studio Suite with source code single license
TeeChart Pro VCL/FMX with source code single license
ZBrush 4R6 Win Commercial Single License ESD
Stimulsoft Reports Server Team 10 users
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
СУБД Oracle "с нуля"
eManual - электронные книги и техническая документация
Мир OLAP и Business Intelligence: новости, статьи, обзоры
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100