如何将一个form的屏幕保存下来，在一个image里面可以预览？谢谢

Question

如何将一个form的屏幕保存下来，在一个image里面可以预览,我做用户表单定制，日后用户浏览定制表单列表的时候，希望可以在一个image里显示出这个form的图象？
                                                         谢谢

Answer 1

按键盘上的Print Screen Sys Rq键就是复制当前活动form,新建个文件保存一下就可以放在image里面了

Answer 2

alt＋Print Screen Sys Rq

Answer 3

procedure TForm1.Button1Click(Sender: TObject);
var
  Rct : TRect;
begin
  // Save file to bmp.
  Rct := Form1.ClientRect ;
  Image1.Canvas.CopyRect (Rct,Form1.canvas,Rct);
  Image1.Picture.SaveToFile ('C:\dd.bmp');
  // Load file if using
  Image1.Picture.LoadFromFile ('C:\dd.bmp');end;

Answer 4

屏 幕 的 图 象 拷 贝    var     //变量声明
  Fullscreen:Tbitmap;  
  FullscreenCanvas:TCanvas;
  dc:HDC;
  //------------------------------------------------------------
  DC := GetDC (0);      //取得屏幕的 DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create;    //创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;        //将屏幕的DC赋给HANDLE
  Fullscreen.Canvas.CopyRect 
  (Rect (0, 0, screen.Width,screen.Height),
  fullscreenCanvas,
  Rect (0, 0, Screen.Width, Screen.Height));
                            //把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;          //释放CANVAS对象
  ReleaseDC (0, DC);              //释放DC
  //SCREEN对象是DELPHI预先定义的屏幕对象，直接使用就行了。
****************************
下面的代码抓窗口：
 procedure ScreenShot(hWindow: HWND; bm: TBitmap);
 var
   Left, Top, Width, Height: Word;
   R: TRect;
   dc: HDC;
   lpPal: PLOGPALETTE;
 begin
   {Check if valid window handle}
   if not IsWindow(hWindow) then Exit;
   {Retrieves the rectangular coordinates of the specified window}
   GetWindowRect(hWindow, R);
   Left   := R.Left;
   Top    := R.Top;
   Width  := R.Right - R.Left;
   Height := R.Bottom - R.Top;
 
   bm.Width  := Width;
   bm.Height := Height;
   {get the screen dc}
   dc := GetDc(0);
   if (dc = 0) then
   begin
     Exit;
   end;
   {do we have a palette device?}
   if (GetDeviceCaps(dc, RASTERCAPS) and
     RC_PALETTE = RC_PALETTE) then
   begin
     {allocate memory for a logical palette}
     GetMem(lpPal,
       SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
     {zero it out to be neat}
     FillChar(lpPal^,
       SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)),
       #0);
     {fill in the palette version}
     lpPal^.palVersion := $300;
     {grab the system palette entries}
     lpPal^.palNumEntries :=
       GetSystemPaletteEntries(dc,
       0,
       256,
       lpPal^.palPalEntry);
     if (lpPal^.PalNumEntries <> 0) then
     begin
       {create the palette}
       bm.Palette := CreatePalette(lpPal^);
     end;
     FreeMem(lpPal, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
   end;
   {copy from the screen to the bitmap}
   BitBlt(bm.Canvas.Handle,
     0,
     0,
     Width,
     Height,
     Dc,
     Left,
     Top,
     SRCCOPY);
   {release the screen dc}
   ReleaseDc(0, dc);
 end;
 
 // Example: Capture the foreground window:
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ScreenShot(GetForeGroundWindow, Image1.Picture.Bitmap);
 end;
***********************
以下代码抓(X,Y)和指定宽度的屏幕内容，并且能够保存调色板
Most of the screenshot code you will see forgets about
the possibility of a palette.Here is some code that will take a palette into account (if needed).
procedure ScreenShot(x : integer;
                     y : integer;
                     Width : integer;
                     Height : integer;
                     bm : TBitMap);
var
  dc: HDC;
  lpPal : PLOGPALETTE;
begin
 {test width and height}
  if ((Width = 0) OR
      (Height = 0)) then begin
    exit;
  end;
  bm.Width := Width;
  bm.Height := Height;
 {get the screen dc}
  dc := GetDc(0);
  if (dc = 0) then begin
    exit;
  end;
 {do we have a palette device?}
  if (GetDeviceCaps(dc, RASTERCAPS) AND
      RC_PALETTE = RC_PALETTE) then begin
   {allocate memory for a logical palette}
    GetMem(lpPal,
           sizeof(TLOGPALETTE) +
           (255 * sizeof(TPALETTEENTRY)));
   {zero it out to be neat}
    FillChar(lpPal^,
             sizeof(TLOGPALETTE) +
             (255 * sizeof(TPALETTEENTRY)),
             #0);
   {fill in the palette version}
    lpPal^.palVersion := $300;
   {grab the system palette entries}
    lpPal^.palNumEntries :=
      GetSystemPaletteEntries(dc,
                              0,
                              256,
                              lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <0) then begin
     {create the palette}
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, sizeof(TLOGPALETTE) +
            (255 * sizeof(TPALETTEENTRY)));
  end;
 {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle,
         0,
         0,
         Width,
         Height,
         Dc,
         x,
         y,
         SRCCOPY);
 {release the screen dc}
  ReleaseDc(0, dc);
end;Joe
******************
下面的代码抓矩形：
function CaptureScreen(const Rect: TRect; const BitDepth: TPixelFormat =
pfDevice): TBitmap;
var
  hDC: Windows.HDC;
  hDesktop: THandle;
begin
  // create and define the bitmap
  Result := Graphics.TBitmap.Create;  try
    case BitDepth of
    pfCustom, pfDevice:
      Result.PixelFormat := pfDevice;
    else
      Result.PixelFormat := BitDepth;
    end;    Result.Width := Rect.Right - Rect.Left;
    Result.Height := Rect.Bottom - Rect.Top;    hDesktop := GetDeskTopWindow();
    hDC := GetDC(hDesktop);
    try
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, hDC,
Rect.Left, Rect.Top, SRCCOPY);
    finally
      ReleaseDC(hDesktop, hDC);
    end;  except
    FreeAndNil(Result);
  end;
end;

Answer 5

function CaptureForm(Form: TForm): TBitmap;
var
 DC: HDC;
 ABitmap: TBitmap;
begin
  Form.BringToFront;
  DC := GetDC(GetDesktopWindow);
  ABitmap := TBitmap.Create;
  try
    ABitmap.Width := Form.Width;
    ABitmap.Height := Form.Height;
    BitBlt(ABitmap.Canvas.Handle,
           0, 0,
           ABitmap.Width, ABitmap.Height,
           DC,
           Form.Left, Form.Top,
           SRCCOPY);
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
  Result := ABitmap;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  CaptureForm(Form2).SaveToFile('d:\Form2.bmp');
end;