home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d3456 / POWERPDF.ZIP / PowerPdf / PRJpegImage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-15  |  2.8 KB  |  92 lines
  1. {*
  2.  * << P o w e r P d f >> -- PRJpegImage.pas
  3.  *
  4.  * Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
  5.  *
  6.  * This library is free software; you can redistribute it and/or modify it
  7.  * under the terms of the GNU Library General Public License as published
  8.  * by the Free Software Foundation; either version 2 of the License, or any
  9.  * later version.
  10.  *
  11.  * This library is distributed in the hope that it will be useful, but WITHOUT
  12.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13.  * FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
  14.  * details.
  15.  *
  16.  * You should have received a copy of the GNU Library General Public License
  17.  * along with this library.
  18.  *
  19.  * 2001.07.01 create
  20.  * 2001.09.07 changes the implementation of TPdfImageCreator.
  21.  *
  22.  *}
  23. unit PRJpegImage;
  24.  
  25. interface
  26.  
  27. uses
  28.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  29.   PReport, PdfDoc, PdfTypes, PdfImages, PdfJpegImage, JPEG;
  30.  
  31. type
  32.   TPRJpegImage = class(TPRImage)
  33.   protected
  34.     procedure SetPicture(Value: TPicture); override;
  35.     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  36.   end;
  37.  
  38. implementation
  39.  
  40. // Print
  41. procedure TPRJpegImage.Print(ACanvas: TPRCanvas; ARect: TRect);
  42. var
  43.   FDoc: TPdfDoc;
  44.   FXObjectName: string;
  45.   i: integer;
  46. begin
  47.   if not Printable then Exit;
  48.  
  49.   if (FPicture = nil) or (FPicture.Graphic = nil) or
  50.    (FPicture.Graphic.Empty) or not (FPicture.Graphic is TJpegImage) then
  51.     Exit;
  52.   FDoc := ACanvas.PdfCanvas.Doc;
  53.   if SharedImage then
  54.   begin
  55.     FXObjectName := Self.Name;
  56.     if FDoc.GetXObject(FXObjectName) = nil then
  57.       FDoc.AddXObject(FXObjectName, CreatePdfImage(FPicture.Graphic, 'Pdf-Jpeg'));
  58.   end
  59.   else
  60.   begin
  61.     for i := 1 to MAX_IMAGE_NUMBER do
  62.     begin
  63.       FXObjectName := Self.Name + IntToStr(Random(MAX_IMAGE_NUMBER));
  64.       if FDoc.GetXObject(FXObjectName) = nil then Break;
  65.       if i = MAX_IMAGE_NUMBER then
  66.         raise Exception.Create('image count over max value..');
  67.     end;
  68.     FDoc.AddXObject(FXObjectName, CreatePdfImage(FPicture.Graphic, 'Pdf-Jpeg'));
  69.   end;
  70.   with ARect, ACanvas.PdfCanvas do
  71.     if FStretch then
  72.       DrawXObject(Left, Self.Page.Height - Bottom, Width, Height, FXObjectName)
  73.     else
  74.       DrawXObjectEx(Left, Self.Page.Height - Top - FPicture.Height,
  75.             FPicture.Width, FPicture.Height,
  76.             Left, Self.Page.Height - Top - Height, Width, Height, FXObjectName);
  77. end;
  78.  
  79. // SetPicture
  80. procedure TPRJpegImage.SetPicture(Value: TPicture);
  81. begin
  82.   if (Value = nil) or (Value.Graphic = nil) or (Value.Graphic is TJpegImage) then
  83.   begin
  84.     FPicture.Assign(Value);
  85.     Invalidate;
  86.   end
  87.   else
  88.     raise exception.Create('only jpeg image is allowed.');
  89. end;
  90.  
  91. end.
  92.