Узнать о завершении работы Windows

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

MCSE — это такой специалист, который обучен с улыбкой на лице и в дружественных выражениях всякий раз авторитетно разъяснять вам, почему нужно переустанавливать вашу операционную систему.

Если текст в Memo1 был изменен, то программа не разрешает завершения сеанса Windows.

private

procedure WMQueryEndSession(var Msg: TWMQueryEndSession);

message WM_QUERYENDSESSION;

procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);

begin

Msg.Result := integer(not Memo1.Modified);

end;

{/codecitation}

Сообщения Windows — введение

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вирус детям не игрушка, не товарищ и не друг!

Кто-нибудь может со мной поделиться информацией о работе в Delphi с Windows Messages (системные сообщения)? Все эти сообщения типа WM_*** вызывают у меня нервный тик, поскольку это я не могу понять как это работает.

Список всех системных сообщений Windows доступен в файлах электронной справки Delphi. (Я использую D5, но думаю в будущих версиях все останется на своих местах).

Сообщения WM_ (и другие) играют существенную роль в работе Windows. Все вы хорошо знаете, что Delphi первоначально строится на принципе *управления событиями*; наверняка не один раз вы создавали обработчики событий OnKeyPress, OnThis, OnThat и других. Если у вас есть исходный код VCL, вы легко обнаружите, что механизм работы событий в Delphi основан на обработке конкретных системных соощенияй, посылаемых вашему элементу управления (как раз здесь и заложено главное достоинство объектно-ориентированного программирования, когда вы можете создать новый компонент на основе существующего и «научить» его обрабатывать другие необходимые вам системные сообщения). Windows постоянно посылает сообщения в ответ на действия пользователя и ждет соответствующей реакции от приложений Delphi (и всех остальных приложений Windows), заключающейся в их «приеме» и соответствующей обработке. Delphi имеет оболочки для большинства системных сообщений, создав «механизм оповещения элемента управления о приеме сообщения на его адрес» — с

обытия для компонентов, как было описано выше.

Кроме приема сообщений, у вас также существует возможность их отправления. Это возможно двумя способами: SendMessage и PostMessage (обе являются Win API функциями), а также метод Delphi Perform. Первые два требуют в качестве параметра Handle указывать дескриптор компонента, которому вы шлете сообщение, тогда как Perform является методом, принадлежащим самому компоненту. Сообщения передаются в стандартную очередь системных сообщений и обрабатываются подобно другим сообщениям.

Вот тривиальный пример: я хочу (по некоторой причудливой причине) вставлять в TMemo символ ‘y’ каждый раз после набора цифры ‘4’. (Обдумайте способ автоматической вставки блока begin-end или заключительной скобки.) Я, конечно, мог бы поработать с Memo-свойством Lines, но это было бы не так красиво и достаточно громоздко. Вот как выглядит наш пример с использованием сообщений:

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

if Key = ‘4’ then

SendMessage(Memo1.Handle, WM_CHAR, Word(‘y’), 0);

end;

Другой пример демонстрирует работу с компонентом ComboBox. Мы хотим, чтобы он автоматически выпадал при нажатии пользователем какой-либо клавиши. Это поведение, к сожалению, нестандартно. Вот что мы делаем:

procedure TFormEffortRates.ComboBoxMaterialKeyDown(Sender: TObject; var

Key: Word; Shift: TShiftState);

var

iShowing: integer;

{ какой-то код, затем… }

begin

{ С помощью сообщения узнаем состояние («раскрытость») ComboBox’а }

iShowing := SendMessage((Sender as TComboBox).Handle, CB_GETDROPPEDSTATE, 0, 0);

if iShowing = 0 then

{ раскрываем ComboBox }

SendMessage((Sender as TComboBox).Handle, CB_SHOWDROPDOWN, 1,0);

end;

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

function TMDIChild.GetMemoColumn(const TheMemo : TMemo) : integer;

begin

Result := TheMemo.SelStart —

(SendMessage(TheMemo.Handle, EM_LINEINDEX,

GetMemoLine(TheMemo), 0));

end;

function TMDIChild.GetMemoLine(const TheMemo : TMemo) : integer;

begin

Result := SendMessage(TheMemo.Handle, EM_LINEFROMCHAR,

TheMemo.SelStart, 0);

end;

Повторю снова: список и описание всех сообщений приведены в электронной справке по API. Инструкция по их использованию получилась у меня несколько скупой, но я надеюсь что хотя-бы несколько прояснил ситуацию и вы сможете задавать более конкретные вопросы.

Короче говоря, сообщения API позволяют тонко управлять вашими приложениями, выполняя именно те задачи, которые вам необходимо решить (метод «точечной наводки»). Вам необходимо лишь выбрать цель и передать свою просьбу понравившемуся элементу управления (или самому ловить такие сообщения).

