你可以先抓屏,然后把图象再打印出来!试试!
For Example:
Unit Printit;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Printers;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
dc: HDC;
isDcPalDevice: BOOL;
MemDc: HDC;
MemBitmap: hBitmap;
OldMemBitmap: hBitmap;
hDibHeader: THandle;
pDibHeader: pointer;
hBits: THandle;
pBits: pointer;
ScaleX:do
uble;
ScaleY:do
uble;
ppal: PLOGPALETTE;
pal: hPalette;
Oldpal: hPalette;
i: integer;
begin
dc := GetDc(0);
MemDc := CreateCompatibleDc(dc);
MemBitmap := CreateCompatibleBitmap(Dc, form1.width, form1.height);
OldMemBitmap := SelectObject(MemDc, MemBitmap);
isDcPalDevice := false;
if GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE then
begin
GetMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
FillChar(pPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
pPal^.palVersion := $300;
pPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, pPal^.palPalEntry);
if pPal^.PalNumEntries < > 0 then
begin
pal := CreatePalette(pPal^);
oldPal := SelectPalette(MemDc, Pal, false);
isDcPalDevice := true
end
else
FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
BitBlt(MemDc, 0, 0, form1.width, form1.height, Dc, form1.left, form1.top, SrcCopy);
if isDcPalDevice = true then
begin
SelectPalette(MemDc, OldPal, false);
DeleteObject(Pal);
end;
SelectObject(MemDc, OldMemBitmap);
DeleteDc(MemDc);
hDibHeader := GlobalAlloc(GHND, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256));
pDibHeader := GlobalLock(hDibHeader);
FillChar(pDibHeader^, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256), #0);
PBITMAPINFOHEADER(pDibHeader)^.biSize := sizeof(TBITMAPINFOHEADER);
PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
PBITMAPINFOHEADER(pDibHeader)^.biWidth := form1.width;
PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;
PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
{find out how much memory for the bits}
GetDIBits(dc, MemBitmap, 0, form1.height, nil, TBitmapInfo(pDibHeader^),
DIB_RGB_COLORS);
hBits := GlobalAlloc(GHND, PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
pBits := GlobalLock(hBits);
GetDIBits(dc, MemBitmap, 0, form1.height, pBits, PBitmapInfo (pDibHeader)^, DIB_RGB_COLORS);
if isDcPalDevice = true then
begin
for i := 0 to (pPal^.PalNumEntries - 1)do
begin
PBitmapInfo(pDibHeader)^.bmiColors.rgbRed := pPal^.palPalEntry.peRed;
PBitmapInfo(pDibHeader)^.bmiColors.rgbGreen := pPal^.palPalEntry.peGreen;
PBitmapInfo(pDibHeader)^.bmiColors.rgbBlue := pPal^.palPalEntry.peBlue;
end;
FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
ReleaseDc(0, dc);
DeleteObject(MemBitmap);
Printer.begin
Doc;
if Printer.PageWidth < Printer.PageHeight then
begin
ScaleX := Printer.PageWidth;
ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);
end
else
begin
ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);
ScaleY := Printer.PageHeight;
end;
isDcPalDevice := false;
if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and
RC_PALETTE = RC_PALETTE then
begin
GetMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
FillChar(pPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
pPal^.palVersion := $300;
pPal^.palNumEntries := 256;
for i := 0 to (pPal^.PalNumEntries - 1)do
begin
pPal^.palPalEntry.peRed := PBitmapInfo(pDibHeader)^.bmiColors.rgbRed;
pPal^.palPalEntry.peGreen := PBitmapInfo(pDibHeader)^.bmiColors.rgbGreen;
pPal^.palPalEntry.peBlue := PBitmapInfo(pDibHeader)^.bmiColors.rgbBlue;
end;
pal := CreatePalette(pPal^);
FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
isDcPalDevice := true
end;
StretchDiBits(Printer.Canvas.Handle, 0, 0, Round(scaleX), Round(scaleY), 0, 0,
Form1.Width, Form1.Height, pBits, PBitmapInfo(pDibHeader)^,
DIB_RGB_COLORS, SRCCOPY);
if isDcPalDevice = true then
begin
SelectPalette(Printer.Canvas.Handle, oldPal, false);
DeleteObject(Pal);
end;
GlobalUnlock(hBits);
GlobalFree(hBits);
GlobalUnlock(hDibHeader);
GlobalFree(hDibHeader);
Printer.EndDoc;
end;