Articles   Members Online: 3
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a transparent TPanel Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
26-Aug-02
Category
VCL-General
Language
Delphi 2.x
Views
124
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

How to create a transparent TPanel

Answer:

Solve 1:

Particularly note the SetParent bit. It works even with movement. It should even 
work in Delphi 1, as it doesn't use the Win32 non-rectangular-window method for 
creating transparency. The code is simple so can be easily retro-fitted to any 
control that you wished were transparent. I put this together in ten minutes, so it 
needs proper testing to make sure it doesn't cause any problems, but here it is. 
Create one on a form, and drag it about over some edits, combo boxes etc. (and 
TImages and you'll get major flicker).

1   type
2     TTransparentPanel = class(TPanel)
3     private
4       procedure SetParent(AParent: TWinControl); override;
5       procedure WMEraseBkGnd(var message: TWMEraseBkGnd); message WM_EraseBkGnd;
6     protected
7       procedure CreateParams(var Params: TCreateParams); override;
8       procedure Paint; override;
9     public
10      constructor Create(AOwner: TComponent); override;
11      procedure Invalidate; override;
12    end;
13  
14  constructor TTransparentPanel.Create(AOwner: TComponent);
15  begin
16    inherited Create(AOwner);
17    ControlStyle := ControlStyle - [csOpaque];
18  end;
19  
20  procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
21  begin
22    inherited CreateParams(Params);
23    Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
24  end;
25  
26  procedure TTransparentPanel.Paint;
27  begin
28    Canvas.Brush.Style := bsClear;
29    Canvas.Rectangle(0, 0, Width, Height);
30    Canvas.TextOut(Width div 2, Height div 2, 'Transparent');
31  end;
32  
33  procedure TTransparentPanel.WMEraseBkGnd(var message: TWMEraseBkGnd);
34  begin
35    {Do Nothing}
36    message.Result := 1;
37  end;
38  
39  procedure TTransparentPanel.SetParent(AParent: TWinControl);
40  begin
41    inherited SetParent(AParent);
42    {The trick needed to make it all work! I don't know if changing the parent's 
43  	style is a good idea, but it only removes the WS_CLIPCHILDREN style which 
44  shouldn't    cause any problems.}
45    if Parent <> nil then
46      SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong
47        (Parent.Handle, GWL_STYLE) and not WS_ClipChildren);
48  end;
49  
50  procedure TTransparentPanel.Invalidate;
51  var
52    Rect: TRect;
53  begin
54    Rect := BoundsRect;
55    if (Parent <> nil) and Parent.HandleAllocated then
56      InvalidateRect(Parent.Handle, @Rect, True)
57    else
58      inherited Invalidate;
59  end;



Solve 2:

60  unit TransparentPanel;
61  
62  interface
63  
64  uses
65    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
66  ExtCtrls;
67  
68  type
69    TTransparentPanel = class(TPanel)
70    private
71      { Private declarations }
72      FBackground: TBitmap;
73      procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
74    protected
75      { Protected declarations }
76      procedure CaptureBackground;
77      procedure Paint; override;
78    public
79      { Public declarations }
80      procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
81      property Canvas;
82      constructor Create(aOwner: TComponent); override;
83      destructor Destroy; override;
84    published
85      { Published declarations }
86    end;
87  
88  procedure register;
89  
90  implementation
91  
92  procedure register;
93  begin
94    RegisterComponents('PBGoodies', [TTransparentPanel]);
95  end;
96  
97  procedure TTransparentPanel.CaptureBackground;
98  var
99    canvas: TCanvas;
100   dc: HDC;
101   sourcerect: TRect;
102 begin
103   FBackground := TBitmap.Create;
104   with Fbackground do
105   begin
106     width := clientwidth;
107     height := clientheight;
108   end;
109   sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);
110   sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);
111   dc := CreateDC('DISPLAY', nil, nil, nil);
112   try
113     canvas := TCanvas.Create;
114     try
115       canvas.handle := dc;
116       Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);
117     finally
118       canvas.handle := 0;
119       canvas.free;
120     end;
121   finally
122     DeleteDC(dc);
123   end;
124 end;
125 
126 constructor TTransparentPanel.Create(aOwner: TComponent);
127 begin
128   inherited;
129   ControlStyle := controlStyle - [csSetCaption];
130 end;
131 
132 destructor TTransparentPanel.Destroy;
133 begin
134   FBackground.free;
135   inherited;
136 end;
137 
138 procedure TTransparentPanel.Paint;
139 begin
140   if csDesigning in ComponentState then
141     inherited
142       {would need to draw frame and optional caption here do not call
143     inherited, the control fills its client area if you do}
144 end;
145 
146 procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
147 begin
148   if Visible and HandleAllocated and not (csDesigning in ComponentState) then
149   begin
150     Fbackground.Free;
151     Fbackground := nil;
152     Hide;
153     inherited;
154     Parent.Update;
155     Show;
156   end
157   else
158     inherited;
159 end;
160 
161 procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);
162 var
163   canvas: TCanvas;
164 begin
165   if csDesigning in ComponentState then
166     inherited
167   else
168   begin
169     if not Assigned(FBackground) then
170       Capturebackground;
171     canvas := TCanvas.create;
172     try
173       canvas.handle := msg.DC;
174       canvas.draw(0, 0, FBackground);
175     finally
176       canvas.handle := 0;
177       canvas.free;
178     end;
179     msg.result := 1;
180   end;
181 end;
182 
183 end.



