VPF::Печать изображения - FAQ update - Форум программистов

Alexeyt

Дата 19.1.2007, 03:10 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 332
Регистрация: 15.9.2006
Где: около Москвы

Репутация: 1
Всего: 2

Нашел вопрос в FAQ (sources.ru), там приведен такой код:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
Begin
  Printer.BeginDoc;
  With Printer Do
   try
    ScaleX:=GetDeviceCaps(Handle,LogPixelsX) div PixelsPerInch;
    ScaleY:=GetDeviceCaps(Handle,LogPixelsY) div PixelsPerInch;
    Canvas.StretchDraw(Rect(0,0,Image1.Picture.Width*ScaleX,Image1.Picture.Height*ScaleY),Image1.Picture.Graphic);
   finally
    EndDoc;
   end;
End;

Я так понимаю, это напечатает картинку в "реальном" масштабе, т.е. таком какой виден на экране. Как модифицировать код, чтобы иметь дополнительные пар-ры:

1) FitToPage - умещать картинку в страницу принтера - пропорционально!
Если FitLargeOnly=false и картинка меньше страницы, то картинку также увеличивать.
Если FitToPage=false то ничего не умещать а пачатать как есть, 1:1.
2) FitLargeOnly - умещать только картинку, большую страницы принтера

Желательно рабочий пример, а не общие фразы "используй св-ва PageWidth, PegeHeight и высчитывай масштаб" - понятно, что надо их использовать, но я пока не сообразил что на что умножать/делить.

Спасибо!
Когда код будет готов, отошлю его в раздел FAQ.

Это сообщение отредактировал(а) Alexeyt - 19.1.2007, 03:10

Alexeyt

Дата 19.1.2007, 23:17 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 332
Регистрация: 15.9.2006
Где: около Москвы

Репутация: 1
Всего: 2

Получилось вот что:

Код


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

Это сообщение отредактировал(а) Alexeyt - 20.1.2007, 18:53

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »