Ir al contenido


Foto

Posibilidades de KEy en Tspeedbutton


  • Por favor identifícate para responder
22 respuestas en este tema

#1 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 01 noviembre 2011 - 06:32

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

#2 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 01 noviembre 2011 - 08:29

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
  • 0

#3 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 01 noviembre 2011 - 10:27

¿Porqué no usas un TBitBtn?

Saludos.

  • 0

#4 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 01 noviembre 2011 - 01:58

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


Imagen Enviada
  • 0

#5 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 01 noviembre 2011 - 02:38

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
  1. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  2.   Shift: TShiftState);
  3. var
  4.   n: Integer;
  5. begin
  6.   for n:= 0 to ControlCount-1 do
  7.   if Controls[n] is TSpeedButton then
  8.     if TSpeedButton(Controls[n]).Tag =Key then
  9.       TSpeedButton(Controls[n]).Down:= true;
  10. end;



Saludos.
  • 0

#6 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 02 noviembre 2011 - 02:00

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

#7 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 02 noviembre 2011 - 06:21

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

#8 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 02 noviembre 2011 - 12:11

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
  1. unit SpButCol;
  2.  
  3.  
  4. interface
  5.  
  6.  
  7. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  8.     Forms, Graphics, Buttons, Dialogs;
  9.  
  10.  
  11. type
  12.   TKeysValid=(kNONE,kENTER,kESC,kDOWN,kUP,kLEFT,kRIGHT,kF1,kF2,kF3,kF4,kF5,kF6,kF7,kF8,kF9,kF10,kF11,kF12,
  13.                 kCTRL_F1,kCTRL_F2,kCTRL_F3,kCTRL_F4,kCTRL_F5,kCTRL_F6,kCTRL_F7,kCTRL_F8,kCTRL_F9,kCTRL_F10,kCTRL_F11,kCTRL_F12,
  14.                 kSHIFT_F1,kSHIFT_F2,kSHIFT_F3,kSHIFT_F4,kSHIFT_F5,kSHIFT_F6,kSHIFT_F7,kSHIFT_F8,kSHIFT_F9,kSHIFT_F10,kSHIFT_F11,kSHIFT_F12);
  15.  
  16.  
  17.   TStyleBorde=(sbNone, sbComplet,sbUp,sbDown,sbLeft,sbRight,sbUpDown,sbLeftRight);
  18.  
  19.  
  20.   TButtonStyle=(SbtImagen,SbtColor);
  21.  
  22.  
  23.   TSpeedButtonBordeColor = class(TSpeedButton)
  24.     private
  25.       { Private fields of TSpeedButtonBorderColor }
  26.         FAnchoBorde : Integer;
  27.         FBordeSpace : Integer;
  28.         FBordeColor : TColor;
  29.         FColor : TColor;
  30.         FKeyDefault : TKeysValid;
  31.         FStyleBorde: TStyleBorde;
  32.         FButtonStyle: TButtonStyle;
  33.       { Private methods of TSpeedButtonBorderColor }
  34.         { Method to set variable and property values and create objects }
  35.         procedure AutoInitialize;
  36.         { Method to free any objects created by AutoInitialize }
  37.         procedure AutoDestroy;
  38.         function GetBordeSpace : Integer;
  39.         procedure SetBordeSpace(Value : Integer);
  40. //        function GetKeyDefault: TKeysValid;
  41.         procedure SetKeyDefault(Value : TKeysValid);
  42.         function GetStyleBorde:TStyleBorde;
  43.         procedure SetStyleBorde(value:TStyleBorde);
  44.         function GetButtonStyle:TButtonStyle;
  45.         procedure SetButtonStyle(Value:TButtonStyle);
  46.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  47.         procedure PressKey(KEyDef: TKeysValid;var Key: Word; Shift: TShiftState);
  48.     protected
  49.       { Protected fields of TSpeedButtonBorderColor }
  50.       { Protected methods of TSpeedButtonBorderColor }
  51.         procedure Click; override;
  52.         procedure Loaded; override;
  53.         procedure Paint; override;
  54.     public
  55.       { Public fields and properties of TSpeedButtonBorderColor }
  56.       { Public methods of TSpeedButtonBorderColor }
  57.         constructor Create(AOwner: TComponent); override;
  58.         destructor Destroy; override;
  59.  
  60.  
  61.     published
  62.       { Published properties of TSpeedButtonBorderColor }
  63.         property OnClick;
  64.         property OnDblClick;
  65.         property OnDragDrop;
  66.         property OnMouseDown;
  67.         property OnMouseMove;
  68.         property OnMouseUp;
  69.         { Tecla a usar por Deefecto }
  70.         property KeyDefault: TKeysValid      read FKeyDefault      write SetKeyDefault    default kNONE;
  71.         property StyleBorder:TStyleBorde      read GetStyleBorde    write SetStyleBorde    default sbNone;
  72.         property ButtonStyle:TButtonStyle    read GetButtonStyle  write SetButtonStyle    default SbtImagen;
  73.       { Ancho del border }
  74.         property AnchoBorder : Integer      read FAnchoBorde    write FAnchoBorde      default 3;
  75.         { Spacio entre el Borde y el Boton }
  76.         property BoderSpace : Integer      read GetBordeSpace  write SetBordeSpace    default 2;
  77.         { Color del Border }
  78.         property BorderColor : TColor      read FBordeColor    write FBordeColor      default clbtnface;
  79.         { Color que tendra }
  80.         property Color : TColor            read FColor        write FColor            default clbtnface;
  81.  
  82.  
  83.   end;
  84.  
  85.  
  86. procedure Register;
  87.  
  88.  
  89. implementation
  90.  
  91.  
  92. procedure Register;
  93. begin
  94.     { Register TSpeedButtonBorderColor with BOTONES as its
  95.       default page on the Delphi component palette }
  96.     RegisterComponents('BOTONES', [TSpeedButtonBordeColor]);
  97. end;
  98.  
  99.  
  100. { Method to set variable and property values and create objects }
  101. procedure TSpeedButtonBordeColor.AutoInitialize;
  102. begin
  103.     FAnchoBorde := 3;
  104.     FBordeSpace := 2;
  105.     FColor := clbtnface;
  106.     FBordeColor:=clBtnFace;
  107.     FKeyDefault := kNONE;
  108.     FStyleBorde:=sbNone;
  109.     FButtonStyle:=SbtImagen;
  110. end; { of AutoInitialize }
  111.  
  112.  
  113. { Method to free any objects created by AutoInitialize }
  114. procedure TSpeedButtonBordeColor.AutoDestroy;
  115. begin
  116.     { No objects from AutoInitialize to free }
  117. end; { of AutoDestroy }
  118.  
  119.  
  120. function TSpeedButtonBordeColor.GetBordeSpace : Integer;
  121. begin
  122.     Result := FBordeSpace;
  123.     Refresh;
  124. end;
  125.  
  126.  
  127. function TSpeedButtonBordeColor.GetStyleBorde;
  128. begin
  129.     Result:=FStyleBorde;
  130.     Refresh;
  131. end;
  132.  
  133.  
  134.  
  135.  
  136. function TSpeedButtonBordeColor.GetButtonStyle;
  137. begin
  138.     Result:=FButtonStyle;
  139.     Refresh;
  140. end;
  141.  
  142.  
  143.  
  144.  
  145. procedure TSpeedButtonBordeColor.SetBordeSpace(Value : Integer);
  146. begin
  147.     FBordeSpace := Value;
  148.       Refresh;
  149.  
  150.  
  151.     { If changing this property affects the appearance of
  152.       the component, call Invalidate here so the image will be
  153.       updated. }
  154.     { Invalidate; }
  155. end;
  156.  
  157.  
  158. //function TSpeedButtonBordeColor.GetKeyDefault;
  159. //begin
  160. //    { Return String value based on S }
  161. //
  162. //    Result := FKeyDefault;
  163. //    Refresh;
  164. //end;
  165.  
  166.  
  167. procedure TSpeedButtonBordeColor.SetKeyDefault(Value : TKeysValid);
  168. begin
  169.       FKeyDefault:=Value;
  170.     { Update the component based on argument S
  171.       and new property setting in Value }
  172.         Refresh;
  173.  
  174.  
  175. end;
  176.  
  177.  
  178. procedure TSpeedButtonBordeColor.SetStyleBorde(value: TStyleBorde);
  179. begin
  180.   FStyleBorde:=value;
  181.     Refresh;
  182. end;
  183.  
  184.  
  185. procedure TSpeedButtonBordeColor.SetButtonStyle;
  186. begin
  187.   FButtonStyle:=Value;
  188.     Refresh;
  189. end;
  190.  
  191.  
  192. { Override OnClick handler from TSpeedButton }
  193. procedure TSpeedButtonBordeColor.Click;
  194. begin
  195.     { Call method of parent class }
  196.     inherited Click;
  197. end;
  198.  
  199.  
  200. constructor TSpeedButtonBordeColor.Create(AOwner: TComponent);
  201. begin
  202.     inherited Create(AOwner);
  203.     AutoInitialize;
  204.  
  205.  
  206.     { Code to perform other tasks when the component is created }
  207.  
  208.  
  209. end;
  210.  
  211.  
  212. destructor TSpeedButtonBordeColor.Destroy;
  213. begin
  214.     AutoDestroy;
  215.     inherited Destroy;
  216. end;
  217.  
  218.  
  219. procedure TSpeedButtonBordeColor.Loaded;
  220. begin
  221.     inherited Loaded;
  222.  
  223.  
  224.     { Perform any component setup that depends on the property
  225.       values having been set }
  226. end;
  227.  
  228.  
  229. procedure TSpeedButtonBordeColor.Paint;
  230. var VarILArgo,VarIAlto:Integer;
  231. begin
  232.     { Make this component look like its parent component by calling  its parent's Paint method. }
  233.     inherited Paint;
  234.       Canvas.Pen.color := FBordeColor ;
  235.       Canvas.Pen.Width:=FAnchoBorde;
  236.       if FStyleBorde<>sbNone then
  237.       begin
  238.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbUp) or (FStyleBorde=sbUpDown) then
  239.         begin//UP
  240.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
  241.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);              //LAgox Altura
  242.         end;
  243.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbDown) or (FStyleBorde=sbUpDown) then
  244.         begin//DOwn
  245.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
  246.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));              //LAgox Altura
  247.         end;
  248.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbLeft) or (FStyleBorde=sbLeftRight) then
  249.         begin //Left
  250.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
  251.           Canvas.LineTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));              //LAgox Altura
  252.         end;
  253.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbRight) or (FStyleBorde=sbLeftRight) then
  254.         begin //Right
  255.           Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
  256.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));              //LAgox Altura
  257.         end;
  258.       { To change the appearance of the component, use the methods  supplied by the component's Canvas property (which is of    type TCanvas).  For example, }
  259.       end;
  260.       if FButtonStyle=SbtColor then
  261.       begin
  262.         Canvas.Pen.color := FColor ;
  263.         Canvas.Pen.Width:=0;
  264.         Canvas.Brush.Color:=FColor;
  265.         Canvas.Brush.Style:=bsSolid;
  266.         Canvas.Rectangle(FBordeSpace+FAnchoBorde+3,FBordeSpace+FAnchoBorde+3,Width-(FBordeSpace+FAnchoBorde+2),Height-(FBordeSpace+FAnchoBorde+2));
  267.         Canvas.Font:=Self.Font;
  268.         VarILArgo:=Canvas.TextWidth(Self.Caption);
  269.         VarIAlto:=Canvas.TextHeight(Self.Caption);
  270.         Canvas.TextOut(((Width div 2)-(VarILArgo div 2)),((Height div 2)-(VarIAlto div 2)),Self.Caption);
  271.       end;
  272.     { Canvas.Rectangle(0, 0, Width, Height); }
  273. end;
  274.  
  275.  
  276. procedure TSpeedButtonBordeColor.WMSize(var Message: TWMSize);
  277. var
  278.     W, H: Integer;
  279. begin
  280.     inherited;
  281.     { Copy the new width and height of the component
  282.       so we can use SetBounds to change both at once }
  283.     W := Width;
  284.     H := Height;
  285.     { Code to check and adjust W and H }
  286.     { Update the component size if we adjusted W or H }
  287.     if (W <> Width) or (H <> Height) then
  288.         inherited SetBounds(Left, Top, W, H);
  289.     { Code to update dimensions of any owned sub-components
  290.       by reading their Height and Width properties and updating
  291.       via their SetBounds methods }
  292.     Message.Result := 0;
  293. end;
  294.  
  295.  
  296. procedure TSpeedButtonBordeColor.PressKey(KEyDef: TKeysValid;var Key: Word; Shift: TShiftState);
  297. begin
  298.     if KEyDef=kESC then ShowMessage('ESCOK');
  299.     if KEyDef=kENTER then ShowMessage('ENTEROK');
  300.   if Key =VK_ESCAPE then ShowMessage('Escape');
  301.       if Key =VK_RETURN then ShowMessage('Enter');
  302.  
  303.  
  304.     case Key of
  305.       VK_ESCAPE:begin
  306.                   if FKeyDefault=kESC then ShowMessage('ESC');
  307.                 end;
  308.       VK_RETURN:begin
  309.                   if FKeyDefault=kENTER then ShowMessage('Enter');
  310.                   if Self.FKeyDefault=kENTER then ShowMessage('Enter');
  311.                   if KeyDefault=kENTER then ShowMessage('Enter');
  312.                   if Self.KeyDefault=kENTER then ShowMessage('Enter');
  313.                 end;
  314.       VK_F1    :begin
  315.                   if (Key=VK_F1) and (Shift=[]) then if FKeyDefault=kF1 then ShowMessage('F1');
  316.                   if (Key=VK_F1) and (Shift=[ssCtrl]) then if FKeyDefault=kCTRL_F1 then ShowMessage('CONTROL + F1');
  317.                   if (Key=VK_F1) and (Shift=[ssShift]) then if FKeyDefault=kSHIFT_F1 then ShowMessage('SHIFT + F1');
  318.                 end;
  319.     end;
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.     case KEyDef of
  327.     kENTER:    if Key=VK_RETURN then
  328.                 begin
  329.                     ShowMessage('HA pulsado Enter');
  330.                     Click;
  331.                 end;
  332.     kESC:      if Key=VK_ESCAPE then Click;
  333.     kDOWN:    if Key=VK_DOWN then Click;
  334.     kUP:      if Key=VK_UP then Click;
  335.     kLEFT:    if Key=VK_LEFT then Click;
  336.     kRIGHT:    if Key=VK_RIGHT then Click;
  337.     kF1:      if Key=VK_F1 then Click;
  338.     kF2:      if Key=VK_F2 then Click;
  339.     kF3:      if Key=VK_F3 then Click;
  340.     kF4:      if Key=VK_F4 then Click;
  341.     kF5:      if Key=VK_F5 then Click ;
  342.     kF6:      if Key=VK_F6 then Click ;
  343.     kF7:      if Key=VK_F7 then Click;
  344.     kF8:      if Key=VK_F8 then Click ;
  345.     kF9:      if Key=VK_F9 then Click;
  346.     kF10:      if Key=VK_F10 then Click;
  347.     kF11:      if Key=VK_F11 then Click;
  348.     kF12:      if Key=VK_F12 then Click;
  349.     kCTRL_F1:  if (Key=VK_F1) and (Shift=[ssCtrl]) then Click;
  350.     kCTRL_F2:  if (Key=VK_F2) and (Shift=[ssCtrl]) then Click;
  351.     kCTRL_F3:  if (Key=VK_F3) and (Shift=[ssCtrl]) then Click;
  352.     kCTRL_F4:  if (Key=VK_F4) and (Shift=[ssCtrl]) then Click;
  353.     kCTRL_F5:  if (Key=VK_F5) and (Shift=[ssCtrl]) then Click;
  354.     kCTRL_F6:  if (Key=VK_F6) and (Shift=[ssCtrl]) then Click;
  355.     kCTRL_F7:  if (Key=VK_F7) and (Shift=[ssCtrl]) then Click;
  356.     kCTRL_F8:  if (Key=VK_F8) and (Shift=[ssCtrl]) then Click;
  357.     kCTRL_F9:  if (Key=VK_F9) and (Shift=[ssCtrl]) then Click;
  358.     kCTRL_F10: if (Key=VK_F10) and (Shift=[ssCtrl]) then Click;
  359.     kCTRL_F11: if (Key=VK_F11) and (Shift=[ssCtrl]) then Click;
  360.     kCTRL_F12: if (Key=VK_F12) and (Shift=[ssCtrl]) then Click;
  361.     kSHIFT_F1: if (Key=VK_F1) and (Shift=[ssShift]) then Click;
  362.     kSHIFT_F2: if (Key=VK_F2) and (Shift=[ssShift]) then Click;
  363.     kSHIFT_F3: if (Key=VK_F3) and (Shift=[ssShift]) then Click;
  364.     kSHIFT_F4: if (Key=VK_F4) and (Shift=[ssShift]) then Click;
  365.     kSHIFT_F5: if (Key=VK_F5) and (Shift=[ssShift]) then Click;
  366.     kSHIFT_F6: if (Key=VK_F6) and (Shift=[ssShift]) then Click;
  367.     kSHIFT_F7: if (Key=VK_F7) and (Shift=[ssShift]) then Click;
  368.     kSHIFT_F8: if (Key=VK_F8) and (Shift=[ssShift]) then Click;
  369.     kSHIFT_F9: if (Key=VK_F9) and (Shift=[ssShift]) then Click;
  370.     kSHIFT_F10:if (Key=VK_F10) and (Shift=[ssShift]) then Click;
  371.     kSHIFT_F11:if (Key=VK_F11) and (Shift=[ssShift]) then Click;
  372.     kSHIFT_F12:if (Key=VK_F12) and (Shift=[ssShift]) then Click;
  373.     end;
  374. end;
  375.  
  376.  
  377.  
  378.  
  379. 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
  1. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  2.   Shift: TShiftState);
  3. begin
  4. TSpeedButtonBordeColor(Sender).PressKey(TSpeedButtonBordeColor(Sender).KeyDefault,key,Shift);
  5. end;




Se agradece como siempre una mano de por que no funciona????
  • 0

#9 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 02 noviembre 2011 - 12:15

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.
  • 0

#10 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.142 mensajes
  • LocationMéxico

Escrito 02 noviembre 2011 - 12:18

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
  • 0

#11 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 02 noviembre 2011 - 12:38

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.
  • 0

#12 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.142 mensajes
  • LocationMéxico

Escrito 02 noviembre 2011 - 12:43

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



delphi
  1.   TSimpleRWSync = class(TInterfacedObject, IReadWriteSync)



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



delphi
  1.   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
  • 0

#13 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 02 noviembre 2011 - 01:03

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.
  • 0

#14 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.142 mensajes
  • LocationMéxico

Escrito 02 noviembre 2011 - 01:08

Ya entiendo, muy interesante este asunto :)

Salud OS
  • 0

#15 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 03 noviembre 2011 - 08:32

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
  1. unit SpeedButtonEx;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Forms, Messages, Classes, Controls, Buttons;
  7.  
  8. type
  9.   TSpeedButtonEx = class(TSpeedButton)
  10.   private
  11.     FOnKeyDown: TKeyEvent;
  12.     FOnKeyPress: TKeyPressEvent;
  13.     FOnKeyUp: TKeyEvent;
  14.     FOldWndProc: TWndMethod;
  15.   protected
  16.     procedure HookFormWndProc(var Message: TMessage);
  17.   public
  18.     constructor Create(AOwner: TComponent); override;
  19.     destructor  Destroy; override;
  20.   published
  21.     property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
  22.     property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
  23.     property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  24.   end;
  25.  
  26. procedure Register;
  27.  
  28. implementation
  29.  
  30. procedure Register;
  31. begin
  32.   RegisterComponents('Samples', [TSpeedButtonEx]);
  33. end;
  34.  
  35. constructor TSpeedButtonEx.Create(AOwner: TComponent);
  36. begin
  37.   inherited Create(AOwner);
  38.   if not(csDesigning in ComponentState) and (Owner <> nil) then
  39.     with AOwner as TControl do
  40.     begin
  41.       FOldWndProc:= WindowProc;
  42.       WindowProc:= HookFormWndProc;
  43.     end;
  44. end;
  45.  
  46. destructor TSpeedButtonEx.Destroy;
  47. begin
  48.   if (Owner <> nil) then
  49.     with Owner as TControl do
  50.       WindowProc:= FOldWndProc;
  51.   inherited Destroy;
  52. end;
  53.  
  54. procedure TSpeedButtonEx.HookFormWndProc(var Message: TMessage);
  55. var
  56.   Key: WORD;
  57.   Shift: TShiftState;
  58.   C: CHAR;
  59. begin
  60.   with Owner as TControl do
  61.   begin
  62.     case Message.Msg of
  63.       WM_KEYUP:
  64.         if Assigned(FOnKeyUp) then
  65.         begin
  66.           Key:= Message.wParam;
  67.           FOnKeyUp(Self, Key, KeyDataToShiftState(Message.lParam));
  68.           Message.wParam:= Key;
  69.         end;
  70.       WM_KEYDOWN:
  71.         if Assigned(FOnKeyDown) then
  72.         begin
  73.           Key:= Message.wParam;
  74.           FOnKeyDown(Self, Key, KeyDataToShiftState(Message.lParam));
  75.           Message.wParam:= Key;
  76.         end;
  77.       WM_CHAR:
  78.         if Assigned(FOnKeyPress) then
  79.         begin
  80.           C:= CHAR(Message.wParam);
  81.           FOnKeyPress(Self, C);
  82.           Message.wParam:= WORD(C);
  83.         end;
  84.     end;
  85.   end;
  86.   FOldWndProc(Message);
  87. end;
  88.  
  89. end.



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

