procedure TGRushControl.SetParent(AParent: TWinControl);
begin
 if AParent<>nil then begin
   AParent.DoubleBuffered := TRUE;
 end;
 inherited SetParent(AParent);
end;

procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
var  Rect: TRect;
.......
begin
 if (IsVisible or (csDesigning in ComponentState) and
   not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and
   Parent.HandleAllocated then
 begin
   Rect := BoundsRect; // - Вот этот рэкт мне очень нужен
   InvalidateRect(Parent.Handle, @Rect, not (IsOpaque or
     (csOpaque in Parent.ControlStyle) or BackgroundClipped));
 end;
end;

unti1.pas:
procedure TForm1.WMPaint(var Message: TWMPaint);
begin
 GetUpdateRect(Handle, UpdateRect, FALSE);
 inherited;
end;

GRushcontrol.pas:
procedure TGRushControl.Paint;
begin
 IntersectRect(rct, BoundsRect, UpdateRect);
 if (IsRectEmpty(rct)=FALSE) then begin
   // Рисуем здесь!!!
 end;
end;

const
 PropWndProc:PChar = 'TWinControl_WndProc_OLD';
 PropUpdateRect:PChar = 'TWinControl_UpdateRect_OLD';
 
function GRushWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall;
var
 PrevWndProc: Pointer;
 UpdateRect: PRect;
begin
 if (Message = WM_PAINT) then begin
   GetMem(UpdateRect, sizeof(TRect));
   GetUpdateRect(Window, UpdateRect^, FALSE);
   SetProp(Window, PropUpdateRect, DWORD(UpdateRect));
 end;
 PrevWndProc := Pointer(GetProp(Window, PropWndProc));
 if PrevWndProc<>nil then
   Result := CallWindowProc(PrevWndProc, Window, Message, wParam, lParam);

 if (Message = WM_PAINT) then begin
   FreeMem(UpdateRect);
   RemoveProp(Window, PropUpdateRect);
 end;
end;

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
 if Parent<>nil then begin
   WinProc := RemoveProp(Parent.Handle, PropWndProc);;
   if (WinProc<>0) then
     SetWindowLong(Parent.Handle, GWL_WNDPROC, WinProc);
 end;
 inherited SetParent(AParent);
 if Parent<>nil then with Parent do begin
   DoubleBuffered := TRUE;
   WinProc := GetWindowLong(Handle, GWL_WNDPROC);
   if (WinProc <> DWORD(@GRushWndProc)) then begin
     SetProp(Handle, PropWndProc, WinProc);
     SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
   end;
 end;
end;

procedure TGRushControl.Paint;
var
 UpdateRect: PRect;
 TR: TRect;
begin
 UpdateRect := Pointer(GetProp(Parent.Handle, PropUpdateRect));
 if UpdateRect<>nil then
   IntersectRect(TR, BoundsRect, UpdateRect^);
 if (IsRectEmpty(TR)=FALSE) OR (UpdateRect=nil) then begin
   // рисуем, как вы догадались, здесь :)
 end;
end;

if тра-ля-ля
 then inherited
 else inherited SetParent(NewParent)

inherited;
AParent = NewParent

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
 if Parent<>nil then begin
   WinProc := RemoveProp(Parent.Handle, PropWndProc);;
   if (WinProc<>0) then
     SetWindowLong(Parent.Handle, GWL_WNDPROC, WinProc);
 end;
 inherited SetParent(AParent);
 if Parent<>nil then with Parent do begin
   DoubleBuffered := TRUE;
   if (GetProp(Handle, PropWndProc) = 0) then begin
     WinProc := SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
     SetProp(Handle, PropWndProc, WinProc);
   end;
 end;
end;

function GRushWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall;
var
 PrevWndProc: Pointer;
 UpdateRect: PRect;
begin
 PrevWndProc := Pointer(GetProp(Window, PropWndProc));
 case Message of
   WM_PAINT: begin
     GetMem(UpdateRect, sizeof(TRect));
     GetUpdateRect(Window, UpdateRect^, FALSE);
     SetProp(Window, PropUpdateRect, DWORD(UpdateRect));
   end;
   WM_DESTROY: begin
     if PrevWndProc<>nil then begin
       SetWindowLong(Window, GWL_WNDPROC, DWORD(PrevWndProc));
       RemoveProp(Window, PropWndProc);
     end;
   end;
 end;
 
 if PrevWndProc<>nil then
   Result := CallWindowProc(PrevWndProc, Window, Message, wParam, lParam);

 if (Message = WM_PAINT) then begin
   FreeMem(UpdateRect);
   RemoveProp(Window, PropUpdateRect);
 end;
end;

procedure TGRushControl.SetParent(AParent: TWinControl);
var WinProc: DWORD;
begin
 inherited SetParent(AParent);
 if Parent<>nil then with Parent do begin
   DoubleBuffered := TRUE;
   if (GetProp(Handle, PropWndProc) = 0) then begin
     WinProc := SetWindowLong(Handle, GWL_WNDPROC, DWORD(@GRushWndProc));
     SetProp(Handle, PropWndProc, WinProc);
   end;
 end;
end;

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;

Use the WindowProc property to temporarily replace or subclass the window procedure of the control.

procedure WMEraseBkgnd( var Msg: TWMEraseBkgnd ); message WM_EraseBkgnd  

SetParent(Parent);

Control1.SetHook:  Control1.LastHook:=SetWindowLong(Control1.Hook);
Control2.SetHook:  Control2.LastHook:=SetWindowLong(Control2.Hook);
Control1.Destroy:  SetWindowLong(Control1.LastHook);
Control2.Destroy:  SetWindowLong(Control2.LastHook);

procedure TWinControl.WMPaint(var Message: TWMPaint);
....
     DC := BeginPaint(Handle, PS);
     Perform(WM_ERASEBKGND, MemDC, MemDC);
     Message.DC := MemDC;
     WMPaint(Message);
     Message.DC := 0;
     BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
     EndPaint(Handle, PS);
....
end;