Поради з програмування на DELPHI (ч.5), Різне, Програмування, статті

Як дізнатися ім’я користувача версію windows і т.д.


В uses пpопісиваешь модуль registry і далі так:
var
r:tregistry;
no:string;
begin
r:=tregistry.create;
r.rootkey:=hkey_local_machine;
r.openkey (“softwaremicrosoftwindowscurrentversion”, 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 (32×32) в 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 pcifiledefaulticon
reg.openkey(prefix+”filedefaulticon”,true);
//and create a value where the icon is stored –> c:project1.exe,0 reg.writestring(“”,exepfad+”,0″);
reg.closekey;
reg.openkey(prefix+”fileshellopencommand”,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;


Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*