• Управление питанием из программы на Delphi
• Получение списка окон запущенных приложений
• Как отключить показ кнопки программы в TaskBar и по Alt-Tab и в Ctrl-Alt-Del
• Добавление программы в автозапуск
• Работа с папкой меню Пуск/Документы
• Установка своего WallPaper для рабочего стола Windows
• Как запретить кнопку Close [x] в заголовке окна.
• Каким образом можно изменить системное меню формы?
• Запуск внешней программы и ожидание ее завершения
• Как узнать местоположение специальных папок у Windows?
• Как скрыть таскбар?
• События нажатия на системные кнопки формы (минимизация, закрытие...)
• Как передать при создании потока (Tthread) ей некоторое значение?
• Как затенить кнопку закрыть в заголовке формы
• Как определить, имеется ли в системе звуковая плата
• Как подавить реакцию Windows на CTRL+ALT+DEL, ALT-TAB, CTRL-ESC
• Определение режима, в котором загружен Windows
• Поиск приложения, сопоставленного с указанным файлом
• Открытие ссылки на сайт или создание письма по команде программы
• Как отреагировать на завершение работы Windows
• Заставка для программы
• Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==>"c:\progra~1")
• Пример вывода сообщения одной командой и ввода строки одной командой.
• Перетаскивание файла
• Как изменять иконку приложения/окна во время его работы

Прочее

Управление питанием из программы на Delphi

*

W9x

 SetSystemPowerState(Suspended, Mode: Boolean):boolean;

Получение списка окон запущенных приложений

*

*

Данный пример выводит в ListBox1 список заголовков видимых окон запущенных приложений

procedure TForm1.Button1Click(Sender: TObject);
VAR
  Wnd : hWnd;
  buff: ARRAY [0..127] OF Char;
begin
  ListBox1.Clear;
  // Получаем hWnd первого окна
  Wnd := GetWindow(Handle, gw_HWndFirst);
  // Цикл поиска окон
  WHILE Wnd <> 0 DO BEGIN 
    IF (Wnd <> Application.Handle) AND // -Собственное окно
       IsWindowVisible(Wnd) AND             // -Невидимые окна
       (GetWindow(Wnd, gw_Owner) = 0) AND   // -Дочернии окна
       (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) // -Окна без заголовков
    THEN BEGIN
      GetWindowText(Wnd, buff, sizeof(buff));
      ListBox1.Items.Add(StrPas(buff));
    END;
    // Ищем новое окно
    Wnd := GetWindow(Wnd, gw_hWndNext);
  END;
  ListBox1.ItemIndex := 0;
end;

Как отключить показ кнопки программы в TaskBar и по Alt-Tab и в Ctrl-Alt-Del

*

*

Внеся изменения (выделенные цветом) в свой проект вы получите приложение, которое не видно в TaskBar и на него нельзя переключиться по Alt-Tab

program Project1;
uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var ExtendedStyle : integer;
begin
  Application.Initialize;
  ExtendedStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE,
    ExtendedStyle or WS_EX_TOOLWINDOW 
{AND NOT WS_EX_APPWINDOW});
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Если включить синий коментарий, то получите очень интересное приложение. Оно не видно в TaskBar и на него нельзя переключиться по Alt-Tab, но когда приложение минимизируется оно остается на рабочем столе в виде свернутого заголовка (прямо как в старом добром Windows 3.11)
Только сpазу пpедупpеждаю пpо гpабли, на котоpые я наступал:
Будьте готов к тому, что если пpи попытке закpытия пpиложения в OnCloseQuery или OnClose выводится вопpос о подтвеpждении, то могут быть пpоблемы с автоматическим завеpшением пpогpаммы пpи shutdown - под Win95 пpосто зависает, под WinNT не завеpшается. Очевидно, что сообщение выводится, но его не видно (пpичем SW_RESTORE не сpабатывает). Решение - ловить WM_QueryEndSession и после всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; 
  external 'KERNEL32.DLL';

implementation

