{SuperButton - Komponente für Delphi 2-4
 dies ist nur eine Test - Komponente
 by Dipl.-Ing. Thomas Speiser Copyright MMIX

 KKTU Comp [SuperButton]
 Version 1.1 Graphische Picture - Button}

unit SuperButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSuperButton = class(TGraphicControl)
  private
      FFirst, FSecond: TBitmap;
      FMouseInControl, FTransparent, FAutoSize: Boolean;
      X_Pos, Y_Pos: integer;
      R: TRect;
      FHottrackColor: TColor;
      procedure SetFirst(Value: TBitmap);
      procedure SetSecond(Value: TBitmap);
      procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
      procedure UpdateTracking;
      procedure SetTransparent(Value: Boolean);
      procedure SetHottrackColor(Value: TColor);
    { Private declarations }
  protected
      procedure Paint; override;
      procedure SetAutoSize(Value: Boolean); virtual;
      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;
      procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    { Protected declarations }
  public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure Click; override;
    { Public declarations }
  published
      property Align;
      property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
      property Color;
      property Caption;
      property HotTrackColor: TColor read FHottrackColor write SetHottrackColor;
      property FirstBitmap: TBitmap read FFirst write SetFirst;
      property SecondBitmap: TBitmap read FSecond write SetSecond;
      property Font;
      property ShowHint;
      property Transparent: Boolean read FTransparent write SetTransparent default False;
      property Visible;
      property OnClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('KKTU Comp', [TSuperButton]);
end;

constructor TSuperButton.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption];
   SetBounds(0, 0, 76, 17);
   FAutoSize := False;
   Color:=clBtnFace;
   FHottrackColor:=clwhite;
   FFirst := TBitmap.Create;
   FSecond := TBitmap.Create;
   ShowHint := True;
end;

destructor TSuperButton.Destroy;
begin
   FFirst.Free;
   FSecond.Free;
   inherited Destroy;
end;

procedure TSuperButton.SetFirst(Value: TBitmap);
begin
  FFirst.Assign(Value);
  Paint;
end;

procedure TSuperButton.SetSecond(Value: TBitmap);
begin
  FSecond.Assign(Value);
  Paint;
end;

procedure TSuperButton.Paint;
begin
 if Enabled then begin
 R := Rect(0, 0, Width, Height);
 Canvas.Font.Assign(Font);
 Canvas.Brush.Color:=Color;
 Canvas.Brush.Style:= bsSolid;
 Canvas.FillRect(R);
 FFirst.Transparent:=FTransparent;

 if FFirst.Empty = false then begin
 X_Pos := (Width - FFirst.Width) div 2;
 Y_Pos := (Height - FFirst.Height) div 2;
 Canvas.Draw(X_Pos,X_Pos,FFirst); end;

{Transparente Schrift}
  Canvas.Brush.Style := bsClear;

{Position justieren}
  X_Pos := (Width - Canvas.TextWidth(Caption)) div 2;
  Y_Pos := (Height - Canvas.TextHeight(Caption)) div 2;
  Canvas.Font.Color:=Font.Color;
  Canvas.TextOut(X_Pos,Y_Pos,Caption); end;
  FMouseInControl:= True;
end;

procedure TSuperButton.UpdateTracking;
begin
 if (Enabled) and (FMouseInControl) then begin
  Canvas.Font.Color:=FHottrackColor;
  Canvas.TextOut(X_Pos,Y_Pos,Caption); FMouseInControl:=False; end;
end;

procedure TSuperButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TSuperButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
 inherited MouseDown(Button, Shift, X, Y);
 if (Button = mbLeft) and (Enabled) then begin
 Canvas.Font.Assign(Font);
 Canvas.Brush.Color:=Color;
 Canvas.Brush.Style:= bsSolid;
 Canvas.FillRect(R);
 FFirst.Transparent:=FTransparent;
 FSecond.Transparent:=FTransparent;

 if FSecond.Empty then begin
 X_Pos := (Width - FFirst.Width) div 2;
 Y_Pos := (Height - FFirst.Height) div 2;
 Canvas.Draw(X_Pos+1,Y_Pos+1,FFirst) end
 else begin
 X_Pos := (Width - FSecond.Width) div 2;
 Y_Pos := (Height - FSecond.Height) div 2;
 Canvas.Draw(X_Pos+1,Y_Pos+1,FSecond); end;

{Transparente Schrift}
  Canvas.Brush.Style := bsClear;

{Position justieren}
  X_Pos := (Width - Canvas.TextWidth(Caption)) div 2;
  Y_Pos := (Height - Canvas.TextHeight(Caption)) div 2;
  Canvas.Font.Color:=FHottrackColor;
  Canvas.TextOut(X_Pos+1,Y_Pos+1,Caption); end;
end;

procedure TSuperButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
    UpdateTracking;
end;

procedure TSuperButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  Paint;
  FMouseInControl:=(X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
  UpdateTracking;
  DoClick := FMouseInControl;
  if DoClick then Click;
end;

procedure TSuperButton.Click;
begin
  inherited Click;
end;

procedure TSuperButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FMouseInControl:=True;
  Paint;
end;

procedure TSuperButton.SetTransparent(Value: Boolean);
begin
 FTransparent:=Value;
 FFirst.Transparent:=FTransparent;
 Paint;
end;

procedure TSuperButton.SetAutoSize(Value: Boolean);
begin
FAutoSize:= Value;
if FAutoSize then
if FFirst.Empty = False then SetBounds(Left, Top, FFirst.Width,FFirst.Height)
end;

procedure TSuperButton.SetHottrackColor(Value: TColor);
begin
  FHottrackColor:=Value;
  Paint;
end;

end.