請教如何將Image的圖像印出? |
尚未結案
|
khw
一般會員 發表:2 回覆:12 積分:2 註冊:2003-06-09 發送簡訊給我 |
|
China Join
中階會員 發表:81 回覆:242 積分:89 註冊:2003-03-12 發送簡訊給我 |
|
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
http://www.swissdelphicenter.ch/en/showcode.php?id=744
{1.} uses Printers; procedure TForm1.Button1Click(Sender: TObject); var ScaleX, ScaleY: Integer; RR: TRect; begin with Printer do begin BeginDoc; // Mit BeginDoc wird ein Druckauftrag initiiert. // The StartDoc function starts a print job. try ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch; ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch; // Informationen über die Auflösung // Retrieves information about the Pixels per Inch of the Printer. RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY); Canvas.StretchDraw(RR, Image1.Picture.Graphic); // An die Auflösung anpassen // Stretch to fit finally EndDoc; //Methode EndDoc beendet den aktuellen Druckauftrag und schließt die // Textdatei-Variable. // Steht in finally - um auch bei Abbruch des Druckauftrages Papierausgabe // sicherzustellen end; end; end; {2.} {************************************************************************} // Based on posting to borland.public.delphi.winapi by Rodney E Geraghty, 8/8/97. procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap); var BitmapHeader: pBitmapInfo; BitmapImage: Pointer; HeaderSize: DWORD; ImageSize: DWORD; begin GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize); GetMem(BitmapHeader, HeaderSize); GetMem(BitmapImage, ImageSize); try GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^); StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, // Destination Origin DestRect.Right - DestRect.Left, // Destination Width DestRect.Bottom - DestRect.Top, // Destination Height 0, 0, // Source Origin Bitmap.Width, Bitmap.Height, // Source Width & Height BitmapImage, TBitmapInfo(BitmapHeader^), DIB_RGB_COLORS, SRCCOPY) finally FreeMem(BitmapHeader); FreeMem(BitmapImage) end end {PrintBitmap}; {3.} {************************************************************************} // from www.experts-exchange.com uses printers; procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); var Header, Bits: Pointer; HeaderSize: DWORD; BitsSize: DWORD; begin GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize); Header := AllocMem(HeaderSize); Bits := AllocMem(BitsSize); try GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^); StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right, DestRect.Bottom, 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY); finally FreeMem(Header, HeaderSize); FreeMem(Bits, BitsSize); end; end; procedure PrintImage(Image: TImage; ZoomPercent: Integer); // if ZoomPercent=100, Image will be printed across the whole page var relHeight, relWidth: integer; begin Screen.Cursor := crHourglass; Printer.BeginDoc; with Image.Picture.Bitmap do begin if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then begin // Stretch Bitmap to width of PrinterPage relWidth := Printer.PageWidth; relHeight := MulDiv(Height, Printer.PageWidth, Width); end else begin // Stretch Bitmap to height of PrinterPage relWidth := MulDiv(Width, Printer.PageHeight, Height); relHeight := Printer.PageHeight; end; relWidth := Round(relWidth * ZoomPercent / 100); relHeight := Round(relHeight * ZoomPercent / 100); DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap); end; Printer.EndDoc; Screen.cursor := crDefault; end; // Example Call: procedure TForm1.Button1Click(Sender: TObject); begin // Print image at 40% zoom: PrintImage(Image1, 40); end;--- 每個人都是一本書 |
China Join
中階會員 發表:81 回覆:242 積分:89 註冊:2003-03-12 發送簡訊給我 |
|
khw
一般會員 發表:2 回覆:12 積分:2 註冊:2003-06-09 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |