aehimself

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

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 🙂

One more thing, this is not really going to work when resizing, as the parent of my dimmed control is the tabsheet (which I need the image of). When I take an image of the tabsheet while the dimmed panel is visible, it's image will be seen on the picture, slowly fading out everything in the process. I need to think think through.

I want to display a progress / warning indicator on a tabsheet which will block all actions to the components on the tabsheet... imagine like the UAC "popup". Everything in the background is dimmed as they are unavailable at the moment, only the important stuff (buttons, labels, etc) are shown with full visibility.

So, the "screenshot" and repaint dimmed works... almost. The bitmap is captured correctly (saved to a file, shows perfectly) but drawing it back causes some issues... I have a TPanel descendant, like... TDimPanel= Class(TPanel) protected Procedure Paint; Override; Procedure Resize; Override; End; Procedure TDimPanel.Resize; Var dc: HWND; Begin inherited; _bitmap.SetSize(0, 0); // Clear the bitmap _bitmap.SetSize(Self.Parent.Width, Self.Parent.Height); // Self.Parent.PaintTo(_bitmap.Canvas.Handle, 0, 0); // Does not capture everything, leaves some components out... dc := GetDC(Self.Parent.Handle); BitBlt(_bitmap.Canvas.Handle, 0, 0, _bitmap.Width, _bitmap.Height, dc, 0, 0, SRCCOPY); _bitmap.SaveToFile('C:\shot.bmp'); End; Procedure TDimPanel.Paint; Begin inherited; Self.Canvas.Draw(0, 0, _bitmap, 128); // Self.Canvas.Ellipse(0, Self.Height - 20, 20, Self.Height); End; But only the upper half of the bitmap is drawn on the panel, bottom half is empty. If ellipse drawing is uncommented, it shows up properly. The funny thing is that if I use Self.Canvas.Draw(0, 0, _bitmap); all is drawn perfectly, but I loose opacity... I guess it will have something to do in how the bitmap is set up...? At the moment I have the following in the constructor: _bitmap := Vcl.Graphics.TBitMap.Create; _bitmap.Transparent := False; _bitmap.PixelFormat := pf32bit; Moving the code out of my project to a TForm and using it's canvas to paint the bitmap to has the same behaviour. Any help is greatly appreciated, these imaging-things are way out of my league.

I was afraid so. I got WinErrors when I tried to do so. While the bitmap screenshot idea will work, it feels really hacky. Makes me a bit more comfortable that others got to the same idea to this problem, though. It's just a little bit strange that "dimming" is this complicated to achieve. Thanks anyway, I'll start with the bitmap idea 🙂

...one small question, though. Is it possible to make the panel transparent, but not the components on it?

NICE!!!! And it even works with VCL Styles. Thank you, @Renate Schaaf!

There is / was a similar thread you can check; maybe it helps? Embarcadero Toaster - Notification Window Caption in Win10 - VCL - Delphi-PRAXiS [en]

You, sir... 🙂

There is no portable version of Delphi available afaik, however I suppose if you copy all necessary files from a PC where you installed Delphi to an other, it might work. But, you have to read the EULA carefully though; I'm not sure if this kind of deployment is allowed. Why installing it is not an option? In my personal opinion a fresh reinstall is always cleaner, guaranteed to work than attempting to "force it to life".

I tried creating a batch file from within the service. It slept 5 seconds (so I can see the process start) called NET STOP, slept 5 seconds (giving time for the service to stop) and NET START. When I called this batch from within the service I remember seeing the process starting and ending when the service terminated. This is why I never used this method. As it works for others I am sure I did something wrong; unfortunately I don't have the code snipplet to debug now. @Lars Fosdal this looks promising, I'll make a dummy service app to test it 🙂

I had this when I had a bug (memory corruption to be exact) in my logging mechanism. The program tried to log it's issue but crashed beforehand. Also, if you use 32 bit processes and your log file grows above 2 GB that can cause your executable to halt.

Well, I have 2 ideas. 1 - use the HTTP status codes. 200 means all fine, it was inserted. 500 means an error happened, transaction was rolled back, resend is needed from the client. If you can not control the status codes, you can add a "status check API". After a 200 OK for inserting the record, the client can query the inserted IDs for verification. If I understand the question completely, that is. But, I never really worked with stuff like this so take this with a grain of salt. I always liked to control everything, so when it was needed I launched my own webserver via ICS. That way I could set return codes, headers, session cookies, and even send detailed answers in any format whenever I wanted to.

Thank you all for the replies guys but I don't want to hijack OP's topic. The methods here seem to be "hacky" (to crash the service and let Windows to restart it - it's a tricky approach I have to admit, though!) or already tried (creating a batch file to sleep for 5 seconds, and issue the NET TOP/START commands. Issue is, as parent program stops, it stops the child processes and therefore the batch file execution too). I was curious if there is a trick to restart a service from within the service itself without the need of a loader, maintenance service - an other executable in general. As it is not that important for me at the moment I'll just keep my eyes open to see if such method was unearthed already.

It's not related to the topic, but may I ask how you implemented the update mechanism? Without a "loader" (e.g. actual code is in a DLL, service only loads and executes the DLL,) I never managed to achieve this. I never figured out how to restart the service from within the service.

Just two notices. If you will ever use Oracle and RetIDList will contain more than 1000 elements, the code will fail. I don't know if any other RDBMS has this limitation though. How trusted is the file? Taking a string value from somewhere and putting it in a SQL command exposes your application to injection attacks.