[转载]Delphi 组件开发教程指南(8)定制特色Button

baacloud免费翻墙vpn注册使用

[转载]Delphi 组件开发教程指南(8)定制特色Button – 得闲笔记 – 博客园.

不知不觉,本系列的文章已经到了第8篇了,不知对大部分初学者是否有帮助。虽然说,本人写这些东西的仅仅是个人的兴趣所致,但是我还是希望他们能够确确实 实的帮助各个入门者,让他们少走弯路。到目前为止,还有属性编辑器没有讲解道,其他的,基本上应该都涉及到了,所以,这系列基本上也差不多接近尾声了。当 然这个没讲到的还是有很多的,比如各种各样的Windows消息,这个东西,太多,莫说我讲不全,因为很多消息,我都没真实的去理解到,Windows程 序员参考大全中就有一本是专门讲解Windows消息的作用的,书名叫《Microsoft Win32程序员参考大全(五)—-消息、结构和宏.pdf》,那个书是一定要备用的。建议各位开发者将本系列全部弄全,一共5本。所以这个消息,我 也就能捡一部分常见的说了,其他的N多N多消息,就需要咱们在实际开发中去查找资料与摸索了。

这次,我思来想去,就只有想到了这个模拟Windows系统的Button组件来讲解一部分消息,虽然针对Windows的系统消息还是九牛一毛的,但是 基本上方式都差不多的,你理解了系统的各个消息的触发时间和触发条件,那么你就可以很容易的来拦截这些消息来进行自己的处理。这次这个定制的 Button,我从TCustomControl继承下来往下面来实现,首先,我们还是先分析一下操作Button的时候的一些条件以及触发的事件。这是 显而易见的,首先,鼠标要按下弹起,就触发一次Click事件,而Button的最重要的也就是单击操作,这里有两个效果,鼠标按下的时候,一个效果,鼠 标弹起的时候一个效果,另外,当鼠标按下了之后会获得焦点,所以还有一个焦点的是否效果存在哈,这都是可操作的情况,除此之外,还会有按钮不可用的状况, 也就是说Enabled := False的状况,此时的按钮状态又要是另一个效果。通过这些简单的分析,现在我们锁定了按钮的几种效果分别是:按下效果,平常状态的效果,焦点效果,不 可用效果这4种情况。这里我是和Windows的Button比较来说,其实说起来,应该还有一个鼠标滑过效果的,这次先不讲。然后我们看看这里涉及到的 几个消息,鼠标按下弹起当然就是WM_LButtonDown,WM_LButtonUp了,然后就是看不可用变化,这个消息是经过Delphi包装之后 发送出来的消息,是CM_ENableCHANGED,用来标记变化效果,这些消息就是用来控制变化效果的。还有一个情况,上面忘记了说,就是按钮标题文 字变化时候也会触发一个消息,这个是CM_TEXTCHANGED。焦点变化的时候的焦点效果,这里有两个消息WM_KillFocus失去焦点的时候触 发,除此之外,WM_SetFocus是获得焦点的时候触发。拦截这两个消息的目的都是用来刷新绘制焦点框的。现在分析完毕,那么剩下的,就是来代码的编 写,注意,Windows的系统按钮是不可设置颜色的,我现在扩充为可设置颜色。

前面说了,要拦截鼠标按下和抬起消息,这个我们直接继承MouseDown和MouseUp消息就OK了,鼠标按下的时候,我们就需要刷新一次,鼠标弹起 MouseUP的时候刷新一次,然后还有一个事件,就是判断鼠标是否在上面,如果在按钮上面就触发Click,来触发单击事件。这里,需要说明一下这个单 击事件,不晓得我在前面有没有说过ControlStyle这个属性,这个用来指定一些组件的样式等,里面有一个csClickEvents,我们这里需 要将这个样式移除。然后再实现我们自己的Click,至于为何移除,暂留,大家思考一下原因。下面就给出一个效果,然后看看代码:

这 个asdf就是实现的一个模拟的Button控件了,现在目前是一个非常挫的效果,不过框架已经出来了,要什么效果,以后都能自己扩充绘制。现在就给出代 码,代码非常简单,里面也就仅仅是简单的实现了一下,大家自己思考思考,将Button的一些其他功能属性补全,下一期,我将介绍将本Button扩充为 QQ效果的按钮

