delphi 控件背景透明代码

痴心易碎 提交于 2019-11-27 02:49:22
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;

 

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!