procedure TForm1.Button1Click(Sender: TObject);
begin 
 if not (csDesigning in ComponentState) then
   RegisterServiceProcess(GetCurrentProcessID, 1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin 
 if not (csDesigning in ComponentState) then
  RegisterServiceProcess(GetCurrentProcessID, 0);
end;

Добавление программы в автозапуск

*

*

sProgTitle: Название для программы
sCmdLine:   Имя EXE файла с путем доступа
bRunOnce:   Запустить только один раз или постоянно при загрузке Windows

procedure RunOnStartup(sProgTitle, sCmdLine : string; bRunOnce : boolean );
var
  sKey : string;       // Суффикс ключа (Once - для однократного запуска)
  reg  : TRegIniFile;  // Класс доступа к реестру
begin
  // Тип запуска
  if bRunOnce then 
   sKey := 'Once'
    else sKey := '';
  reg := TRegIniFile.Create('');
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.WriteString('Software\Microsoft\Windows\CurrentVersion\Run'+ sKey + #0,
    sProgTitle, sCmdLine );
  reg.Free;
end;

// Пример вызова
RunOnStartup('Title of my program','MyProg.exe',False );

Примечание. Этот пример удобно использовать при написании деинсталляторов - добавить однократный вызов деинсталлятора и запросить от пользователя перезагрузку. Этот прием позволит безболезненно удалять DLL и им подобные файлы, которые обычном способом удалить невозможно (они загружены в силу того, что использовались деинсталлируемой программой или работают в момент деинсталляции).

Работа с папкой меню Пуск/Документы

*

*

Для добавления ссылки на файл в системную папку "Документы" необходимо вызвать функцию SHAddToRecentDocs:

uses ShellAPI, ShlOBJ;
procedure AddToStartDocumentsMenu( sFilePath : string );
begin
  SHAddToRecentDocs(  SHARD_PATH, PChar( sFilePath ) );
end;

// Например
AddToStartDocumentsMenu( 'c:\windows\MyWork.txt' );

Установка своего WallPaper для рабочего стола Windows

*

*

program wallpapr;
uses Registry, WinProcs;

procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );
var
  reg : TRegIniFile;
begin
// Изменяем ключи реестра
// HKEY_CURRENT_USER\Control Panel\Desktop
//  TileWallpaper (REG_SZ)
//  Wallpaper     (REG_SZ)
  reg := TRegIniFile.Create('Control Panel\Desktop' );
  with reg do begin
    WriteString( '', 'Wallpaper',  sWallpaperBMPPath );
    if( bTile )then
    begin
      WriteString('', 'TileWallpaper', '1' );
    end else begin
      WriteString('', 'TileWallpaper', '0' );
    end;
  end;
  reg.Free;
  // Оповещаем всех о том, что мы изменили системные настройки
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );
end;

begin
 // пример установки WallPaper по центру рабочего стола
 SetWallpaper('е:\winnt\winnt.bmp', False );
end.

Как запретить кнопку Close [x] в заголовке окна.

*

*

procedure TForm1.FormCreate(Sender: TObject);
var Style: Longint;
begin
  Style := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);
end;

// Блокировка нажатия ALT+F4 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_F4) and (ssAlt in Shift) then begin
    MessageBeep(0); 
    Key := 0;
  end;
end;

Каким образом можно изменить системное меню формы?

*

*

Hе знаю как насчет акселераторов, надо поискать, а вот добавить Item - пожалуйста

type
 TMyForm=class(TForm)
   procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;
 end;
const

ID_ABOUT    = WM_USER+1;
ID_CALENDAR = WM_USER+2;
ID_EDIT     = WM_USER+3;
ID_ANALIS   = WM_USER+4;

implementation

procedure TMyForm.wmSysCommand;
begin
 case Message.wParam of
  ID_CALENDAR : DatBitBtnClick(Self) ;
  ID_EDIT     : EditBitBtnClick(Self);
  ID_ANALIS   : AnalisButtonClick(Self);
 end;
 inherited;
