home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / FONTSAMP / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-14  |  3KB  |  147 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Printers, StdCtrls, Buttons, ExtCtrls,
  8.   About, Preview, DrawPage;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     File1: TMenuItem;
  14.     PrintPreview1: TMenuItem;
  15.     PrintSetup1: TMenuItem;
  16.     Print1: TMenuItem;
  17.     N1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     Help1: TMenuItem;
  20.     About1: TMenuItem;
  21.     PrintDialog1: TPrintDialog;
  22.     PrinterSetupDialog1: TPrinterSetupDialog;
  23.     SelectAllBitBtn: TBitBtn;
  24.     PrintBitBtn: TBitBtn;
  25.     CloseBitBtn: TBitBtn;
  26.     FontListBox: TListBox;
  27.     Bevel1: TBevel;
  28.     Label1: TLabel;
  29.     PreviewBitBtn: TBitBtn;
  30.     procedure Exit1Click(Sender: TObject);
  31.     procedure About1Click(Sender: TObject);
  32.     procedure PrintSetup1Click(Sender: TObject);
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure PreviewBitBtnClick(Sender: TObject);
  35.     procedure PrintBitBtnClick(Sender: TObject);
  36.     procedure SelectAllBitBtnClick(Sender: TObject);
  37.   private
  38.     Previewing: Boolean;
  39.     { Private declarations }
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   MainForm: TMainForm;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. procedure TMainForm.Exit1Click(Sender: TObject);
  52. begin
  53.   Close;
  54. end;
  55.  
  56. procedure TMainForm.About1Click(Sender: TObject);
  57. begin
  58.   AboutForm.ShowModal;
  59. end;
  60.  
  61. procedure TMainForm.PrintSetup1Click(Sender: TObject);
  62. begin
  63.   PrinterSetupDialog1.Execute;
  64. end;
  65.  
  66. procedure TMainForm.FormCreate(Sender: TObject);
  67. begin
  68.   FontListBox.Items := Printer.Fonts;
  69.   Previewing := False;
  70. end;
  71.  
  72. procedure TMainForm.PreviewBitBtnClick(Sender: TObject);
  73. begin
  74.   if PreviewForm.ShowModal = mrOk then
  75.     PrintBitBtn.Click;  { User selected preview's print button }
  76. end;
  77.  
  78. { This is the procedure that prints the pages }
  79. procedure TMainForm.PrintBitBtnClick(Sender: TObject);
  80. var
  81.   PpiX, PpiY, Page, FirstPage, LastPage: Integer;
  82.  
  83.   { Initialize PrintDialog1 object}
  84.   procedure InitPrintDialog;
  85.   begin
  86.     with PrintDialog1 do
  87.     begin
  88.       MinPage := 1;
  89.       MaxPage := FontListBox.SelCount;
  90.       FromPage := MinPage;
  91.       ToPage := MaxPage;
  92.     end;
  93.   end;
  94.  
  95.   { Initialize printing variables }
  96.   procedure InitParameters;
  97.   begin
  98.   { Do our own scaling based on Page width and height. This
  99.   seems to be more reliable than GetDeviceCaps. }
  100.     PpiX := Trunc(Printer.PageWidth / 8.5);
  101.     PpiY := Trunc(Printer.PageHeight / 11.0);
  102.   { Set FirstPage and LastPage }
  103.     if PrintDialog1.PrintRange = prAllPages then
  104.     begin
  105.       FirstPage := 1;
  106.       LastPage := FontListBox.SelCount;
  107.     end else
  108.     begin
  109.       FirstPage := PrintDialog1.FromPage;
  110.       LastPage := PrintDialog1.ToPage;
  111.     end;
  112.   end;
  113.  
  114. begin
  115.   InitPrintDialog;
  116.   if PrintDialog1.Execute then
  117.   begin
  118.     Printer.BeginDoc;
  119.     try
  120.       InitParameters;
  121.       for Page := FirstPage to LastPage do
  122.       begin
  123.         DrawOnePage(Printer.Canvas, FontListBox, Page,
  124.           Printer.PageWidth, Printer.PageHeight, False,
  125.           PpiX, PpiY);
  126.         if Page < LastPage then
  127.           Printer.NewPage;
  128.       end;
  129.     finally
  130.       Printer.EndDoc;
  131.     end;
  132.   end;
  133.  
  134. end;
  135.  
  136. procedure TMainForm.SelectAllBitBtnClick(Sender: TObject);
  137. var
  138.   I: Integer;
  139. begin
  140.   with FontListBox, Items do
  141.   for I := 0 to Count - 1 do
  142.     Selected[I] := True;
  143. end;
  144.  
  145. end.
  146.  
  147.