Al modificar MaxLength ajustar TEdit.Width

[elGuerrero]

Hice un componente TEditor derivado de TEdit y deseo añadirle la funcionalidad de que:

Si Autosize:=True y MaxLength<>0,
Entonces se modifique el valor de Width para que se ajuste al número de caracteres máximo.

Ese nuevo valor de Width debe tomar en cuenta el Font definido para el componente y el cambio debe ser visible en tiempo de diseño y en tiempo de ejecución.

Actualmente, en una child Form incluyo mi componente TEditor y modifico esas propiedades en tiempo de diseño y no se ajusta el Width.

Para calcular el ancho he visto algunos códigos por la red pero no he encontrado cómo atrapar/generar el evento que indique la modificación del valor de Autosize o de MaxLength para asignar el nuevo valor a Width.

Gracias por adelantado.

[ecfisa]

Hola elGuerrero.

Creo que podrías hacer algo así:

Código Delphi [-]
...
type
  TMiEdit = class(TEdit)
  private
    FAutoWidth: Boolean;
    procedure SetAutoWidth(const Value: Boolean);
    ...
  public
    property AutoWidth: Boolean read FAutoWidth write SetAutoWidth default True;
    ...
  end;

implementation

...

procedure TMiEdit.SetAutoWidth(const Value: Boolean);
var
  B: TBitMap;
begin
  if (FAutoWidth <> Value) and (MaxLength <> 0) then
  begin
    B:= TBitMap.Create;
    try
      FAutoWidth:= Value;
      B.Canvas.Font.Assign(Font);
      Width:= B.Canvas.TextWidth(' '+Text+' ')
    finally
      B.Free
    end;
  end;
end;
...

Saludos.

[Neftali [Germán.Estévez]]

Empezado por elGuerrero

Para calcular el ancho he visto algunos códigos por la red pero no he encontrado cómo atrapar/generar el evento que indique la modificación del valor de Autosize o de MaxLength para asignar el nuevo valor a Width.

Yo probaría redefiniendo estos dos métodos (revisa el código de StdCtrls.pas)

Código Delphi [-]

procedure SetAutoSize(Value: Boolean); override;

procedure DoSetMaxLength(Value: Integer); virtual;

El primero es el método de la propiedad AutoSize, y el segundo se llama directamente desde el método SetMaxLength.

[elGuerrero]

Gracias a ambos por sus ideas. Me hicieron sentido, pero creo que me falta un detalle técnico para implementarlas en mi componente.

Al componente que hice le asigne un monospaced font para que fuera un ancho constante, lo incluyo en el Form y le modifico las propiedades en tiempo de diseño pero no me ha funcionado.

Les adjunto lo esencial del código, esperando me puedan orientar para corregir mi error:

unit Editor;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Forms,
  Graphics, ExtCtrls, StrUtils;

type
  TEditor = class(TEdit)
  protected
    procedure SetAutoSize(Value: Boolean); override;
    procedure DoSetMaxLength(Value: Integer); virtual;
    procedure AjustarWidth;
  public
   end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Comunes', [TEditor]);
end;

procedure TEditor.SetAutoSize(Value: Boolean);
var bCambio: Boolean;
begin
  bCambio:= Value <> AutoSize;
  inherited;
  if bCambio then AjustarWidth;
end;

procedure TEditor.DoSetMaxLength(Value: Integer);
begin
  AjustarWidth;
  inherited;
end;

procedure TEditor.AjustarWidth;
var
  B: TBitMap;
  sText: String;
begin
  if (AutoSize) and (MaxLength > 0) then
    begin
    //Calculo ancho de una cadena completa, 
    //pues regularmente Text no estará al máximo
    sText:= #32+ DupeString('X', MaxLength) +#32;
    //
    B:= TBitMap.Create;
    try
      B.Canvas.Font.Assign(Font);
      Width:= B.Canvas.TextWidth(sText)
    finally
      B.Free
    end;//try

    end;//if
end;

END.

Gracias por adelantado.

[elGuerrero]

H!

Buscando en la red, encontré un código de A. Johnson para lo redimensionar el componente TEdit. Lo adapté y si funcionó:

procedure TEditor.AjustarWidth;
var
  DC: HDC;
  SaveFont: HFont;
  Size: TSize;
  sText: String;
begin
  if (AutoSize) and (MaxLength > 0) then
    begin
    if not HandleAllocated then exit;
    DC := GetDC(handle);
    try
      SaveFont := SelectObject(DC, Font.Handle);
      sText:= DupeString('X', MaxLength);
      if GetTextExtentPoint32(DC, pchar(sText), length(sText), Size) then
          ClientWidth:= Size.cx;
      SelectObject(DC, SaveFont);
    finally
      ReleaseDC(handle, DC);
    end;
    end;//if
end;

La llamada a este procedimiento la hago desde CreateWnd, SetAutoSize y DoSetMaxLength:

procedure TEditor.CreateWnd;
begin
  inherited CreateWnd;
  AjustarWidth;
end;

procedure TEditor.SetAutoSize(Value: Boolean);
begin
  inherited;
  AjustarWidth;
end;

procedure TEditStr.DoSetMaxLength(Value: Integer);
begin
  AjustarWidth;
  inherited;
end;

Sin embargo, funciona a medias. En tiempo de diseño, cuando modificó SetAutoSize y luego MaxLength, no cambia el ancho del componente visual TEditor, pero si lo hago al revés, si lo cambia. También lo cambia, cuando cambio SetAutoSize, MaxLength y vuelvo a poner la propiedad SetAutoSize.

¿Qué me estará faltando?
¿No habrá otra manera de llamar el procedimiento AjustarWidth cuando se cambie el valor de MaxLength?
Espero puedan ayudarme. Gracias de antemano.

[elGuerrero]

La solución anterior me ocasionó problemas en la apariencia del componente pues borraba el contenido de él, no actualizaba cuando cambiaba la MaxLength y otros detalles.
Se me ocurrió hacerlo a través de WMPaint, que se ejecuta al redibujar el control, así que recargue los procedimientos

  TEditor = class(TEdit)
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetAutoSize(Value: Boolean); override;
    procedure DoSetMaxLength(Value: Integer); virtual;
  end;

Luego en la sección de implementationredefiní el procedimiento

procedure TEditor.WMPaint(var Msg: TWMPaint);
var
  sText: String;
  MCanvas: TControlCanvas;
begin
  if (AutoSize) and (MaxLength > 0) then
    Begin
    MCanvas := TControlCanvas.Create;
    try
      MCanvas.Control   := Self;
      MCanvas.Font      := Self.Font;
      sText:= DupeString('X', MaxLength+2);
      Self.Width:= MCanvas.TextWidth(sText);
    finally
      MCanvas.Free;
    end; //try
    End;
  Inherited;
end;

Para forzarlo a redibujar el componente, utilicé RePaint en los mismos procedimientos:

procedure TEditor.SetAutoSize(Value: Boolean);
begin
  inherited;
  Repaint;
end;

procedure TEditor.DoSetMaxLength(Value: Integer);
begin
  inherited;
  Repaint;
end;

procedure TEditor.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

Y ahora si, ya está funcionando como deseaba.

Esta solución la terminé consultando varios códigos fuente, sin embargo, tengo duda en cuanto a que si tengo bugs en el código o errores de diseño ¿Uds. qué creen?
Les agradezco de antemano sus respuestas.