[ralfiii]

Hello!

I'd like to create a component that is completely independent from AlphaControls so I can give it to any other developer, even if they don't have the AC-package installed.

But: when the component is placed on a skinned application and the component name is listed in sSkinManager.ThirdParty then component should be party transparent so that the background of the form underneath comes through on some parts.

I attached an image, the region in fuchsia should show the same background as the form.

Here's some sample code of a component. Any hints how to achieve that?

Code:

type
TTest = class(TCustomControl)
public
constructor Create(AOwner: TComponent); override;
procedure Paint; override;
end;
constructor TTest.Create(AOwner: TComponent);
begin
inherited;
Width:=100;
Height:=100;
Color:=clFuchsia;
end;
procedure TTest.Paint;
begin
Canvas.rectangle(width div 5, Height div 5, 4*(width div 5), 4*(Height div 5))
end;

I have found entries about round buttons, transparent grids or a transparent TCustomControl-descendant (which would be what I need) here in the forum, but all solutions rely on using AC-code. However, there are a lot of controls like the ButtonedEdit or the VirtualTreeView simply work after you place them into the ThirdParty-list without the need to recompile anything.

So somehow it should be possible to construct a component to cooperate with alphacontrols. Even though this is an obvious question I didn't find any hints on how to achieve that in the docu.

HELP!!! 🙂

Thanks!

[Support]

Hello

You can receive a transparent control with using of a way which shown in the demo of a transparent chart.

You need only declare these types :

Code:

type
PacBGInfo = ^TacBGInfo;
TacBGType = (btUnknown, btFill, btCache, btNotReady); // Returned by control type of BG
TacBGInfo = record
Bmp : Graphics.TBitmap;
Color : TColor; // Color returned if btFill is used
Offset : TPoint; // Offset of bg, used with Cache
R : TRect; // Rectangle used if PlsDraw is True
BgType : TacBGType; // btUnknown, btFill, btCache
PleaseDraw : boolean; // Parent must fill rectangle(R)
DrawDC : hdc; // Device context for drawing, if PleaseDraw is True
end;

GetBGInfo(@bgInfo, Chart.Parent) may be replaced by

Code:

Control.Perform(SM_ALPHACMD, MakeWParam(0, AC_GETBG), LPARAM(BGInfo));
if BGInfo.BgType btUnknown then begin // Parent is not AlphaControl
BGInfo.Color := Control.Parent.Color;
BGInfo.BgType := btFill;
end;

This is easiest way. How you think?

[ralfiii]

I suppose you mean LPARAM(@BGInfo), right? (the @-symbol was missing)

hmmm… still, it's not really working well.

If I place the control on a TsPanel then it's really transparent.

If I place it directly on a Form then the form is skined but the control itself remains opaque.

If I place it on a TsPanel which is transparent because the BevelOuter is set to bvNone then it's also opaque.

And the line

ParentBGInfo.Color := Parent.Color

doesn't compile as Parent.Color seems not to be available.

Here's the source with both paint methods, selectable with a define:

Code:

{$DEFINE Independent}

{$IFDEF Independent}
uses Graphics, Windows;
{$ELSE}
uses Graphics, Windows, sGraphUtils, sConst;
{$ENDIF}

{$IFDEF Independent}
type
PacBGInfo = ^TacBGInfo;
TacBGType = (btUnknown, btFill, btCache, btNotReady); // Returned by control type of BG
TacBGInfo = record
Bmp : Graphics.TBitmap;
Color : TColor; // Color returned if btFill is used
Offset : TPoint; // Offset of bg, used with Cache
R : TRect; // Rectangle used if PlsDraw is True
BgType : TacBGType; // btUnknown, btFill, btCache
PleaseDraw : boolean; // Parent must fill rectangle(R)
DrawDC : hdc; // Device context for drawing, if PleaseDraw is True
end;

// from sMessages.pas
var
SM_ALPHACMD : LongWord;
const
AC_GETBG = 34;
{$ENDIF}

procedure TTest.Paint;
var
ParentBGInfo : TacBGInfo;
begin
Canvas.Lock;

