Jump to content
Sign in to follow this  
Followers 0
Gustav Schubert

ClientArea painting problem when MainMenu wraps/unwraps

By Gustav Schubert, in FMX

Recommended Posts

Gustav Schubert    25

Gustav Schubert
Posted

Hi, I have isolated another odd behaviour, and I am just dumping it here, to get it off my mind, and for your entertainment, of course.

FMX only. Windows only. Edge case. Reproducible. With TMainMenu that wraps!

(There are painting problems when ClientHeight is around Screen.WorkingAreaHeight and the number of menu rows changes because of changed ClientWidth.)
  

unit FrmMain;

interface

(*

The goal:

- Maximize ClientHeight, but keep in control of aspect ratio of ClientArea.
- Height should be Screen.WorkAreaHeight.
- Width should be either Portrait (smaller, 800) or Landscape (larger, 1000).
- Need to set Width/Height or ClientWidth/ClientHeight in code.
- Prefer to set ClientWidth/ClientHeight over Width/Height.

The plot thickens:
- Have big TMainMenu component.
- In Portrait MainMenu will wrap into two lines!
- In Landscape MainMenu will fit on one line!

The Problem:
- ClientArea painting problem when MainMenu wraps/unwraps,
  when you toggle between Landscape and Portrait:

Odd:
- MainMenu.Height is not a property.
- Changing MainMenu-Height seems to be part of the problem.
- Missing space to grow the window is another part of the problem?

Usage:
  Press buttons in order given below...

Problem cases:

a) Reset, Portrait, Landscape:
- Black (unpainted) area at the bottom edge.

b) Reset, Button2, Button1:
- Black unpainted area at bottom edge of ClientArea in Window.
- Button1 and Button2 not painted correctly, around bottom edge.

c) Reset, Lanscape, Button1, Landscape:
- Window too big, bottom edge behind task bar.

These cases work as expected:

d) Reset, Portrait
e) Reset, Landscape
f) Reset, Button 1 (like Portrait but via using Height property)
g) Reset, Button 2 (like Lanscape but via using Height property)

Steps:
- In new, empty FMX project
- rename Form to FormMain
- paste test code
- connect FormCreate, FormDestroy, FormKeyUp
- run
- hit keys instead of clicking buttons.

*)

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.UIConsts,
  System.Classes,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Menus,
  FMX.Layouts,
  FMX.Objects;
type
  TFormMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure LandscapeBtnClick(Sender: TObject);
    procedure PortraitBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    ML: TStringList;
    fa: Integer;

    MaxClientHeight: Integer;
    MaxClientHeight1: Integer;
    MaxClientHeight2: Integer;

    MenuHeight1: Integer;
    MenuHeight2: Integer;
    procedure InitMemoText;
    procedure InitMenu;
    procedure UpdateReport;
    function AddMenu(M: TMainMenu; Caption: string): TMenuItem;
    procedure InitItem(I: TMenuItem; fa: Integer);
  public
    MainMenu: TMainMenu;
    MemoText: TText;
//    ResetBtn: TButton;
//    PortraitBtn: TButton;
//    LandscapeBtn: TButton;
//    Button1: TButton;
//    Button2: TButton;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ML := TStringList.Create;

  { record this while there is no MainMenu }
  MaxClientHeight := Screen.WorkAreaHeight - (Height - ClientHeight);

  InitMemoText;
  InitMenu;

  { by now we 'know' the height of the main-menu-lines }
  MaxClientHeight1 := MaxClientHeight - MenuHeight1;
  MaxClientHeight2 := MaxClientHeight - MenuHeight2;

  UpdateReport;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ML.Free;
end;

procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if KeyChar = 'a' then
  begin
    ResetBtnClick(nil);
    PortraitBtnClick(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'b' then
  begin
    ResetBtnClick(nil);
    Button2Click(nil);
    Button1Click(nil);
  end

  else if KeyChar = 'c' then
  begin
    ResetBtnClick(nil);
    LandscapeBtnClick(nil);
    Button1Click(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'd' then
  begin
    ResetBtnClick(nil);
    PortraitBtnClick(nil);
  end

  else if KeyChar = 'e' then
  begin
    ResetBtnClick(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'f' then
  begin
    ResetBtnClick(nil);
    Button1Click(nil);
  end

  else if KeyChar = 'g' then
  begin
    ResetBtnClick(nil);
    Button2Click(nil);
  end

  else if KeyChar = 'l' then
  begin
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'p' then
  begin
    PortraitBtnClick(nil);
  end

  else if KeyChar = 'r' then
  begin
    ResetBtnClick(nil);
  end

  else if KeyChar = '1' then
  begin
    Button1Click(nil);
  end

  else if KeyChar = '2' then
  begin
    Button2Click(nil);
  end

end;

procedure TFormMain.ResetBtnClick(Sender: TObject);
begin
  ClientWidth := 800;
  ClientHeight := 600;
  Top := 100;
  UpdateReport;
end;

procedure TFormMain.LandscapeBtnClick(Sender: TObject);
begin
  ClientWidth := 1000;
  ClientHeight := MaxClientHeight1;
  Top := 0;
  UpdateReport;
end;

procedure TFormMain.PortraitBtnClick(Sender: TObject);
begin
  ClientWidth := 800;
  ClientHeight := MaxClientHeight2;
  Top := 0;
  UpdateReport;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  ClientWidth := 800;
  Height := Screen.WorkAreaHeight;
  Top := 0;
  UpdateReport;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  ClientWidth := 1000;
  Height := Screen.WorkAreaHeight;
  Top := 0;
  UpdateReport;
end;

procedure TFormMain.UpdateReport;
begin
  ML.Clear;
  ML.Add('Button KeyChars:');
  ML.Add('  r = Reset');
  ML.Add('  p = Portrait');
  ML.Add('  l = Landscape');
  ML.Add('  1 = Button 1');
  ML.Add('  2 = Button 2');
  ML.Add('');
  ML.Add('KeyChars for Test Cases:');
  ML.Add('  a, b, c = Bad');
  ML.Add('  d, e, f, g = Good');
  ML.Add('');
  ML.Add('Info:');
  ML.Add(Format('  Screen.Height = %d', [Screen.Height]));
  ML.Add(Format('  WorkAreaHeight = %d', [Screen.WorkAreaHeight]));
  ML.Add(Format('  MenuHeight1 = %d', [MenuHeight1]));
  ML.Add(Format('  MenuHeight2 = %d', [MenuHeight2]));
  ML.Add(Format('  W-H = (%d, %d)', [Width, Height]));
  ML.Add(Format('  Client-W-H = (%d, %d)', [ClientWidth, ClientHeight]));

  MemoText.Text := ML.Text;
end;

procedure TFormMain.InitMemoText;
begin
  MemoText := TText.Create(self);
  MemoText.Parent := self;
  MemoText.Position.X := 10.0;
  MemoText.Position.Y := 20.0;

  MemoText.TextSettings.WordWrap := False;
  MemoText.AutoSize := True;
  MemoText.Font.Family := 'Consolas';
  MemoText.Font.Size := 14;
  MemoText.TextSettings.FontColor := claBlue;
  MemoText.TextSettings.HorzAlign := TTextAlign.Leading;
  MemoText.TextSettings.VertAlign := TTextAlign.Leading;
end;

procedure TFormMain.InitMenu;
var
  i: Integer;
  ch1, ch2: Integer;
begin
  MainMenu := TMainMenu.Create(self);
  MainMenu.Parent := self;

  ch1 := ClientHeight;

  for i in [1..8] do
    AddMenu(MainMenu,'Menu' + IntToStr(i));

  ch2 := ClientHeight;
  MenuHeight1 := ch1 - ch2;

  for i in [9..16] do
    AddMenu(MainMenu,'Menu' + IntToStr(i));

  ch2 := ClientHeight;
  MenuHeight2 := ch1 - ch2;
end;

function TFormMain.AddMenu(M: TMainMenu; Caption: string): TMenuItem;
var
  j: Integer;
begin
  result := TMenuItem.Create(M);
  result.Text := Caption;
  M.AddObject(result);
  for j in [1..2] do
  begin
    Inc(fa);
    InitItem(result, fa);
  end;
end;

procedure TFormMain.InitItem(I: TMenuItem; fa: Integer);
var
  t: TMenuItem;
begin
  t := TMenuItem.Create(I);
  t.Width := 50;
  t.Height := 50;
  t.Opacity := 1.0;
  t.Font.Size := 24;
  t.Text := 'Item' + IntToStr(fa);
  t.Enabled := True;
  t.Visible := True;
  t.Tag := Ord(fa);
  I.AddObject(t);
end;

end.

 

Share this post

Link to post

Gustav Schubert    25

Gustav Schubert
Posted (edited)

Updated Info.

 

Changing Window Size manually (with mouse) works, programmatically changing does not, when MainMenu wraps/unwraps.


I added Wide and Narrow commands, used to toggle ClientWidth only, so that the Menu will wrap/unwrap.

 

When I toggle programmatically,
- ClientHeight stays the same
- Content of window is squeezed (scaled down) when in narrow situation.

 

If I drag with mouse to make Window wider then press Narrow key (n)
- Black unpainted area at bottom edge of Window appears
- Content is wrongly scaled (scaled down)

 

If I change Window size with mouse to some other values for Width and Height,
then press Reset, Wide, Narrow keys in order
- Height changes
- ClientHeight stays unchanged
- black unpainted area does NOT appear
- but content is wrongly scaled.

 

The Height of the Window may change or not, depending on history!

When I resize the Window by dragging the corner, correct scaling is restored!

Drawing  seems to operate on false assumption of actual ClientHeight!

 

I can see that the  content is distorted by looking at the debug-output-text.
I have also seen Buttons squeezed (when I still had buttons on the test form.)

 

Workaround:
I have so far worked around the problems except for one remaining:

 

If I start up my real application with a narrower ClientWidth so that MainMenu wraps around,

the content of the Window is initially scaled too big in y-direction,
so that part of the Content is clipped at the bottom of the Window.

 

I made sure the App starts wide enough to not wrap the MainMenu, but this does not count as a workaround.

 

Note that I do set the size of a layout component manually in code (optimizing resize count) and I need the reported ClientHeight to be correct.

 

Updated problem description:
- Scaling may be wrong under certain conditions.
- This is related to MainMenu wrapping and automatic resizing!
- I understand that Delphi is not drawing the MainMenu.
- Delphi does not know whether the Menu will wrap or not?
- How do we query the current height of the MainMenu?
- The point in time when Delphi queries Height/ClientHeight is too early?

 

--- Continuation ---

 

Program changes:
- Added OnPaint handler, in which I record LastPaintRect: TRectF.
- I handle KeyChar i, calling InvalidateRect(self.ClientRect);
- I print LastPaintRect in the Textual Report.
- I update the Report in OnResize

 

Now focusing on this test case:
1. change window width with mouse and watch MainMenu and ClientHeight
2. stop when MainMenu does not wrap (it is wide enough)
3. press key n to set ClientWidth to narrow
4. press space bar or key i to update Report and show LastPaintRect
5. evaluate situation

 

Observation:
- Height stays the same.
- ClientHeight changes when dragging the Width.
- ClientHeight does NOT change when setting ClientWidth in code (using KeyChar w and n)
- PaintRect is in sync with ClientWidth/ClientHeight.

 

Expected:
- Window.Height should not change
- MainMenu wraps and uses more vertical space
- ClientHeight should change
- Content should update and adapt to new ClientHeight.

 

Actual:
- Window.Height does not change, ok
- MainMenu wraps and uses more space, ok
- ClientHeight property value remains the same, wrong! ( = PerceivedClientHeight)
- 'PerceivedClientHeight' is too big in this case.
- Content is drawn y-distorted, condensed.
- Scaling factor seems to be ActualClientHeight/PerceivedClientHeight.
- Black unpainted strip appears

 

Form1-02.thumb.png.0019f5782fc1081190e784f9a3f67342.png

Delphi sometimes gets behind the reality in terms of what it thinks ClientHeight is right now, and then the painting gets distorted.

 

I have a situation in my real App, where I drop Images to a DropTarget and then set ClientWidth and ClientHeight to match the Image size. Sometimes I need to drag the same Image up to three times to get good result.

 

Again, this only happens when MainMenu.Height (not a property) changes.

 

Eventually I will build a minimal test case for reporting.

 

How can you determine the actual Height of the MainMenu?
How can you know if MainMenu wraps?

 

 

Edited by Gustav Schubert

Share this post

Link to post

Gustav Schubert    25

Gustav Schubert
Posted

Final update. (Test code now improved and amplified.)

 

- run application
- toggle ClientWidth between Wide (w) and SuperNarrow (t).
- watch how content gets distorted (scaled up and down)
  

unit FrmMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.UIConsts,
  System.Classes,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Menus,
  FMX.Layouts,
  FMX.Objects;

type
  TFormMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);

    procedure LandscapeBtnClick(Sender: TObject);
    procedure PortraitBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure NarrowBtnClick(Sender: TObject);
    procedure WideBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FSuperNarrow: Integer;
    FNarrow: Integer;
    FWide: Integer;
    FNormalClientHeight: Integer;

    ML: TStringList;
    fa: Integer;

    MaxClientHeight: Integer;
    MaxClientHeight1: Integer;
    MaxClientHeight2: Integer;

    MenuHeight1: Integer;
    MenuHeight2: Integer;

    LastPaintRect: TRectF;

    procedure InitMemoText;
    procedure InitMenu;
    procedure UpdateReport;
    function AddMenu(M: TMainMenu; Caption: string): TMenuItem;
    procedure InitItem(I: TMenuItem; fa: Integer);
    procedure InitRectangle;
    procedure SuperNarrow;
  public
    MainMenu: TMainMenu;
    MemoText: TText;
    Rectangle: TRectangle;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ML := TStringList.Create;

  FSuperNarrow := 300;
  FNarrow := 800;
  FWide := 1000;
  FNormalClientHeight := 600;

  ResetBtnClick(nil);

  { record this while there is no MainMenu }
  MaxClientHeight := Screen.WorkAreaHeight - (Height - ClientHeight);

  InitRectangle;
  InitMemoText;
  InitMenu;

  { by now we 'know' the height of the main-menu-lines }
  MaxClientHeight1 := MaxClientHeight - MenuHeight1;
  MaxClientHeight2 := MaxClientHeight - MenuHeight2;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ML.Free;
end;

procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if KeyChar = 'a' then
  begin
    ResetBtnClick(nil);
    PortraitBtnClick(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'b' then
  begin
    ResetBtnClick(nil);
    Button2Click(nil);
    Button1Click(nil);
  end

  else if KeyChar = 'c' then
  begin
    ResetBtnClick(nil);
    LandscapeBtnClick(nil);
    Button1Click(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'd' then
  begin
    ResetBtnClick(nil);
    PortraitBtnClick(nil);
  end

  else if KeyChar = 'e' then
  begin
    ResetBtnClick(nil);
    LandscapeBtnClick(nil);
  end

  else if KeyChar = 'f' then
  begin
    ResetBtnClick(nil);
    Button1Click(nil);
  end

  else if KeyChar = 'g' then
  begin
    ResetBtnClick(nil);
    Button2Click(nil);
  end

  else if KeyChar = 'i' then InvalidateRect(self.ClientRect)
  else if KeyChar = 'l' then LandscapeBtnClick(nil)
  else if KeyChar = 'n' then NarrowBtnClick(nil)
  else if KeyChar = 'p' then PortraitBtnClick(nil)
  else if KeyChar = 'r' then ResetBtnClick(nil)
  else if KeyChar = 't' then SuperNarrow
  else if KeyChar = 'w' then WideBtnClick(nil)
  else if KeyChar = '1' then Button1Click(nil)
  else if KeyChar = '2' then Button2Click(nil);

  UpdateReport;
end;

procedure TFormMain.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
begin
  LastPaintRect := ARect;
end;

procedure TFormMain.FormResize(Sender: TObject);
begin
  UpdateReport;
end;

procedure TFormMain.ResetBtnClick(Sender: TObject);
begin
  ClientWidth := FNarrow;
  ClientHeight := FNormalClientHeight;
  Top := 100;
end;

procedure TFormMain.LandscapeBtnClick(Sender: TObject);
begin
  ClientWidth := FWide;
  ClientHeight := MaxClientHeight1;
  Top := 0;
end;

procedure TFormMain.PortraitBtnClick(Sender: TObject);
begin
  ClientWidth := FNarrow;
  ClientHeight := MaxClientHeight2;
  Top := 0;
end;

procedure TFormMain.NarrowBtnClick(Sender: TObject);
begin
  ClientWidth := FNarrow;
end;

procedure TFormMain.WideBtnClick(Sender: TObject);
begin
  ClientWidth := FWide;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  ClientWidth := FNarrow;
  Height := Screen.WorkAreaHeight;
  Top := 0;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  ClientWidth := FWide;
  Height := Screen.WorkAreaHeight;
  Top := 0;
end;

procedure TFormMain.UpdateReport;
begin
  ML.Clear;
  ML.Add('Button KeyChars:');
  ML.Add('  r = Reset');
  ML.Add('  p = Portrait');
  ML.Add('  l = Landscape');
  ML.Add('  1 = Button 1');
  ML.Add('  2 = Button 2');
  ML.Add('');
  ML.Add('KeyChars for Test Cases:');
  ML.Add('  a, b, c = Bad');
  ML.Add('  d, e, f, g = Good');
  ML.Add('');
  ML.Add('Info:');
  ML.Add(Format('  Screen.Height = %d', [Screen.Height]));
  ML.Add(Format('  WorkAreaHeight = %d', [Screen.WorkAreaHeight]));
  ML.Add(Format('  MenuHeight1 = %d', [MenuHeight1]));
  ML.Add(Format('  MenuHeight2 = %d', [MenuHeight2]));
  ML.Add(Format('  W-H = (%d, %d)', [Width, Height]));
  ML.Add(Format('  Client-W-H = (%d, %d)', [ClientWidth, ClientHeight]));
  ML.Add(Format('  Rectangle-W-H = (%.0f, %.0f)', [Rectangle.Width, Rectangle.Height]));
  ML.Add(Format('  PaintRect-W-H = (%.0f, %.0f)', [LastPaintRect.Width, LastPaintRect.Height]));

  MemoText.Text := ML.Text;
end;

procedure TFormMain.InitMemoText;
begin
  MemoText := TText.Create(self);
  MemoText.Parent := self;
  MemoText.Position.X := 10.0;
  MemoText.Position.Y := 20.0;

  MemoText.TextSettings.WordWrap := False;
  MemoText.AutoSize := True;
  MemoText.Font.Family := 'Consolas';
  MemoText.Font.Size := 14;
  MemoText.TextSettings.FontColor := claBlue;
  MemoText.TextSettings.HorzAlign := TTextAlign.Leading;
  MemoText.TextSettings.VertAlign := TTextAlign.Leading;
end;

procedure TFormMain.InitMenu;
var
  i: Integer;
  ch1, ch2: Integer;
begin
  MainMenu := TMainMenu.Create(self);
  MainMenu.Parent := self;

  ch1 := ClientHeight;

  for i in [1..8] do
    AddMenu(MainMenu,'Menu' + IntToStr(i));

  ch2 := ClientHeight;
  MenuHeight1 := ch1 - ch2;

  for i in [9..16] do
    AddMenu(MainMenu,'Menu' + IntToStr(i));

  ch2 := ClientHeight;
  MenuHeight2 := ch1 - ch2;
end;

function TFormMain.AddMenu(M: TMainMenu; Caption: string): TMenuItem;
var
  j: Integer;
begin
  result := TMenuItem.Create(M);
  result.Text := Caption;
  M.AddObject(result);
  for j in [1..2] do
  begin
    Inc(fa);
    InitItem(result, fa);
  end;
end;

procedure TFormMain.InitItem(I: TMenuItem; fa: Integer);
var
  t: TMenuItem;
begin
  t := TMenuItem.Create(I);
  t.Width := 50;
  t.Height := 50;
  t.Opacity := 1.0;
  t.Font.Size := 24;
  t.Text := 'Item' + IntToStr(fa);
  t.Enabled := True;
  t.Visible := True;
  t.Tag := Ord(fa);
  I.AddObject(t);
end;

procedure TFormMain.InitRectangle;
begin
  Rectangle := TRectangle.Create(self);
  Rectangle.Parent := self;
  Rectangle.Fill.Color := claNull;
  Rectangle.Stroke.Color := claRed;
  Rectangle.Stroke.Thickness := 5.0;
  Rectangle.Align := TAlignLayout.Client;
end;

procedure TFormMain.SuperNarrow;
begin
  ClientWidth := FSuperNarrow;
end;

end.

Form1-04.thumb.png.086b0cdba80cc60bff65a469e338dce4.png

When you drag the Window with the mouse, the distortion disappears.

 

 

Share this post

Link to post

Gustav Schubert    25

Gustav Schubert
Posted (edited)

A wrapping or unwrapping MainMenu is one way to cause trouble in the process of setting ClientWidth and ClientHeight.

 

But there is another, when the call to SetWindowPos in procedure TWinWindowHandle.SetWindowSizeByClientSize causes the height of the Window to be clipped! This happens to be the case when ClientHeight is greater than the height of the screen.

 

So, it is possible to construct a test case where you can see the same distortion, but without using a MainMenu!

 

Start minimal app, click on Button1, then click on Button2, Bingo.

  

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    mch: Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
var
  scale: single;
  MaxClientHeight: Integer;
  h: Integer;
  ch: Integer;
begin
  scale := self.Handle.Scale;
  h := Height;
  ch := ClientHeight;

  MaxClientHeight := Screen.WorkAreaHeight - Round(scale *(h - ch));
  mch := Round(MaxClientHeight / scale);

  { MaxClientHeight in 'Pixel-Units' }
  mch := Round(MaxClientHeight / scale);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientWidth := Round(0.8 * mch); // must be <> mch
  ClientHeight := Round(1.1 * mch); // must be > mch
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ClientWidth := mch;
  ClientHeight := Round(2 * mch); // must be > mch
end;

 

Edited by Gustav Schubert

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  
Followers 0
Go To Topic Listing FMX
×