Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Transparent WinControls?

483 views
Skip to first unread message

Wayne Conway

unread,
Jul 21, 1998, 3:00:00 AM7/21/98
to
I'm trying to make a transparent TWinControl (TCustomControl
Actually). Essentially, I want something that acts like a Panel, but is
transparent. Then I intend on basing a few useful controls off of it.
All attempts have failed so far. Obviously, I've tried the simple
controlstyle:=controlstyle-[csOpaque]...which had little to no effect.
I've set the WS_TRANSPARENT property in CreateParams....and I've tried
fooling around with a few windows messages and how things paint (ie
WM_ERASEBKGND and WM_POSCHANGING and a few others I can't think of off
the top of my head).....I've got close.....but still too many bugs to
consider it workable. Has anybody ever done this or know how? I
thought to myself that maybe the TStaticText component in Delphi 3.0
would shed some light on it......but of cource....TStaticText has no
transparent property! :)

Anyhow, thanks in advance,

Wayne Conway.

Jochen

unread,
Jul 21, 1998, 3:00:00 AM7/21/98
to
P.S. I tested this panel Delphi 2 and it worked


Jochen

unread,
Jul 21, 1998, 3:00:00 AM7/21/98
to
Hello Wayne,

At the end I added a Transparent panel component
Hopefully this will help

Wayne Conway wrote:

unit TranPanel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
TTransparentPanel = class(TPanel)
private
{ Private-Deklarationen }
FTransparent : Boolean;
procedure SetTransparent(Value : Boolean);
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Transparent : Boolean read FTransparent write SetTransparent
default false;
end;

procedure Register;

Type
TTranPanel = Class(TPanel)
Private
FTransparent : Boolean;
FNoPaint : Boolean;
procedure SetNoPaint(Value : Boolean);
procedure SetTransparent(Value : Boolean);
Procedure SetParent(AParent:TWinControl); Override;
Procedure WMEraseBkGnd(Var Message:TWMEraseBkGnd); Message
WM_EraseBkGnd;
Protected
Procedure CreateParams(Var Params:TCreateParams); Override;
Procedure Paint; Override;
Public
Constructor Create(AOwner:TComponent); Override;
Procedure Invalidate; Override;
Procedure RePaint; Override;
Procedure Refresh; {Override;}
Procedure Update; Override;
published
{ Published-Deklarationen }
property Transparent : Boolean read FTransparent write SetTransparent
default false;
property NoPaint : Boolean read FNoPaint write SetNoPaint default false;

End;


implementation

procedure Register;
begin
RegisterComponents('Zusätzlich', [TTransparentPanel, TTranPanel]);
end;

constructor TTransparentPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

destructor TTransparentPanel.Destroy;
begin
inherited Destroy;
end;

procedure TTransparentPanel.SetTransparent(Value : Boolean);
begin
if FTransparent <> Value then begin
FTransparent := Value;
if FTransparent then ControlStyle := ControlStyle - [csOpaque]
else ControlStyle := ControlStyle + [csOpaque];
invalidate;
end;
end;

Constructor TTranPanel.Create(AOwner:TComponent);
Begin
Inherited Create(AOwner);
ControlStyle:= ControlStyle - [csOpaque];
End;


Procedure TTranPanel.CreateParams(Var Params:TCreateParams);
Begin
if FNoPaint then exit;
Inherited CreateParams(Params);
Params.ExStyle:= Params.ExStyle or WS_EX_TRANSPARENT;
End;


Procedure TTranPanel.Paint;
Begin
if FNoPaint then exit;
if not (csDesigning in ComponentState) then exit;
Canvas.Brush.Style:= bsClear;
Canvas.Rectangle(0, 0, Width, Height);
Canvas.TextOut(Width div 2, Height div 2, 'Transparent');
End;


Procedure TTranPanel.WMEraseBkGnd(Var Message:TWMEraseBkGnd);
Begin
if FNoPaint then exit;
{ Do Nothing }
Message.Result:= 1;
End;


Procedure TTranPanel.SetParent(AParent:TWinControl);
Begin
if FNoPaint then exit;
Inherited SetParent(AParent);
{
The trick needed to make it all work!
I don't know if changing the parent's style is a good idea, but it only
removes the WS_CLIPCHILDREN style which shouldn't cause any problems.
}
If Parent <> Nil then
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) And Not WS_ClipChildren);
End;


Procedure TTranPanel.RePaint;
begin
if FNoPaint then exit;
inherited Repaint;
end;

Procedure TTranPanel.Refresh;
begin
if FNoPaint then exit;
inherited Refresh;
end;

Procedure TTranPanel.Update;
begin
if FNoPaint then exit;
inherited Update;
end;

Procedure TTranPanel.Invalidate;
Var
Rect :TRect;
Begin
if FNoPaint then exit;
Rect:= BoundsRect;
If (Parent <> Nil) and Parent.HandleAllocated then
InvalidateRect(Parent.Handle, @Rect, True)
Else
Inherited Invalidate;
end;

procedure TTranPanel.SetTransparent(Value : Boolean);
begin
if FTransparent <> Value then begin
FTransparent := Value;
if FTransparent then ControlStyle := ControlStyle - [csOpaque]
else ControlStyle := ControlStyle + [csOpaque];
invalidate;
end;
end;

procedure TTranPanel.SetNoPaint(Value : Boolean);
begin
if FNoPaint <> Value then begin
FNoPaint := Value;
end;
end;

end.

Andrew Stewart

unread,
Jul 22, 1998, 3:00:00 AM7/22/98
to
Jochen wrote:
>
> Hello Wayne,
>
> At the end I added a Transparent panel component
> Hopefully this will help
>

Or how about the ORIGINAL source of the code...

Andrew

Unit AsdTrWnd;

{

============================================================================
A Transparent Window Control

Copyright (C) 1998 Andrew Stewart. All Rights Reserved.

Email: aste...@strobes.co.nz

============================================================================

This control is released as freeware.

Use at your own risk.
}

interface

uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Menus;

{

============================================================================
TAsdCustomTransparentWindow

This class handles transparency relative to the parent quite well, but
if any sibling controls get in behind it, then transparency may not
work
properly.

It might help if you remove the WS_CLIPSIBLINGS style from any
siblings
that may get behind the control. See SetParentStyle for an example.

============================================================================
}

Const
UM_SetParentStyle = WM_USER + 1024;

Type
TAsdCustomTransparentWindow = Class(TCustomControl)
Private
FFullRepaint :Boolean;
FTransparent :Boolean;
FSentSetParent :Boolean;
FParentHandle :HWND;
FOnResize :TNotifyEvent;

Procedure UMSetParentStyle(Var Message:TMessage); Message
UM_SetParentStyle;


Procedure WMEraseBkGnd(Var Message:TWMEraseBkGnd); Message
WM_EraseBkGnd;

Procedure WMSize(Var Message:TWMSize); Message WM_Size;

Protected
Procedure CreateParams(Var Params:TCreateParams); Override;

Procedure CreateWindowHandle(Const Params:TCreateParams); Override;
Procedure Paint; Override;
Procedure SetBounds(ALeft, ATop, AWidth, AHeight:Integer); Override;
Procedure SetParent(AParent:TWinControl); Override;

Procedure Resize; Virtual;
Procedure SetParentStyle;
Procedure SetTransparent(Const Value:Boolean);

Property FullRepaint :Boolean Read FFullRepaint Write
FFullRepaint Default True;
Property Transparent :Boolean Read FTransparent Write
SetTransparent Default False;
Property OnResize :TNotifyEvent Read FOnResize Write
FOnResize;

Public
Constructor Create(AOwner:TComponent); Override;

Procedure Invalidate; Override;
Procedure InvalidateRect(Const aRect:TRect);
End;

{

============================================================================
TAsdTransparentWindow

============================================================================
}

TAsdTransparentWindow = Class(TAsdCustomTransparentWindow)
Private
FOnPaint :TNotifyEvent;
Protected


Procedure Paint; Override;
Public
Constructor Create(AOwner:TComponent); Override;

Property Canvas;
Published
Property Align;
Property Caption;
Property Color;
Property Ctl3D;
Property DragCursor;
Property DragMode;
Property Enabled;
Property Font;
Property FullRepaint;
Property ParentColor;
Property ParentCtl3D;
Property ParentFont;
Property ParentShowHint;
Property PopupMenu;
Property ShowHint;
Property TabOrder;
Property TabStop;
Property Transparent Default True;
Property Visible;
Property OnClick;
Property OnDblClick;
Property OnDragDrop;
Property OnDragOver;
Property OnEndDrag;
Property OnEnter;
Property OnExit;
Property OnMouseDown;
Property OnMouseMove;
Property OnMouseUp;
Property OnResize;
Property OnPaint :TNotifyEvent Read FOnPaint Write FOnPaint;
End;


Implementation

{

============================================================================
TAsdCustomTransparentWindow

============================================================================
}

Constructor TAsdCustomTransparentWindow.Create(AOwner:TComponent);
Begin
Inherited Create(AOwner);
Width:= 50;
Height:= 50;
FFullRepaint:= True;
End;


Procedure TAsdCustomTransparentWindow.CreateParams(Var
Params:TCreateParams);
Begin
Inherited CreateParams(Params);
If Transparent then


