Jump to content

Gustav Schubert

  • Content Count

  • Joined

  • Last visited

  • Days Won


Gustav Schubert last won the day on December 11 2019

Gustav Schubert had the most liked content!

Community Reputation

23 Excellent

Technical Information

  • Delphi-Version
    Delphi 10.1 Berlin

Recent Profile Visitors

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

  1. Gustav Schubert

    Function with 2 return values ?

    But it started with two good answers at the top, which I liked, to make it clear. 🙂
  2. 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;
  3. 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.
  4. 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.
  5. 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
  6. 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.
  7. 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.
  8. 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.
  9. 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;
  10. 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.
  11. 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. )
  12. Gustav Schubert

    SudokuHelper - Example for uncoupled design via interfaces

    The Help text is now available in markdown and with screenshot, if you want to have a preview of how this application looks like.
  13. Gustav Schubert

    Component for GIF animation

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

    Firemonkey draw over native elements

    Yes, it does on Windows. No event needed.
  15. Gustav Schubert

    Firemonkey draw over native elements

    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.