唯惟的VCL Button研究。(9分)

  • 主题发起人 zw960122
  • 开始时间
Z

zw960122

Unregistered / Unconfirmed
GUEST, unregistred user!
[brown][/brown]unit FrmBtn;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Button3: TButton;
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
procedure MyOnClick(Sender : TObject);
public
{ Public declarations }
end;

TWWButtonControl = class(TWinControl)
private
FClicksDisabled: Boolean;
function IsCheckedStored: Boolean;
protected
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetActionLinkClass: TControlActionLinkClass; override;
function GetChecked: Boolean; virtual;
procedure SetChecked(Value: Boolean); virtual;
procedure WndProc(var Message: TMessage); override;
property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;
public
constructor Create(AOwner: TComponent); override;
end;

TWWButtonActionLink = class(TWinControlActionLink)
protected
FClient: TWWButtonControl;
procedure AssignClient(AClient: TObject); override;
function IsCheckedLinked: Boolean; override;
procedure SetChecked(Value: Boolean); override;
end;

TWWButton = class(TWWButtonControl)
private
FDefault: Boolean;
FCancel: Boolean;
FActive: Boolean;
FModalResult: TModalResult;
procedure SetDefault(Value: Boolean);
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure SetButtonStyle(ADefault: Boolean); virtual;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
function UseRightToLeftAlignment: Boolean; override;
published
property Action;
property Anchors;
property BiDiMode;
property Cancel: Boolean read FCancel write FCancel default False;
property Caption;
property Constraints;
property Default: Boolean read FDefault write SetDefault default False;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

var
Form1: TForm1;
myBtn : TWWButton;

implementation

{$R *.dfm}

{ TButtonActionLink }

procedure TWWButtonActionLink.AssignClient(AClient: TObject);
begin
inherited AssignClient(AClient);
FClient := AClient as TWWButtonControl;
end;

function TWWButtonActionLink.IsCheckedLinked: Boolean;
begin
Result := inherited IsCheckedLinked and
(FClient.Checked = (Action as TCustomAction).Checked);
end;

procedure TWWButtonActionLink.SetChecked(Value: Boolean);
begin
if IsCheckedLinked then
begin
FClient.ClicksDisabled := True;
try
FClient.Checked := Value;
finally
FClient.ClicksDisabled := False;
end;
end;
end;

{ TButtonControl }

constructor TWWButtonControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
ImeMode := imDisable;
end;

procedure TWWButtonControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Self.Checked = False) then
Self.Checked := Checked;
end;
end;

function TWWButtonControl.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TWWButtonActionLink;
end;

function TWWButtonControl.GetChecked: Boolean;
begin
Result := False;
end;

function TWWButtonControl.IsCheckedStored: Boolean;
begin
Result := (ActionLink = nil) or not TWWButtonActionLink(ActionLink).IsCheckedLinked;
end;

procedure TWWButtonControl.SetChecked(Value: Boolean);
begin
end;

procedure TWWButtonControl.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if not (csDesigning in ComponentState) and not Focused then
begin
FClicksDisabled := True;
Windows.SetFocus(Handle);
FClicksDisabled := False;
if not Focused then Exit;
end;
CN_COMMAND:
if FClicksDisabled then Exit;
end;
inherited WndProc(Message);
end;

{ TButton }

constructor TWWButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption, csOpaque, csDoubleClicks];
// ControlStyle 定义控件的风格特性, 有如下值:
{
csAcceptsControls 成为设计期放在其上的所有控件的父类。TPanel的制定类就是这样声明的。
csCaptureMouse 当控件被点击时捕捉其事件。
csDesignInteractive 设计期,控件映射右键点击为左击来操作控件。
csClickEvents 控件能接收及响应鼠标事件。
csFramed 控件有个3D框架。TEdit就是这个样子。
csSetCaption 如果控件的标题没有明确定义,应匹配Name属性。
csOpaque 控件完全填充其客户区矩型。想做不规则形状的东东吗,这个不能不知道呀。
csDoubleClicks 控件能接收及响应鼠标双击事件。否则映射双击为左击。
csFixedWidth 控件宽度固定。
csFixedHeight 控件高度固定。
csNoDesignVisible 控件设计期不可见。
csReplicatable 控件能通过PaintTo方法拷贝其image到任意画布。TShape,TPaintBox,TImage,TBevel等都是这样的。

csNoStdEvents 标准事件如 mouse, key, 和 click 事件都被忽略。当没必要响应这些事件时,这个标识能使程序运行得更快。
csDisplayDragImage 哥呀,我译不了了。If some control that has an associated drag image list is dragged across a control with this setting, then the image list is used to enhance the drag cursor while the cursor is over it. Otherwise, the drag cursor is used on its own.
csReflector 控件响应窗体对话框消息, 焦点消息, 或大小改变消息. 如果控件能被作为一个ActiveX控件就用这个设置, 这样它就能接收这些事件的通知。

csActionClient 控件连接一个action对象.当Action属性被设置时这个属性被设置,当Action属性被清空时它被清除。
csMenuEvents 控件响应系统菜单命令。
TControl 析构中初始化 ControlStyle 为 [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks].
}

Width := 75;
Height := 25;
TabStop := True;
end;

procedure TWWButton.Click;
var
Form: TCustomForm;
begin
//inherited 和inherited Click;有什么区别吗?
//先inherrited和后inherrited有什么区别吗?
//inherited不就是把父类的相应方法做一次吗?
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult;
inherited Click;
end;

function TWWButton.UseRightToLeftAlignment: Boolean;
begin
Result := False;
end;

procedure TWWButton.SetButtonStyle(ADefault: Boolean);
const
BS_MASK = $000F;
var
Style: Word;
begin
if HandleAllocated then
begin
if ADefault then
Style := BS_DEFPUSHBUTTON
else
Style := BS_PUSHBUTTON;
//真搞笑BS_MASK <> Style 这部分永远都是真呀。Style只能是0或1, 加这块干什么呀。
//查帮助说 GetWindowLong 是找回 窗体的信息。GWL_STYLE 是风格信息。
//控件编程什么时候要处理这些异常呢?faint.
if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
SendMessage(Handle, BM_SETSTYLE, Style, 1);
end;
end;

procedure TWWButton.SetDefault(Value: Boolean);
var
Form: TCustomForm;
begin
//有趣,原来很多书上的焦点例子都是从这抄的呀。哈哈。我也会了。perform...
//在学校的时候看过查里老头的一本书,把D用得象Borland C++一样,专本捕Windows消息,
//那个时候是没头没脸的看,看过后以为进步多了,可是还是用不上什么,
//高手就是高手呀。WParam, LParam这两个参数的真正意义没明确。唉。
//谁会呀,救我吧!
//再看GetParentForm函数,如果中间的父类不可见。。。哈。
FDefault := Value;
if HandleAllocated then
begin
Form := GetParentForm(Self);
if Form <> nil then
Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
end;
end;

procedure TWWButton.CreateParams(var Params: TCreateParams);
const
ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
begin
//CreateWnd会调用这个方法来初始化控件参数. 重载这个方法来制定控件的表现方式。
//为什么这个控件会是个按钮,因为Params.Style := Params.Style or ButtonStyles[FDefault];
//把倒数第二行注示掉。用最后一行。怎么样,很好玩吧。
inherited CreateParams(Params);
CreateSubClass(Params, 'BUTTON');
Params.Style := Params.Style or ButtonStyles[FDefault];
// Params.Style := Params.Style or BS_RADIOBUTTON;
end;

procedure TWWButton.CreateWnd;
begin
//控件创建时被自动调用。
inherited CreateWnd;
FActive := FDefault;
end;

//下面的几个是消息方法
procedure TWWButton.CNCommand(var Message: TWMCommand);
begin
//知道为什么点击消息会去执行Click事件吗?这就是了。
//有关OOP方面的东东我就不多说了。那是好一点的书上都有的。
if Message.NotifyCode = BN_CLICKED then Click;
end;

procedure TWWButton.CMDialogKey(var Message: TCMDialogKey);
begin
//哎。。。,这个东西是个玩意呀。
//从代码看是处理会话消息,处理回车,ESC等会话消息。
//把它设置成Default后就可以执行了。可是如果不设置的话怎么会无效呢?
// ShowMessage(IntToStr(Message.CharCode));
with Message do
if (((CharCode = VK_RETURN) and FActive) or ((CharCode = VK_ESCAPE) and FCancel))
and (KeyDataToShiftState(Message.KeyData) = [])
and CanFocus
then
begin
Click;
Result := 1;
// showmessage('KEY OK');
end else
inherited;
end;

procedure TWWButton.CMDialogChar(var Message: TCMDialogChar);
begin
// IsAccel判断键盘消息 Message.CharCode 是否是 Caption 里的快捷键
with Message do
if IsAccel(CharCode, Caption) and CanFocus then
begin
Click;
Result := 1;
end else
inherited;
end;

procedure TWWButton.CMFocusChanged(var Message: TCMFocusChanged);
begin
{
为什么要判断Senter 是不是TButton呢?
with语句里我只写一个 FActive := Sender = Self;
运行起来看没什么问题呀。
}

with Message do
if Sender is TButton then
FActive := Sender = Self
else
FActive := FDefault;
SetButtonStyle(FActive);
inherited;
end;

procedure TWWButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
DefaultHandler(Message);
end;

procedure TForm1.MyOnClick(Sender : TObject);
begin
showmessage('My Test OnClick methode');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
mybtn := TWWButton.Create(application);
with mybtn do begin
OnClick := MyOnClick;
caption := '&Test it !';
parent:=form1;
// Default := True;
// setfocus;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
mybtn.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//注意看,点这个按钮后,得到焦点,并且按钮变为默认的
//再看我通过程序建立的那个按钮,得到焦点,但按钮没有变为默认的,差在什么地方了呢。
//我在建立按钮的过程中加了下面的两行,问题是解决了,可是我讨厌瞎摸索,
//有没有谁告诉我准确的解决方法?为什么系统设计期建立的东东就没这个问题呢。
//TWWButton.CMDialogKey与这个问题是否相关呢?
// Default := True;
// setfocus;
end;
 
单元文件拷贝后在窗体上放三个按钮一个编辑框就可以运行了。
其中的问题请各位同仁指正,谢了。
 
虽然是拷贝VCL的代码,不过自己瞎摸的日子--没办法呀。:(
代码研究集中在TWWButton里,其它的只是为的调试的层次更深一点。
如果有对代码更深入了解的兄弟想聊聊。我QQ 26761119。唉时常不在线中午在一会儿。
 
一个问题,当子类中的方法与父类中的方法名相同,如SetAlignment
不做override声明的话,D怎么处理。
 
》》当子类中的方法与父类中的方法名相同,如SetAlignment不做override声明的话,D怎么处理。
覆盖掉父类的方法。如果参数不同的话可以用overload。
 
哥哥们呀,我上传的代码里有很多问题呀。:--(随手找个答一下吧。:(。。。
Button 是怎么响应点击事件的呢?
在 TControl 里有个方法
procedure TControl.Click
begin
if Assigned(FOnClick) then FOnClick(Self);
end;
可是怎么就能使用户为OnClick 事件写代码后点击就去做了呢。
而且用户的代码是TButton1Click .太不明白了。求求各位高手了。
是不是太简单了还是我问得不explicity呢。
 
//WParam, LParam这两个参数的真正意义没明确
看看前缀不就知道了,WParam 是 Word 型的,LParam 是 LongWord 型的
不过要说实际意义,那可以说是有具体的消息来解释的,它说 LParam 是
什么意思就是什么意思,所以要针对具体的消息查帮助,里面会说明这两
个参数分别代表的实际意义。
 
>>>>bata
谢了, 这个我再次查书后有了点认识。
 
你根本就没有捕获到按钮的单击事件吧:)
这个 TControl.Click 是在接收到单击事件时,做完该做的事情了过后通知用户一声而已
也就是说这个 Click 的确是调用用户所写的单击响应代码用的,应该在捕获到单击事件
的时候调用它,但是问题是你根本没有调用到它:)
 
>>>>>>Beta哥, 我QQ 26761119
 
procedure TWWButton.CNCommand(var Message: TWMCommand);
begin
//知道为什么点击消息会去执行Click事件吗?这就是了。
//有关OOP方面的东东我就不多说了。那是好一点的书上都有的。
if Message.NotifyCode = BN_CLICKED then Click;
end;
的代码是不是捕捉了呢。 太不明白了。
 
//procedure TControl.Click
//begin
// if Assigned(FOnClick) then FOnClick(Self);
//end;
//可是怎么就能使用户为OnClick 事件写代码后点击就去做了呢。
用if Assigned(FOnClick) then FOnClick(Self);这种形式是因为要在设计期间做可视化服务的,
即IDE的需要。
 
别叫我哥哥,我应该比你小:)
sorry, 刚才看错了,导致理解错误:)

//procedure TControl.Click
//begin
// if Assigned(FOnClick) then FOnClick(Self);
//end;
//可是怎么就能使用户为OnClick 事件写代码后点击就去做了呢。
//而且用户的代码是TButton1Click .太不明白了。
错了,用户的代码是Button1Click,不是 TButton1Click
Button1Click 只是一个过程而已,你看看那个窗口的 .DFM 文件就知道了:

object Button1: TButton
Left = 88
Top = 56
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end

看见了吧,Delphi 自动帮我们把 Button1Click 这个过程赋给 Button1.OnClick 属性了
而这个 OnClick 属性也就对是上面的 FOnClick 进行操作的(property OnClick read FOnClick...)。
反过来一看不就清楚了:) 调用了 FOnClick,也就是调用了 OnClick,也就是调用了
Button1Click 。
 
>>>>SaveNight
>>>>用if Assigned(FOnClick) then FOnClick(Self);这种形式是因为要在设计期间做可视化服务的,
>>>>即IDE的需要。
啥意思没明白。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1161755
里面有今天更新的内容,请指点一二吧。


》》》Beta
谢了。
新帖里的说明可能就是你的意思吧, 如果看到去签个到吧。 发分:)[8D]
 
同意楼上说的,就是把把方法关联起来而已
 
接受答案了.
 
测试部件:
(1)在窗体单元中的uses 语句中加入部件单元名字。
(2)用构造方法OnCreate(Owner) ,Owner 一般是Self
(3)必须指定部件的Parent属性。(应该第一步就这样做)
parent := Self 即指为窗体。
(4)设置默认值。
 
stored 属性数据是否存储在DFM 文件中。
default 声明默认值并不是将属性设置为该值,而是在IDE中从部件面板中将部件放在
窗体上时,部件才会将设置成缺省值。
所以,设计期Default 关键字说明的属性,在动态建立时应将其显示地设置值
 
顶部