Delphi WinAPI FAQ
  1. Программное выключение монитора.
  2. Мигающий заголовок окна.
  3. Закрытие всплывающего меню в приложении system tray.
  4. Текущее время и дата по Гринвичу.
  5. Способ быстрой очистки canvasа .
  6. Использование InvalidateRect()t для перерисовки всей формы.
  7. Использование процедуры mouse_event() .
  8. Программное закрытие другого приложения.
  9. Форматирование диска.
  10. Отключение кнопки 'Пуск'.
  11. Отключение обновления окна.
  12. Программная установка драйвера принтера.
  13. Как набрать номер с помощью модема в Win32.
  14. Использование Tapi (Telephony API).
  15. Показ иконки, ассоциированной с данным типом файла.
  16. Определение нажатия определенной клавиши
    во время загрузки приложения.
  17. Звуки из динамика.
  18. Отключение кнопки закрытия любого окна.
  19. Как узнать путь к каталогам Windows.
  20. Как узнать полный путь и имя файла загруженной DLL.
  21. Вызов диалога 'Найти файлы и папки' проводника.
  22. MDI - родительское окно с фоновым рисунком.
  23. Как перехватить нажатие кнопки PrintScreen в Windows.
  24. Определение числа заданий spoolerа печати.
  25. Как определить имена установленых Com-портов.
  26. Извлечение пиктограммы из exe, dll или ico-файла.
  27. Обновление Рабочего Стола Windows.
  28. Отключение перерисовки содержимого окна при перемещении.
  29. Передача процессорных циклов другим приложениям.
  30. Запуск программы на старте Windows.
  31. Увеличение процессорного времени, выделяемого программе.
  32. Определение момента окончания изменения размера окна.
  33. Определение времени последнего доступа к файлу.
  34. Использование функции Shell API SHBrowseForFolder.
  35. Получение дескриптора окна Window, сожержащего DOS программу.
  36. Определение факта изменения системного времени.
  37. Очистка пункта Документы меню кнопки Пуск .
  38. Опеределение состояния модема под Win32.
  39. Добавление пункта к системному меню.
  40. Создание нестандартной процедуры разбиения слов.
  41. Копирование файлов, используя стандартный
    диалог Копирование Файла Windows.
  42. Как узнать серийный номер диска.
  43. Как узнать тип диска.
  44. Проверка готовности диска.
  45. Использование FindFirst для поиска файлов.
  46. Получение дескриптора окна другого приложения.
  47. Создание не-VCL консольного поекта.
  48. Ошибка внешней функции при передаче параметров типа boolean.
  49. Как получить длинное имя файла .
  50. Временное отключение range checking .
  51. Получение имени файла и пути локальной таблицы.
  52. Получение дескриптора панели задач (TaskBar).
  53. Запуск Screen saver'а програмно.
  54. Установлены ли TrueType шрифты.
  55. Как послать файл в корзину.
  56. Обои рабочего стола.
  57. Запущен ли Delphi.
  58. Версия Windows.
  59. Переменные окружения DOS.
  60. Рисовать на Рабочем столе.
  61. Каталог Windows.
  62. Размер Рабочего стола.
  63. Как закрыть CD.
  64. Определение свободного дискового пространства.
  65. Как спрятать Windows Taskbar.
  66. Машина в сети.
  67. Добавить документ в меню ПУСК ДОКУМЕНТЫ.
  68. Изменить порт принтера.
  69. Определить измения оборудования PlugNPlay.
  70. Изменения в ini-файле.
  71. Как открыть Проводником кокретный каталог.
  72. Запустить аплет панели управления.
  73. Цветная печать.
  74. Открыть URL установленным браузером.
  75. Стереть ехе-файл во время выполнения.
  76. Програмно добавить шрифты True Type.
  77. Часовые пояса.
  78. Использование функции GetTimeZoneInformation.
  79. Прозрачный текст.
  80. Информация о версии файла.
  81. Как создать иконку из bitmap'а.
  82. Преобразование цвета в оттенки серого.
  83. Как держать приложение в минимизированном виде.
  84. Вызов функции RegisterClass .
  85. drag &drop файлов.
  86. Создание задержки без таймера.
  87. Перезапуск Windows.






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

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



Copyright © 2002-2006 Максим Комогоров. Все права защищены.
Замечания, вопросы и предложения направляйте
по адресу: webscript@pisem.net
Поиск по сайту
О проекте
Архив
Hosted by uCoz