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 .
复制代码
本文转自 不得闲 博客园博客,原文链接: http://www.cnblogs.com/DxSoft/archive/2010/05/25/1743574.html   ,如需转载请自行联系原作者
相关文章
|
1月前
|
C# Python
使用wxpython开发跨平台桌面应用,对wxpython控件实现类似C#扩展函数处理的探究
【10月更文挑战第30天】使用 `wxPython` 开发跨平台桌面应用时,可以通过创建辅助类来模拟 C# 扩展函数的功能。具体步骤包括:1. 创建辅助类 `WxWidgetHelpers`;2. 在该类中定义静态方法,如 `set_button_color`;3. 在应用中调用这些方法。这种方法提高了代码的可读性和可维护性,无需修改 `wxPython` 库即可为控件添加自定义功能。但需要注意显式调用方法和避免命名冲突。
|
7月前
qt 开发 “控件之家“
qt 开发 “控件之家“
|
7月前
|
容器
【鸿蒙软件开发】ArkTS常用组件之Button
【鸿蒙软件开发】ArkTS常用组件之Button
1274 0
|
7月前
|
XML Java 数据格式
Anrodi Studio App开发入门之网格视图GridView的使用及实战(附源码 超详细必看)
Anrodi Studio App开发入门之网格视图GridView的使用及实战(附源码 超详细必看)
100 0
|
Windows
[UWP开发]NavigationView基础使用方法
原文:[UWP开发]NavigationView基础使用方法 [UWP开发]NavigationView基础使用方法 NavigationView是秋季创意者更新(16299)引入的新控件,用于生成Windows特色的导航栏。
2333 0
UWP入门(一) -- 先写几个简单控件简单熟悉下(别看这个)
原文:UWP入门(一) -- 先写几个简单控件简单熟悉下(别看这个) 1. MainPage.xmal ...
1194 0

热门文章

最新文章