Как узнать имя пользователя версию 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;