{/codecitation}

Переслать текст в другую программу

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

unit Readmain;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, Menus, StdCtrls;

{ The WM_COPYDATA Windows message is not defined in the 16-bit Messages }

{ unit, although it is available to 16-bit applications running under }

{ Windows 95 or NT. This message is discussed in the Win32 API online }

{ help. }

const

WM_COPYDATA = $004A;

type

TMainForm = class(TForm)

ReadMemo: TMemo;

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

Help1: TMenuItem;

About1: TMenuItem;

procedure Exit1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure About1Click(Sender: TObject);

private

procedure OnAppMessage(var M: TMsg; var Handled: Boolean);

procedure WMCopyData(var M: TMessage); message WM_COPYDATA;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses RegMsg, AboutU;

type

{ The TCopyDataStruct record type is not defined in WinTypes unit, }

{ although it is available in the 16-bit Windows API when running }

{ under Windows 95 and NT. The lParam of the WM_COPYDATA message }

{ points to one of these. }

PCopyDataStruct = ^TCopyDataStruct;

TCopyDataStruct = record

dwData: DWORD;

cbData: DWORD;

lpData: Pointer;

end;

procedure TMainForm.OnAppMessage(var M: TMsg; var Handled: Boolean);

{ OnMessage handler for Application object. }

begin

{ The DDGM_HandshakeMessage message is received as a broadcast to }

{ all applications. The wParam of this message contains the handle }

{ of the window which broadcasted the message. We respond by posting }

{ the same message back to the sender, with our handle in the wParam. }

if M.Message = DDGM_HandshakeMessage then

begin

PostMessage(M.wParam, DDGM_HandshakeMessage, Handle, 0);

Handled := True;

end;

end;

procedure TMainForm.WMCopyData(var M: TMessage);

{ Handler for WM_COPYDATA message }

begin

{ Check wParam to ensure we know WHO sent us the WM_COPYDATA message }

if PCopyDataStruct(M.lParam)^.dwData = DDGM_HandshakeMessage then

{ When WM_COPYDATA message is received, the lParam points to}

ReadMemo.SetTextBuf(PChar(PCopyDataStruct(M.lParam)^.lpData));

end;

procedure TMainForm.Exit1Click(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Application.OnMessage := OnAppMessage;

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

AboutBox;

end;

end.

unit CopyMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Menus;

type

TMainForm = class(TForm)

DataMemo: TMemo;

BottomPnl: TPanel;

BtnPnl: TPanel;

CloseBtn: TButton;

CopyBtn: TButton;

MainMenu1: TMainMenu;

File1: TMenuItem;

CopyData1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

Help1: TMenuItem;

About1: TMenuItem;

procedure CloseBtnClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure About1Click(Sender: TObject);

procedure CopyBtnClick(Sender: TObject);

private

{ Private declarations }

protected

procedure WndProc(var Message: TMessage); override;

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses AboutU, RegMsg;

// The following declaration is necessary because of an error in

// the declaration of BroadcastSystemMessage() in the Windows unit

function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;

uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;

external ‘user32.dll’;

var

Recipients: DWORD = BSM_APPLICATIONS;

procedure TMainForm.WndProc(var Message: TMessage);

var

DataBuffer: TCopyDataStruct;

Buf: PChar;

BufSize: Integer;

begin

if Message.Msg = DDGM_HandshakeMessage then

begin

{ Allocate buffer }

BufSize := DataMemo.GetTextLen (1 * SizeOf(Char));

Buf := AllocMem(BufSize);

{ Copy memo to buffer }

DataMemo.GetTextBuf(Buf, BufSize);

try

with DataBuffer do

begin

{ Fill dwData with registered message as safety check }

dwData := DDGM_HandshakeMessage;

cbData := BufSize;

lpData := Buf;

end;

{ NOTE: WM_COPYDATA message must be *sent* }

SendMessage(Message.wParam, WM_COPYDATA, Handle,

Longint(@DataBuffer));

finally

FreeMem(Buf, BufSize);

end;

end

else

inherited WndProc(Message);

end;

procedure TMainForm.CloseBtnClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormResize(Sender: TObject);

begin

BtnPnl.Left := BottomPnl.Width div 2 — BtnPnl.Width div 2;

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

AboutBox;

end;

procedure TMainForm.CopyBtnClick(Sender: TObject);

begin

{ Call for any listening apps }

BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,

@Recipients, DDGM_HandshakeMessage, Handle, 0);

end;

end.

Скачать весь проект

{/codecitation}

Переслать сообщение с помощью SendMessage

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

This is useful if you want to send a message from your DLL back

to the calling application.

}

const

MY_MESSAGE = WM_USER 4242;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

