Delphi6控件内容完整截屏

由于用户那套旧系统需要截取Form中控件的内容，但经常因内容超长而截屏不完整（又被踢下坑了）。

网上有不少关于这方面的资料（感谢他们的分享），再自己琢磨了一下，得到了以下代码。

值得注意的是，以下代码在Win8下可正常截图，但在Win7下超出屏幕部分的截取就会黑屏。由于程序只是简单的调用了user32.dll的方法，所以问题还在user32.dll的版本上（真心没闹懂微软想干嘛）

IDE：Delphi6

根据网上资料编写的方法

引入以下单元

Graphics

在{$R *.dfm}后添加以下代码

function PrintWindow(Wnd: HWND; hDCBlt:HDC; nFlags: DWord): Bool; stdcall external 'user32.dll';

procedure TForm.SaveImage;
var
  lHwnd : HWND;
  lhDC, lhBmp, lhMemDC: Integer;
  lRect : TRect;
  lBmp : TBitmap;
  old_Height, old_Width : Integer;
  aAlign : TAlign;
  i : integer;
rectH, rectW : integer;
begin
//这里用了DrawGrid 控件
try
    try
      old_Height := DrawGrid.Height;
      old_Width := DrawGrid.Width;
      aAlign := DrawGrid.Align;     //记录控件原Align
      DrawGrid.Align := alNone;    //设置控件的Align为alNone，否则截图会有黑屏

//累加DrawGrid每行行高，用于截屏高度
      rectH := 0;
      for i := 0 to DrawGrid.RowCount - 1 do
        rectH := rectH + DrawGrid.RowHeights[i] + 1;
      DrawGrid.Height := rectH;

      //累加DrawGrid每列列宽，用于截屏宽度
      rectW := 0;
      for i := 0 to DrawGrid.ColCount - 1 do
        rectW := rectW + DrawGrid.ColWidths[i] + 1;
      DrawGrid.Width := rectW;
	  
      //获取控件句柄
	  lHwnd := DrawGrid.Handle;
      lhDC := GetWindowDC(lHwnd);
      if lhDC <> 0 then
	  begin
	    lhMemDC := CreateCompatibleDC(lhDC);
        if lhMemDC <> 0 then
        begin
          GetWindowRect(lHwnd, lRect);
          lhBmp := CreateCompatibleBitmap(lhDC, rectW, rectH);
          if lhBmp <> 0 then
          begin
            SelectObject(lhMemDC, lhBmp);
            if not PrintWindow(lHwnd, lhMemDC, 0) then
            begin
              Application.MessageBox(PChar('截屏失败'), '提示', MB_OK);
              Exit;
            end;//if
			//保存截图
            lBmp := TBitmap.Create;
            lBmp.Handle := lhBmp;
            lBmp.SaveToFile('TEMP.BMP'); 
            lBmp.Free;
            DeleteObject(lhBmp);
          end;//if
          DeleteObject(lhMemDC);
        end;//if
        ReleaseDC(lHwnd, lhDC);
      end;//if
    except
      on e:Exception do
      begin
        Application.MessageBox(PChar(e.Message), '保存图片失败', MB_OK or MB_ICONINFORMATION);
      end;
    end;//except
  finally
    DrawGrid.Height := old_Height; 回复控件原高、宽
    DrawGrid.Width := old_Width;
    DrawGrid.Align := Align;
  end;//finally

效果图

控件

正常截屏图

如果不是设置控件的Align 为 alNone和宽、高，则截屏会有部分黑屏