Gustav Schubert
Members-
Content Count
114 -
Joined
-
Last visited
-
Days Won
1
Everything posted by Gustav Schubert
-
Delphi 12 Athens Refactoring Broken
Gustav Schubert replied to Navid Madani's topic in Delphi IDE and APIs
I can only comment on the rename refactoring. My impression is that it works about the same as before. Therefore: not using it is not an option. But, still my point here, just for anyone else who is reading, my own user story: I use Ctrl-Shift-E a lot. And that was my bigggest problem with Delphi 12, because the IDE would disappear within two seconds from pressing Ctrl-Shift-E. It took me days to find out that installing the modelling option was the solution. I can now use rename refactoring as before, with about the same expectation. But back to the topic now, I think the question should have been: Has the (rename) refactoring functionality in Delphi 12/Athens deteriorated, in comparison to 10.1 Berlin? ( I don't know, will read about it here... ) -
Delphi 12 Athens Refactoring Broken
Gustav Schubert replied to Navid Madani's topic in Delphi IDE and APIs
To get rename refactoring back, install the modelling option, as Uwe pointed out in RSP-42936. It worked for me! -
You could vote for feature request RSP-18851. It suggests a new event for TCommonCustomForm, which is called when resize has ended.
-
We only need to deal with the flattened points, distance to line segment computation is not needed. I know this only because I have just tested out the FlattenToPolygon approach starting from the PathDemo.zip test program from above. To find the distance between two points is easy when working with TPointF. It is more difficult to update the properties of a supposedly easy to use TLine test component. One would have expected a TLine component to have TPointF properties for start and end points, but nope. The snippets below may be of help, when building the interactive test program. procedure TFormMain.InitProps; begin { Since we are using design time test components in the test program ... } { the TPath under test } Path.HitTest := False; { a TCircle } Circle.Width := 50; Circle.Height := 50; Circle.HitTest := False; Circle.Opacity := 0.5; Circle.Stroke.Color := claBlue; { a TLine } Line.LineType := TLineType.Top; Line.RotationCenter.Point := TPointF.Zero; Line.Height := 0; Line.HitTest := False; Line.Stroke.Color := claRed; end; procedure TFormMain.PanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if FDragging then begin FDragging := False; ControlPoint1.Visible := True; ControlPoint2.Visible := True; end else if ssCtrl in Shift then begin ShowClosestPoint(TPointF.Create(X, Y)); // <-- new: Ctrl-Click to test! end end; procedure TFormMain.ShowClosestPoint(P: TPointF); var T: TPointF; PT: TPointF; begin { T is closest point on Path, measured from test point P } T := FindClosestPoint(Path, P); { center the translucent circle at the closest point } Circle.Position.Point := T - TPointF.Create(Circle.Width, Circle.Height) / 2; { update the test line properties, so that Line is drawn from P to T } PT := T - P; Line.Position.Point := P; Line.Width := PT.Length; Line.RotationAngle := 180 + RadToDeg(TPointF.Zero.Angle(PT)); end; function TFormMain.FindClosestPoint(APath: TPath; APoint: TPointF): TPointF; var Poly: TPolygon; l: Integer; i: Integer; d: single; iMin: Integer; dMin: single; begin APath.Data.FlattenToPolygon(Poly, 2); l := Length(Poly); if l < 1 then Exit; dMin := APoint.Distance(Poly[0]); iMin := 0; for i := 1 to l - 1 do begin d := APoint.Distance(Poly[i]); if d < dMin then begin dMin := d; iMin := i; end; end; result := Poly[iMin]; end;
-
Function with 2 return values ?
Gustav Schubert replied to Henry Olive's topic in RTL and Delphi Object Pascal
But it started with two good answers at the top, which I liked, to make it clear. 🙂 -
Function with 2 return values ?
Gustav Schubert replied to Henry Olive's topic in RTL and Delphi Object Pascal
You can return a TPointF: procedure Test; var A, B: Currency; // <-- ? P: TPointF; function GetResult(const s: string): TPointF; begin result.X := 99.98; result.Y := -1.01; end; begin { get going fast } P := GetResult('ABC'); { in order to be able to play with some data types } A := P.X; B := P.Y; end; -
Updating TPolygon items in generic List is difficult?
Gustav Schubert posted a topic in RTL and Delphi Object Pascal
I need an explanation, for this: program PolyTest; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.Types, System.Math.Vectors, System.Generics.Collections; var P: TPolygon; // array of TPointF, see declaration in System.Math.Vectors L: TList<TPolygon>; procedure Test(WantProblem: Boolean); var Temp: TPolygon; begin Temp := L[0] + P; // append to the existing polygon if WantProblem then begin L[0] := Temp; // <-- access violation here (sure at second attempt) end else begin L.Delete(0); L.Insert(0, Temp); end; end; begin try P := [TPointF.Create(0, 0), TPointF.Create(1, 1)]; L := TList<TPolygon>.Create; try L.Add(P); Test(False); Test(False); WriteLn('Updating via Delete/Insert seems to work.'); WriteLn('But why not via assigning?'); WriteLn('Press Enter to continue...'); ReadLn; Test(True); Test(True); finally L.Free; end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; WriteLn('Program has finished.'); WriteLn('Press Enter to close...'); Readln; end. -
Updating TPolygon items in generic List is difficult?
Gustav Schubert replied to Gustav Schubert's topic in RTL and Delphi Object Pascal
New Wheel: Special purpose Array with Add method and Count property, an attempt. unit RiggVar.FederModel.ListArray; interface type TListArray<T> = class private FEmpty: T; FArray: TArray<T>; FLength: Integer; FCount: Integer; function GetItem(Index: Integer): T; procedure SetItem(Index: Integer; const Value: T); public constructor Create(ALength: Integer; AEmpty: T); procedure Clear; function Add(AItem: T): Integer; procedure Delete(Index: Integer); procedure Insert(Index: Integer; AItem: T); property Count: Integer read FCount; property Items[Index: Integer]: T read GetItem write SetItem; default; end; { - Original use case: substitute for TList<TPolygon> - needed in Delphi 10.1 (work around RSP-16511) - It is intended for a known maximum number of items only. } implementation { TListArray<T> } constructor TListArray<T>.Create(ALength: Integer; AEmpty: T); begin FCount := 0; FLength := ALength; FEmpty := AEmpty; SetLength(FArray, FLength); Clear; end; procedure TListArray<T>.Clear; var i: Integer; begin FCount := 0; for i := 0 to FLength - 1 do begin FArray[i] := FEmpty; end; end; function TListArray<T>.GetItem(Index: Integer): T; begin if (Index < 0) or (Index >= FCount) then result := FEmpty else result := FArray[Index]; end; procedure TListArray<T>.SetItem(Index: Integer; const Value: T); begin if (Index >= 0) and (Index < FLength) and (Index < FCount) then FArray[Index] := Value; end; function TListArray<T>.Add(AItem: T): Integer; begin if FCount < FLength then begin FArray[FCount] := AItem; Inc(FCount); result := FCount; end else result := -1; end; procedure TListArray<T>.Delete(Index: Integer); var I: Integer; begin if (Index >= 0) and (Index < FLength) and (FCount > 0) and (Index < FCount) then begin for i := Index to FCount - 2 do FArray[i] := FArray[i + 1]; FArray[FCount - 1] := FEmpty; Dec(FCount); end; end; procedure TListArray<T>.Insert(Index: Integer; AItem: T); var i: Integer; begin if (Index >= 0) and (Index < FCount) and (FCount < FLength) then begin for i := FCount downto Index + 1 do FArray[i] := FArray[i - 1]; FArray[Index] := AItem; Inc(FCount); end; end; end. -
Updating TPolygon items in generic List is difficult?
Gustav Schubert replied to Gustav Schubert's topic in RTL and Delphi Object Pascal
Reading the bug report is one thing, understanding it another. I am dumping my test program here. It shows how to display the reference count of the dynamic array in the list. Comments in button click method will serve as alternative explanation for the same old problem you don't have. unit FrmMain; interface { 1. If you use new version of Delphi, please ignore. 2. In older version of Delphi, including Berlin, there is (known) bug. 3. Because of this bug (internal details already explained elsewhere) the reference count of the TPolygon will not be incremented when assigning to the list index. 4. When the assigned Polygon is a local variable which goes out of scope at the end of the method, it will be finalized and the list then contains a dangling pointer. 5. The AV only happens later, the next time the polygon is accessed. 6. The exception will likely be caught and handled by the debugger and following this the assignment will succeed. The newly assigned polygon will be usable, if the assigned polygon will not be finalized. 7. It is possible to monitor the reference count of the dynamic array. Stackoverflow question 22163259 has the answer that shows how. 8. The test program below has a timer which will update a report, which is showing the current ref count of the dynamic array in the list. - Usually the ref count of the polygon in the list is two. - After assigning a local variable with unique content it goes down to one. - The next time you click, the exception may happen, and ref count will be two again. - If assigning something that will not be finalized next, then the reference count can be left at one with no problem. - The biggest problem is the dangling pointer that is left behind, if any. - And the second biggest problem is the exception itself, which is not wanted. 9. Again, fixed in new version of Delphi! } uses Winapi.Windows, System.SysUtils, System.Classes, System.Types, System.StrUtils, System.UITypes, System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects; type { for Delphi 10.1. Berlin } TFormMain = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; Button6: TButton; Button7: TButton; T: TText; Timer: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure TimerTimer(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button7Click(Sender: TObject); private P1: TPolygon; P2: TPolygon; L: TList<TPolygon>; SL: TStringList; Counter: Integer; RefCountP1: Integer; RefCountP2: Integer; RefCountL0: Integer; procedure ShowContent; procedure SetupText; end; var FormMain: TFormMain; implementation {$R *.fmx} type { https://stackoverflow.com/questions/22163259/ } { how-i-determine-the-number-of-references-to-a-dynamic-array } PDynArrayRec = ^TDynArrayRec; TDynArrayRec = packed record {$IFDEF CPUX64} _Padding: LongInt; // Make 16 byte align for payload.. {$ENDIF} RefCnt: LongInt; Length: NativeInt; end; function DynArrayRefCount(P: Pointer): LongInt; begin if P <> nil then Result := PDynArrayRec(PByte(P) - SizeOf(TDynArrayRec))^.RefCnt else Result := 0; end; procedure TFormMain.FormCreate(Sender: TObject); begin P1 := [TPointF.Create(1, 1)]; P2 := [TPointF.Create(2, 2)]; L := TList<TPolygon>.Create; L.Add(P1); SL := TStringList.Create; SetupText; Timer.Interval := 500; Button7.Text := 'Reset'; end; procedure TFormMain.FormDestroy(Sender: TObject); begin L.Free; SL.Free; end; procedure TFormMain.TimerTimer(Sender: TObject); begin ShowContent; end; procedure TFormMain.SetupText; begin T.VertTextAlign := TTextAlign.Leading; T.Width := 200; T.Height := 500; T.Font.Size := 16; {$ifdef MACOS} T.Font.Family := 'CourierNewPSMT'; {$else} T.Font.Family := 'Courier New'; {$endif} T.Font.Style := T.Font.Style + [TFontStyle.fsBold]; T.Opacity := 1.0; T.Color := TAlphaColors.Cornflowerblue; T.HitTest := False; end; procedure TFormMain.ShowContent; var P: TPointF; s: string; begin if L.Count < 1 then begin T.Text := 'L is Empty'; Exit; end; RefCountP1 := DynArrayRefCount(Pointer(P1)); RefCountP2 := DynArrayRefCount(Pointer(P2)); RefCountL0 := DynArrayRefCount(Pointer(L[0])); Inc(Counter); SL.Clear; SL.Add(IntToStr(Counter)); SL.Add(Format('RecCountP1 = %d', [RefCountP1])); SL.Add(Format('RecCountP2 = %d', [RefCountP2])); SL.Add(Format('RecCountL0 = %d', [RefCountL0])); for P in L[0] do begin s := Format('(%.2f, %.2f)', [P.X, P.Y]); SL.Add(s); end; T.Text := SL.Text; end; procedure TFormMain.Button1Click(Sender: TObject); begin { problem will show at this point when L.Items[0] is invalid } // CurrentRefCount := DynArrayRefCount(Pointer(L[0])); // if CurrentRefCount > 1 then // begin L.Items[0] := P1; // end; end; procedure TFormMain.Button2Click(Sender: TObject); begin { this does not change anything } L[0] := L[0]; end; procedure TFormMain.Button3Click(Sender: TObject); var Temp: TPolygon; i: Integer; begin { this is ok, if L[0] contains valid polygon } Temp := P1; // P1 will not be finalized after method ends i := DynArrayRefCount(Pointer(Temp)); // Assert(i = 3); if not (i = 3) then Beep; L[0] := Temp; end; procedure TFormMain.Button4Click(Sender: TObject); begin { will leave a dangling pointer in L[0] } L[0] := L[0] + P1; end; procedure TFormMain.Button5Click(Sender: TObject); var Temp: TPolygon; begin { will leave a dangling pointer in L[0] } Temp := L[0] + P1; L[0] := Temp; end; procedure TFormMain.Button6Click(Sender: TObject); var Temp: TPolygon; begin { will leave dangling pointer in L[0] } { but no exception here when clicked again } { because it is not accessed } Temp := P1 + P2; L.Delete(0); L.Insert(0, Temp); end; procedure TFormMain.Button7Click(Sender: TObject); begin { Reset, ref count of L[0] will be two again. } L.Clear; L.Add(P1); end; (* https://stackoverflow.com/questions/45958714/ delphi-dynamic-array-reference-counting *) end. -
Updating TPolygon items in generic List is difficult?
Gustav Schubert replied to Gustav Schubert's topic in RTL and Delphi Object Pascal
I started to debug and have already stopped, after verifying that the AV happens when calling DynArrayClear inside of TListHelper.DoSetItemDynArray. procedure TListHelper.DoSetItemDynArray(const Value; AIndex: Integer); begin try // ... finally DynArrayClear(OldItem, FTypeInfo); // in 10.1.2 { DynArrayClear(OldItem, ElType); } // from 10.3.0 end; end; Update: Now I see that the best explanation (so far) is at stackoverflow, I am coming late to the party, sorry. https://stackoverflow.com/questions/41047688/how-to-work-around-delphi-10s-bug-with-tlist-anydynamicarrays -
Updating TPolygon items in generic List is difficult?
Gustav Schubert replied to Gustav Schubert's topic in RTL and Delphi Object Pascal
Good to know, I am using D10.1, perhaps a fixed bug, but I could not find a report in QP. -
Ha, here at home, today, I needed to do this test: procedure Test; var R1, R2, R3: TRectF; begin { TRectF from System.Types, when calling class operator TRectF.Add in 10.1 Berlin, will call class function TRectF.Union, which will call UnionRectF(Result, R1, R2), which will return Zero if result is Empty. <-- wrong ? The c++ code given in the docwiki does not do this. (please check) https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.Types.TRectF } R1 := TRectF.Create(-1, 0, 1, 0); R2 := TRectF.Create(0, -1, 0, 1); R3 := R1 + R2; // (0, 0, 0, 0) unexpected R1 := TRectF.Create(-1, 0, 1, 0.1); R2 := TRectF.Create(0, -1, 0.1, 1); R3 := R1 + R2; // (-1, -1, 1, 1) // as expected end;
-
class operator TRectF.Add
Gustav Schubert replied to Gustav Schubert's topic in RTL and Delphi Object Pascal
Thanks for the two good comments above (code context and wording). QP tells me that I do not have permission to create a report, but here are the steps I prepared, please feel free to use them. function Test: Boolean; var P1, P2: TPointF; P3, P4: TPointF; R1, R2: TRectF; ActualResult: TRectF; ExpectedResult: TRectF; begin P1 := TPointF.Create(-1, 0); P2 := TPointF.Create(1, 0); P3 := TPointF.Create(0, -1); P4 := TPointF.Create(0, 1); { imagine rectangles that hold the two points of a line } R1 := TRectF.Create(P1, P2); // horizontal line R2 := TRectF.Create(P3, P4); // vertical line ActualResult := R1 + R2; ExpectedResult := TRectF.Create(-1, -1, 1, 1); result := ActualResult = ExpectedResult; end; Title: TRect.Add and UnionF problem with Empty rectangles Description: Class operator Add of TRectF has a problem with Emtpy operands. It will return Zero when it should not. It is understood that the actual problem is the implementation of UnionRectF. -
No, and you do not need any packages. It is not even cross-platform at the moment. It demonstrates some basics, like how to create components at runtime.
-
This one is the latest: https://github.com/federgraph/SudokuHelper Not a mainstream demo, but it will draw your attention to the things that are important. ( Just make sure you update .\$(Platform)\$(Config) in the project options before compiling. )
-
SudokuHelper - Example for uncoupled design via interfaces
Gustav Schubert replied to PeterBelow's topic in I made this
The Help text is now available in markdown and with screenshot, if you want to have a preview of how this application looks like.- 38 replies
-
- interfaces
- uncoupled design
-
(and 2 more)
Tagged with:
-
What happens if you test out TMediaPlayer on Android? It seems to work on Windows. procedure TFormMain.FormCreate(Sender: TObject); begin { TMediaPlayerControl component instance } MediaPlayerControl.Align := TAlignLayout.Client; MediaPlayerControl.MediaPlayer := MediaPlayer; { TMediaPlayer component instance } MediaPlayer.FileName := 'TestGif.gif'; MediaPlayer.Play; end;
-
Yes, it does on Windows. No event needed.
-
If so the test app can be simplified: MediaPlayer not needed. This topic has potential to become an interesting question. I wanted to reduce the amount of updates. Here we want frequent updates as the form is relocated, not resized. Resizing is not the problem. Correct me if I am wrong.
-
Did you consider OnIdle? As I understand it, the issue is when dragging the main form by the title bar, then the location of the TImage is not updated; not while changing the position and not even after the drag operation has ended. Using OnIdle can be a replacement for the missing OnResizeEnd event. It should work on a Mac but may not be good enough, as it is not called while dragging. procedure TfrmMain.FormActivate(Sender: TObject); begin OnActivate := nil; FOSD := TImageLayout.Create(self); FOSD.Parent := self; FOSD.Align := TAlignLayout.Contents; FOSD.Visible := true; imgPlay.Parent := FOSD; FOSD.Active := true; MediaPlayer.FileName := 'D:\...\TestGif.gif'; MediaPlayer.Play; Application.OnIdle := DoOnIdle; end; procedure TfrmMain.DoOnIdle(Sender: TObject; var Handled: Boolean); begin if (Left <> OldLeft) or (Top <> OldTop) then begin Inc(IdleCounter); OldLeft := Left; OldTop := Top; Caption := IntToStr(IdleCounter); FOSD.UpdateView; end; Handled := True; end; Update: Are we in search of an event that is triggered when the form is repositioned? procedure TfrmMain.FormActivate(Sender: TObject); begin ... { OnTimer is the one to beat. OnResize fails. public property TControl.OnResized is not available in 10.1 Berlin (I cannot test). OnResizeEnd is priate to myself. OnIdle is not triggered while relocating. OnCanResize does not exist in FMX (works in VCL). } Timer.Interval := 1; // Self.OnResize := FormResize; // Self.OnResizeEnd := FormResizeEnd; // Application.OnIdle := DoOnIdle; Timer.OnTimer := FormResize; end; procedure TfrmMain.FormResize(Sender: TObject); begin if FOSD <> nil then FOSD.UpdateView; end; Test result: I don't know.
-
OnResizeEnd ? ( RSP-18851 ) Not tested.
-
I am quite sure that, for the TAsyncDeletion trick to work in Tokyo, you need to make one more change, in TControls.Destroy. { in Vcl.Controls } destructor TControl.Destroy; begin if Application <> nil then // <-- check needed Application.ControlDestroyed(Self); // ... end; Otherwise, when closing application, you will have access violation and different memory leak (TScrollWindows) because TAsyncDeletion.FreeItems is called when Application is already nil, and App will crash when first item in the list is destroyed.
-
deleted
-
Detail noticed: Order is initially ok, IF the default style is not Windows (but for example Iceberg Classico) and only becomes problematic after switching to another VCL Style (other than Windows). // order with default VCL style <> Windows, immediately after startup TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TListView TTreeView // order after switching to VCL style <> Windows TListView TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TScrollingStyleHook.TScrollWindow TTreeView ( The order we always get with the workaround is the same as the initial order without workaround. )
-
1. I have reduced the test project (in source.zip on page 1) further and have a very small observation: With only three components (RadioGroup, TreeView, ListView) the memory leak disapears. But the memory leak (after switching style at runtime) is back when TreeView and ListView are children of (the same) Panel. I needed to bring back the panel! In other words: The observation is that the parent Panel plays a role. Why is it that we need a Panel (or maybe other common parent component) to see the problem? 2. Confirmed that the TListView.WndProc override 'works' in Tokyo.