用PaintTo(Printer.Handle,0,0)为什么图形那么小?(50分)

  • 主题发起人 主题发起人 BuddyWang
  • 开始时间 开始时间
B

BuddyWang

Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢!!
 
你是否想打印图形啊?

var
ScaleX,ScaleY :Integer;
R :TRect;
begin
if Printer.Printers.Count=0 then
begin
ShowMessage('请首先安装打印机');
Exit; //跳出N11Click
end;
if not MainPrintDialog.Execute then Exit
else
begin
with Printer do
begin
BeginDoc;
ScaleX :=GetDeviceCaps(Handle,LogPixelsX) div PixelsPerInch;
ScaleY :=GetDeviceCaps(Handle,LogPixelsY) div PixelsPerInch;
R :=Rect(0,0,MDIChildForm.MainImage.Width*ScaleX,MDIChildForm.MainImage.Height*ScaleY);
Canvas.StretchDraw(R,MDIChildForm.MainImage.Picture.Graphic);
EndDoc;
end;
end;
end;
 
打印图形卷起千堆雪tyn的这个效果不是很好,你试一下这个:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Printers,
ExtCtrls, StdCtrls;

type
PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
TPalEntriesArray = array[0..0] of TPaletteEntry;



type
TForm1 = class(TForm)
PrintDialog1: TPrintDialog;
Button1: TButton;
Image1: TImage;
PrinterSetupDialog1: TPrinterSetupDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure BltTBitmapAsDib(DestDc : hdc; {Handle of where to blt}
x : word; {Bit at x}
y : word; {Blt at y}
Width : word; {Width to stretch}
Height : word; {Height to stretch}
bm : TBitmap); {the TBitmap to Blt}
var
OriginalWidth :LongInt; {width of BM}
dc : hdc; {screen dc}
IsPaletteDevice : bool; {if the device uses palettes}
IsDestPaletteDevice : bool; {if the device uses palettes}
BitmapInfoSize : integer; {sizeof the bitmapinfoheader}
lpBitmapInfo : PBitmapInfo; {the bitmap info header}
hBm : hBitmap; {handle to the bitmap}
hPal : hPalette; {handle to the palette}
OldPal : hPalette; {temp palette}
hBits : THandle; {handle to the DIB bits}
pBits : pointer; {pointer to the DIB bits}
lPPalEntriesArray : PPalEntriesArray; {palette entry array}
NumPalEntries : integer; {number of palette entries}
i : integer; {looping variable}
begin
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
OriginalWidth := bm.Width;
dc := GetDc(0);
IsPaletteDevice :=
GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
ReleaseDc(0, dc);
if IsPaletteDevice then
BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
else
BitmapInfoSize := sizeof(TBitmapInfo);
GetMem(lpBitmapInfo, BitmapInfoSize);

FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;
lpBitmapInfo^.bmiHeader.biHeight := bm.Height;
lpBitmapInfo^.bmiHeader.biPlanes := 1;
if IsPaletteDevice then
lpBitmapInfo^.bmiHeader.biBitCount := 8
else
lpBitmapInfo^.bmiHeader.biBitCount := 24;
lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
lpBitmapInfo^.bmiHeader.biSizeImage :=0;//((lpBitmapInfo^.bmiHeader.biWidth *longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *lpBitmapInfo^.bmiHeader.biHeight;
lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
if IsPaletteDevice then begin
lpBitmapInfo^.bmiHeader.biClrUsed := 256;
lpBitmapInfo^.bmiHeader.biClrImportant := 256;
end else begin
lpBitmapInfo^.bmiHeader.biClrUsed := 0;
lpBitmapInfo^.bmiHeader.biClrImportant := 0;
end;
hBm := bm.ReleaseHandle;
hPal := bm.ReleasePalette;

dc := GetDc(0);

if IsPaletteDevice then begin
OldPal := SelectPalette(dc, hPal, TRUE);
RealizePalette(dc);
end;
GetDiBits(dc,
hBm,
0,
lpBitmapInfo^.bmiHeader.biHeight,
nil,
TBitmapInfo(lpBitmapInfo^),
DIB_RGB_COLORS);

hBits := GlobalAlloc(GMEM_MOVEABLE,
lpBitmapInfo^.bmiHeader.biSizeImage);
pBits := GlobalLock(hBits);
GetDiBits(dc,
hBm,
0,
lpBitmapInfo^.bmiHeader.biHeight,
pBits,
TBitmapInfo(lpBitmapInfo^),
DIB_RGB_COLORS);


if IsPaletteDevice then begin
GetMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
NumPalEntries := GetPaletteEntries(hPal,
0,
256,
lPPalEntriesArray^);
NumPalEntries := GetSystemPaletteEntries(dc,
0,
256,
lPPalEntriesArray^);
for i := 0 to (NumPalEntries - 1) do begin
lpBitmapInfo^.bmiColors.rgbRed :=
lPPalEntriesArray^.peRed;
lpBitmapInfo^.bmiColors.rgbGreen :=
lPPalEntriesArray^.peGreen;
lpBitmapInfo^.bmiColors.rgbBlue :=
lPPalEntriesArray^.peBlue;
end;
FreeMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
end;

if IsPaletteDevice then begin
SelectPalette(dc, OldPal, TRUE);
RealizePalette(dc);
end;
ReleaseDc(0, dc);
IsDestPaletteDevice :=
GetDeviceCaps(DestDc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;


if IsPaletteDevice then begin
OldPal := SelectPalette(DestDc, hPal, TRUE);
RealizePalette(DestDc);
end;

{Do the blt}
StretchDiBits(DestDc,
x,
y,
Width,
Height,
0,
0,
OriginalWidth,
lpBitmapInfo^.bmiHeader.biHeight,
pBits,
lpBitmapInfo^,
DIB_RGB_COLORS,
SrcCopy);

if IsDestPaletteDevice then begin
SelectPalette(DestDc, OldPal, TRUE);
RealizePalette(DestDc);
end;

GlobalUnLock(hBits);
GlobalFree(hBits);

FreeMem(lpBitmapInfo, BitmapInfoSize);

bm.Handle := hBm;
bm.Palette := hPal;

{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ScaleX, ScaleY: Integer;
b:TBitmap;
begin
b:=TBitmap.Create;
b.LoadFromFile('c:/temp/capture.bmp');
image1.Canvas.StretchDraw(Image1.ClientRect,b);
if PrintDialog1.Execute then begin
Printer.BeginDoc;
ScaleX := GetDeviceCaps(printer.Handle, logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(printer.Handle, logPixelsY) div PixelsPerInch;
BltTBitmapAsDib(Printer.Canvas.Handle,
0,
0,
b.Width*ScaleX,
b.Height*ScaleY,
b);
Printer.EndDoc;
end;
end;

end.
 
我是打印控件!如何把屏幕中的一块打印出来?
 
多人接受答案了。
 
后退
顶部