Como todos más o menos han expresado el tema de control de teclas pulsada no ha funcionado, pero la parte gráfica si´, así que os pongo el código y subo al Ftp, el componente y la demos
Código Delphi
[-]
unit SPBBC;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Buttons;
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;
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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; 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;
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;
end;
function TSpeedButtonBC.GetBordeSpace : Integer;
begin
Result := FBordeSpace;
Repaint;
end;
function TSpeedButtonBC.GetStyleBorde;
begin
Result:=FStyleBorde;
Repaint;
end;
function TSpeedButtonBC.GetButtonStyle;
begin
Result:=FButtonStyle;
Repaint;
end;
procedure TSpeedButtonBC.SetBordeSpace(Value : Integer);
begin
FBordeSpace := Value;
Repaint;
end;
procedure TSpeedButtonBC.SetStyleBorde(value: TStyleBorde);
begin
FStyleBorde:=value;
Repaint;
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
inherited Destroy;
end;
procedure TSpeedButtonBC.Loaded;
begin
inherited Loaded;
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.