imagebtn.pas

DbAnyWhere开发套件

unit ImageBtn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,ExtDlgs,RsgImageList;

type
  TImageBtn = class(TImage)
  private
    { Private declarations }
    Down: Boolean;
    {FOverPict: TPicture;
    FDownPict: TPicture;
    FUpPict:   TPicture;
    FDisPict:  TPicture; }
    FRsgImagelist:TrsgImageList;
    FEnabled: Boolean;
    captionstr:string;
    FFont:TFont;
    //FCaptionLeft:integer;
    //FCaptionTop:integer;
    procedure SetEnable(Value: Boolean);
    procedure setimagelist(Value:TrsgimageList);
    procedure Setcaption(Value: string);
    procedure paintcaption(str:string);
    procedure setFont(value:Tfont);
    //procedure setleft(value:integer);
    //procedure settop(value:integer);
  public
    { Public declarations }
    destructor Destroy; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    constructor Create(AOwner: TComponent); override;      
  published
    { Published declarations }
    property RsgImageList: TrsgImageList read FRsgImagelist write Setimagelist;
    property picEnabled: Boolean read FEnabled write SetEnable;
    property picCaption: string read captionstr write Setcaption;
    property Font: TFont read Ffont write Setfont;
    //property CaptionLeft:integer read FCaptionLeft write setleft;
    //property CaptionTop:integer read FCaptiontop write settop;
  end;

procedure Register;

implementation
 
procedure Register;
begin
  RegisterComponents('DbAnyWhere', [TImageBtn]);
end;
procedure TImageBtn.setFont(value:Tfont);
begin
  FFont.Assign(value);
  if self.FRsgImagelist<>nil then
     Picture:=self.FRsgImagelist.picup;
  paintcaption(captionstr);
end;
procedure TImageBtn.SetEnable(Value: Boolean);
begin
 if self.FRsgImagelist=nil then exit;
 if Value = True then
  Picture:=self.FRsgImagelist.picup
 else Picture:=self.FRsgImagelist.picdis;
 FEnabled:=Value;
end;
procedure TImageBtn.Setcaption(Value: string);
begin
  captionstr:=value;
  if self.FRsgImagelist<>nil then
     Picture:=self.FRsgImagelist.picup;
  paintcaption(captionstr);
end;
{procedure Timagebtn.setleft(value:integer);
begin
  fcaptionleft:=value;
  self.Setcaption(self.picCaption);
end;
procedure Timagebtn.settop(value:integer);
begin
  fcaptiontop:=value;
  self.Setcaption(self.picCaption);
end;  }
procedure Timagebtn.paintcaption(str:string);
var
   xl,yl:integer;
begin
  if self.FRsgImagelist=nil then exit;
  canvas.Brush.Style:=bsclear;
  canvas.Font.Assign(Ffont);
  xl:=round((width-canvas.TextWidth(captionstr))/2);
  yl:=round((height-canvas.Textheight(captionstr))/2);
  canvas.Textout(xl,yl,captionstr);
end;
constructor TImageBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  autosize:=true;
  FEnabled:=true;
  Down:= False;
  Ffont:=Tfont.Create;
  picture:=nil;
  if self.FRsgImagelist<>nil then Picture:=self.FRsgImagelist.picup;
end;
procedure TImageBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
 if self.FRsgImagelist=nil then exit;
 inherited;
 if FEnabled=True then
 if not Down then
 begin
  if (X<0)or(X>Width)or(Y<0)or(Y>Height) then
   begin
    SetCaptureControl(nil);
    Picture:=self.FRsgImagelist.picup;
   end  else
   begin
    SetCaptureControl(Self);
    Picture:=self.FRsgImagelist.picover;
   end;
  end;
  paintcaption(captionstr);
end;

procedure TImageBtn.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  if self.FRsgImagelist=nil then exit;
  if (Button=mbLeft)and(FEnabled=True) then
  begin
    Picture:=self.FRsgImagelist.picdown;
    Down:=True;
  end;
 inherited MouseDown(Button, Shift, X, Y);
 paintcaption(captionstr);
end;

procedure TImageBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
     X, Y: Integer);
begin
 if self.FRsgImagelist=nil then exit;
 if (Button=mbLeft)and(Enabled=True) then
  begin
   Picture:=self.FRsgImagelist.picup;
   SetCaptureControl(nil);
  end;
 inherited  MouseUp(Button, Shift, X, Y);
 Down:=False;
 paintcaption(captionstr);
end;
procedure TImageBtn.setimagelist(Value:TrsgimageList);
begin
  FrsgImageList:=value;
  Picture:=self.FRsgImagelist.picup;
  paintcaption(captionstr);
end;
destructor TImageBtn.Destroy;
begin
  inherited Destroy;
end;

end.