home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d345 / PPREV.ZIP / BenPreview / Demo / TestPrev.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-09-29  |  5.0 KB  |  197 lines
  1. unit TestPrev;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Printers, Spin, ComCtrls, PrevPrinter;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel2: TPanel;
  12.     FontDialog1: TFontDialog;
  13.     OpenDialog1: TOpenDialog;
  14.     ShowGridBox: TCheckBox;
  15.     ZoomBox: TComboBox;
  16.     Label1: TLabel;
  17.     PageControl1: TPageControl;
  18.     TabSheet1: TTabSheet;
  19.     Panel1: TPanel;
  20.     TestBut: TButton;
  21.     FontBut: TButton;
  22.     LoadBut: TButton;
  23.     OwnerDrawBox: TCheckBox;
  24.     Label2: TLabel;
  25.     PageSetupBut: TButton;
  26.     StatusBar1: TStatusBar;
  27.     RichEdit1: TRichEdit;
  28.     Button1: TButton;
  29.     PreviewPrinter1: TPreviewPrinter;
  30.     procedure TestButClick(Sender: TObject);
  31.     procedure FontButClick(Sender: TObject);
  32.     procedure FormDestroy(Sender: TObject);
  33.     procedure LoadButClick(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure PreviewPrinter1OwnerDraw(Sender: TObject; Page,
  36.       Line: Integer; R: TRect; Canvas: TCanvas);
  37.     procedure PreviewPrinter1NewPage(Sender: TObject; Page: Integer);
  38.     procedure PreviewPrinter1OwnerHeight(Sender: TObject; Line: Integer;
  39.       var Height: Integer; var ForceNewPage: Boolean);
  40.     procedure PageSetupButClick(Sender: TObject);
  41.     procedure PreviewPrinter1Status(Sender: TObject; const StatMsg: String;
  42.       PageNum: Integer; StatusType: TStatusType);
  43.     procedure Button1Click(Sender: TObject);
  44.   private
  45.     { Private declarations }
  46.   public
  47.     { Public declarations }
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.  
  53. implementation
  54.  
  55. {$R *.DFM}
  56.  
  57. function GetScreenCap: TBitmap;
  58. var
  59.    dc : HDC;
  60.    c  : TCanvas;
  61.    R  : TRect;
  62. begin
  63.    dc := GetDC(0);
  64.    try
  65.       c := TCanvas.Create;
  66.       c.Handle := dc;
  67.       try
  68.          Result := TBitmap.Create;
  69.          Result.Width := Screen.Width;
  70.          Result.Height := Screen.Height;
  71.          R := Rect(0, 0, Screen.Width, Screen.Height);
  72.          Result.Canvas.CopyRect(R, c, R);
  73.       finally
  74.          c.Free;
  75.       end;
  76.    finally
  77.       ReleaseDC(0, dc);
  78.    end;
  79. end;
  80.  
  81. procedure TForm1.TestButClick(Sender: TObject);
  82. var
  83.    pp    : TPreviewPrinter;
  84. begin
  85.    pp := PreviewPrinter1;
  86.  
  87.    pp.ShowGrid := ShowGridBox.Checked;
  88.  
  89.    case ZoomBox.ItemIndex of
  90.       0 : pp.ZoomOption := zoFitToPage;
  91.       1 : pp.ZoomOption := zoFitToWidth;
  92.       2 : pp.ZoomOption := zoTwoPages;
  93.    end;
  94.  
  95.    pp.TextOptions.DrawStyle := dsStandard;
  96.    pp.TextOptions.BodyFont := FontDialog1.Font;
  97.  
  98.    if OwnerDrawBox.Checked then begin
  99.       pp.TextOptions.DrawStyle := dsOwnerDrawFixed;
  100.       pp.DrawStringList(RichEdit1.Lines);
  101.    end else begin
  102.       pp.DrawRichText(RichEdit1);
  103.    end;
  104.  
  105.    pp.Preview;
  106. end;
  107.  
  108.  
  109. procedure TForm1.FontButClick(Sender: TObject);
  110. begin
  111.    FontDialog1.Font := RichEdit1.Font;
  112.    if FontDialog1.Execute then
  113.       RichEdit1.Font := FontDialog1.Font;
  114. end;
  115.  
  116. procedure TForm1.FormDestroy(Sender: TObject);
  117. var
  118.    i : integer;
  119. begin
  120.    for i := ComponentCount-1 downto 0 do begin
  121.       Components[i].Free;
  122.    end;
  123. end;
  124.  
  125. procedure TForm1.LoadButClick(Sender: TObject);
  126. begin
  127.    if OpenDialog1.Execute then begin
  128.       RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
  129.       PreviewPrinter1.TextOptions.Header := OpenDialog1.FileName;
  130.    end;
  131. end;
  132.  
  133. procedure TForm1.FormCreate(Sender: TObject);
  134. begin
  135.    ZoomBox.ItemIndex := 0;
  136. end;
  137.  
  138. procedure TForm1.PreviewPrinter1OwnerDraw(Sender: TObject; Page,
  139.   Line: Integer; R: TRect; Canvas: TCanvas);
  140. begin
  141.    Canvas.Brush.Color := clLtGray;
  142.    Canvas.Pen.Width   := PreviewPrinter1.PixelsPerInchX * 1 div 72;
  143.    Canvas.Rectangle(R.Left, R.Top, R.Right-1, R.Bottom-1);
  144.    Canvas.TextRect(R, R.Left, R.Top, RichEdit1.Lines[Line]);
  145.    Canvas.Brush.Color := clWhite;
  146. end;
  147.  
  148. procedure TForm1.PreviewPrinter1NewPage(Sender: TObject; Page: Integer);
  149. begin
  150.    PreviewPrinter1.TextOptions.Footer :=
  151.       FormatDateTime('d-mmm-yy (ddd)  hh:nn ampm', Now);
  152. end;
  153.  
  154. procedure TForm1.PreviewPrinter1OwnerHeight(Sender: TObject; Line: Integer;
  155.   var Height: Integer; var ForceNewPage: Boolean);
  156. begin
  157.    ForceNewPage := (Line = 100) or (Line = 300);
  158. end;
  159.  
  160. procedure TForm1.PageSetupButClick(Sender: TObject);
  161. begin
  162.    PreviewPrinter1.PageSetupDlg;
  163. end;
  164.  
  165. procedure TForm1.PreviewPrinter1Status(Sender: TObject;
  166.   const StatMsg: String; PageNum: Integer; StatusType: TStatusType);
  167. begin
  168.    StatusBar1.Panels[0].Text := StatMsg;
  169.    Update;
  170. end;
  171.  
  172. procedure TForm1.Button1Click(Sender: TObject);
  173. var
  174.   x: LongInt;
  175. begin
  176.   Randomize;
  177.   with PreviewPrinter1 do
  178.     begin
  179.       BeginDoc;
  180.       try
  181.         for x := 1 to 50 do
  182.           begin
  183.             Canvas.Pen.Color := Random( 99999 );
  184.             Canvas.Pen.Width := UnitToX(0.015);
  185.             PreviewPrinter1.Canvas.Rectangle( Random(PageWidth),
  186.                 Random(PageHeight), Random(PageWidth),
  187.                 Random(PageHeight) );
  188.           end;
  189.       finally
  190.         EndDoc;
  191.         Preview;
  192.       end;
  193.     end;
  194. end;
  195.  
  196. end.
  197.