我的源代码(已经上传到了www.playicq.com)
{-----------------------------------------------------------------------------
Unit Name: mybutton
Author: donkey
mailto: liaojb@21cn.com
Purpose: 一个自画的按钮,有picture和picturedown属性,分别用于显示按钮的常态
和按下状态,可以自行扩展其他的Picture属性以适应更多的状态
本代码仅用于示例,要实用还需加上一些代码,例如透明
History: 2002-6-14
-----------------------------------------------------------------------------}
unit mybutton;
interface
uses Messages, Windows, SysUtils, Controls, Forms, Classes, Menus, Graphics,
StdCtrls, ActnList;
type
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
TMyButton = class(TButtonControl)
private
FAlignment: TLeftRight;
FChecked: Boolean;
FPicture: TPicture;
FPictureDown: TPicture;
FCanvas: TCanvas;
FClickDown: Boolean;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure SetPicture(Value: TPicture);
procedure SetPictureDown(Value: TPicture);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Action;
property Anchors;
property BiDiMode;
property Caption;
property Checked;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property Picture: TPicture read FPicture write SetPicture;
property PictureDown: TPicture read FPictureDown write SetPictureDown;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
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;
procedure Register;
implementation
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
FPicture := TPicture.Create;
FPictureDown := TPicture.Create;
Width := 113;
Height := 17;
ControlStyle := [csSetCaption, csDoubleClicks, csOpaque];
FAlignment := taRightJustify;
FClickDown := false;
Invalidate;
end;
destructor TMyButton.Destroy;
begin
inherited Destroy;
FCanvas.free;
FPicture.Free;
FPictureDown.Free;
end;
procedure TMyButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;
procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
begin
DrawItem(Message.DrawItemStruct^);
end;
procedure TMyButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDown: Boolean;
R: TRect;
//这是对图像进行透明处理用的内存bitmap,但是目前还没有加上透明处理代码
BufCanvas: TBitmap;
begin
R := ClientRect;
FCanvas.Handle := DrawItemStruct.hDC;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
end;
//打开这两句总是有效的
// FCanvas.Brush.Color := Color;
// FCanvas.FillRect (R);
//如果打开下面的这句注释,点击时会出现有时无法显示roundRect的效果的现象
// FCanvas.RoundRect (R.Left ,R.Top ,R.Right ,R.Bottom ,5,5);
try
BufCanvas := TBitmap.Create;
//在没有指定状态图像之前,我想让它显示出来,
// 但是下面这段代码没有达到应有的效果
if (csDesigning in ComponentState)or(csReading in ComponentState)or
(csLoading in ComponentState) then
begin
R:=BoundsRect ;
FCanvas.Pen.Color := clRed;
FCanvas.Brush.Color := clRed;
FCanvas.Brush.Style := bsSolid ;
FCanvas.FillRect(R);
end;
if isdown then
begin
//这下面三句是对图像进行透明处理的代码,打开会有效果,但是快速点击时会出现闪烁
//现象,看来还是要用缓冲的办法
// FPictureDown.Bitmap.Transparent := true;
// FPictureDown.Bitmap.TransparentColor := FPictureDown.Bitmap.Canvas.Pixels[0,0];
// FCanvas.StretchDraw(R, FPictureDown.Bitmap);
FCanvas.CopyMode := cmSrcCopy ;
R.Left := 0;
R.Right := FPictureDown.Bitmap.Width;
R.Top :=0;
R.Bottom := FPictureDown.Bitmap.Height ;
//使用下面的两句显示图像就不会出现闪烁了,直觉上两句的速度一样快,
//所以使用其中的一句就可以了
//FCanvas.CopyRect (R,FPictureDown.Bitmap.Canvas,R);
BitBlt(Fcanvas.Handle,R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,
FPictureDown.Bitmap.Canvas.Handle,0,0,SRCCOPY);
end
else
// FCanvas.TextOut(R.Left +2,R.Top +2,Caption);
begin
// FPicture.Bitmap.Transparent := true;
// Picture.Bitmap.TransparentColor := FPicture.Bitmap.Canvas.Pixels[0,0];
// FCanvas.StretchDraw(R, FPicture.Bitmap );
R.Left := 0;
R.Right := FPicture.Bitmap.Width;
R.Top :=0;
R.Bottom := FPicture.Bitmap.Height ;
// FCanvas.CopyRect (R,FPicture.Bitmap.Canvas,R);
BitBlt(Fcanvas.Handle,R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,
FPicture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
end;
finally
BufCanvas.Free;
end;
end;
procedure TMyButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TMyButton.SetPicture(Value: TPicture);
Var
R:TRect;
begin
FPicture.Assign(Value);
//我想根据图像大小调整按钮的大小,但是下面这一段代码在运行期没有没有任何效果,
//仅仅在设计期有效,我不知道为什么?
Height := FPicture.Bitmap.Height ;
Width := FPicture.Bitmap.Width ;
SetBounds(Left,Top,FPicture.Bitmap.Width,FPicture.Bitmap.Height);
R.Left := left;
R.Top := Top ;
R.Right := left+ FPicture.Bitmap.Width ;
R.Bottom := Top+ FPicture.Bitmap.Height ;
BoundsRect := R;
UpdateBoundsRect(R);
Invalidate;
end;
procedure TMyButton.SetPictureDown(Value: TPicture);
begin
FPictureDown.Assign(Value);
end;
procedure TMyButton.CreateParams(var Params: TCreateParams);
const
Alignments: array[Boolean, TLeftRight] of DWORD =
((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'BUTTON');
with Params do
//在这里创建一个自画的按钮,这样不用从TWincontrol继承下来,再重写很多事件,属性
//之类的东西,仅仅重载几个必要的东东就可以了,省了很多事
//我不明白为什么很多按钮的作者要从TWincontrol继承下来,再加上自己的画表面代码,
//控制代码等等,使事情复杂,而且可重用性很差
//我想根据图像的形状控制按钮的Region,但是不知道把代码加在哪里,不过我认为不会
//是在这里
Style := Style or BS_OWNERDRAW or //BS_RADIOBUTTON or
//改变这里的参数会变换界面
Alignments[UseRightToLeftAlignment, FAlignment];
end;
procedure TMyButton.CNCommand(var Message: TWMCommand);
begin
inherited;
if Message.NotifyCode = BN_CLICKED then Click;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyButton]);
end;
end.