DoubleBuffered := true;

ControlState := ControlState + [csOpaque];

procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
begin
 Message.Result := 1;
end;

1. прил.
1) непрозрачный; непроницаемый, темный

procedure TRzCustomButton.WMEraseBkgnd( var Msg: TWMEraseBkgnd );
begin
 if FTransparent then
 begin
   DrawParentImage( Self, Msg.DC, True );
   Msg.Result := 1;
 end
 else
   inherited;
end;

procedure DrawParentImage( Control: TControl; DC: HDC; InvalidateParent: Boolean = False );
var
 SaveIndex: Integer;
 P: TPoint;
begin
 if Control.Parent = nil then
   Exit;
 SaveIndex := SaveDC( DC );
 GetViewportOrgEx( DC, P );

 SetViewportOrgEx( DC, P.X - Control.Left, P.Y - Control.Top, nil );
 IntersectClipRect( DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight );

 if not ( csDesigning in Control.ComponentState ) then
 begin
   Control.Parent.Perform( wm_EraseBkgnd, DC, 0 );
   Control.Parent.Perform( wm_Paint, DC, 0 );
 end
 else
 begin
   try
     Control.Parent.Perform( wm_EraseBkgnd, DC, 0 );
     Control.Parent.Perform( wm_Paint, DC, 0 );
   except
   end;
 end;

 RestoreDC( DC, SaveIndex );

 if InvalidateParent then
 begin
   if not ( Control.Parent is TCustomControl ) and
      not ( Control.Parent is TCustomForm ) and
      not ( csDesigning in Control.ComponentState ) then
   begin
     Control.Parent.Invalidate;
   end;
 end;
end;

procedure DrawTransparentControlBackground(AControl: TWinControl;
 ADrawCanvas: TCanvas; ADrawRect: TRect);

 procedure PaintControlTo(ADrawingControl: TWinControl;
   ADrawCanvas: TCanvas; AX, AY, AWidth, AHeight: Integer);

   function ControlInDrawingRect(AControl: TWinControl; AOrg: TPoint): Boolean;
   var
     ARect: TRect;
   begin
     ARect.TopLeft := AOrg;
     ARect.Top := ARect.Top + AControl.Top;
     ARect.Left := ARect.Left + AControl.Left;
     ARect.Bottom := ARect.Top + AControl.Height;
     ARect.Right := ARect.Left + AControl.Width;
     Result := IntersectRect(ARect, ARect, Rect(0, 0, AWidth, AHeight));
   end;

   procedure DrawEdgesAndBorders(ADrawCanvas: TCanvas);
   var
     AEdgeFlags, ABorderFlags: Integer;
     R: TRect;
   begin
     ABorderFlags := 0;
     AEdgeFlags := 0;
     with ADrawingControl do
     begin
       if GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0 then
       begin
         AEdgeFlags := EDGE_SUNKEN;
         ABorderFlags := BF_RECT or BF_ADJUST
       end
       else
         if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
         begin
           AEdgeFlags := BDR_OUTER;
           ABorderFlags := BF_RECT or BF_ADJUST or BF_MONO;
         end;
       if ABorderFlags <> 0 then
       begin
         R := Rect(0, 0, Width, Height);
         DrawEdge(ADrawCanvas.Handle, R, AEdgeFlags, ABorderFlags);
         MoveWindowOrg(ADrawCanvas.Handle, R.Left, R.Top);
         IntersectClipRect(ADrawCanvas.Handle, 0, 0,
           R.Right - R.Left, R.Bottom - R.Top);
       end;
     end;
   end;

 var
   AOrg: TPoint;
   ASavedDC, AWindowRgnType, I: Integer;
   AWindowRgn: HRGN;
 begin
   AWindowRgn := CreateRectRgnIndirect(cxEmptyRect);
   try
     AWindowRgnType := GetWindowRgn(ADrawingControl.Handle, AWindowRgn);
     if AWindowRgnType = NULLREGION then
       Exit;
     ASavedDC := SaveDC(ADrawCanvas.Handle);
     ADrawingControl.ControlState := ADrawingControl.ControlState + [csPaintCopy];
     try
       MoveWindowOrg(ADrawCanvas.Handle, AX, AY);
       GetWindowOrgEx(ADrawCanvas.Handle, AOrg);
       AOrg.X := -AOrg.X;
       AOrg.Y := -AOrg.Y;
       with ADrawingControl do
       begin
         if AWindowRgnType = ERROR then
           IntersectClipRect(ADrawCanvas.Handle, 0, 0, Width, Height)
         else
         begin
           OffsetRgn(AWindowRgn, AOrg.X, AOrg.Y);
           ExtSelectClipRgn(ADrawCanvas.Handle, AWindowRgn, RGN_AND);
         end;
         if ADrawingControl <> AControl.Parent then
           DrawEdgesAndBorders(ADrawCanvas);
         ADrawCanvas.Lock;
         try
           Perform(WM_ERASEBKGND, ADrawCanvas.Handle, 0);
           Perform(WM_PAINT, ADrawCanvas.Handle, 0);
         finally
           ADrawCanvas.Unlock;
         end;
         for I := 0 to ControlCount - 1 do
         begin
           if Controls[I] = AControl then
             Break;
           if Controls[I] is TWinControl then
             if TWinControl(Controls[I]).Visible and
               ControlInDrawingRect(TWinControl(Controls[I]), AOrg) then
               begin
                 ADrawCanvas.Lock;
                 try
                   with TWinControl(Controls[I]) do
                     PaintControlTo(TWinControl(ADrawingControl.Controls[I]),
                       ADrawCanvas, Left, Top, AWidth, AHeight);
                 finally
                   ADrawCanvas.Unlock;
                 end;
               end;
         end;
       end;
     finally
       ADrawingControl.ControlState := ADrawingControl.ControlState - [csPaintCopy];
       RestoreDC(ADrawCanvas.Handle, ASavedDC);
     end;
   finally
     DeleteObject(AWindowRgn);
   end;
 end;

var
 AX, AY: Integer;
begin
 if AControl.Parent <> nil then
 begin
   OffsetRect(ADrawRect, AControl.Left, AControl.Top);
   AX := - ADrawRect.Left;
   AY := - ADrawRect.Top;
   PaintControlTo(AControl.Parent, ADrawCanvas, AX, AY,
     ADrawRect.Right - ADrawRect.Left, ADrawRect.Bottom - ADrawRect.Top);
 end;
end;

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;
   { Copy parent control image }
   SaveIndex := SaveDC(DC);
   try
     SetViewportOrgEx(DC, X, Y, nil);
     IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth,
       Control.Parent.ClientHeight);
     with TParentControl(Control.Parent) do begin
       Perform(WM_ERASEBKGND, DC, 0);
       PaintWindow(DC);
     end;
   finally
     RestoreDC(DC, SaveIndex);
   end;
   { Copy images of graphic controls }
   for I := 0 to Count - 1 do begin
     if Control.Parent.Controls[I] = Control then Break
     else if (Control.Parent.Controls[I] <> nil) and
       (Control.Parent.Controls[I] is TGraphicControl) 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
             SaveIndex := SaveDC(DC);
             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;