Gracias Lepe, pero se me ha ocurrido una ida y no se por que no funciona, pongo el código de mi componente y explico la idea, para si podéis me digáis donde me estoy equivocando.
Código Delphi
[-]unit SpButCol;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Buttons, Dialogs;
type
TKeysValid=(kNONE,kENTER,kESC,kDOWN,kUP,kLEFT,kRIGHT,kF1,kF2,kF3,kF4,kF5,kF6,kF7,kF8,kF9,kF10,kF11,k F12,
kCTRL_F1,kCTRL_F2,kCTRL_F3,kCTRL_F4,kCTRL_F5,kCTRL_F6,kCTRL_F7,kCTRL_F8,kCTRL_F9,kCTRL_F10,kCTRL_F11 ,kCTRL_F12,
kSHIFT_F1,kSHIFT_F2,kSHIFT_F3,kSHIFT_F4,kSHIFT_F5,kSHIFT_F6,kSHIFT_F7,kSHIFT_F8,kSHIFT_F9,kSHIFT_F10 ,kSHIFT_F11,kSHIFT_F12);
TStyleBorde=(sbNone, sbComplet,sbUp,sbDown,sbLeft,sbRight,sbUpDown,sbLeftRight);
TButtonStyle=(SbtImagen,SbtColor);
TSpeedButtonBordeColor = class(TSpeedButton)
private
FAnchoBorde : Integer;
FBordeSpace : Integer;
FBordeColor : TColor;
FColor : TColor;
FKeyDefault : TKeysValid;
FStyleBorde: TStyleBorde;
FButtonStyle: TButtonStyle;
procedure AutoInitialize;
procedure AutoDestroy;
function GetBordeSpace : Integer;
procedure SetBordeSpace(Value : Integer);
procedure SetKeyDefault(Value : TKeysValid);
function GetStyleBorde:TStyleBorde;
procedure SetStyleBorde(value:TStyleBorde);
function GetButtonStyle:TButtonStyle;
procedure SetButtonStyle(Value:TButtonStyle);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure PressKey(KEyDef: TKeysValid;var Key: Word; Shift: TShiftState);
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 KeyDefault: TKeysValid read FKeyDefault write SetKeyDefault default kNONE;
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', [TSpeedButtonBordeColor]);
end;
procedure TSpeedButtonBordeColor.AutoInitialize;
begin
FAnchoBorde := 3;
FBordeSpace := 2;
FColor := clbtnface;
FBordeColor:=clBtnFace;
FKeyDefault := kNONE;
FStyleBorde:=sbNone;
FButtonStyle:=SbtImagen;
end;
procedure TSpeedButtonBordeColor.AutoDestroy;
begin
end;
function TSpeedButtonBordeColor.GetBordeSpace : Integer;
begin
Result := FBordeSpace;
Refresh;
end;
function TSpeedButtonBordeColor.GetStyleBorde;
begin
Result:=FStyleBorde;
Refresh;
end;
function TSpeedButtonBordeColor.GetButtonStyle;
begin
Result:=FButtonStyle;
Refresh;
end;
procedure TSpeedButtonBordeColor.SetBordeSpace(Value : Integer);
begin
FBordeSpace := Value;
Refresh;
end;
procedure TSpeedButtonBordeColor.SetKeyDefault(Value : TKeysValid);
begin
FKeyDefault:=Value;
Refresh;
end;
procedure TSpeedButtonBordeColor.SetStyleBorde(value: TStyleBorde);
begin
FStyleBorde:=value;
Refresh;
end;
procedure TSpeedButtonBordeColor.SetButtonStyle;
begin
FButtonStyle:=Value;
Refresh;
end;
procedure TSpeedButtonBordeColor.Click;
begin
inherited Click;
end;
constructor TSpeedButtonBordeColor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;
destructor TSpeedButtonBordeColor.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;
procedure TSpeedButtonBordeColor.Loaded;
begin
inherited Loaded;
end;
procedure TSpeedButtonBordeColor.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 TSpeedButtonBordeColor.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;
procedure TSpeedButtonBordeColor.PressKey(KEyDef: TKeysValid;var Key: Word; Shift: TShiftState);
begin
if KEyDef=kESC then ShowMessage('ESCOK');
if KEyDef=kENTER then ShowMessage('ENTEROK');
if Key =VK_ESCAPE then ShowMessage('Escape');
if Key =VK_RETURN then ShowMessage('Enter');
case Key of
VK_ESCAPE:begin
if FKeyDefault=kESC then ShowMessage('ESC');
end;
VK_RETURN:begin
if FKeyDefault=kENTER then ShowMessage('Enter');
if Self.FKeyDefault=kENTER then ShowMessage('Enter');
if KeyDefault=kENTER then ShowMessage('Enter');
if Self.KeyDefault=kENTER then ShowMessage('Enter');
end;
VK_F1 :begin
if (Key=VK_F1) and (Shift=[]) then if FKeyDefault=kF1 then ShowMessage('F1');
if (Key=VK_F1) and (Shift=[ssCtrl]) then if FKeyDefault=kCTRL_F1 then ShowMessage('CONTROL + F1');
if (Key=VK_F1) and (Shift=[ssShift]) then if FKeyDefault=kSHIFT_F1 then ShowMessage('SHIFT + F1');
end;
end;
case KEyDef of
kENTER: if Key=VK_RETURN then
begin
ShowMessage('HA pulsado Enter');
Click;
end;
kESC: if Key=VK_ESCAPE then Click;
kDOWN: if Key=VK_DOWN then Click;
kUP: if Key=VK_UP then Click;
kLEFT: if Key=VK_LEFT then Click;
kRIGHT: if Key=VK_RIGHT then Click;
kF1: if Key=VK_F1 then Click;
kF2: if Key=VK_F2 then Click;
kF3: if Key=VK_F3 then Click;
kF4: if Key=VK_F4 then Click;
kF5: if Key=VK_F5 then Click ;
kF6: if Key=VK_F6 then Click ;
kF7: if Key=VK_F7 then Click;
kF8: if Key=VK_F8 then Click ;
kF9: if Key=VK_F9 then Click;
kF10: if Key=VK_F10 then Click;
kF11: if Key=VK_F11 then Click;
kF12: if Key=VK_F12 then Click;
kCTRL_F1: if (Key=VK_F1) and (Shift=[ssCtrl]) then Click;
kCTRL_F2: if (Key=VK_F2) and (Shift=[ssCtrl]) then Click;
kCTRL_F3: if (Key=VK_F3) and (Shift=[ssCtrl]) then Click;
kCTRL_F4: if (Key=VK_F4) and (Shift=[ssCtrl]) then Click;
kCTRL_F5: if (Key=VK_F5) and (Shift=[ssCtrl]) then Click;
kCTRL_F6: if (Key=VK_F6) and (Shift=[ssCtrl]) then Click;
kCTRL_F7: if (Key=VK_F7) and (Shift=[ssCtrl]) then Click;
kCTRL_F8: if (Key=VK_F8) and (Shift=[ssCtrl]) then Click;
kCTRL_F9: if (Key=VK_F9) and (Shift=[ssCtrl]) then Click;
kCTRL_F10: if (Key=VK_F10) and (Shift=[ssCtrl]) then Click;
kCTRL_F11: if (Key=VK_F11) and (Shift=[ssCtrl]) then Click;
kCTRL_F12: if (Key=VK_F12) and (Shift=[ssCtrl]) then Click;
kSHIFT_F1: if (Key=VK_F1) and (Shift=[ssShift]) then Click;
kSHIFT_F2: if (Key=VK_F2) and (Shift=[ssShift]) then Click;
kSHIFT_F3: if (Key=VK_F3) and (Shift=[ssShift]) then Click;
kSHIFT_F4: if (Key=VK_F4) and (Shift=[ssShift]) then Click;
kSHIFT_F5: if (Key=VK_F5) and (Shift=[ssShift]) then Click;
kSHIFT_F6: if (Key=VK_F6) and (Shift=[ssShift]) then Click;
kSHIFT_F7: if (Key=VK_F7) and (Shift=[ssShift]) then Click;
kSHIFT_F8: if (Key=VK_F8) and (Shift=[ssShift]) then Click;
kSHIFT_F9: if (Key=VK_F9) and (Shift=[ssShift]) then Click;
kSHIFT_F10:if (Key=VK_F10) and (Shift=[ssShift]) then Click;
kSHIFT_F11:if (Key=VK_F11) and (Shift=[ssShift]) then Click;
kSHIFT_F12:if (Key=VK_F12) and (Shift=[ssShift]) then Click;
end;
end;
end.
Si os fijáis he añadido un procedure llamado PressKey,(KEyDef: TKeysValid;var Key: Word; Shift: TShiftState);, este lo he puesto en Published, Public y Private y en ninguna ha funcionado, el problema es ke el Key lo reconoce pero el KeyDef no, por lo meno no hace el recorrido como quiero, he probado de varias maneras (se pueden ver dentro del procedure, ya que no las he eliminado, para seguir probando).
La manera de llamarlo que tengo es dentro del fom con el KeyPrevie en tru y dentro del Evento OnkeyDown
Código Delphi
[-]procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
TSpeedButtonBordeColor(Sender).PressKey(TSpeedButtonBordeColor(Sender).KeyDefault,key,Shift);
end;
Se agradece como siempre una mano de por que no funciona????