|
Навигация
|
Главная » Delphi Советы по программированию на DELPHI (ч.4)Источник: articlesorg Михаил Христосенко Изменение шрифта у всплывающих подсказокunit unit1;interface uses sysutils, wintypes, winprocs, messages, classes, graphics, controls, forms, dialogs, stdctrls; type tform1 = class(tform) edit1: tedit; procedure formcreate(sender: tobject); private { private declarations } public { public declarations } end; var form1: tform1; implementation {$r *.dfm} type tmyhintwindow = class (thintwindow) constructor create (aowner: tcomponent); override; end; constructor tmyhintwindow.create (aowner: tcomponent); begin inherited create (aowner); canvas.font.name := 'times new roman'; canvas.font.size := 14; end; procedure tform1.formcreate(sender: tobject); begin application.showhint := false; hintwindowclass := tmyhintwindow; application.showhint := true; end; end. Как проверить готовность диска a:\function diskindrive(const drive: char): boolean;var drvnum: byte; emode: word; begin result := true; // было false drvnum := ord(drive); if drvnum >= ord('a') then dec(drvnum,$20); emode := seterrormode(sem_failcriticalerrors); try while disksize(drvnum-$40) = -1 do begin // при неудаче выводим диалог if (application.messagebox('Диск не готов...'+chr(13)+chr(10)+ 'Повторить?',pchar('Диск '+uppercase(drive)),mb_okcancel+ mb_iconexclamation{iconquestion})=idcancel) then begin result:=false; break; end; end; finally seterrormode(emode); end; end; Перекодировка текстаprocedure wintodos;var src, str:pchar;//src-строка для перевода str-конечная begin src := memo1.lines.gettext; //Берем текст из tmemo как тип pchar chartooem(src, str); //api функция для перевода текста memo2.lines.text := strpas(str);//Записываем назад end; procedure dostowin; var src, str:pchar; begin src := memo1.lines.gettext; //Берем текст из tmemo как тип pchar oemtochar(src, str); //api функция для перевода текста memo2.lines.text := strpas(str);//Записываем назад end; Открытие и закрытие привода cd-romunit drivetools;interface uses windows, sysutils, mmsystem; function closecd(drive : char) : boolean; function opencd(drive : char) : boolean; implementation function opencd(drive : char) : boolean; var res mcierror; openparm: tmci_open_parms; flags : dword; s : string; deviceid : word; begin result:=false; s:=drive+':'; flags:=mci_open_type or mci_open_element; with openparm do begin dwcallback := 0; lpstrdevicetype := 'cdaudio'; lpstrelementname := pchar(s); end; res := mcisendcommand(0, mci_open, flags, longint(@openparm)); if res<>0 then exit; deviceid:=openparm.wdeviceid; try res:=mcisendcommand(deviceid, mci_set, mci_set_door_open, 0); if res=0 then exit; result:=true; finally mcisendcommand(deviceid, mci_close, flags, longint(@openparm)); end; end; function closecd(drive : char) : boolean; var res : mcierror; openparm: tmci_open_parms; flags : dword; s : string; deviceid : word; begin result:=false; s:=drive+':'; flags:=mci_open_type or mci_open_element; with openparm do begin dwcallback := 0; lpstrdevicetype := 'cdaudio'; lpstrelementname := pchar(s); end; res := mcisendcommand(0, mci_open, flags, longint(@openparm)); if res<>0 then exit; deviceid:=openparm.wdeviceid; try res:=mcisendcommand(deviceid, mci_set, mci_set_door_closed, 0); if res=0 then exit; result:=true; finally mcisendcommand(deviceid, mci_close, flags, longint(@openparm)); end; end; end. Как подавить реакцию на ctrl+alt+del?В некоторых случаях (например, при работе в полноэкранном режиме, показе своей презентации или экранной заставки ...) бывает полезно заблокировать перечисленные комбинации клавиш. Они блокируются при работе системы в режиме "экранная заставка" , который в свою очередь несложно включить и выключить:// Включение режима systemparametersinfo(spi_screensaverrunning, 1, 0, 0); // Выключение режима systemparametersinfo(spi_screensaverrunning, 0, 0, 0); Кстати, systemparametersinfo имеет еще кучу полезных ключей spi_****, подробности см. в win32.hlp Как изменить изображение на кнопке ПУСК?{ объявляем глобальные переменные }var form1: tform1; startbutton: hwnd; oldbitmap: thandle; newimage: tpicture; { добавляем следующий код в событие формы oncreate } procedure tform1.formcreate(sender: tobject); begin newimage := tpicture.create; newimage.loadfromfile('c:\windows\circles.bmp'); startbutton := findwindowex (findwindow('shell_traywnd',nil),0,'button', nil); oldbitmap := sendmessage(startbutton, bm_setimage, 0, newimage.bitmap.handle); end; { Событие ondestroy } procedure tform1.formdestroy(sender: tobject); begin sendmessage(startbutton,bm_setimage,0,oldbitmap); newimage.free; end; Как изменить обои на рабочем столе?program wallpapr;uses registry, winprocs; procedure setwallpaper(swallpaperbmppath:string;btile:boolean); var reg : treginifile; begin // Изменяем ключи реестра // hkey_current_user // control panel\desktop // tilewallpaper (reg_sz) // wallpaper (reg_sz) reg := treginifile.create('control panel\desktop' ); with reg do begin 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; // пример установки wallpaper по центру рабочего стола setwallpaper('c:\winnt\winnt.bmp', false ); //Эту строчку надо написать где-то в программе. Путеводитель по сертификации разработчиков. Разработка DLL в среде Borland Delphi. Oracle: Работа с датами в Oracle. Delphi: Как писать Win32API приложения на Delphi. Новые версии XE2 RAD Studio, Delphi и C++Builder компании Embarcadero ломают стереотипы разработки бизнес-приложений. Главная » Delphi |
© 2024 Team.Furia.Ru.
Частичное копирование материалов разрешено. |