// Handler that receive the Message

procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

txt: string;

begin

txt := ‘Hello World’;

SendMessage(Form1.Handle, MY_MESSAGE, 0, DWORD(PChar(txt)));

end;

// To receive this custom Message that is addressed to form1.handle

// you need a message handler.

procedure TForm1.MessageReceiver(var msg: TMessage);

var

txt: PChar;

begin

txt := PChar(msg.lParam);

msg.Result := 1;

ShowMessage(txt);

end;

end.

{/codecitation}

Отслеживать имя текущего компонента

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

— Что общего между Женщиной и Windows?

— И с тем, и с другим приходится трахаться.

— А в чем различие?

— С Женщиной, приятней. Но с Windows’ом зато без проблем. Нет месячных перерывов и жалоб на головную боль.

unit FCForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, StdCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

StatusBar1: TStatusBar;

public

procedure CmFocusChanged (var Msg: TCmFocusChanged);

message cm_FocusChanged;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CmFocusChanged (var Msg: TCmFocusChanged);

begin

StatusBar1.SimpleText := Msg.Sender.Name;

end;

end.

Загрузить исходный код проекта

{/codecitation}

Отправление сообщения сразу всем элементам управления формы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вы слишком много работаете за компьютером, если:

— Вспоминаете про антивирусные пакеты всякий раз, когда открываете консервы, книги, двери

— Вспоминаете про архивирование, когда:

— идете с тяжелыми сумками домой

— несете свою жену на руках

— Вспоминаете операцию «удалить», когда: — видите тещу

— инспектора ГИБДД

— Подсознательно ненавидите женщин с именами

— Ася

— Клава

— Вспоминаете про разархивирование, когда получаете зарплату.

Вы слишком мало работаете за компьютером, если:

— позволяете себе заниматься сексом без предохранения, даже с надежным партнером

— позволяете себе заниматься сексом

— позволяете себе.

Можно использовать

Screen.Forms[i].BroadCast(msg);

где [i] — индекс той формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми компонентами, потомками TWinControls и отправляет сообщение всем дочерним компонентам из массива Controls. Если один из дочерних компонентов обрабатывает это сообщение и устанавливает Msg.Result в ненулевое значение — дальнейшая рассылка сообщения останавливается.

{/codecitation}

Отловить сообщение в компоненте

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Кот схватил мышку за хвост…

… и своротил со стола комп!

{*************************************************************************}

{

TApplication besitzt eine Methode HookMainWindow.

Damit kann man in die Windows Prozedur (WndProc) «einhaken» und Nachrichten,

welche an die Applikation geschickt werden, abfangen und behandeln.

HookMainWindow is wie folgt deklariert:

}

procedure HookMainWindow(Hook : TWindowHook);

{ Und der Parameter TWindowHook (Methoden Pointer) so: }

type

TWindowHook = function(var Message : TMessage) : Boolean of object;

{*************************************************************************}

unit MessageReceiver;

interface

uses

Windows, Messages, SysUtils, Classes, Forms, Dialogs;

type

TOnReceiveUserMessage = procedure(Msg: Cardinal; wParam, lParam: Integer;

var Handled: Boolean) of object;

TOnReceiveOtherMessage = procedure(var Handled: Boolean) of object;

TMessageReceiver = class(TComponent)

private

{ Private declarations }

FHooked: Boolean;

FOnReceiveUserMessage: TOnReceiveUserMessage;

FOnDateTimeChange: TOnReceiveOtherMessage;

function MessageHook(var Msg: TMessage): Boolean;

protected

function DoDateTimeChange(Msg: TMessage): Boolean; dynamic;

function DoUserMessage(Msg: TMessage): Boolean; dynamic;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

{ Published declarations }

property OnDateTimeChange: TOnReceiveOtherMessage

read FOnDateTimeChange write FOnDateTimeChange;

property OnReceiveUserMessage: TOnReceiveUserMessage

read FOnReceiveUserMessage write FOnReceiveUserMessage;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents(‘System’, [TMessageReceiver]);

end;

function TMessageReceiver.MessageHook(var Msg: TMessage): Boolean;

begin

Result := False;

// User defined messages

if (Msg.Msg >= WM_USER) then

Result := DoUserMessage(Msg)

else

// Other messages

case Msg.Msg of

WM_TIMECHANGE: Result := DoDateTimeChange(Msg);

// …

end;

end;

function TMessageReceiver.DoDateTimeChange(Msg : TMessage): Boolean;

begin

Result := False;

if Assigned(FOnDateTimeChange) then

FOnDateTimeChange(Result);

end;

function TMessageReceiver.DoUserMessage(Msg: TMessage): Boolean;

begin

Result := False;

if Assigned(FOnReceiveUserMessage) then

