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

[hoika]

Hallo,

mit direktem WinAPI habe ich mich lange nicht beschäftigt.

Vielleicht bringt es ja MoveWindow.
Das Fenster-Handle hast du ja.

MoveWindow

Du hast nat. vielleicht Recht, dass das MoveWindow auch wieder eine WM_SIZE Message erzeugt.

Viell. setzt du ja in der Hook-Funktion das wieder um (unbeabsichtigt).

Probieren ...


Heiko

[sebastianz1983]

Soweit war ich schon. :)
Das verursacht das besagte Flackern des Fensters.
Hab jetzt auch mal versucht, eine WM_SIZING Nachricht in meinem WM_SIZING Handler zu schicken (und meine Routine für das zweite WM_SIZING auszuschalten, dass ich nicht in eine Endlosschleife laufe), aber die wird wohl anscheinend ignoriert.

[hoika]

Hallo,

du könntest ja eine WM_SIZING2 (WM_USER+X) Meldung schicken,
die du besonders handhabst (in dem Fall gar nicht)


Heiko

[sebastianz1983]

Hmmm, ich habe jetzt noch ein wenig mit MoveWindow() bzw. SetWindowPos() rumgespielt, weiß aber nicht genau, wie du das mit WM_SIZING2 meinst. Ich muss ja so und so irgendwie die Fenstergröße setzen. Ein Codebeispiel, wie du dir das vorstellst, wär net schlecht.

[hoika]

Hallo,

du schickst dem Fenster eine WM_SIZING2,
die von dir in der Hook-Funktion anders behandelt wird,
wie die normale WM_SIZING .

War nur so eine Idee.

Warum bastelst du jett mit Hooks rum,
wo es doch schon eine fertige Lösung weiter oben gibt ?

Musst halt mal in Google suchen,
ob man die WM_SIZE Messages irgendwie umgehen kann.

Mir fällt da nix ein.


Heiko

[sebastianz1983]

Ich bastel mit 'nem Hook rum, weil in einem bestehenden Projekt hier in der Arbeit jetzt alle Fenster und deren Controls bei Größenänderung mitskalieren sollen.
Daher war mein erster Ansatz: Machste mal die Fenstergröße erstmal proportional, dann kann man auch die Buttons, Listen, etc. nur proportional in der Größe verändern und hat keine Probleme mit Positionierung der Elemente usw., weil das ja alles ebenfalls proportional geschieht. Das alles funktioniert wunderbar, solange man das direkt als Unit in die einzelnen Forms einbaut, allerdings ist das Programm wie so viele andere Programme über die Jahre gewachsen und hat mittlerweile zu viele Fenster und Dialoge, und natürlich auch etliche Unterschiedliche Methoden, wie diese aufgerufen werden, um diese alle einzeln zu behandeln.
Deswegen war meine Idee, dies über einen Hook zu realisieren und somit auf einen Schlag alle Fenster abhandeln zu können.
Vielleicht gibt's aber auch eine bessere Lösung, die ich im Moment einfach übersehe?
Zumindest mit der WM_SIZING2 ändert sich ja nichts an der Problematik, weil ich ja irgendwie Windows klarmachen muss, dass es gefälligst das jeweilige Fenster proportional vergrößern soll, wenn ich es größer/kleiner ziehe.
Das Problem hierbei ist allerdings offensichtlich, dass das Fenster nach Aufruf von MoveWindow() bzw. SetWindowPos() zwar auf die angegebene Größe gesetzt wird, jedoch sofort danach wieder zurück zur alten Größe gesetzt wird. Warum weiß ich nicht, weil es ja von mir durch die oben erwähnten Funktionen bereits mitbekommt, wie groß es dargestellt werden soll.
Den Ansatz von mir, die Werte über lParam zu setzen (das funktioniert, solange ich ohne den Hook arbeite), hast du mir ja schon zunichte gemacht. :wink:
Bisher hab ich bei Google (und auch hier) nix gefunden, deswegen bin ich ja jetzt aktiv geworden und schreib hier diesen schönen Beitrag. :wink:
Bin für jeden weiteren Vorschlag offen - am besten mit Beispielcode, weil ich wie schon erwähnt ziemlich neu in Delphi bin. Würd das nur ungern in jede Form einbinden müssen (zumal ich bei dieser Lösung wahrscheinlich von meinem Chef geköpft werde :wink: )

Sebastian

[hoika]

Hallo,

Zitat:

weil in einem bestehenden Projekt hier in der Arbeit jetzt alle Fenster und deren Controls bei Größenänderung mitskalieren solle

Schon mal an Formular-Vererbung gedacht ?


Heiko

[sebastianz1983]

Zitat:

Zitat von hoika

Hallo,

Zitat:

weil in einem bestehenden Projekt hier in der Arbeit jetzt alle Fenster und deren Controls bei Größenänderung mitskalieren solle

Schon mal an Formular-Vererbung gedacht ?


Heiko

