Jump to content

Gustav Schubert

Members
  • Content Count

    114
  • 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

25 Excellent

Technical Information

  • Delphi-Version
    Delphi 12 Athens

Recent Profile Visitors

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

  1. Gustav Schubert

    Delphi 12 Athens Refactoring Broken

    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... )
  2. Gustav Schubert

    Delphi 12 Athens Refactoring Broken

    To get rename refactoring back, install the modelling option, as Uwe pointed out in RSP-42936. It worked for me!
  3. Gustav Schubert

    FMX Resize / StartWindowResize

    You could vote for feature request RSP-18851. It suggests a new event for TCommonCustomForm, which is called when resize has ended.
  4. Gustav Schubert

    User Drawing of Lines and Curves

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

    Function with 2 return values ?

    But it started with two good answers at the top, which I liked, to make it clear. 🙂
  6. Gustav Schubert

    Function with 2 return values ?

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

    Updating TPolygon items in generic List is difficult?

    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.
  8. Gustav Schubert

    Updating TPolygon items in generic List is difficult?

    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.
  9. Gustav Schubert

    Updating TPolygon items in generic List is difficult?

    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
  10. Gustav Schubert

    Updating TPolygon items in generic List is difficult?

    Good to know, I am using D10.1, perhaps a fixed bug, but I could not find a report in QP.
  11. 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.
  12. Gustav Schubert

    class operator TRectF.Add

    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.
  13. Gustav Schubert

    class operator TRectF.Add

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

    I need FireMonkey demo projects

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

    I need FireMonkey demo projects

    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. )
×