|
Навигация
|
Главная » Delphi Советы по программированию на DELPHI (ч.5)Источник: articlesorg Михаил Христосенко Как узнать имя пользователя версию 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?varbmp: 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?varicon : 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-битное кодирование/декодированиеconstbase64table='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 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 с timageprocedure 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; Основные принципы выбора прикладного программного обеспечения для построения корпоративной информационной системы (документация). FAQ по Turbo 2006 (FAQ). Расширенная RTTI информация классов. Delphi XE2 к старту готов!. RAD Studio XE2. Главная » Delphi |
© 2024 Team.Furia.Ru.
Частичное копирование материалов разрешено. |