home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / FONTSAMP / PREVIEW.PAS < prev   
Pascal/Delphi Source File  |  1998-04-14  |  4KB  |  148 lines
  1. unit Preview;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, DrawPage;
  8.  
  9. type
  10.   TPreviewForm = class(TForm)
  11.     ToolBar: TPanel;
  12.     LeftPageSB: TSpeedButton;
  13.     RightPageSB: TSpeedButton;
  14.     PrintSB: TSpeedButton;
  15.     CloseSB: TSpeedButton;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormResize(Sender: TObject);
  18.     procedure FormPaint(Sender: TObject);
  19.     procedure FormDestroy(Sender: TObject);
  20.     procedure CloseSBClick(Sender: TObject);
  21.     procedure PrintSBClick(Sender: TObject);
  22.     procedure FormActivate(Sender: TObject);
  23.     procedure LeftPageSBClick(Sender: TObject);
  24.     procedure RightPageSBClick(Sender: TObject);
  25.   private
  26.     PreBits: TBitmap;       { Preview bitmap with canvas }
  27.     PpiX, PpiY: Integer;    { Logical pixels per inch }
  28.     Page: Integer;          { One font sampler per page }
  29.     procedure InitGlobals;  { Initialize global variables }
  30.   public
  31.     FontListBox: TListBox;  { Reference to form's ListBox }
  32.   end;
  33.  
  34. var
  35.   PreviewForm: TPreviewForm;
  36.  
  37. implementation
  38.  
  39. uses Main;
  40.  
  41. {$R *.DFM}
  42.  
  43. const
  44.   border = 10;      { Top and bottom preview bitmap borders }
  45.  
  46. { Create form and a bitmap to represent the preview page }
  47. procedure TPreviewForm.FormCreate(Sender: TObject);
  48. begin
  49.   FontListBox := nil;
  50.   PreBits := TBitmap.Create;
  51. end;
  52.  
  53. { Initialize global variables and window size }
  54. procedure TPreviewForm.InitGlobals;
  55. begin
  56.   PreBits.Width := ClientWidth div 2;  { Bitmap width = 1/2 client width }
  57.   PreBits.Height := Round(1.3 * PreBits.Width);  { 1.3 = 8-1/2 x 11 ratio }
  58.   PpiX := Round(PreBits.Width / 8.5);    { Logical pixels per inch }
  59.   PpiY := Round(PreBits.Height / 11.0);  { Logical pixels per inch }
  60.   if WindowState <> wsMaximized then     { Adjust window bottom }
  61.     ClientHeight := ToolBar.Height + PreBits.Height + border * 2;
  62. end;
  63.  
  64. { Tip: OnResize is called before OnActivate, but
  65. only if the form is NOT maximized, in which case FormResize
  66. is never called. Don't use OnResize as your only
  67. display initializer--also initialize in OnActivate. }
  68. procedure TPreviewForm.FormResize(Sender: TObject);
  69. begin
  70.   InitGlobals;
  71.   DrawOnePage(PreBits.Canvas, FontListBox, Page,  { Redraw page }
  72.     PreBits.Width, Height, True, PpiX, PpiY);
  73.   Invalidate;  { Tell Windows to issue wm_Paint to form }
  74. end;
  75.  
  76. { Because the program does its own scaling, we can call Draw
  77. instead of StretchDraw as some previewers do. This keeps the
  78. display fast and keeps the text looking as wysiwyg as possible. }
  79. procedure TPreviewForm.FormPaint(Sender: TObject);
  80. begin
  81.   Canvas.Draw(ClientWidth div 4, ToolBar.Height + border, PreBits);
  82. end;
  83.  
  84. procedure TPreviewForm.FormDestroy(Sender: TObject);
  85. begin
  86.   PreBits.Free;
  87. end;
  88.  
  89. procedure TPreviewForm.CloseSBClick(Sender: TObject);
  90. begin
  91.   ModalResult := mrCancel;
  92. end;
  93.  
  94. procedure TPreviewForm.PrintSBClick(Sender: TObject);
  95. begin
  96.   ModalResult := mrOk;
  97. end;
  98.  
  99. { This procedure prepares the FontListBox, and it draws
  100. the first page (or a blank if no font is selected). The
  101. procedure also enables and disables the toolbar speed buttons }
  102. procedure TPreviewForm.FormActivate(Sender: TObject);
  103. begin
  104. { If you don't assign a ListBox to PreviewForm.FontListBox, this
  105. statement picks up the LisBox from the parent form. }
  106.   if FontListBox = nil then
  107.     FontListBox := MainForm.FontListBox;
  108. { Draw first page }
  109.   Page := 1;
  110.   InitGlobals;
  111.   DrawOnePage(PreBits.Canvas, FontListBox, Page,
  112.     PreBits.Width, Height, True, PpiX, PpiY);
  113. { Enable / disable speed buttons in toolbar }
  114.   with FontListBox do
  115.   begin
  116.     LeftPageSB.Enabled := SelCount > 1;
  117.     RightPageSB.Enabled := SelCount > 1;
  118.     PrintSB.Enabled := SelCount > 0;
  119.   end;
  120. end;
  121.  
  122. { Display previous page }
  123. procedure TPreviewForm.LeftPageSBClick(Sender: TObject);
  124. begin
  125.   if Page > 1 then
  126.   begin
  127.     Dec(Page);
  128.     DrawOnePage(PreBits.Canvas, FontListBox, Page,
  129.       PreBits.Width, Height, True, PpiX, PpiY);
  130.     Invalidate;
  131.   end;
  132. end;
  133.  
  134. { Display next page }
  135. procedure TPreviewForm.RightPageSBClick(Sender: TObject);
  136. begin
  137.   if Page < FontListBox.SelCount then
  138.   begin
  139.     Inc(Page);
  140.     DrawOnePage(PreBits.Canvas, FontListBox, Page,
  141.       PreBits.Width, Height, True, PpiX, PpiY);
  142.     Invalidate;
  143.   end;
  144. end;
  145.  
  146. end.
  147.  
  148.