Saludos.

  • 0

#16 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 03 noviembre 2011 - 11:51

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,.
  • 0

#17 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 06 noviembre 2011 - 02:35

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
  1. //***********************************************[ SpeedButtonBordeColor ]******
  2. // Componente Creado por JLGT 2011-  El Componente es Free, por lo que podeis
  3. // Modificarlo y usarlo libremente sin mencion ni solicitud alguna por mi parte
  4. //------------------------------------------------------------------------------
  5. //--[Metodos y Eventos]---------------------------------------------------------
  6. // AnchoBorde : Integer;      Es el valor del Ancho del Borde si StyleBorde es diferente de  sbNone
  7. // BordeSpace : Integer;      Espacio a dejar entre los Filos del Speedbutton y donde dibujamos el nuevo borde
  8. // BordeColor : TColor;        Color del Borde
  9. // Color      : TColor;        Color del relleno interior si ButtonStyle  es SbtColor
  10. // StyleBorde : TStyleBorde;  Estilos del Borde, (cada lado por separado, arriba y abajo, derecha y izquierda y
  11. //                            Completo los cuato lados)
  12. // ButtonStyle: TButtonStyle;  Permite elegir tal Cual, admitiendo imagen, o con relleno de color, en este apartado,
  13. //                            si tenemos el texto muy grande o una imagen puesta , se pueden ver por debajo del
  14. //                            relleno arruinando el efecto
  15. //------------------------------------------------------------------------------
  16. unit SPBBC;
  17.  
  18.  
  19. interface
  20.  
  21.  
  22. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
  23.     Forms, Graphics, Buttons;
  24.  
  25.  
  26. type
  27.   //Estilos de Borde
  28.   TStyleBorde=(sbNone, sbComplet,sbUp,sbDown,sbLeft,sbRight,sbUpDown,sbLeftRight);
  29.   //Estilo del botón
  30.   TButtonStyle=(SbtImagen,SbtColor);
  31.  
  32.  
  33.   TSpeedButtonBC = class(TSpeedButton)
  34.     private
  35.         FAnchoBorde : Integer;
  36.         FBordeSpace : Integer;
  37.         FBordeColor : TColor;
  38.         FColor : TColor;
  39.         FStyleBorde: TStyleBorde;
  40.         FButtonStyle: TButtonStyle;
  41.         procedure AutoInitialize;
  42.         function GetBordeSpace : Integer;
  43.         procedure SetBordeSpace(Value : Integer);
  44.         function GetStyleBorde:TStyleBorde;
  45.         procedure SetStyleBorde(value:TStyleBorde);
  46.         function GetButtonStyle:TButtonStyle;
  47.         procedure SetButtonStyle(Value:TButtonStyle);
  48.         procedure WMSize(var Message: TWMSize); message WM_SIZE;
  49.     protected
  50.         procedure Click; override;
  51.         procedure Loaded; override;
  52.         procedure Paint; override;
  53.     public
  54.         constructor Create(AOwner: TComponent); override;
  55.         destructor Destroy; override;
  56.     published
  57.         property OnClick;
  58.         property OnDblClick;
  59.         property OnDragDrop;
  60.         property OnMouseDown;
  61.         property OnMouseMove;
  62.         property OnMouseUp;
  63.         property StyleBorder:TStyleBorde      read GetStyleBorde    write SetStyleBorde    default sbNone;
  64.         property ButtonStyle:TButtonStyle    read GetButtonStyle  write SetButtonStyle    default SbtImagen;
  65.         property AnchoBorder : Integer        read FAnchoBorde      write FAnchoBorde      default 3;
  66.         property BoderSpace : Integer        read GetBordeSpace    write SetBordeSpace    default 2;
  67.         property BorderColor : TColor        read FBordeColor      write FBordeColor      default clbtnface;
  68.         property Color : TColor              read FColor          write FColor            default clbtnface;
  69.   end;
  70.  
  71.  
  72. procedure Register;
  73.  
  74.  
  75. implementation
  76.  
  77.  
  78. procedure Register;
  79. //------------------------------------------------------------------------------
  80. //************************************************************[ Register ]******
  81. // Donde registramos El Componente
  82. //------------------------------------------------------------------------------
  83. begin
  84.   RegisterComponents('BOTONES', [TSpeedButtonBC]);
  85. end;
  86.  
  87.  
  88. procedure TSpeedButtonBC.AutoInitialize;
  89. //------------------------------------------------------------------------------
  90. //******************************************************[ AutoInitialize ]******
  91. // Como se incia el componente
  92. //------------------------------------------------------------------------------
  93. begin
  94.   FAnchoBorde := 3;
  95.   FBordeSpace := 2;
  96.   FColor := clbtnface;
  97.   FBordeColor:=clBtnFace;
  98.   FStyleBorde:=sbNone;
  99.   FButtonStyle:=SbtImagen;
  100. end;
  101.  
  102.  
  103. function TSpeedButtonBC.GetBordeSpace : Integer;
  104. //------------------------------------------------------------------------------
  105. //*******************************************************[ GetBordeSpace ]******
  106. // leer del Dato BordeSpace
  107. //------------------------------------------------------------------------------
  108. begin
  109.   Result := FBordeSpace;
  110.   Repaint;
  111. end;
  112.  
  113.  
  114. function TSpeedButtonBC.GetStyleBorde;
  115. //------------------------------------------------------------------------------
  116. //*******************************************************[ GetStyleBorde ]******
  117. // leer del Dato StyleBorde
  118. //------------------------------------------------------------------------------
  119. begin
  120.   Result:=FStyleBorde;
  121.   Repaint;
  122. end;
  123.  
  124.  
  125. function TSpeedButtonBC.GetButtonStyle;
  126. //------------------------------------------------------------------------------
  127. //******************************************************[ GetButtonStyle ]******
  128. // leer del Dato ButtonStyle
  129. //------------------------------------------------------------------------------
  130. begin
  131.   Result:=FButtonStyle;
  132.   Repaint;
  133. end;
  134.  
  135.  
  136. procedure TSpeedButtonBC.SetBordeSpace(Value : Integer);
  137. //------------------------------------------------------------------------------
  138. //*******************************************************[ SetBordeSpace ]******
  139. // Asignamos el nuevo valor a BordeSpace
  140. //------------------------------------------------------------------------------
  141. begin
  142.   FBordeSpace := Value;
  143.   Repaint;
  144. end;
  145.  
  146.  
  147. procedure TSpeedButtonBC.SetStyleBorde(value: TStyleBorde);
  148. //------------------------------------------------------------------------------
  149. //*******************************************************[ SetStyleBorde ]******
  150. // Asignamos el nuevo valor a StyleBorde
  151. //------------------------------------------------------------------------------
  152. begin
  153.   FStyleBorde:=value;
  154.   Repaint;
  155. end;
  156.  
  157.  
  158. procedure TSpeedButtonBC.SetButtonStyle;
  159. //------------------------------------------------------------------------------
  160. //******************************************************[ SetButtonStyle ]******
  161. // Asignamos el nuevo valor a ButtonStyle
  162. //------------------------------------------------------------------------------
  163. begin
  164.   FButtonStyle:=Value;
  165.   Repaint;
  166. end;
  167.  
  168.  
  169. procedure TSpeedButtonBC.Click;
  170. //------------------------------------------------------------------------------
  171. //***************************************************************[ Click ]******
  172. // Al Pulsar en  SetButtonStyle
  173. //------------------------------------------------------------------------------
  174. begin
  175.   inherited Click;
  176. end;
  177.  
  178.  
  179. constructor TSpeedButtonBC.Create(AOwner: TComponent);
  180. //------------------------------------------------------------------------------
  181. //**************************************************************[ Create ]******
  182. // Creación del Componente
  183. //------------------------------------------------------------------------------
  184. begin
  185.   inherited Create(AOwner);
  186.   AutoInitialize;
  187. end;
  188.  
  189.  
  190. destructor TSpeedButtonBC.Destroy;
  191. //------------------------------------------------------------------------------
  192. //*************************************************************[ Destroy ]******
  193. // Destrucción del Componente
  194. //------------------------------------------------------------------------------
  195. begin
  196.   inherited Destroy;
  197. end;
  198.  
  199.  
  200. procedure TSpeedButtonBC.Loaded;
  201. //------------------------------------------------------------------------------
  202. //**************************************************************[ Loaded ]******
  203. // Carga del Componente
  204. //------------------------------------------------------------------------------
  205. begin
  206.   inherited Loaded;
  207. end;
  208.  
  209.  
  210. procedure TSpeedButtonBC.Paint;
  211. //------------------------------------------------------------------------------
  212. //***************************************************************[ Paint ]******
  213. // Dibujado del Componente
  214. //------------------------------------------------------------------------------
  215. var VarILArgo,VarIAlto:Integer;
  216. begin
  217.   inherited Paint;
  218.   Canvas.Pen.color := FBordeColor ;
  219.   Canvas.Pen.Width:=FAnchoBorde;
  220.   if FStyleBorde<>sbNone then
  221.   begin
  222.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbUp) or (FStyleBorde=sbUpDown) then
  223.         begin//dibujamo Arriva
  224.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
  225.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
  226.         end;
  227.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbDown) or (FStyleBorde=sbUpDown) then
  228.         begin//Dibujamos abajo
  229.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
  230.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
  231.         end;
  232.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbLeft) or (FStyleBorde=sbLeftRight) then
  233.         begin //Dibujamoa a la Izquierda
  234.           Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
  235.           Canvas.LineTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
  236.         end;
  237.         if (FStyleBorde=sbComplet) or (FStyleBorde=sbRight) or (FStyleBorde=sbLeftRight) then
  238.         begin //Dibujamoa a la derecha
  239.           Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
  240.           Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
  241.         end;
  242.   end;
  243.   if FButtonStyle=SbtColor then
  244.   begin  //Para dibujar el Relleno
  245.         Canvas.Pen.color := FColor ;
  246.         Canvas.Pen.Width:=0;
  247.         Canvas.Brush.Color:=FColor;
  248.         Canvas.Brush.Style:=bsSolid;
  249.         Canvas.Rectangle(FBordeSpace+FAnchoBorde+3,FBordeSpace+FAnchoBorde+3,Width-(FBordeSpace+FAnchoBorde+2),Height-(FBordeSpace+FAnchoBorde+2));
  250.         Canvas.Font:=Self.Font;
  251.         VarILArgo:=Canvas.TextWidth(Self.Caption);
  252.         VarIAlto:=Canvas.TextHeight(Self.Caption);
  253.         Canvas.TextOut(((Width div 2)-(VarILArgo div 2)),((Height div 2)-(VarIAlto div 2)),Self.Caption);
  254.   end;
  255. end;
  256.  
  257.  
  258. procedure TSpeedButtonBC.WMSize(var Message: TWMSize);
  259. //------------------------------------------------------------------------------
  260. //**************************************************************[ WMSize ]******
  261. // Para controlar el tamaño
  262. //------------------------------------------------------------------------------
  263. var W, H: Integer;
  264. begin
  265.   inherited;
  266.   W := Width;
  267.   H := Height;
  268.   if (W <> Width) or (H <> Height) then inherited SetBounds(Left, Top, W, H);
  269.   Message.Result := 0;
  270. end;
  271. 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
  • 0

