22 replies to this topic

[Desart]

Se trata de poder poner los eventos OnkeyPress, OnkeyUp, OnkeyDown a TSpeedButton, si podeis echarme una mano?

[eduarcol]

No creo se pueda ya que estos no capturan el foco. Si te sirve yo le asignó estos eventos al formulario previamente colocó el keypreview en true

[escafandra]

¿Porqué no usas un TBitBtn?

Saludos.

[Desart]

Es que el problema es que quiero las propiedades del Speedbutton, Group y Down, de hecho estoy trabajando en uno que permite borde, espacio, ancho color borde, color Fondo, usar imagen o color y diferentes estilos de borde, lo que pasa es que quiero añadir una propiedad, para según la tecla elegida, sea usada por defecto, para que ejecute el OnClick del botón.


Una Imagen del Speedbutton

[escafandra]

En ese caso te propongo un truco. Activa el KeyPreview del formulario. En el tag de cada botón pon el valor del V_KEY correspondiente a la tecla que quieres que lo pulse. Ahora en el evento OnKeyDown escribe:

delphi

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  n: Integer;
begin
  for n:= 0 to ControlCount-1 do
  if Controls[n] is TSpeedButton then
    if TSpeedButton(Controls[n]).Tag =Key then
      TSpeedButton(Controls[n]).Down:= true;
end;

Saludos.

[Desart]

racias Escafandra, pero me pregunto, no podria captura el evento, si vinculo al componente el Form correspondiente?

[eduarcol]

Es que el evento siempre se disparara en el Form, no veo la forma de agregarle eso al componente que haces...

[Desart]

Muchas Gracias Eduarcol, pero se me ha ocurrido una ida y no entiendo por que no funciona, pongo el Código y detallo la ida para si podéis me echéis una mano






El código completo (falta detallar y depurar y eliminar parte con las que he estado probando)

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,kF12,
                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

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????

[escafandra]

racias Escafandra, pero me pregunto, no podria captura el evento, si vinculo al componente el Form correspondiente?

De forma directa no. El TSpeedButton no recibe eventos del teclado y por lo tanto no puede procesarlos. Se puede derivar un control del TSpeedButton que capture los mensajes del Form Parent  que a su vez tiene que tener su KeyPreview:= true. Esto permitiría lo que quieres, pero tienes que escribir el control derivado.

No se si te va a merecer la pena esto o aplicar la idea que te expuse mas arriba.


Saludos.

[egostar]

Perdón por mi ignorancia, pero no se puede heredar de dos clases un sólo componente, el problema que veo es que el SpeedButton hereda de GraphicControl y los TButton de TWinControl que es el que tiene las propiedades que se requieren.

SaludOS

[escafandra]

Perdón por mi ignorancia, pero no se puede heredar de dos clases un sólo componente, el problema que veo es que el SpeedButton hereda de GraphicControl y los TButton de TWinControl que es el que tiene las propiedades que se requieren.

SaludOS

No es ignorancia, es una pregunta lógica en alguien no ignorante y es una pregunta que me hago yo  .  Si se tratara ce C++ la respuesta es si. Tratándose de delphi, creo que no se permite la herencia múltiple. Aquí el ignorante soy yo, recuerda que no hace mucho que me adentré en él y que básicamente lo uso para cosas sencillas o responder preguntas del foro.

Así que la pregunta es: ¿Delphi admite la herencia múltiple?. Por lo que he leído creo que no, pero no me hagáis demasiado caso.


Saludos.

[egostar]

Bueno, es que metiendome a las unidades que trae Delphi he visto algo como esto

delphi

  TSimpleRWSync = class(TInterfacedObject, IReadWriteSync)

Lo que me confirma que si se puede, el punto es que si yo hago esto

delphi

  TMiSpeedButton = class(TSpeedButton, TWinControl)

Me manda un mensaje de error.

Entonces me parece que el punto es que combinaciones de clases se pueden mezclar.

Salud OS

[escafandra]

