WinAPIFAQ

источник информации:

DELPHI WinAPI FAQ Перевод с английского

Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
специально для Королевства Дельфи.

Скачать (27 K) для просмотра в off-line.

Вопрос:
Как программно выключить монитор?

Ответ:
Программно можно отключить монитор совместимый со стандартом EnergyStar.

Отправьте сообщение wm_SysCommand с параметром WParam = SC_MonitorPower и LParam = 0 для отключения монитора LParam = 1 для включения монитора
В приведенном примере монитор отключается на 10 секунд.

Пример: type TForm1 = class(TForm) Button1: TButton; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public MonitorOff : bool; { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Enabled := false; Timer1.Interval := 10000; MonitorOff := false; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if MonitorOff then begin MonitorOff := false; SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, -1); Timer1.Enabled := false; end; end; procedure TForm1.Button1Click(Sender: TObject); begin MonitorOff := true; Timer1.Enabled := true; SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0); end; Вопрос:

Как создать мигающий заголовок окна (пиктограмму)?
Ответ:
Можно воспользоваться функцией API FlashWindow():

Пример:
var Flash : bool; procedure TForm1.Timer1Timer(Sender: TObject); begin FlashWindow(Form1.Handle, Flash); FlashWindow(Application.Handle, Flash); Flash := not Flash; end; procedure TForm1.FormCreate(Sender: TObject); begin Flash := False; end; Вопрос:

Иногда всплывающее меню моего приложения system tray не исчезает когда оно теряет фокус. Как закрыть его?
Ответ:
При показе всплывающего меню установите foreground window, затем пошлите сообщение WM_NULL после показа меню. procedure TForm1.WndProc(var Msg : TMessage); var p : TPoint; begin case Msg.Msg of WM_USER + 1: case Msg.lParam of WM_RBUTTONDOWN: begin SetForegroundWindow(Handle); GetCursorPos(p); PopupMenu1.Popup(p.x, p.y); PostMessage(Handle, WM_NULL, 0, 0); end; end; end; inherited; end; Вопрос:

Как узнать текущие время и дату по Гринвичу
Ответ:
Используя API фукцию GetSystemTime.

Пример:
procedure TForm1.Button1Click(Sender: TObject); var lt : TSYSTEMTIME; st : TSYSTEMTIME; begin GetLocalTime(lt); GetSystemTime(st); Memo1.Lines.Add('LocalTime = ' + IntToStr(lt.wmonth) + '/' + IntToStr(lt.wDay) + '/' + IntToStr(lt.wYear) + ' ' + IntToStr(lt.wHour) + ':' + IntToStr(lt.wMinute) + ':' + IntToStr(lt.wSecond)); Memo1.Lines.Add('UTCTime = ' + IntToStr(st.wmonth) + '/' + IntToStr(st.wDay) + '/' + IntToStr(st.wYear) + ' ' + IntToStr(st.wHour) + ':' + IntToStr(st.wMinute) + ':' + IntToStr(st.wSecond)); end; Вопрос:

