Jump to content

Gustav Schubert

Members
 View Profile  See their activity

  • Content Count

    116

  • Joined

  • Last visited

  • Days Won

    1

Posts posted by Gustav Schubert

  1. Posted

    7 hours ago, MichaelT said:

    not being precise enough

    Thanks for you excellent precision, it was helpful!

     

    The documents folder is apparently the folder where everyone will dump their stuff. My attempt to make sure that nothing in there will be automatically saved to the cloud failed at least once. It is a no go area for my documents. I almost never look there. So, when I try  to find the Catalog Repository folder, I go straight to "Dieser PC" in Explorer and try my luck in "Öffentlich" first.

     

    I guess the new version of PAServer fixes the need to copy newly installed provisioning files from the new location to the location where PAServer is looking for them. But how can one know?

    • Like 1

  2. Posted

    41 minutes ago, MichaelT said:

    The new files do exist in the Catalog Reporsitory.

    I have just installed the May patch via GetIt, using the link in the IDE. I see two Catalog Repository folders, one in the public documents library, and one in the user account document library, which has the new files.

    • Like 1

  3. Posted

    21 hours ago, Navid Madani said:

    Is it just me, or is the entire refactoring functionality in 12/Athens 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... )

  6. Posted

    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;

     

  8. Posted · Edited by Gustav Schubert
    Use of Double should be questioned before optimization.

    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;


     

  9. Posted · Edited by Gustav Schubert

    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.

     

  10. Posted · Edited by Gustav Schubert
    typo

    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.

     

    • Like 1

  11. Posted · Edited by Gustav Schubert
    link to stackoverflow added

    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

  13. Posted

    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.

     

  14. Posted

    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.
     

  15. Posted

    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;

     

  19. Posted

    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;


     

    • Like 1

  21. Posted

    18 hours ago, Gustav Schubert said:

    Are we  in search of an event that is triggered when the form is repositioned?

    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.

     

  22. Posted · Edited by Gustav Schubert
    after testing out timer

    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.
     

  24. Posted

    On 3/10/2021 at 4:36 PM, balabuev said:

    This version works fine.

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