home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d3456 / PREVIEW.ZIP / Demo / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-05-11  |  11.9 KB  |  360 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   StdCtrls, ExtCtrls, Tabs, Preview, Dialogs, jpeg;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Toolbar: TPanel;
  12.     ZoomComboBox: TComboBox;
  13.     PrintButton: TButton;
  14.     Label1: TLabel;
  15.     Image1: TImage;
  16.     PrintPreview: TPrintPreview;
  17.     UnitComboBox: TComboBox;
  18.     Label2: TLabel;
  19.     FastPrintCheckBox: TCheckBox;
  20.     Image2: TImage;
  21.     AutoScrollCheckBox: TCheckBox;
  22.     PageNavigator: TTabSet;
  23.     PrinterSetupDialog: TPrinterSetupDialog;
  24.     SaveButton: TButton;
  25.     LoadButton: TButton;
  26.     OpenDialog: TOpenDialog;
  27.     SaveDialog: TSaveDialog;
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure FormActivate(Sender: TObject);
  30.     procedure ZoomComboBoxChange(Sender: TObject);
  31.     procedure UnitComboBoxChange(Sender: TObject);
  32.     procedure AutoScrollCheckBoxClick(Sender: TObject);
  33.     procedure FastPrintCheckBoxClick(Sender: TObject);
  34.     procedure PrintButtonClick(Sender: TObject);
  35.     procedure SaveButtonClick(Sender: TObject);
  36.     procedure LoadButtonClick(Sender: TObject);
  37.     procedure PageNavigatorChange(Sender: TObject; NewTab: Integer;
  38.       var AllowChange: Boolean);
  39.     procedure PrintPreviewChange(Sender: TObject);
  40.     procedure PrintPreviewBeforePrint(Sender: TObject);
  41.     procedure PrintPreviewPrintProgress(Sender: TObject; PageNum,
  42.       Progress: Integer; var AbortIt: Boolean);
  43.     procedure PrintPreviewAfterPrint(Sender: TObject);
  44.     procedure PrintPreviewNewPage(Sender: TObject);
  45.     procedure PrintPreviewBeginDoc(Sender: TObject);
  46.     procedure PrintPreviewEndDoc(Sender: TObject);
  47.   private
  48.     FirstActivation: Boolean;
  49.     procedure CreateImageTextPage;
  50.     procedure CreateImageOnlyPage;
  51.     procedure CreatePages;
  52.   end;
  53.  
  54. var
  55.   MainForm: TMainForm;
  56.  
  57. implementation
  58.  
  59. uses Windows;
  60.  
  61. {$R *.DFM}
  62.  
  63. procedure TMainForm.FormCreate(Sender: TObject);
  64. begin
  65.   Randomize;
  66.   PrintPreview.ZoomState := zsZoomToFit;
  67.   ZoomComboBox.ItemIndex := 6; // Zoom to Fit (Whole Page)
  68.   UnitComboBox.ItemIndex := Ord(PrintPreview.Units);
  69.   FastPrintCheckBox.Checked := PrintPreview.FastPrint;
  70.   AutoScrollCheckBox.Checked := PrintPreview.AutoScroll;
  71.   FirstActivation := True;
  72. end;
  73.  
  74. procedure TMainForm.FormActivate(Sender: TObject);
  75. begin
  76.   if FirstActivation then
  77.   begin
  78.     FirstActivation := False;
  79.     Update;
  80.     CreatePages;
  81.   end;
  82. end;
  83.  
  84. procedure TMainForm.ZoomComboBoxChange(Sender: TObject);
  85. begin
  86.   case ZoomComboBox.ItemIndex of
  87.     0: PrintPreview.Zoom := 50;
  88.     1: PrintPreview.Zoom := 100;
  89.     2: PrintPreview.Zoom := 150;
  90.     3: PrintPreview.Zoom := 200;
  91.     4: PrintPreview.ZoomState := zsZoomToWidth;
  92.     5: PrintPreview.ZoomState := zsZoomToHeight;
  93.     6: PrintPreview.ZoomState := zsZoomToFit;
  94.   end;
  95. end;
  96.  
  97. procedure TMainForm.UnitComboBoxChange(Sender: TObject);
  98. begin
  99.   CreatePages;
  100. end;
  101.  
  102. procedure TMainForm.AutoScrollCheckBoxClick(Sender: TObject);
  103. begin
  104.   PrintPreview.AutoScroll := AutoScrollCheckBox.Checked;
  105. end;
  106.  
  107. procedure TMainForm.FastPrintCheckBoxClick(Sender: TObject);
  108. begin
  109.   PrintPreview.FastPrint := FastPrintCheckBox.Checked;
  110. end;
  111.  
  112. procedure TMainForm.PrintButtonClick(Sender: TObject);
  113. begin
  114.   if (PrintPreview.State = psReady) and PrinterSetupDialog.Execute then
  115.     PrintPreview.Print;
  116. end;
  117.  
  118. procedure TMainForm.SaveButtonClick(Sender: TObject);
  119. begin
  120.   if SaveDialog.Execute then
  121.   begin
  122.     Screen.Cursor := crHourglass;
  123.     Caption := Application.Title + ' - Saving to file...';
  124.     try
  125.       PrintPreview.SaveToFile(SaveDialog.FileName);
  126.     finally
  127.       Caption := Application.Title;
  128.       Screen.Cursor := crDefault;
  129.     end;
  130.   end;
  131. end;
  132.  
  133. procedure TMainForm.LoadButtonClick(Sender: TObject);
  134. begin
  135.   if OpenDialog.Execute then
  136.   begin
  137.     Screen.Cursor := crHourglass;
  138.     Caption := Application.Title + ' - Loading from file...';
  139.     try
  140.       PrintPreview.LoadFromFile(OpenDialog.FileName);
  141.     finally
  142.       Caption := Application.Title;
  143.       Screen.Cursor := crDefault;
  144.     end;
  145.   end;
  146. end;
  147.  
  148. procedure TMainForm.PageNavigatorChange(Sender: TObject; NewTab: Integer;
  149.   var AllowChange: Boolean);
  150. begin
  151.   PrintPreview.CurrentPage := NewTab + 1;
  152. end;
  153.  
  154. procedure TMainForm.PrintPreviewChange(Sender: TObject);
  155. begin
  156.   while PageNavigator.Tabs.Count < PrintPreview.TotalPages do
  157.     PageNavigator.Tabs.Add(IntToStr(PageNavigator.Tabs.Count + 1));
  158.   while PageNavigator.Tabs.Count > PrintPreview.TotalPages do
  159.     PageNavigator.Tabs.Delete(PageNavigator.Tabs.Count - 1);
  160.   PageNavigator.TabIndex := PrintPreview.CurrentPage - 1;
  161.  
  162.   if PrintPreview.State = psReady then
  163.   begin
  164.     PrintButton.Enabled := PrintPreview.PrinterInstalled and (PrintPreview.TotalPages > 0);
  165.     SaveButton.Enabled := (PrintPreview.TotalPages > 0);
  166.   end;
  167. end;
  168.  
  169. procedure TMainForm.PrintPreviewBeginDoc(Sender: TObject);
  170. begin
  171.   Caption := Application.Title + ' - Creating pages...';
  172.  
  173.   UnitComboBox.Enabled := False;
  174.   PrintButton.Enabled := False;
  175.   SaveButton.Enabled := False;
  176.   LoadButton.Enabled := False;
  177. end;
  178.  
  179. procedure TMainForm.PrintPreviewEndDoc(Sender: TObject);
  180. begin
  181.   Caption := Application.Title;
  182.  
  183.   UnitComboBox.Enabled := True;
  184.   PrintButton.Enabled := PrintPreview.PrinterInstalled and (PrintPreview.TotalPages > 0);
  185.   SaveButton.Enabled := (PrintPreview.TotalPages > 0);
  186.   LoadButton.Enabled := True;
  187. end;
  188.  
  189. procedure TMainForm.PrintPreviewBeforePrint(Sender: TObject);
  190. begin
  191.   Screen.Cursor := crHourglass;
  192.   Caption := Application.Title + ' - Preparing to print...';
  193.  
  194.   UnitComboBox.Enabled := False;
  195.   PrintButton.Enabled := False;
  196.   SaveButton.Enabled := False;
  197.   LoadButton.Enabled := False;
  198.   FastPrintCheckBox.Enabled := False;
  199. end;
  200.  
  201. procedure TMainForm.PrintPreviewAfterPrint(Sender: TObject);
  202. begin
  203.   Caption := Application.Title;
  204.   Screen.Cursor := crDefault;
  205.  
  206.   UnitComboBox.Enabled := True;
  207.   PrintButton.Enabled := PrintPreview.PrinterInstalled and (PrintPreview.TotalPages > 0);
  208.   SaveButton.Enabled := (PrintPreview.TotalPages > 0);
  209.   LoadButton.Enabled := True;
  210.   FastPrintCheckBox.Enabled := True;
  211. end;
  212.  
  213. procedure TMainForm.PrintPreviewPrintProgress(Sender: TObject; PageNum,
  214.   Progress: Integer; var AbortIt: Boolean);
  215. begin
  216.   Caption := Format('%s - Printing page %d of %d (%%%d done)...',
  217.     [Application.Title, PageNum, PrintPreview.TotalPages, Progress]);
  218.   Update;
  219. end;
  220.  
  221. // In this example, the code is independent of the Units property of
  222. // PrintPreview. If you use only one measuremnt unit for PrintPreview, you can
  223. // easily use constant values instead of passing them to ConvertUnit method.
  224. // In addition, precision of mmLoEnglish unit is not enough for choosing small
  225. // font size (the smallest font can be 1/10"), so in this example I have used
  226. // different code for mmLoEnglish.
  227.  
  228. procedure TMainForm.PrintPreviewNewPage(Sender: TObject);
  229. var
  230.   R: TRect;
  231. begin
  232.   with PrintPreview do
  233.   begin
  234.     // The following line ensures one pixel pen width in any mapping mode.
  235.     Canvas.Pen.Width := 0;
  236.     Canvas.Brush.Style := bsCLear;
  237.     // We are going to draw a rectangular frame on the page with 1cm distance
  238.     // from edges of the paper.
  239.     SetRect(R, 0, 0, PaperWidth, PaperHeight);
  240.     InflateRect(R, -ConvertUnit(1000, mmHiMetric, Units),
  241.                    -ConvertUnit(1000, mmHiMetric, Units));
  242.     Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  243.     // Here we write the page number on bottom left corner of the page
  244.     if Units <> mmLoEnglish then
  245.       Canvas.Font.Height := -ConvertUnit(500, mmHiMetric, Units)
  246.     else
  247.       Canvas.Font.Height := -2;
  248.     SetTextAlign(Canvas.Handle, TA_RIGHT or TA_TOP);
  249.     Canvas.TextOut(R.Right, R.Bottom, Format('Page %d', [TotalPages+1]));
  250.     // Restores text alignment to the default state
  251.     SetTextAlign(Canvas.Handle, TA_LEFT or TA_TOP);
  252.   end;
  253. end;
  254.  
  255. procedure TMainForm.CreateImageTextPage;
  256. var
  257.   R: TRect;
  258. begin
  259.   with PrintPreview do
  260.   begin
  261.     // To draw the image, first we should calculate the image's bound rectangle.
  262.     // For this purpose we have to convert the image's dimensions from screen's
  263.     // pixels/resolution to printer's unit/resolution. In this example, the image
  264.     // is scaled two times smaller than its actual size.
  265.     SetRect(R, 0, 0, Screen2PrinterUnit(Image1.Width) div 2,
  266.                      Screen2PrinterUnit(Image1.Height) div 2);
  267.     // We place the image rectangle horizontally in center of the paper and
  268.     // vertically 2cm far from top of the paper.
  269.     OffsetRect(R, (PaperWidth - R.Right) div 2,
  270.                   ConvertUnit(2000, mmHiMetric, Units));
  271.     // We draw the image here.
  272.     Canvas.StretchDraw(R, Image1.Picture.Graphic);
  273.     // We are going to draw a frame and write some sample text inside it.
  274.     // For the frame's side and bottom margins we consider 2cm and for edges of
  275.     // the paper, and for top position, 1cm under the image.
  276.     SetRect(R, ConvertUnit(2000, mmHiMetric, Units),
  277.                R.Bottom + ConvertUnit(1000, mmHiMetric, Units),
  278.                PaperWidth - ConvertUnit(2000, mmHiMetric, Units),
  279.                PaperHeight - ConvertUnit(2000, mmHiMetric, Units));
  280.     // Here, we draw the frame.
  281.     Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  282.     // To write the frame's dimensions under the frame, we use a font with 5mm
  283.     // height. When unit is mmLoEnglish we set the font height to 0.2".
  284.     if Units <> mmLoEnglish then
  285.       Canvas.Font.Height := -ConvertUnit(500, mmHiMetric, Units)
  286.     else
  287.       Canvas.Font.Height := -2;
  288.     Canvas.TextOut(R.Left, R.Bottom, Format('%d (%s) x %d (%s)',
  289.       [R.Right - R.Left, UnitComboBox.Items[UnitComboBox.ItemIndex],
  290.        R.Bottom - R.Top, UnitComboBox.Items[UnitComboBox.ItemIndex]]));
  291.     // For the first line of the sample text, we set the font height to 0.8mm.
  292.     // Of course, when the unit is mmLoEnglish, the smallest font height cannot
  293.     // be smaller than 0.2".
  294.     if Units <> mmLoEnglish then
  295.       Canvas.Font.Height := -ConvertUnit(80, mmHiMetric, Units)
  296.     else
  297.       Canvas.Font.Height := -2;
  298.     // While we have not reached to the frame's bottom...
  299.     while R.Top - Canvas.Font.Height < R.Bottom do
  300.     begin
  301.       // Randomly we select a font color
  302.       Canvas.Font.Color := RGB(Random(256), Random(256), Random(256));
  303.       // draw the text,
  304.       Canvas.TextRect(R, R.Left, R.Top, 'Powered by Borland Delphi.');
  305.       // move the frame's top to the next line,
  306.       Inc(R.Top, -Canvas.Font.Height);
  307.       // and we increase the font height by 0.5mm. if unit is mmLoEnglish, we
  308.       // increase it by 0.1".
  309.       if Units <> mmLoEnglish then
  310.         Canvas.Font.Height := Canvas.Font.Height - ConvertUnit(50, mmHiMetric, Units)
  311.       else
  312.         Canvas.Font.Height := Canvas.Font.Height - 1;
  313.     end;
  314.   end;
  315. end;
  316.  
  317. procedure TMainForm.CreateImageOnlyPage;
  318. var
  319.   R: TRect;
  320. begin
  321.   with PrintPreview do
  322.   begin
  323.     // To draw the image, first we should calculate the image's bound rectangle.
  324.     // For this purpose we have to convert the image's dimensions from screen's
  325.     // pixels/resolution to printer's unit/resolution. In this example, the image
  326.     // is scaled two times larger than its actual size.
  327.     SetRect(R, 0, 0, Screen2PrinterUnit(Image2.Width) * 2,
  328.                      Screen2PrinterUnit(Image2.Height) * 2);
  329.     // We place the rectangle in center of the paper
  330.     OffsetRect(R, (PaperWidth - R.Right) div 2,
  331.                   (PaperHeight - R.Bottom) div 2);
  332.     // We draw the image here.
  333.     Canvas.StretchDraw(R, Image2.Picture.Graphic);
  334.   end;
  335. end;
  336.  
  337. procedure TMainForm.CreatePages;
  338. var
  339.   I: Integer;
  340. begin
  341.   with PrintPreview do
  342.   begin
  343.     Units := TUnits(UnitComboBox.ItemIndex);
  344.     BeginDoc;
  345.     for I := 1 to Random(10)+2 do // At least 2 and at most 11 pages
  346.     begin
  347.       if I > 1 then NewPage;
  348.       if Odd(I) then
  349.         CreateImageTextPage
  350.       else
  351.         CreateImageOnlyPage;
  352.       Application.ProcessMessages;
  353.     end;
  354.     EndDoc;
  355.   end;
  356. end;
  357.  
  358. end.
  359.  
  360.