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

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


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

БОЛЬШОЙ FAQ ПО DELPHI



Многоразовая обработка сообщения



 unit PostForm;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls;
 
 type
   TFormManyMess = class(TForm)
     LBox: TListBox;
     Button1: TButton;
     ButtonPost: TButton;
     ButtonSend: TButton;
     ButtonPerform: TButton;
     ButtonMouseDown: TButton;
     ButtonOnMouseDown: TButton;
     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure ButtonPostClick(Sender: TObject);
     procedure ButtonSendClick(Sender: TObject);
     procedure ButtonPerformClick(Sender: TObject);
     procedure ButtonMouseDownClick(Sender: TObject);
     procedure ButtonOnMouseDownClick(Sender: TObject);
   private
     { Private declarations }
   public
     procedure WndProc(var Message: TMessage); override;
     procedure DefaultHandler(var Message); override;
     procedure WmLButtonDown (var Message: TWMMouse);
       message wm_lButtonDown;
     procedure MouseDown(Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer); override;
     procedure ApplicationMessage (var Msg: TMsg;
       var Handled: Boolean);
   end;
 
 var
   FormManyMess: TFormManyMess;
 
 implementation
 
 {$R *.DFM}
 
 procedure TFormManyMess.FormMouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin
   if Button = mbLeft then
     LBox.Items.Add (Format ('%s in (%d, %d)',
       ['FormMouseDown', X, Y]));
 end;
 
 procedure TFormManyMess.WndProc(var Message: TMessage);
 begin
   if Message.Msg = wm_LButtonDown then
     LBox.Items.Add (Format ('%s in (%d, %d)',
       ['WndProc', LoWord (Message.LParam),
       HiWord (Message.LParam)]));
   inherited;
 end;
 
 procedure TFormManyMess.DefaultHandler(var Message);
 begin
   with TMessage (Message) do
     if Msg = wm_LButtonDown then
       LBox.Items.Add (Format ('%s in (%d, %d)',
         ['DefaultHandler', LoWord (LParam),
         HiWord (LParam)]));
   inherited;
 end;
 
 procedure TFormManyMess.WmLButtonDown (var Message: TWMMouse);
 begin
   LBox.Items.Add (Format ('%s in (%d, %d)',
     ['WmLButtonDown', Message.XPos, Message.YPos]));
   inherited;
 end;
 
 procedure TFormManyMess.MouseDown(Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   if Button = mbLeft then
     LBox.Items.Add (Format ('%s in (%d, %d)',
       ['MouseDown', X, Y]));
   inherited;
 end;
 
 procedure TFormManyMess.ApplicationMessage (var Msg: TMsg;
   var Handled: Boolean);
 begin
   if (Msg.Message = wm_LButtonDown) and
       (Msg.hWnd = Handle) then
     LBox.Items.Add (Format ('%s in (%d, %d)',
       ['ApplicationMessage', LoWord (Msg.LParam),
       HiWord (Msg.LParam)]));
   Handled := False;
 end;
 
 procedure TFormManyMess.FormCreate(Sender: TObject);
 begin
   Application.OnMessage := ApplicationMessage;
 end;
 
 procedure TFormManyMess.Button1Click(Sender: TObject);
 begin
   LBox.Clear;
 end;
 
 procedure TFormManyMess.ButtonPostClick(Sender: TObject);
 begin
   LBox.Items.Add (' --- PostMessage ---');
   PostMessage (Handle, wm_lButtonDown,
     0, MakeLong (10, 10));
   PostMessage (Handle, wm_lButtonUp,
     0, MakeLong (10, 10));
 end;
 
 procedure TFormManyMess.ButtonSendClick(Sender: TObject);
 begin
   LBox.Items.Add (' --- SendMessage ---');
   SendMessage (Handle, wm_lButtonDown,
     0, MakeLong (10, 10));
   SendMessage (Handle, wm_lButtonUp,
     0, MakeLong (10, 10));
 end;
 
 procedure TFormManyMess.ButtonPerformClick(Sender: TObject);
 begin
   LBox.Items.Add (' --- Perform ---');
   Perform (wm_lButtonDown,
     0, MakeLong (10, 10));
   Perform (wm_lButtonUp,
     0, MakeLong (10, 10));
 end;
 
 procedure TFormManyMess.ButtonMouseDownClick(Sender: TObject);
 begin
   LBox.Items.Add (' --- MouseDown ---');
   MouseDown (mbLeft, [], 10, 10);
 end;
 
 procedure TFormManyMess.ButtonOnMouseDownClick(Sender: TObject);
 begin
   LBox.Items.Add (' --- OnMouseDown ---');
   OnMouseDown (self, mbLeft, [], 10, 10);
 end;
 
 end.

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




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



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



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


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