Jump to content

Gustav Schubert

Members
  • Content Count

    25
  • Joined

  • Last visited

Community Reputation

8 Neutral

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. Gustav Schubert

    XE5 > RIO

    I am looking at Macapi.ObjCRuntime. There is a function objc_msgSendP2. What if you declare objc_msgSendP4? There are 5 calls to objc-msgSend in the uFMain unit. Three take two params, these do compile? One takes 4 Params, should be objc_msgSendP2? One takes 6 params, which should be objc_msgSendP4?
  2. Gustav Schubert

    How to get the selected Font from Picker on Mac

    I include a minimal test project for FMX, OSX64 target only, see attachment. ( You can change TRectangle.Fill.Color and TText.Font.Family via native dialogs, see screenshot. ) This seems to work somehow, but there are at least two remaining problems: 1) Color: If you change from Apple to Developer in combo box and continue to use the dialog - it will crash the App. 2) Font: selectedFont is the value navigated from, not the value navigated to; in the example the font family of the TText should be Arial Narrow, not Arial Black. I would like to understand the reason for problem 1, any idea? ChangeColorTest.zip
  3. Gustav Schubert

    How to get the selected Font from Picker on Mac

    OK, done, found and example of how to implement callback for Color, extended the case for Font, this seems to work.
  4. On the OSX64 platform I want to use native Pickers for Color (TNsColorPanel) and Font (TNsFontPanel). The idea is that first the dialog must be shown (initialized) so that the user can select a color or font in the dialog. Then, at any time, if an action is triggered in the App, the currently selected Color or Font should be retrieved and used. It works for Color, but not for Font. I don't implement changeFont since I don't know how. But it looks as if a working handler is needed, or it won't work. Won't work means that the current Font cannot be retrieved via the convertFont method of the FontManager. https://github.com/federgraph/federgraph-meme-builder/blob/6e035f461e47ed0b30c46ceb36960cbfd528c6c2/MB/RiggVar.MB.Picker.Mac.pas#L104 - debug on Mac (F9) - press button sC (show Color Panel) - change color in panel - select App window (focus) - press button pC (pick Color), ok - press button sF (show Font Panel) - chang Font in panel - ( set breakpoint in TPickerMac.SelectFontFamilyName ) - select App window (focus) - press button pF (pick Font) - todo: make it work Should I give up at this point, and if so, why?
  5. Gustav Schubert

    Using WorkAreaHeight for MaxClientHeight

    On the desktop I call Screen.UpdateDisplayInformation just before I need it, it works for me. But the next problem I found with Screen.WorkAreaHeight is that the units (real pixel or scaled pixel) are different between the platforms. Surface Pro = real pixels given (Scale = 2.0) My Desktop = cannot tell (because Scale = 1.0) Retina iMac = scaled pixels returned (Scale = 2.0) So, on Windows Screen.WorkAreaHeight and ClientHeight are NOT using the same units, on Mac they are given in same units, but what should it be by design? ( I have a workaround that in my test App. )
  6. Gustav Schubert

    RAD Studio 10.3.3 now available

    Fixed, 367 more days for my CE installation. I have requested a new license via free-download page, using same email login as always, and got email with new license key. Then I used the license dialog of Tokyo Pro to register new license and delete expired license. Quote from comment on FB page: "Please make sure your license is expired, otherwise you will get the same expiration date as before." This may very well be true.
  7. Gustav Schubert

    RAD Studio 10.3.3 now available

    Downloaded web installer. Got new license key for CE in email. Now I have 10.3.3 CE with two days left. The license manager UI still buggy btw - when you navigate the leftmost listbox with the arrow keys up and down. You need to click with the mouse on the items, to see the corresponding license details in the middle, which is relevant for the actions on the right. But there is no action reading 'extend license for one more year' or similar. RSP-16220 ('code navigation is blocked inside MACOS blocks') still reproducible, contrary to what they say. 💎
  8. Gustav Schubert

    Using WorkAreaHeight for MaxClientHeight

    TScreen.WorkAreaHeight is available in Vcl and in FMX. The Vcl help has slightly more info, but it does not mention whether the value is ever updated or not. Found out that, if you change the rotation of the form on the Surface tablet, it does not update. If you change the taskbar mode (Taskleiste automatisch ausblenden, available in taskbar context menu on Surface Pro), it does NOT update either. Any change is only reflected after restart of app. And since the implementation hides behind TPlatformServices.Current.Something it is not easy to find out. Back to square 2. Edit 1: It seems I have to call Screen.UpdateDisplayInformation manually, but when?
  9. Gustav Schubert

    ClientArea painting problem when MainMenu wraps/unwraps

    Current test code at GitHub repo. Reported as RSP-26601.
  10. Gustav Schubert

    Using WorkAreaHeight for MaxClientHeight

    I wanted to precompute the max possible value of ClientHeight, based on Screen.WorkAreaHeight, and I have tested on a normal HD-Screen and on a Surface tablet screen, and I have been surprised that - on the Surface screen WorkAreaHeight is always the same, no matter if TaskBar has collapsed, - Screen.WorkAreaHeight is given in real pixels, - whereas Height and ClientHeight are given in scaled pixels. Normal Desktop HD Screen Report: Handle.Scale = 1.0 Screen.WorkAreaHeight = 1040 MaxClientHeight = 1001 Screen-W-H = (1920, 1080) (Form)-W-H = ( 616, 639) Client-W-H = ( 600, 600) MaxClientHeight := wah - Round(scale *(h - ch)); 1001 := 1040 - Round(1.0 *(639 - 600)); mch = MaxClientHeight / scale = 1001 Surface-Pro Screen Report: Handle.Scale = 2.0 Screen.WorkAreaHeight = 1824 MaxClientHeight = 876 Screen-W-H = (2736, 1824) (Form)-W-H = ( 613, 636) Client-W-H = ( 600, 600) MaxClientHeight := wah - Round(scale *(h - ch)); 1752 := 1824 - Round(2.0 *(636 - 600)); mch = MaxClientHeight / scale = 876 Report generating code: procedure TForm1.UpdateReport; var scale: single; h:Integer; ch: Integer; wah: Integer; MaxClientHeight: Integer; mch: Integer; begin scale := Handle.Scale; h := Height; ch := ClientHeight; wah := Screen.WorkAreaHeight; MaxClientHeight := Screen.WorkAreaHeight - Round(scale *(h - ch)); mch := Round(MaxClientHeight / scale); { ClientHeight := mch; // this is the intended use of mch } { mch is the actual MaxClientHeight to be used. } { ML is a TStringList } ML.Clear; ML.Add(Format('Handle.Scale = %.1f', [scale])); ML.Add(Format('Screen.WorkAreaHeight = %d', [wah])); ML.Add(Format('MaxClientHeight = %d', [MaxClientHeight])); ML.Add(''); ML.Add(Format('Screen-W-H = (%d, %d)', [Screen.Width, Screen.Height])); ML.Add(Format('(Form)-W-H = (%d, %d)', [Width, Height])); ML.Add(Format('Client-W-H = (%d, %d)', [ClientWidth, ClientHeight])); ML.Add(''); ML.Add(Format('MaxClientHeight := wah - Round(scale *(h - ch));', [])); ML.Add(Format(' %d := %d - Round(%.1f *(%d - %d));', [MaxClientHeight, wah, scale, h, ch])); ML.Add(''); ML.Add(Format('mch = MaxClientHeight / scale = %d', [mch])); { Memo is a component on the form } Memo.Text := ML.Text; end; What do you think about Screen.WorkAreaHeight? Is this the best thing to use? How should I compute the maximum of ClientHeight that can be visible on a given screen?
  11. Gustav Schubert

    ClientArea painting problem when MainMenu wraps/unwraps

    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;
  12. Gustav Schubert

    ClientArea painting problem when MainMenu wraps/unwraps

    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. When you drag the Window with the mouse, the distortion disappears.
  13. Gustav Schubert

    ClientArea painting problem when MainMenu wraps/unwraps

    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 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?
  14. 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.
  15. Gustav Schubert

    FMX TEdit: how to prevent user from pasting a TBitmap ?

    Reported as RSP-26546. The little problem was found in Meme-Builder-App, which is toy, but can be used as a test case.
×