unit DxButton; interface uses Windows,Messages,Classes,SysUtils,Controls,Graphics; type TDxButton = class(TCustomControl) private FIsDown:Boolean; FInButtonArea: Boolean; FOnClick: TNotifyEvent; protected procedure Paint;override; procedure CMTextChanged(var msg: TMessage);message CM_TEXTCHANGED; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override; procedure WMEnable(var Message: TMessage); message WM_ENABLE; procedure WMKillFocus(var msg: TWMKillFocus);message WM_KILLFOCUS; procedure WMS(var msg: TWMSetFocus);message WM_SETFOCUS; public constructor Create(AOwner: TComponent);override; procedure Click; override; published property Color; property Enabled; property Caption; property OnClick: TNotifyEvent read FOnClick write FOnClick; end; implementation procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer); procedure DoRect; var TopRight, BottomLeft: TPoint; begin with Canvas, Rect do begin TopRight.X := Right; TopRight.Y := Top; BottomLeft.X := Left; BottomLeft.Y := Bottom; Pen.Color := TopColor; PolyLine([BottomLeft, TopLeft, TopRight]); Pen.Color := BottomColor; Dec(BottomLeft.X); PolyLine([TopRight, BottomRight, BottomLeft]); end; end; begin Canvas.Pen.Width := 1; Dec(Rect.Bottom); Dec(Rect.Right); while Width > 0 do begin Dec(Width); DoRect; InflateRect(Rect, -1, -1); end; Inc(Rect.Bottom); Inc(Rect.Right); end; function GetNearColor(const Color: TColor;OffsetValue: integer): TColor; var R, G, B, dR, dG, dB: Byte; begin if (OffsetValue > 127) or (OffsetValue < -127) then raise Exception.Create('偏移值为-127-127之间') else if OffsetValue = 0 then Result := Color else begin Result := ($80 + OffsetValue) shl 24 or (ColorToRGB(Color)); R := Byte(Result shr 0); G := Byte(Result shr 8); B := Byte(Result shr 16); if OffsetValue > 0 then begin Inc(OffsetValue); dR := not R; dG := not G; dB := not B; end else begin dR := R; dG := G; dB := B; end; R := R + (dR * OffsetValue) shr 7; G := G + (dG * OffsetValue) shr 7; B := B + (dB * OffsetValue) shr 7; Result := RGB(R,G,B) end; end; { TDxButton } procedure TDxButton.Click; begin if Visible and Enabled then begin if Assigned(FOnClick) then FOnClick(Self); end; end; procedure TDxButton.CMEnabledChanged(var Message: TMessage); begin inherited; if Parent <> nil then Invalidate; end; procedure TDxButton.CMMouseEnter(var Message: TMessage); begin FInButtonArea:=True; inherited; end; procedure TDxButton.CMMouseLeave(var Message: TMessage); begin FInButtonArea:=False; inherited; end; procedure TDxButton.CMTextChanged(var msg: TMessage); begin Invalidate; end; constructor TDxButton.Create(AOwner: TComponent); begin inherited; ControlStyle := [csSetCaption, csCaptureMouse]; Width := 40; Height := 20; end; procedure TDxButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if Enabled then begin SetFocus; FIsDown:=True; Invalidate; end; end; procedure TDxButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var IsClick: Boolean; begin inherited; IsClick := FIsDown; FIsDown := False; Invalidate; if IsClick and FInButtonArea then begin Click; FIsDown:=False; end; end; procedure TDxButton.Paint; var r: TRect; begin r := ClientRect; if not FIsDown then Frame3D(Canvas,r,GetNearColor(Color,80),GetNearColor(Color,-80),1) else Frame3D(Canvas,r,GetNearColor(Color,-80),GetNearColor(Color,80),1); //然后绘制文字 if Focused then begin Canvas.Brush.Color := not Color; InflateRect(r,-1,-1); DrawFocusRect(Canvas.Handle,r) end; Canvas.Brush.Style := bsClear; Canvas.Font.Assign(Font); if not Enabled then begin OffsetRect(r, 1, 1); Canvas.Font.Color := clWhite; DrawText(Canvas.Handle, PChar(Caption), Length(Caption), r, DT_CENTER or DT_VCENTER or DT_SINGLELINE); Canvas.Font.Color := clGray; OffsetRect(r, -1, -1); end; DrawText(Canvas.Handle, PChar(Caption), Length(Caption), r, DT_CENTER or DT_VCENTER or DT_SINGLELINE); end; procedure TDxButton.WMEnable(var Message: TMessage); begin SetEnabled(Message.WParam <> 0); end; procedure TDxButton.WMKillFocus(var msg: TWMKillFocus); begin inherited; Invalidate; end; procedure TDxButton.WMS(var msg: TWMSetFocus); begin inherited; Invalidate; end; end.

Delphi 组件开发教程指南目录

作者:不得闲
本文版权归作者和博客园共有,欢迎转载,但未经作者同意必 须保留此段声明,且在文章页面明显位置给出原
文连接,否则保留追究法律责任的权利。
赞(0) 打赏
分享到: 更多 (0)

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

微信扫一扫打赏