Какой самый быстрый способ для очистки canvasа?
Ответ:
Windows API функция PatBlt().
Пример:
procedure TForm1.Button1Click(Sender: TObject); begin PatBlt(Form1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS); end; Вопрос:
При изменении размеров формы мне необходимо чтобы перерисовывалась вся ее поверхность. Но свойство Canvas.ClipRect у формы - только для чтения.
Ответ:
На событии Resize вызовите Windows API функцию InvalidateRect(). Если передать nil в качестве второго параметра приведет к тому, что перерисовываться будет вся клиентская область окна. Третий параметр указывает будет ли перерисовываться фон формы.
Пример:
procedure TForm1.FormResize(Sender: TObject); begin InvalidateRect(Form1.Handle, nil, false); end; Вопрос:
Как использовать процедуру mouse_event() для имитации событий мыши?
Ответ:
Приведенный пример демонстрирует использование API функции mouse_event() для имитации событий мыши. При нажатии кнопки Button2 программа перемещает курсор мыши на кнопку Button1 и щелкает по ней. Положение курсора мыши задается в "абсолютных" координатах ("Mickeys"), где 65535 "Mickeys" равно ширине экрана. procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage('Button 1 clicked'); end; procedure TForm1.Button2Click(Sender: TObject); var Pt : TPoint; begin {Позволим кнопке Button2 перерисоваться} Application.ProcessMessages; {Найдем координаты центра button 1} Pt.x := Button1.Left + (Button1.Width div 2); Pt.y := Button1.Top + (Button1.Height div 2); {Преобразуем Pt к координатам экрана} Pt := ClientToScreen(Pt); {Преобразуем Pt к "mickeys" (аболютным координатам курсора мышки} Pt.x := Round(Pt.x * (65535 / Screen.Width)); Pt.y := Round(Pt.y * (65535 / Screen.Height)); {Переместим курсор мыши} Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.x, Pt.y, 0, 0); {Имитируем нажатие левой кнопки мыши} Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, Pt.x, Pt.y, 0, 0);; {Имитируем отпускание левой кнопки мыши} Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, Pt.x, Pt.y, 0, 0);; end; Вопрос:
Как программно закрыть другое приложение?
Ответ:
Отправьте этому приложению сообщение WM_QUIT
Пример:
PostMessage(FindWindow(Nil, 'Заголовок окна'), WM_QUIT, 0, 0); Где "Заголовок окна" - заголовок окна, которому Вы посылаете сообщение. Вопрос:
Форматирование диска в Win32
Ответ:
ShellAPI функция ShFormatDrive().
Пример:
const SHFMT_DRV_A = 0; const SHFMT_DRV_B = 1; const SHFMT_ID_DEFAULT = $FFFF; const SHFMT_OPT_QUICKFORMAT = 0; const SHFMT_OPT_FULLFORMAT = 1; const SHFMT_OPT_SYSONLY = 2; const SHFMT_ERROR = -1; const SHFMT_CANCEL = -2; const SHFMT_NOFORMAT = -3; function SHFormatDrive(hWnd : HWND; Drive : Word; fmtID : Word; Options : Word) : Longint stdcall; external 'Shell32.dll' name 'SHFormatDrive'; procedure TForm1.Button1Click(Sender: TObject); var FmtRes : longint; begin try FmtRes:= ShFormatDrive(Handle, SHFMT_DRV_A, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); case FmtRes of SHFMT_ERROR : ShowMessage('Error formatting the drive'); SHFMT_CANCEL : ShowMessage('User canceled formatting the drive'); SHFMT_NOFORMAT : ShowMessage('No Format') else ShowMessage('Disk has been formatted'); end; except end; end; Вопрос:
Как спрятать и отключить кнопку "Пуск"?
Ответ:
Приведенный пример прячет и показывает кнопку "Пуск", а также разрешает и запрещает ее.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var Rgn : hRgn; begin {Cпрятать кнопку "Пуск"} Rgn := CreateRectRgn(0, 0, 0, 0); SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), Rgn, true); end; procedure TForm1.Button2Click(Sender: TObject); begin {Показать кнопку "Пуск"} SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), 0, true); end; procedure TForm1.Button3Click(Sender: TObject); begin {Запретить кнопку "Пуск"} EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), false); end; procedure TForm1.Button4Click(Sender: TObject); begin {Разрешить кнопку "Пуск"} EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), true); end Вопрос:
Как временно отключить перерисовку окна?
Ответ:
Вызовите функцию WinAPI LockWindowUpdate передав ей дескриптор окна, которое необходимо не обновлять. Передайте ноль в качестве параметра для восстановления нормального обновления. LockWindowUpdate(Memo1.Handle); . . LockWindowUpdate(0); Вопрос:
Моя программа использует дравер принтера. Возможно ли потихоньку установить драйвер принтера без вмешательства пользователя?
Ответ:
Приведенный пример устанавливает драйвер принтера. Вам необходимо скопировать файлы с драйвером принтера в каталог Windows\System и внести необходимые изменения в файл Win.Ini. Примечание: DriverName = Имя драйвера; DRVFILE - имя файла с драйвером без расширения (".drv" - по умолчанию).
Пример:
procedure TForm1.Button1Click(Sender: TObject); var s : array[0..64] of char; begin WriteProfileString('PrinterPorts', 'DriverName', 'DRVFILE,FILE:,15,45'); WriteProfileString('Devices', 'DriverName', 'DRVFILE,FILE:'); StrCopy(S, 'PrinterPorts'); SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); StrCopy(S, 'Devices'); SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); end; Вопрос:
Как набрать номер с помощью модема в Win32?
Ответ:
Используйте функцию Windows API CreateFile() чтобы получить дескриптор порта, и стандартные функции ввода-вывода для связи с полученным портом.
Пример:
var hCommFile : THandle; procedure TForm1.Button1Click(Sender: TObject); var PhoneNumber : string; CommPort : string; NumberWritten : LongInt; begin PhoneNumber := 'ATDT 1-555-555-1212' + #13 + #10; CommPort := 'COM2'; {Open the comm port} hCommFile := CreateFile(PChar(CommPort), GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCommFile=INVALID_HANDLE_VALUE then begin ShowMessage('Unable to open '+ CommPort); exit; end; {Dial the phone} NumberWritten:=0; if WriteFile(hCommFile, PChar(PhoneNumber)^, Length(PhoneNumber), NumberWritten, nil) = false then begin ShowMessage('Unable to write to ' + CommPort); end; end; procedure TForm1.Button2Click(Sender: TObject); begin {Close the port} CloseHandle(hCommFile); end; Вопрос:
Как использовать TAPI для голосового звонка?
Ответ:
См пример.
Пример:
{tapi Errors} const TAPIERR_CONNECTED = 0; const TAPIERR_DROPPED = -1; const TAPIERR_NOREQUESTRECIPIENT = -2; const TAPIERR_REQUESTQUEUEFULL = -3; const TAPIERR_INVALDESTADDRESS = -4; const TAPIERR_INVALWINDOWHANDLE = -5; const TAPIERR_INVALDEVICECLASS = -6; const TAPIERR_INVALDEVICEID = -7; const TAPIERR_DEVICECLASSUNAVAIL = -8; const TAPIERR_DEVICEIDUNAVAIL = -9; const TAPIERR_DEVICEINUSE = -10; const TAPIERR_DESTBUSY = -11; const TAPIERR_DESTNOANSWER = -12; const TAPIERR_DESTUNAVAIL = -13; const TAPIERR_UNKNOWNWINHANDLE = -14; const TAPIERR_UNKNOWNREQUESTID = -15; const TAPIERR_REQUESTFAILED = -16; const TAPIERR_REQUESTCANCELLED = -17; const TAPIERR_INVALPOINTER = -18; {tapi size constants} const TAPIMAXDESTADDRESSSIZE = 80; const TAPIMAXAPPNAMESIZE = 40; const TAPIMAXCALLEDPARTYSIZE = 40; const TAPIMAXCOMMENTSIZE = 80; const TAPIMAXDEVICECLASSSIZE = 40; const TAPIMAXDEVICEIDSIZE = 40; function tapiRequestMakeCallA(DestAddress : PAnsiChar; AppName : PAnsiChar; CalledParty : PAnsiChar; Comment : PAnsiChar) : LongInt; stdcall; external 'TAPI32.DLL'; function tapiRequestMakeCallW(DestAddress : PWideChar; AppName : PWideChar; CalledParty : PWideChar; Comment : PWideChar) : LongInt; stdcall; external 'TAPI32.DLL'; function tapiRequestMakeCall(DestAddress : PChar; AppName : PChar; CalledParty : PChar; Comment : PChar) : LongInt; stdcall; external 'TAPI32.DLL'; procedure TForm1.Button1Click(Sender: TObject); var DestAddress : string; CalledParty : string; Comment : string; begin DestAddress := '1-555-555-1212'; CalledParty := 'Frank Borland'; Comment := 'Calling Frank'; tapiRequestMakeCall(pChar(DestAddress), PChar(Application.Title), pChar(CalledParty), PChar(Comment)); end; end. Вопрос:
Как показать иконку, ассоциированной с данным типом файла?
Ответ:
ShellApi функция ExtractAssociatedIcon()
Пример:
uses ShellApi; procedure TForm1.Button1Click(Sender: TObject); var Icon : hIcon; IconIndex : word; begin IconIndex := 1; Icon := ExtractAssociatedIcon(HInstance, Application.ExeName, IconIndex); DrawIcon(Canvas.Handle, 10, 10, Icon); end; Вопрос:
Как определение нажатия определенной клавиши во время загрузки приложения?
Ответ:
Используйту WinAPI функцию GetKeyState() для определения нажатия клавиши в тексте проекта. Для того чтобы увидеть текст файла проекта в главном меню Delphi 3 выберите "View">>"ProjectSource" в Delphi 4 "Project">>"View Source".
Пример:
program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.RES} begin if GetKeyState(vk_F8) < 1 then MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok); Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. Вопрос:
Как заставить пикнуть динамик несколько раз с небольшой задержкой между сигналами, не зависящей от тактовой частоты процессора?
Ответ:
См. пример.
Пример:
procedure Delay(ms : longint); {$IFNDEF WIN32} var TheTime : LongInt; {$ENDIF} begin {$IFDEF WIN32} Sleep(ms); {$ELSE} TheTime := GetTickCount + ms; while GetTickCount < TheTime do Application.ProcessMessages; {$ENDIF} end; procedure TForm1.Button1Click(Sender: TObject); begin MessageBeep(word(-1)); Delay(200); MessageBeep(word(-1)); Delay(200); MessageBeep(word(-1)); end; Вопрос:
Можно ли отключить кнопку закрытия любого окна?
Ответ:
Да, приведенный пример отключает кнопку закрытия и пункт "закрыть" ситсемного меню заданного окна. procedure TForm1.Button1Click(Sender: TObject); var hwndHandle : THANDLE; hMenuHandle : HMENU; begin hwndHandle := FindWindow(nil, 'Untitled - Notepad'); if (hwndHandle <> 0) then begin hMenuHandle := GetSystemMenu(hwndHandle, FALSE); if (hMenuHandle <> 0) then DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND); end; end; Вопрос:
Как узнать путь к каталогам Windows?
Ответ:
Следующий пример получает полный список каталогов по умолчанию (Favorites, Desktop, Programs, Fonts, SendTo, Start, Menu, Templates, Startup, Recent and NetHood) Windows и заносит его в Memo.
Пример:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg : TRegistry; ts : TStrings; i : integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_CURRENT_USER; reg.LazyWrite := false; reg.OpenKey( 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', false); ts := TStringList.Create; reg.GetValueNames(ts); for i := 0 to ts.Count -1 do begin Memo1.Lines.Add(ts.Strings[i] + ' = ' + reg.ReadString(ts.Strings[i])); end; ts.Free; reg.CloseKey; reg.free; end; Вопрос:
Как узнать полный путь и имя файла загруженной DLL?
Ответ:
См. пример
Пример:
uses Windows; procedure ShowDllPath stdcall; var TheFileName : array[0..MAX_PATH] of char; begin FillChar(TheFileName, sizeof(TheFileName), #0); GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName)); MessageBox(0, TheFileName, 'The DLL file name is:', mb_ok); end; Вопрос:
Как вызвать диалог 'Найти файлы и паки' проводника?
Ответ:
Приведенный пример показывает использование DDE для вызова диалога 'Найти файлы и паки' Explorerа. Диалог открывается на каталоге "C:\Download". procedure TForm1.Button1Click(Sender: TObject); begin with TDDEClientConv.Create(Self) do begin ConnectMode := ddeManual; ServiceApplication := 'explorer.exe'; SetLink( 'Folders', 'AppProperties'); OpenLink; ExecuteMacro('[FindFolder(, C:\DOWNLOAD)]', False); CloseLink; Free; end; end; Вопрос:
Как сделать родительское окно с фоновым рисунком в клиентской области?
Ответ:
Для того чтобы сделать это выполните следующие шаги: Срздайте новый проект. Установите FormStyle формы в fsMDIForm Разместите Image на форме и загрузите в него картинку. Найдите { Private Declarations } в обьявлении формы и добаьте следующие строки: FClientInstance : TFarProc; FPrevClientProc : TFarProc; procedure ClientWndProc(var Message: TMessage); Добаьте следующие строки в разделе implementation: procedure TMainForm.ClientWndProc(var Message: TMessage); var Dc : hDC; Row : Integer; Col : Integer; begin with Message do case Msg of WM_ERASEBKGND: begin Dc := TWMEraseBkGnd(Message).Dc; for Row := 0 to ClientHeight div Image1.Picture.Height do for Col := 0 to ClientWidth div Image1.Picture.Width do BitBlt(Dc, Col * Image1.Picture.Width, Row * Image1.Picture.Height, Image1.Picture.Width, Image1.Picture.Height, Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); Result := 1; end; else Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam); end; end; В методе формы OnCreate добавьте: FClientInstance := MakeObjectInstance(ClientWndProc); FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC)); SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance)); Добавьте к проекту новую форму и установите ее свойство FormStyle в fsMDIChild. У Вас получился MDI-проект с "обоями" в клиентской области MDI формы. Вопрос:
Как глобально перехватить нажатие кнопки PrintScreen?
Ответ:
В примере для глобального перехвата нажатия клавиши printscreen регистрируется горячая клавиша (hot key).
Пример:
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const id_SnapShot = 101; procedure TForm1.WMHotKey (var Msg : TWMHotKey); begin if Msg.HotKey = id_SnapShot then ShowMessage('GotIt'); end; procedure TForm1.FormCreate(Sender: TObject); begin RegisterHotKey(Form1.Handle, id_SnapShot, 0, VK_SNAPSHOT); end; procedure TForm1.FormDestroy(Sender: TObject); begin UnRegisterHotKey (Form1.Handle, id_SnapShot); end; Вопрос:
Существует ли способ для определение числа заданий spoolerа печати?
Ответ:
Spoolerа печати Windows посылает WM_SPOOLERSTATUS каждый раз при добавлении и удалении заданий в очереди печати. В следующем примере показано как перехватить это сообщение
Пример:
type TForm1 = class(TForm) Label1: TLabel; private { Private declarations } procedure WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS); message WM_SPOOLERSTATUS; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS); begin Lable1.Caption := IntToStr(msg.JobsLeft) + ' Jobs currenly in spooler'; msg.Result := 0; end; Вопрос:
Как определить имена установленых Com-портов?
Ответ:
Из реестра. См. пример.
Пример:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg : TRegistry; ts : TStrings; i : integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('hardware\devicemap\serialcomm', false); ts := TStringList.Create; reg.GetValueNames(ts); for i := 0 to ts.Count -1 do begin Memo1.Lines.Add(reg.ReadString(ts.Strings[i])); end; ts.Free; reg.CloseKey; reg.free; end; Вопрос:
Извлечение пиктограммы из exe, dll или ico-файла
Ответ:
Функция SHELLAPI ExtractIconEx:
Обратите внимание - в примере функции обьявленны иначе, чем в модуле ShellAPI type ThIconArray = array[0..0] of hIcon; type PhIconArray = ^ThIconArray; function ExtractIconExA(lpszFile: PAnsiChar; nIconIndex: Integer; phiconLarge : PhIconArray; phiconSmall: PhIconArray; nIcons: UINT): UINT; stdcall; external 'shell32.dll' name 'ExtractIconExA'; function ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer; phiconLarge: PhIconArray; phiconSmall: PhIconArray; nIcons: UINT): UINT; stdcall; external 'shell32.dll' name 'ExtractIconExW'; function ExtractIconEx(lpszFile: PAnsiChar; nIconIndex: Integer; phiconLarge : PhIconArray; phiconSmall: PhIconArray; nIcons: UINT): UINT; stdcall; external 'shell32.dll' name 'ExtractIconExA'; procedure TForm1.Button1Click(Sender: TObject); var NumIcons : integer; pTheLargeIcons : phIconArray; pTheSmallIcons : phIconArray; LargeIconWidth : integer; SmallIconWidth : integer; SmallIconHeight : integer; i : integer; TheIcon : TIcon; TheBitmap : TBitmap; begin NumIcons := ExtractIconEx('C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe', -1, nil, nil, 0); if NumIcons > 0 then begin LargeIconWidth := GetSystemMetrics(SM_CXICON); SmallIconWidth := GetSystemMetrics(SM_CXSMICON); SmallIconHeight := GetSystemMetrics(SM_CYSMICON); GetMem(pTheLargeIcons, NumIcons * sizeof(hIcon)); GetMem(pTheSmallIcons, NumIcons * sizeof(hIcon)); FillChar(pTheLargeIcons^, NumIcons * sizeof(hIcon), #0); FillChar(pTheSmallIcons^, NumIcons * sizeof(hIcon), #0); ExtractIconEx('C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe', 0, pTheLargeIcons, pTheSmallIcons, numIcons); {$IFOPT R+} {$DEFINE CKRANGE} {$R-} {$ENDIF} for i := 0 to (NumIcons - 1) do begin DrawIcon(Form1.Canvas.Handle, i * LargeIconWidth, 0, pTheLargeIcons^[i]); TheIcon := TIcon. Create; TheBitmap := TBitmap.Create; TheIcon.Handle := pTheSmallIcons^[i]; TheBitmap.Width := TheIcon.Width; TheBitmap.Height := TheIcon.Height; TheBitmap.Canvas.Draw(0, 0, TheIcon); TheIcon.Free; Form1.Canvas.StretchDraw(Rect(i * SmallIconWidth, 100, (i + 1) * SmallIconWidth, 100 + SmallIconHeight), TheBitmap); TheBitmap.Free; end; {$IFDEF CKRANGE} {$UNDEF CKRANGE} {$R+} {$ENDIF} FreeMem(pTheLargeIcons, NumIcons * sizeof(hIcon)); FreeMem(pTheSmallIcons, NumIcons * sizeof(hIcon)); end; end; end. Вопрос:
как заставить Рабочий Стола Windows обновится?
Ответ:
См. пример.
Пример:
procedure TForm1.Button1Click(Sender: TObject); begin SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0); end; Вопрос:
Перерисовка canvasf моей формы занимает довольно много времени. Как определить установлен ли у пользователя режим перерисовки всего окна при перемещении чтобы временно отключить перерисовку моего окна?
Ответ:
В приведенном примере определяется включен ли режим "Full Window Drag" (перерисовки всего окна при перемещении)
Пример:
procedure TForm1.Button1Click(Sender: TObject); var b : bool; begin SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @b, 0); if not b then ShowMessage('Full Window Drag is not enabled') else ShowMessage('Full Window Drag is enabled'); end; Вопрос:
Как уступить выделенный моей программе квант процессорного времени другим приложениям?
Ответ:
Вызовите функцию Windows API Sleep() передав ноль в качестве параметра.
Вопрос:
Как запускать мою программу на каждом старте Windows?
Ответ:
Пример работает и для Win32и для Win16. uses Registry, {For Win32} IniFiles; {For Win16} {$IFNDEF WIN32} const MAX_PATH = 144; {$ENDIF} {For Win32} procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', false); reg.WriteString('My App', Application.ExeName); reg.CloseKey; reg.free; end; {For Win16} procedure TForm1.Button2Click(Sender: TObject); var WinIni : TIniFile; WinIniFileName : array[0..MAX_PATH] of char; s : string; begin GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName)); StrCat(WinIniFileName, '\win.ini'); WinIni := TIniFile.Create(WinIniFileName); s := WinIni.ReadString('windows', 'run', ''); if s = '' then s := Application.ExeName else s := s + ';' + Application.ExeName; WinIni.WriteString('windows', 'run', s); WinIni.Free; end; Вопрос:
Как увеличить процессорное время, выделяемого программе?
Ответ:
Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать с осторожностью - т.к. присвоение слишком высокого приоритета может привети к медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority() function.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var ProcessID : DWORD; ProcessHandle : THandle; ThreadHandle : THandle; begin ProcessID := GetCurrentProcessID; ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, false, ProcessID); SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS); ThreadHandle := GetCurrentThread; SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL); end; Вопрос:
Я хочу определить момент окончания изменения размера или перемещения окна. Перехватываю сообщения WM_SIZE и WM_MOVE но я получаю много таких сообщений а мне нужно узнать когда именно пользователь закончил перенос или изменение размеров окна. Возможно ли это?
Ответ:
В следующем примере показан перехват сообщения WM_EXITSIZEMOVE Хотя сообщение документированно только для Windows NT оно работает точно так же и под Windows 95. Обратите внимание что Вы можите перехватить сообщение WM_ENTERSIZEMOVEдля определения момента начала пользователем операции изменения размера или перемещения окна.
Пример:
type TForm1 = class(TForm) private { Private declarations } public procedure WMEXITSIZEMOVE(var Message: TMessage); message WM_EXITSIZEMOVE; { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMEXITSIZEMOVE(var Message: TMessage); begin Form1.Caption := 'Finished Moving and sizing'; end; Вопрос:
Как определить время последнего доступа к файлу?
Ответ:
См пример. Примечание: не все файловые системы поддерживают время последнего доступа к файлу.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var SearchRec : TSearchRec; Success : integer; DT : TFileTime; ST : TSystemTime; begin Success := SysUtils.FindFirst('C:\autoexec.bat', faAnyFile, SearchRec); if (Success = 0) and (( SearchRec.FindData.ftLastAccessTime.dwLowDateTime <> 0) or ( SearchRec.FindData.ftLastAccessTime.dwHighDateTime <> 0)) then begin FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime,DT); FileTimeToSystemTime(DT,ST); Memo1.Lines.Clear; Memo1.Lines.Add('AutoExec.Bat was last accessed at:'); Memo1.Lines.Add('Year := ' + IntToStr(st.wYear)); Memo1.Lines.Add('Month := ' + IntToStr(st.wMonth)); Memo1.Lines.Add('DayOfWeek := ' + IntToStr(st.wDayOfWeek)); Memo1.Lines.Add('Day := ' + IntToStr(st.wDay)); Memo1.Lines.Add('Hour := ' + IntToStr(st.wHour)); Memo1.Lines.Add('Minute := ' + IntToStr(st.wMinute)); Memo1.Lines.Add('Second := ' + IntToStr(st.wSecond)); Memo1.Lines.Add('Milliseconds := ' + IntToStr(st.wMilliseconds)); end; SysUtils.FindClose(SearchRec); end; Вопрос:
Как использовать функцию Shell API SHBrowseForFolder чтобы позволить пользователю выбрать каталог?
Ответ:
См. пример
Пример:
uses ShellAPI, ShlObj; procedure TForm1.Button1Click(Sender: TObject); var TitleName : string; lpItemID : PItemIDList; BrowseInfo : TBrowseInfo; DisplayName : array[0..MAX_PATH] of char; TempPath : array[0..MAX_PATH] of char; begin FillChar(BrowseInfo, sizeof(TBrowseInfo), #0); BrowseInfo.hwndOwner := Form1.Handle; BrowseInfo.pszDisplayName := @DisplayName; TitleName := 'Please specify a directory'; BrowseInfo.lpszTitle := PChar(TitleName); BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); ShowMessage(TempPath); GlobalFreePtr(lpItemID); end; end; Вопрос:
Как получить дескриптора окна Window, сожержащего DOS программу или программу консольного режима?
Ответ:
В следуещем примере используется функция Windows API FindWindow(). Обратите внимание, что WndClass консольного окна отличаются для Windows 95 и Window NT и заголовок окна может содержать полный путь под Windows NT.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var info : TOSVersionInfo; ClassName : string; Title : string; begin {Проверяем - Win95 или NT.} info.dwOSVersionInfoSize := sizeof(info); GetVersionEx(info); if (info.dwPlatformId = VER_PLATFORM_WIN32_NT) then begin ClassName := 'ConsoleWindowClass'; Title := 'Command Prompt'; end else begin ClassName := 'tty'; Title := 'MS-DOS Prompt'; end; ShowMessage(IntToStr(FindWindow(PChar(ClassName), PChar(Title)))); end; Вопрос:
Возможно ли определить факта изменения системного времени другим приложением?
Ответ:
Следующий прмер перехватывает событие WM_TIMECHANGE. примечание: Приложение , изменяющее системное время должно посылать сообщение WM_TIMECHANGE всем окнам. type TForm1 = class(TForm) private { Private declarations } procedure WMTIMECHANGE(var Message: TWMTIMECHANGE); message WM_TIMECHANGE; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE); begin Form1.Caption := 'Time Changed'; end; Вопрос:
Как очистить пункт документы меню кнопки Пуск
Ответ:
Вызовите Windows API функцию SHAddToRecentDocs() передав nil вместо имени файла в качестве параметра.
Пример:
uses ShlOBJ; procedure TForm1.Button1Click(Sender: TObject); begin SHAddToRecentDocs(SHARD_PATH, nil); end; Вопрос:
Как опеределить состояние модема под Win32?
Ответ:
См. пример
Пример:
procedure TForm1.Button1Click(Sender: TObject); var CommPort : string; hCommFile : THandle; ModemStat : DWord; begin CommPort := 'COM2'; {Open the comm port} hCommFile := CreateFile(PChar(CommPort), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCommFile = INVALID_HANDLE_VALUE then begin ShowMessage('Unable to open '+ CommPort); exit; end; {Get the Modem Status} if GetCommModemStatus(hCommFile, ModemStat) <> false then begin if ModemStat and MS_CTS_ON <> 0 then ShowMessage('The CTS (clear-to-send) is on.'); if ModemStat and MS_DSR_ON <> 0 then ShowMessage('The DSR (data-set-ready) is on.'); if ModemStat and MS_RING_ON <> 0then ShowMessage('The ring indicator is on.'); if ModemStat and MS_RLSD_ON <> 0 then ShowMessage('The RLSD (receive-line-signal-detect) is on.'); end; {Close the comm port} CloseHandle(hCommFile); end; Вопрос:
Как добавить пункт к системному меню приложения?
Пример:
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const SC_MyMenuItem = WM_USER + 1; procedure TForm1.FormCreate(Sender: TObject); begin AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, ''); AppendMenu(GetSystemMenu(Handle, FALSE), MF_STRING, SC_MyMenuItem, 'My Menu Item'); end; procedure TForm1.WMSysCommand(var Msg: TWMSysCommand); begin if Msg.CmdType = SC_MyMenuItem then ShowMessage('Got the message') else inherited; end; Вопрос:
Как создание нестандартную процедуру разбиения слов при переносах для TEdit, TMemo или TRichEdit?
Ответ:
В следующем примере создается процедура разбиения слов при переносах для TMemo. Заметьте, что реализованная процедура просто всегда разрешает перенос. Для дополнительной информации см.таже документацию к сообщению EM_SETWORDBREAKPROC. var OriginalWordBreakProc : pointer; NewWordBreakProc : pointer; function MyWordBreakProc(LPTSTR : pchar; ichCurrent : integer; cch : integer; code : integer) : integer {$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF} begin result := 0; end; procedure TForm1.FormCreate(Sender: TObject); begin OriginalWordBreakProc := Pointer( SendMessage(Memo1.Handle, EM_GETWORDBREAKPROC, 0, 0)); {$IFDEF WIN32} NewWordBreakProc := @MyWordBreakProc; {$ELSE} NewWordBreakProc := MakeProcInstance(@MyWordBreakProc, hInstance); {$ENDIF} SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0, longint(NewWordBreakProc)); end; procedure TForm1.FormDestroy(Sender: TObject); begin SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0, longint(@OriginalWordBreakProc)); {$IFNDEF WIN32} FreeProcInstance(NewWordBreakProc); {$ENDIF} end; Вопрос:
Можно ли скопировать группу файлов, используя стандартный диалог с анимацией Копирование Файлов, который использует "Проводник" (Explorer)?
Ответ:
В следующем примере используется функция SHFileOperation для копирования группы файлов и показа анимированного диалога. Вы можете использовать также следующие флаги для копирования, удаления, переноса и переименования файлов. TO_COPY FO_DELETE FO_MOVE FO_RENAME Примечание: буфер, содержащий имена файлов для копирования должен заканчиваться двумя нулевыми символами.
Пример:
uses ShellAPI; procedure TForm1.Button1Click(Sender: TObject); var Fo : TSHFileOpStruct; buffer : array[0..4096] of char; p : pchar; begin FillChar(Buffer, sizeof(Buffer), #0); p := @buffer; p := StrECopy(p, 'C:\DownLoad\1.ZIP') + 1; p := StrECopy(p, 'C:\DownLoad\2.ZIP') + 1; p := StrECopy(p, 'C:\DownLoad\3.ZIP') + 1; StrECopy(p, 'C:\DownLoad\4.ZIP'); FillChar(Fo, sizeof(Fo), #0); Fo.Wnd := Handle; Fo.wFunc := FO_COPY; Fo.pFrom := @Buffer; Fo.pTo := 'D:\'; Fo.fFlags := 0; if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then ShowMessage('Cancelled') end; Вопрос:
Как узнать серийный номер диска
Ответ:
procedure TForm1.Button1Click(Sender: TObject); var VolumeName, FileSystemName : array [0..MAX_PATH-1] of Char; VolumeSerialNo : DWord; MaxComponentLength, FileSystemFlags : Integer; begin GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo, MaxComponentLength,FileSystemFlags, FileSystemName,MAX_PATH); Memo1.Lines.Add('VName = '+VolumeName); Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8)); Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength)); Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4)); Memo1.Lines.Add('FSName = '+FileSystemName); end; Вопрос:
Как узнать является диск CD-диском,сетевым диском, виртуальным диском или сьемным диском?
Ответ:
Windows API функция GetDriveType().
Пример:
procedure TForm1.Button1Click(Sender: TObject); begin case GetDriveType('C:\') of 0 : ShowMessage('The drive type cannot be determined'); 1 : ShowMessage('The root directory does not exist'); DRIVE_REMOVABLE:ShowMessage('The disk can be removed'); DRIVE_FIXED : ShowMessage('The disk cannot be removed'); DRIVE_REMOTE : ShowMessage('The drive is remote (network) drive'); DRIVE_CDROM : ShowMessage('The drive is a CD-ROM drive'); DRIVE_RAMDISK : ShowMessage('The drive is a RAM disk'); end; end; Вопрос:
Как проверить готовность диска без появления окна ошибки Windows?
Ответ:
Вы можете использовать функцию Windows API SetErrorMode() для отключения диалога Window's critical Error.
Пример:
function IsDriveReady(DriveLetter : char) : bool; var OldErrorMode : Word; OldDirectory : string; begin OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX); GetDir(0, OldDirectory); {$I-} ChDir(DriveLetter + ':\'); {$I+} if IoResult <> 0 then Result := False else Result := True; ChDir(OldDirectory); SetErrorMode(OldErrorMode); end; procedure TForm1.Button1Click(Sender: TObject); begin if not IsDriveReady('A') then ShowMessage('Drive Not Ready') else ShowMessage('Drive is Ready'); end; Вопрос:
Использование FindFirst для поиска файлов.
Ответ:
begin Result := SysUtils.FindFirst(Path, Attr, SearchRec); while Result = 0 do begin ProcessSearchRec(SearchRec); Result := SysUtils.FindNext(SearchRec); end; SysUtils.FindClose(SearchRec); end; Вопрос:
Как получить дескриптор окна другого приложения и сделать его активным?
Ответ:
Использование фуекции Windows API FindWindow() - простейший способ нахождение окна, при условии, что известен его заголовок или имя оконного класса. Если Вам известна только часть заголовка окна (например 'Netscape - ' + 'какой-то неизвестный URL'), Вам нужно использовать функцию EnumWindows() для получения всех окон, затем вызывать функцию GetWindowsText() и GetClassName для поиска нужного окна. Следующий пример находит первое окно, содержащее совпадающую часть заголовка окна и полностью совпадающее название оконного класса (если он задан) и делает это окно активным. type PFindWindowStruct = ^TFindWindowStruct; TFindWindowStruct = record Caption : string; ClassName : string; WindowHandle : THandle; end; function EnumWindowsProc(hWindow : hWnd; lParam : LongInt) : Bool {$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF} var lpBuffer : PChar; WindowCaptionFound : bool; ClassNameFound : bool; begin GetMem(lpBuffer, 255); Result := True; WindowCaptionFound := False; ClassNameFound := False; try if GetWindowText(hWindow, lpBuffer, 255) > 0 then if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0 then WindowCaptionFound := true; if PFindWindowStruct(lParam).ClassName = '' then ClassNameFound := True else if GetClassName(hWindow, lpBuffer, 255) > 0 then if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer)) > 0 then ClassNameFound := True; if (WindowCaptionFound and ClassNameFound) then begin PFindWindowStruct(lParam).WindowHandle := hWindow; Result := False; end; finally FreeMem(lpBuffer, sizeof(lpBuffer^)); end; end; function FindAWindow(Caption : string; ClassName : string) : THandle; var WindowInfo : TFindWindowStruct; begin with WindowInfo do begin Caption := Caption; ClassName := ClassName; WindowHandle := 0; EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo)); FindAWindow := WindowHandle; end; end; procedure TForm1.Button1Click(Sender: TObject); var TheWindowHandle : THandle; begin TheWindowHandle := FindAWindow('Netscape - ', ''); if TheWindowHandle = 0 then ShowMessage('Window Not Found!') else BringWindowToTop(TheWindowHandle); end; Вопрос:
Как написать программу не имеющую ни одной формы?
Ответ:
Создайте новое приложение, затем удалите из проекта все unitы - (Delphi 3 - View - Project Manager)
(Delphi 4 - Project - Remove from project)
Откройте файл проекта
(Delphi 3 - View - Project Source)
(Delphi 3 - Project - View Source)
и отредактируйте его так как приведино ниже.

