Печать изображения
Falk0ner, вс, 06/07/2008 - 15:34.
Печать изображения
. Использует модуль Printers.
Должно работать со всеми типами графики: битмепами, метафайлами и иконками.
(c) Alexey Torgashin, 2007
Последняя версия функции всегда доступна в исходниках компонента ATViewer:
http://atorg.net.ru/delphi/atviewer.htm
Параметры:
- AImage: TImage объект.
- ACopies: число копий (можно задать 0 для одной копии).
- AFitToPage: умещать картинку в страницу принтера. Если картинка меньше
страницы и AFitOnlyLarger=False, то картинка будет растянута.
- AFitOnlyLarger: разрешает умещать только картинки, бОльшие размера страницы.
- ACenter: центрировать картинку по странице.
- APixelsPerInch: число точек на дюйм на экране. Передавайте сюда значение
св-ва PixelsPerInch Вашей формы или объекта Screen.
- ACaption: заголовок задания печати в Print Manager.
-----------------------------------
Image printing. Uses Printers unit.
Should work with all graphics: bitmaps, metafiles and icons.
Parameters:
- AImage: TImage object.
- ACopies: number of copies (you may set 0 for a single copy).
- AFitToPage: fit image to a printer page. If image is smaller than a page and
AFitOnlyLarger=False then image will be stretched up to a page.
- AFitOnlyLarger: allows to stretch images smaller than a page.
- ACenter: center image on a page.
- APixelsPerInch: pass here value of PixelsPerInch property of your form or
of a Screen object (Screen.PixelsPerInch).
- ACaption: print job caption in Print Manager.
}
function ImagePrint(
AImage: TImage;
ACopies: word;
AFitToPage,
AFitOnlyLarger,
ACenter: boolean;
APixelsPerInch: integer;
const ACaption: string): boolean;
var
bmp: TBitmap;
begin
bmp:= TBitmap.Create;
try
bmp.PixelFormat:= pf24bit;
{$ifdef ADV_IMAGE_CONV}
if not CorrectImageToBitmap(AImage, bmp, clWhite) then
begin
Result:= false;
Exit
end;
{$else}
with AImage.Picture do
begin
bmp.Width:= Graphic.Width;
bmp.Height:= Graphic.Height;
bmp.Canvas.Draw(0, 0, Graphic);
end;
{$endif}
Result:= BitmapPrint( //Declared below
bmp,
ACopies,
AFitToPage,
AFitOnlyLarger,
ACenter,
APixelsPerInch,
ACaption);
finally
bmp.Free;
end;
end;
function BitmapPrint(
ABitmap: TBitmap;
ACopies: word;
AFitToPage,
AFitOnlyLarger,
ACenter: boolean;
APixelsPerInch: integer;
const ACaption: string): boolean;
var
Scale, ScalePX, ScalePY, ScaleX, ScaleY: Double;
SizeX, SizeY,
RectSizeX, RectSizeY, RectOffsetX, RectOffsetY: integer;
i: integer;
Begin
Result:= true;
Assert(
Assigned(ABitmap) and (ABitmap.Width>0) and (ABitmap.Height>0),
'BitmapPrint: bitmap is empty.');
if ACopies = 0 then
Inc(ACopies);
with Printer do
begin
SizeX:= PageWidth;
SizeY:= PageHeight;
ScalePX:= GetDeviceCaps(Handle, LOGPIXELSX) / APixelsPerInch;
ScalePY:= GetDeviceCaps(Handle, LOGPIXELSY) / APixelsPerInch;
ScaleX:= SizeX / ABitmap.Width / ScalePX;
ScaleY:= SizeY / ABitmap.Height / ScalePY;
if ScaleX < ScaleY then
Scale:= ScaleX
else
Scale:= ScaleY;
if (not AFitToPage) or (AFitOnlyLarger and (Scale > 1.0)) then
Scale:= 1.0;
RectSizeX:= Trunc(ABitmap.Width * Scale * ScalePX);
RectSizeY:= Trunc(ABitmap.Height * Scale * ScalePY);
if ACenter then
begin
RectOffsetX:= (SizeX - RectSizeX) div 2;
RectOffsetY:= (SizeY - RectSizeY) div 2;
end
else
begin
RectOffsetX:= 0;
RectOffsetY:= 0;
end;
Title:= ACaption;
try
BeginDoc;
try
for i:= 1 to ACopies do
begin
Canvas.StretchDraw(
Rect(
RectOffsetX,
RectOffsetY,
RectOffsetX + RectSizeX,
RectOffsetY + RectSizeY),
ABitmap
);
if i < ACopies then
NewPage;
end;
finally
EndDoc;
end;
except
Result:= false;
end;
end;
end;
AImage: TImage;
ACopies: word;
AFitToPage,
AFitOnlyLarger,
ACenter: boolean;
APixelsPerInch: integer;
const ACaption: string): boolean;
var
bmp: TBitmap;
begin
bmp:= TBitmap.Create;
try
bmp.PixelFormat:= pf24bit;
{$ifdef ADV_IMAGE_CONV}
if not CorrectImageToBitmap(AImage, bmp, clWhite) then
begin
Result:= false;
Exit
end;
{$else}
with AImage.Picture do
begin
bmp.Width:= Graphic.Width;
bmp.Height:= Graphic.Height;
bmp.Canvas.Draw(0, 0, Graphic);
end;
{$endif}
Result:= BitmapPrint( //Declared below
bmp,
ACopies,
AFitToPage,
AFitOnlyLarger,
ACenter,
APixelsPerInch,
ACaption);
finally
bmp.Free;
end;
end;
function BitmapPrint(
ABitmap: TBitmap;
ACopies: word;
AFitToPage,
AFitOnlyLarger,
ACenter: boolean;
APixelsPerInch: integer;
const ACaption: string): boolean;
var
Scale, ScalePX, ScalePY, ScaleX, ScaleY: Double;
SizeX, SizeY,
RectSizeX, RectSizeY, RectOffsetX, RectOffsetY: integer;
i: integer;
Begin
Result:= true;
Assert(
Assigned(ABitmap) and (ABitmap.Width>0) and (ABitmap.Height>0),
'BitmapPrint: bitmap is empty.');
if ACopies = 0 then
Inc(ACopies);
with Printer do
begin
SizeX:= PageWidth;
SizeY:= PageHeight;
ScalePX:= GetDeviceCaps(Handle, LOGPIXELSX) / APixelsPerInch;
ScalePY:= GetDeviceCaps(Handle, LOGPIXELSY) / APixelsPerInch;
ScaleX:= SizeX / ABitmap.Width / ScalePX;
ScaleY:= SizeY / ABitmap.Height / ScalePY;
if ScaleX < ScaleY then
Scale:= ScaleX
else
Scale:= ScaleY;
if (not AFitToPage) or (AFitOnlyLarger and (Scale > 1.0)) then
Scale:= 1.0;
RectSizeX:= Trunc(ABitmap.Width * Scale * ScalePX);
RectSizeY:= Trunc(ABitmap.Height * Scale * ScalePY);
if ACenter then
begin
RectOffsetX:= (SizeX - RectSizeX) div 2;
RectOffsetY:= (SizeY - RectSizeY) div 2;
end
else
begin
RectOffsetX:= 0;
RectOffsetY:= 0;
end;
Title:= ACaption;
try
BeginDoc;
try
for i:= 1 to ACopies do
begin
Canvas.StretchDraw(
Rect(
RectOffsetX,
RectOffsetY,
RectOffsetX + RectSizeX,
RectOffsetY + RectSizeY),
ABitmap
);
if i < ACopies then
NewPage;
end;
finally
EndDoc;
end;
except
Result:= false;
end;
end;
end;
Взято с Vingrad.ru http://forum.vingrad.ru
Отправить комментарий