home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / RAPREVW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-04  |  9.9 KB  |  331 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit RaPrevw;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   ExtCtrls, StdCtrls, Spin, Buttons, ComCtrls, Quickrpt, qrprntr, Mask;
  33.  
  34. type
  35.   TfmPreView = class(TForm)
  36.     QRPreview: TQRPreview;
  37.     cbZoom: TComboBox;
  38.     sePageNo: TSpinEdit;
  39.     rgZoom: TRadioGroup;
  40.     paTop: TPanel;
  41.     paMiddle: TPanel;
  42.     paBottom: TPanel;
  43.     ProgressBar: TProgressBar;
  44.     StatusBar: TStatusBar;
  45.     Timer: TTimer;
  46.     bbPrint: TSpeedButton;
  47.     bbSave: TSpeedButton;
  48.     SaveDialog: TSaveDialog;
  49.     PrintDialog: TPrintDialog;
  50.     procedure FormShow(Sender: TObject);
  51.     procedure bbPrintClick(Sender: TObject);
  52.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  53.       Shift: TShiftState);
  54.     procedure sePageNoChange(Sender: TObject);
  55.     procedure QRPreviewProgressUpdate(Sender: TObject; Progress: Integer);
  56.     procedure rgZoomClick(Sender: TObject);
  57.     procedure FormResize(Sender: TObject);
  58.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  59.     procedure cbZoomChange(Sender: TObject);
  60.     procedure FormCreate(Sender: TObject);
  61.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  62.     procedure cbZoomKeyDown(Sender: TObject; var Key: Word;
  63.       Shift: TShiftState);
  64.     procedure FormPaint(Sender: TObject);
  65.     procedure TimerTimer(Sender: TObject);
  66.     procedure sePageNoEnter(Sender: TObject);
  67.     procedure bbSaveClick(Sender: TObject);
  68.   private
  69.     IAmLoaded: boolean;
  70.   end;
  71.  
  72. implementation
  73.  
  74. uses StdUtils, Printers, QRaCtrls;
  75.  
  76. {$R *.DFM}
  77.  
  78. procedure TfmPreView.FormShow(Sender: TObject);
  79. begin
  80.   sePageNo.MaxValue := 1;
  81.   sePageNo.MinValue := 1;
  82.   sePageNo.Value := 1;
  83. end;
  84.  
  85. procedure TfmPreView.bbPrintClick(Sender: TObject);
  86.  
  87.   procedure SetPrinterPaperSize(ASize: TQRPaperSize);
  88.   var ADeviceMode: PDeviceMode;
  89.       hDevMode: HGLOBAL;
  90.       hDevNames: HGLOBAL;
  91.   begin
  92.      stdUtils.GetPrinter(hDevMode, hDevNames);
  93.      ADeviceMode := GlobalLock(hDevMode);
  94.      try
  95.        if ASize = Custom then
  96.           ADeviceMode^.dmPaperSize := 256
  97.          else
  98.           ADeviceMode^.dmPaperSize := ord(ASize);
  99.        //QRPreview.QrPrinter.Copies := ADeviceMode^.dmCopies;
  100.      finally
  101.        GlobalUnLock(hDevMode)
  102.      end;
  103.   end;
  104.  
  105. var ASize: TQRPaperSize;
  106.     i: integer;
  107. begin
  108.   //cbZoom.SetFocus;
  109.   Owner.Tag := 1;
  110.   ASize := QRPreview.QrPrinter.PaperSize;
  111.   QRPreview.QrPrinter.PrintSetup;
  112.   SetPrinterPaperSize(ASize);
  113.   if Owner.Tag=0 then
  114.   begin
  115.     if not (pcCopies in Printer.Capabilities) then
  116.       for i := 1 to Printer.Copies-1 do
  117.       begin
  118.          QRPreview.QrPrinter.Print;
  119.          Application.ProcessMessages;
  120.          while Printer.Printing do
  121.            Application.ProcessMessages;
  122.       end;
  123.     QRPreview.QrPrinter.Print;
  124.   end;
  125. end;
  126.  
  127. procedure TfmPreView.FormKeyDown(Sender: TObject; var Key: Word;
  128.   Shift: TShiftState);
  129. var APosition: Integer;
  130. begin
  131.   case Key of
  132.      VK_PRIOR:
  133.        if Shift = [] then
  134.        begin
  135.          if QRPreview.PageNumber > 1 then
  136.           sePageNo.Value := sePageNo.Value-1;
  137.        end;
  138.      VK_NEXT:
  139.        if Shift = [] then
  140.        begin
  141.          if QRPreview.PageNumber < sePageNo.MaxValue then
  142.           sePageNo.Value := sePageNo.value+1;
  143.        end;
  144.      VK_HOME:
  145.          if Shift = [ssCtrl] then
  146.          if sePageNo.MaxValue > 0 then
  147.            sePageNo.Value := 1;
  148.      VK_END:
  149.          if Shift = [ssCtrl] then
  150.          if sePageNo.MaxValue > 0 then
  151.            sePageNo.Value := sePageNo.MaxValue;
  152.      VK_ESCAPE:
  153.          Close;
  154.      VK_DOWN:
  155.         if (Shift = []) and not cbZoom.DroppedDown then
  156.         begin
  157.           APosition := QrPreview.VertScrollBar.Position;
  158.           QrPreview.VertScrollBar.Position :=
  159.                   QrPreview.VertScrollBar.Position+round(16*QrPreview.Zoom/100);
  160.           if QrPreview.VertScrollBar.Position = APosition then
  161.             if QRPreview.PageNumber < sePageNo.MaxValue then
  162.                sePageNo.Value := sePageNo.value+1;
  163.           Key := 0;
  164.         end;
  165.      VK_UP:
  166.         if (Shift = []) and not cbZoom.DroppedDown then
  167.         begin
  168.           if QrPreview.VertScrollBar.Position = 0 then
  169.             if QRPreview.PageNumber > 1 then
  170.             begin
  171.                sePageNo.Value := sePageNo.value-1;
  172.                QrPreview.VertScrollBar.Position := QrPreview.VertScrollBar.Range;
  173.                Key := 0;
  174.                exit;
  175.             end;
  176.           APosition :=
  177.                 QrPreview.VertScrollBar.Position-round(16*QrPreview.Zoom/100);
  178.           if APosition < 0 then
  179.              APosition := 0;
  180.           QrPreview.VertScrollBar.Position := APosition;
  181.           Key := 0;
  182.         end;
  183.   end;
  184.   if Key in [VK_PRIOR,VK_NEXT,VK_HOME,VK_END] then
  185.      QRPreview.PageNumber:=sePageNo.Value;
  186. end;
  187.  
  188. procedure TfmPreView.sePageNoChange(Sender: TObject);
  189. begin
  190.   with sePageNo do
  191.   begin
  192.     if MaxValue < Value then
  193.        Value := MaxValue;
  194.     if MinValue > Value then
  195.        Value := MinValue;
  196.     if Text <> '' then
  197.      QRPreview.PageNumber := Value;
  198.   end;
  199. end;
  200.  
  201. procedure TfmPreView.QRPreviewProgressUpdate(Sender: TObject;
  202.   Progress: Integer);
  203. var
  204.   S: string;
  205. begin
  206.   sePageNo.MaxValue := QRPreView.QRPrinter.PageCount;
  207.   str(sePageNo.MaxValue,S);
  208.   StatusBar.Panels[0].Text:= 'Page count: ' + S;
  209.   ProgressBar.Position := Progress;
  210.   if Progress = 100 then
  211.     ProgressBar.Position := 0;
  212.   bbPrint.Enabled := Progress = 100;
  213.   bbSave.Enabled := bbPrint.Enabled;
  214.   if Progress < 100 then
  215.      StatusBar.Panels[1].Text := 'Please wait...'
  216.     else
  217.      StatusBar.Panels[1].Text := 'Ready';
  218. end;
  219.  
  220. procedure TfmPreView.rgZoomClick(Sender: TObject);
  221. var
  222.   S: String;
  223. begin
  224.   cbZoom.SetFocus;
  225.   case rgZoom.ItemIndex of
  226.      0: QRPreview.ZoomToFit;
  227.      1: QRPreview.ZoomToWidth;
  228.     else
  229.       exit;
  230.   end;
  231.   Str(QRPreview.Zoom, S);
  232.   cbZoom.Text := S + '%';
  233. end;
  234.  
  235. procedure TfmPreView.FormResize(Sender: TObject);
  236. var s : string;
  237. begin
  238.   Str(QRPreview.Zoom, S);
  239.   cbZoom.Text := S + '%';
  240.   ProgressBar.Width := StatusBar.Width-
  241.                        (StatusBar.Panels[0].Width+StatusBar.Panels[1].Width+3);
  242. end;
  243.  
  244. procedure TfmPreView.FormClose(Sender: TObject; var Action: TCloseAction);
  245. begin
  246.   Action := caFree;
  247. end;
  248.  
  249. procedure TfmPreView.cbZoomChange(Sender: TObject);
  250. begin
  251.   Timer.Enabled := False;
  252.   Timer.Enabled := True;
  253. end;
  254.  
  255. procedure TfmPreView.FormCreate(Sender: TObject);
  256. var ADir : array[0..80] of char;
  257. begin
  258.   GetTempPath(30, ADir);
  259.   SaveDialog.InitialDir := ADir;
  260.   if Owner is TQuickRep then
  261.      QrPreview.QRPrinter := (Owner as TQuickRep).QRPrinter;
  262. end;
  263.  
  264. procedure TfmPreView.FormKeyPress(Sender: TObject; var Key: Char);
  265. begin
  266.    if Key = Char(VK_ESCAPE) then
  267.       Key := #0;
  268. end;
  269.  
  270. procedure TfmPreView.cbZoomKeyDown(Sender: TObject; var Key: Word;
  271.   Shift: TShiftState);
  272. begin
  273.   if Key in [VK_PRIOR,VK_NEXT,VK_HOME,VK_END] then
  274.      Key := 0;
  275. end;
  276.  
  277. procedure TfmPreView.FormPaint(Sender: TObject);
  278. begin
  279.   if not IAmLoaded then
  280.   begin
  281.     IAmLoaded := True;
  282.     rgZoom.ItemIndex := 1;
  283.     rgZoomClick(Sender);
  284.     FormResize(Sender);
  285.   end;
  286. end;
  287.  
  288. procedure TfmPreView.TimerTimer(Sender: TObject);
  289. var
  290.   I, Code: Integer;
  291.   S: String;
  292. begin
  293.   Timer.Enabled := False;
  294.   S := cbZoom.Text;
  295.   if Pos('%',S) > 0 then
  296.   S := Copy(S,1,Pos('%',S)-1);
  297.   Val(S, I, Code);
  298.   if Code = 0 then
  299.   begin
  300.     Code := cbZoom.SelStart;
  301.     cbZoom.Text := S + '%';
  302.     if (QRPreview.Zoom <> I) then
  303.     begin
  304.       if not cbZoom.DroppedDown then
  305.       begin
  306.         cbZoom.SelStart := Code;
  307.         cbZoom.SelLength := 0;
  308.       end;
  309.       if I <> QRPreview.Zoom then
  310.       begin
  311.          rgZoom.ItemIndex := -1;
  312.          QRPreview.Zoom := I;
  313.       end;
  314.     end;
  315.   end;
  316. end;
  317.  
  318. procedure TfmPreView.sePageNoEnter(Sender: TObject);
  319. begin
  320.    cbZoom.SetFocus;
  321. end;
  322.  
  323. procedure TfmPreView.bbSaveClick(Sender: TObject);
  324. begin
  325.    SaveDialog.FileName := QRPreview.QRPrinter.Title;
  326.    if SaveDialog.Execute then
  327.      QRPreview.QRPrinter.ExportToFilter(TQRaAsciiExportFilter.Create(SaveDialog.FileName));
  328. end;
  329.  
  330. end.
  331.