BGRA Opaque Panel example, teach me please
lazarus / 39-Graphics

----------------------------------------------------------------------
KodeZwerg · 2024-02-10 09:28

Good day!

After a message from Lainz about that there is a darkmode for BGRA
controls I did update my Lazarus installation with the dev variants of
both packages (BGRA Bitmap and Controls)
All works wonderful, while I tested out the different panels I found a
gradient drawing TBCPanel. That looks pretty interesting!
Now I did try, without luck, to put another panel over it that has no
colors (clNone) to achieve the effect of a full opaque window control
where I could align labels or other controls in it but the grandient
of the background panel is full visible.

I did try this with several different panels but I can't make it work.

Can you teach me how to achieve it please?

Attached is a demo project (no code, just visual properties) where I
would learn from about how to use the properties correct to have a
full opaque window control.

----------------------------------------------------------------------
lainz · 2024-02-10 13:07

I can imagine you can use TBGRAVirtualScreen and OnRedraw event draw
the gradient background of the TBCPanel.
Like drawing the background rect in the virtual screen. A virtual
screen is a panel.

----------------------------------------------------------------------
KodeZwerg · 2024-02-10 13:58

Quote from: lainz on February 10, 2024, 02:07:04 pmI can imagine you
can use TBGRAVirtualScreen and OnRedraw event draw the gradient
background of the TBCPanel.
Like drawing the background rect in the virtual screen. A virtual
screen is a panel.I will look into that Virtual Screen, thank you for
the hint!

Meanwhile I am stuck on a different problem, actually its 2 problems.
I do show what I've done to get what I needed and by accident found
something interesting for your demo that uses desktop wallpaper and
blur it to have a fake glass effect.
That way the blur should be faster since the images are small.
The problem is that is uses wrong coordinate and it sadly does not
autoupdate itself with my current way of doing :-/
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
uMain; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,  BCPanel,
BGRACustomDrawn, BCLabel, LCLIntf, LCLType, LMessages; type   {
TBCDPanel }   TBCDPanel = class(BGRACustomDrawn.TBCDPanel)    strict
private      FBackgroundBitmap: TBitmap;      FCustomPaint: Boolean; 
   FUseDesktop: Boolean;      FOnMove: TNotifyEvent;      procedure
SetCustomPaint(AValue: Boolean);    protected      procedure Resize;
override;      procedure Loaded; override;      procedure Paint;
override;      procedure WndProc(var Message: TLMessage); override;  
private      procedure MoveHandler(Sender: TObject);    public     
procedure UpdateBackgroundBitmap;    public      constructor
Create(AOwner: TComponent); override;      destructor Destroy;
override;    published      property OnMove: TNotifyEvent read FOnMove
write FOnMove;      property UseDesktop: Boolean read FUseDesktop
write FUseDesktop default True;      property CustomPaint: Boolean
read FCustomPaint write SetCustomPaint default False;  end; type   {
TForm1 }   TForm1 = class(TForm)    BCDPanel1: TBCDPanel;   
BCDPanel2: TBCDPanel;    BCDPanel3: TBCDPanel;    Label1: TLabel;   
Label2: TLabel;    Label3: TLabel;    Label4: TLabel;    Label5:
TLabel;    Label6: TLabel;    Panel1: TPanel;    pnlMain: TBCPanel; 
protected    procedure WndProc(var Message: TLMessage); override; 
private    procedure UpdatePanelBackground;  private   public  
end; var  Form1: TForm1; implementation {$R *.lfm} { TBCDPanel
} procedure TBCDPanel.SetCustomPaint(AValue: Boolean);begin  if
FCustomPaint = AValue then    Exit;  FCustomPaint := AValue;  if
FCustomPaint then    UpdateBackgroundBitmap; // Update the background
bitmap when the control is loadedend; procedure
TBCDPanel.Resize;begin  inherited Resize;  if FCustomPaint then   
UpdateBackgroundBitmap; // Update the background bitmap when the
control is loadedend; procedure TBCDPanel.Loaded;begin  inherited
Loaded;  if FCustomPaint then    UpdateBackgroundBitmap; // Update the
background bitmap when the control is resizedend; procedure
TBCDPanel.Paint;begin//  inherited Paint;//  Self.Canvas.Brush.Color
:= clOlive;//  Self.Canvas.Brush.Style := bsSolid;//
 Self.Canvas.FillRect(Self.ClientRect);  if FCustomPaint then   
