Capture Screen
Fred W
app, or main form. Want to capture it into a bitmap or other
graphic form, then save it to a file.
Thanks!
Jason
"Fred W" <inv...@null.com> wrote in message
news:41c8cde1$1...@newsgroups.borland.com...
Below are some functions that I use for such things. It's not pretty code
but it seems to work.
{$IFDEF USECLX}
function GrabForm(aBitmap: TBitmap; aForm: TForm): TPoint;
//returns image size;
var
P1, P2, C1, C2: TPoint;
aWinHandle: QWidgetH;
aWinId: Cardinal;
x, y, dy: integer;
w, h: integer;
begin
aWinHandle:= QApplication_desktop;
aWinId:= QWidget_winId(aWinHandle);
x:= aForm.Left;
y:= aForm.Top;
C1.X:= x;
C1.Y:= y;
C2.X:= aForm.Width;
C2.Y:= aForm.Height;
P1:= aForm.ClientToScreen(C1);
P2:= aForm.ClientToScreen(C2);
h:= P2.Y - aForm.Top + 4;
w:= P2.X - aForm.Left + 4;
QPixmap_grabWindow(aBitmap.Handle, aWinId, x, y, w, h);
Result.X:= w;
Result.Y:= h;
end;
{$ENDIF}
{$IFNDEF USECLX}
{$IFDEF CLR}
procedure CustomFormPrint(aImage: TImage; aForm: TForm);
var
FormImage: TBitmap;
Info: IntPtr;
BMPInfo: TBitmapInfo;
InfoSize: DWORD;
Image: TBytes;
ImageSize: DWORD;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;
begin
Printer.BeginDoc;
try
FormImage:= aImage.Picture.Bitmap;
aForm.Canvas.Lock;
try
{ Paint bitmap to the printer }
with Printer, Canvas do
begin
Bits:= FormImage.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info:= Marshal.AllocHGlobal(InfoSize);
try
SetLength(Image, ImageSize);
GetDIB(Bits, 0, Info, Image);
BMPInfo:= TBitmapInfo(Marshal.PtrToStructure(Info,
TypeOf(TBitmapInfo)));
with BMPInfo.bmiHeader do
begin
DIBWidth:= biWidth;
DIBHeight:= biHeight;
end;
PrintWidth:= MulDiv(DIBWidth, PageHeight, DIBHeight);
if PrintWidth < PageWidth then
PrintHeight:= PageHeight
else begin
PrintWidth:= PageWidth;
PrintHeight:= MulDiv(DIBHeight, PageWidth, DIBWidth);
end;
Marshal.StructureToPtr(TObject(BMPInfo), Info, True);
StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info, DIB_RGB_COLORS, SRCCOPY);
finally
Marshal.FreeHGlobal(Info);
end;
end;
finally
aImage.Canvas.Unlock;
end;
finally
Printer.EndDoc;
end;
end;
{$ELSE}
procedure CustomFormPrint(aImage: TImage; aForm: TForm);
var
FormImage: TBitmap;
Info: PBitmapInfo;
InfoSize: DWORD;
Image: Pointer;
ImageSize: DWORD;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;
begin
Printer.BeginDoc;
try
FormImage:= aImage.Picture.Bitmap;
aForm.Canvas.Lock;
try
{ Paint bitmap to the printer }
with Printer, Canvas do
begin
Bits:= FormImage.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info:= AllocMem(InfoSize);
try
Image:= AllocMem(ImageSize);
try
GetDIB(Bits, 0, Info^, Image^);
with Info^.bmiHeader do
begin
DIBWidth:= biWidth;
DIBHeight:= biHeight;
end;
PrintWidth:= MulDiv(DIBWidth, PageHeight, DIBHeight);
if PrintWidth < PageWidth then
PrintHeight:= PageHeight
else
begin
PrintWidth:= PageWidth;
PrintHeight:= MulDiv(DIBHeight, PageWidth, DIBWidth);
end;
StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0,
0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
finally
aImage.Canvas.Unlock;
end;
finally
Printer.EndDoc;
end;
end;
{$ENDIF CLR}
{$ENDIF}
function CopyFormToImage(aForm: TForm; aImage: TImage): TPoint;
//returns image size
var w, h, dy, dx: integer;
var ptop, pbottom: TPoint;
var a, b: integer;
begin
aForm.Refresh;
aForm.Update;
{$IFNDEF LINUX}
w:= aForm.Width;
ptop:= aForm.ClientToScreen(Point(0, 0));
dy:= abs(ptop.y - aForm.Top);
dx:= abs(ptop.x - aForm.Left);
pbottom:= aForm.ClientToScreen(Point(0, aForm.Height));
h:= abs(pbottom.y - ptop.y);
aImage.Width:= aForm.Width;
aImage.Height:= h;
aImage.Canvas.CopyRect(Rect(0, 0, w, h), aForm.Canvas, Rect(-dx, -dy, w -
dx, -dy + h));
{$ELSE}
Result:= GrabForm(aImage.Picture.Bitmap, aForm);
{$ENDIF}
end;
procedure PrintForm(aForm: TForm);
var R: TRect;
{$IFDEF USECLX}
var printAdapter: TQPrintAdapter;
var metrics: QPaintDeviceMetricsH;
var PrinterHandle: QPrinterH;
var aBitmap: TBitmap;
var xScale, yScale: double;
var xDPI, yDPI, xMargin, yMargin: Int64;
var rRight, rBottom, sw, sh, dy, dx: Int64;
var FormSize: TPoint;
var PrinterPageWidth, PrinterPageHeight, PrinterPageWidthMM,
PrinterPageHeightMM: Int64;
{$ELSE}
var aImage: TImage;
var bForm: TForm;
{$ENDIF}
begin
{$IFNDEF USECLX}
{$IFNDEF CLR}
SetPixelsPerInch;
{$ENDIF}
aForm.Refresh;
aForm.Update;
aImage:= TImage.Create(nil);
try
CopyFormToImage(aForm, aImage);
CustomFormPrint(aImage, aForm);
finally
aImage.Free;
end;
{$ELSE}
printAdapter:= Printer.PrintAdapter as TQPrintAdapter;
if aForm.Left < 0 then AForm.Left:= 0;
if aForm.Top < 0 then AForm.Top:= 0;
if printAdapter <> nil then begin
metrics:= printAdapter.DeviceMetrics;
if metrics = nil then begin
QuietDlg('Failed to Retreive Metrics from Printer', mtError,
[mbAbort], 0);
exit;
end;
PrinterHandle:= QPrinterH(Printer.Handle);
end
else begin
QuietDlg('Failed to Initialize Printer', mtError, [mbAbort], 0);
exit
end;
begin
// print to full page with no margins
QPrinter_setFullPage(QPrinterH(Printer.Handle), true);
PrinterPageWidth:= QPaintDeviceMetrics_width(metrics);
PrinterPageHeight:= QPaintDeviceMetrics_height(metrics);
PrinterPageWidthMM:= QPaintDeviceMetrics_widthMM(metrics);
PrinterPageHeightMM:= QPaintDeviceMetrics_heightMM(metrics);
xDPI:= QPaintDeviceMetrics_logicalDpiX(metrics);
yDPI:= QPaintDeviceMetrics_logicalDpiY(metrics);
aForm.Refresh;
aForm.Update;
aBitMap:= TBitMap.Create;
try
FormSize:= GrabForm(aBitMap, aForm);
xMargin:= (xDPI * 50) div 100;
yMargin:= (yDPI * 50) div 100;
R.Left:= 0;
R.Top:= 0;
PrinterPageWidth:= PrinterPageWidth - 2 * xMargin;
PrinterPageHeight:= PrinterPageHeight - 2 * yMargin;
sw:= FormSize.X;
sh:= FormSize.Y;
xScale:= (PrinterPageWidth / sw);
yScale:= (PrinterPageHeight / sh);
if xScale < yScale then begin
rRight:= (sw * PrinterPageWidth) div sw;
rBottom:= (sh * PrinterPageWidth) div sw;
end
else begin
rRight:= (sw * PrinterPageHeight) div sh;
rBottom:= (sh * PrinterPageHeight) div sh;
end;
R.Right:= R.Left + rRight;
R.Bottom:= R.Top + rBottom;
dy:= Printer.PageHeight - R.Bottom;
if dy > 0 then begin
R.Top:= R.Top + (dy div 2);
R.Bottom:= R.Bottom + (dy div 2);
end;
dx:= Printer.PageWidth - R.Right;
if dx > 0 then begin
R.Left:= R.Left + (dx div 2);
R.Right:= R.Right + (dx div 2);
end;
try
Printer.BeginDoc;
Printer.Canvas.StretchDraw(R, aBitMap);
finally
Printer.EndDoc;
end;
finally
aBitMap.Free;
end;
end;
{$ENDIF}
end;
theo
You can lookup past articles in Google like:
http://groups.google.com/groups?q=kylix+capture+screen&hl=de&btnG=Google-Suche