在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
unit BmpBtn;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom); TDesignType = (dtMenu, dtButton);
TBmpButton = class(TGraphicControl) private MOver: TBitmap; MDown: TBitmap; MUp: TBitmap; Bmp: TBitmap; ActualBmp: TBitmap; BmpDAble: TBitmap; // 禁用状态图像 FGlyph: TIcon; //FTransparentGlyph: Boolean; FTransparentBmp: Boolean; FLayout: TButtonLayout; FSpacing: integer; FDesignType: TDesignType; //用于菜单还是按钮 //FColorText: TColor; BtnClick: TNotifyEvent; OnMDown: TMouseEvent; OnMUp: TMouseEvent; OnMEnter: TNotifyEvent; OnMLeave: TNotifyEvent; procedure SetMOver(Value: TBitmap); procedure SetMDown(Value: TBitmap); procedure SetMUp(Value: TBitmap); procedure SetBmp(Value: TBitmap); procedure SetBmpDAble(Value: TBitmap); procedure SetGlyph(Value: TIcon); // procedure SetLayout(Value: TButtonLayout); //procedure SetTransparentGlyph(Value: Boolean); procedure SetTransparentBmp(Value: Boolean); procedure SetSpacing(Value: Integer); // procedure SetColors(Value: TColor); procedure SetDesignType(Value: TDesignType); protected procedure Paint; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure TextChanged (var msg: TMessage); message CM_TEXTCHANGED; procedure Click; override; public constructor Create(AOwner: TComponent); override; published property BitmapOver: TBitmap read MOver write SetMOver; property BitmapDown: TBitmap read MDown write SetMDown; property BitmapUp: TBitmap read MUp write SetMUp; property BitmapDisabled: TBitmap read BmpDAble write SetBmpDAble; property Bitmap: TBitmap read Bmp write SetBmp; property Glyph: TIcon read FGlyph write SetGlyph; //加入图标属性 property Layout: TButtonLayout read FLayout write SetLayout; //加入布局属性 //property TransparentGlyph: Boolean read FTransparentGlyph write SetTransparentGlyph; //加入透明度属性(去否去掩码,针对小图标) property TransparentBmp: Boolean read FTransparentBmp write SetTransparentBmp; //加入透明度属性(去否去掩码,针对背景图像) property Spacing: integer read FSpacing write SetSpacing; //加入图标和文字的间距属性 property Font; //加入文字属性 property Caption; //加入文字 // property ColorText: TColor read FColorText write SetColors; //文字颜色 property DesignType: TDesignType read FDesignType write SetDesignType; //指定设计类型 property OnClick: TNotifyEvent read BtnClick write BtnClick; property OnMouseDown: TMouseEvent read OnMDown write OnMDown; property OnMouseUp: TMouseEvent read OnMUp write OnMUp; property OnMouseEnter: TNotifyEvent read OnMEnter write OnMEnter; property OnMouseLeave: TNotifyEvent read OnMLeave write OnMLeave; property Enabled; property ShowHint; property ParentShowHint; property ParentFont; property Visible; end;
procedure Register;
implementation
procedure Register; begin RegisterComponents('SkinsDesign', [TBmpButton]); end;
{ TImageButton }
constructor TBmpButton.Create(AOwner: TComponent); begin inherited Create(AOwner); MOver := TBitmap.Create; MDown := TBitmap.Create; MUp := TBitmap.Create; Bmp := TBitmap.Create; BmpDAble := TBitmap.Create; ActualBmp := TBitmap.Create;
FGlyph := TIcon.Create; //TransparentGlyph := True; FSpacing := 4; //FColorText := clBlack;
Width := 75; Height := 25; Canvas.Brush.Color := clBtnFace; ShowHint := true; end;
procedure TBmpButton.Paint; var TempBmp: TBitMap; CaptionRect: TRect; GlyphLeft, GlyphTop, TextTop, TextLeft, TextWidth, TextHeight: integer; //TextColor: TColor; begin inherited Paint;
TempBmp := TBitMap.Create; TempBmp.Width := Width; TempBmp.Height := Height; TempBmp.TransparentColor:= clFuchsia; TempBmp.Transparent := FTransparentBmp;
if ActualBmp.Width = 0 then ActualBmp.Assign(Bmp); TempBmp.Canvas.FillRect(Rect(0,0,Width,Height)); if Enabled or (BmpDAble.Width = 0) then TempBmp.Canvas.Draw(0,0,ActualBmp) else begin Width := BmpDAble.Width; Height := BmpDAble.Height; TempBmp.Canvas.Draw(0,0,BmpDAble); end;
TempBmp.Canvas.Font := Font; TextWidth := TempBmp.Canvas.TextWidth(Caption); TextHeight := TempBmp.Canvas.TextHeight(Caption); TextTop := (Height - TextHeight) div 2; TextLeft := (Width - TextWidth) div 2;
if not Glyph.Empty then begin GlyphLeft:= 0; case FLayout of blGlyphLeft: begin GlyphTop:= (Height - FGlyph.Height) div 2; GlyphLeft:= TextLeft - FGlyph.Width div 2; inc(TextLeft, FGlyph.Width div 2); if not (Caption = '') then begin GlyphLeft:= GlyphLeft - FSpacing div 2 - FSpacing mod 2; inc(TextLeft, FSpacing div 2); end; end;
blGlyphRight: begin GlyphTop:= (Height - FGlyph.Height) div 2; GlyphLeft:= TextLeft + TextWidth - FGlyph.Width div 2; inc(TextLeft, - FGlyph.Width div 2); if not (Caption = '') then begin GlyphLeft:= GlyphLeft + FSpacing div 2 + FSpacing mod 2; inc(TextLeft, - FSpacing div 2); end; end;
blGlyphTop: begin GlyphLeft:= (Width - FGlyph.Width) div 2; GlyphTop:= TextTop - FGlyph.Height div 2 - FGlyph.Height mod 2; inc(TextTop, FGlyph.Height div 2); if not (Caption = '') then begin GlyphTop:= GlyphTop - FSpacing div 2 - FSpacing mod 2; inc(TextTop, + FSpacing div 2); end; end;
blGlyphBottom: begin GlyphLeft:= (Width - FGlyph.Width) div 2; GlyphTop:= TextTop + TextHeight - Glyph.Height div 2; inc(TextTop, - FGlyph.Height div 2); if not (Caption = '') then begin GlyphTop:= GlyphTop + FSpacing div 2 + FSpacing mod 2; inc(TextTop, - FSpacing div 2); end; end; end; end;
{if FBtnState = bsDown then begin inc(GlyphTop, 1); inc(GlyphLeft, 1); end; }
//FGlyph.TransparentColor:= FGlyph.Canvas.Pixels[0, 0]; //FGlyph.Transparent:= FTransparentGlyph;
TempBmp.Canvas.Draw(GlyphLeft, GlyphTop, FGlyph);
with CaptionRect do begin Top:= TextTop; Left:=TextLeft; Right:= Left + TextWidth; Bottom:= Top + TextHeight; end;
if Caption <> '' then begin TempBmp.Canvas.Brush.Style:= bsClear; DrawText(TempBmp.Canvas.Handle, PChar(Caption), length(Caption), CaptionRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP); end;
Canvas.Draw(0, 0, TempBmp); TempBmp.Free; end;
procedure TBmpButton.Click; begin inherited Click; Paint; if Enabled then if Assigned(BtnClick) then BtnClick(Self); end;
procedure TBmpButton.SetMOver(Value: TBitmap); begin MOver.Assign(Value); Paint; end;
procedure TBmpButton.SetMDown(Value: TBitmap); begin MDown.Assign(Value); Paint; end;
procedure TBmpButton.SetMUp(Value: TBitmap); begin MUp.Assign(Value); Paint; end;
procedure TBmpButton.SetBmp(Value: TBitmap); begin Bmp.Assign(Value); ActualBmp.Assign(Value); Width := Bmp.Width; Height := Bmp.Height; Paint; end;
procedure TBmpButton.SetBmpDAble(Value: TBitmap); begin BmpDAble.Assign(Value); paint; end;
procedure TBmpButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if (Button = mbLeft) and Enabled then begin if Assigned (OnMDown) then OnMDown(Self, Button, Shift, X, Y); if MDown.Width > 0 then begin ActualBmp.Assign(MDown); Width := MDown.Width; Height := MDown.Height; Paint; end; end; end;
procedure TBmpButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //var MouseOverButton: Boolean; // P: TPoint; begin Case FDesignType of dtMenu: begin ActualBmp.Assign(MDown); Paint; end; dtButton: begin inherited MouseUp(Button, Shift, X, Y); end; end; //if (x>0) and (y>0) and (x<width) and (y<height) then
{if (Button = mbLeft) and Enabled then begin if Assigned (OnMUp) then OnMUp(Self, Button, Shift, X, Y); if MUp.Width > 0 then begin GetCursorPos(P); MouseOverButton := (FindDragTarget(P, True) = Self); if MouseOverButton then begin Width := MUp.Width; Height := MUp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,MUp); end else begin Width := bmp.Width; Height := Bmp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,Bmp); end; end else begin if MouseOverButton = false then begin Width := MOver.Width; Height := MOver.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,MOver); end else begin Width := bmp.Width; Height := Bmp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,Bmp); end; end; end; } end;
procedure TBmpButton.MouseEnter(var Message: TMessage); begin if Enabled then begin if MOver.Width > 0 then begin ActualBmp.Assign(MOver); Width := MOver.Width; Height := MOver.Height; Paint; end; end; end;
procedure TBmpButton.MouseLeave(var Message: TMessage); begin Case FDesignType of dtMenu: begin Exit; end; dtButton: begin if Enabled then begin if Bmp.Width > 0 then begin ActualBmp.Assign(Bmp); Width := Bmp.Width; Height := Bmp.Height; Paint; end; end; end; end; end;
procedure TBmpButton.SetGlyph(Value: TIcon); begin FGlyph.Assign(Value); Invalidate; end;
procedure TBmpButton.SetLayout(Value: TButtonLayout); begin FLayout:= Value; Invalidate; end;
{procedure TBmpButton.SetTransparentGlyph(Value: Boolean); begin FTransparentGlyph:= Value; Invalidate; end; }
procedure TBmpButton.SetSpacing(Value: Integer); begin FSpacing:= Value; Invalidate; end;
{procedure TBmpButton.SetColors(Value: TColor); begin FColorText := Value; Paint; end; }
procedure TBmpButton.TextChanged(var msg: TMessage); begin Invalidate; end;
procedure TBmpButton.SetDesignType(Value: TDesignType); begin FDesignType := Value; Invalidate; end;
procedure TBmpButton.SetTransparentBmp(Value: Boolean); begin FTransparentBmp:= Value; Invalidate; end;
end.
http://blog.csdn.net/zang141588761/article/details/52287872 |
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论