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
.