How to create components with a transparent background #74
To do that kind of stuff right, create a new control derived for example from TGroupbox, and override its CreateParams method like this:
protected {in control declaration} procedure CreateParams(var params: TCreateParams); override; procedure TTransparentGroupbox.CreateParams(var params: TCreateParams); begin inherited CreateParams(params); params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT; end; {Add a handler for the WM_ERASEBKGND message} procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND; procedure TTransparentGroupbox.WMEraseBkGnd(var msg: TWMEraseBkGnd); begin SetBkMode (msg.DC, TRANSPARENT); msg.result := 1; end;
That is the basic frame for a TWinControl descendent. For a TGraphicsControl you would drop the CreateParams (since only WinControls have that method) and override the create constructor. After calling the inherited constructor you modify the ControlStyle of the control:
ControlStyle := ControlStyle - [csOpaque];
Demo code
A ready made project containing this demo code is available. View the project.
In this demo we'll create a new transparent group box (TGroupBoxEx) and, to demonstrate a transparent TGraphicControls, a new transparent label (TLabelEx). I know that TLabel has a Transparent property, but this is just a proof of concept example!
Start a new Delphi VCL application and create OnPaint and
OnCreate event handlers for the main form. Name the
form "Form1" and save the form unit as
Unit1.pas
.
Now code Unit1 as follows:
unit Unit1; interface uses Forms, Classes, Controls, StdCtrls, Messages; type // Example of a TWinControl derived control TGroupBoxEx = class(TGroupBox) protected procedure CreateParams(var params: TCreateParams); override; procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND; end; // Example of a TGraphicControl derived control TLabelEx = class(TLabel) public constructor Create(AOwner: TComponent); override; end; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure swe3(Sender: TObject); private fGB: TGroupBox; // standard group box fGBX: TGroupBoxEx; // transparent group box fLbl: TLabel; // standard label fLblX: TLabelEx; // transparent label end; var Form1: TForm1; implementation uses Windows, Graphics; {$R *.dfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin // Normal group box fGB := TGroupBox.Create(Self); fGB.Parent := Self; fGB.Caption := 'TGroupBox'; fGB.Top := 20; fGB.Left := 20; // Special group box fGBX := TGroupBoxEx.Create(Self); fGBX.Parent := Self; fGBX.Caption := 'TGroupBoxEx'; fGBX.Top := 20; fGBX.Left := fGB.Left + fGB.Width + 20; // Normal label fLbl := TLabel.Create(Self); fLbl.Parent := Self; fLbl.Caption := 'TLabel'; fLbl.Top := fGB.Top + fGB.Height + 20; fLbl.Left := fGB.Left; // Special label fLblX := TLabelEx.Create(Self); fLblX.Parent := Self; fLblX.Caption := 'TLabelEx'; fLblX.Top := fGBX.Top + fGBX.Height + 20; fLblX.Left := fGBX.Left; end; // Paint form in yellow / white candy stripes procedure TForm1.swe3(Sender: TObject); var Idx: Integer; begin for Idx := 0 to ClientHeight div 8 do begin if Odd(Idx) then Canvas.Brush.Color := clWhite else Canvas.Brush.Color := $aaffff; // pale yellow Canvas.FillRect(Rect(0, Idx * 8, ClientWidth, Idx * 8 + 8)); end; end; { TGroupBoxEx: implemented per tip #87 for TWinControls } procedure TGroupBoxEx.CreateParams(var params: TCreateParams); begin inherited; params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT; end; procedure TGroupBoxEx.WMEraseBkGnd(var msg: TWMEraseBkGnd); begin SetBkMode (msg.DC, TRANSPARENT); msg.result := 1; end; { TLabelEx: implemented per tip #87 for TGraphicControls } constructor TLabelEx.Create(AOwner: TComponent); begin inherited; ControlStyle := ControlStyle - [csOpaque]; end; end.
We've painted a candy stripe background on the form to help demonstrate transparency. You'll see the normal label and group box use the form's default colour as a background, while the new components are truly transparent (except for the label of the group box) and the candy stripes show through.
Demo by Peter Johnson
Transparency actually works better for TGraphicControls than for TWinControls. The latter have problems if the control is moved or the background needs to change. Delphi container controls (like form or panel) are always created with the WS_CLIPCHILDREN style, which automatically excludes the area under child controls from updates, so the background will not be updated if required. Removing the WS_CLIPCHILDREN style from a controls parent is possible with:
SetWindowLong( parent.handle, GWL_STYLE, GetWIndowLong(parent.handle, GWL_STYLE) and not WS_CLIPCHILDREN );
But that may lead to excessive flicker on screen updates.
Original resource: | The Delphi Pool |
---|---|
Author: | Unknown |
Added: | 2009/08/12 |
Last updated: | 2010/03/16 |