4 farklı durum alan buton

Kod:
{ A button which states are indicated by bitmap images.
@author Derek van Daal
@version 1.0
}
unit BitmapButton;

interface

uses
SysUtils, Messages, Classes, Graphics, Controls, StdCtrls;

type
TBitmapButton = class(TGraphicControl)
private
FAutoSize: Boolean;
FBmpDisabled: TBitmap;
FBmpHot: TBitmap;
FBmpNormal: TBitmap;
FBmpPressed: TBitmap;
FCurrentBitmap: TBitmap;
FHotTrack: Boolean;
FMousePressed: Boolean;
FMouseInControl: Boolean;
FTransparent: Boolean;
FTransparentColor: TColor;
procedure SetAutoSize(Value: Boolean);
procedure SetBmpDisabled(Value: TBitmap);
procedure SetBmpHot(Value: TBitmap);
procedure SetBmpNormal(Value: TBitmap);
procedure SetBmpPressed(Value: TBitmap);
procedure SetTransparent(Value: Boolean);
procedure SetTransparentColor(Value: TColor);
{ Private declarations }
protected
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMMouseEnter(var msg : TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg : TMessage); message CM_MOUSELEAVE;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;
{ Protected declarations }
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
{ Public declarations }
published
property Action;
property Anchors;
property AutoSize: Boolean read FAutoSize write SetAutoSize;
property BiDiMode;
property BmpDisabled: TBitmap read FBmpDisabled write SetBmpDisabled;
property BmpHot: TBitmap read FBmpHot write SetBmpHot;
property BmpNormal: TBitmap read FBmpNormal write SetBmpNormal;
property BmpPressed: TBitmap read FBmpPressed write SetBmpPressed;
property Constraints;
property Enabled;
property HotTrack: Boolean read FHotTrack write FHotTrack;
property ParentShowHint;
property ParentBiDiMode;
property PopupMenu;
property ShowHint;
property Transparent: Boolean read FTransparent write SetTransparent;
property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{ Published declarations }
end;

procedure Register;

implementation

{--------------------------------------------------------------------}
{
Constructs and initializes the LabelButton component.
@param AOwner the LabelButton's owner component
}
constructor TBitmapButton.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FAutoSize := True;
FBmpDisabled := TBitmap.Create;
FBmpHot := TBitmap.Create;
FBmpNormal := TBitmap.Create;
FBmpPressed := TBitmap.Create;
FCurrentBitmap := FBmpNormal;
FHotTrack := False;
FMousePressed := False;
FMouseInControl := False;
FTransparent := False;
FTransparentColor := clNone;
Width := 25;
Height := 25;
end;
{--------------------------------------------------------------------}
{
Frees the LabelButton component from memory.
}
destructor TBitmapButton.Destroy;
begin
FBmpPressed.Free;
FBmpNormal.Free;
FBmpHot.Free;
FBmpDisabled.Free;
inherited Destroy;
end;
{--------------------------------------------------------------------}
{
Sets the current image to the disabled image as
the EnabledChanged message is dispatched.
@param Message the message directive
}
procedure TBitmapButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if not Enabled then
FCurrentBitmap := FBmpDisabled
else
FCurrentBitmap := FBmpNormal;
Repaint;
end;
{--------------------------------------------------------------------}
{
Sets the current image to the normal/hot image
as the MouseEnter message is dispatched.
@param Message the message directive
}
procedure TBitmapButton.CMMouseEnter(var Msg: TMessage);
begin
inherited;
FMouseInControl := True;
if Enabled then
begin
if FMousePressed then
begin
FCurrentBitmap := FBmpPressed;
Repaint;
end
else
if FHotTrack then
begin
FCurrentBitmap := FBmpHot;
Repaint;
end;
end;
end;
{--------------------------------------------------------------------}
{
Sets the current image to the normal image as
the MouseLeave message is dispatched.
@param Message the message directive
}
procedure TBitmapButton.CMMouseLeave(var Msg: TMessage);
begin
inherited;
FMouseInControl := False;
If Enabled then FCurrentBitmap := FBmpNormal;
Repaint;
end;
{--------------------------------------------------------------------}
{
Sets the current image to the pressed image
as the MouseDown event occurs.
@param Button the pressed button
@param Shift the keyboard shift state
@param X the mouse X coordinate
@param Y the mouse Y coordinate
}
procedure TBitmapButton.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