end;

procedure TMyForm.FormCreate(Sender: TObject);
var SysMenu:THandle;
begin
 SysMenu:=GetSystemMenu(Handle,False);
 InsertMenu(SysMenu,Word(-1),MF_SEPARATOR,ID_ABOUT,'');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Calendar, 'Calendar');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Analis, 'Analis');
 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Edit, 'Edit');
end;

Запуск внешней программы и ожидание ее завершения

*

*

procedure TForm1.Button1Click(Sender: TObject);
var
  si : Tstartupinfo;
  p  : Tprocessinformation;
begin
 FillChar( Si, SizeOf( Si ) , 0 );
 with Si do begin
  cb := SizeOf( Si);
  dwFlags := startf_UseShowWindow;
  wShowWindow := 4;
 end;
 Application.Minimize;
 Createprocess(nil,'notepad.exe',nil,nil,false,Create_default_error_mode,nil,nil,si,p);
 Waitforsingleobject(p.hProcess,infinite);
 Application.Restore;
end;

Как узнать местоположение специальных папок у Windows?

*

*

var 
 FolderPath : string;

Registry := TRegistry.Create;
try
 Registry.RootKey := HKey_Current_User;
 Registry.OpenKey('Software\Microsoft\Windows\'+
  'CurrentVersion\Explorer\Shell Folders', False);
 FolderName := Registry.ReadString('StartUp'); 
   {Cache, Cookies, Desktop, Favorites, 
    Fonts, Personal, Programs, SendTo, Start Menu, Startp}
finally
 Registry.Free;
end;

Как скрыть таскбар?

*

*

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;

События нажатия на системные кнопки формы (минимизация, закрытие...)

*

*

При нажатии на эти кнопки происходит сообщение WM_SYSCOMMAND, его то и надо перехватить.

При этом:
 uCmdType = wParam;     // тип команды
 xPos = LOWORD(lParam); // X в экранных координатах
 yPos = HIWORD(lParam); // Y в экранных координатах

Пример:

Type TMain = class(TForm)
 ....
 protected
  Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND;
 end;
 .....
//   Обработка сообщения WM_SYSCOMMAND (перехват минимизации окна)
Procedure TForm1.WMGetSysCommand(var Message : TMessage) ;
Begin
 IF (Message.wParam = SC_MINIMIZE) Then Begin
  --- некая особая реакция на MINIMIZE ----
  Form1.Visible:=False;
 end else Inherited; // Во всех остальных случаях вызываем стандартный обработчик
End;

Как передать при создании потока (Tthread) ей некоторое значение?

*

*

К примеру, функция "прослушивает" каталог на предмет файлов. Если находит, то создает поток, в котором будет обрабатываться файл. При этом потоку необходимо передать имя файла, а вот как?
Странный вопрос. Я бы понял, если бы требовалось передавать данные во время работы нити. А так обычно поступают следующим образом.
В объект нити, происходящий от TThread дописывают поля. Как правило, в секцию PRIVATE. Затем переопределяют конструктор CREATE, который, принимая необходимые параметры заполняет соответствующие поля. А уже в методе EXECUTE легко можно пользоваться данными, переданными ей при его создании.
Например:

......
TYourThread = class(TTHread)
private
 FFileName: String;
protected
 procedure Execute; overrided;
public
 constructor Create(CreateSuspennded: Boolean;
 const AFileName: String);
end;
.....
constructor TYourThread.Create(CreateSuspennded: Boolean;
  const AFileName: String);
begin
 inherited Create(CreateSuspennded);
 FFIleName := AFileName;
end;

procedure TYourThread.Execute;
begin
 try
  ....
  if FFileName = ...
  ....
 except
  ....
 end;
end;
....
TYourForm = class(TForm)
....
private
 YourThread: TYourThread;
 procedure LaunchYourThread(const AFileName: String);
 procedure YourTreadTerminate(Sender: TObject);
....
end;
....
procedure TYourForm.LaunchYourThread(
  const AFileName: String);
