freepascal.ru

Код: Выделить всё

procedure TForm1.Button4Click(Sender: TObject);
var MyBitmap:Graphics.TBitmap;
    ScreenDC:LCLType.HDC;
    WrkJpg:TJpegImage;
begin
  MyBitmap:=Graphics.TBitmap.Create;
  ScreenDC:=LCLIntf.GetDC(0);
  MyBitmap.LoadFromDevice(ScreenDC);


    //Per avere un elenco dei vari formati disponibili (png, bmp, xmp, ecc.):
    //http://wiki.lazarus.freepascal.org/Developing_with_Graphics#Image_formats
    WrkJpg:=TJpegImage.Create;
    try
      WrkJpg.Assign(MyBitmap);
      WrkJpg.SaveToFile(Utf8ToSys(WinTemp + 'Mario.jpg'));
    finally
      FreeAndNil(WrkJpg);
    end;


  LCLIntf.ReleaseDC(0 , ScreenDC);
  FreeAndNil(MyBitmap);
end;

Код: Выделить всё

function TCaptureForm.CreateSnapshot ( WindowHD : HWND ):TBitmap;
var
    wnd:HWND;
    dc:HDC;
    Bmp:TBitmap;
    r:TRect;

begin
    Bmp:=TMP;
     wnd :=WindowHD;
       if wnd = 0 then
        begin
         dc := GetDC(0);
         Bmp := TBitmap.Create;
         Bmp.SetSize (Screen.Width,Screen.Height);
        end
       else
        begin
        Bmp := TBitmap.Create;
        dc := GetWindowDC(wnd);
         GetWindowRect(wnd,r);
         Bmp.SetSize(r.Right-r.Left,r.Bottom-r.Top);
        end;
       BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,DC,0,0,SRCCOPY);
       Result:= bmp;
      ReleaseDC(wnd,dc);
end;

Код: Выделить всё

procedure Screen2File(const aFileName: string);
var
  dc: HDC;
begin
  dc := LclIntf.GetDC(0);
  try
    with TPicture.Create do
      try
        Bitmap.LoadFromDevice(dc);
        SaveToFile(aFileName);
      finally
        Free;
      end;
  finally
    LclIntf.ReleaseDC(0 , dc);
  end;
end; 

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var
  MyBitmap: TBitmap;
  ScreenDC: HDC;
begin
  MyBitmap:= TBitmap.Create;
  try
    ScreenDC:= GetDC(0);
    try
      MyBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0,ScreenDC);
    end;

    Image1.Picture.Assign(MyBitmap);
  finally
    FreeAndNil(MyBitmap);
  end;
end;