begin
inherited MouseDown(Button, Shift, X, Y);
FMousePressed := True;
FCurrentBitmap := FBmpPressed;
Repaint;
end;
{--------------------------------------------------------------------}
{
Sets the current image to the normal/hot image
as the MouseUp event occurs.
@param Button the pressed button
@param Shift the keyboard shift state
@param X the mouse X coordinate
@param Y the mouse Y coordinate
}
procedure TBitmapButton.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

begin
inherited MouseUp(Button, Shift, X, Y);
FMousePressed := False;

if Enabled then
begin
if (FHotTrack) and (FMouseInControl) then
FCurrentBitmap := FBmpHot
else
FCurrentBitmap := FBmpNormal;
Repaint;
end;
end;
{--------------------------------------------------------------------}
{
Paints the appropriate bitmap on the control
as the Paint event occurs.
}
procedure TBitmapButton.Paint;

function GetX: Integer;
begin
Result := Width div 2 - FCurrentBitmap.Width div 2;
end;

function GetY: Integer;
begin
Result := Height div 2 - FCurrentBitmap.Height div 2;
end;

begin
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Color := clGray;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;

if Assigned(FCurrentBitmap) then
begin
FCurrentBitmap.TransparentColor := FTransparentColor;
FCurrentBitmap.Transparent := FTransparent;
inherited Canvas.Draw(GetX, GetY, FCurrentBitmap);
end;
end;
{--------------------------------------------------------------------}
{
Assigns the AutoSize property and resizes the component
if needed.
@param Value the AutoSize property value(True/False)
}
procedure TBitmapButton.SetAutoSize(Value: Boolean);
begin
FAutoSize := Value;
If (FAutoSize) and (csDesigning in ComponentState) then
begin
If Assigned(FBmpNormal) then
begin
Height := FBmpNormal.Height;
Width := FBmpNormal.Width;
end
else
begin
//Height := 0;
//Width := 0;
end;
end;
end;
{--------------------------------------------------------------------}
{
Assigns the BmpDisabled property.
@param Value the new bitmap
}
procedure TBitmapButton.SetBmpDisabled(Value: TBitmap);
begin
FBmpDisabled.Assign(Value);
end;
{--------------------------------------------------------------------}
{
Assigns the BmpHot property.
@param Value the new bitmap
}
procedure TBitmapButton.SetBmpHot(Value: TBitmap);
begin
FBmpHot.Assign(Value);
end;
{--------------------------------------------------------------------}
{
Assigns the BmpNormal property.
@param Value the new bitmap
}
procedure TBitmapButton.SetBmpNormal(Value: TBitmap);
begin
FBmpNormal.Assign(Value);
SetAutoSize(FAutoSize);
end;
{--------------------------------------------------------------------}
{
Assigns the BmpPressed property.
@param Value the new bitmap
}
procedure TBitmapButton.SetBmpPressed(Value: TBitmap);
begin
FBmpPressed.Assign(Value);
end;
{--------------------------------------------------------------------}
{
Assigns the Transparent property and repaints the component.
@param Value the Transparent property value(True/False)
}
procedure TBitmapButton.SetTransparent(Value: Boolean);
begin
FTransparent := Value;
Repaint;
end;
{--------------------------------------------------------------------}
{
Assigns the TransparentColor property and repaints the component.
@param Value the transparent color
}
procedure TBitmapButton.SetTransparentColor(Value: TColor);
begin
FTransparentColor := Value;
Repaint;
end;


{ Register }
{--------------------------------------------------------------------}
{
Registers the Streamer component.
}
procedure Register;
begin
RegisterComponents('My Components', [TBitmapButton]);
end;