Ver Mensaje Individual
  #6  
Antiguo 02-11-2011
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Reputación: 22
José Luis Garcí Va camino a la fama
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
      { Private fields of TSpeedButtonBorderColor }
        FAnchoBorde : Integer;
        FBordeSpace : Integer;
        FBordeColor : TColor;
        FColor : TColor;
        FKeyDefault : TKeysValid;
        FStyleBorde: TStyleBorde;
        FButtonStyle: TButtonStyle;
      { Private methods of TSpeedButtonBorderColor }
        { Method to set variable and property values and create objects }
        procedure AutoInitialize;
        { Method to free any objects created by AutoInitialize }
        procedure AutoDestroy;
        function GetBordeSpace : Integer;
        procedure SetBordeSpace(Value : Integer);
//        function GetKeyDefault: TKeysValid;
        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
      { Protected fields of TSpeedButtonBorderColor }
      { Protected methods of TSpeedButtonBorderColor }
        procedure Click; override;
        procedure Loaded; override;
        procedure Paint; override;
    public
      { Public fields and properties of TSpeedButtonBorderColor }
      { Public methods of TSpeedButtonBorderColor }
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

    published
      { Published properties of TSpeedButtonBorderColor }
        property OnClick;
        property OnDblClick;
        property OnDragDrop;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        { Tecla a usar por Deefecto }
        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;
       { Ancho del border }
        property AnchoBorder : Integer      read FAnchoBorde    write FAnchoBorde       default 3;
        { Spacio entre el Borde y el Boton }
        property BoderSpace : Integer       read GetBordeSpace  write SetBordeSpace     default 2;
        { Color del Border }
        property BorderColor : TColor       read FBordeColor    write FBordeColor       default clbtnface;
        { Color que tendra }
        property Color : TColor             read FColor         write FColor            default clbtnface;

  end;

procedure Register;

implementation

procedure Register;
begin
     { Register TSpeedButtonBorderColor with BOTONES as its
       default page on the Delphi component palette }
     RegisterComponents('BOTONES', [TSpeedButtonBordeColor]);
end;

{ Method to set variable and property values and create objects }
procedure TSpeedButtonBordeColor.AutoInitialize;
begin
     FAnchoBorde := 3;
     FBordeSpace := 2;
     FColor := clbtnface;
     FBordeColor:=clBtnFace;
     FKeyDefault := kNONE;
     FStyleBorde:=sbNone;
     FButtonStyle:=SbtImagen;
end; { of AutoInitialize }

{ Method to free any objects created by AutoInitialize }
procedure TSpeedButtonBordeColor.AutoDestroy;
begin
     { No objects from AutoInitialize to free }
end; { of AutoDestroy }

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;

     { If changing this property affects the appearance of
       the component, call Invalidate here so the image will be
       updated. }
     { Invalidate; }
end;

//function TSpeedButtonBordeColor.GetKeyDefault;
//begin
//     { Return String value based on S }
//
//     Result := FKeyDefault;
//     Refresh;
//end;

procedure TSpeedButtonBordeColor.SetKeyDefault(Value : TKeysValid);
begin
      FKeyDefault:=Value;
     { Update the component based on argument S
       and new property setting in Value }
        Refresh;

end;

procedure TSpeedButtonBordeColor.SetStyleBorde(value: TStyleBorde);
begin
   FStyleBorde:=value;
    Refresh;
end;

procedure TSpeedButtonBordeColor.SetButtonStyle;
begin
   FButtonStyle:=Value;
    Refresh;
end;

{ Override OnClick handler from TSpeedButton }
procedure TSpeedButtonBordeColor.Click;
begin
     { Call method of parent class }
     inherited Click;
end;

constructor TSpeedButtonBordeColor.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;

     { Code to perform other tasks when the component is created }

end;

destructor TSpeedButtonBordeColor.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TSpeedButtonBordeColor.Loaded;
begin
     inherited Loaded;

     { Perform any component setup that depends on the property
       values having been set }
end;

procedure TSpeedButtonBordeColor.Paint;
var VarILArgo,VarIAlto:Integer;
begin
     { Make this component look like its parent component by calling  its parent's Paint method. }
     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//UP
          Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
          Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);               //LAgox Altura
        end;
        if (FStyleBorde=sbComplet) or (FStyleBorde=sbDown) or (FStyleBorde=sbUpDown) then
        begin//DOwn
          Canvas.MoveTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
          Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));               //LAgox Altura
        end;
        if (FStyleBorde=sbComplet) or (FStyleBorde=sbLeft) or (FStyleBorde=sbLeftRight) then
        begin //Left
          Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
          Canvas.LineTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));               //LAgox Altura
        end;
        if (FStyleBorde=sbComplet) or (FStyleBorde=sbRight) or (FStyleBorde=sbLeftRight) then
        begin //Right
          Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
          Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));               //LAgox Altura
        end;
       { To change the appearance of the component, use the methods  supplied by the component's Canvas property (which is of    type TCanvas).  For example, }
      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;
     { Canvas.Rectangle(0, 0, Width, Height); }
end;

procedure TSpeedButtonBordeColor.WMSize(var Message: TWMSize);
var
     W, H: Integer;
begin
     inherited;
     { Copy the new width and height of the component
       so we can use SetBounds to change both at once }
     W := Width;
     H := Height;
     { Code to check and adjust W and H }
     { Update the component size if we adjusted W or H }
     if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H);
     { Code to update dimensions of any owned sub-components
       by reading their Height and Width properties and updating
       via their SetBounds methods }
     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????
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita