學習 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