Aquí os pongo una versión mejorada de mi SppedButon Border Color
tiene la propiedad ButtonRepeat, que repite el onclick mientras este pulsado, la de StarInterval que indica la espera para la primera repetición y la TimeInterval que indica el tiempo ha dejar pasar entre las siguientes repeticiones.
Al estar buscando como repetir un onclick mientras esta pulsado el botón, encontré el componente TRepeatButton para delphi 5 pero no hay información del autor ni un email, donde contactar con el para informarle de que he cogido parte de su código, lo he modificado un poco y lo he añadido a mi componente, de todas maneras como podéis ver lo especifico en la cabecera del mismo
Código Delphi
[-]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.