Self.Canvas.Draw(0,  0, FBackgroundBitmap)  else    inherited
Paint;end; procedure TBCDPanel.WndProc(var Message: TLMessage);begin 
case Message.Msg of    LM_SIZE:      begin       
UpdateBackgroundBitmap;      end;    LM_MOVE:      begin       
UpdateBackgroundBitmap;      end;    else      inherited
WndProc(Message);  end;end; procedure
TBCDPanel.UpdateBackgroundBitmap;var  ScreenDC, MemDC: HDC; 
OldBitmap: HBITMAP;  PointOnScreen: TPoint;begin  if FUseDesktop then 
  ScreenDC := GetDC(0)  else    ScreenDC := GetDC(Parent.Handle);  if
ScreenDC <>  0 then  begin    try      PointOnScreen :=
Self.ClientToScreen(Point(Self.Left + Parent.Left,  Self.Top +
Parent.Top));//      PointOnScreen :=
Self.ScreenToClient(Point(Self.Left + Parent.Left,  Self.Top +
Parent.Top));//      PointOnScreen :=
Self.ClientToScreen(Point(Self.Left,  Self.Top));//      PointOnScreen
:= Self.ScreenToClient(Point(Self.Left,  Self.Top));     
FBackgroundBitmap.SetSize(Self.Width, Self.Height);      MemDC :=
CreateCompatibleDC(ScreenDC);      if MemDC <>  0 then      begin    
  try          OldBitmap := SelectObject(MemDC,
FBackgroundBitmap.Handle);          BitBlt(MemDC,  0,  0, Self.Width,
Self.Height, ScreenDC, PointOnScreen.X, PointOnScreen.Y, SRCCOPY);   
     SelectObject(MemDC, OldBitmap);        finally         
DeleteDC(MemDC);        end;      end;    finally      if FUseDesktop
then        ReleaseDC(0, ScreenDC)      else       
ReleaseDC(Parent.Handle, ScreenDC);    end;  end; 
Self.Invalidate;end; procedure TBCDPanel.MoveHandler(Sender:
TObject);begin  if FCustomPaint then   
UpdateBackgroundBitmap;end; constructor TBCDPanel.Create(AOwner:
TComponent);begin  inherited Create(AOwner);  FUseDesktop := True; 
FCustomPaint := True;  FBackgroundBitmap := TBitmap.Create; 
Self.DoubleBuffered := False;  Self.ParentBackground := False; 
Self.Color := clNone;  Self.Visible := True;  Self.OnMove :=
@MoveHandler;end; destructor TBCDPanel.Destroy;begin 
FBackgroundBitmap.Free;  inherited Destroy;end; { TForm1 } procedure
TForm1.WndProc(var Message: TLMessage);begin  case Message.Msg of   
LM_SIZE:      begin        UpdatePanelBackground;      end;   
LM_MOVE:      begin        UpdatePanelBackground;      end;    else  
  inherited WndProc(Message);  end;end; procedure
TForm1.UpdatePanelBackground;var  i: Integer;begin  for i := 0 to
Pred(Self.ControlCount) do    begin      if Self.Controls[i] is
TBCDPanel then        (Self.Controls[i] as
TBCDPanel).UpdateBackgroundBitmap;    end;end; end.

----------------------------------------------------------------------
KodeZwerg · 2024-02-10 16:59

