Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 12 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

DELPHI WinAPI FAQ







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

    Ответ:
    Программно можно отключить монитор совместимый со стандартом 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 ); 
    Наверх к содержанию



    К списку статей


    Есть комментарии, вопросы, ссылки на полезные ресурсы? Все это можно указать здесь:

    E-mail для ответа:

    Сообщение:



    Материалы находятся на сайте https://exelab.ru/pro/



    Оригинальный DVD-ROM: eXeL@B DVD !


  • Вы находитесь на EXELAB.rU
    Проект ReactOS