Delphi皮肤之 - 图片按钮

效果如图，支持普通、移上去、按下、弹起、禁用5种状态。

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.