change width SysIPAddress32

Viewed 359

I'm trying implement IP edit. This my code:

unit Main;

interface

uses
  System.SysUtils, System.Classes,
  Winapi.Windows, Winapi.Messages, Winapi.CommCtrl,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ComCtrls;

type

  TIpEdit = class(TWinControl)
  strict protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;      
  end;

  TMainForm = class(TForm)
    Btn1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Btn1Click(Sender: TObject);
  private
    FIpEdit: TIpEdit;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TIPEdit }

procedure TIPEdit.CreateParams(var Params: TCreateParams);
begin
  InitCommonControl(ICC_INTERNET_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, WC_IPADDRESS);
  Params.Style := Params.Style or WS_TABSTOP or WS_CHILD;
end;

procedure TIPEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS;
end;

procedure TIPEdit.WMSetFont(var Message: TWMSetFont);
var
  LF: LOGFONT;
begin
  if GetObject(Message.Font, SizeOf(LF), @LF) <> 0 then
  begin
    Message.Font := CreateFontIndirect(LF);
    inherited;
  end;
end;

{ TMainForm }

procedure TMainForm.Btn1Click(Sender: TObject);
begin
  FIpEdit.Width := FIpEdit.Width + 100;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FIpEdit := TIpEdit.Create(Self);
  FIpEdit.Parent := Self;
  FIpEdit.SetBounds(10, 10, 120, 21);
end;

end.

Before Btn1.Click

enter image description here

After Btn1.Click

enter image description here

As a result: Control change own width but not change width internal edits.

I try fix by two ways

  • Use RecreateWnd. This works, but IMHO its ugly solution.
  • Fix internal edits width manualy. This works, but it is difficult to implement, due to the internal work of the control

Maybe I missed something and there is a simpler solution?

Edit:

I tested the RecreateWnd, but it can not be used when using DevExpress layout control. It seems that layout control uses the direct call of the API bypassing the SetBounds method. In this case RecreateWnd can not be using.

The final conclusion is:

  • RecreateWnd is simple solution with some ristrictions
  • RepeatUntil answer more difficult, but always working
2 Answers
Related