begin
 YourThread := TYourThread.Create(True, AFileName);
 YourThread.Onterminate := YourTreadTerminate;
 YourThread.Resume
end;
....
procedure TYourForm.YourTreadTerminate(Sender: TObject);
begin
 ....
end;
....
end.

Как затенить кнопку закрыть в заголовке формы

*

*

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

procedure TForm1.FormCreate(Sender: TObject); 
var hMenuHandle:HMENU; 
begin 
 hMenuHandle := GetSystemMenu(Handle, FALSE); 
 IF (hMenuHandle <> 0) THEN 
  DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND); 
end;

Как определить, имеется ли в системе звуковая плата

*

*

Эта функция может быть полезна при написании инсталляторов

 Uses --//--,mmSystem;

 --- // ---
Function CheckAudioCard : boolean;
Begin
 Result := WaveOutGetNumDevs>0;
end;

Как подавить реакцию Windows на CTRL+ALT+DEL, ALT-TAB, CTRL-ESC

*

*

В некоторых случаях (например, при работе в полноэкранном режиме, показе своей презентации или экранной заставки ...) бывает полезно заблокировать перечисленные комбинации клавиш. Они блокируются при работе системы в режиме "экранная заставка" , который в свою очередь несложно включить и выключить:

Блокировка ALT-TAB
Проще всего это сделать при помощи регистрации горячей клавиши ALT-TAB. Это можно сделать при помощи функции RegisterHotKey(Handle, 1, MOD_ALT, VK_TAB);. При завершении программы следует вызывать UnRegisterHotKey(Handle, 1);

Определение режима, в котором загружен Windows

*

*

Как известно, Windows может быть загружен в различных режимах - нормальном, в режиме защиты от сбоев (с сетью и без нее). При написании автоматически запускаемых программ неплохо анализировать режим загрузки для корректировки режима работы программы (лично я в настройках такой программы обычно делаю флажок "не запускаться в режиме защиты от сбоев".
Определить это легко при помощи функции API GetSystemMetrics:

var
 BootMode : integer;
 ... ... ... 
BootMode := GetSystemMetrics(SM_CLEANBOOT);

Поиск приложения, сопоставленного с указанным файлом

*

*

Для определения, какое приложение сопоставлено с указанным файлом, необходимо использовать функцию FindExecutable.Она получает три параметра - имя файла, директорию по умолчанию (она не имеет смысла при указании полного пути к файлу) и указатель на буфер-получатель. При успешном выполнении возвращаемое значение больше или равно 32, иначе это код ошибки.
Пример:

var
 buf : array[0..255] of char;
begin
 FindExecutable('D:\test.doc','',buf);
 Caption := buf;
end;

Открытие ссылки на сайт или создание письма по команде программы

*

*

Часто при написании программы возникает необходимость открыть некоторый ресурс Интернет в стандартном браузере (как правило, подобное действие производится при щелчке не некотором TLabel на форме "О программе". Аналогично дело обстоит с отправкой письма автору программы. Решение проблемы достаточно простое:

uses ShellApi;
 ....
 ShellExecute(0, nil,'ресурс',nil,nil,1);

Как отреагировать на завершение работы Windows

*

*

Существует два способа:

• Обработка сообщения WM_QUERYENDSESSION
• Написание обработчика FormCloseQuery

Заставка для программы

*

*

Сведения о программе, авторские права и т.д., лучше оформить в виде отдельной формы и показывать ее при запуске программы (как это сделано в Word).
Сделать это не сложно:
1. Создаете форму (например SplashForm).
2. Объявляете ее свободной (availableForms).
3. В Progect Source вставляете следующее (например):

Program Splashin;
uses
 Forms,
 Main in 'PARTITION.PAS',
 Splash in 'SPLASH.PAS'
{$R *.RES}
begin
 try
  SlashForm := TSplashForm.Create(Application);
  SplashForm.Show;
  SplashForm.Update;
  Application.CreateForm(TMainForm, MainForm);
  SplashForm.Hide;
 finally
  SplashForm.Free;
 end;
 Application.Run;
end.

И форма SplashForm держится на экране пока выполняется Create в главной форме. Но иногда она появляется и пропадает очень быстро, поэтому нужно сделать задержку:
1. Добавляете на форму таймер с событием:

    procedure TSplashForm.Timer1Timer(Sender: TObject);
    begin
      Timer1.Enabled := False;
    end;

2. Событие onCloseQuery для формы:

    procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    begin
      CanClose := Not Timer1.Enabled;
    end;

3. И перед SplashForm.Hide; ставите цикл:

    repeat
      Application.ProcessMessages;
    until SplashForm.CloseQuery;

4. Все! Осталось установить на таймере период задержки 3-4 секунды.
5. На последок, у такой формы желательно убрать Caption:
SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);

Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==>"c:\progra~1")

