balabuev

Never tried it myself, but I suspect that you just need to return a string with specific format. Such as "(3, 5, 7)" to show value as array with child elements. Or like "(PropA: 3; PropB: 5)" to show as object with child properties. I may be wrong, of course.

Do you looked at the source code of TDebuggerListHelperVisualizer.GetReplacementValue?

On 3/29/2021 at 10:18 AM, FaFaFooey said:

In 10.4.2 the top line is not selected when invoked

This happens (and always was the case) with the following settings:

Task completed:

Then, I don't know, sorry.

Try to uninstall third-party stuff. Like Cnpack/Gexperts...

Also your object instector looks strange. I have no horizontal lines:

12 minutes ago, malobo said:

Any idea?

Non-standard property editors are installed. More technically (if anyone interested) this happens when a property editor implements ICustomPropertyDrawing interface but does not implement more recently introduced ICustomPropertyDrawing80 interface.

My point is that from all things, happening during rescaling of a form, the most resource consuming are SetWindowPos calls, which are called from SetBounds, which are themselfs called from different places, including AlignControls.

Drawing and especially async invalidation takes much less resources and time, imho.

So, when we speak about form rescaling performance, we can denote it as O(n), where n - is mostly the number of SetWindowPos calls. To trace how many times SetWindowPos is actually called we can use WM_WINDOWPOSCHANGED event handlers on child controls.

So, given very simple example with a single TPanel control, aligned with alClient on a form, I see three SetWindowPos on each dpi boundary cross:

procedure TPanel.WMWindowPosChanged(var M: TWMWindowPosChanged);
var
  cr: TRect;
begin
  if (M.WindowPos.flags and SWP_NOSIZE) = 0 then
  begin
    Winapi.Windows.GetWindowRect(Handle, cr);
    OutputDebugString(PChar('WMWindowPosChanged: ' + cr.Width.ToString +
                            ',' + cr.Height.ToString));
  end;
  inherited;
end;

As seen from the events log the child panel is repositioned three times, and each time its size is set to different value: 

• 638 * 380
• 510 * 304
• 640 * 382

So, in this particular case three times more work is done, than it actually required.

Test project: dpi_test.zip

PS: Looking more generally at this issue I have to conclude that layouting should be asynchronous. The concept of async layouting is a some kind of replacement of the global BeginUpdate/EndUpdate mentioned earlier. But, this will be too big and breaking change for VCL. And moreover, this is almost impossible for native Windows controls, such as TEdit, TListBox, etc.

33 minutes ago, Attila Kovacs said:

Could you check if this superfluous invalidate in Vcl.Controls has an impact on it? I forgot the details on it.

In my demo on a form full of different controls this line is not executed at all.

Those issues in VCL are unfixable.

Sorting of replacement patterns (by length, desc) seems to me an overkill.

As @Attila Kovacs already proposed, input patterns already have their natural order in array - so this order should be respected. This will be more flexible, and fast.

8 hours ago, David Heffernan said:

I guess if there are no firm rules on the expected behaviour, then that makes it easier to write faster code. 

You are welcome to try.

1 hour ago, Attila Kovacs said:

does this respect the order of the substrings?

Hm. I think - yes.

Here is my small idea. Not perfect, has limitations, I guess, but usable 

{$POINTERMATH ON}

const
  GUESS_MASK = 32 - 1;

procedure BuildGuess(AGuess: PByte; const aOld: array of string);
var
  pi, j: Integer;
begin
  FillChar(AGuess^, GUESS_MASK + 1, 0);
  for pi := 0 to High(aOld) do
  begin
    j := Ord(aOld[pi][1]) and GUESS_MASK;
    if AGuess[j] = 0 then
      AGuess[j] := pi + 1
    else
      AGuess[j] := 255;
  end;
end;

function Equals(S1, S2: PChar; ACount: Integer): Boolean;
var
  i: Integer;
begin
  for i := 0 to ACount - 1 do
  begin
    if S1[i] <> S2[i] then
      Exit(False);
  end;
  Result := True;