Params.ExStyle:= Params.ExStyle or WS_EX_TRANSPARENT;
End;


Procedure TAsdCustomTransparentWindow.CreateWindowHandle(Const
Params:TCreateParams);
Begin
Inherited CreateWindowHandle(Params);
SetParentStyle;
End;


Procedure TAsdCustomTransparentWindow.Invalidate;
Begin
InvalidateRect(Rect(0,0,Width,Height));
End;


Procedure TAsdCustomTransparentWindow.InvalidateRect(Const aRect:TRect);
Var
InvalRect :TRect;
Begin
IntersectRect(InvalRect, aRect, Rect(0,0,Width,Height));

If Transparent and (Parent <> Nil) and Parent.HandleAllocated then
Begin
If FParentHandle <> Parent.Handle then
SetParentStyle;
OffsetRect(InvalRect, Left, Top);
WinProcs.InvalidateRect(FParentHandle, @InvalRect, True)
End
Else If HandleAllocated then
WinProcs.InvalidateRect(Handle, @InvalRect, True);
End;


Procedure TAsdCustomTransparentWindow.Paint;
Begin
With Canvas do
If Not Transparent then
Begin
Brush.Color:= Color;
Brush.Style:= bsSolid;
Pen.Color:= Color;
Pen.Mode:= pmCopy;
Rectangle(0, 0, Width, Height);
If Caption <> '' then
TextOut((Width - TextWidth(Caption)) div 2, (Height -
TextHeight(Caption)) div 2, Caption);
End
Else If Transparent and (csDesigning in ComponentState) then
Begin
Brush.Style:= bsClear;
Pen.Mode:= pmCopy;
Pen.Color:= clBlack;
Rectangle(0, 0, Width, Height);
If Caption <> '' then
TextOut((Width - TextWidth(Caption)) div 2, (Height -
TextHeight(Caption)) div 2, Caption);
End;
End;


Procedure TAsdCustomTransparentWindow.Resize;
Begin
If Transparent or FullRepaint then
Invalidate;

If Assigned(FOnResize) then
FOnResize(Self);
End;


Procedure TAsdCustomTransparentWindow.SetBounds(ALeft, ATop, AWidth,
AHeight:Integer);
Var
Resized :Boolean;
Begin
Resized:= (Width <> AWidth) or (Height <> AHeight);
Inherited SetBounds(ALeft, ATop, AWidth, AHeight);
If Resized then
Resize
Else If (csDesigning in ComponentState) and (Transparent or
FullRepaint) then
Invalidate;
End;


Procedure TAsdCustomTransparentWindow.SetParent(AParent:TWinControl);
Begin
Inherited SetParent(AParent);
SetParentStyle;
End;


Procedure TAsdCustomTransparentWindow.SetParentStyle;
Begin
If Transparent and (Parent <> Nil) then
If Parent.HandleAllocated then
Begin
FParentHandle:= Parent.Handle;
SetWindowLong(FParentHandle, GWL_STYLE,
GetWindowLong(FParentHandle, GWL_STYLE)
And Not WS_ClipChildren)
End
Else If HandleAllocated and Not FSentSetParent then
Begin
FSentSetParent:= True;
PostMessage(Handle, UM_SetParentStyle, 0, 0);
End;
End;


Procedure TAsdCustomTransparentWindow.SetTransparent;
Begin
If FTransparent <> Value then
Begin
Invalidate;
FTransparent:= Value;

If FTransparent then


ControlStyle:= ControlStyle - [csOpaque]

Else


ControlStyle:= ControlStyle + [csOpaque];

If HandleAllocated then
RecreateWnd;

If FTransparent then
SetParentStyle;

Invalidate;
End;
End;


Procedure TAsdCustomTransparentWindow.UMSetParentStyle(Var
Message:TMessage);
begin
FSentSetParent:= False;
SetParentStyle;
End;


Procedure TAsdCustomTransparentWindow.WMEraseBkGnd(Var
Message:TWMEraseBkGnd);
Begin
If Transparent then
Message.Result:= 1
Else
Inherited
End;


Procedure TAsdCustomTransparentWindow.WMSize(Var Message:TWMSize);
Begin
Inherited;
If Not (csLoading in ComponentState) then
Resize;
End;

{

============================================================================
TAsdTransparentWindow

============================================================================
}

Constructor TAsdTransparentWindow.Create(AOwner:TComponent);
Begin
Inherited Create(AOwner);
Transparent:= True;
End;


Procedure TAsdTransparentWindow.Paint;
Begin
Inherited Paint;
If Assigned(FOnPaint) then
FOnPaint(Self);
End;


End.

0 new messages