Für die Vererbung muss ich doch wieder alle Formulare anfassen, oder etwa nicht? Geh mal bitte davon aus, dass ich die nicht verändern will und wohl auch nicht darf.

Hab noch ein bisschen rumgespielt und hab jetzt zusätzlich eine Ereignisbehandlung für WM_SIZE eingebaut, die via SendMessage() eine weitere WM_SIZE Nachricht (mit der von mir gewollten Größe des Fensters) wirft.

Hier mal der aktuell von mir abgeänderte Code:

Delphi-Quellcode:

unit TestSizeHook;

interface

procedure StartProportionalSizing; stdcall; forward;
procedure StopProportionalSizing; stdcall; forward;

implementation
uses Windows, Forms, Dialogs, Messages, SysUtils, Math, Classes, Controls,
  Types;

var
  glbSizeHook: cardinal = 0;
  glbRatio: single;
  glbHookRunning: boolean = FALSE;
  glbWindowRect: TRect;

function Hook(code: Integer; W: wParam; L: lParam): LResult; stdcall;
type
  pCWPStruct = ^CWPSTRUCT;

var
  currentCWP: CWPSTRUCT;
  windowRect: TRect;
  PWindowRect: PRect;
  newSize: integer;

begin
  if (code >= HC_ACTION) then begin
    currentCWP := pCWPStruct(L)^;

    case currentCWP.message of
      WM_ENTERSIZEMOVE: begin
        if GetWindowRect(currentCWP.hwnd, windowRect) then
          glbRatio := (windowRect.Right - windowRect.Left) / (windowRect.Bottom - windowRect.Top);
      end;

      WM_SIZING: begin
        if not glbHookRunning then begin
          PWindowRect := PRect(currentCWP.LParam);
          glbWindowRect := PWindowRect^;
          case currentCWP.WParam of
            WMSZ_BOTTOM, WMSZ_TOP,
            WMSZ_TOPLEFT, WMSZ_TOPRIGHT, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT: begin
              newSize := trunc(SimpleRoundTo((PWindowRect.Bottom - PWindowRect.Top + 1) * glbRatio, 0));
              PWindowRect.Right := PWindowRect.Left + newSize;
            end;

            WMSZ_LEFT, WMSZ_RIGHT: begin
              newSize := trunc(SimpleRoundTo((PWindowRect.Right - PWindowRect.Left + 1) / glbRatio, 0));
              PWindowRect.Bottom := PWindowRect.Top + newSize;
            end;
          end;
          MoveWindow(currentCWP.hwnd,
                     PWindowRect.Left,
                     PWindowRect.Top,
                     PWindowRect.Right - PWindowRect.Left,
                     PWindowRect.Bottom - PWindowRect.Top,
                     TRUE);
          glbHookRunning := TRUE;
        end;
      end;

      WM_SIZE: begin
        if not glbHookRunning then begin
          newSize := WORD(glbWindowRect.Bottom - glbWindowRect.Top) shl (SizeOf(WORD) * 8) + WORD(glbWindowRect.Right - glbWindowRect.Left);
          SendMessage(currentCWP.hwnd, WM_SIZE, w, newSize);
          glbHookRunning := TRUE;
        end;
      end;
    end;
    glbHookRunning := FALSE;
  end;

  result := CallNextHookEx(glbSizeHook, code, w, l);
end;

procedure StartProportionalSizing;
begin
  if glbSizeHook = 0 then
    glbSizeHook := SetWindowsHookEx(WH_CALLWNDPROC, @Hook, 0, GetCurrentThreadID());
end;

procedure StopProportionalSizing;
begin
  if glbSizeHook <> 0 then
    UnhookWindowsHookEx(glbSizeHook);
end;

end.

Ergebnis hierbei:
Das Flackern wird geringer. Da sowohl in der WM_SIZING als auch in der WM_SIZE die korrekte Größe des Fensters gesetzt wird. Das ist allerdings auch noch nicht das Gelbe vom Ei, weil am Ende wohl doch nochmal ein WM_SIZE von Windows abgearbeitet wird, das die Größe wieder auf die ursprüngliche setzt.

Aus meiner Sicht fehlt mir nur noch das Abfangen (und Verwerfen) dieses letzten WM_SIZE Ereignisses, das das Fenster wieder auf die Standardgröße zurücksetzt.

Werden wirklich ALLE Ereignisse eines Threads an einen Threadhook geschickt? Und kann ich dieses Ereignis abhandeln, ohne dass dies an den normalen Handler weitergereicht wird? Dann müsste ich doch auch dieses Ereignis einfach stoppen können, oder nicht?


Sebastian

[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!

[hoika]

Hallo,

du immer noch mit diesem Mi.. ;) (Minnesang, wollte ich schreiben)

Delphi-Quellcode:

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

Das sind globale Variablen, pfui ;)
Ab ins Form damit.

Schau dir mal Formular-Vererbung an,
der Code kommt ins Hauptform
und alle abgeleiteten Forms erben den.


Heiko