unit SPBBC;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Buttons, ExtCtrls;
type
TStyleBorde=(sbNone, sbComplet,sbUp,sbDown,sbLeft,sbRight,sbUpDown,sbLeftRight);
TButtonStyle=(SbtImagen,SbtColor);
TSpeedButtonBC = class(TSpeedButton)
private
FAnchoBorde : Integer;
FBordeSpace : Integer;
FBordeColor : TColor;
FColor : TColor;
FStyleBorde : TStyleBorde;
FButtonStyle : TButtonStyle;
FStarInterval : Integer;
FTimeInterval : integer;
FButtonRepeat : Boolean;
FOnRepeat: TNotifyEvent;
procedure SetButtonRepeat(Value:Boolean);
procedure SetStarInterval(Value:Integer);
procedure SetTimeInterval(Value:Integer);
function GetRepeatInterval: integer;
function GetStartInterval: integer;
procedure AutoInitialize;
function GetBordeSpace : Integer;
procedure SetBordeSpace(Value : Integer);
function GetStyleBorde:TStyleBorde;
procedure SetStyleBorde(value:TStyleBorde);
function GetButtonStyle:TButtonStyle;
procedure SetButtonStyle(Value:TButtonStyle);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
procedure Click; override;
procedure Loaded; override;
procedure Paint; override;
procedure doRepeat(Sender: TObject);
procedure doStart(Sender: TObject);
public
tRepeat: TTimer;
tStart: TTimer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override;
published
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property StyleBorder:TStyleBorde read GetStyleBorde write SetStyleBorde default sbNone;
property ButtonStyle:TButtonStyle read GetButtonStyle write SetButtonStyle default SbtImagen;
property AnchoBorder : Integer read FAnchoBorde write FAnchoBorde default 3;
property BoderSpace : Integer read GetBordeSpace write SetBordeSpace default 2;
property BorderColor : TColor read FBordeColor write FBordeColor default clbtnface;
property Color : TColor read FColor write FColor default clbtnface;
property ButtonRepeat:Boolean read FButtonRepeat write SetButtonRepeat;
property StarInterval:Integer read FStarInterval write SetStarInterval;
property TimeInterval:integer read FTimeInterval write SetTimeInterval;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('BOTONES', [TSpeedButtonBC]);
end;
procedure TSpeedButtonBC.AutoInitialize;
begin
FAnchoBorde := 3;
FBordeSpace := 2;
FColor := clbtnface;
FBordeColor:=clBtnFace;
FStyleBorde:=sbNone;
FButtonStyle:=SbtImagen;
FStarInterval:=50;
FTimeInterval:=100;
tRepeat:=TTimer.Create(Self);
tRepeat.Enabled:=false;
tRepeat.Interval:=FStarInterval;
tRepeat.OnTimer:=doRepeat;
tStart:=TTimer.Create(Self);
tStart.Enabled:=false;
tStart.Interval:=FTimeInterval;
tStart.OnTimer:=doStart;
end;
function TSpeedButtonBC.GetBordeSpace : Integer;
begin
Result := FBordeSpace;
Repaint;
end;
function TSpeedButtonBC.GetStartInterval: integer;
begin
Result:=tStart.Interval;
end;
function TSpeedButtonBC.GetStyleBorde;
begin
Result:=FStyleBorde;
Repaint;
end;
function TSpeedButtonBC.GetButtonStyle;
begin
Result:=FButtonStyle;
Repaint;
end;
function TSpeedButtonBC.GetRepeatInterval: integer;
begin
result:=tRepeat.Interval;
end;
procedure TSpeedButtonBC.SetBordeSpace(Value : Integer);
begin
FBordeSpace := Value;
Repaint;
end;
procedure TSpeedButtonBC.SetStarInterval(Value: Integer);
begin
if FStarInterval<>value then
begin
FStarInterval:=value;
tStart.Interval:=FStarInterval;
end;
end;
procedure TSpeedButtonBC.SetStyleBorde(value: TStyleBorde);
begin
FStyleBorde:=value;
Repaint;
end;
procedure TSpeedButtonBC.SetButtonRepeat(Value: Boolean);
begin
if FButtonRepeat<>Value then FButtonRepeat:=Value;
end;
procedure TSpeedButtonBC.SetTimeInterval(Value: Integer);
begin
if FTimeInterval<>value then
begin
FTimeInterval:=value;
tRepeat.Interval:=FTimeInterval;
end;
end;
procedure TSpeedButtonBC.SetButtonStyle;
begin
FButtonStyle:=Value;
Repaint;
end;
procedure TSpeedButtonBC.Click;
begin
inherited Click;
end;
constructor TSpeedButtonBC.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;
destructor TSpeedButtonBC.Destroy;
begin
tRepeat.free;
tStart.Free;
inherited Destroy;
end;
procedure TSpeedButtonBC.doRepeat(Sender: TObject);
begin
if FButtonRepeat then if assigned(OnClick) then OnClick(Self);
end;
procedure TSpeedButtonBC.doStart(Sender: TObject);
begin
tStart.Enabled:=false;
tRepeat.Enabled:=true;
end;
procedure TSpeedButtonBC.Loaded;
begin
inherited Loaded;
end;
procedure TSpeedButtonBC.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
tStart.Enabled:=true;
end;
procedure TSpeedButtonBC.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
tRepeat.Enabled:=false;
tStart.Enabled:=false;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TSpeedButtonBC.Paint;
var VarILArgo,VarIAlto:Integer;
begin
inherited Paint;
Canvas.Pen.color := FBordeColor ;
Canvas.Pen.Width:=FAnchoBorde;
if FStyleBorde<>sbNone then
begin
if (FStyleBorde=sbComplet) or (FStyleBorde=sbUp) or (FStyleBorde=sbUpDown) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbDown) or (FStyleBorde=sbUpDown) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbLeft) or (FStyleBorde=sbLeftRight) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
Canvas.LineTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbRight) or (FStyleBorde=sbLeftRight) then
begin Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
end;
end;
if FButtonStyle=SbtColor then
begin Canvas.Pen.color := FColor ;
Canvas.Pen.Width:=0;
Canvas.Brush.Color:=FColor;
Canvas.Brush.Style:=bsSolid;
Canvas.Rectangle(FBordeSpace+FAnchoBorde+3,FBordeSpace+FAnchoBorde+3,Width-(FBordeSpace+FAnchoBorde+2),Height-(FBordeSpace+FAnchoBorde+2));
Canvas.Font:=Self.Font;
VarILArgo:=Canvas.TextWidth(Self.Caption);
VarIAlto:=Canvas.TextHeight(Self.Caption);
Canvas.TextOut(((Width div 2)-(VarILArgo div 2)),((Height div 2)-(VarIAlto div 2)),Self.Caption);
end;
end;
procedure TSpeedButtonBC.WMSize(var Message: TWMSize);
var W, H: Integer;
begin
inherited;
W := Width;
H := Height;
if (W <> Width) or (H <> Height) then inherited SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
end.