home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_View.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-30  |  33KB  |  1,221 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {             Report preview               }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_View;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QExtCtrls, QButtons, QStdCtrls, QMenus, FR_Ctrls, FR_Dock, FR_Const,
  20.   QComCtrls, QImgList, QTypes, Qt;
  21.  
  22. type
  23.   TfrPreviewForm = class;
  24.   TfrPreview = class;
  25.   TfrPreviewZoom = (pzDefault, pzPageWidth, pzOnePage, pzTwoPages);
  26.   TfrPreviewButton = (pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbHelp, pbExit, pbPageSetup);
  27.   TfrPreviewButtons = set of TfrPreviewButton;
  28.  
  29.   TfrPageChangedEvent = procedure(Sender: TfrPreview; PageNo: Integer) of object;
  30.  
  31.   TfrPreview = class(TPanel)
  32.   private
  33.     FWindow: TfrPreviewForm;
  34.     FScrollBars: TScrollStyle;
  35.     FShowToolbar: Boolean;
  36.     FOnPageChanged: TfrPageChangedEvent;
  37.     function GetPage: Integer;
  38.     procedure SetPage(Value: Integer);
  39.     function GetZoom: Double;
  40.     procedure SetZoom(Value: Double);
  41.     function GetAllPages: Integer;
  42.     procedure SetScrollBars(Value: TScrollStyle);
  43.     procedure SetShowToolbar(Value: Boolean);
  44.     procedure OnInternalPageChanged(Sender: TObject);
  45.   public
  46.     constructor Create(AOwner: TComponent); override;
  47.     destructor Destroy; override;
  48.     procedure Resize; override;
  49.     procedure Connect(Doc: Pointer);
  50.     procedure Disconnect;
  51.     procedure OnePage;
  52.     procedure TwoPages;
  53.     procedure PageWidth;
  54.     procedure First;
  55.     procedure Next;
  56.     procedure Prev;
  57.     procedure Last;
  58.     procedure SaveToFile;
  59.     procedure LoadFromFile;
  60.     procedure Print;
  61.     procedure Edit;
  62.     procedure Clear;
  63.     procedure LoadFile(Name: String);
  64.     property AllPages: Integer read GetAllPages;
  65.     property Page: Integer read GetPage write SetPage;
  66.     property Zoom: Double read GetZoom write SetZoom;
  67.     property Window: TfrPreviewForm read FWindow write FWindow;
  68.   published
  69.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
  70.     property ShowToolbar: Boolean read FShowToolbar write SetShowToolbar default False;
  71.     property OnPageChanged: TfrPageChangedEvent read FOnPageChanged write FOnPageChanged;
  72.   end;
  73.  
  74.   TfrPBox = class(TPanel)
  75.   private
  76.     Down, DFlag: Boolean;
  77.     LastX, LastY: Integer;
  78.     LastClick: Integer;
  79.   public
  80.     Preview: TfrPreviewForm;
  81.     procedure Paint; override;
  82.     procedure MouseDown(Button: TMouseButton;
  83.       Shift: TShiftState; X, Y: Integer); override;
  84.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  85.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  86.       X, Y: Integer); override;
  87.     procedure DblClick; override;
  88.   end;
  89.  
  90.   TfrScaleMode = (mdNone, mdPageWidth, mdOnePage, mdTwoPages);
  91.  
  92.   TfrPreviewForm = class(TForm)
  93.     TPanel: TPanel;
  94.     ProcMenu: TPopupMenu;
  95.     N2001: TMenuItem;
  96.     N1501: TMenuItem;
  97.     N1001: TMenuItem;
  98.     N751: TMenuItem;
  99.     N501: TMenuItem;
  100.     N251: TMenuItem;
  101.     N101: TMenuItem;
  102.     N1: TMenuItem;
  103.     N2: TMenuItem;
  104.     N3: TMenuItem;
  105.     OpenDialog: TOpenDialog;
  106.     SaveDialog: TSaveDialog;
  107.     N4: TMenuItem;
  108.     N5: TMenuItem;
  109.     N6: TMenuItem;
  110.     N7: TMenuItem;
  111.     PreviewPanel: TPanel;
  112.     ScrollBox1: TScrollBox;
  113.     RPanel: TPanel;
  114.     PgUp: TfrSpeedButton;
  115.     PgDown: TfrSpeedButton;
  116.     VScrollBar: TScrollBar;
  117.     BPanel: TPanel;
  118.     Bevel1: TBevel;
  119.     Label1: TLabel;
  120.     HScrollBar: TScrollBar;
  121.     Panel1: TToolBar;
  122.     ZoomBtn: TfrTBButton;
  123.     LoadBtn: TToolButton;
  124.     SaveBtn: TToolButton;
  125.     PrintBtn: TToolButton;
  126.     HelpBtn: TToolButton;
  127.     ExitBtn: TToolButton;
  128.     MainImages: TImageList;
  129.     Panel2: TPanel;
  130.     Bevel2: TBevel;
  131.     frTBSeparator2: TToolButton;
  132.     frTBSeparator3: TToolButton;
  133.     frTBSeparator1: TToolButton;
  134.     procedure FormResize(Sender: TObject);
  135.     procedure VScrollBarChange(Sender: TObject);
  136.     procedure HScrollBarChange(Sender: TObject);
  137.     procedure PgUpClick(Sender: TObject);
  138.     procedure PgDownClick(Sender: TObject);
  139.     procedure ZoomBtnClick(Sender: TObject);
  140.     procedure N3Click(Sender: TObject);
  141.     procedure ExitBtnClick(Sender: TObject);
  142.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  143.       Shift: TShiftState);
  144.     procedure LoadBtnClick(Sender: TObject);
  145.     procedure SaveBtnClick(Sender: TObject);
  146.     procedure PrintBtnClick(Sender: TObject);
  147.     procedure FormCreate(Sender: TObject);
  148.     procedure FormDestroy(Sender: TObject);
  149.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  150.     procedure EditBtnClick(Sender: TObject);
  151.     procedure DelPageBtnClick(Sender: TObject);
  152.     procedure NewPageBtnClick(Sender: TObject);
  153.     procedure HelpBtnClick(Sender: TObject);
  154.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  155.       Shift: TShiftState; X, Y: Integer);
  156.     procedure FormActivate(Sender: TObject);
  157.     procedure FormDeactivate(Sender: TObject);
  158.     procedure HScrollBarEnter(Sender: TObject);
  159.     procedure FormShow(Sender: TObject);
  160.   private
  161.     { Private declarations }
  162.     Doc: Pointer;
  163.     EMFPages: Pointer;
  164.     PBox: TfrPBox;
  165.     CurPage: Integer;
  166.     ofx, ofy, OldV, OldH: Integer;
  167.     per: Double;
  168.     mode: TfrScaleMode;
  169.     PaintAllowed: Boolean;
  170.     HF: String;
  171.     FOnPageChanged: TNotifyEvent;
  172.     KWheel: Integer;
  173.     InitFlag: Boolean;
  174.     DoneModal: Boolean;
  175.     procedure Connect(ADoc: Pointer);
  176.     procedure ConnectBack;
  177.     procedure ShowPageNum;
  178.     procedure SetToCurPage;
  179.     procedure RedrawAll(ResetPage: Boolean);
  180.     procedure LoadFromFile(name: String);
  181.     procedure SaveToFile(name: String);
  182.     procedure InitButtons;
  183.     procedure Localize;
  184.     property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
  185.     procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  186.       MousePos: TPoint; var Handled: Boolean);
  187.     procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  188.       MousePos: TPoint; var Handled: Boolean);
  189.   public
  190.     { Public declarations }
  191.     function WantKey(Key: Integer; Shift: TShiftState;
  192.       const KeyText: WideString): Boolean; override;
  193.     procedure Show_Modal(ADoc: Pointer);
  194.   end;
  195.  
  196.  
  197. implementation
  198.  
  199. {$R *.xfm}
  200.  
  201. uses
  202.   FR_Class, QPrinters, FR_Prntr, FR_PrDlg, FR_Utils, FR_API;
  203.  
  204. type
  205.   THackControl = class(TControl)
  206.   end;
  207.  
  208. var
  209.   LastScale: Double = 1;
  210.   LastScaleMode: TfrScaleMode = mdNone;
  211.  
  212.  
  213. {----------------------------------------------------------------------------}
  214. constructor TfrPreview.Create(AOwner: TComponent);
  215. begin
  216.   inherited Create(AOwner);
  217.   FWindow := TfrPreviewForm.Create(nil);
  218.   FWindow.OnPageChanged := OnInternalPageChanged;
  219.   BevelInner := bvNone;
  220.   BevelOuter := bvLowered;
  221.   ScrollBars := ssBoth;
  222. end;
  223.  
  224. destructor TfrPreview.Destroy;
  225. begin
  226.   FWindow.Free;
  227.   inherited Destroy;
  228. end;
  229.  
  230. procedure TfrPreview.Resize;
  231. begin
  232.   inherited;
  233.   FWindow.FormResize(nil);
  234. end;
  235.  
  236. procedure TfrPreview.Connect(Doc: Pointer);
  237. var
  238.   f: TForm;
  239. begin
  240.   FWindow.PreviewPanel.Parent := Self;
  241.   if FShowToolbar then
  242.     FWindow.TPanel.Parent := Self;
  243.   FWindow.PreviewPanel.Show;
  244.   FWindow.Connect(Doc);
  245.   FWindow.InitButtons;
  246.   FWindow.PaintAllowed := True;
  247.   FWindow.InitFlag := False;
  248.   FWindow.RedrawAll(True);
  249.   if PopupMenu <> nil then
  250.     FWindow.PopupMenu := PopupMenu;
  251.   f := TForm(GetParentForm(Self));
  252.   if f <> nil then
  253.   begin
  254.     f.OnMouseWheelUp := FWindow.FormMouseWheelUp;
  255.     f.OnMouseWheelDown := FWindow.FormMouseWheelDown;
  256.   end;
  257. end;
  258.  
  259. procedure TfrPreview.Disconnect;
  260. begin
  261.   FWindow.ConnectBack;
  262. end;
  263.  
  264. function TfrPreview.GetPage: Integer;
  265. begin
  266.   Result := FWindow.CurPage;
  267. end;
  268.  
  269. procedure TfrPreview.SetPage(Value: Integer);
  270. begin
  271.   if (Value < 1) or (Value > AllPages) then Exit;
  272.   FWindow.CurPage := Value;
  273.   FWindow.SetToCurPage;
  274. end;
  275.  
  276. function TfrPreview.GetZoom: Double;
  277. begin
  278.   Result := FWindow.Per * 100;
  279. end;
  280.  
  281. procedure TfrPreview.SetZoom(Value: Double);
  282. begin
  283.   FWindow.Per := Value / 100;
  284.   FWindow.Mode := mdNone;
  285.   LastScale := FWindow.Per;
  286.   LastScaleMode := FWindow.Mode;
  287.   FWindow.FormResize(nil);
  288.   FWindow.PBox.Paint;
  289. end;
  290.  
  291. function TfrPreview.GetAllPages: Integer;
  292. begin
  293.   Result := 0;
  294.   if TfrEMFPages(FWindow.EMFPages) <> nil then
  295.     Result := TfrEMFPages(FWindow.EMFPages).Count;
  296. end;
  297.  
  298. procedure TfrPreview.SetScrollBars(Value: TScrollStyle);
  299. begin
  300.   FScrollBars := Value;
  301.   FWindow.RPanel.Visible := (Value = ssBoth) or (Value = ssVertical);
  302.   FWindow.BPanel.Visible := (Value = ssBoth) or (Value = ssHorizontal);
  303. end;
  304.  
  305. procedure TfrPreview.SetShowToolbar(Value: Boolean);
  306. begin
  307.   FShowToolbar := Value;
  308.   if FShowToolbar then
  309.     FWindow.TPanel.Parent := Self else
  310.     FWindow.TPanel.Parent := FWindow;
  311. end;
  312.  
  313. procedure TfrPreview.OnePage;
  314. begin
  315.   FWindow.Mode := mdOnePage;
  316.   LastScaleMode := FWindow.Mode;
  317.   FWindow.FormResize(nil);
  318.   FWindow.PBox.Paint;
  319. end;
  320.  
  321. procedure TfrPreview.TwoPages;
  322. begin
  323.   FWindow.Mode := mdTwoPages;
  324.   LastScaleMode := FWindow.Mode;
  325.   FWindow.FormResize(nil);
  326.   FWindow.PBox.Paint;
  327. end;
  328.  
  329. procedure TfrPreview.PageWidth;
  330. begin
  331.   FWindow.Mode := mdPageWidth;
  332.   LastScaleMode := FWindow.Mode;
  333.   FWindow.FormResize(nil);
  334.   FWindow.PBox.Paint;
  335. end;
  336.  
  337. procedure TfrPreview.First;
  338. begin
  339.   Page := 1;
  340. end;
  341.  
  342. procedure TfrPreview.Next;
  343. begin
  344.   Page := Page + 1;
  345. end;
  346.  
  347. procedure TfrPreview.Prev;
  348. begin
  349.   Page := Page - 1;
  350. end;
  351.  
  352. procedure TfrPreview.Last;
  353. begin
  354.   Page := AllPages;
  355. end;
  356.  
  357. procedure TfrPreview.SaveToFile;
  358. begin
  359.   FWindow.SaveBtnClick(nil);
  360. end;
  361.  
  362. procedure TfrPreview.LoadFromFile;
  363. begin
  364.   FWindow.LoadBtnClick(nil);
  365. end;
  366.  
  367. procedure TfrPreview.Print;
  368. begin
  369.   FWindow.PrintBtnClick(nil);
  370. end;
  371.  
  372. procedure TfrPreview.Edit;
  373. begin
  374.   FWindow.EditBtnClick(nil);
  375. end;
  376.  
  377. procedure TfrPreview.Clear;
  378. begin
  379.   if FWindow.EMFPages <> nil then
  380.   begin
  381.     TfrEMFPages(FWindow.EMFPages).Free;
  382.     FWindow.EMFPages := nil;
  383.     FWindow.PreviewPanel.Hide;
  384.     FWindow.RedrawAll(True);
  385.   end;
  386. end;
  387.  
  388. procedure TfrPreview.LoadFile(Name: String);
  389. begin
  390.   if FileExists(Name) then
  391.     FWindow.LoadFromFile(Name) else
  392.     Clear;
  393. end;
  394.  
  395. procedure TfrPreview.OnInternalPageChanged(Sender: TObject);
  396. begin
  397.   if Assigned(FOnPageChanged) then
  398.     FOnPageChanged(Self, Page);
  399. end;
  400.  
  401. {----------------------------------------------------------------------------}
  402. procedure TfrPBox.Paint;
  403. var
  404.   i: Integer;
  405.   r, r1: TRect;
  406.   Pages: TfrEMFPages;
  407.   h: frHRGN;
  408. begin
  409.   if not Preview.PaintAllowed then Exit;
  410.   if Preview.EMFPages = nil then
  411.   begin
  412.     Canvas.Brush.Color := clBtnFace;
  413.     Canvas.FillRect(ClientRect);
  414.     Exit;
  415.   end;
  416.   Pages := TfrEMFPages(Preview.EMFPages);
  417.   h := frCreateRectRgn(0, 0, Width, Height);
  418.   Canvas.Start;
  419.   frSetClipRgn(Canvas.Handle, h);
  420.  
  421.   for i := 0 to Pages.Count - 1 do            // drawing window background
  422.   begin
  423.     r := Pages[i].r;
  424.     OffsetRect(r, Preview.ofx, Preview.ofy);
  425.     if (r.Top > 2000) or (r.Bottom < 0) then
  426.       Pages[i].Visible := False else
  427.       Pages[i].Visible := frRectVisible(Canvas.Handle, r);
  428.     if Pages[i].Visible then
  429.       frExcludeClipRect(Canvas.Handle, r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom - 1);
  430.   end;
  431.   with Canvas do
  432.   begin
  433.     Brush.Color := clGray;
  434.     FillRect(Rect(0, 0, Width, Height));
  435.     Pen.Color := clBlack;
  436.     Pen.Width := 1;
  437.     Pen.Mode := pmCopy;
  438.     Pen.Style := psSolid;
  439.     Brush.Color := clWhite;
  440.   end;
  441.  
  442.   frSetClipRgn(Canvas.Handle, h);
  443.   for i := 0 to Pages.Count - 1 do            // drawing page background
  444.     if Pages[i].Visible then
  445.     begin
  446.       r := Pages[i].r;
  447.       OffsetRect(r, Preview.ofx, Preview.ofy);
  448.       Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
  449.       Canvas.Polyline([Point(r.Left + 1, r.Bottom),
  450.                        Point(r.Right, r.Bottom),
  451.                        Point(r.Right, r.Top + 1)]);
  452.     end;
  453.  
  454.   for i := 0 to Pages.Count - 1 do           // drawing page content
  455.   begin
  456.     if Pages[i].Visible then
  457.     begin
  458.       r := Pages[i].r;
  459.       OffsetRect(r, Preview.ofx, Preview.ofy);
  460.       if Pages[i].UseMargins then
  461.         Pages.Draw(i, Canvas, r)
  462.       else
  463.       begin
  464.         with Preview, Pages[i].PrnInfo, Pages[i].pgMargins do
  465.         begin
  466.           r1.Left := Round((Ofx + Left) * per);
  467.           r1.Top := Round((Ofy + Top) * per);
  468.           r1.Right := r1.Left + Round((Pw - (Left + Right)) * per);
  469.           r1.Bottom := r1.Top + Round((Ph - (Top + Bottom)) * per);
  470.           Inc(r1.Left, r.Left); Inc(r1.Right, r.Left);
  471.           Inc(r1.Top, r.Top); Inc(r1.Bottom, r.Top);
  472.         end;
  473.         Pages.Draw(i, Canvas, r1);
  474.       end;
  475.     end
  476.     else
  477.       Pages.Draw(i, Canvas, Rect(0, 0, 0, 0)); // remove it from cache
  478.   end;
  479.   Canvas.Stop;
  480.   frDeleteRgn(h);
  481. end;
  482.  
  483. procedure TfrPBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  484. var
  485.   i: Integer;
  486.   pt: TPoint;
  487.   r: TRect;
  488.   C: TCursor;
  489. begin
  490.   if Preview.EMFPages = nil then Exit;
  491.   if DFlag then
  492.   begin
  493.     DFlag := False;
  494.     Exit;
  495.   end;
  496.  
  497.   with Preview do
  498.   if Button = mbLeft then
  499.   begin
  500.     LastClick := 0;
  501.     pt := Point(x - ofx, y - ofy);
  502.     for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
  503.     begin
  504.       r := TfrEMFPages(EMFPages)[i].r;
  505.       if PtInRect(r, pt) then
  506.       begin
  507.         LastClick := i + 1;
  508.         if TfrEMFPages(EMFPages).DoClick(i,
  509.           Point(Round((pt.X - r.Left) / per), Round((pt.Y - r.Top) / per)),
  510.           True, C) then Exit;
  511.       end;
  512.     end;
  513.     Down := True;
  514.     LastX := X; LastY := Y;
  515.   end
  516.   else if Button = mbRight then
  517.   begin
  518.     pt := Self.ClientToScreen(Point(X, Y));
  519.     if (frDesignerClass <> nil) and TfrReport(Doc).ModifyPrepared then
  520.     begin
  521.       N4.Visible := True;
  522.       N5.Visible := True;
  523.       N6.Visible := True;
  524.       N7.Visible := True;
  525.     end;
  526.     if THackControl(Preview.PreviewPanel.Parent).PopupMenu = nil then
  527.       ProcMenu.Popup(pt.x, pt.y) else
  528.       THackControl(Preview.PreviewPanel.Parent).PopupMenu.Popup(pt.x, pt.y);
  529.   end;
  530. end;
  531.  
  532. procedure TfrPBox.MouseMove(Shift: TShiftState; X, Y: Integer);
  533. var
  534.   i: Integer;
  535.   pt: TPoint;
  536.   r: TRect;
  537.   C: TCursor;
  538. begin
  539.   if Down then
  540.   begin
  541.     Preview.HScrollBar.Position := Preview.HScrollBar.Position - (X - LastX);
  542.     Preview.VScrollBar.Position := Preview.VScrollBar.Position - (Y - LastY);
  543.     LastX := X; LastY := Y;
  544.   end
  545.   else
  546.   with Preview do
  547.   if (Doc <> nil) and Assigned(TfrReport(Doc).OnMouseOverObject) then
  548.   begin
  549.     pt := Point(x - ofx, y - ofy);
  550.     for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
  551.     begin
  552.       r := TfrEMFPages(EMFPages)[i].r;
  553.       if PtInRect(r, pt) then
  554.       begin
  555.         C := crDefault;
  556.         pt := Point(Round((pt.X - r.Left) / per), Round((pt.Y - r.Top) / per));
  557.         if TfrEMFPages(EMFPages).DoClick(i, pt, False, C) then
  558.           Self.Cursor := C else
  559.           Self.Cursor := crDefault;
  560.         break;
  561.       end;
  562.     end;
  563.   end;
  564. end;
  565.  
  566. procedure TfrPBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  567.   X, Y: Integer);
  568. begin
  569.   Down := False;
  570. end;
  571.  
  572. procedure TfrPBox.DblClick;
  573. begin
  574.   Down := False;
  575.   DFlag := True;
  576.   if (Preview.EMFPages = nil) or (LastClick = 0) then Exit;
  577.   with Preview do
  578.   begin
  579.     CurPage := LastClick;
  580.     if N5.Visible then EditBtnClick(nil);
  581.   end;
  582. end;
  583.  
  584.  
  585. {----------------------------------------------------------------------------}
  586. procedure TfrPreviewForm.Localize;
  587. begin
  588.   N1.Caption := S53020;
  589.   N2.Caption := S53021;
  590.   N3.Caption := S53022;
  591.   N5.Caption := S53029;
  592.   N6.Caption := S53030;
  593.   N7.Caption := S53031;
  594.  
  595.   ZoomBtn.Hint := S53024;
  596.   LoadBtn.Hint := S53025;
  597.   SaveBtn.Hint := S53026;
  598.   PrintBtn.Hint := S53027;
  599.   HelpBtn.Hint := S53032;
  600.   ExitBtn.Hint := S53023;
  601. end;
  602.  
  603. procedure TfrPreviewForm.FormCreate(Sender: TObject);
  604. begin
  605.   PaintAllowed := False;
  606.   InitFlag := True;
  607.   PBox := TfrPBox.Create(Self);
  608.   with PBox do
  609.   begin
  610.     Parent := ScrollBox1;
  611.     Align := alClient;
  612.     BevelInner := bvNone;
  613.     BevelOuter := bvNone;
  614.     Color := clGray;
  615.     Preview := Self;
  616.     Tag := 207;
  617.   end;
  618.  
  619.   ScrollBox1.OnMouseWheelUp := FormMouseWheelUp;
  620.   ScrollBox1.OnMouseWheelDown := FormMouseWheelDown;
  621.   KWheel := 3;
  622. end;
  623.  
  624. procedure TfrPreviewForm.FormDestroy(Sender: TObject);
  625. begin
  626.   if EMFPages <> nil then
  627.     TfrEMFPages(EMFPages).Free;
  628.   EMFPages := nil;
  629.   PBox.Free;
  630.   MainImages.Clear;
  631.   DoneModal := True;
  632.   Application.ProcessMessages;
  633. end;
  634.  
  635. procedure TfrPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
  636. begin
  637.   if FormStyle <> fsMDIChild then
  638.     SaveFormPosition(frIni, Self);
  639.   Action := caFree;
  640. end;
  641.  
  642. procedure TfrPreviewForm.FormShow(Sender: TObject);
  643. begin
  644.   Localize;
  645.   if FormStyle <> fsMDIChild then
  646.     RestoreFormPosition(frIni, Self) else
  647.     WindowState := wsNormal;
  648.   PaintAllowed := True;
  649.   InitFlag := False;
  650.   PBox.Invalidate;
  651. end;
  652.  
  653. procedure TfrPreviewForm.FormActivate(Sender: TObject);
  654. begin
  655.   Application.HelpFile := 'FRuser.hlp';
  656.   ActiveControl := ScrollBox1;
  657. end;
  658.  
  659. procedure TfrPreviewForm.FormDeactivate(Sender: TObject);
  660. begin
  661.   Application.HelpFile := HF;
  662. end;
  663.  
  664. procedure TfrPreviewForm.InitButtons;
  665. begin
  666.   if not (csDesigning in TfrReport(Doc).ComponentState) then
  667.   begin
  668.     ZoomBtn.Visible := pbZoom in TfrReport(Doc).PreviewButtons;
  669.     LoadBtn.Visible := pbLoad in TfrReport(Doc).PreviewButtons;
  670.     SaveBtn.Visible := pbSave in TfrReport(Doc).PreviewButtons;
  671.     PrintBtn.Visible := pbPrint in TfrReport(Doc).PreviewButtons;
  672.     HelpBtn.Visible := (pbHelp in TfrReport(Doc).PreviewButtons) and
  673.       (TPanel.Parent = Self);
  674.     ExitBtn.Visible := (pbExit in TfrReport(Doc).PreviewButtons) and
  675.       (TPanel.Parent = Self);
  676.     if not ZoomBtn.Visible then
  677.       frTBSeparator1.Hide;
  678.     frTBSeparator3.Visible := HelpBtn.Visible;
  679.   end;
  680.  
  681.   PrintBtn.Enabled := Printer.Printers.Count > 0;
  682.   if (frDesignerClass = nil) or not TfrReport(Doc).ModifyPrepared then
  683.   begin
  684.     N4.Visible := False;
  685.     N5.Visible := False;
  686.     N6.Visible := False;
  687.     N7.Visible := False;
  688.   end;
  689.  
  690.   case TfrReport(Doc).InitialZoom of
  691.     pzPageWidth: LastScaleMode := mdPageWidth;
  692.     pzOnePage: LastScaleMode := mdOnePage;
  693.     pzTwoPages:  LastScaleMode := mdTwoPages;
  694.   end;
  695. end;
  696.  
  697. procedure TfrPreviewForm.Show_Modal(ADoc: Pointer);
  698. begin
  699.   Connect(ADoc);
  700.   InitButtons;
  701.   RedrawAll(True);
  702.   HScrollBar.Position := 0;
  703.   VScrollBar.Position := 0;
  704.  
  705.   HF := Application.HelpFile;
  706.   if TfrReport(Doc).ModalPreview then
  707.   begin
  708.     Show;
  709.     SetCaptureControl(nil);
  710.     DoneModal := False;
  711.     while not DoneModal do
  712.       Application.ProcessMessages;
  713.   end
  714.   else
  715.     Show;
  716. end;
  717.  
  718. procedure TfrPreviewForm.Connect(ADoc: Pointer);
  719. begin
  720.   Doc := ADoc;
  721.   if EMFPages <> nil then
  722.     TfrEMFPages(EMFPages).Free;
  723.   EMFPages := TfrReport(Doc).EMFPages;
  724.   TfrReport(Doc).EMFPages := TfrEMFPages.Create(Doc);
  725. end;
  726.  
  727. procedure TfrPreviewForm.ConnectBack;
  728. begin
  729.   TfrReport(Doc).EMFPages.Free;
  730.   TfrReport(Doc).EMFPages := TfrEMFPages(EMFPages);
  731.   EMFPages := nil;
  732. end;
  733.  
  734. procedure TfrPreviewForm.RedrawAll(ResetPage: Boolean);
  735. var
  736.   i: Integer;
  737. begin
  738.   per := LastScale;
  739.   mode := LastScaleMode;
  740.   if mode = mdPageWidth then
  741.     N1.Checked := True
  742.   else if mode = mdOnePage then
  743.     N2.Checked := True
  744.   else if mode = mdTwoPages then
  745.     N3.Checked := True
  746.   else
  747.     for i := 0 to ProcMenu.Items.Count - 1 do
  748.       if ProcMenu.Items[i].Tag = per * 100 then
  749.         ProcMenu.Items[i].Checked := True;
  750.  
  751.   if ResetPage then
  752.   begin
  753.     CurPage := 1;
  754.     ofx := 0; ofy := 0; OldH := 0; OldV := 0;
  755.     HScrollBar.Position := 0;
  756.     VScrollBar.Position := 0;
  757.   end;
  758.   ShowPageNum;
  759.   FormResize(nil);
  760.   if EMFPages <> nil then
  761.     for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
  762.     begin
  763.       TfrEMFPages(EMFPages)[i].Visible := False;
  764.       TfrEMFPages(EMFPages).Draw(i, Canvas, Rect(0, 0, 0, 0));
  765.     end;
  766.   PBox.Repaint;
  767. end;
  768.  
  769. procedure TfrPreviewForm.FormResize(Sender: TObject);
  770. var
  771.   i, j, y, d, nx, dwx, dwy, maxx, maxy, maxdy, curx: Integer;
  772.   Pages: TfrEMFPages;
  773. begin
  774.   if EMFPages = nil then Exit;
  775.   Pages := TfrEMFPages(EMFPages);
  776.   PaintAllowed := False;
  777.   with Pages[CurPage - 1].PrnInfo do
  778.   begin
  779.     dwx := Pgw; dwy := Pgh;
  780.   end;
  781.   case mode of
  782.     mdNone:
  783.       begin
  784.         for i := 0 to ProcMenu.Items.Count - 1 do
  785.           if ProcMenu.Items[i].Tag = Round(per * 100) then
  786.             ProcMenu.Items[i].Checked := True;
  787.       end;
  788.     mdPageWidth:
  789.       begin
  790.         per := (PBox.Width - 20) / dwx;
  791.         N1.Checked := True;
  792.       end;
  793.     mdOnePage:
  794.       begin
  795.         per := (PBox.Height - 20) / dwy;
  796.         N2.Checked := True;
  797.       end;
  798.     mdTwoPages:
  799.       begin
  800.         per := (PBox.Width - 30) / (2 * dwx);
  801.         N3.Checked := True;
  802.       end;
  803.   end;
  804.   ZoomBtn.Caption := IntToStr(Round(per * 100)) + '%';
  805.   nx := 0; maxx := 10; j := 0;
  806.   for i := 0 to Pages.Count - 1 do
  807.   begin
  808.     d := maxx + 10 + Round(Pages[i].PrnInfo.Pgw * per);
  809.     if d > PBox.Width then
  810.     begin
  811.       if nx < j then nx := j;
  812.       j := 0;
  813.       maxx := 10;
  814.     end
  815.     else
  816.     begin
  817.       maxx := d;
  818.       Inc(j);
  819.       if i = Pages.Count - 1 then
  820.         if nx < j then nx := j;
  821.     end;
  822.   end;
  823.   if nx = 0 then nx := 1;
  824.   if mode = mdOnePage then nx := 1;
  825.   if mode = mdTwoPages then nx := 2;
  826.   y := 10;
  827.   i := 0;
  828.   maxx := 0; maxy := 0;
  829.   while i < Pages.Count do
  830.   begin
  831.     j := 0; maxdy := 0; curx := 10;
  832.     while (j < nx) and (i + j < Pages.Count) do
  833.     begin
  834.       dwx := Round(Pages[i + j].PrnInfo.Pgw * per);
  835.       dwy := Round(Pages[i + j].PrnInfo.Pgh * per);
  836.       if (nx = 1) and (dwx < PBox.Width) then
  837.       begin
  838.         d := (PBox.Width - dwx) div 2;
  839.         Pages[i + j].r := Rect(d, y, d + dwx, y + dwy);
  840.       end
  841.       else
  842.         Pages[i + j].r := Rect(curx, y, curx + dwx, y + dwy);
  843.       if maxx < Pages[i + j].r.Right then
  844.         maxx := Pages[i + j].r.Right;
  845.       if maxy < Pages[i + j].r.Bottom then
  846.         maxy := Pages[i + j].r.Bottom;
  847.       Inc(j);
  848.       if maxdy < dwy then maxdy := dwy;
  849.       Inc(curx, dwx + 10);
  850.     end;
  851.     Inc(y, maxdy + 10);
  852.     Inc(i, nx);
  853.   end;
  854.   PgDown.Top := RPanel.Height - 20;
  855.   PgUp.Top := PgDown.Top - 16;
  856.   VScrollBar.Height := PgUp.Top - 1;
  857.   if RPanel.Visible then
  858.     HScrollBar.Width := BPanel.Width - HScrollBar.Left - VScrollBar.Width else
  859.     HScrollBar.Width := BPanel.Width - HScrollBar.Left;
  860.   maxx := maxx - PBox.Width;
  861.   maxy := maxy - PBox.Height;
  862.   if maxx < 0 then maxx := 0 else Inc(maxx, 10);
  863.   if maxy < 0 then maxy := 0 else Inc(maxy, 10);
  864.   HScrollBar.Max := maxx; VScrollBar.Max := maxy;
  865.   HScrollBar.Enabled := maxx <> 0;
  866.   VScrollBar.Enabled := maxy <> 0;
  867.   if Visible then
  868.     ActiveControl := ScrollBox1;
  869.   SetToCurPage;
  870.   if not InitFlag then
  871.     PaintAllowed := True;
  872.   PBox.Paint;
  873. end;
  874.  
  875. procedure TfrPreviewForm.SetToCurPage;
  876. begin
  877.   if EMFPages = nil then Exit;
  878.   if ofy <> TfrEMFPages(EMFPages)[CurPage - 1].r.Top - 10 then
  879.     VScrollBar.Position := TfrEMFPages(EMFPages)[CurPage - 1].r.Top - 10;
  880. end;
  881.  
  882. procedure TfrPreviewForm.ShowPageNum;
  883. begin
  884.   if EMFPages = nil then
  885.     Label1.Caption := ''
  886.   else
  887.   begin
  888.     if Assigned(FOnPageChanged) then
  889.       FOnPageChanged(Self);
  890.     Label1.Caption := SPg + ' ' + IntToStr(CurPage) + '/' +
  891.       IntToStr(TfrEMFPages(EMFPages).Count);
  892.   end;
  893. end;
  894.  
  895. procedure TfrPreviewForm.VScrollBarChange(Sender: TObject);
  896. var
  897.   i, p, pp: Integer;
  898.   r: TRect;
  899.   Pages: TfrEMFPages;
  900. begin
  901.   if EMFPages = nil then Exit;
  902.   Pages := TfrEMFPages(EMFPages);
  903.   p := VScrollBar.Position;
  904.   pp := OldV - p;
  905.   OldV := p;
  906.   ofy := -p;
  907.   r := Rect(0, 0, PBox.Width, PBox.Height);
  908.   QWidget_scroll(PBox.Handle, 0, pp);
  909.  
  910.   for i := 0 to Pages.Count-1 do
  911.     if (Pages[i].r.Top < -ofy + 11) and
  912.       (Pages[i].r.Bottom > -ofy + 11) then
  913.     begin
  914.       CurPage := i + 1;
  915.       ShowPageNum;
  916.       break;
  917.     end;
  918. end;
  919.  
  920. procedure TfrPreviewForm.HScrollBarChange(Sender: TObject);
  921. var
  922.   p, pp: Integer;
  923.   r: TRect;
  924. begin
  925.   if EMFPages = nil then Exit;
  926.   p := HScrollBar.Position;
  927.   pp := OldH - p;
  928.   OldH := p;
  929.   ofx := -p;
  930.   r := Rect(0, 0, PBox.Width, PBox.Height);
  931.   QWidget_scroll(PBox.Handle, pp, 0);
  932. end;
  933.  
  934. procedure TfrPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
  935.   Shift: TShiftState);
  936. begin
  937.   if EMFPages = nil then Exit;
  938.   if Key = key_Up then
  939.     VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange
  940.   else if Key = key_Down then
  941.     VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange
  942.   else if Key = key_Left then
  943.     HScrollBar.Position := HScrollBar.Position - HScrollBar.SmallChange
  944.   else if Key = key_Right then
  945.     HScrollBar.Position := HScrollBar.Position + HScrollBar.SmallChange
  946.   else if Key = key_Prior then
  947.     if ssCtrl in Shift then
  948.       PgUpClick(nil) else
  949.       VScrollBar.Position := VScrollBar.Position - VScrollBar.LargeChange
  950.   else if Key = key_Next then
  951.     if ssCtrl in Shift then
  952.       PgDownClick(nil) else
  953.       VScrollBar.Position := VScrollBar.Position + VScrollBar.LargeChange
  954.   else if Key = key_Space then
  955.     ZoomBtnClick(nil)
  956.   else if Key = key_Escape then
  957.     ExitBtnClick(nil)
  958.   else if Key = key_Home then
  959.     if ssCtrl in Shift then
  960.       VScrollBar.Position := 0 else
  961.       Exit
  962.   else if Key = key_End then
  963.     if ssCtrl in Shift then
  964.     begin
  965.       CurPage := TfrEMFPages(EMFPages).Count;
  966.       SetToCurPage;
  967.     end
  968.     else Exit
  969.   else if ssCtrl in Shift then
  970.   begin
  971.     if Chr(Key) = 'O' then LoadBtnClick(nil)
  972.     else if Chr(Key) = 'S' then SaveBtnClick(nil)
  973.     else if (Chr(Key) = 'P') and PrintBtn.Enabled then PrintBtnClick(nil)
  974.     else if (Chr(Key) = 'E') and N5.Visible then EditBtnClick(nil)
  975.   end
  976.   else Exit;
  977.   Key := 0;
  978. end;
  979.  
  980. procedure TfrPreviewForm.PgUpClick(Sender: TObject);
  981. begin
  982.   if CurPage > 1 then Dec(CurPage);
  983.   ShowPageNum;
  984.   SetToCurPage;
  985. end;
  986.  
  987. procedure TfrPreviewForm.PgDownClick(Sender: TObject);
  988. begin
  989.   if EMFPages = nil then Exit;
  990.   if CurPage < TfrEMFPages(EMFPages).Count then Inc(CurPage);
  991.   ShowPageNum;
  992.   SetToCurPage;
  993. end;
  994.  
  995. procedure TfrPreviewForm.ZoomBtnClick(Sender: TObject);
  996. var
  997.   pt: TPoint;
  998. begin
  999.   pt := ZoomBtn.ClientToScreen(Point(ZoomBtn.Left, ZoomBtn.Top + ZoomBtn.Height));
  1000.   N4.Visible := False;
  1001.   N5.Visible := False;
  1002.   N6.Visible := False;
  1003.   N7.Visible := False;
  1004.   ProcMenu.Popup(pt.x, pt.y);
  1005. end;
  1006.  
  1007. procedure TfrPreviewForm.N3Click(Sender: TObject);
  1008. begin
  1009.   if EMFPages = nil then Exit;
  1010.   ofx := 0;
  1011.   with Sender as TMenuItem do
  1012.   begin
  1013.     case Tag of
  1014.       1: mode := mdPageWidth;
  1015.       2: mode := mdOnePage;
  1016.       3: mode := mdTwoPages;
  1017.     else
  1018.       begin
  1019.         mode := mdNone;
  1020.         per := Tag / 100;
  1021.       end;
  1022.     end;
  1023.     Checked := True;
  1024.   end;
  1025.   HScrollBar.Position := 0;
  1026.   FormResize(nil);
  1027.   LastScale := per;
  1028.   LastScaleMode := mode;
  1029.   PBox.Repaint;
  1030. end;
  1031.  
  1032. procedure TfrPreviewForm.LoadBtnClick(Sender: TObject);
  1033. begin
  1034.   if EMFPages = nil then Exit;
  1035.   OpenDialog.Filter := SRepFile + ' (*.frp)|*.frp';
  1036.   with OpenDialog do
  1037.    if Execute then
  1038.      LoadFromFile(FileName);
  1039. end;
  1040.  
  1041. procedure TfrPreviewForm.SaveBtnClick(Sender: TObject);
  1042. var
  1043.   i: Integer;
  1044.   s: String;
  1045. begin
  1046.   if EMFPages = nil then Exit;
  1047.   s := SRepFile + ' (*.frp)|*.frp';
  1048.   for i := 0 to frFiltersCount - 1 do
  1049.     s := s + '|' + frFilters[i].FilterDesc + '|' + frFilters[i].FilterExt;
  1050.   with SaveDialog do
  1051.   begin
  1052.     Filter := s;
  1053.     FilterIndex := 1;
  1054.     if Execute then
  1055.       if FilterIndex = 1 then
  1056.         SaveToFile(FileName)
  1057.       else
  1058.       begin
  1059.         ConnectBack;
  1060.         TfrReport(Doc).ExportTo(frFilters[FilterIndex - 2].Filter,
  1061.           ChangeFileExt(FileName, Copy(frFilters[FilterIndex - 2].FilterExt, 2, 255)));
  1062.         Connect(Doc);
  1063.         RedrawAll(False);
  1064.       end;
  1065.   end;
  1066. end;
  1067.  
  1068. procedure TfrPreviewForm.PrintBtnClick(Sender: TObject);
  1069. var
  1070.   Pages: String;
  1071.   ind: Integer;
  1072. begin
  1073.   if (EMFPages = nil) or (Printer.Printers.Count = 0) then Exit;
  1074.   ind := Prn.PrinterIndex;
  1075.   with TfrPrintForm.Create(nil) do
  1076.   begin
  1077.     E1.Text := IntToStr(TfrReport(Doc).DefaultCopies);
  1078.     CollateCB.Checked := TfrReport(Doc).DefaultCollate;
  1079.     if ShowModal = mrOk then
  1080.     begin
  1081.       if Prn.PrinterIndex <> ind then
  1082.         if TfrReport(Doc).CanRebuild then
  1083.           if TfrReport(Doc).ChangePrinter(ind, Prn.PrinterIndex) then
  1084.           begin
  1085.             TfrEMFPages(EMFPages).Free;
  1086.             EMFPages := nil;
  1087.             TfrReport(Doc).PrepareReport;
  1088.             Connect(Doc);
  1089.           end
  1090.           else
  1091.           begin
  1092.             Free;
  1093.             Exit;
  1094.           end;
  1095.       if RB1.Checked then
  1096.         Pages := ''
  1097.       else if RB2.Checked then
  1098.         Pages := IntToStr(CurPage)
  1099.       else
  1100.         Pages := E2.Text;
  1101.       ConnectBack;
  1102.       TfrReport(Doc).PrintPreparedReport(Pages, StrToInt(E1.Text),
  1103.         CollateCB.Checked, TfrPrintPages(CB2.ItemIndex));
  1104.       Connect(Doc);
  1105.       RedrawAll(False);
  1106.     end;
  1107.     Free;
  1108.   end;
  1109. end;
  1110.  
  1111. procedure TfrPreviewForm.ExitBtnClick(Sender: TObject);
  1112. begin
  1113.   if Doc = nil then Exit;
  1114. {  if TfrReport(Doc).ModalPreview then
  1115.     ModalResult := mrOk else}
  1116.     Close;
  1117. end;
  1118.  
  1119. procedure TfrPreviewForm.LoadFromFile(name: String);
  1120. begin
  1121.   if Doc = nil then Exit;
  1122.   TfrEMFPages(EMFPages).Free;
  1123.   EMFPages := nil;
  1124.   TfrReport(Doc).LoadPreparedReport(name);
  1125.   Connect(Doc);
  1126.   CurPage := 1;
  1127.   FormResize(nil);
  1128.   PaintAllowed := False;
  1129.   ShowPageNum;
  1130.   SetToCurPage;
  1131.   PaintAllowed := True;
  1132.   PBox.Repaint;
  1133. end;
  1134.  
  1135. procedure TfrPreviewForm.SaveToFile(name:String);
  1136. begin
  1137.   if Doc = nil then Exit;
  1138.   name := ChangeFileExt(name, '.frp');
  1139.   ConnectBack;
  1140.   TfrReport(Doc).SavePreparedReport(name);
  1141.   Connect(Doc);
  1142. end;
  1143.  
  1144.  
  1145. procedure TfrPreviewForm.EditBtnClick(Sender: TObject);
  1146. begin
  1147.   if (Doc = nil) or not TfrReport(Doc).ModifyPrepared then Exit;
  1148.   ConnectBack;
  1149.   TfrReport(Doc).EditPreparedReport(CurPage - 1);
  1150.   Connect(Doc);
  1151.   RedrawAll(False);
  1152. end;
  1153.  
  1154. procedure TfrPreviewForm.DelPageBtnClick(Sender: TObject);
  1155. begin
  1156.   if Doc = nil then Exit;
  1157.   if TfrEMFPages(EMFPages).Count > 1 then
  1158.     if Application.MessageBox(SRemovePg, SConfirm,
  1159.       [smbYes, smbNo], smsWarning) = smbYes then
  1160.     begin
  1161.       TfrEMFPages(EMFPages).Delete(CurPage - 1);
  1162.       RedrawAll(True);
  1163.     end;
  1164. end;
  1165.  
  1166. procedure TfrPreviewForm.NewPageBtnClick(Sender: TObject);
  1167. begin
  1168.   if Doc = nil then Exit;
  1169.   TfrEMFPages(EMFPages).Insert(CurPage - 1, TfrReport(Doc).Pages[0]);
  1170.   RedrawAll(False);
  1171. end;
  1172.  
  1173. procedure TfrPreviewForm.HelpBtnClick(Sender: TObject);
  1174. begin
  1175.   Screen.Cursor := crHelp;
  1176. //  SetCapture(Handle);
  1177.   HelpBtn.Invalidate;
  1178. end;
  1179.  
  1180. procedure TfrPreviewForm.FormMouseDown(Sender: TObject;
  1181.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1182. var
  1183.   c: TControl;
  1184. begin
  1185.   HelpBtn.Down := False;
  1186.   Screen.Cursor := crDefault;
  1187.   c := frControlAtPos(Self, Point(X, Y));
  1188.   if (c <> nil) and (c <> HelpBtn) then
  1189.     Application.ContextHelp(c.Tag);
  1190. end;
  1191.  
  1192. procedure TfrPreviewForm.FormMouseWheelUp(Sender: TObject;
  1193.   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  1194. begin
  1195.   VScrollBar.Position := VScrollBar.Position - VScrollBar.SmallChange * KWheel;
  1196. end;
  1197.  
  1198. procedure TfrPreviewForm.FormMouseWheelDown(Sender: TObject;
  1199.   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  1200. begin
  1201.   VScrollBar.Position := VScrollBar.Position + VScrollBar.SmallChange * KWheel;
  1202. end;
  1203.  
  1204. procedure TfrPreviewForm.HScrollBarEnter(Sender: TObject);
  1205. begin
  1206.   ActiveControl := ScrollBox1;
  1207. end;
  1208.  
  1209. function TfrPreviewForm.WantKey(Key: Integer; Shift: TShiftState;
  1210.   const KeyText: WideString): Boolean;
  1211. begin
  1212.   if (Key = key_Up) or (Key = key_Down) or (Key = key_Left) or (Key = key_Right) then
  1213.     Result := False else
  1214.     Result := inherited WantKey(Key, Shift, KeyText);
  1215. end;
  1216.  
  1217.  
  1218.  
  1219. end.
  1220.  
  1221.