unit1.pas

Delphi高级程序开发配书源代码,可以循序渐进的学习Delphi.

unit Unit1;

interface

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

const
  WM_MYMSG=WM_APP+$100;
  mstr='%s message now in %s.';
type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    CBox1: TCheckBox; //OnMessage Box
    CBox2: TCheckBox; //WndProc Box
    CBox3: TCheckBox; //Message Procedure Box
    CBox4: TCheckBox; //Default Handler Box
    FilterBox: TCheckBox;
    GroupBox2: TGroupBox;
    FRB1: TRadioButton; //OnMsg RadioButton
    FRB2: TRadioButton; //WndProc RadioButton
    FRB3: TRadioButton; //Message Proc RadioButton
    FRB4: TRadioButton; //Default Handler RadioButton
    PostButton: TButton;
    SendButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
    procedure PostButtonClick(Sender: TObject);
    procedure CBox1Click(Sender: TObject);
    procedure FilterBoxClick(Sender: TObject);
    procedure CBox4Click(Sender: TObject);
  private
    { Private declarations }

    //在应用程序层处处理消息
    procedure OnAppmessage(var msg:TMsg;var handled:boolean);

   //重载WndProc方法，在窗口过程处处理消息
    procedure WndProc(var msg:TMessage);override;

   //自定义的消息处理过程
   procedure MyMessage(var msg:TMessage);message WM_MYMSG;

   //重载缺省的消息处理过程
   procedure DefaultHandler(var msg);override;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{消息发送方法的数组，SendPostString[0]是 Send消息,
 SendPostString[1]是Post消息，在程序中是以判断消息结构的
 wParam字段来得到索引值的。SendMessage 时将wParam置为0，
 PostMessage 时将wParam置为1。}
const
SendPostStrings:array[0..1] of string=('Sent','Posted');


procedure TForm1.FormCreate(Sender: TObject);
begin
    //用OnAppmesage过程设置应用程序的Onmessage事件过程
    application.OnMessage :=OnAppmessage;

    //使用Checkbox.tag属性来存储与之相关的Radiobutton按钮的引用
    CBox1.Tag:=longint(FRB1);
    CBox2.Tag:=longint(FRB2);
    CBox3.Tag:=longint(FRB3);
    CBox4.Tag:=longint(FRB4);

    //使用Radiobutton.tag属性来存储与之相关的Checkbox按钮的引用
    FRB1.Tag:=longint(CBox1);
    FRB2.Tag:=longint(CBox2);
    FRB3.Tag:=longint(CBox3);
    FRB4.Tag:=longint(CBox4);
end;

//应用程序的OnMessage处理函数
procedure TForm1.OnAppmessage(var msg:TMsg;var handled:boolean);
begin
    //判断是否是自定义消息
   if msg.message =WM_MYMSG then
     begin
     //判断是否采用OnMessage来捕获消息
       if CBox1.Checked then
        begin
         showMessage(format(mstr,[SendPostStrings[msg.wparam],
         'Application.Onmessage']));
         handled:=FRB1.Checked;
        end;
     end;
end;

//窗口WndProc函数
procedure TForm1.WndProc(var msg:TMessage);
var
  callInherited:boolean;
begin
  //假设我们已经调用了继承的处理
  callinherited:=true;

  //如果是自定义的消息
  if msg.Msg =WM_MYMSG then
   begin

      //判断是否在WndProc捕获消息
      if CBox2.Checked then
      begin
          showmessage(format(mstr,
              [SendPostStrings[msg.wparam],'WndProc']));

          //察看是否在WndProc中设定了屏蔽
          callinherited:=not FRB2.Checked;
      end;
   end;
   if callinherited then inherited wndproc(msg);
end;

//用户自定义的消息处理函数
procedure TForm1.MyMessage(var msg:TMessage);
var
   callinherited:boolean;
begin
   callinherited:=true;

   //判断是否在自己的消息处理函数中捕获自定义消息
   if CBox3.Checked then
   begin
        showmessage(format(mstr,[SendPostStrings[msg.wparam],
                    'message procedure']));
        callinherited:=not FRB3.Checked;
   end;
   if callinherited then inherited;
end;

//缺省处理方法
procedure TForm1.DefaultHandler(var msg);
var
  callinherited:boolean;
begin
  callinherited:=true;
  if tmessage(msg).msg=WM_MYMSG then
  begin

     //判断是否在Default Handler 中捕获消息
     if CBox4.Checked then
    begin
       showmessage(format(mstr,
         [SendPostStrings[tmessage(msg).wparam],'defaultHandler']));
       callinherited:=not FRB4.Checked;
    end;
  end;
  if callinherited then inherited;
end;

//向窗体Send自定义消息,wParam置为0
procedure TForm1.SendButtonClick(Sender: TObject);
begin
  SendMessage(handle,WM_MYMSG,0,0);
end;

//向窗体Post自定义消息,wParam置为1
procedure TForm1.PostButtonClick(Sender: TObject);
begin
  PostMessage(handle,WM_MYMSG,1,0);
end;

//单击Checkbox时使适当的Radiobutton按钮有效或无效
procedure TForm1.CBox1Click(Sender: TObject);
begin

end;

//在适当的时候使Radiobutton按钮有效或无效
procedure TForm1.FilterBoxClick(Sender: TObject);
var
   I:integer;
   DoEnable,FBoxEnabled:boolean;
begin
   FBoxEnabled:=FilterBox.checked;

   //改变每一个RadioButton的Enable值
   for I:=0 to GroupBox2.ControlCount -1 do
    with GroupBox2.controls[I] as TRadioButton do
     begin
         DoEnable:=FBoxEnabled;
         //当选了'屏蔽消息'后，只激活与选定的捕获消息相应的RadioButton
         if DoEnable then DoEnable:=TCheckBox(tag).checked;
         if not DoEnable then checked:=false;
         enabled:=DoEnable;
     end;
end;

{捕获消息组中的OnMessage,WndProc,
 Message Procedure,Default Handler,
 共同使用的OnClick过程，来针对不同的情况
 使屏蔽消息组中的RadioButton有效或无效}
procedure TForm1.CBox4Click(Sender: TObject);
begin
  if FilterBox.Checked then
  begin

    //找到与该checkBox相对应的RadioButton
    with  TRadioButton((Sender as TCheckBox).Tag) do
    begin
       enabled:=TCheckBox(Sender).Checked;
       //根据CheckBox的Enable情况设定RadioButton的Enable值
       if not enabled then
                  checked:=false;
    end;
  end;
end;

end.