学习 Message(11): 测试 TWMMouse 结构相关的鼠标消息

和 TWMMouse 一致的消息结构有:

---

TWMLButtonDblClk {左键双击}
TWMLButtonDown   {左键按下}
TWMLButtonUp     {左键抬起}
TWMMButtonDblClk {中键双击}
TWMMButtonDown   {中键按下}
TWMMButtonUp     {中键抬起}
TWMMouseMove     {鼠标移动}
TWMRButtonDblClk {右键双击}
TWMRButtonDown   {右键按下}
TWMRButtonUp     {右键抬起}

代码文件:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  protected
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Align := alLeft;
  Memo1.ScrollBars := ssVertical;
  Memo1.Clear;
  Position := poScreenCenter;
  CheckBox1.Caption := '接受鼠标移动消息';
  Button1.Caption := '清空列表';
end;

procedure TForm1.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标左键双击: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMLButtonDown(var Message: TWMLButtonDown);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标左键按下: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMLButtonUp(var Message: TWMLButtonUp);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标左键抬起: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMMButtonDblClk(var Message: TWMMButtonDblClk);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标中键双击: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMMButtonDown(var Message: TWMMButtonDown);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标中键按下: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMMButtonUp(var Message: TWMMButtonUp);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标中键抬起: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMMouseMove(var Message: TWMMouseMove);
var
  x,y: Integer;
  s: string;
begin
  if not CheckBox1.Checked then Exit;
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标移动: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMRButtonDblClk(var Message: TWMRButtonDblClk);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标右键双击: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMRButtonDown(var Message: TWMRButtonDown);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标右键按下: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

procedure TForm1.WMRButtonUp(var Message: TWMRButtonUp);
var
  x,y: Integer;
  s: string;
begin
  x := Message.XPos;
  y := Message.YPos;
  s := Format('鼠标右键抬起: %d,%d', [x,y]);
  Memo1.Lines.Add(s);
  Message.Result := 0;
end;

end.

窗体文件:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 206
  ClientWidth = 321
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 185
    Height = 89
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
  end
  object CheckBox1: TCheckBox
    Left = 199
    Top = 8
    Width = 122
    Height = 17
    Caption = 'CheckBox1'
    TabOrder = 1
  end
  object Button1: TButton
    Left = 199
    Top = 173
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 2
    OnClick = Button1Click
  end
end