end;

function MyReplace(const S: string; const aOld, aNew: array of string): string;
label
  L;
var
  lnt:    Integer;
  pcnt:   Integer;
  c, eof: PChar;
  p:      PChar;
  pi, j:  Integer;
  pln:    Integer;
  off:    Integer;
  guess:  array[0..GUESS_MASK] of Byte;
begin
  pln  := 0;
  lnt  := Length(S);
  pcnt := Length(AOld);

  BuildGuess(@guess, aOld);
  SetLength(Result, lnt * 2);

  c   := Pointer(S);
  eof := c + lnt;
  off := PChar(Pointer(Result)) - c;

  while c <> eof do
  begin
    pi := guess[Ord(c^) and GUESS_MASK];
    if pi <> 0 then
    begin
      if pi <> 255 then
      begin
        Dec(pi);
        pln := aOld[pi].Length;
        if (c^ = aOld[pi][1]) and Equals(c, Pointer(aOld[pi]), pln) then
          goto L;
      end
      else
      begin
        pi := 0;
        while pi <> pcnt do
        begin
          pln := aOld[pi].Length;
          if (c^ = aOld[pi][1]) and Equals(c, Pointer(aOld[pi]), pln) then
            goto L;
          Inc(pi);
        end;
      end;
    end;

    c[off] := c^;
    Inc(c);
    Continue;
  L:
    Inc(c, pln);
    Dec(off, pln);

    pln := aNew[pi].Length;
    p   := Pointer(aNew[pi]);

    for j := 0 to pln - 1 do
      c[off + j] := p[j];
    Inc(off, pln);
  end;

  SetLength(Result, @c[off] - PChar(Pointer(Result)));
end;

Voted.

5 hours ago, Mike Torrettinni said:

is this something you came up with on the spot, or you are using something similar or is from another library? This is not licensed, right, I can use in commercial software?

No library used, just a simplest implementation of hash map. Use it as you need.

7 hours ago, Stefan Glienke said:

the approach to use objects as bucket items for a hashmap is a no go in real code

I'm hearing about this the first time ever, and it seems to me very strange. Also, a single hash map can be organized on top of TDataLine user objects without any additional objects (via additng Next and Hash fields directly to TDataLine). Two maps, however will need another one pair of such properties, which is not so graceful, but also possible, if we speak about the extreme case.

7 hours ago, Stefan Glienke said:

On my i7 the TNameMap already drops behind the RTL dict at around 50000k items.

I've only tested with 100k items. I can see the effect. However, it's not clear for me why this happens.

Here is my try. I've changed a lot in existing code (mentioned early comparers, equality comparers, etc.). Also, I've replaced returned string type in functions by PString, just because otherwise string handling takes too much time and algorythms comparison becomes not interesting. 

As well I've added my own minimalistic implementation of hash maps (not universal).

mapstest.zip

9 minutes ago, Edwin Yip said:

Mike, can you share your benchmarking code on github?

Or simply upload zipped project here...

FMX is no way to go. What is more, controls are ususally developed for more than just one latest IDE version. So, what is matter, whether in some reasonably old IDE version FMX works good and is actually popular.

On 2/22/2021 at 11:46 AM, Stefan Glienke said:

Should be an (*1)array of (*2)pointer to libvlc_media_track_t passed by (*3)reference, no?

I think this is a:

• passed by reference (1*)
  • pointer variable, which will point (2*) to
    • array of pointers (3*) to libvlc_media_track_t structs.

type
  PTracks = ^TTracks;
  TTracks = array[0..1024] of ^libvlc_media_track_t;

function  libvlc_media_tracks_get(p_md: libvlc_media_t_ptr; var tracks: PTracks): LongWord; cdecl;
procedure libvlc_media_tracks_release(tracks: PTracks; i_count: LongWord); cdecl;

procedure GetTracks;
var
  tracks: PTracks;
  cnt:    Integer;
  track:  libvlc_media_track_t;
