vkbmpbutton.pas

Delphi7的一个支持位图的控件源码.将位图切成4份.

//==============================================================================
//◆-公司名称: IN-NET Cor.
//◆-单元名称: VkBmpButton.pas
//◆-单元作用: Viking做的支持鼠标移入和鼠标移出以及鼠标按下,鼠标弹出时变化图片的按钮
//◆-作者姓名: Viking.Liu
//◆-注意事项:
//==============================================================================
unit VkBmpButton;

interface
uses
   SysUtils, Classes, Controls, Graphics, Types, Messages, ExtCtrls, Buttons;


//鼠标事件
type
  TVkBmpButton = class(TCustomControl)
  private
    FBitmap: TBitmap;
    FMaskColor: TColor;

    FNormalIndex: Integer;
    FHighLightIndex: Integer;
    FDownIndex: Integer;
    FDisableIndex: Integer;
    FGraphicNums: Integer;
    FTransparent: Boolean;
    FStatus: Integer;
    FProgress: Integer;
    FData: TObject;

    procedure SetNormalIndex(const Value: Integer);
    procedure SetHighLightIndex(const Value: Integer);
    procedure SetDownIndex(const Value: Integer);
    procedure SetDisableIndex(const Value: Integer);
    procedure SetGraphicNums(const Value: Integer);
    procedure SetBitmap(const Value: TBitmap);
    procedure SetMaskColor(const Value: TColor);
    procedure SetTransparent(const Value: Boolean);
    procedure SetStatus(const Value: Integer);
    procedure SetProgress(const Value: Integer);
    procedure SetData(const Value: TObject);

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  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 DrawBtn(ImageIndex: Integer);
    procedure ResizeMe;
    procedure OnBitmapChanged(Sender: TObject);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property MaskColor: TColor read FMaskColor write SetMaskColor default clWhite;

    property NormalIndex: Integer read FNormalIndex write SetNormalIndex default 0;
    property HighLightIndex: Integer read FHighLightIndex write SetHighLightIndex default 3;
    property DownIndex: Integer read FDownIndex write SetDownIndex default 1;
    property DisableIndex: Integer read FDisableIndex write SetDisableIndex default 2;
    property GraphicNums: Integer read FGraphicNums write SetGraphicNums default 1;
    property Transparent: Boolean read FTransparent write SetTransparent;
    property Status: Integer read FStatus write SetStatus;
    property Progress: Integer read FProgress write SetProgress;
    property Data: TObject read FData write SetData;

    property OnClick;
    property OnDblClick;
    property Anchors;
    property Visible;
    property ShowHint;
  end;


  TImgButton = class(TGraphicControl)
  private
    FHighLightIndex: Integer;
    FNormalIndex: Integer;
    FGraphicNums: Integer;
    FDisableIndex: Integer;
    FDownIndex: Integer;
    FBitmap: TBitmap;
    FMaskColor: TColor;
    procedure SetBitmap(const Value: TBitmap);
    procedure SetDisableIndex(const Value: Integer);
    procedure SetDownIndex(const Value: Integer);
    procedure SetGraphicNums(const Value: Integer);
    procedure SetHighLightIndex(const Value: Integer);
    procedure SetNormalIndex(const Value: Integer);
    procedure SetMaskColor(const Value: TColor);

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  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 DrawBtn(ImageIndex: Integer);
    procedure ResizeMe;

    procedure OnBitmapChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property GraphicNums: Integer read FGraphicNums write SetGraphicNums default 1;
    property NormalIndex: Integer read FNormalIndex write SetNormalIndex default 0;
    property HighLightIndex: Integer read FHighLightIndex write SetHighLightIndex default 3;
    property DownIndex: Integer read FDownIndex write SetDownIndex default 1;
    property DisableIndex: Integer read FDisableIndex write SetDisableIndex default 2;
    property MaskColor: TColor read FMaskColor write SetMaskColor default clWhite;

    property OnClick;
    property Anchors;
  end;


  TImgMovie = class(TGraphicControl)
  private
    FActived: Boolean;
    FGraphicNums: Integer;
    FBitmap: TBitmap;
    FMaskColor: TColor;
    FTimer: TTimer;
    FIndex: Integer;

    procedure SetActived(const Value: Boolean);
    procedure SetBitmap(const Value: TBitmap);
    procedure SetGraphicNums(const Value: Integer);
    procedure SetMaskColor(const Value: TColor);
    procedure SetInterval(const Value: Cardinal);
    function GetInterval: Cardinal;

  protected
    procedure OnTimer(Sender: TObject);
    procedure OnBitmapChanged(Sender: TObject);

    procedure Paint; override;
    procedure DrawImage;
    procedure ResizeMe;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property GraphicNums: Integer read FGraphicNums write SetGraphicNums default 1;
    property MaskColor: TColor read FMaskColor write SetMaskColor default clWhite;
    property Actived: Boolean read FActived write SetActived default false;
    property Interval: Cardinal read GetInterval write SetInterval default 300;
    property Visible;
    property Anchors;
    property Parent;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('VkCtrl', [TVkBmpButton, TImgButton, TImgMovie]);