Si, delphi permite un truco para simular herencia múltiple que son las interfaces. Una interface es una especie de clase abstracta. Se permite derivar de una clase y una interface, pero no de dos clases.

Es este artículo se habla del tema. Es un tema interesante que se sale del hilo abierto por Desart...

Por estas dificultades es por lo que sugerí hookear los mensajes del form padre desde un control derivado de SpeedButton para "cotillear los WM_" que se le envían a éste.



Saludos.

[egostar]

Ya entiendo, muy interesante este asunto

Salud OS

[escafandra]

Bueno, voy a tratar de dar un empujoncito al tema.

He escrito un componente con la idea que expuse mas arriba, se llama TSpeedButtonEx. Captura la función de tratamiento de mensajes de su Owner y si éste es capas de responder al teclado (como un TForm o TPanel) nuestro SpeedButtonEx responderá.

He añadido los eventos:

- OnKeyDown
- OnKeyUp
- OnKeyPress


Existe un detalle, el foco del teclado, al que no le he prestado mucha atención. Todos los SpeedButtonEx reciben el mensaje del teclado correspondiente, con lo que en el evento de tratamiento de cada uno debe conocer si responder o no. Lo considero un incidente menor que no creo que plantee problema.

Sin mas dejo el código:

delphi

unit SpeedButtonEx;
 
interface
 
uses
  SysUtils, Forms, Messages, Classes, Controls, Buttons;
 
type
  TSpeedButtonEx = class(TSpeedButton)
  private
    FOnKeyDown: TKeyEvent;
    FOnKeyPress: TKeyPressEvent;
    FOnKeyUp: TKeyEvent;
    FOldWndProc: TWndMethod;
  protected
    procedure HookFormWndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TSpeedButtonEx]);
end;
 
constructor TSpeedButtonEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not(csDesigning in ComponentState) and (Owner <> nil) then
    with AOwner as TControl do
    begin
      FOldWndProc:= WindowProc;
      WindowProc:= HookFormWndProc;
    end;
end;
 
destructor TSpeedButtonEx.Destroy;
begin
  if (Owner <> nil) then
    with Owner as TControl do
      WindowProc:= FOldWndProc;
  inherited Destroy;
end;
 
procedure TSpeedButtonEx.HookFormWndProc(var Message: TMessage);
var
  Key: WORD;
  Shift: TShiftState;
  C: CHAR;
begin
  with Owner as TControl do
  begin
    case Message.Msg of
      WM_KEYUP:
        if Assigned(FOnKeyUp) then
        begin
          Key:= Message.wParam;
          FOnKeyUp(Self, Key, KeyDataToShiftState(Message.lParam));
          Message.wParam:= Key;
        end;
      WM_KEYDOWN:
        if Assigned(FOnKeyDown) then
        begin
          Key:= Message.wParam;
          FOnKeyDown(Self, Key, KeyDataToShiftState(Message.lParam));
          Message.wParam:= Key;
        end;
      WM_CHAR:
        if Assigned(FOnKeyPress) then
        begin
          C:= CHAR(Message.wParam);
          FOnKeyPress(Self, C);
          Message.wParam:= WORD(C);
        end;
    end;
  end;
  FOldWndProc(Message);
end;
 
end.

Espero que cumpla las expectativas de Desart o al menos sirva de ejemplo para el desarrollo de otro mas avanzado.

Saludos.

[Desart]

escafandra, eres un Genio, me funciono perfectamente para lo que quiero, no doy por RESUELTO aun el tema, porque me falta dejar presentable el código, comentar y poner el código completo  y una demo en estos días, pero debo dar gracias una vez más las gracias a Escafandra,.

[Desart]

Debo decir que mi euforia inicial ha caído de manera inimaginable  , aunque  el código puesto por escafandra me funcionaba perfectamente, tiene un problema, cuando añades cualquier otro control deja de funcionar, es por eso que dejo sólo la parte grafica para el Boton y me olvido de la parte de control de pulsaciones preestablecidas, aún así debo decir que el proyecto de TPV en el que estoy trabajando en casa ha mejorado mucho gracias ha este nuevo botón.