begin
  cnt := libvlc_media_tracks_get(FVLCMIntf, tracks);
  try
    for i := 0 to cnt - 1 do
    begin
      track := tracks[i]^;
      DoSomething(track);
    end;
  finally
    libvlc_media_tracks_release(tracks, cnt);
  end;
end;

4 hours ago, Attila Kovacs said:

Is it tested now?

Not really works, because enqueued via ForceQueue tasks are not executed after the main form close. So, need to replace it with some explicit implementation:

type
  TScrollingStyleHook = class(TMouseTrackControlStyleHook)
  public type
    //...
    TAsyncDeletion = class
    private
    class var
      FItems: TList;
      class procedure FreeItems;
    public
      class destructor Destroy;
      class procedure  FreeAsync(O: TObject);
    end;
    //...
  end;

class destructor TScrollingStyleHook.TAsyncDeletion.Destroy;
begin
  TThread.RemoveQueuedEvents(nil, FreeItems);
  FreeItems;
end;

class procedure TScrollingStyleHook.TAsyncDeletion.FreeAsync(O: TObject);
begin
  if FItems = nil then
  begin
    FItems := TList.Create;
    TThread.ForceQueue(nil, FreeItems);
  end;
  FItems.Add(O);
end;

class procedure TScrollingStyleHook.TAsyncDeletion.FreeItems;
var
  itm: TObject;
begin
  if FItems <> nil then
  begin
    for itm in FItems do
      TObject(itm).Free;
    FreeAndNil(FItems);
  end;
end;

This version works fine.

1 hour ago, pyscripter said:

Are you planning to submit one?

Ohh, no. I can vote if someone will report.

40 minutes ago, pyscripter said:

Code queued with ForceQueue is executed in the main thread with the same mechanism as Thread.Synchronize and not with PostMessage.

It's looks like carefully hidden stuff, but PostMessage is there:

class procedure TThread.Synchronize(...);
begin
  //...
  if Assigned(WakeMainThread) then
    WakeMainThread(SyncProcPtr.SyncRec.FThread);
  //...
end;

procedure TApplication.WakeMainThread(Sender: TObject);
begin
  PostMessage(Handle, WM_NULL, 0, 0);
end;

procedure TApplication.WndProc(var Message: TMessage);
begin
  //...
  WM_NULL:
    CheckSynchronize; // Executes accumulated tasks.
  //...
end;

There simply no other ways, main thread executes message loop infinitely.

6 minutes ago, Attila Kovacs said:

Destroying a window from a different thread? Does it work?

AFAIK, this internally executed in the context of the main thread (via PostMessage).

1 hour ago, pyscripter said:

I guess the issue would still be present if you now replace the ListView with anything that has scrollbars including a treeview.  Is that right?

I think similarly.

1 hour ago, pyscripter said:

How about this one?

Yes, something like this. However, I'll still prefer to leave DoRemoveControl as is, and deal with TScrollingStyleHook.Destroy instead to defer the destruction of two TScrollWindow objects only.

And, since TScrollWindow objects (controls) uses CreateParented constructor, which utilizes ParentWindow property (instead of Parent property), they cannot be occasionnaly destroyed by their parents. So, this simplifies the task a bit, and we can ommit usual book keeping involving FreeNotification, etc.

procedure FreeScrollWindowAsync(W: TScrollingStyleHook.TScrollWindow);
begin
  if W.HandleAllocated then
  begin
    ShowWindow(W.Handle, SW_HIDE);
    TThread.ForceQueue(nil, procedure
    begin
      W.Free;
    end);
  end
  else
    W.Free;
end;

destructor TScrollingStyleHook.Destroy;
begin
  FInitingScrollBars := True;
  if FVertScrollWnd <> nil then
  begin
    FVertScrollWnd.StyleHook := nil;
    FreeScrollWindowAsync(FVertScrollWnd);
  end;
  if FHorzScrollWnd <> nil then
  begin
    FHorzScrollWnd.StyleHook := nil;
    FreeScrollWindowAsync(FHorzScrollWnd);
  end;
  FInitingScrollBars := False;
  inherited;
end;