aehimself

2 hours ago, limelect said:

I did not check for FMX

In VCL Easy use OgFirst in free "ONGUARD"

in DPR

begin
  if  TogFirst.IsFirstInstance  then
  begin
xxxxxxxxxx

xxxxxxxxxx

xxxxxxxxxxx

  end
  else TogFirst.ActivateFirstInstance;
 

I can not understand why you have to have (free or paid) components for everything; unless true multiplatform is supported.

You can simply use WinApi:

handle := CreateMutex(nil, True, 'MyApplicationUniqueMutex');
Try
  If (handle = 0) Or (GetLastError = ERROR_ALREADY_EXISTS) Then
  Begin
    ShowMessage('Only one instance can be running at a time!');
    handle := FindWindow('TMyApplicationMainForm', nil);
    If IsWindow(handle) Then
    Begin
      ShowWindow(handle, SW_RESTORE And SW_SHOW);
      SetForegroundWindow(handle);
      SetFocus(handle);
    End;
    handle := 0;
    Exit;
  End;
  
  // Stuff from DPR... like Application.Run etc
  
Finally
 If handle <> 0 Then
   CloseHandle(handle);
End; 

End result is the same and you have smaller resource footprint.
 

Unfortunately GetMatchingBracketEx does not support quotes - to be precise opener and closer pairs which are the same character. I wrote a quick handler for quotes, all is working like a charm:

// This whole method was copied from https://stackoverflow.com/questions/18487553/synedit-onpainttransientdemo and modified
// to draw rectangles instead of coloring. A few bugs were fixed and it was greatly simplified, too. Oh and while I figured
// out what it is doind exactly, I placed some comments for easier understanding :)
Procedure TEditorFrame.SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);

  Procedure PaintText(Const inPoint: TPoint; Const inText: String);
  Begin
    Case TransientType Of
      ttAfter:
      Begin
        // Clear brush and pen has font color: rectangle will be drawn
        SynEdit1.Canvas.Brush.Style := bsClear;
        SynEdit1.Canvas.Pen.Color := SynEdit1.Font.Color;
      End;
      ttBefore:
      Begin
        // Solid brush and pen has background color: Rectangle will be cleared
        SynEdit1.Canvas.Brush.Style := bsSolid;
        SynEdit1.Canvas.Pen.Color := SynEdit1.Color;
      End;
    End;

    SynEdit1.Canvas.Rectangle(inPoint.X, inPoint.Y, inPoint.X + SynEdit1.Canvas.TextWidth(inText), inPoint.Y + SynEdit1.Canvas.TextHeight(inText));
    SynEdit1.Canvas.TextOut(inPoint.X, inPoint.Y, inText);
  End;

Const
  OCSYMBOLS = '()[]{}<>''"';

Var
  bufcoord: TBufferCoord;
  tp: TPoint;
  index, a: Integer;
  c: Char;
Begin
  c := #0;
  bufcoord := SynEdit1.CaretXY;

  If (bufcoord.Char = 0) Or (bufcoord.Line = 0) Then
    Exit;

  If bufcoord.Char > 1 Then
  Begin
    // Take the character BEHIND the cursor and check if it's a character we need to highlight
    c := SynEdit1.Lines[bufcoord.Line - 1][bufcoord.Char - 1];
    index := OCSYMBOLS.IndexOf(c);
  End
  Else
    index := -1;

  If index = -1 Then
    If bufcoord.Char > Length(SynEdit1.Lines[bufcoord.Line - 1]) Then
      Exit
    Else
    Begin
      // The character behind the cursor wasn't something we need to highlight.
      // Take the character AFTER the cursor and check the same

      c := SynEdit1.Lines[bufcoord.Line - 1][bufcoord.Char];
      index := OCSYMBOLS.IndexOf(c);

      If index = -1 Then
        Exit;
    End
  Else
    bufcoord.Char := bufcoord.Char - 1;

  // Originally this was a FOR cycle but it's a waste to go through all if only one iteration actually performs something.
  // During the search we already got the character which requires highlighting. Simply use that to save some cycles
  SynEdit1.Canvas.Font.Assign(SynEdit1.Font);

  tp := SynEdit1.RowColumnToPixels(SynEdit1.BufferToDisplayPos(bufcoord));
  PaintText(tp, c);

  Case c Of
    '''', '"':
    Begin
      // GetMatchingBracketEx does not support the same opening and closing characters. Therefore quotes
      // need special handling.
      // This quick and easy method only detects quotes in the same line.

      index := bufcoord.Char;
      a := index - 1;

      // Try to find the previous quote of the same type
      While a > 0 Do
      Begin
        If SynEdit1.Lines[bufcoord.Line - 1][a] = c Then
          Break;
        Dec(a);
      End;

      If a = 0 Then
      Begin
        // No previous quote was found. Reset the position and try to find the next one
        a := index + 1;

        While a < Length(SynEdit1.Lines[bufcoord.Line - 1]) Do
        Begin
          If SynEdit1.Lines[bufcoord.Line - 1][a] = c Then
            Break;
          Inc(a);
        End;

        If a > Length(SynEdit1.Lines[bufcoord.Line - 1]) Then
          Exit;
      End;

      bufcoord.Char := a;
      tp := SynEdit1.RowColumnToPixels(SynEdit1.BufferToDisplayPos(bufcoord));
      End;
    Else
    Begin
      bufcoord := SynEdit1.GetMatchingBracketEx(bufcoord, OCSYMBOLS);

      If (bufcoord.Char = 0) Or (bufcoord.Line = 0) Then
        Exit;

      tp := SynEdit1.RowColumnToPixels(SynEdit1.BufferToDisplayPos(bufcoord));

      If tp.X <= SynEdit1.GutterWidth Then
        Exit;

      // We need to paint the opposite symbol now: if first one was an opener then a closer and vice versa.
      // Instead of an If statement we can simply use a XOr 1, as it will turn 1 -> 2 and 2 -> 1, 3 -> 4 and
      // 4 -> 3... giving the exact opposite symbol in the pair that we need
      c := OCSYMBOLS.Chars[index XOr 1];
    End;
  End;

  PaintText(tp, c);
End;

Feel free to use it if you like; any comment or improvement is welcome 🙂

@pyscripter The patch worked, it highlight correctly now! I saw that the request to be able to provide matching characters were also implemented so I changed the array to a string - this way no sorting is required and I can simply pass it to GetMatchingBracketEx.

I'll take a look into the efficiency you mentioned.

Thank you!

Hello,

I found and modified a code to highlight matching brackets in SynEdit in a Delphi IDE style (no color highlights, but a square around the characters. All is working fine except this one scenario:

Enter this pattern and place the cursor in the middle of the inner brackets:

Now, press backspace:

And now, enter an opening bracket again:

The rectangle around the first bracket doesn't get cleared and I can not figure out why. What is even more strange, if you put all in one line all works just fine:

This image was taken after deleting and reentering the inner starting bracket.

The code I have at the moment is the following:

// This whole method was copied from https://stackoverflow.com/questions/18487553/synedit-onpainttransientdemo and modified
// to draw rectangles instead of coloring.
Procedure TEditorFrame.SynEdit1PaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);

  Procedure PaintText(Const inPoint: TPoint; Const inText: String);
  Begin
    Case TransientType Of
      ttAfter:
      Begin
        // Clear brush and pen has font color: rectangle will be drawn
        SynEdit1.Canvas.Brush.Style := bsClear;
        SynEdit1.Canvas.Pen.Color := SynEdit1.Font.Color;
      End;

      ttBefore:
      Begin
        // Solid brush and pen has background color: Rectangle will be cleared
        SynEdit1.Canvas.Brush.Style := bsSolid;
        SynEdit1.Canvas.Pen.Color := SynEdit1.Color;
      End;
    End;

    SynEdit1.Canvas.Rectangle(inPoint.X, inPoint.Y, inPoint.X + SynEdit1.Canvas.TextWidth(inText), inPoint.Y + SynEdit1.Canvas.TextHeight(inText));
    SynEdit1.Canvas.TextOut(inPoint.X, inPoint.Y, inText);
  End;

Const
  OCSYMBOLS: Array[0..7] Of Char = ('(', ')', '{', '}', '[', ']', '<', '>');

Var
  bufcoord: TBufferCoord;
  tp: TPoint;
  a: Integer;
  c: Char;
Begin
  bufcoord := SynEdit1.CaretXY;
  a := SynEdit1.RowColToCharIndex(bufcoord);

  If (a > 0) And (a <= SynEdit1.Text.Length) Then
  Begin
    // First, take the character BEHIND the cursor and check if it's an opener or a closer

    c := SynEdit1.Text[a];
    If Not TArray.BinarySearch<Char>(OCSYMBOLS, c, a) Then
      c := #0;
  End
  Else
    c := #0;

  If c = #0 Then
  Begin
    // Variable a might have been overwritten by TArray.BinarySearch so let's initialize it again
    a := SynEdit1.RowColToCharIndex(bufcoord);

    If (a < SynEdit1.Text.Length) Then
    Begin
      // If the character behind the cursor wasn't an opener or a closer,
      // take the character AFTER the cursor and check the same

      c := SynEdit1.Text[a + 1];
      If Not TArray.BinarySearch<Char>(OCSYMBOLS, c, a) Then
        c := #0;
    End;

    If c = #0 Then
      Exit;
  End
  Else
    bufcoord.Char := bufcoord.Char - 1;

  // Originally this was a FOR cycle but it's a waste to go through all if only one iteration actually performs something.
  // During the binary search we already got the index and if it's an opener or a closer. Simply use those previously saved
  // values
  SynEdit1.Canvas.Font.Assign(SynEdit1.Font);

  tp := SynEdit1.RowColumnToPixels(SynEdit1.BufferToDisplayPos(bufcoord));
  PaintText(tp, c);

  bufcoord := SynEdit1.GetMatchingBracketEx(bufcoord);

  If (bufcoord.Char = 0) Or (bufcoord.Line = 0) Then
    Exit;

  tp := SynEdit1.RowColumnToPixels(SynEdit1.BufferToDisplayPos(bufcoord));

  If tp.X <= SynEdit1.GutterWidth Then
    Exit;

  // We need to paint the opposite symbol now: if first one was an opener then a closer and vice versa.
  // Instead of an If statement we can simply use a XOr 1, as it will turn 1 -> 2 and 2 -> 1, 3 -> 4 and
  // 4 -> 3... giving the exact opposite symbol in the pair that we need
  PaintText(tp, OCSYMBOLS[a XOr 1]);
End;

I'm using TurboPack SynEdit on D10.4.2. If the code doesn't compile just use SynEdit1.Gutter.Width instead, I think nothing else had to be changed.

Can someone please check and give some hints on why things go south? 🙂

Thanks!

On 8/26/2020 at 3:29 PM, Anders Melander said:

Yeah, that one is really annoying. I used to have a class helper that added TZipFile.Delete and Remove methods but one of the Delphi versions after XE2 broke that one as the required TZipFile internal data structures are no longer accessible to class helpers.

Kind of necroing a thread, I'm aware but I was just informed:

https://docwiki.embarcadero.com/RADStudio/Alexandria/en/What's_New#RTL:_TZipFile

Quote

RTL: TZipFile
We have focused on ZIP files (that is, the TZipFile class of the RTL) quality, improvements, and optimizations. We added support for Zip64 and a method to remove a file in TZipFile. Also, TZipHeader has a GetFIleName method, TZipFile.IsValid() accepts a stream parameter and System.Zip works with files larger in size than 4 GB.

Still doesn't support LZMA and still fails on slightly corrupted archives 7Zip extracts happily, though.

I don't know which one is funnier: the reply, or that an MSFT marked it as an answer 😄

Just now, Attila Kovacs said:

So they were leaks from the perspective of the initial test. This means that your repro's were also wrong, didn't they?

Well, yes and no. My repro was correct - in a way as it should have been done. In real world it could be like

Repeat
 CreateInnerMostFrameWithImageList;
Until False;

and just wait until I run out of GDI objects.

There were no leaks, just too many created at once due to a design issue.

There was a small trick I was unaware of. The innermost frame (which contained the ImageList) was not created once, but at least 10-20 times. Then, based on some criteria only one of them was shown (it's a really bad practice in my opinion, but it is how it is).

Since the ImageList contains 10-11 images, basically what I wanted to say is... 1 main frame easily created 100-200 GDI objects (or more) just for this one ImageList. To add salt to the wound, some of these main frames are not actually closed when they should be to improve loading time upon the next time they should be shown.

Moving the ImageList to a separate location kept the amount of GDI objects below 2500 at all times and the test finished without any issues. At the end of the day, @Fr0sT.Brutal was right - there was no leak, there were just way too many created which would have been freed up normally once the application (frame) closes.

Legacy code is the best. You can learn so much just from the design issues your predecessors made 🙂 Actually, without irony this time. I had no idea that "GDI object" as a thing exists and can make your program to crash!

7 minutes ago, Lars Fosdal said:

Not that it has any bearing on this problem, but I keep my shared image lists in a data module

Yep, in my own projects me too. Unfortunately this application was written some 20+ years ago and contains several thousand frames and hundreds of custom components… it will take a while to check and correct all these small design mistakes :)

49 minutes ago, Fr0sT.Brutal said:

Something could leak without a detectable leakage.

for i in 1..MaxInt do TButton.Create(MainForm)

these buttons will be freed on form close but they obviously leak

That is true, and definitely could apply here (no memory / GDI leak upon application closure) but we are talking about auto-created components here. The imagelist is on the innermost frame, and that frame is embedded design time on the parent frame.

I’ll check the whole chain tomorrow though - if just one is created runtime it can cause this.

Thanks!

1 minute ago, Attila Kovacs said:

You see what is leaking, you could start placing breakpoints to the constructor/destructor of the imagelists first and count them, and check who the caller is.

The issue is, about 600 frames are opened and closed before the issue detectibly appears. My sanity will give up first than to count each and every TImageList and track their lifetime.

Also, any Delphi object leak would be reported by DeLeaker upon application closure. I spent more than a year to get that list clean, so no more unfreed imagelists / TBitmaps 🙂

Just now, Attila Kovacs said:

Is that on the screenshot?

It's showing a bunch of HBITMAP leaks in the comctl32.dll.

TImageList is a wrapper for some windows imagelist so I'm suspecting that it's not freed correctly or created twice under the same reference etc...

I'd look for that.

Yes, it is. My first idea was that the skinning of TcxPageControl caused this (we recently applied some DevExpress skins based on user input) as it was the most recent change with comctrls involvement.

My issue is that the ImageList is simply dropped on the innermost frame design-time. It should be created and freed up automatically. If there would be a bug in the Delphi wrapper, it would be visible in my test case, too.

The real code contains a cximageList (DevExpress version) but symptoms are exactly the same if I replace it with a simply TImageList. This is why I didn't mention in until now. I doubt it will make any difference, though.

1 minute ago, Uwe Raabe said:

Yes, is was MS itself making that error.

 

BTW, Windows 10 requires a reboot for the changes to get applied - and there is a similar entry under the WOW6432Node (both should match).

 

Anyway, there were several things done to fix a GDI leak and significantly reduce the overall GDI handle usage in Delphi 11.

I already introduced my boss to D11 when it was released and I personally was the one who said I don't see a reason why we would need to upgrade.

Good thing is that I asked him to doublecheck our licensing and we should still be eligible. Will be a funny talk, though 🙂

My personal OCD still hasn't calmed down yet. How come a completely unused TImageList can cause a GDI object leak?

Or I'm just looking at the completely wrong direction. That is unfortunately a completely valid option, too.

2 hours ago, Attila Kovacs said:

I don't think that the ImageList should be on the frame.

There is a combobox, which is normally pulling those images from the ImageList. I have a hunch that if I get rid of the imagelist and push those bitmaps in resources the issue is solved... it just bugs me that I don't know what is causing the mayhem now.

2 hours ago, Attila Kovacs said:

Anyway, is your test-project also creates the sub-frames from the constructor?

Of course. I tried to replicate everything as close to the real thing as possible. Btw, creating the frames from constructor means inherited... by embedded I meant to add the innermost frame to an outer one from the designer.

2 hours ago, Attila Kovacs said:

You should check where and what is calling GetDC/ReleaseDC in the VCL and if they are called in pair.

I suspect the VCL is working correctly, this is why creating and destroying my test frame 100k + times makes no difference. I'm suspecting something funky going on here... like the Z-order TTreeNode leak with styles active or some 3rd party component interference.

My knowledge is severely limited in this area though, that's why I need starting points.

I'll do a quick search to see if GetDC is called in our custom components / frame code somewhere, but I doubt. The complexity the ancient code is written is pretty basic... data storage is a TStringList 78% of the times 🙂

2 minutes ago, Uwe Raabe said:

What is your registry value for HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\GDIProcessHandleQuota?

Could it be that it is 10000 decimal instead of 10000 hex?

It is the installation default, which is 10000 decimal. It seems irrelevant though, as if even an abandoned ImageList is on the innermost frame (all code commented out, not used at all, no images in it) will cause the application to have 7500+ GDI objects in about 20 minutes. If I completely remove the ImageList, GDI object count stays top 2500.

Hello,

Our legacy application mainly consist of frames which are created and displayed runtime when needed. Several parts of these frames are the same, so these functionalities were created on a smaller frame which was then embedded to the main frame. So basically we have a form with a panel, we create a frame in that panel and the constructor creates an other frame, which is on the frame we are creating. The subfame has an imagelist on it.

Recently our automatic test started to fail after creating and destroying ~600 frames because of "invalid parameter" when the DFM streaming was creating the bitmap to add it to the imagelist.

When executing the same test from the Delphi 10.4.2 IDE, actually 2 error messages appear, one after the other, but at the same place: parameter incorrect and out of system resources.

I managed to find out that the errors start appearing when the GDI object count reaches 9999 and a new frame is about to be created.

If I clear all bitmaps from the imagelist I get an "Invalid imagelist" error when GDI object count reaches the limit.

If I remove the ImageList from the frame, the test finishes successfully, without GDI object count raising above 2500.

No matter how hard I try I can not reproduce the issue in a fresh appication even if I model the imagelist-on-a-frame-on-a-frame-in-a-panel-on-a-form layout. GDI object count simply stays at 42.

Now, this is the first time I heard that there is such a thing as GDI objects and that there is a limit on it, so my experience is converging towards zero.

We have DeLeaker purchased and is showing no memory leaks. There are tons and tons of GDI objects during runtime, all from the same source:

Do you guys have any tips on how to find out what is causing this leak?

4 minutes ago, Henry Olive said:

How can i get THE FIRST WORD of a memo1.text ?

Var firstword = String(Memo1.Text).Trim.Substring(0, String(Memo1.Text).Trim.IndexOf(' '));

Ineffective, but will yield you results 🙂

But as I mentioned, this will work only in some cases. I'd recommend against using such a solution anywhere near production.

30 minutes ago, Lars Fosdal said:

No lingering BDS.exes for me.

Seems... you are perfect, too? 🙂

This won't work, you have to parse at least a little bit. E.g.:

-- This is a very good query
/* Just for extra complexity */ SELECT * FROM MyTable

is a valid SQL query.

Zeos has a SmartOpen property, so you can call .Open even on queries with no resultset returned - although I never tested this.

My personal solution is:

Function IsOpenQuery(Const inSQL: String): Boolean;
Var
 fword: String;
 tokenizer: TZTokenizer;
 token: TZToken;
Begin
 tokenizer := TZTokenizer.Create;
 fword := '';
 Try
  For token In tokenizer.TokenizeBuffer(inSQL, [toSkipUnknown, toSkipWhitespaces, toSkipComments, toSkipEOF, toUnifyNumbers]) Do
   If token.TokenType = ttWord Then Begin
                                    fword := Copy(token.P, 0, token.L).ToLower;
                                    Break;
                                    End;
 Finally
  FreeAndNil(tokenizer);
 End;

Result := (fword = 'select') Or (fword = 'show') { Or fword.IsEmpty };
End;

It uses Zeos's tokenizer for parsing so I don't have to worry about comments and stuff.

Although it works, it is still vulnerable to the fact that (probably) there are a lot more statements than SELECT and SHOW, which will return a resultset.

27 minutes ago, Mike Torrettinni said:

Never experienced any issue with updates, except when I tried fighting them 🙂

https://en.wikipedia.org/wiki/Stockholm_syndrome

1 hour ago, FPiette said:

You system must be badly configured. I never have a force reboot using Win10 PRO: the system tells me a reboot is required but don't reboot by itself (You can also set the working hours so that the system still reboot but only in the non-working hours). I suggest you have a better look at all the related setting. And also make sure you have the latest Windows 10. Currently this is version 21H1.

My thoughts exactly. I saw videos Windows rebooting itself on some live streams and conferences but never happened to me, not even once; and I was testing it from the first Insider build. I also have to admit that Microsoft did a great job around updates (less downtime, torrent-like downloading from Internet and neighboring PCs, active hour detection, etc); whoever says otherwise install Vista or 7 vanilla and try to patch it up to current.

I have a feeling that lots of absolute-negative opinions of Windows 10 would flip if only the logo would be Apple instead of Microsoft.

On 10/7/2021 at 12:39 PM, Uwe Raabe said:

A fresh VCL forms application shows a Delphi icon in front of the window title. What did you do to remove that?

Form 652. That's a pretty extended hello world collection!

I inherit most of my classes from TObject (I have a habit of freeing what I create myself) and ALL of them have inherited calls in constructors and destructors, even if the Create was ReIntroduce-d. There are a MINIMAL amount of cases when this was strictly forbidden - there I did the same what @Dalija Prasnikar did - put it there, comment it out, put a comment why it is commented out. With links, if possible.

These just feel empty without inherited calls, even though I know they do nothing.

On the other hand, my OCD makes me capitalize almost every instruction (Create, If, Then, Begin, End, Procedure, Function, etc.) so it might be just plain stupid after all 🙂

@Fr0sT.Brutal Call me old-fashioned, I'd simply use {$REGION}-s 🙂 Nevertheless yes, this is a valid case. Thanks!

On 10/1/2021 at 2:11 PM, Fr0sT.Brutal said:

This was likely advised by an ill C-er to spread the C-style madness over another languages. AFAIK no language uses this mechanism besides C which kinda alludes.

Ah, so those are the C header files...?! Basically only the descriptors?

On 10/1/2021 at 2:11 PM, Fr0sT.Brutal said:

Yes and it makes source examining a real nighmare. Alas, there's no better option to avoid code duplication.

Tbh I still don't get why splitting Interface and Implementation would help to avoid code duplication. If you have two units where the implementation section is the same, you can use helpers / a class which does the work / not to have two different units but use only the first one.

Take this with a grain of salt, though. I just can not - yet - imagine a scenario where this would be beneficial.