Größenverhältnis der Form bei Größenänderung beibehalten

[sebastianz1983]

Hallo nochmal,

nach langem Rumprobieren und -stöbern im Netz bin ich leider immernoch nicht auf eine passende Lösung gestoßen. Daher hab ich jetzt beschlossen, das ganze doch nicht via Hook zu lösen, sondern direkt als Unit im Projekt zu speichern, um zumindest die Funktionalität zur Skalierung eingeschränkt nutzen zu können.
Hier der Code, den ich bisher habe:

Delphi-Quellcode:

unit ResizeForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math, StdCtrls, Buttons, ExtCtrls, ComCtrls, XPMan;

type
  originals = record
    name: TComponentName;
    left: integer;
    top: integer;
    width: integer;
    height: integer;
    fontSize: integer;
    itemHeight: integer;
    columnWidths: Array of integer;
  end;

  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ListBox2: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    DateTimePicker1: TDateTimePicker;
    procedure FormCreate(Sender: TObject);
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
    procedure createControlList(windowHandle: hwnd);
    procedure FWM_Sizing(var AMsg: TMessage); message WM_SIZING;
  end;

var
  Form1: TForm1;
  glbRatio: single;
  glbClientWidth, glbClientHeight: integer;
  glbControlOriginals: Array of originals;

implementation

{$R *.dfm}

  procedure TForm1.createControlList(windowHandle: hwnd);
  var
    i, j: integer;
    controlOriginals: originals;
  begin
    for i := 0 to ComponentCount - 1 do begin
      if Components[i] is TControl then begin
        with controlOriginals do begin
          name := Components[i].Name;
          left := TControl(Components[i]).Left;
          top := TControl(Components[i]).Top;
          width := TControl(Components[i]).Width;
          height := TControl(Components[i]).Height;
        end;
        if Components[i] is TControl then begin
          with TControl(Components[i]) do begin
            controlOriginals.fontSize := Font.Size;
          end;
        end;
        if Components[i] is TListBox then begin
          TListBox(Components[i]).Style := lbOwnerDrawFixed;
          TListBox(Components[i]).OnDrawItem := Form1.ListBoxDrawItem;
          with controlOriginals do
            itemHeight := TListBox(Components[i]).ItemHeight;
        end
        else if Components[i] is TListView then begin
          with controlOriginals do begin
            for j := TListView(Components[i]).Columns.Count - 1 downto 0 do begin
              SetLength(columnWidths,Length(columnWidths)+1);
              columnWidths[High(columnWidths)] := TListView(Components[i]).Columns[j].Width;
            end;
          end;
        end;

        SetLength(glbControlOriginals,Length(glbControlOriginals)+1);
        glbControlOriginals[High(glbControlOriginals)] := controlOriginals;
      end;
    end;
  end;

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    glbClientWidth := ClientWidth;
    glbClientHeight := ClientHeight;
    glbRatio := Height / Width;

    createControlList(Handle);
  end;

  procedure TForm1.FWM_Sizing(var AMsg: TMessage);
  var
    rect: PRect;
    newSize, i, j: integer;
    widthRatio, heightRatio: single;
    control: TControl;
  begin
    rect := PRect(AMsg.LParam);
    case AMsg.WParam of
      WMSZ_BOTTOM, WMSZ_TOP,
      WMSZ_TOPLEFT, WMSZ_TOPRIGHT, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT: begin
        newSize := trunc(SimpleRoundTo((rect.Bottom - rect.Top) / glbRatio, 0));
        rect.Right := rect.Left + newSize;
      end;

      WMSZ_LEFT, WMSZ_RIGHT: begin
        newSize := trunc(SimpleRoundTo((rect.Right - rect.Left) * glbRatio, 0));
        rect.Bottom := rect.Top + newSize;
      end;
    end;
    widthRatio := ClientWidth / glbClientWidth;
    heightRatio := ClientHeight / glbClientHeight;

    for i := Length(glbControlOriginals) - 1 downto 0 do begin
      control        := TControl(FindComponent(glbControlOriginals[i].name));
      control.Left   := trunc(SimpleRoundTo(glbControlOriginals[i].left * widthRatio, 0));
      control.Top    := trunc(SimpleRoundTo(glbControlOriginals[i].top * heightRatio, 0));
      control.Width  := trunc(SimpleRoundTo(glbControlOriginals[i].width * widthRatio, 0));
      control.Height := trunc(SimpleRoundTo(glbControlOriginals[i].height * heightRatio, 0));
      if control is TControl then begin
        with TControl(control) do begin
          Font.Size := trunc(SimpleRoundTo(glbControlOriginals[i].fontSize * heightRatio, 0));
        end;
      end;
      if control is TListBox then begin
        with TListBox(control) do
          ItemHeight := trunc(SimpleRoundTo(glbControlOriginals[i].itemHeight * heightRatio, 0));
      end
      else if control is TListView then begin
        with TListView(control) do begin
          for j := Length(glbControlOriginals[i].columnWidths) - 1 downto 0 do
            Columns[j].Width := trunc(SimpleRoundTo(glbControlOriginals[i].columnWidths[j] * widthRatio, 0));
        end;
      end;
    end;

    inherited;
  end;

  procedure TForm1.ListBoxDrawItem(control: TWinControl; index: Integer;
    rect: TRect; state: TOwnerDrawState);
  var
    heightRatio: single;
    textHeight: integer;
  begin
    heightRatio := ClientHeight / glbClientHeight;

    with TListBox(control) do begin
      if odSelected in state then begin
        Canvas.Brush.Color := clHighlight;
        Canvas.FillRect(rect);
      end else begin
        Canvas.Brush.Color := clWindow;
        Canvas.FillRect(rect);
      end;
      Font.Size := trunc(SimpleRoundTo(glbControlOriginals[0].fontSize * heightRatio, 0));
      textHeight := Canvas.TextHeight(Items[index]);
      Canvas.TextOut(rect.Left + 2, trunc(simpleRoundTo(rect.Top + (rect.Bottom - rect.Top) / 2 - textHeight / 2,0)), Items[index]);
    end;
  end;
end.

Funktioniert auch soweit ganz gut (siehe Screenshots). Problem hierbei: Das ganze ist momentan an Form1 gebunden. Wie ermögliche ich es, dass diese Funktionalität z. B. beim Aktivieren des Fensters eingebunden wird?
Hab schon mehrere Ansätze durchprobiert, hauptsächlich in Kombination mit Screen.OnActiveFormChange, bin jedoch leider kläglich gescheitert. Problem hierbei ist die dynamische Einbindung der Ereignisbehandlungsroutine für WM_SIZING (die in meinem Beispiel ja bereits zur Designzeit definiert ist (Zeile 39)). Bekomme ich evtl. wieder die gleichen Probleme wie schon bei meinen Versuchen mit dem Hook, dass die Parameter abgefangenen WM_SIZING Nachricht NICHT die Pointer zu den tatsächlichen Werten darstellen? Hat jemand einen Lösungsvorschlag für mich? (am besten mit Beispelcode)

Danke schonmal für die Mühe!