{$IFDEF Independent}
Perform(SM_ALPHACMD, MakeWParam(0, AC_GETBG), LPARAM(@ParentBGInfo));
if ParentBGInfo.BgType btUnknown then
begin // Parent is not AlphaControl
ParentBGInfo.Color := clRed; // Parent.Color is not reachable ?!?!?
ParentBGInfo.BgType := btFill;
end;
{$ELSE}
GetBGInfo(@ParentBGInfo, Parent); // Receive a BG information from parent
if ParentBGInfo.BgType = btCache then
begin // If BG is accessible as bitmap
BitBlt(Canvas.Handle, 0, 0, Width, Height, ParentBGInfo.Bmp.Canvas.Handle,
Left + ParentBGInfo.Offset.x, Top + ParentBGInfo.Offset.y, SRCCOPY);
end
else // Else just filled by received color
FillDC(Canvas.Handle, Rect(0, 0, Left+Width+1, Top+Height+1), ParentBGInfo.Color);
{$ENDIF}

// Data output
Canvas.rectangle(width div 5, Height div 5, 4*(width div 5), 4*(Height div 5));

Canvas.UnLock;
end;

…

{$IFDEF Independent}
initialization
SM_ALPHACMD := RegisterWindowMessage('SM_ALPHACMD');
if True or (SM_ALPHACMD < $C000) then SM_ALPHACMD := $A100;
{$ENDIF}

[ralfiii]

I think I will simply use a “UseAlphaControls” define.

Thanks for your help!

[Support]

I'm sorry, you are right. Some errors exists in my previous code. Try this :

Code:

var
ParentBGInfo : TacBGInfo;
…

ParentBGInfo.BgType := btUnknown;
ParentBGInfo.PleaseDraw := False;
// Receive a BG information from parent
SendMessage(YourControl.Parent.Handle, $A100{SM_ALPHACMD}, MakeWParam(0, 34{AC_GETBG}), LPARAM(@ParentBGInfo));

[ralfiii]

'Support' wrote:

I'm sorry, you are right. Some errors exists in my previous code. Try this

Still doesn't work.

Don't I have to assign the Painting-rect?

I tried

Code:

procedure TTest.Paint;
…
if ParentBGInfo.BgType btUnknown then
begin // Parent is not AlphaControl
ParentBGInfo.BgType := btUnknown;
ParentBGInfo.PleaseDraw := False;
ParentBGInfo.R:=Rect(Left, Top, Left+Width, Top+Height);
SendMessage(Parent.Handle, $A100{SM_ALPHACMD}, MakeWParam(0, 34{AC_GETBG}), LPARAM(@ParentBGInfo));
end;

But this also didn't work.

AND: If I simply clear ParentBGInfo

FillChar(ParentBGInfo, sizeof(TacBGInfo), 0);

before I do anything with it, nothing happens anymore, then the component isn't transparent even when placed on a panel.

Somethings terribly wrong here.

If you like I can send a tiny demo application, so you could correct it in there.

[Support]

Here is changed your Paint procedure

Code:

procedure TTest.Paint;
var
ParentBGInfo : TacBGInfo;
begin
Canvas.Lock;

{$IFDEF Independent}
ParentBGInfo.BgType := btUnknown;
ParentBGInfo.PleaseDraw := False;
// Receive a BG information from parent
SendMessage(Parent.Handle, $A100{SM_ALPHACMD}, MakeWParam(0, 34{AC_GETBG}), LPARAM(@ParentBGInfo));
{$ELSE}
GetBGInfo(@ParentBGInfo, Parent); // Receive a BG information from parent
{$ENDIF}

if ParentBGInfo.BgType = btCache then
begin // If BG is accessible as bitmap
BitBlt(Canvas.Handle, 0, 0, Width, Height, ParentBGInfo.Bmp.Canvas.Handle,
Left + ParentBGInfo.Offset.x, Top + ParentBGInfo.Offset.y, SRCCOPY);
end
else // Else just filled by received color
FillDC(Canvas.Handle, Rect(0, 0, Left+Width+1, Top+Height+1), ParentBGInfo.Color);

// Data output
Canvas.rectangle(width div 5, Height div 5, 4*(width div 5), 4*(Height div 5));

Canvas.UnLock;
end;

I can't check it now, unfortunately.

[Support]

If you have problem still, then I can change your demo 🙂

[ralfiii]

I tested it and it works.

You're a genious! :a3:

Thanks!!!!

I attach the file just in case anybody wants it as a reference.

[Author]

Posts