I have made a big progress in belonging if i want to have the content
of whats behind our form window to use in inside panel as background
is working very reliable now.
Now I wanted to make the same than Lainz did to blurr an Image but the
result is wrong so I use it wrong I assume
Can you please look over and help me fixing this issue?
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TBCDPanel.UpdateBackgroundBitmap;  function
FindTopLevelParent(Control: TControl): TControl;  begin    if
Assigned(Control.Parent) then      Result :=
FindTopLevelParent(Control.Parent)    else      Result := Control; 
end;const  BLURSIZE = 5;  ALPHAVALUE = 10;var  ScreenDC, MemDC: HDC; 
OldBitmap: HBITMAP;  PointOnScreen: TPoint;  CurrentControl:
TControl;  blurred: TBGRABitmap;begin  if not FCustomPaint then   
Exit;  ScreenDC := GetDC(0);  try   
FBackgroundBitmap.SetSize(Self.Width, Self.Height);    MemDC :=
CreateCompatibleDC(ScreenDC);    try      OldBitmap :=
SelectObject(MemDC, FBackgroundBitmap.Handle);       if FUseDesktop
then        CurrentControl := FindTopLevelParent(Self)      else     
 CurrentControl := Self;      PointOnScreen :=
CurrentControl.ClientOrigin;      if FUseDesktop then        begin   
     PointOnScreen.X := PointOnScreen.X - (CurrentControl.Left -
Self.Left);          PointOnScreen.Y := PointOnScreen.Y -
(CurrentControl.Top - Self.Top);        end      else        begin   
     PointOnScreen.X := PointOnScreen.X - (CurrentControl.Left);     
   PointOnScreen.Y := PointOnScreen.Y - (CurrentControl.Top);       
end;      BitBlt(MemDC,   0,   0, Self.Width, Self.Height, ScreenDC,
PointOnScreen.X, PointOnScreen.Y, SRCCOPY);       SelectObject(MemDC,
OldBitmap);    finally      DeleteDC(MemDC);    end;  finally   
ReleaseDC(0, ScreenDC);  end;  if FUseDesktop then  begin    blurred
:= TBGRABitmap.Create;    try      blurred.Assign(FBackgroundBitmap); 
    BGRAReplace(blurred, blurred.FilterBlurRadial(BLURSIZE, BLURSIZE,
rbBox));      blurred.Rectangle(0, 0, blurred.Width, blurred.Height, 
     BGRA(255, 255, 255, ALPHAVALUE), BGRA(255, 255, 255, ALPHAVALUE),
dmDrawWithTransparency);      blurred.PutImage(-Left, -Top, blurred,
dmSet);      blurred.Rectangle(0, 0, blurred.Width + 1,
blurred.Height, BGRABlack, dmSet);//    
 blurred.AssignToBitmap(FBackgroundBitmap);    finally     
blurred.Free;    end;  end;   Self.Invalidate;end;
/edit
To show current results I've added an image to show that the
background is used now at correct location
What is badly needed is a fix that it redo this method when the form
moves and a fix to the blurr

----------------------------------------------------------------------
lainz · 2024-02-10 23:33

Can you attach a compilable program, I don't want to make all the UI
despite is just panels and labels.

----------------------------------------------------------------------
KodeZwerg · 2024-02-11 09:30

Quote from: lainz on February 11, 2024, 12:33:05 amCan you attach a
compilable program, I don't want to make all the UI despite is just
panels and labels.
Of course I can and did :-D

This is the latest full of bugs of all kind version that at least
show, even when broken, that a background image is created and shown.
My 3 options that I included with checkboxes are doing no difference
for still unknown reason but present to let you know that this is how
I am needing it to tweak the original TBCDPanel component.
Maybe adding option to tweak interval for update process, I was
thinking if its blurr choosen than once per second do update is
enough.

----------------------------------------------------------------------
KodeZwerg · 2024-02-11 12:28

