Jump to content

Gustav Schubert

Members
  • Content Count

    78
  • Joined

  • Last visited

  • Days Won

    1

Gustav Schubert last won the day on December 11 2019

Gustav Schubert had the most liked content!

Community Reputation

16 Good

Recent Profile Visitors

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

  1. Gustav Schubert

    Text 3D is horrible

    Possible starting point for playing: unit FrmMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, System.Math.Vectors, FMX.Controls3D, FMX.Objects3D, FMX.Viewport3D, FMX.MaterialSources; type TFormMain = class(TForm) Viewport: TViewport3D; procedure FormCreate(Sender: TObject); private Text: TText3D; Camera: TCamera; MS: TColorMaterialSource; end; var FormMain: TFormMain; implementation {$R *.fmx} procedure TFormMain.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown := True; Width := 800; Height := 600; Viewport.Position.X := 10; Viewport.Position.Y := 10; Viewport.Width := 640; Viewport.Height := 480; Camera := TCamera.Create(Self); Camera.Parent := Viewport; Camera.Position.Z := -100; Viewport.Camera := Camera; Viewport.UsingDesignCamera := False; MS := TColorMaterialSource.Create(Self); MS.Parent := nil; MS.Color := TAlphaColors.Dodgerblue; Text := TText3D.Create(Self); Text.Parent := Viewport; Text.WordWrap := False; Text.Stretch := False; Text.Depth := 3; Text.Height := 10; Text.Width := 100; Text.Scale.X := 1; Text.Scale.Y := 1; Text.Text := 'Sample Text'; Text.RotationAngle.X := 20; Text.MaterialShaftSource := MS; end; end.
  2. Sometimes you need to resort to git on the commandline to rename a file, with git mv -f See How do I commit case-sensitive only filename changes in Git?
  3. Gustav Schubert

    ClientHeight in FormResize screen scaling issue

    The cost of using OnResizeEnd is rather high, as of now.
  4. Gustav Schubert

    Text 3D is horrible

    I wonder how that would look using an orthographic projection.
  5. Gustav Schubert

    ClientHeight in FormResize screen scaling issue

    FMX Rio: ClientHeight is not up to date in FormResize when the form is moved back from a second monitor which has a higher value screen scale. Can this be reproduced in 10.4? If so I would report it, and update this post. Minimal sample with problem in 10.3.3: New app with one TRectangle on main form. Add OnResize handler as given below. Run on Windows. Test with two monitors of different scaling. Main monitor = 1.0 and second monitor to the right = 1.25. Drag Form1 from one monitor to other and then back to see problem. Drag the right border of form to resize again and correct the problem. Problem shows after dragging back from right to main monitor. There is a gap between Rectangle.Bottom and Form.Bottom. It seems to be the diff in actual and perceived ClientHeight, 8 pixel in my setup. Problem will be corrected if form is resized, because then ClientHeight will be good in FormResize. procedure TForm1.FormResize(Sender: TObject); begin { Rectangle1: TRectangle } // Rectangle1.Width := ClientWidth - Rectangle1.Position.X; Rectangle1.Height := ClientHeight - Rectangle1.Position.Y; Caption := Format('%d - %d - %.2f', [Height, ClientHeight, Rectangle1.Scene.GetSceneScale]); end;
  6. Gustav Schubert

    git - do you 'pull' before/after switching branches?

    In theory, yes. But I have difficulty to compare branches with only one folder. My merge tool which is my diff tool needs two folders. And, I have more branches at home than I have at github.
  7. Gustav Schubert

    git - do you 'pull' before/after switching branches?

    1) Because for me there is no better was to see what has changed. 2) When learning how to use git. I don't want to do that live at github. 3) I also have different settings for .gitignore 4) My local only one has a longer history, I want to keep that
  8. Gustav Schubert

    git - do you 'pull' before/after switching branches?

    Sometimes I opt to have two local repositories, one which is connected to a remote, and another one which is not - which is the one I will use for development. I know which is which by folder name. When I open the one with connection to remote in Visual Studio Code (folder), it tells me that there is new stuff that I can pull down, and I will, immediately. When I want to publish some work I will use my merge tool to copy the new stuff over to the hot repo and then commit with a button click. ( It is via my merge tool that I keep in control, it works with directories on disc. ) You could have two repos connected to the remote, pull one often - as advised, and the other one only when you want (after a successfull push, from other repo). ( If the repo is large you can care about subfolders only and ignore the rest, only merge the subfolder you are working on. )
  9. Gustav Schubert

    ImageWrapMode.Original and Dpi-Support PerMonitorV2

    Progress: Now I have sharp text for the controls AND a sharp drawing on a high resolution screen. I need to scale the drawing - when I do the drawing, and I need to provide a Bitmap which is big enough to show everything. Width and Height of the Image need to be set to the unscaled values: private FScale: single; BitmapWidth: Integer; BitmapHeight: Integer; Image: TImage; procedure TForm1.FormCreate(Sender: TObject); var Bitmap: TBitmap; begin FScale := Handle.Scale; { nominal bitmap size, fixed at time of creation } BitmapWidth := 800; BitmapHeight := 800; Bitmap := TBitmap.Create(Round(BitmapWidth * FScale), Round(BitmapHeight * FScale)); Bitmap.Clear(claWhite); Assert(FScale = Image.Scene.GetSceneScale); { Image Width and Height can change later with alignment or anchoring } Image.Width := BitmapWidth; // unscaled (nominal) value Image.Height := BitmapHeight; Image.Bitmap := Bitmap; Bitmap.Free; // image has copy via assign Image.WrapMode := TImageWrapMode.Original; end; { g = Image.Bitmap.Canvas } procedure TForm1.DrawToCanvas(g: TCanvas); begin g.Offset := TH.Offset; // transform helper if g.BeginScene then try g.SetMatrix(TMatrix.CreateScaling(FScale, FScale)); g.Clear(claWhite); // ... finally g.EndScene; end; end; The TImage is good as is. No bug report and no feature request from me. But I have built myself a significantly more lightweight TOriginalImage control (less than 200 lines), which features a read only Bitmap property. I will no longer provide the Bitmap - only the NominalSize. Whenever I access Image.Bitmap.Canvas to draw on it: the Bitmap will have the correct size for the current monitor I still need to do the scaling via matrix I need to call Image.Repaint after drawing. Moving the form from one monitor to another with different scaling should work, because my new component has a ScaleChangedHandler, as does TImage. The TImage from FMX.Objects works ok, it is just difficult to understand, too much MultiResBitmap stuff which I do not need - when I just want to draw on it.
  10. Gustav Schubert

    ImageWrapMode.Original and Dpi-Support PerMonitorV2

    I'm off because I had an odd dream about TImage.UpdateCurrentBitmap; and now I need to read more about MultiResImages. overridden procedure TImage.Paint; begin NewUpdateCurrentBitmap; if FCurrentBitmap <> nil then MyDrawBitmap(Canvas, LocalRect, FCurrentBitmap, AbsoluteOpacity); end; //private procedure TImage.UpdateCurrentBitmap; strictly; ignore; public procedure TImage.NewUpdateCurrentBitmap; possible; abstract; public MyDrawBitmap(Canvas, LocalRect, FCurrentBitmap, AbsoluteOpacity); virtually; easy; unchanged procedure TImage.SetBitmap(const Value: TBitmap); var LBitmap: TBitmap; begin LBitmap := GetBitmap; if LBitmap <> nil then LBitmap.Assign(Value); end; function TImage.GetBitmap: TBitmap; var Item: TCustomBitmapItem; begin Result := nil; // Return the most appropriate non-empty picture // ? end;
  11. Gustav Schubert

    ImageWrapMode.Original and Dpi-Support PerMonitorV2

    Observation 1: If I use PerMonitorV2 then the text of controls like ListView will be sharper. This is why I want to keep using it. Observation 2: I have been able to produce sharp drawings which take advantage of the many pixels of the 4K screen, in PerMonitorV2 mode. Unfortunately the effort is high, in terms of extra code that I need to write for correct layout and manual scaling. At first I thought that the DrawImage method of TImage might have a bug. But by now I have tested out a change - with only partial success. I can make the drawing scale as I want, but it will appear slightly blurred, because it gets upscaled, as with Dpi-Support None. Status: In order to get a sharp drawing I need to leave EMBA code as is and do the additional work. Problem is of course that I cannot and want not do that in in my bigger application for some existing drawings, not now, and maybe never. For now I will go with sharp text and slightly blurred drawings.
  12. Gustav Schubert

    ImageWrapMode.Original and Dpi-Support PerMonitorV2

    From docwiki: Original - displays the image with its original dimensions. Fit - provides the best fit, keeping image proportions (the ratio between the width and height) for the TImage rectangle. If needed, the image is scaled down or stretched to best fit the rectangle area. This is the default option. In mode original the image should be clipped - ok - but should it not still be scaled according to the sceen scaling factor? Or is the intention really that it appears smaller on a high resolution screen, relative to other controls?
  13. This is about the result of testing my FMX app on a high resolution screen, Windows platform. ( A TImage component is the central component on my form, I am drawing onto its bitmap, it has a known fixed size. ) Using ImageWrapMode = TImageWrapMode.Original. Using project options - application- manifest - dpi support = PerMonitorV2. Using 10.3.3. Test is done on a 4K Monitor with Scaling of 2.0. The TImage (which I will draw on) will appear half the size. All components are scaled automatically, except TImage. I tried to work around the issue. Depending on Handle.Scale I can make the Image and Bitmap bigger, and then draw with a scaling transform, it works. But then I also need to adapt custom layout code because I am using Width and Height of components to stack them horizontally or vertically. And this is not nice if one component uses different 'units' for Width and Height. I have reverted back to using Dpi-Support of None, since in this mode the scaling of TImage is done automatically. So, all is well now, except that I could spam some site with 125 lines of minimal test form code!
  14. Gustav Schubert

    Converting simple VCL form to FMX

    For me the first step is to empty the form. I will create all components in code - I do this manually - but for this I think there should be a tool! Next I will refactor - a lot, the layout of components and the repetitive settings of basic component properties. So, I am not using any tools, but I can reuse code for laying out components and setting standard properties, much better than before.
  15. Gustav Schubert

    TListBox OnClick not working just on some machines ?

    I have applied info from "Patch a private virtual method" topic. My fix as a patch in a minimal test project: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Controls.Presentation, FMX.ListBox; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private LB: TListBox; SC: TListBoxSelector; function GetVirtualMethodIndex: Integer; procedure DoOnIdle(Sender: TObject; var Done: Boolean); procedure PatchMouseSelectFinish; protected procedure InspectVMT(const AMethodName: string); end; var Form1: TForm1; implementation {$R *.fmx} uses Windows, System.Rtti; const MSF_MethodName = 'MouseSelectFinish'; type TListBoxAccess = class(TListBox); TMouseSelectProc = procedure( const Item: TListBoxItem; const Button: TMouseButton; const Shift: TShiftState) of object; procedure FixedMouseSelectFinish(Self: TListBoxSelector; const Item: TListBoxItem; const Button: TMouseButton; const Shift: TShiftState); begin if Button <> TMouseButton.mbLeft then Self.DoMouseSelectStart(Item, Shift); Self.DoMouseSelectFinish(Item, Shift); end; procedure TForm1.FormCreate(Sender: TObject); var i: Integer; begin LB := TListBox.Create(Self); LB.Parent := Self; { works for other MultiSelectStyles too } LB.MultiSelectStyle := TMultiSelectStyle.None; with LB.Items do begin for i in [0..3] do Add('Item ' + IntToStr(i)); end; { we need to know the class type of the SelectionController } SC := TListBoxAccess(LB).SelectionController; PatchMouseSelectFinish; // of the actual SC { Needed to see whether ListBox selection 'works' as expected, when you click on items with the right mouse button. } Application.OnIdle := DoOnIdle; { Optional, for more info ... } // LB.Align := TAlignLayout.Client; // InspectVMT(''); end; procedure TForm1.PatchMouseSelectFinish; var p: Pointer; n: UINT_PTR; vi: Integer; begin // vi := 7; { known value in 10.3.3 } vi := GetVirtualMethodIndex; if vi > 0 then begin { see https://en.delphipraxis.net/topic/1922-patch-a-private-virtual-method/ } {$POINTERMATH ON} p := @FixedMouseSelectFinish; WriteProcessMemory( GetCurrentProcess, @PPointer(SC.ClassType)[vi], @p, SizeOf(Pointer), n); end; end; function TForm1.GetVirtualMethodIndex: Integer; var LContext: TRttiContext; LType: TRttiType; LMethods: TArray<TRttiMethod>; l: Integer; m: TRttiMethod; begin { get the index of the public virtual method in VMT, of the class that is actually used, a descendent of TListBoxSelector } result := -1; LContext := TRttiContext.Create; try LType := LContext.GetType(SC.ClassType); LMethods := LType.GetMethods('MouseSelectFinish'); l := Length(LMethods); if l > 0 then begin { we want the first one } m := LMethods[0]; result := m.VirtualIndex; end; finally LContext.Free; end; end; procedure TForm1.InspectVMT(const AMethodName: string); var LContext: TRttiContext; LType: TRttiType; LMethods: TArray<TRttiMethod>; i: Integer; rm: TRttiMethod; mn: string; cn: string; vi: Integer; begin LB.Items.Clear; LContext := TRttiContext.Create; try LType := LContext.GetType(SC.ClassType); if AMethodName = '' then LMethods := LType.GetMethods else LMethods := LType.GetMethods(AMethodName); for i := 0 to Length(LMethods) - 1 do begin rm := LMethods[i]; cn := rm.Parent.Name; mn := rm.ToString; vi := rm.VirtualIndex; LB.Items.Add(Format('%3d %p %s.%s', [vi, rm.CodeAddress, cn, mn])); end; finally LContext.Free; end; end; procedure TForm1.DoOnIdle(Sender: TObject; var Done: Boolean); begin Caption := IntToStr(LB.ItemIndex); Done := True; end; end. I am patching a public virtual method that appears in TListBoxSelector, which is NOT overridden in TSingleSelectionController. VMT, from the styled test poject (not minimal): Notes: The root problem is with concrete classes declared in implementation section. a) I cannot typecast to these types. MethodPtr := TSingleSelectionController(@VMT).MouseSelectFinish; // nope MethodPtr := TRggSelectionController(@VMT).MouseSelectFinish; // ok b) In ( for LType in LContext.GetTypes do ) I cannot find a type by name, by checking for (LType.Name = 'TSingleSelectionController') // nope by checking for (LType.Name = 'TRggSelectionController') // ok. c) But I can do LType := LContext.GetType(SC.ClassType); // SC = TSingleSelectionController So, I could make use of VirtualIndex because I got Access to the type first, via TListBoxAccess. - You can test out my fix if you want.
×