|
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Grids, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Label1: TLabel;
SaveDialog1: TSaveDialog;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure copyImage(form : TForm; destination : TBitmap);
//procedure that assigns the screenshot of "form" to "destination"
var
tmp : TBitmap;
w,h : integer;
r : TRect;
begin
w := form1.Width;
h:= form1.Height;
r:= Rect(0,0,w,h);
tmp:=TBitmap.Create;
tmp.Width:=w;
tmp.Height:=h;
tmp.Canvas.CopyRect(r, form1.Canvas, r);
destination.Assign(tmp);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
copyImage(form1, image1.Picture.Bitmap);
image1.Picture.SaveToFile('D:\img001.bmp');
end;
end.
http://www.lazarus.freepascal.org/index.php/topic,4211.msg19714.html#msg19714
Ovako je u Lazarusu, ne bi trebalo da bude problema u Delphi.
Rezultat mog testa:
|
