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

Источник: articlesorg

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

Получение имени пользователя.

Для этого мы конечно же воспользуемся реестром. Там вообще прячется очень много полезной информации, но надо знать, где она лежит. Итак, чтобы использовать реестр, необходимо добавить модуль registry в uses. Затем надо объявить переменную типа tregistry, а дальше открыть нужный ключ и прочитать оттуда все, что хочется. Например, в событии формы oncreate напишите:

var r:tregistry;
begin
r:=tregistry.create; {создаем экземпляр объекта}
r.rootkey:=hkey_local_machine;
r.openkey('software\microsoft\windows\currentversion', false);
{#сюда потом запишем необходимые операторы}

r.free; {уничтожим объект}
end;

Чтобы прочесть какие-нибудь данные нужно воспользоваться функцией readstring (если вам надо прочесть строку, чтобы прочитать число нужно воспользоваться функцией readinteger...). Допустим вы хотите, чтобы имя пользователя и название организации выводились с помощью метки. Тогда до оператора free (после комментария #), впишите:

label1.caption:='Владелец: '+r.readstring('registeredowner')+#13+
'Организация: '+r.readstring('registeredorganization');

Чтобы получить директорию windows нужно вызвать r.readstring('systemroot');

Обязательно посмотрите этот ключ реестра, там много полезных данных.

Картинку с рабочего стола в canvas.

Чтобы скопировать обои рабочего стола, нам придется воспользоваться функцией paintdesktop. Приведу ее полное объявление:

function paintdesktop(hdc) : boolean;

То есть, чтобы картинку с рабочего стола и нарисовать ее на форме, нужно написать следующий код:

paintdesktop(form1.canvas.handle);

Таким образом ваша форма заполнится рисунком с рабочего стола. Если таковой не установлен, то форма окрасится в тот же цвет, что и цвет рабочего стола.

Как рисовать прямо на экране. (api)

Для того, чтобы нарисовать что-нибудь на экране или на чужом окне, необходимо получить контекст этого устройства с помощью функции api:

function getdc(wnd: hwnd): hdc;

где wnd - указатель на нужное окно, или 0 для получения контекста всего экрана.

А затем рисуйте что душе угодно. Для примера поставьте на форму кнопку и обработчик ее события onclick приведите к виду:

procedure tform1.button1click(sender: tobject);
var screendc: hdc;
begin
screendc := getdc(0); {получить контекст экрана}
rectangle(screendc,10,10,200,200);{рисуем квадрат}
releasedc(0,screendc); {освободить контекст}
end;

Как поменять обои рабочего стола.

Чтобы изменить обои на рабочем столе необходимо сделать изменения в файле настроек win.ini, записав туда путь к нужной bmp-картинке. Реализовать это можно при помощи объекта типа treginifile, чтобы можно было его использовать, надо в uses добавить модули registry и winprocs. Допустим картинка на рабочем столе будет меняться по клику на кнопку. Тогда в обработчике события onclick напишите:

procedure tform1.button1click(sender: tobject);
var
reg : treginifile;
swallpaperbmppath:string;
btile:boolean;
begin
// Изменяем ключи реестра
// hkey_current_user
// control panel\desktop
// tilewallpaper (reg_sz)
// wallpaper (reg_sz)
reg := treginifile.create('control panel\desktop' );
with reg do begin

//путь к картинке, я думаю вам какой-нибудь другой захочется
swallpaperbmppath:='С:\borland\delphi 3\images\backgrnd\writing.bmp';
//По центру рабочего стола
btile:=false;

writestring( '', 'wallpaper', swallpaperbmppath );
if( btile )then begin
writestring('', 'tilewallpaper', '1' );
end
else begin
writestring('', 'tilewallpaper', '0' );
end;
end;
reg.free;
// Оповещаем всех о том, что мы
// изменили системные настройки
systemparametersinfo(spi_setdeskwallpaper, 0, nil, spif_sendwininichange );
end;

Завершение другого приложения.

Для того чтобы закрыть какое-нибудь приложение можно воспользоваться приведенной ниже функцией:

procedure killprogram(classname : pchar; windowtitle : pchar);
const
process_terminate = $0001;
var
processhandle : thandle;
processid: integer;
thewindow : hwnd;
begin
thewindow := findwindow(classname, windowtitle);
getwindowthreadprocessid(thewindow, @processid);
processhandle := openprocess(process_terminate, false, processid);
terminateprocess(processhandle,4);
end;

То есть, чтобы завершить приложение вам необходимо знать либо classname либо заголовок этого окна. Привожу пример использования этой процедуры. Запустите графический редактор paint. Его заголовок в начале такой: "Безымянный - paint", поэтому вызов функции может быть таким:

killprogram(nil,'Безымянный - paint');

Увеличиваем экран.

Нам понадобится одна форма, один image, одна панель, кнопка, таймер и ползунок. Добавляем к форме картинку и панель. Размещаем остальные элементы управления на панели.
Код, наиболее важной части программы:
// переменные
var srect,drect,posforme:trect;
iwidth,iheight,dmx,dmy:integer;
itmpx,itmpy:real;
c:tcanvas;
kursor:tpoint;
// Увеличиваем экран, если приложение не свёрнуто в иконку
if not isiconic(application.handle) then begin
// Получаем координаты курсора
getcursorpos(kursor);
// posform представляет прямоугольник с
// координатами form (image control).
posforme:=rect(form1.left,form1.top,form1.left+form1.width,form1.top+form1.height);
//Показываем magnified screen
//если курсор за пределами формы.
if not ptinrect(posforme,kursor) then begin
// Далее код можно использовать для увеличения выбранной
// части экрана. С небольшими модификациями его можно
// использовать для уменьшения
// экрана
iwidth:=image1.width;
iheight:=image1.height;
drect:=bounds(0,0,iwidth,iheight);
itmpx:=iwidth / (slider.position * 4);
itmpy:=iheight / (slider.position * 4);
srect:=rect(kursor.x,kursor.y,kursor.x,kursor.y);
inflaterect(srect,round(itmpx),round(itmpy));
//Получаем обработчик(handle) окна рабочего стола.
c:=tcanvas.create;
try
c.handle:=getdc(getdesktopwindow);
//Передаём часть изображения окна в timage.
image1.canvas.copyrect(drect,c,srect);
finally
c.free;
end;
end;
// Обязательно обрабатываем все сообщения windows.
application.processmessages;
end; // isiconic

Коды всех виртуальных клавиш

vk_lbutton = $01;
vk_rbutton = $02;
vk_cancel = $03;
vk_mbutton = $04; { генерятся только системой вместе с l & rbutton }
vk_back = $08;
vk_tab = $09;
vk_clear = $0c;
vk_return = $0d;
vk_shift = $10;
vk_control = $11;
vk_menu = $12;
vk_pause = $13;
vk_capital = $14;
vk_escape = $1b;
vk_space = $20;
vk_prior = $21;
vk_next = $22;

vk_end = $23;
vk_home = $24;
vk_left = $25;
vk_up = $26;
vk_right = $27;
vk_down = $28;
vk_select = $29;
vk_print = $2a;
vk_execute = $2b;
vk_snapshot = $2c;
{ vk_copy = $2c не используется клавиатурой }
vk_insert = $2d;
vk_delete = $2e;
vk_help = $2f;
{ vk_a - vk_z такие же, как и их ascii-эквиваленты: 'a' - 'z' }
{ vk_0 - vk_9 такие же, как и их ascii-эквиваленты: '0' - '9' }vk_numpad0 = $60;
vk_numpad1 = $61;
vk_numpad2 = $62;
vk_numpad3 = $63;
vk_numpad4 = $64;
vk_numpad5 = $65;
vk_numpad6 = $66;
vk_numpad7 = $67;
vk_numpad8 = $68;
vk_numpad9 = $69;
vk_multiply = $6a;
vk_add = $6b;
vk_separator = $6c;
vk_subtract = $6d;
vk_decimal = $6e;
vk_divide = $6f;
vk_f1 = $70;
vk_f2 = $71;
vk_f3 = $72;
vk_f4 = $73;
vk_f5 = $74;
vk_f6 = $75;
vk_f7 = $76;
vk_f8 = $77;
vk_f9 = $78;
vk_f10 = $79;
vk_f11 = $7a;
vk_f12 = $7b;
vk_f13 = $7c;
vk_f14 = $7d;
vk_f15 = $7e;
vk_f16 = $7f;
vk_f17 = $80;
vk_f18 = $81;
vk_f19 = $82;
vk_f20 = $83;
vk_f21 = $84;
vk_f22 = $85;
vk_f23 = $86;
vk_f24 = $87;
vk_numlock = $90;
vk_scroll = $91;

Как подсчитать занимаемое директорией место

Возвращаемая размерность - байты.):
var
dirbytes : integer;

function tfilebrowser.dirsize(dir:string):integer;
var
searchrec : tsearchrec;
separator : string;
begin
if copy(dir,length(dir),1)='\' then
separator := ''
else
separator := '\';
if findfirst(dir+separator+'*.*',faanyfile,searchrec) = 0 then begin
if fileexists(dir+separator+searchrec.name) then begin
dirbytes := dirbytes + searchrec.size;
{memo1.lines.add(dir+separator+searchrec.name);}
end else if directoryexists(dir+separator+searchrec.name) then begin
if (searchrec.name<>'.') and (searchrec.name<>'..') then begin
dirsize(dir+separator+searchrec.name);
end;
end;
while findnext(searchrec) = 0 do begin
if fileexists(dir+separator+searchrec.name) then begin
dirbytes := dirbytes + searchrec.size;
{memo1.lines.add(dir+separator+searchrec.name);}
end else if directoryexists(dir+separator+searchrec.name) then
begin
if (searchrec.name<>'.') and (searchrec.name<>'..') then begin
dirsize(dir+separator+searchrec.name);
end;
end;
end;
end;
findclose(searchrec);
end;

Сохранение параметров шрифта в файле.

function fonttostr(font: tfont): string;
procedure yes(var str:string);
begin
str := str + 'y';
end;
procedure no(var str:string);
begin
str := str + 'n';
end;
begin
{кодируем все атрибуты tfont в строку}
result := '';
result := result + inttostr(font.color) + '/';
result := result + inttostr(font.height) + '/';
result := result + font.name + '/';
result := result + inttostr(ord(font.pitch)) + '/';
result := result + inttostr(font.pixelsperinch) + '/';
result := result + inttostr(font.size) + '/';
if fsbold in font.style then yes(result) else no(result);
if fsitalic in font.style then yes(result) else no(result);
if fsunderline in font.style then yes(result) else no(result);
if fsstrikeout in font.style then yes(result) else no(result);
end;

procedure strtofont(str: string; font: tfont);
begin
if str = '' then exit;
font.color := strtoint(tok('/', str));
font.height := strtoint(tok('/', str));
font.name := tok('/', str);
font.pitch := tfontpitch(strtoint(tok('/', str)));
font.pixelsperinch := strtoint(tok('/', str));
font.size := strtoint(tok('/', str));
font.style := [];
if str[0] = 'y' then font.style := font.style + [fsbold];
if str[1] = 'y' then font.style := font.style + [fsitalic];
if str[2] = 'y' then font.style := font.style + [fsunderline];
if str[3] = 'y' then font.style := font.style + [fsstrikeout];
end;

function tok(sep: string; var s: string): string;
function isoneof(c, s: string): boolean;
var
itmp: integer;
begin
result := false;
for itmp := 1 to length(s) do
begin
if c = copy(s, itmp, 1) then
begin
result := true;
exit;
end;
end;
end;
var
c, t: string;
begin
if s = '' then
begin
result := s;
exit;
end;
c := copy(s, 1, 1);
while isoneof(c, sep) do
begin
s := copy(s, 2, length(s) - 1);
c := copy(s, 1, 1);
end;
t := '';
while (not isoneof(c, sep)) and (s <> '') do
begin
t := t + c;
s := copy(s, 2, length(s)-1);
c := copy(s, 1, 1);
end;
result := t;
end;

Листер плагин на Borland Delphi 7 для начинающих.

Вопросы и ответы по сертификации Delphi.

Популярность Delphi продолжает расти.

Программируем в Delphi.

RadPHP XE2.

Главная » Delphi