FOnReceiveUserMessage(Msg.Msg, Msg.wParam, Msg.LParam, Result);

end;

constructor TMessageReceiver.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FHooked := False;

if not (csDesigning in ComponentState) then

begin

Application.HookMainWindow(MessageHook);

FHooked := True;

end;

end;

destructor TMessageReceiver.Destroy;

begin

if FHooked then Application.UnhookMainWindow(MessageHook);

inherited Destroy;

end;

end.

{/codecitation}

Оповещение всей системы о изменении WIN.INI

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Hа pаботе пpопал пpогpамеp. День нету, два. Hа звонки не отвечает. Hу pешили пpовеpить что да как. Пpишли к нему домой, а там в холодной ванне сидит лысый пpогpамист с полупустой бутылкой шампуня в pуке. Отняли у него бутылку и читают инстpукцию:

1. Hанести на влажные волосы. 2. Hамылить. 3. Подождать. 4. Смыть. 5. Повтоpить.

Оповещение приложения (или всей системы) о изменении WIN.INI. При изменении WIN.INI (например, изменении настроек хранителя экрана) необходимо уведомить систему (или конкретное приложение) о том, что WIN.INI изменен. Это можно сделать при помощи передачи приложению сообщения WM_WININICHANGE SendMessage(HANDLE, WM_WININICHANGE, 0, PCHAR(SECT_NAME)); При этом HANDLE равен или HANDLE приложения, или HWND_BROADCAST — рассылка всем приложениям. SECT_NAME задает имя секции WIN.INI, в которой произошли изменения. Если указать пустую строку (#0), то считается, что изменялись все секции, что естественно увеличивает время обработки и нагрузку на систему

VAR S : ARRAY[0..40] OF Char;

StrCopy(S, ‘Desktop’);

SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));

{/codecitation}

Обработка WM_SysCommand

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Neil J. Rubenking

Системное меню в приложениях Delphi ведет двойную жизнь — когда основная форма активна, работает системное меню главной формы, но когда приложение минимизировано, работает системное меню объекта Applictaion. Этот код может оказаться полезным:

CONST

SC_UDF = $EFF0; {должен быть < $F000 и делиться на 16}

procedure TForm1.FormCreate(Sender: TObject);

begin

AppendMenu(GetSystemMenu(Handle, False), MF_STRING, SC_UDF, ‘Всегда на

Новая WinProc

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

unit Scwndprc;

interface

uses Forms, Messages;

const

DDGM_FOOMSG = WM_USER;

implementation

uses Windows, SysUtils, Dialogs;

var

WProc: Pointer;

function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint;

stdcall;

{ This is a Win32 API-level window procedure. It handles the messages }

{ received by the Application window. }

begin

if Msg = DDGM_FOOMSG then

{ If it’s our user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by WndProc! Value is: $%x’, [Msg]));

{ Pass message on to old window procedure }

Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

initialization

{ Set window procedure of Application window. }

WProc := Pointer(SetWindowLong(Application.Handle, gwl_WndProc,

Integer(@NewWndProc)));

end.

unit Main;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TMainForm = class(TForm)

SendBtn: TButton;

PostBtn: TButton;

procedure SendBtnClick(Sender: TObject);

procedure PostBtnClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

OldWndProc: Pointer;

WndProcPtr: Pointer;

procedure WndMethod(var Msg: TMessage);

procedure HandleAppMessage(var Msg: TMsg; var Handled: Boolean);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses ScWndPrc;

procedure TMainForm.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);

{ OnMessage handler for Application object. }

begin

if Msg.Message = DDGM_FOOMSG then

{ if it’s the user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by OnMessage! Value is: $%x’,

[Msg.Message]));

end;

procedure TMainForm.WndMethod(var Msg: TMessage);

begin

if Msg.Msg = DDGM_FOOMSG then

{ if it’s the user-defined message, then alert the user. }

ShowMessage(Format(‘Message seen by WndMethod! Value is: $%x’, [Msg.Msg]));

with Msg do

{ Pass message on to old window procedure. }

Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam,

lParam);

end;

procedure TMainForm.SendBtnClick(Sender: TObject);

begin

SendMessage(Application.Handle, DDGM_FOOMSG, 0, 0);

end;

procedure TMainForm.PostBtnClick(Sender: TObject);

begin

PostMessage(Application.Handle, DDGM_FOOMSG, 0, 0);

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Application.OnMessage := HandleAppMessage; // set OnMessage handler

WndProcPtr := MakeObjectInstance(WndMethod); // make window proc

{ Set window procedure of application window. }

OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC,

Integer(WndProcPtr)));

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

{ Restore old window procedure for Application window }

SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));

{ Free our user-created window procedure }

FreeObjectInstance(WndProcPtr);

end;

end.

{/codecitation}