Пример:
program Project1; {$R *.RES} uses SysUtils; var f : TextFile; begin AssignFile(f, 'TestFile.Txt'); ReWrite(f); Writeln(f, 'Test'); Close(f); end. Вопрос:
Почему возникает ошибка при передаче параметров типа boolean равного True в некоторые внешней функции
Ответ:
В Delphi 3 значение "True" для типов ByteBool, WordBool LongBool представляется как -1 для совместимости с Microsoft Visual Basic. Многие компиляторы представляют "True" как либо "не нуль" либо 1. При передаче параметров в не Visual Basic-приложения Вам следует придерживаться следующей техники во избежание несовместимости: LongBool(Abs(True)); При приеме значений типа boolean из внешних программ Вам следует всегда проверять его на значение "False". Эта техника всегда работает, поскольку "False" всегда представляется нулем. if BoolValPassed <> False then DoSomething. Вопрос:
Как получить длинное имя файла или каталога, зная короткое имя?
Ответ:
Используйте Win32_Find_Data поле TSearchRec.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var SearchRec : TSearchRec; Success : integer; begin Success := SysUtils.FindFirst('C:\DownLoad\dial-u~1.htm', faAnyFile, SearchRec); if Success = 0 then begin ShowMessage(SearchRec.FindData.CFileName); end; SysUtils.FindClose(SearchRec); end; Вопрос:
Как временно отключить range checking для участка программы, а затем вновь вклчить его?
Ответ:
Можно сделать это, используя "IFOPT" и "DEFINE". type PSomeArray = ^TSomeArray; TSomeArray = array[0..0] of integer; procedure TForm1.Button1Click(Sender: TObject); var p : PSomeArray; i : integer; begin {$IFOPT R+} {$DEFINE CKRANGE} {$R-} {$ENDIF} GetMem(p, sizeof(integer) * 200); try for i := 1 to 200 do p[i] := i; finally FreeMem(p, sizeof(integer) * 200); end; {$IFDEF CKRANGE} {$UNDEF CKRANGE} {$R+} {$ENDIF} end; Вопрос:
Как получить имя файла и путь локальной таблицы?
Ответ:
Следующий пример взят из файла BDE32.HLP Borland/CommonFiles/BDE directory: implementation {$R *.DFM} uses DbiTypes, DbiProcs; function fDbiFormFullName(Tbl: TTable): String; var Props: CurProps; Buffer1 : array[0..DBIMAXPATHLEN] of char; Buffer2 : array[0..DBIMAXPATHLEN] of char; begin Check(DbiGetCursorProps(Tbl.Handle,Props)); StrPCopy(Buffer1, Tbl.TableName); Check(DbiFormFullName(Tbl.DBHandle, @Buffer1, Props.szTableType, @Buffer2)); Result := StrPas(Buffer2); end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Lines.Add(fDbiFormFullName(Table1)); end; Примечание: Таблица должна быть открытой. Работает с локальными таблицами. Вопрос:
Как получить дескриптор панели задач (TaskBar)?
Ответ:
hTaskbar := FindWindow('Shell_TrayWnd', Nil ); Вопрос:
Как из программы запустить Screen Saver?
Ответ:
Представленная ниже функция демонстрирует как это сделать function TurnScreenSaverOn : bool; var b : bool; begin result := false; if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @b, 0) <> true then exit; if not b then exit; PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0); result := true; end; Вопрос:
Как выяснить установлены ли в системе шрифты TrueType?
Ответ:
function IsTrueTypeAvailable : bool; var {$IFDEF WIN32} rs : TRasterizerStatus; {$ELSE} rs : TRasterizer_Status; {$ENDIF} begin result := false; if not GetRasterizerCaps(rs, sizeof(rs)) then exit; if rs.WFlags and TT_AVAILABLE <> TT_AVAILABLE then exit; if rs.WFlags and TT_ENABLED <> TT_ENABLED then exit; result := true; end; Вопрос:
Как переслать файл в Мусорную Корзину?
Ответ:
Используйте функцию SHFileOperation(). uses ShellAPI; procedure SendToRecycleBin(FileName: string); var SHF: TSHFileOpStruct; begin with SHF do begin Wnd := Application.Handle; wFunc := FO_DELETE; pFrom := PChar(FileName); fFlags := FOF_SILENT or FOF_ALLOWUNDO; end; SHFileOperation(SHF); end; procedure TForm1.Button1Click(Sender: TObject); begin SendToRecycleBin('c:\DownLoad\Test.gif'); end; Вопрос:
Как изменить обои Windows програмно?
Ответ:
Изменить обои можно функцией SystemParametersInfo()Б переслав ей в качестве параметров константу SPI_SETDESKWALLPAPER и имя нового файла обоев.
Пример:
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar('C:\SOMEPATH\SOME.BMP'), SPIF_SENDWININICHANGE); Вопрос:
Как выяснить запущен ли Delphi / C++ Builder?
Ответ:
Используйте функцию FindWindow. (Класс главного окна Delphi / C++ Builder - TAppBuilder) if FindWindow('TAppBuilder', Nil) <> 0 Then ShowMessage('Delphi and or C++ Builder is running'); Вопрос:
Как програмно выяснить версию Windows?
Ответ:
{$IFDEF WIN32} function GetVersionEx(lpOs : pointer) : BOOL; stdcall; external 'kernel32' name 'GetVersionExA'; {$ENDIF} procedure GetWindowsVersion(var Major : integer; var Minor : integer); var {$IFDEF WIN32} lpOS, lpOS2 : POsVersionInfo; {$ELSE} l : longint; {$ENDIF} begin {$IFDEF WIN32} GetMem(lpOS, SizeOf(TOsVersionInfo)); lpOs^.dwOSVersionInfoSize := SizeOf(TOsVersionInfo); while getVersionEx(lpOS) = false do begin GetMem(lpos2, lpos^.dwOSVersionInfoSize + 1); lpOs2^.dwOSVersionInfoSize := lpOs^.dwOSVersionInfoSize + 1; FreeMem(lpOs, lpOs^.dwOSVersionInfoSize); lpOS := lpOs2; end; Major := lpOs^.dwMajorVersion; Minor := lpOs^.dwMinorVersion; FreeMem(lpOs, lpOs^.dwOSVersionInfoSize); {$ELSE} l := GetVersion; Major := LoByte(LoWord(l)); Minor := HiByte(LoWord(l)); {$ENDIF} end; procedure TForm1.Button1Click(Sender: TObject); var Major : integer; Minor : integer; begin GetWindowsVersion(Major, Minor); Memo1.Lines.Add(IntToStr(Major)); Memo1.Lines.Add(IntToStr(Minor)); end; Вопрос:
Как узнать переменные окружения (environment variable) DOS, например path?
Ответ:
Windows API - функция GetDOSEnvironment() для Win16 и GetEnvironmentStrings() для Win32.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var p : pChar; begin Memo1.Lines.Clear; Memo1.WordWrap := false; {$IFDEF WIN32} p := GetEnvironmentStrings; {$ELSE} p := GetDOSEnvironment; {$ENDIF} while p^ <> #0 do begin Memo1.Lines.Add(StrPas(p)); inc(p, lStrLen(p) + 1); end; {$IFDEF WIN32} FreeEnvironmentStrings(p); {$ENDIF} end; Вопрос:
Как рисовать непосредственно на Рабочем столе?
Ответ:

