[Romanick]

Всем доброго времени суток!
Написал компонент TTransparentPanel, который рисует фон под собой, как это рекомендовано здесь
Вот код компонента:

Код:

unit TransparentPanels;

interface

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

type
  TTransparentPanel = class(TPanel)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    
  end;

procedure Register;

implementation

procedure CopyParentImage(Control: TControl; Dest: TCanvas);
var
  I, Count, X, Y, SaveIndex: Integer;
  DC: HDC;
  R, SelfR, CtlR: TRect;
begin
  if (Control = nil) or (Control.Parent = nil) then Exit;
  Count := Control.Parent.ControlCount;
  DC := Dest.Handle;
{$IFDEF WIN32}
  with Control.Parent do
  ControlState := ControlState + [csPaintCopy];
  try
{$ENDIF}
    with Control do
    begin
      SelfR := Bounds(Left, Top, Width, Height);
      X := -Left; Y := -Top;
    end;
    SaveIndex := SaveDC(DC);
    try
      SetViewportOrgEx(DC, X, Y, nil);
      IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
      with TWinControl(Control.Parent) do
      begin
        Perform(WM_ERASEBKGND, DC, 0);
        Perform(WM_PAINT, DC, 0);
      end;
    finally
      RestoreDC(DC, SaveIndex);
    end;
    for I := 0 to Count - 1 do
    begin
      if Control.Parent.Controls[i] = Control then
      Break
      else
      if Control.Parent.Controls[i] <> nil then
      begin
        with TGraphicControl(Control.Parent.Controls[i]) do
        begin
          CtlR := Bounds(Left, Top, Width, Height);
          if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then
          begin
{$IFDEF WIN32}
            ControlState := ControlState + [csPaintCopy];
{$ENDIF}
            SaveIndex := SaveDC(DC);
            try
              SetViewportOrgEx(DC, Left + X, Top + Y, nil);
              IntersectClipRect(DC, 0, 0, Width, Height);
              Perform(WM_PAINT, DC, 0);
            finally
              RestoreDC(DC, SaveIndex);
{$IFDEF WIN32}
              ControlState := ControlState - [csPaintCopy];
{$ENDIF}
            end;
          end;
        end
      end;
    end;
{$IFDEF WIN32}
  finally
    with Control.Parent do
    ControlState := ControlState - [csPaintCopy];
  end;
{$ENDIF}
end;

procedure Register;
begin
  RegisterComponents('Prsicom', [TTransparentPanel]);
end;

constructor TTransparentPanel.Create(AOwner: TComponent);
begin
  inherited;
  Ctl3D := false;
  BorderStyle := bsNone;
end;

procedure TTransparentPanel.Paint;
begin
end;

procedure TTransparentPanel.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  CopyParentImage(Self, Self.Canvas);
end;

end.

Всё работает. Но если на эту панель положить, например, кнопку TButton, то она отрисовывается как-то странно: при щелчке мышью в дизайнере она пропадает. Тоже самое и для других контролов и наследников от TGraphicControl. В run-time же видно, что отрисовка идёт без очищения фона (если положить на панель png-картинку с прозрачностью, то панель при каждой отрисовке будет становится всё непрозрачнее).
В чём может быть проблема?

[The Shadow]

А если поставить обычную панель + XPManifest?

[Romanick]

Сообщение от The Shadow

А если поставить обычную панель + XPManifest?

А ты пробовал? Ничего не получится.

[The Shadow]

Может я не так понял "прозрачная"...