#18 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 06 noviembre 2011 - 06:35

... 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.
  • 0

#19 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.292 mensajes
  • LocationArgentina

Escrito 06 noviembre 2011 - 07:42

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.
  • 0

#20 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.950 mensajes
  • LocationMadrid - España

Escrito 07 noviembre 2011 - 06:10


... 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
  1. //------------------------------------------------------------------------------
  2. // Boton SpeedButtonEx:
  3. // Se añaden los eventos de teclado por Hook: OnKeyDown y OnKeyUp
  4. //
  5. // Escrito por escafandra 7-nov-2011.
  6. // Delphiaccess.com
  7. //------------------------------------------------------------------------------
  8.  
  9. unit SpeedButtonEx;
  10.  
  11. interface
  12.  
  13. uses
  14.   SysUtils, Forms, Windows, Messages, Classes, Controls, Buttons;
  15.  
  16. type
  17.   TSpeedButtonEx = class(TSpeedButton)
  18.   private
  19.     FOnKeyDown: TKeyEvent;
  20.     FOnKeyUp: TKeyEvent;
  21.   protected
  22.     procedure WndProc(var Message: TMessage); override;
  23.   public
  24.     constructor Create(AOwner: TComponent); override;
  25.     destructor  Destroy; override;
  26.   published
  27.     property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
  28.     property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
  29.   end;
  30.  
  31. procedure Register;
  32.  
  33. implementation
  34. var
  35.   WHookKeyboard: HHOOK = 0;
  36.  
  37.  
  38. procedure Register;
  39. begin
  40.   RegisterComponents('Samples', [TSpeedButtonEx]);
  41. end;
  42.  
  43. procedure Broadcast(var Message);
  44. var
  45.   I: Integer;
  46. begin
  47.   with Screen.ActiveForm do
  48.   begin
  49.     for I := 0 to ControlCount - 1 do
  50.       if Controls[I].ClassName = 'TSpeedButtonEx' then
  51.         Controls[I].WindowProc(TMessage(Message));
  52.   end;
  53. end;
  54.  
  55. function KeyboardHook(Code, wParam, lParam: Integer): integer; stdcall;
  56. var
  57.   Msg: TMessage;
  58. begin
  59.   if Code = HC_ACTION then
  60.   begin
  61.     Msg.Msg := WM_KEYDOWN;
  62.     if (lParam and $80000000) = $80000000 then
  63.       Msg.Msg := WM_KEYUP;
  64.     Msg.WParam := wParam;
  65.     Msg.LParam := lParam;
  66.     Msg.Result := 0;
  67.     Broadcast(Msg);
  68.   end;
  69.   Result:= CallNextHookEx(WHookKeyboard, Code, wParam, lParam);
  70. end;
  71.  
  72. constructor TSpeedButtonEx.Create(AOwner: TComponent);
  73. begin
  74.   inherited Create(AOwner);
  75.   FOnKeyDown:= nil;
  76.   FOnKeyUp:= nil;
  77.   if not(csDesigning in ComponentState) and (WHookKeyboard = 0) then
  78.     WHookKeyboard:= SetWindowsHookEx(WH_KEYBOARD, KeyboardHook, 0, GetCurrentThreadId);
  79. end;
  80.  
  81. destructor TSpeedButtonEx.Destroy;
  82. begin
  83.   inherited Destroy;
  84.   if (WHookKeyboard <> 0) then
  85.     UnhookWindowsHookEx(WHookKeyboard);
  86. end;
  87.  
  88. procedure TSpeedButtonEx.WndProc(var Message: TMessage);
  89. var
  90.   Key: WORD;
  91. begin
  92.   case Message.Msg of
  93.     WM_KEYUP:
  94.       if Assigned(FOnKeyUp) then
  95.       begin
  96.         Key:= Message.wParam;
  97.         FOnKeyUp(Self, Key, KeyDataToShiftState(Message.lParam));
  98.         Message.wParam:= Key;
  99.       end;
  100.     WM_KEYDOWN:
  101.       if Assigned(FOnKeyDown) then
  102.       begin
  103.         Key:= Message.wParam;
  104.         FOnKeyDown(Self, Key, KeyDataToShiftState(Message.lParam));
  105.         Message.wParam:= Key;
  106.       end;
  107.   end;
  108.   inherited WndProc(Message);
  109. end;
  110.  
  111. 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.
  • 0