procedure DrawParentBackground(Control: TControl; DC: HDC; R: PRect = nil; bDrawErasebkgnd: Boolean = False);

var

  SaveIndex: Integer;

  MemDC: HDC;

  MemBmp: HBITMAP;

begin

  if R <> nil then

  begin

    MemDC := CreateCompatibleDC(DC);

    MemBmp := CreateCompatibleBitmap(DC, Control.Width, Control.Height);

    SelectObject(MemDC, MemBmp);

    try

      with Control.BoundsRect.TopLeft do

        SetWindowOrgEx(MemDC, X, Y, nil);

      if bDrawErasebkgnd then

        Control.Parent.Perform(WM_ERASEBKGND, Integer(MemDC), Integer(MemDC));

      Control.Parent.Perform(WM_PAINT, Integer(MemDC), Integer(MemDC));

      with Control.BoundsRect.TopLeft do

        BitBlt(DC, R^.Left, R^.Top, R^.Right - R^.Left, R^.Bottom - R^.Top, MemDC, X + R^.Left, Y + R^.Top, SRCCOPY);

    finally

      DeleteObject(MemBmp);

      DeleteDC(MemDC);

    end;

    Exit;

  end;

  SaveIndex := SaveDC(DC);

  try

    with Control.BoundsRect.TopLeft do

      SetWindowOrgEx(DC, X, Y, nil);

    if bDrawErasebkgnd then

      Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));

    Control.Parent.Perform(WM_PAINT, Integer(DC), Integer(DC));

  finally

    RestoreDC(DC, SaveIndex);

  end;

end;