Solve 3:

This panel will be transparent only at runtime.

184 { ... }
185 type
186   TMyPopUpTransPanel = class(TPanel)
187   protected
188     procedure CMHitTest(var message: TCMHitTest); message CM_HITTEST;
189     procedure WndProc(var message: TMessage); override;
190     procedure CreateParams(var Params: TCreateParams); override;
191     procedure Paint; override;
192   end;
193   { ... }
194 
195 procedure TMyPopUpTransPanel.CMHitTest(var message: TCMHitTest);
196 begin
197   message.Result := Windows.HTNOWHERE;
198 end;
199 
200 procedure TMyPopUpTransPanel.WndProc(var message: TMessage);
201 var
202   XControl: TControl;
203   XPos: TPoint;
204 begin
205   if not (csDesigning in ComponentState) and ((message.Msg >= WM_MOUSEFIRST)
206     and (message.Msg <= WM_MOUSELAST)) then
207   begin
208     XPos := ClientToScreen(POINT(TWMMouse(message).XPos, TWMMouse(message).YPos));
209     XControl := Parent.ControlAtPos(POINT(TWMMouse(message).XPos +
210       Left, TWMMouse(message).YPos + Top), true, true);
211     if Assigned(XControl) and (XControl is TWinControl) then
212     begin
213       XPos := TWinControl(XControl).ScreenToClient(XPos);
214       TWMMouse(message).XPos := XPos.X;
215       TWMMouse(message).YPos := XPos.Y;
216       PostMessage(TWinControl(XControl).Handle, message.Msg,
217 			 message.WParam, message.LParam);
218     end
219     else
220     begin
221       XPos := Parent.ScreenToClient(XPos);
222       TWMMouse(message).XPos := XPos.X;
223       TWMMouse(message).YPos := XPos.Y;
224       PostMessage(Parent.Handle, message.Msg, message.WParam, message.LParam);
225     end;
226     message.Result := 0;
227   end
228   else
229     inherited WndProc(message);
230 end;
231 
232 procedure TMyPopUpTransPanel.CreateParams(var Params: TCreateParams);
233 begin
234   inherited CreateParams(Params);
235   if not (csDesigning in ComponentState) then
236     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
237 end;
238 
239 procedure TMyPopUpTransPanel.Paint;
240 var
241   XBitMap: TBitMap;
242   XOldDC: HDC;
243   XRect: TRect;
244 begin
245   if (csDesigning in ComponentState) then
246     inherited Paint
247   else
248   begin
249     XRect := ClientRect;
250     XOldDC := Canvas.Handle;
251     XBitMap := TBitMap.Create;
252     try
253       XBitMap.Height := Height;
254       XBitMap.Width := Width;
255       Canvas.Handle := XBitMap.Canvas.Handle;
256       inherited Paint;
257       RedrawWindow(Parent.Handle, @XRect, 0, RDW_ERASE or RDW_INVALIDATE or
258         RDW_NOCHILDREN or RDW_UPDATENOW);
259     finally
260       Canvas.Handle := XOldDC;
261       Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
262       XBitMap.Free;
263     end;
264   end;
265 end;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC