aehimself

program Project2; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; Const MAX_NUMBER = 1000; CYCLECOUNT = Integer.MaxValue; Var numbers: Array[0.. MAX_NUMBER - 1] Of Integer; a, min, max: Integer; begin Randomize; For a := Low(numbers) to High(numbers) Do numbers[a] := 0; For a := 1 To CYCLECOUNT Do Inc(numbers[Random(MAX_NUMBER)]); min := CYCLECOUNT; max := 0; For a := Low(numbers) To High(numbers) Do Begin If numbers[a] < min Then min := numbers[a] Else If numbers[a] > max Then max := numbers[a]; End; WriteLn('After ' + CYCLECOUNT.ToString + ' cycle(s), minimum amount of occurrences of the same number is ' + min.ToString + ', maximum is ' + max.ToString); ReadLn; end. After 2147483647 cycle(s), minimum amount of occurrences of the same number is 2144157, maximum is 2150811 That means, the luckiest random number was hit 6654 times more than the least lucky one (from more than 2 billion attempts!). Delphi's internal random number generator has a healthy dispersion. It's not perfect, but it is more than enough for average use.

Both XOrShift and ISAAC has nice Delphi implementations. They are both PRNGs but it you initialize them with the Random function, they will work quite well.

Joke: In today's world you are better suited with a string type.

Is (s)he a freelancer / available? 😄

May I ask which site is giving an overview about licenses like this?

My main home project atm is ~500k LOC if I'm not mistaken. Linking speed won't be an issue I presume. If I'd be able to encrypt and patch the executable with the .MAP file I think it would be possible to disable all hooks and magic of MadExcept and use it only to fill the .StackTrace of exceptions (unit can be seen here). That'd be an acceptable solution too.

Also, you can define if LOBs should be cached on load or on access - where supported of course 🙂

You don't have to. I just brought a minimum reproduceable code snipplet to show what built-in language feature is not supported by MadExcept.

Which response you mean? To create a bug report and parse it's text from code?

http://forum.madshi.net/viewtopic.php?f=4&amp;t=28723 I have the same symptoms. This simple code: procedure TForm1.FormCreate(Sender: TObject); Function RecExDump(E:Exception): String; Begin If Not Assigned(E) Then Exit(''); Result := E.ClassName + ' - ' + E.Message + sLineBreak + E.StackTrace + sLineBreak + sLineBreak + RecExDump(E.InnerException); End; begin Try Try Raise Exception.Create('Original'); Except Exception.RaiseOuterException(EListError.Create('Outer')); End; Except On E:Exception Do ShowMessage(RecExDump(E)); End; End; Shows both exceptions without MadExcept enabled and with EurekaLog. If MadExcept is enabled, EecExDump only sees the outer exception,

I never said it was the fault of Application.ProcessMessages; it was mine for using it 🙂 Tbh I don't see a difference between running in a cycle of While thread.Terminated Do and dataset.Next millions of iterations. It just depends how much data you have. Sleep was originally uncommented, I think I could go down to 5 ms sleep before starting to eat up the CPU. But since I took a deep breath and started to get rid of this - I don't want to experiment to try to patch-the-patch to make it look better. This time I want to do it right 🙂

This is the exact thing I experienced. I took the shortcut when I converted my app to use background threads for operations. Instead of Connection.Connect; DoSomeStuff; I started a thread and did... StartConnectionInBackgroundThread; While Not thread.Finished Do Begin // Sleep(10); Application.ProcessMessages; End; DoSomeStuff; All was fine until only one code like this ran. In the moment two tried to connect simultaneously (not mentioning a couple of occasional deadlocks) connections took 5-10 times more than they normally would, if they connect by themselves. Also, UI was responsive, but sluggish. For 20+ builds now I'm in the process to get rid of this shortcut I thought was a good idea before. And while it did what I wanted to achieve on the surface - it did backfire on the long run. For 2+ weeks I'm making changes what the end user might not even realize, and these changes affect 20-30 source files per piece. I completely agree with @Dalija Prasnikar and some others on this matter - I wish I didn't know Application.ProcessMessages exists in the first place 🙂

I think that whenever you change the datasource / dataset on the DBGrid it reinitializes everything, including the column captions you set in design time. To change the column caption, you can change the field's DisplayLabel property: dataset.FieldByName('FNAME').DisplayLabel := 'Medlemsnr'; This will cause the DBGrid to display that as a caption automatically when it creates the column. You'll still have to manually change the caption to bold every time, that is.

On a memo it indeed has the rectangle. I guess it'll have to do with TLabel being a TGraphicControl instead of a TWinControl. I don't know how to fix it but I can offer an alternative. I have similar loading indicators but just dropping it in front of everything will not catch the user's attention immediately. You can try to put it on a DimPanel, that way the background "issue" will disappear too:

Isn't the background is transparent...? It seems to me that is is:

Hello, I am trying to "dim" a whole tabsheet so a notification can be clearly shown - blocking the sheet itself, but not blocking the main form. I guess I'd need an alpha blended panel or a semi-transparent bitmap drawn on a TImage... never really worked with imaging until now so I'm not sure about the terms. Other than the standard components I have Graphics32 installed; can this be achieved with a custom TPanel descendant or with Graphics32 somehow? I would like not to install any 3rd party component just for this if not needed. Worst case scenario I'll capture the tabsheet as a bitmap and draw it on a alClient panel with Canvas.Draw - which supports opacity. Using Delphi 10.4.2 if it matters.

To be completely honest I did not try to install it in the IDE as I prefer to create most of my custom components runtime (in my local unit the Register procedure does not exist at all because of this). The constructor can be the standard, just throw an AV if the specified owner is not a TWinControl. What else is problematic?

Unfortunately I cannot go back to delete the previous unit implementations so they have to stay. Anyway I added enabling/disabling parent controls AND the register procedure. Thank you all who helped to make this happen! 🙂 Unit uDimPanel; Interface Uses Vcl.ExtCtrls, Vcl.Graphics, Vcl.Controls, System.Generics.Collections; Type TDimPanel = Class(TPanel) strict private _bitmap: TBitMap; _enabledcontrols: TList<TControl>; Procedure DisableParentControls; Procedure EnableParentControls; Procedure UpdateBitmap; strict protected Procedure InternalThemeChanged(Const inSystemTheme: Boolean); Virtual; protected Procedure Paint; Override; Procedure Resize; Override; Procedure VisibleChanging; Override; public Constructor Create(inOwner: TWinControl); ReIntroduce; Virtual; Destructor Destroy; Override; Procedure ThemeChanged(Const inSystemTheme: Boolean); End; Procedure Register; Implementation Uses System.SysUtils, System.Classes, WinApi.Windows; Procedure Register; Begin RegisterComponents('Additional', [TDimPanel]); End; //Procedure TDimPanel.SetTransparent(Const inWinControl: TWinControl; Const inTransparent: Boolean); //Var // exStyle: DWORD; //Begin // exStyle := GetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE); // If exStyle = 0 Then RaiseLastOSError; // // If inTransparent Then // Begin // exStyle := exStyle Or WS_EX_LAYERED; // If SetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE, exStyle) = 0 Then // RaiseLastOSError; // If Not SetLayeredWindowAttributes(inWinControl.Handle, 0, 127, LWA_ALPHA) Then // RaiseLastOSError; // End // Else // Begin // exStyle := exStyle XOr WS_EX_LAYERED; // SetWindowLong(inWinControl.Handle, GWL_EXSTYLE, exStyle); // End; //End; Constructor TDimPanel.Create(inOwner: TWinControl); Begin inherited Create(nil); // Change to inOwner if you don't want to free it up by yourself... _bitmap := Vcl.Graphics.TBitMap.Create; // Drawing with opacity might alphablend seemingly random parts with // pfDevice (default) or pf32bit. Enforce a 24 bit pixel format to ensure // what is on the owner is what gets painted. _bitmap.PixelFormat := pf24bit; _enabledcontrols := TList<TControl>.Create; Self.Visible := False; Self.DoubleBuffered := True; Self.Parent := inOwner; Self.ParentBackground := False; // Might cause flicker if true, plus we are custom drawing Self.Left := 0; Self.Top := 0; Self.Width := Self.Parent.ClientWidth; Self.Height := Self.Parent.ClientHeight; Self.Anchors := [akLeft, akTop, akRight, akBottom]; Self.BevelOuter := bvNone; End; Destructor TDimPanel.Destroy; Begin FreeAndNil(_bitmap); FreeAndNil(_enabledcontrols); inherited; End; Procedure TDimPanel.DisableParentControls; Var a: Integer; Begin // Should be empty every time, but to be sure... _enabledcontrols.Clear; For a := 0 To Self.Parent.ControlCount - 1 Do If (Self.Parent.Controls[a] <> Self) And Self.Parent.Controls[a].Enabled Then Begin _enabledcontrols.Add(Self.Parent.Controls[a]); Self.Parent.Controls[a].Enabled := False; End; End; Procedure TDimPanel.EnableParentControls; Var control: TControl; Begin Try For control In _enabledcontrols Do control.Enabled := True; Finally _enabledcontrols.Clear; End; End; Procedure TDimPanel.InternalThemeChanged(Const inSystemTheme: Boolean); Begin // Dummy End; Procedure TDimPanel.Paint; Begin // Omit the call to inherited in general. We only need a black background // and the opaque bitmap we captured earlier. Self.Canvas.Brush.Color := clBlack; Self.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height)); Self.Canvas.Draw(0, 0, _bitmap, 125); End; Procedure TDimPanel.Resize; Begin inherited; If Self.Visible Then Self.UpdateBitmap; End; Procedure TDimPanel.ThemeChanged(Const inSystemTheme: Boolean); Begin Self.InternalThemeChanged(inSystemTheme); End; Procedure TDimPanel.UpdateBitmap; Var dc: HWND; Begin If Self.Visible Then Begin // If the dimpanel is visible, it will be included in the screenshot. So // let's "hide" it... Self.SendToBack; // ...and kindly ask the parent to repaint so new dimensions can be // captured correctly! Self.Parent.Repaint; End; Try _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height); dc := GetDC(Self.Parent.Handle); Try BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY); Finally ReleaseDC(Self.Parent.Handle, dc); End; Finally If Self.Visible Then Self.BringToFront; End; End; Procedure TDimPanel.VisibleChanging; Begin inherited; If Not Self.Visible Then Begin // Force owned controls to resize before showing the panel Self.Resize; // Make sure nothing can be interacted with while parent is dimmed Self.DisableParentControls; // UpdateBitmap is not called if Self.Visible is false... Self.UpdateBitmap; // Neither does BringToFront Self.BringToFront; End Else Begin // Clear bitmap to free up memory _bitmap.SetSize(0, 0); // Re-enable all controls we disabled earlier Self.EnableParentControls; End; End; End.

True that! In my code I have a child inherited from this and I'm calling BringToFront there... but yes, it makes a lot more sense here! Feel free to add the Register procedure 🙂 I like to keep my IDE as clean as possible... too many components might make it sluggist / unstable.

This is the final unit I created and which works as I expected to. Feel free to suggest improvements and use if you see fit! I'm not sure if selecting areas to capture / paint would speed up the process but that is a plausible choke point. Unit uDimPanel; Interface Uses Vcl.ExtCtrls, Vcl.Graphics, Vcl.Controls; Type TDimPanel = Class(TPanel) strict private _bitmap: TBitMap; Procedure UpdateBitmap; protected Procedure Paint; Override; Procedure Resize; Override; Procedure VisibleChanging; Override; public Constructor Create(inOwner: TWinControl); ReIntroduce; Destructor Destroy; Override; End; Implementation Uses System.SysUtils, System.Classes, WinApi.Windows; //Procedure TDimPanel.SetTransparent(Const inWinControl: TWinControl; Const inTransparent: Boolean); //Var // exStyle: DWORD; //Begin // exStyle := GetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE); // If exStyle = 0 Then RaiseLastOSError; // // If inTransparent Then // Begin // exStyle := exStyle Or WS_EX_LAYERED; // If SetWindowLongPtr(inWinControl.Handle, GWL_EXSTYLE, exStyle) = 0 Then // RaiseLastOSError; // If Not SetLayeredWindowAttributes(inWinControl.Handle, 0, 127, LWA_ALPHA) Then // RaiseLastOSError; // End // Else // Begin // exStyle := exStyle XOr WS_EX_LAYERED; // SetWindowLong(inWinControl.Handle, GWL_EXSTYLE, exStyle); // End; //End; Constructor TDimPanel.Create(inOwner: TWinControl); Begin inherited Create(nil); // Change to inOwner if you don't want to free it up by yourself... _bitmap := Vcl.Graphics.TBitMap.Create; // Drawing with opacity might alphablend seemingly random parts with // pfDevice (default) or pf32bit. Enforce a 24 bit pixel format to ensure // what is on the owner is what gets painted. _bitmap.PixelFormat := pf24bit; Self.Visible := False; Self.DoubleBuffered := True; Self.Parent := inOwner; Self.ParentBackground := False; // Might cause flicker if true, plus we are custom drawing Self.Left := 0; Self.Top := 0; Self.Width := Self.Parent.ClientWidth; Self.Height := Self.Parent.ClientHeight; Self.Anchors := [akLeft, akTop, akRight, akBottom]; Self.BevelOuter := bvNone; End; Destructor TDimPanel.Destroy; Begin FreeAndNil(_bitmap); inherited; End; Procedure TDimPanel.Paint; Begin // Omit the call to inherited in general. We only need a black background // and the opaque bitmap we captured earlier. Self.Canvas.Brush.Color := clBlack; Self.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height)); Self.Canvas.Draw(0, 0, _bitmap, 125); End; Procedure TDimPanel.Resize; Begin inherited; If Self.Visible Then Self.UpdateBitmap; End; Procedure TDimPanel.UpdateBitmap; Var dc: HWND; Begin If Self.Visible Then Begin // If the dimpanel is visible, it will be included in the screenshot. So // let's "hide" it... Self.SendToBack; // ...and kindly ask the parent to repaint so new dimensions can be // captured correctly! Self.Parent.Repaint; End; Try _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height); dc := GetDC(Self.Parent.Handle); Try BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY); Finally ReleaseDC(Self.Parent.Handle, dc); End; Finally If Self.Visible Then Self.BringToFront; End; End; Procedure TDimPanel.VisibleChanging; Begin inherited; If Not Self.Visible Then Begin Self.Resize; Self.UpdateBitmap; // UpdateBitmap is not called if Self.Visible is false... End Else _bitmap.SetSize(0, 0); // clear bitmap to free up memory End; End. Edit: I might also want to disable controls on the parent in VisibleChanging to ensure nothing can be focused by pressing tab as @Attila Kovacs suggested earlier.

I never really worked with imaging, I had no idea that there is such a thing as ReleaseDC 🙂 I am relying on errors by ReportMemoryLeaksOnShutdown which missed this. btw, if you meant to change it like this: BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, THackWinControl(Self.Parent).Canvas.Handle, 0, 0, SRCCOPY); It does not work, throws an AV. Canvas seems to be nil?

It works and surely the flicker is neglectable...unless you have VCL Styles active. Then it flickers like madness 🙂 Guess I'll just have to live with it 😄 For anyone interested, this is how the relevant code looks like: TDimPanel = Class(TPanel) strict private _bitmap: TBitMap; protected Procedure Paint; Override; Procedure Resize; Override; Procedure VisibleChanging; Override; End; Procedure TDimPanel.Paint; Begin Self.Canvas.Draw(0, 0, _bitmap, 80); End; Procedure TDimPanel.Resize; Begin inherited; If Self.Visible Then Self.UpdateBitmap; End; Procedure TDimPanel.UpdateBitmap; Var dc: HWND; Begin If Self.Visible Then Begin Self.SendToBack; Self.Parent.Repaint; End; Try _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height); dc := GetDC(Self.Parent.Handle); BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY); Finally If Self.Visible Then Self.BringToFront; End; End; Procedure TDimPanel.VisibleChanging; Begin inherited; If Not Self.Visible Then Begin Self.UpdateBitmap; Self.Repaint; End Else _bitmap.SetSize(0, 0); // clear bitmap to free up memory End; ...just make sure you change _bitmap.PixelFormat to pf24bit in the constructor 🙂

Progress. If I open the saved bitmap with Irfanview and re-save it, drawing it with opacity works. Size drops from 1,9 to 1,4 MB, bit depth drops from 32 to 24 bit. So yes, something is wrong with the bitmap format 🙂 Edit: damn it. Creating the bitmap like _bitmap := Vcl.Graphics.TBitMap.Create; // _bitmap.Transparent := False; _bitmap.PixelFormat := pf24bit; // _bitmap.AlphaFormat := afDefined; repainting with opacity works like a charm. It does not work with pfDevice or pf32bit. Time to put my components back on it 🙂

That is exactly what I am trying to achieve now. The problem I'm getting is why the TPanel's Self.Canvas.Draw(0, 0, _bitmap); works while Self.Canvas.Draw(0, 0, _bitmap, 128); draws only the top half of the panel... see Good point, thank you! Did not think about this!

I don't see why it is that important, but let's say you have a connection to a server on each tab. It can be a web page, RDP, or simply some data aware controls. Once the connection is broken, the tabsheed would go dimmed, with a clear message "Reconnecting" (and an abort button) would be shown. This is just one example. Or let's say each tab allows you to manipulate data like... financial records. One tab = one person. There is a button which calculates some averages but since it takes so long, it is being done in a background thread. Until the thread is running no data must be modified as it can cause incorrect results. So, the tab sheet goes dimmed, with a marquee progress bar and a "Please wait" text. Or, you have a chat application, like IRC. One tab = one channel. If you are kicked from a channel, the tab goes dimmed, saying "You have been kicked from the channel" and a button to close the tabsheet. The things dimmed are not important at that stage because they can not be used; let them be a MsTSCAX control, TWebBrowser, TDBEdit or just a TButton - this is "everything". Important stuff means everything that the tab wants you to know at this point, a message maybe with some controls to interact with. Hope this helps to clear the desired outcome 🙂