Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Многоразовая обработка сообщения



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.

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

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.