*

*

Данная операция выполняется при помощи функции API GetShortPathName(), которая получает длинное имя, а возвращает короткое

Пример вывода сообщения одной командой и ввода строки одной командой.

*

*

Вывод сообщения:
ShowMessage('сообщение');
Ввод текста от пользователя:
S:=InputBox('Заголовок', 'Сообщение', S{строка по умолчанию});

unit Unit1;
interface
uses  
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, 
 Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Пример простого сообщения.'+#10+
  'Данное сообщение выводится всегда в центре экрана.');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessagePos('Пример сообщения с указанием его положения на экране.', 
   Form1.Left+Button2.Left, Form1.Top+Button2.Top);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Button3.Caption := InputBox('Delphi для всех',  'Введите строку:', Button3.Caption);
end;

end.

Перетаскивание файла

*

*

// На эту форму можно бросить файл (например из проводника) и он будет открыт
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs,StdCtrls, 
  ShellAPI // обязательно!;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    FileNameLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    // Это процедура, отвечающая за прием сообщения о броске файла
    procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles; 
end;

var
  Form1: TForm1;
implementation
{$R *.DFM}

procedure TForm1.WMDropFiles(var Msg: TMessage);
var 
   Filename: array[0 .. 256] of Char;
   Count   : integer;
begin
  // Получаем количество файлов (просто пример)
  nCount := DragQueryFile( msg.WParam, $FFFFFFFF,  acFileName, cnMaxFileNameLen);
  // Получаем имя первого файла }
  DragQueryFile( THandle(Msg.WParam),
     0, { это номер файла }
     Filename,SizeOf(Filename) ) ;
  // Открываем его
  with FileNameLabel do begin
   Caption := LowerCase(StrPas(FileName));
   Memo1.Lines.LoadfromFile(Caption);
  end;
  // Отдаем сообщение о завершении процесса
  DragFinish(THandle(Msg.WParam));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 // Уведомляем Windows, что на объект с указанным Handle можно бросать файлы
 DragAcceptFiles(Handle, True); 
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 DragAcceptFiles(Handle, False); 
end;
end.

Как изменять иконку приложения/окна во время его работы

*

*

Изменять иконку приложения или окна достаточно просто - для этого у TApplication и TForm предусмотрено свойство Icon. Смена иконки может вестись обычным присвоением свойству Icon нового значения:

 Form1.Icon  := Image1.Picture.Icon;

 Form1.Icon.Handle := LoadIcon(hInstance, 'имя иконки в ресурсе');

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 inc(IconIndex);
 case IconIndex of
  1 : Application.Icon.Assign(Image1.Picture.Icon);
  2 : Application.Icon.Assign(Image2.Picture.Icon);
  else IconIndex := 0;
 end;
 InvalidateRect(Application.Handle, NIL, True);
end;

© Зайцев Олег, "Программирование на Delphi - обмен опытом" 1999-2004. При использовании любых материалов данного сайта необходимо указывать источник информации. Дата обновления: 22.11.2004. Сайт размещен на хостинге AGAVA - Хостинг от AGAVA.ru