Вопрос # 988

Вопрос задала: Марина (статус: Посетитель)
Вопрос отправлен: 18 октября 2007, 18:36
Состояние вопроса: открыт, ответов: 2.

Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 18 октября 2007, 18:57
Оценка за ответ: 5

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 18 октября 2007, 23:26
Оценка за ответ: 4

Feniks (статус: Бакалавр), 18 октября 2007, 19:03 [#1]:

{
Печать изображения. Использует модуль 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;