home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d3456 / POWERPDF.ZIP / PowerPdf / Example / DBImage / UDbImage.pas < prev   
Pascal/Delphi Source File  |  2001-09-15  |  5KB  |  179 lines
  1. {*
  2.  * << P o w e r P d f >> -- UDbImage.pas
  3.  * << DBImage sample program >>
  4.  *
  5.  * Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
  6.  *
  7.  * 2000.09.10 create.
  8.  * 2001.09.08 change .
  9.  *}
  10. unit UDbImage;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   PReport, ExtCtrls, Menus, ComCtrls, Db, DBTables,
  17.  
  18.   // to use outline, PdfDoc and PdfTypes must be inclueded.
  19.   PdfDoc, PdfTypes;
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     StatusBar1: TStatusBar;
  24.     ScrollBox1: TScrollBox;
  25.     MainMenu1: TMainMenu;
  26.     File1: TMenuItem;
  27.     CreatePDF1: TMenuItem;
  28.     N1: TMenuItem;
  29.     Exit1: TMenuItem;
  30.     Help1: TMenuItem;
  31.     About1: TMenuItem;
  32.     PReport1: TPReport;
  33.     SaveDialog1: TSaveDialog;
  34.     PRPage1: TPRPage;
  35.     PRLayoutPanel1: TPRLayoutPanel;
  36.     PRGridPanel1: TPRGridPanel;
  37.     PRText1: TPRText;
  38.     PRRect1: TPRRect;
  39.     PRRect2: TPRRect;
  40.     PRText2: TPRText;
  41.     PRText3: TPRText;
  42.     PRText4: TPRText;
  43.     PRImage1: TPRImage;
  44.     Table1: TTable;
  45.     Table1Common_Name: TStringField;
  46.     Table1SpeciesName: TStringField;
  47.     Table1Length_In: TFloatField;
  48.     Table1Graphic: TGraphicField;
  49.     PRRect3: TPRRect;
  50.     procedure CreatePDF1Click(Sender: TObject);
  51.     procedure PRPage1PrintPage(Sender: TObject; ACanvas: TPRCanvas);
  52.     procedure FormCreate(Sender: TObject);
  53.     procedure PRGridPanel1BeforePrintChild(Sender: TObject;
  54.       ACanvas: TPRCanvas; ACol, ARow: Integer; Rect: TRect);
  55.     procedure About1Click(Sender: TObject);
  56.     procedure Exit1Click(Sender: TObject);
  57.   private
  58.     FPage: integer;
  59.     FOutline: TPROutLineEntry;
  60.   public
  61.     { Public }
  62.   end;
  63.  
  64. var
  65.   Form1: TForm1;
  66.  
  67. implementation
  68.  
  69. {$R *.DFM}
  70.  
  71. procedure TForm1.CreatePDF1Click(Sender: TObject);
  72. begin
  73.   if SaveDialog1.Execute then
  74.   begin
  75.     Screen.Cursor := crHourGlass;
  76.     Application.ProcessMessages;
  77.     try
  78.       with PReport1 do
  79.       begin
  80.         FileName := SaveDialog1.FileName;
  81.         BeginDoc;
  82.         FPage := 0;
  83.         Table1.Open;
  84.         while not Table1.Eof do
  85.           Print(PRPage1);
  86.         StatusBar1.Panels[0].Text := 'writing document..';
  87.         StatusBar1.Repaint;
  88.         EndDoc;
  89.         StatusBar1.Panels[0].Text := 'end..';
  90.         Table1.Close;
  91.       end;
  92.     finally
  93.       Screen.Cursor := crDefault;
  94.     end;
  95.   end;
  96. end;
  97.  
  98. procedure TForm1.PRPage1PrintPage(Sender: TObject; ACanvas: TPRCanvas);
  99. begin
  100.   // creating outlines (the destination set to the top of the page).
  101.   with PReport1 do
  102.   begin
  103.     // if the first page, create open-action. 
  104.     if PageNumber = 1 then
  105.     begin
  106.       OpenAction := CreateDestination;
  107.       with OpenAction do
  108.       begin
  109.         DestinationType := dtXYZ;
  110.         Zoom := 1;
  111.       end;
  112.     end;
  113.     FOutline := OutlineRoot.AddChild;
  114.     FOutline.Dest := CreateDestination;
  115.     FOutline.Dest.Top := 0;
  116.     FOutline.Title := 'Page ' + IntToStr(PReport1.PageNumber);
  117.   end;
  118. end;
  119.  
  120. procedure TForm1.FormCreate(Sender: TObject);
  121. begin
  122.   PRPage1.Visible := false;
  123. end;
  124.  
  125. procedure TForm1.PRGridPanel1BeforePrintChild(Sender: TObject;
  126.   ACanvas: TPRCanvas; ACol, ARow: Integer; Rect: TRect);
  127. begin
  128.   with Table1 do
  129.     if not Table1.Eof then
  130.     begin
  131.       inc(FPage);
  132.       // setting status bar text.
  133.       StatusBar1.Panels[0].Text := 'creating page ' + IntToStr(FPage);
  134.       StatusBar1.Repaint;
  135.  
  136.       // setting text from current record.
  137.       PRText2.Text := Table1Common_Name.AsString;
  138.       PRText3.Text := Table1SpeciesName.AsString;
  139.       PRText4.Text := 'Length_In: ' + FormatFloat('##0.#0', Table1Length_In.AsFloat);
  140.  
  141.       // creating outline entry
  142.       with PReport1 do
  143.       begin
  144.         with FOutline.AddChild do
  145.         begin
  146.           // create destination and set the properties.
  147.           Dest := CreateDestination;
  148.           Dest.Top := Rect.Top;
  149.           Dest.Left := Rect.Left;
  150.           Title := PRText2.Text;
  151.         end;
  152.       end;
  153.  
  154.       // setting image..
  155.       PRImage1.Picture.Assign(Table1Graphic);
  156.       Table1.Next;
  157.     end
  158.     else
  159.     begin
  160.       PRText2.Text := '';
  161.       PRText3.Text := '';
  162.       PRText4.Text := '';
  163.       PRRect2.Printable := false;
  164.       PRImage1.Printable := false;
  165.     end;
  166. end;
  167.  
  168. procedure TForm1.About1Click(Sender: TObject);
  169. begin
  170.   ShowMessage(POWER_PDF_VERSION_STR + #13#10 + POWER_PDF_COPYRIGHT);
  171. end;
  172.  
  173. procedure TForm1.Exit1Click(Sender: TObject);
  174. begin
  175.   Close;
  176. end;
  177.  
  178. end.
  179.