您的位置:首页 > 其它

VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作

2013-08-10 07:45 405 查看
TWinControl的构造函数中会调用MakeObjectInstance并且传递MainWndProc作为窗口消息处理函数,而MainWndProc则会调用虚函数WndProc来处理窗口消息。留个爪,对TButton的主要方法,都要仔细解读一下。

推测VCL控件组件大都应该重载TWinControl的虚函数WndProc来进行处理窗口消息的工作,举例:

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


TButtonControl = class(TWinControl)
private
FClicksDisabled: Boolean;
FWordWrap: Boolean;
function IsCheckedStored: Boolean;
procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure SetWordWrap(const Value: 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;
procedure CreateParams(var Params: TCreateParams); override;
property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
public
constructor Create(AOwner: TComponent); override;
end;

TButton = class(TButtonControl)
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 CNCtlColorBtn(var Message: TWMCtlColorBtn); message CN_CTLCOLORBTN;
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;
end;


// TButtonControl 研究

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

procedure TButtonControl.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 TButtonControl.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TButtonActionLink;
end;

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

procedure TButtonControl.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
with ThemeServices do
if ThemesEnabled then
begin
DrawParentBackground(Handle, Message.ChildDC, nil, False);
{ Return an empty brush to prevent Windows from overpainting we just have created. }
Message.Result := GetStockObject(NULL_BRUSH);
end
else
inherited;
end;

procedure TButtonControl.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
{ Under theme services the background is drawn in CN_CTLCOLORSTATIC. }
if ThemeServices.ThemesEnabled then
Message.Result := 1
else
inherited;
end;

procedure TButtonControl.CreateParams(var Params: TCreateParams);
begin
inherited;
if FWordWrap then
Params.Style := Params.Style or BS_MULTILINE;
end;

procedure TButtonControl.SetWordWrap(const Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
RecreateWnd;
end;
end;


// TButton研究

constructor TButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption, csDoubleClicks];
Width := 75;
Height := 25;
TabStop := True;
end;

procedure TButton.Click;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult;
inherited Click;
end;

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

procedure TButton.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;
if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
SendMessage(Handle, BM_SETSTYLE, Style, 1);
end;
end;

procedure TButton.SetDefault(Value: Boolean);
var
Form: TCustomForm;
begin
FDefault := Value;
if HandleAllocated then
begin
Form := GetParentForm(Self);
if Form <> nil then
Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
end;
end;

procedure TButton.CreateParams(var Params: TCreateParams);
const
ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'BUTTON');
Params.Style := Params.Style or ButtonStyles[FDefault];
end;

procedure TButton.CreateWnd;
begin
inherited CreateWnd;
FActive := FDefault;
end;

procedure TButton.CNCommand(var Message: TWMCommand);
begin
if Message.NotifyCode = BN_CLICKED then Click;
end;

procedure TButton.CMDialogKey(var Message: TCMDialogKey);
begin
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;
end else
inherited;
end;

procedure TButton.CMDialogChar(var Message: TCMDialogChar);
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus then
begin
Click;
Result := 1;
end else
inherited;
end;

procedure TButton.CMFocusChanged(var Message: TCMFocusChanged);
begin
with Message do
if Sender is TButton then
FActive := Sender = Self
else
FActive := FDefault;
SetButtonStyle(FActive);
inherited;
end;

procedure TButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if ThemeServices.ThemesEnabled then
Message.Result := 1
else
DefaultHandler(Message);
end;

procedure TButton.CNCtlColorBtn(var Message: TWMCtlColorBtn);
begin
with ThemeServices do
if ThemesEnabled then
begin
DrawParentBackground(Handle, Message.ChildDC, nil, False);
{ Return an empty brush to prevent Windows from overpainting we just have created. }
Message.Result := GetStockObject(NULL_BRUSH);
end
else
inherited;
end;


其它继承的组件:
TCustomCheckBox = class(TButtonControl)
TCheckBox = class(TCustomCheckBox)
TRadioButton = class(TButtonControl)
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