I would really appreciate if BGRA Controls would add an BGRA optimized
Opaque Panel visual control into its palette 

My needings and current way of doing, in a work in progress manner:
- choose between 2 opaque modes, from point of whats behind form =
UseDesktop, from point of whats behind the control = not UseDesktop
:-D
- an generic option to turn opaque mode on/off = CustomPaint (should
rename this to OpaqueEnabled...)
- depending on UseDesktop, either cut out of form the region of the
panel to make a screenshot of whats begin control
    or cutout the full form of view to know whats behind the form,
very alpha state :-/
- give back screenshot as backgroundimage to panel, optional blurr it
- make it update itself, works but very alpha, should probably check
if there is a difference between new image and current displayed to
reduce flickering
- convert all to a BGRA Bitmap version without need of other units so
its multicrossplatform and hopeful faster

//edit
future plans, let me dream:
- make it a custom control instead of intercepting
- extend current blurr effect by switching to a simplified glass
effect
  - make glass effect by "draw alphablended color over screenshot"
without adding fancy glass highlights (could become possible in many
many future versions )
  - take screen shot, add overlay of glasscolor if <> clNone
  - add blurr effect setting for "how strong you can see thru glass"
0..100
  - add opacity property to choose between 0 and 100 how much
alphablended (transparency to background of control) the background
should become
  - optimize it for better handling

----------------------------------------------------------------------
lainz · 2024-02-11 14:39

Attached a screenshot of my latest demo in bgracontrols, please test.

----------------------------------------------------------------------
lainz · 2024-02-11 17:26

- Added Shadow
- Added noise for the blur
- Working on High DPI

ToDo:
- fix bgravirtualscreen bug that doesn't redraw if size don't change

----------------------------------------------------------------------
KodeZwerg · 2024-02-11 19:13

Quote from: lainz on February 11, 2024, 03:39:27 pmAttached a
screenshot of my latest demo in bgracontrols, please test.I am unsure
how to test, cant find your attachment, but its looking cool! Especial
the last one with fluent ui optics <3

----------------------------------------------------------------------
lainz · 2024-02-11 19:29

Quote from: KodeZwerg on February 11, 2024, 08:13:22 pmQuote from:
lainz on February 11, 2024, 03:39:27 pmAttached a screenshot of my
latest demo in bgracontrols, please test.I am unsure how to test, cant
find your attachment, but its looking cool! Especial the last one with
fluent ui optics <3

Hi, thanks.

It's here:
https://github.com/bgrabitmap/bgracontrols/tree/dev-
bgracontrols/test/test_bgravirtualscreen_blur

----------------------------------------------------------------------
KodeZwerg · 2024-02-11 23:09

Wow, I've downloaded and run demo, it enlightened me so much!
That TBGRAVirtualScreen is really amazing and as you suggested first,
it fit my needs to 100% !

So it is like a full empty void with the advantage of having custom
paint and keep acting as container for more, awesome!
I like to play with it a little since I found some behave I'd like to
upgrade.
I will look into it if I can tweak its usage to generate small
screenshots of the region on screen without the control and integrate
a "see-thru form" opaque modifier.
Plus that it autoupdate interval based, as i see it uses a redraw
method to bring it on screen so that can be called and a current
background image just for the region of the panel (virtualscreen) can
be computed in there

Thank you Lainz for your example, it really help me much on this
voyage!
I will try if I can make a Blurr(inBitmap, outBitmap, Glasscolor,
Glassdensity, Blurrdistortion) or something like that method to
combine each and all of your example and call it on redraw

----------------------------------------------------------------------
lainz · 2024-02-12 01:00

Great. Keep going.

----------------------------------------------------------------------
lainz · 2024-02-17 23:55

Hi. I've fixed the demo with full image. It works fine in Lazarus 3.
The bug was in Lazarus 2 that do not refresh the virtual screen
properly...