end;

{ TVkBmpButton }

procedure TVkBmpButton.CMMouseEnter(var Message: TMessage);
begin
  if (not FBitmap.Empty) and (FGraphicNums > 0) then
  begin
    if MouseCapture then
    begin
      if (FDownIndex >= 0) and (FDownIndex < FGraphicNums) then
      begin
        DrawBtn(FDownIndex);
        //Repaint();
      end;
    end else
    begin
      if (FHighLightIndex >= 0) and (FHighLightIndex < FGraphicNums) then
      begin
        DrawBtn(FHighLightIndex);
        //Repaint();
      end;
    end;
  end;

  inherited;
end;

procedure TVkBmpButton.CMMouseLeave(var Message: TMessage);
begin
  if (not FBitmap.Empty) and (FGraphicNums > 0)
    and (FHighLightIndex >= 0) and (FHighLightIndex < FGraphicNums) then
  begin
    DrawBtn(FNormalIndex);
    Repaint();
  end;

  inherited;
end;

constructor TVkBmpButton.Create(AOwner: TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.OnChange := OnBitmapChanged;
  FMaskColor := clWhite;
  FGraphicNums := 1;

  FNormalIndex := 0;
  FDownIndex := 1;
  FDisableIndex := 2;
  FHighLightIndex := 3;
end;

destructor TVkBmpButton.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TVkBmpButton.DrawBtn(ImageIndex: Integer);
var
  R: TRect;
begin
  if (ImageIndex >= FGraphicNums) or (ImageIndex < 0) then ImageIndex := FNormalIndex;

  R.Left := ImageIndex * Width;
  R.Top := 0;
  R.Right := R.Left + Width;
  R.Bottom := Height;

  FBitmap.Transparent := true;
  //FBitmap.TransparentColor := FBitmap.Canvas.Pixels[0, 0];
  //FBitmap.TransparentColor := cl;

  Canvas.Brush.Style := bsClear;
  Canvas.BrushCopy(ClientRect, FBitmap, R, FMaskColor);
  //Canvas.StretchDraw(ClientRect, FBitmap);
end;

procedure TVkBmpButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  if (Button = mbLeft) and (not FBitmap.Empty) and (FGraphicNums > 0)
    and (FDownIndex >= 0) and (FDownIndex < FGraphicNums) then
    DrawBtn(FDownIndex);
end;

procedure TVkBmpButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  if (Button = mbLeft) and (not FBitmap.Empty) and (FGraphicNums > 0) then
  begin
    if (PtInRect(ClientRect, Point(X, Y))) then
      DrawBtn(FHighLightIndex)
    else
      DrawBtn(FNormalIndex);
  end;
end;

procedure TVkBmpButton.OnBitmapChanged(Sender: TObject);
begin
  ResizeMe;
end;

procedure TVkBmpButton.Paint;
begin
  if Enabled then DrawBtn(NormalIndex)
  else DrawBtn(DisableIndex);
end;

procedure TVkBmpButton.ResizeMe;
begin
  if (FBitmap.Empty) or (FGraphicNums <= 0) then
  begin
    Width := 75;
    Height := 25;
  end else
  begin
    Width := FBitmap.Width div FGraphicNums;
    Height := FBitmap.Height;
  end;

  //Repaint;
end;

procedure TVkBmpButton.SetBitmap(const Value: TBitmap);
begin
  FBitmap.Assign(Value);
  Repaint;
  Invalidate;
end;

procedure TVkBmpButton.SetDisableIndex(const Value: Integer);
begin
  if FDisableIndex <> Value then
  begin
    FDisableIndex := Value;
    Invalidate;
  end;
end;

procedure TVkBmpButton.SetDownIndex(const Value: Integer);
begin
  if FDownIndex <> Value then
  begin
    FDownIndex := Value;
    Invalidate;
  end;
end;

procedure TVkBmpButton.SetGraphicNums(const Value: Integer);
begin
  if FGraphicNums <> Value then
  begin
    FGraphicNums := Value;
    ResizeMe;
    Invalidate;
  end;
end;

procedure TVkBmpButton.SetHighLightIndex(const Value: Integer);
begin
  if FHighLightIndex <> Value then
  begin
    FHighLightIndex := Value;