Пример:
procedure TForm1.Button1Click(Sender: TObject); var dc : hdc; begin dc := GetDc(0); MoveToEx(Dc, 0, 0, nil); LineTo(Dc, 300, 300); ReleaseDc(0, Dc); end; Вопрос:
Как определить каталог Windows?
Ответ:
Вызовите функцию GetWindowsDirectory(). Если Вас интересует каталог System, вызовите функцию GetSystemDirectory().
Пример:
{$IFNDEF WIN32} const MAX_PATH = 144; {$ENDIF} procedure TForm1.Button1Click(Sender: TObject); var a : Array[0..MAX_PATH] of char; begin GetWindowsDirectory(a, sizeof(a)); ShowMessage(StrPas(a)); GetSystemDirectory(a, sizeof(a)); ShowMessage(StrPas(a)); end; Вопрос:
Как определить размер рабочего стола без Тaskbar'а?
Ответ:
Воспользуйтесь функцией SystemParametersInfo(), переслав ей в качестве параметров - SPI_GETWORKAREA и адрес структуры типа TRect, куда будут передан полученный результат.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var r : TRect; begin SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0); Memo1.Lines.Add(IntToStr(r.Top)); Memo1.Lines.Add(IntToStr(r.Left)); Memo1.Lines.Add(IntToStr(r.Bottom)); Memo1.Lines.Add(IntToStr(r.Right)); end; Вопрос:
Как закрыть CD програмно?
Ответ:
Вызовите функцию mciSendCommand (из библиотекиMMSystem) передав ей параметр MCI_SET_DOOR_CLOSED.
Пример:
uses MMSystem; procedure CloseCD(Drive : char); var mp : TMediaPlayer; begin result := false; Application.ProcessMessages; mp := TMediaPlayer.Create(nil); mp.Visible := false; mp.Parent := Application.MainForm; mp.Shareable := true; mp.DeviceType := dtCDAudio; mp.FileName := Drive + ':'; mp.Open; Application.ProcessMessages; mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); Application.ProcessMessages; mp.Close; Application.ProcessMessages; mp.free; result := true; end; procedure TForm1.Button1Click(Sender: TObject); begin CloseCD('D'); end; Вопрос:
Как определить свободное дисковое пространство на дисках размером больше 2 ГБ?
Ответ:
Вызовите функцию GetDiskFreeSpaceEx(). Возвращаемый функцией результат типа integers конвертируйте в doubles.
Пример:
function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar; var lpFreeBytesAvailableToCaller : Integer; var lpTotalNumberOfBytes: Integer; var lpTotalNumberOfFreeBytes: Integer) : bool; stdcall; external kernel32 name 'GetDiskFreeSpaceExA'; procedure GetDiskSizeAvail(TheDrive : PChar; var TotalBytes : double; var TotalFree : double); var AvailToCall : integer; TheSize : integer; FreeAvail : integer; begin GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail); {$IFOPT Q+} {$DEFINE TURNOVERFLOWON} {$Q-} {$ENDIF} if TheSize >= 0 then TotalBytes := TheSize else if TheSize = -1 then begin TotalBytes := $7FFFFFFF; TotalBytes := TotalBytes * 2; TotalBytes := TotalBytes + 1; end else begin TotalBytes := $7FFFFFFF; TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize); end; if AvailToCall >= 0 then TotalFree := AvailToCall else if AvailToCall = -1 then begin TotalFree := $7FFFFFFF; TotalFree := TotalFree * 2; TotalFree := TotalFree + 1; end else begin TotalFree := $7FFFFFFF; TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall); end; end; procedure TForm1.Button1Click(Sender: TObject); var TotalBytes : double; TotalFree : double; begin GetDiskSizeAvail('C:\', TotalBytes, TotalFree); ShowMessage(FloatToStr(TotalBytes)); ShowMessage(FloatToStr(TotalFree)); end; Вопрос:
Как спрятать Панель Задач Windows (Task Bar)?
Ответ:
Вначале необходимо вызвать функцию FindWindow(), чтобы определить handle TaskBar. Затем вызвите функцию ShowWindow(), передав ей в качестве параметра костанту SW_HIDE.
Пример:
procedure TForm1.Button1Click(Sender: TObject); var hTaskBar : THandle; begin hTaskbar := FindWindow('Shell_TrayWnd', Nil); ShowWindow(hTaskBar, SW_HIDE); end; procedure TForm1.Button2Click(Sender: TObject); var hTaskBar : THandle; begin hTaskbar := FindWindow('Shell_TrayWnd', Nil); ShowWindow(hTaskBar, SW_SHOWNORMAL); end; Вопрос:
Как определить подключен ли компюетер к сети.
Ответ:
Воспользуйтесь функцией GetSystemMetrics(), переслав ей флаг SM_NETWORK.
Пример:
procedure TForm1.Button1Click(Sender: TObject); begin if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then ShowMessage('Machine is attached to network') else ShowMessage('Machine is not attached to network'); end; Вопрос:
Как добавить документ в меню ПУСК - ДОКУМЕНТЫ?
Ответ:
Используйте функцию SHAddToRecentDocs.
Пример:
uses ShlOBJ; procedure TForm1.Button1Click(Sender: TObject); var s : string; begin s := 'C:\DownLoad\ntkfaq.html'; SHAddToRecentDocs(SHARD_PATH, pChar(s)); end; Вопрос:
Как программно изменить текущий порт принтера?
Ответ:
Используйте метод SetPrinter класса TPrinter.
Пример:
uses Printers; {$IFNDEF WIN32} const MAX_PATH = 144; {$ENDIF} procedure TForm1.Button1Click(Sender: TObject); var pDevice : pChar; pDriver : pChar; pPort : pChar; hDMode : THandle; PDMode : PDEVMODE; begin if PrintDialog1.Execute then begin GetMem(pDevice, cchDeviceName); GetMem(pDriver, MAX_PATH); GetMem(pPort, MAX_PATH); Printer.GetPrinter(pDevice, pDriver, pPort, hDMode); Printer.SetPrinter(pDevice, PDriver, 'FILE:', hDMode); FreeMem(pDevice, cchDeviceName); FreeMem(pDriver, MAX_PATH); FreeMem(pPort, MAX_PATH); Printer.BeginDoc; Printer.Canvas.TextOut(100, 100, 'Delphi Is RAD!'); Printer.EndDoc; end; end; Вопрос:
Как корректно определить изменения в оборудовании PlugNPlay?
Ответ:

Пример:
type TForm1 = class(TForm) Button1: TButton; private { Private declarations } procedure WMDeviceChange(var Message: TMessage); message WM_DEVICECHANGE; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const DBT_DEVICEARRIVAL = $8000; const DBT_DEVICEQUERYREMOVE = $8001; const DBT_DEVICEQUERYREMOVEFAILED = $8002; const DBT_DEVICEREMOVEPENDING = $8003; const DBT_DEVICEREMOVECOMPLETE = $8004; const DBT_DEVICETYPESPECIFIC = $8005; const DBT_CONFIGCHANGED = $0018; procedure TForm1.WMDeviceChange(var Message: TMessage); var s : string; begin {Do Something here} case Message.wParam of DBT_DEVICEARRIVAL : s := 'A device has been inserted and is now available'; DBT_DEVICEQUERYREMOVE: begin s := 'Permission to remove a device is requested'; ShowMessage(s); {True grants premission} Message.Result := integer(true); exit; end; DBT_DEVICEQUERYREMOVEFAILED : s := 'Request to remove a device has been canceled'; DBT_DEVICEREMOVEPENDING : s := 'Device is about to be removed'; DBT_DEVICEREMOVECOMPLETE : s := 'Device has been removed'; DBT_DEVICETYPESPECIFIC : s := 'Device-specific event'; DBT_CONFIGCHANGED : s:= 'Current configuration has changed' else s := 'Unknown Device Message'; end; ShowMessage(s); inherited; end; Вопрос:
Как после записи в ini-файл сбросить cache на диск, чтоб задействовать изменения?
Ответ:
Вызовите функцию WriteProfileString() или WritePrivateProfileString(), передав ей в качестве параметров секции, ключа и строки - nil.
Пример:
WriteProfileString(nil, nil, nil); WritePrivateProfileString(nil, nil, nil, FileName); Вопрос:
Как с помощью Проводника открыть конкретный каталог?
Ответ:

Пример:
uses ShellApi; procedure TForm1.Button1Click(Sender: TObject); begin ShellExecute(0, 'explore', 'C:\WINDOWS', nil, nil, SW_SHOWNORMAL); end; Вопрос:
Как запустить аплет Панели управления?
Ответ:
Запустить аплет Панели управления можно вызвав функцию WinExec, для выполнения файла control.exe, которому передано имя аплета. Обычно аплеты панели управления расположены в каталоге System Windows и имеют расширение .cpl.
Пример:
procedure TForm1.Button1Click(Sender: TObject); begin WinExec('C:\WINDOWS\CONTROL.EXE TIMEDATE.CPL', sw_ShowNormal); WinExec('C:\WINDOWS\CONTROL.EXE MOUSE', sw_ShowNormal); WinExec('C:\WINDOWS\CONTROL.EXE PRINTERS', sw_ShowNormal); end; Вопрос:
Как печатать в цвете?
Ответ:
Обычно нет необходимости переводить принтер в режим цветной печати, если он установлен в этот режим. Windows автоматически переведет цветную печать в черно-белую, если принтер не поддерживает цветной печати. Если Вам необходимо програмно изменить режим цвета, Вы можете обратится к структуре DevMode драйвера принтера.
Пример:
uses Printers; procedure TForm1.Button1Click(Sender: TObject); var Device : array[0..255] of char; Driver : array[0..255] of char; Port : array[0..255] of char; hDMode : THandle; PDMode : PDEVMODE; begin with Printer do begin PrinterIndex := PrinterIndex; GetPrinter(Device, Driver, Port, hDMode); if hDMode <> 0 then begin pDMode := GlobalLock(hDMode); if pDMode <> nil then begin pDMode.dmFields := pDMode.dmFields or dm_Color; pDMode.dmColor := DMCOLOR_COLOR; GlobalUnlock(hDMode); end; end; PrinterIndex := PrinterIndex; BeginDoc; Canvas.Font.Color := clRed; Canvas.TextOut(100,100, 'Red As A Rose!'); EndDoc; end; end; Вопрос:
Как открыть URL браузером, установленным по умолчанию?
Ответ:
Используйте функцию ShellExecute.
Пример:
uses ShellAPI; procedure TForm1.Button1Click(Sender: TObject); begin ShellExecute(Form1.Handle, nil, 'http://www.borland.com', nil, nil, SW_SHOWNORMAL); end; Вопрос:
Как стереть ехе-файл во время его исполнения?
Ответ:
Это не возможно. Вы можете стереть его во время следующего запуска Windows, добавив ключ RunOnce: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce
Пример:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; begin reg := TRegistry.Create; with reg do begin RootKey := HKEY_LOCAL_MACHINE; LazyWrite := false; OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', false); WriteString('Delete Me!','command.com /c del FILENAME.EXT'); CloseKey; free; end; end; Вопрос:
Как програмноинсталировать шрифты TrueType?
Ответ:
Скопируйте файл шрифта в директорию Windows\Fonts, и добавьте строку с именем шрифта и его расположением в разделе "'Software\Microsoft\Windows\CurrentVersion\Fonts". Вызовите функцию AddFontRecource(), а затем передайте системе сообщение WM_FONTCHANGE. И наконец, для удоления установленного шрифта, вызовите функцию RemoveFontRecource(), а затем передайте системе сообщение WM_FONTCHANGE.
Пример:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; b : bool; begin CopyFile('C:\DOWNLOAD\FP000100.TTF', 'C:\WINDOWS\FONTS\FP000100.TTF', b); reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.LazyWrite := false; reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Fonts', false); reg.WriteString('TESTMICR (TrueType)','FP000100.TTF'); reg.CloseKey; reg.free; {Add the font resource} AddFontResource('c:\windows\fonts\FP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); {Remove the resource lock} RemoveFontResource('c:\windows\fonts\FP000100.TTF'); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); end; Вопрос:
Как получить список часовых поясов?
Ответ:

Пример:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg : TRegistry; ts : TStrings; i : integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones', false); if reg.HasSubKeys then begin ts := TStringList.Create; reg.GetKeyNames(ts); reg.CloseKey; for i := 0 to ts.Count -1 do begin reg.OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones\' + ts.Strings[i], false); Memo1.Lines.Add(ts.Strings[i]); Memo1.Lines.Add(reg.ReadString('Display')); Memo1.Lines.Add(reg.ReadString('Std')); Memo1.Lines.Add(reg.ReadString('Dlt')); Memo1.Lines.Add('----------------------'); reg.CloseKey; end; ts.Free; end else reg.CloseKey; reg.free; end; Вопрос:
Какие значения возвращает функция GetTimeZoneInformation()?
Ответ:
const TIME_ZONE_ID_UNKNOWN = 0; const TIME_ZONE_ID_STANDARD = 1; const TIME_ZONE_ID_DAYLIGHT = 2; Вопрос:
Как сделать прозрачным фон текста?
Ответ:
Используйте функцию SetBkMode().
Пример:
procedure TForm1.Button1Click(Sender: TObject); var OldBkMode : integer; begin with Form1.Canvas do begin Brush.Color := clRed; FillRect(Rect(0, 0, 100, 100)); Brush.Color := clBlue; TextOut(10, 20, 'Not Transparent!'); OldBkMode := SetBkMode(Handle, TRANSPARENT); TextOut(10, 50, 'Transparent!'); SetBkMode(Handle, OldBkMode); end; end; Вопрос:
Как получить информацию о версии файла?
Ответ:
Для этого необходимо вызвать несколько функций API. В приведеннном ниже примере проверяется версия shell32.dll. Функция возвращает значение True - если версия DLL больше или равна 4.71 function TForm1.CheckShell32Version: Boolean; procedure GetFileVersion(FileName: string; var Major1, Major2, Minor1, Minor2: Integer); { Helper function to get the actual file version information } var Info: Pointer; InfoSize: DWORD; FileInfo: PVSFixedFileInfo; FileInfoSize: DWORD; Tmp: DWORD; begin // Get the size of the FileVersionInformatioin InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp); // If InfoSize = 0, then the file may not exist, or // it may not have file version information in it. if InfoSize = 0 then raise Exception.Create('Can''t get file version information for ' + FileName); // Allocate memory for the file version information GetMem(Info, InfoSize); try // Get the information GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info); // Query the information for the version VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize); // Now fill in the version information Major1 := FileInfo.dwFileVersionMS shr 16; Major2 := FileInfo.dwFileVersionMS and $FFFF; Minor1 := FileInfo.dwFileVersionLS shr 16; Minor2 := FileInfo.dwFileVersionLS and $FFFF; finally FreeMem(Info, FileInfoSize); end; end; var tmpBuffer: PChar; Shell32Path: string; VersionMajor: Integer; VersionMinor: Integer; Blank: Integer; begin tmpBuffer := AllocMem(MAX_PATH); // Get the shell32.dll path try GetSystemDirectory(tmpBuffer, MAX_PATH); Shell32Path := tmpBuffer + '\shell32.dll'; finally FreeMem(tmpBuffer); end; // Check to see if it exists if FileExists(Shell32Path) then begin // Get the file version GetFileVersion(Shell32Path, VersionMajor, VersionMinor, Blank, Blank); // Do something, such as require a certain version // (such as greater than 4.71) if (VersionMajor >= 4) and (VersionMinor >= 71) then Result := True else Result := False; end else Result := False; end; Вопрос:
Как создать иконку из bitmap'а?
Ответ:
Нужно создать два bitmap'а: bitmap-маску ("AND" bitmap) и bitmap-картинку (XOR bitmap). Потом передать дескрипторы "AND" и "XOR" bitmap-ов API функции CreateIconIndirect()
Пример:
procedure TForm1.Button1Click(Sender: TObject); var IconSizeX : integer; IconSizeY : integer; AndMask : TBitmap; XOrMask : TBitmap; IconInfo : TIconInfo; Icon : TIcon; begin {Get the icon size} IconSizeX := GetSystemMetrics(SM_CXICON); IconSizeY := GetSystemMetrics(SM_CYICON); {Create the "And" mask} AndMask := TBitmap.Create; AndMask.Monochrome := true; AndMask.Width := IconSizeX; AndMask.Height := IconSizeY; {Draw on the "And" mask} AndMask.Canvas.Brush.Color := clWhite; AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY)); AndMask.Canvas.Brush.Color := clBlack; AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4); {Draw as a test} Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask); {Create the "XOr" mask} XOrMask := TBitmap.Create; XOrMask.Width := IconSizeX; XOrMask.Height := IconSizeY; {Draw on the "XOr" mask} XOrMask.Canvas.Brush.Color := ClBlack; XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY)); XOrMask.Canvas.Pen.Color := clRed; XOrMask.Canvas.Brush.Color := clRed; XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4); {Draw as a test} Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask); {Create a icon} Icon := TIcon.Create; IconInfo.fIcon := true; IconInfo.xHotspot := 0; IconInfo.yHotspot := 0; IconInfo.hbmMask := AndMask.Handle; IconInfo.hbmColor := XOrMask.Handle; Icon.Handle := CreateIconIndirect(IconInfo); {Destroy the temporary bitmaps} AndMask.Free; XOrMask.Free; {Draw as a test} Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon); {Assign the application icon} Application.Icon := Icon; {Force a repaint} InvalidateRect(Application.Handle, nil, true); {Free the icon} Icon.Free; end; Вопрос:
Как преобразовать RGB-цвет в оттенки серого?
Ответ:
В приведенном примере для преобразования RGB-цвета используются коэффициенты, принятые в телевидении: function RgbToGray(RGBColor : TColor) : TColor; var Gray : byte; begin Gray := Round((0.30 * GetRValue(RGBColor)) + (0.59 * GetGValue(RGBColor)) + (0.11 * GetBValue(RGBColor ))); Result := RGB(Gray, Gray, Gray); end; procedure TForm1.FormCreate(Sender: TObject); begin Shape1.Brush.Color := RGB(255, 64, 64); Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color); end; Вопрос:
Как держать приложение в минимизированном виде?
Ответ:
Установите свойство WindowState в Minimized. Создайте обработчик сообщения WM_QueryOpen.
Пример:
{Place this code in the private section of the Form declaration} procedure WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN; {Place this code in the Form implementation section} procedure TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen); begin Msg.Result := 0; end; Вопрос:
при вызове функции RegisterClass я получаю ошибку: "Incompatible types: 'TPersistantClass' and 'TWndClassA'"
Ответ:
Функция RegisterClass() обьявлена в модулях Classes и Windows unit. Чтобы вызвать функцию из модуля Windows просто добавте префикс "Windows."
Пример:
procedure TForm1.Button1Click(Sender: TObject); wc : TWndClass; begin Windows.RegisterClass(wc) end; Вопрос:
Как принять файлы, брошенные на мою форму по drag & drop
Ответ:
Нужно сообщить Windows, что ваша форма принимает файлы по drag & drop с помощью функции Shell API DragAcceptFiles.(в обработчике события form create) Затем нужно реагироавть на сообытия drag & drop чтобы принять файлы. (см. пример) unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); private procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses ShellApi; procedure TForm1.FormCreate(Sender: TObject); begin {Let Windows know we accept dropped files} DragAcceptFiles(Form1.Handle, True); end; procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES); var NumFiles : longint; i : longint; buffer : array[0..255] of char; begin {How many files are being dropped} NumFiles := DragQueryFile(Message.Drop, -1, nil, 0); {Accept the dropped files} for i := 0 to (NumFiles - 1) do begin DragQueryFile(Message.Drop, i, @buffer, sizeof(buffer)); Form1.Memo1.Lines.Add(buffer); end; end; end. Вопрос:

Как создать задержку не подвешивая систему без компонента TTimer ?
Ответ:
В примере используется вызов Application.ProcessMessages для того, чтобы Windows обрабатывал сообщения во время цикла задержки. procedure Delay(ms : longint); var TheTime : LongInt; begin TheTime := GetTickCount + ms; while GetTickCount < TheTime do Application.ProcessMessages; end; procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage('Start Test'); Delay(2000); ShowMessage('End Test'); end; Вопрос:

Как програмно перезагрузить Windows? Ответ: Используйте функцию ExitWindows(). В качестве первого параметра ей передается она из трех констант: EW_RESTARTWINDOWS EW_REBOOTSYSTEM EW_EXITANDEXECAPP Второй параметр используется для перезагрузки компьютера в режиме эмуляции MS DOS.
Пример:
ExitWindows(EW_RESTARTWINDOWS, 0 );

Содержание Назад Вперед