aquí os dejo el código

delphi

//***********************************************[ SpeedButtonBordeColor ]******
// Componente Creado por JLGT 2011-  El Componente es Free, por lo que podeis
// Modificarlo y usarlo libremente sin mencion ni solicitud alguna por mi parte
//------------------------------------------------------------------------------
//--[Metodos y Eventos]---------------------------------------------------------
// AnchoBorde : Integer;       Es el valor del Ancho del Borde si StyleBorde es diferente de  sbNone
// BordeSpace : Integer;       Espacio a dejar entre los Filos del Speedbutton y donde dibujamos el nuevo borde
// BordeColor : TColor;        Color del Borde
// Color      : TColor;        Color del relleno interior si ButtonStyle  es SbtColor
// StyleBorde : TStyleBorde;   Estilos del Borde, (cada lado por separado, arriba y abajo, derecha y izquierda y
//                             Completo los cuato lados)
// ButtonStyle: TButtonStyle;  Permite elegir tal Cual, admitiendo imagen, o con relleno de color, en este apartado,
//                             si tenemos el texto muy grande o una imagen puesta , se pueden ver por debajo del
//                             relleno arruinando el efecto
//------------------------------------------------------------------------------
unit SPBBC;
 
 
interface
 
 
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Buttons;
 
 
type
  //Estilos de Borde
  TStyleBorde=(sbNone, sbComplet,sbUp,sbDown,sbLeft,sbRight,sbUpDown,sbLeftRight);
  //Estilo del botón
  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;
//------------------------------------------------------------------------------
//************************************************************[ Register ]******
// Donde registramos El Componente
//------------------------------------------------------------------------------
begin
   RegisterComponents('BOTONES', [TSpeedButtonBC]);
end;
 
 
procedure TSpeedButtonBC.AutoInitialize;
//------------------------------------------------------------------------------
//******************************************************[ AutoInitialize ]******
// Como se incia el componente
//------------------------------------------------------------------------------
begin
   FAnchoBorde := 3;
   FBordeSpace := 2;
   FColor := clbtnface;
   FBordeColor:=clBtnFace;
   FStyleBorde:=sbNone;
   FButtonStyle:=SbtImagen;
end;
 
 
function TSpeedButtonBC.GetBordeSpace : Integer;
//------------------------------------------------------------------------------
//*******************************************************[ GetBordeSpace ]******
// leer del Dato BordeSpace
//------------------------------------------------------------------------------
begin
   Result := FBordeSpace;
   Repaint;
end;
 
 
function TSpeedButtonBC.GetStyleBorde;
//------------------------------------------------------------------------------
//*******************************************************[ GetStyleBorde ]******
// leer del Dato StyleBorde
//------------------------------------------------------------------------------
begin
   Result:=FStyleBorde;
   Repaint;
end;
 
 
function TSpeedButtonBC.GetButtonStyle;
//------------------------------------------------------------------------------
//******************************************************[ GetButtonStyle ]******
// leer del Dato ButtonStyle
//------------------------------------------------------------------------------
begin
   Result:=FButtonStyle;
   Repaint;
end;
 
 
procedure TSpeedButtonBC.SetBordeSpace(Value : Integer);
//------------------------------------------------------------------------------
//*******************************************************[ SetBordeSpace ]******
// Asignamos el nuevo valor a BordeSpace
//------------------------------------------------------------------------------
begin
   FBordeSpace := Value;
   Repaint;
end;
 
 
procedure TSpeedButtonBC.SetStyleBorde(value: TStyleBorde);
//------------------------------------------------------------------------------
//*******************************************************[ SetStyleBorde ]******
// Asignamos el nuevo valor a StyleBorde
//------------------------------------------------------------------------------
begin
   FStyleBorde:=value;
   Repaint;
end;
 
 
procedure TSpeedButtonBC.SetButtonStyle;
//------------------------------------------------------------------------------
//******************************************************[ SetButtonStyle ]******
// Asignamos el nuevo valor a ButtonStyle
//------------------------------------------------------------------------------
begin
   FButtonStyle:=Value;
   Repaint;
end;
 
 
procedure TSpeedButtonBC.Click;
//------------------------------------------------------------------------------
//***************************************************************[ Click ]******
// Al Pulsar en  SetButtonStyle
//------------------------------------------------------------------------------
begin
   inherited Click;
end;
 
 
constructor TSpeedButtonBC.Create(AOwner: TComponent);
//------------------------------------------------------------------------------
//**************************************************************[ Create ]******
// Creación del Componente
//------------------------------------------------------------------------------
begin
   inherited Create(AOwner);
   AutoInitialize;
end;
 
 
destructor TSpeedButtonBC.Destroy;
//------------------------------------------------------------------------------
//*************************************************************[ Destroy ]******
// Destrucción del Componente
//------------------------------------------------------------------------------
begin
   inherited Destroy;
end;
 
 
procedure TSpeedButtonBC.Loaded;
//------------------------------------------------------------------------------
//**************************************************************[ Loaded ]******
// Carga del Componente
//------------------------------------------------------------------------------
begin
   inherited Loaded;
end;
 
 
procedure TSpeedButtonBC.Paint;
//------------------------------------------------------------------------------
//***************************************************************[ Paint ]******
// Dibujado del Componente
//------------------------------------------------------------------------------
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//dibujamo Arriva
          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//Dibujamos abajo
          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 //Dibujamoa a la Izquierda
          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 //Dibujamoa a la derecha
          Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
          Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
        end;
   end;
   if FButtonStyle=SbtColor then
   begin   //Para dibujar el Relleno
         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);
//------------------------------------------------------------------------------
//**************************************************************[ WMSize ]******
// Para controlar el tamaño
//------------------------------------------------------------------------------
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.

y aquí el componente y la demo

Posdata, compañeros estoy intentando dar el tema por resuelto, pero no me deja editar mi 1º post, ni con el Crhome ni con Firefox

[escafandra]

... aunque  el código puesto por escafandra me funcionaba perfectamente, tiene un problema, cuando añades cualquier otro control deja de funcionar...

Es un problema del foco. Déjame que lo mire en cuanto tenga un rato libre.


Saludos.

[Delphius]

Hola Desart,
Edité tu post para colocar la etiqueta delphi, parece que tuviste algunos problemitas con ella.


Respecto a lo que comentas de que no puedes poner el prefijo RESUELTO ¿Simplemente no puedes editar el post o es que no te aparece el combo para seleccionar el profijo? Porque a mi en Chrome y en FF si me aparece. Si nos puedes decir más sobre el problema lo podremos ver.Para no mezclar con el tema del hilo quizá sea mejor que nos los respondas de forma privada.

[escafandra]

... aunque  el código puesto por escafandra me funcionaba perfectamente, tiene un problema, cuando añades cualquier otro control deja de funcionar...

Es un problema del foco. Déjame que lo mire en cuanto tenga un rato libre.


Saludos.

Te explico lo que sucede:

Los formularios pierden el foco del teclado cuando se les inserta un control capaz de recibir ese foco. Yo basé la estrategia erroneamente pensando que si los formularios podían capturar el teclado al accionar KeyPreview, era porque se les enviaban los  mensajes WM_KEYDOWN, WM_KEYUP y WM_CHAR. Pero en realidad no los reciben si pierden el foco del teclado, sino que son informados desde  el control que tiene dicho foco y así pueden responder a los eventos.

Así pues, mi método, un Hook al WndProc del formulario o TPanel padre, falla en cuanto aparece en escena un control que  pueda recibir el foco.

La solución es leer el teclado a las bravas, mediante un Hook local tipo WH_KEYBOARD y enviar a todos los TSpeedButton presentes en  el formulario activo, un mensaje WM_KEYDOWN o WM_KEYUP según corresponda.

Los TSpeedButton van a recibir siempre esos mensajes que se han de filtrar en el evento correspondiente. Se debe tener en cuenta  que si tenemos un edit en escena, las pulsaciones que reciba las reciben los TSpeedButton. Y al contrario, si un edit tiene el foco, las pulsaciones que queremos mandar a los botones las "escribe" dicho edit. Eesto obliga a ser cuidadosos al escribir los  eventos OnKeyDown y OnKeyUp de los botones TSpeedButtonEx.

Sin extenderme mas publico el código:

delphi

//------------------------------------------------------------------------------
// Boton SpeedButtonEx:
// Se añaden los eventos de teclado por Hook: OnKeyDown y OnKeyUp
//
// Escrito por escafandra 7-nov-2011.
// Delphiaccess.com
//------------------------------------------------------------------------------
 
unit SpeedButtonEx;
 
interface
 
uses
  SysUtils, Forms, Windows, Messages, Classes, Controls, Buttons;
 
type
  TSpeedButtonEx = class(TSpeedButton)
  private
    FOnKeyDown: TKeyEvent;
    FOnKeyUp: TKeyEvent;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
  end;
 
procedure Register;
 
implementation
var
  WHookKeyboard: HHOOK = 0;
 
 
procedure Register;
begin
  RegisterComponents('Samples', [TSpeedButtonEx]);
end;
 
procedure Broadcast(var Message);
var
  I: Integer;
begin
  with Screen.ActiveForm do
  begin
    for I := 0 to ControlCount - 1 do
      if Controls[I].ClassName = 'TSpeedButtonEx' then
        Controls[I].WindowProc(TMessage(Message));
  end;
end;
 
function KeyboardHook(Code, wParam, lParam: Integer): integer; stdcall;
var
  Msg: TMessage;
begin
  if Code = HC_ACTION then
  begin
    Msg.Msg := WM_KEYDOWN;
    if (lParam and $80000000) = $80000000 then
      Msg.Msg := WM_KEYUP;
    Msg.WParam := wParam;
    Msg.LParam := lParam;
    Msg.Result := 0;
    Broadcast(Msg);
  end;
  Result:= CallNextHookEx(WHookKeyboard, Code, wParam, lParam);
end;
 
constructor TSpeedButtonEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOnKeyDown:= nil;
  FOnKeyUp:= nil;
  if not(csDesigning in ComponentState) and (WHookKeyboard = 0) then
    WHookKeyboard:= SetWindowsHookEx(WH_KEYBOARD, KeyboardHook, 0, GetCurrentThreadId);
end;
 
destructor TSpeedButtonEx.Destroy;
begin
  inherited Destroy;
  if (WHookKeyboard <> 0) then
    UnhookWindowsHookEx(WHookKeyboard);
end;
 
procedure TSpeedButtonEx.WndProc(var Message: TMessage);
var
  Key: WORD;
begin
  case Message.Msg of
    WM_KEYUP:
      if Assigned(FOnKeyUp) then
      begin
        Key:= Message.wParam;
        FOnKeyUp(Self, Key, KeyDataToShiftState(Message.lParam));
        Message.wParam:= Key;
      end;
    WM_KEYDOWN:
      if Assigned(FOnKeyDown) then
      begin
        Key:= Message.wParam;
        FOnKeyDown(Self, Key, KeyDataToShiftState(Message.lParam));
        Message.wParam:= Key;
      end;
  end;
  inherited WndProc(Message);
end;
 
end.

He eliminado el evento OnKeyPress correspondiente al mensaje WM_CHAR porque la traducción desde un Hook del teclado para generar dicho mensaje se complica un poco en el caso de caracteres especiales, acentuados o con deadkeys. Por otro lado no creo que sea necesario.

El código está probado en convivencia con otros controles y edits, pero no puedo asegurar fallos.

Espero que cumpla con tus expectativas, Desart.


Saludos.