1
2 {*****************************************}
3 { }
4 { FastReport v2.3 }
5 { Report preview }
6 { }
7 { Copyright (c) 1998-99 by Tzyganenko A. }
8 { }
9 {*****************************************}
10
11 unit LR_View;
12
13 interface
14
15 {$I LR_Vers.inc}
16
17 uses
18 Classes, SysUtils, LResources, LMessages, Forms, Controls, Graphics, Dialogs,
19 ExtCtrls, Buttons, StdCtrls, Menus, GraphType, LCLType, LCLProc, LCLIntf, LazUTF8,
20 LR_Const, PrintersDlgs;
21
22 type
23 TfrPreviewForm = class;
24 TfrPreviewZoom = (pzDefault, pzPageWidth, pzOnePage, pzTwoPages);
25 TfrPreviewButton = (pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbHelp, pbExit);
26 TfrPreviewButtons = set of TfrPreviewButton;
27
28 { TfrPreview }
29
30 TfrPreview = class(TPanel)
31 private
32 FWindow: TfrPreviewForm;
33 FScrollBars: TScrollStyle;
GetOnScrollPagenull34 function GetOnScrollPage: TNotifyEvent;
GetPagenull35 function GetPage: Integer;
36 procedure SetOnScrollPage(AValue: TNotifyEvent);
37 procedure SetPage(Value: Integer);
GetZoomnull38 function GetZoom: Double;
39 procedure SetZoom(Value: Double);
GetAllPagesnull40 function GetAllPages: Integer;
41 procedure SetScrollBars(Value: TScrollStyle);
42 protected
43 procedure DoOnChangeBounds; override;
44 public
45 constructor Create(AOwner: TComponent); override;
46 destructor Destroy; override;
47 procedure Connect(Doc: Pointer);
48 procedure Clear;
49 procedure OnePage;
50 procedure TwoPages;
51 procedure PageWidth;
52 procedure First;
53 procedure Next;
54 procedure Prev;
55 procedure Last;
56 procedure SaveToFile;
57 procedure LoadFromFile;
Printnull58 function Print: boolean;
59 procedure Edit;
60 procedure Find;
61
62 procedure SmallScrollUp;
63 procedure SmallScrollDown;
64 procedure SmallScrollLeft;
65 procedure SmallScrollRight;
66 procedure SmallScrollNext;
67 procedure SmallScrollPrior;
68
ExportTonull69 function ExportTo(AFileName: string): boolean;
70 property AllPages: Integer read GetAllPages;
71 property Page: Integer read GetPage write SetPage;
72 property Zoom: Double read GetZoom write SetZoom;
73 published
74 property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
75 property OnScrollPage:TNotifyEvent read GetOnScrollPage write SetOnScrollPage;
76 end;
77
78 { TfrPBox }
79
80 TfrPBox = class(TPanel)
81 private
82 FCurView:TObject;
83 public
84 Preview: TfrPreviewForm;
85 procedure WMEraseBackground(var {%H-}Message: TLMEraseBkgnd); message LM_ERASEBKGND;
86 procedure Paint; override;
87 procedure MouseDown(Button: TMouseButton;
88 {%H-}Shift: TShiftState; X, Y: Integer); override;
89 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
90 procedure DblClick; override;
91
92 property OnMouseWheelDown;
93 property OnMouseWheelUp;
94 end;
95
96 TfrScaleMode = (mdNone, mdPageWidth, mdOnePage, mdTwoPages);
97
98 { TfrPreviewForm }
99
100 TfrPreviewForm = class(TForm)
101 FindBtn: TBitBtn;
102 BtZoomOut: TBitBtn;
103 BtZoomIn: TBitBtn;
104 frTBSeparator1: TPanel;
105 frTBSeparator2: TPanel;
106 frTBSeparator3: TPanel;
107 frTBSeparator4: TPanel;
108 LbPanel: TPanel;
109 MenuItem1: TMenuItem;
110 MenuItem2: TMenuItem;
111 PanTop: TPanel;
112 PgDown: TSpeedButton;
113 PgUp: TSpeedButton;
114 PopupMenu1: TPopupMenu;
115 SettingsBtn: TBitBtn;
116 prnDialog: TPrintDialog;
117 ProcMenu: TPopupMenu;
118 N2001: TMenuItem;
119 N1501: TMenuItem;
120 N1001: TMenuItem;
121 N751: TMenuItem;
122 N501: TMenuItem;
123 N251: TMenuItem;
124 N101: TMenuItem;
125 N1: TMenuItem;
126 N2: TMenuItem;
127 N3: TMenuItem;
128 OpenDialog: TOpenDialog;
129 SaveDialog: TSaveDialog;
130 N4: TMenuItem;
131 N5: TMenuItem;
132 N6: TMenuItem;
133 N7: TMenuItem;
134 PreviewPanel: TPanel;
135 ScrollBox1: TScrollBox;
136 RPanel: TPanel;
137 BtPgFirst: TSpeedButton;
138 BtPgLast: TSpeedButton;
139 PageSetupBtn: TBitBtn;
140 SpeedButton1: TSpeedButton;
141 VScrollBar: TScrollBar;
142 BPanel: TPanel;
143 HScrollBar: TScrollBar;
144 Panel1: TPanel;
145 ZoomBtn: TBitBtn;
146 LoadBtn: TBitBtn;
147 SaveBtn: TBitBtn;
148 PrintBtn: TBitBtn;
149 ExitBtn: TBitBtn;
150 procedure BtZoomInClick(Sender: TObject);
151 procedure BtZoomOutClick(Sender: TObject);
152 procedure FormResize(Sender: TObject);
153 procedure BtPgFirstClick(Sender: TObject);
154 procedure BtPgLastClick(Sender: TObject);
155 procedure PageSetupBtnClick(Sender: TObject);
156 procedure SettingsBtnClick(Sender: TObject);
157 procedure SpeedButton1Click(Sender: TObject);
158 procedure VScrollBarChange(Sender: TObject);
159 procedure HScrollBarChange(Sender: TObject);
160 procedure PgUpClick(Sender: TObject);
161 procedure PgDownClick(Sender: TObject);
162 procedure ZoomBtnClick(Sender: TObject);
163 procedure N3Click(Sender: TObject);
164 procedure ExitBtnClick(Sender: TObject);
165 procedure FormKeyDown(Sender: TObject; var Key: Word;
166 Shift: TShiftState);
167 procedure LoadBtnClick(Sender: TObject);
168 procedure SaveBtnClick(Sender: TObject);
169 procedure PrintBtnClick(Sender: TObject);
170 procedure FormCreate(Sender: TObject);
171 procedure FindBtnClick(Sender: TObject);
172 procedure FormDestroy(Sender: TObject);
173 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
174 procedure EditBtnClick(Sender: TObject);
175 procedure DelPageBtnClick(Sender: TObject);
176 procedure NewPageBtnClick(Sender: TObject);
177 procedure HelpBtnClick(Sender: TObject);
178 procedure FormMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
179 {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
180 procedure FormActivate(Sender: TObject);
181 procedure FormDeactivate(Sender: TObject);
182 private
183 Doc: Pointer;
184 EMFPages: Pointer;
185 PBox: TfrPBox;
186 CurPage: Integer;
187 ofx, ofy, OldV, OldH: Integer;
188 per: Double;
189 mode: TfrScaleMode;
190 PaintAllowed: Boolean;
191
192 SearchFindStr: String;
193 SearchCaseSensitive: Boolean;
194 SearchDirecion:integer;
195 SearchLastFoundPage: Integer;
196 SearchLastFoundObject: Integer;
197
198 HF: String;
199
200 FOnScrollPage:TNotifyEvent;
201 procedure ShowPageNum;
202 procedure SetToCurPage;
203 // procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
204 procedure RedrawAll;
205 procedure LoadFromFile(const aName: String);
206 procedure SaveToFile(const aName: String);
207 // procedure FindInEMF(emf: TMetafile);
FindInEMFPagesnull208 function FindInEMFPages:boolean;
209 procedure FindText;
210 procedure SetGrayedButtons(Value: Boolean);
211 procedure Connect(ADoc: Pointer);
212 procedure ConnectBack;
213 procedure ScrollbarDelta(const VertDelta,HorzDelta: Integer);
214 procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
215 {%H-}MousePos: TPoint; var Handled: Boolean);
216 procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
217 {%H-}MousePos: TPoint; var Handled: Boolean);
ExportToWithFilterIndexnull218 function ExportToWithFilterIndex(AFilterIndex:Integer; const AFileName: string): boolean;
Printnull219 function Print: boolean;
220 procedure CreateExportFilterItems;
221 procedure ExportFilterItemExecClick(Sender: TObject);
ShowReportoptionsnull222 function ShowReportoptions(const CurReport: TObject): Boolean;
223 public
224 procedure Show_Modal(ADoc: Pointer);
225 end;
226
227
228 implementation
229 uses LR_Class, LR_Prntr, LR_Srch, LR_PrDlg, Printers, lr_PreviewToolsAbstract,LR_Dopt,LR_pgopt;
230
231 {$R *.lfm}
232
233
234 type
235 THackControl = class(TWinControl)
236 end;
237
238 var
239 LastScale : Double = 1;
240 LastScaleMode : TfrScaleMode = mdNone;
241 {----------------------------------------------------------------------------}
242 constructor TfrPreview.Create(AOwner: TComponent);
243 begin
244 inherited Create(AOwner);
245 FWindow := TfrPreviewForm.Create(nil);
246 self.BevelInner := bvNone;
247 self.BevelOuter := bvLowered;
248 self.ScrollBars := ssBoth;
249 end;
250
251 destructor TfrPreview.Destroy;
252 begin
253 FWindow.Free;
254 inherited Destroy;
255 end;
256
257 procedure TfrPreview.Connect(Doc: Pointer);
258 begin
259 FWindow.PreviewPanel.Parent := Self;
260 FWindow.Connect(Doc);
261 Page := 1;
262 FWindow.RedrawAll;
263 end;
264
265 procedure TfrPreview.Clear;
266 begin
267 FWindow.PreviewPanel.Parent := nil;
268 end;
269
GetPagenull270 function TfrPreview.GetPage: Integer;
271 begin
272 Result := FWindow.CurPage;
273 end;
274
GetOnScrollPagenull275 function TfrPreview.GetOnScrollPage: TNotifyEvent;
276 begin
277 Result:=FWindow.FOnScrollPage;
278 end;
279
280 procedure TfrPreview.SetOnScrollPage(AValue: TNotifyEvent);
281 begin
282 FWindow.FOnScrollPage:=AValue;
283 end;
284
285 procedure TfrPreview.SetPage(Value: Integer);
286 begin
287 if (Value < 1) or (Value > AllPages) then Exit;
288 FWindow.CurPage := Value;
289 FWindow.SetToCurPage;
290 end;
291
TfrPreview.GetZoomnull292 function TfrPreview.GetZoom: Double;
293 begin
294 Result := FWindow.Per * 100;
295 end;
296
297 procedure TfrPreview.SetZoom(Value: Double);
298 begin
299 FWindow.Per := Value / 100;
300 FWindow.Mode := mdNone;
301 FWindow.FormResize(nil);
302 FWindow.PBox.Paint;
303 end;
304
TfrPreview.GetAllPagesnull305 function TfrPreview.GetAllPages: Integer;
306 begin
307 Result := 0;
308 if TfrEMFPages(FWindow.EMFPages) <> nil then
309 Result := TfrEMFPages(FWindow.EMFPages).Count;
310 end;
311
312 procedure TfrPreview.SetScrollBars(Value: TScrollStyle);
313 begin
314 FScrollBars := Value;
315 FWindow.RPanel.Visible := (Value = ssBoth) or (Value = ssVertical);
316 FWindow.BPanel.Visible := (Value = ssBoth) or (Value = ssHorizontal);
317 end;
318
319 procedure TfrPreview.DoOnChangeBounds;
320 begin
321 inherited DoOnChangeBounds;
322 if FWindow<>nil then
323 FWindow.FormResize(nil);
324 end;
325
326 procedure TfrPreview.OnePage;
327 begin
328 FWindow.Mode := mdOnePage;
329 FWindow.FormResize(nil);
330 FWindow.PBox.Paint;
331 end;
332
333 procedure TfrPreview.TwoPages;
334 begin
335 FWindow.Mode := mdTwoPages;
336 FWindow.FormResize(nil);
337 FWindow.PBox.Paint;
338 end;
339
340 procedure TfrPreview.PageWidth;
341 begin
342 FWindow.Mode := mdPageWidth;
343 FWindow.FormResize(nil);
344 FWindow.PBox.Paint;
345 end;
346
347 procedure TfrPreview.First;
348 begin
349 Page := 1;
350 end;
351
352 procedure TfrPreview.Next;
353 begin
354 Page := Page + 1;
355 end;
356
357 procedure TfrPreview.Prev;
358 begin
359 Page := Page - 1;
360 end;
361
362 procedure TfrPreview.Last;
363 begin
364 Page := AllPages;
365 end;
366
367 procedure TfrPreview.SaveToFile;
368 begin
369 FWindow.SaveBtnClick(nil);
370 end;
371
372 procedure TfrPreview.LoadFromFile;
373 begin
374 FWindow.LoadBtnClick(nil);
375 end;
376
Printnull377 function TfrPreview.Print: boolean;
378 begin
379 result := FWindow.Print;
380 end;
381
382 procedure TfrPreview.Edit;
383 begin
384 FWindow.EditBtnClick(nil);
385 end;
386
387 procedure TfrPreview.Find;
388 begin
389 FWindow.FindBtnClick(nil);
390 end;
391
392 procedure TfrPreview.SmallScrollUp;
393 begin
394 if FWindow.VScrollBar.Enabled then FWindow.VScrollBar.SetFocus;
395 FWindow.ScrollBarDelta(-FWindow.VScrollBar.SmallChange, 0)
396 end;
397
398 procedure TfrPreview.SmallScrollDown;
399 begin
400 if FWindow.VScrollBar.Enabled then FWindow.VScrollBar.SetFocus;
401 FWindow.ScrollBarDelta(FWindow.VScrollBar.SmallChange, 0)
402 end;
403
404 procedure TfrPreview.SmallScrollLeft;
405 begin
406 if FWindow.HScrollBar.Enabled then FWindow.HScrollBar.SetFocus;
407 FWindow.ScrollBarDelta(-FWindow.HScrollBar.SmallChange, 0)
408 end;
409
410 procedure TfrPreview.SmallScrollRight;
411 begin
412 if FWindow.HScrollBar.Enabled then FWindow.HScrollBar.SetFocus;
413 FWindow.ScrollBarDelta(FWindow.HScrollBar.SmallChange, 0)
414 end;
415
416 procedure TfrPreview.SmallScrollNext;
417 begin
418 if FWindow.VScrollBar.Enabled then FWindow.VScrollBar.SetFocus;
419 FWindow.ScrollBarDelta(FWindow.VScrollBar.LargeChange, 0)
420 end;
421
422 procedure TfrPreview.SmallScrollPrior;
423 begin
424 if FWindow.VScrollBar.Enabled then FWindow.VScrollBar.SetFocus;
425 FWindow.ScrollBarDelta(-FWindow.VScrollBar.LargeChange, 0)
426 end;
427
ExportTonull428 function TfrPreview.ExportTo(AFileName: string): boolean;
429 var
430 i: Integer;
431 AExt: string;
432 begin
433 result := false;
434 AExt := ExtractFileExt(AFileName);
435 for i:=0 to ExportFilters.Count - 1 do
436 if SameText(AExt, ExtractFileExt(ExportFilters[i].FilterExt)) then
437 begin
438 FWindow.ExportToWithFilterIndex(i, AFileName);
439 result := true;
440 break;
441 end;
442 end;
443
444 {----------------------------------------------------------------------------}
445 procedure TfrPBox.WMEraseBackground(var Message: TLMEraseBkgnd);
446 begin
447 end;
448
449 procedure TfrPBox.Paint;
450 var
451 i: Integer;
452 r, r1: TRect;
453 Pages: TfrEMFPages;
454 h: HRGN;
455 begin
456 if not Preview.PaintAllowed then Exit;
457 if Preview.EMFPages = nil then
458 begin
459 Canvas.Brush.Color := clBtnFace;
460 Canvas.FillRect(ClientRect);
461 Exit;
462 end;
463 Pages := TfrEMFPages(Preview.EMFPages);
464 h := CreateRectRgn(0, 0, Width, Height);
465 GetClipRgn(Canvas.Handle, h);
466
467 for i := 0 to Pages.Count - 1 do // drawing window background
468 begin
469 r := Pages[i]^.r;
470 OffsetRect(r, Preview.ofx, Preview.ofy);
471 if (r.Top > 2000) or (r.Bottom < 0) then
472 Pages[i]^.Visible := False else
473 Pages[i]^.Visible := RectVisible(Canvas.Handle, r);
474 if Pages[i]^.Visible then
475 ExcludeClipRect(Canvas.Handle, r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom - 1);
476 end;
477
478 with Canvas do
479 begin
480 Brush.Color := clGray;
481 FillRect(Rect(0, 0, Width, Height));
482 Pen.Color := clBlack;
483 Pen.Width := 1;
484 Pen.Mode := pmCopy;
485 Pen.Style := psSolid;
486 Brush.Color := clWhite;
487 end;
488
489 SelectClipRgn(Canvas.Handle, h);
490 for i := 0 to Pages.Count - 1 do // drawing page background
491 if Pages[i]^.Visible then
492 begin
493 r := Pages[i]^.r;
494 OffsetRect(r, Preview.ofx, Preview.ofy);
495 Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
496 Canvas.Polyline([Point(r.Left + 1, r.Bottom),
497 Point(r.Right, r.Bottom),
498 Point(r.Right, r.Top + 1)]);
499 end;
500
501 for i := 0 to Pages.Count - 1 do // drawing page content
502 begin
503 if Pages[i]^.Visible then
504 begin
505 r := Pages[i]^.r;
506 OffsetRect(r, Preview.ofx, Preview.ofy);
507 if Pages[i]^.pgMargins then
508 Pages.Draw(i, Canvas, r)
509 else
510 begin
511 with Preview, Pages[i]^.PrnInfo do
512 begin
513 r1.Left := Round(Ofx * per);
514 r1.Top := Round(Ofy * per);
515 r1.Right := r1.Left + Round(Pw * per);
516 r1.Bottom := r1.Top + Round(Ph * per);
517 Inc(r1.Left, r.Left); Inc(r1.Right, r.Left);
518 Inc(r1.Top, r.Top); Inc(r1.Bottom, r.Top);
519 end;
520 Pages.Draw(i, Canvas, r1);
521 end;
522 end
523 else
524 Pages.Draw(i, Canvas, Rect(0, 0, 0, 0)); // remove it from cache
525 end;
526 DeleteObject(h);
527 end;
528
529 procedure TfrPBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
530 var
531 i, k, PP: Integer;
532 pt: TPoint;
533 AInfo:string;
534 begin
535 if Preview.EMFPages = nil then Exit;
536 with Preview do
537 if Button = mbLeft then
538 begin
539 Pt:=Point(X - Preview.ofx, Y - Preview.ofy);
540 for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
541 if PtInRect(TfrEMFPages(EMFPages)[i]^.r, Pt) then
542 begin
543 if TfrEMFPages(EMFPages).DoMouseClick(i, Point(Round((pt.X - TfrEMFPages(EMFPages)[i]^.r.Left) / per), Round((pt.Y - TfrEMFPages(EMFPages)[i]^.r.Top) / per)), AInfo) then
544 begin
545 K:=Pos ('@', AInfo);
546 if (K > 0) then
547 begin
548 PP:=StrToIntDef(Copy(AInfo, K+1, 255), -1);
549 if (PP>0) and (K<TfrEMFPages(EMFPages).Count) then
550 begin
551 CurPage := PP;
552 SetToCurPage;
553 CurPage := PP;
554 ShowPageNum;
555 end;
556 end;
557 Exit;
558 end;
559
560 CurPage := i + 1;
561 SetToCurPage;
562 CurPage := i + 1;
563 ShowPageNum;
564 break;
565 end;
566 end
567 else
568 if Button = mbRight then
569 begin
570 pt := Self.ClientToScreen(Point(X, Y));
571 if frDesigner <> nil then
572 begin
573 N4.Visible := True;
574 N5.Visible := True;
575 N6.Visible := True;
576 N7.Visible := True;
577 end;
578 if THackControl(Preview.PreviewPanel.Parent).PopupMenu = nil then
579 ProcMenu.Popup(pt.x, pt.y) else
580 THackControl(Preview.PreviewPanel.Parent).PopupMenu.Popup(pt.x, pt.y);
581 end;
582 end;
583
584 type
585 THackView = class(TfrMemoView);
586
587 procedure TfrPBox.MouseMove(Shift: TShiftState; X, Y: Integer);
588 var
589 E:TfrEMFPages;
590 i:integer;
591 P:TPoint;
592 C:TCursor;
593 S:string;
594 V:TfrView;
595 begin
596 if not Assigned(Preview.EMFPages) then Exit;
597 E:=TfrEMFPages(Preview.EMFPages);
598 P:=Point(X - Preview.ofx, Y - Preview.ofy);
599 for i := 0 to E.Count - 1 do
600 if PtInRect(E[i]^.R, P) then
601 begin
602 V:=E.DoMouseMove(i, Point(Round((P.X - E[i]^.R.Left) / Preview.per), Round((P.Y - E[i]^.r.Top) / Preview.per)), C, S);
603 if Assigned(V) then
604 Cursor:=C
605 else
606 Cursor:=crDefault;
607
608 if FCurView <> V then
609 begin
610 if FCurView is TfrMemoView then
611 begin
612 THackView(FCurView).DoMouseLeave;
613 // THackView(FCurView).Invalidate;
614 end;
615 FCurView:=V;
616 if FCurView is TfrMemoView then
617 begin
618 THackView(FCurView).DoMouseEnter;
619 // THackView(FCurView).Invalidate;
620 end;
621 // Invalidate;
622 end;
623 Break;
624 end;
625 inherited MouseMove(Shift, X, Y);
626 end;
627
628 procedure TfrPBox.DblClick;
629 begin
630 if Preview.EMFPages = nil then Exit;
631 with Preview do
632 if N5.Visible then EditBtnClick(nil);
633 FCurView:=nil;
634 end;
635
636
637 {----------------------------------------------------------------------------}
638 procedure TfrPreviewForm.FormCreate(Sender: TObject);
639 begin
640 PBox := TfrPBox.Create(Self);
641 with PBox do
642 begin
643 Parent := ScrollBox1;
644 Align := alClient;
645 BevelInner := bvNone;
646 BevelOuter := bvNone;
647 Color := clGray;
648 Preview := Self;
649 Tag := 207;
650 OnMouseWheelDown := @MouseWheelDown;
651 OnMouseWheelUp := @MouseWheelUp;
652 end;
653
654 N1.Caption := sPreviewFormPW;
655 N2.Caption := sPreviewFormWhole;
656 N3.Caption := sPreviewForm2Pg;
657 N5.Caption := sPreviewFormEdit;
658 N6.Caption := sPreviewFormAdd;
659 N7.Caption := sPreviewFormDel;
660
661 ZoomBtn.Hint := sPreviewFormScale;
662 LoadBtn.Hint := sPreviewFormOpen;
663 SaveBtn.Hint := sPreviewFormSave;
664 PrintBtn.Hint := sPreviewFormPrint;
665 ExitBtn.Hint := sPreviewFormClose;
666 FindBtn.Hint := sPreviewFormFind;
667
668 // TODO: ADD hints to new buttons
669 CreateExportFilterItems;
670 end;
671
672 procedure TfrPreviewForm.FormDestroy(Sender: TObject);
673 begin
674 if EMFPages <> nil then
675 TfrEMFPages(EMFPages).Free;
676 PBox.Free;
677 end;
678
679 procedure TfrPreviewForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
680 begin
681 CloseAction := caFree;
682 end;
683
684 procedure TfrPreviewForm.FormActivate(Sender: TObject);
685 begin
686 Application.HelpFile := 'FRuser.hlp';
687 end;
688
689 procedure TfrPreviewForm.FormDeactivate(Sender: TObject);
690 begin
691 Application.HelpFile := HF;
692 end;
693
694 procedure TfrPreviewForm.Show_Modal(ADoc: Pointer);
695 var
696 GrayedButtons: Boolean;
697 begin
698 Connect(ADoc);
699
700 if not (csDesigning in TfrReport(Doc).ComponentState) then
701 begin
702 FindBtn.Visible := pbFind in TfrReport(Doc).PreviewButtons;
703 ZoomBtn.Visible := pbZoom in TfrReport(Doc).PreviewButtons;
704 SaveBtn.Visible := (pbSave in TfrReport(Doc).PreviewButtons) and not ((ExportFilters.Count = 0) and (roHideDefaultFilter in TfrReport(Doc).Options));
705 LoadBtn.Visible := pbLoad in TfrReport(Doc).PreviewButtons;
706 PrintBtn.Visible := pbPrint in TfrReport(Doc).PreviewButtons;
707 ExitBtn.Visible := pbExit in TfrReport(Doc).PreviewButtons;
708 if not ZoomBtn.Visible then
709 frTBSeparator1.Hide;
710 end;
711
712 PrintBtn.Enabled := Printer.Printers.Count > 0;
713 if frDesigner = nil then
714 begin
715 N4.Visible := False;
716 N5.Visible := False;
717 N6.Visible := False;
718 N7.Visible := False;
719 end;
720
721 case TfrReport(Doc).InitialZoom of
722 pzPageWidth: LastScaleMode := mdPageWidth;
723 pzOnePage: LastScaleMode := mdOnePage;
724 pzTwoPages: LastScaleMode := mdTwoPages;
725 end;
726
727
728 RedrawAll;
729 HScrollBar.Position := 0;
730 VScrollBar.Position := 0;
731
732 GrayedButtons := TfrReport(Doc).GrayedButtons;
733 (*
734 //TODO: designtime options are not saved so no restore,
735 // see lr_desgn.pas:TfrDesignerForm.SaveState;
736 {$IFDEF MSWINDOWS}
737 if frDesigner <> nil then
738 begin
739 Ini := TRegIniFile.Create('Software\FastReport\' + Application.Title);
740 GrayedButtons := Ini.ReadBool('Form\' + frDesigner.Name, 'GrayButtons', False);
741 Ini.Free;
742 end;
743 {$ENDIF}
744 *)
745 SetGrayedButtons(GrayedButtons);
746
747 HF := Application.HelpFile;
748 {$IFDEF DebugLR}
749 DebugLn('TfrReport(Doc).ModalPreview=',BoolToStr(TfrReport(Doc).ModalPreview));
750 {$ENDIF}
751 if TfrReport(Doc).ModalPreview then
752 begin
753 Visible:=False;
754 Enabled:=True;
755 ShowModal;
756 end
757 else Show;
758 end;
759
Printnull760 function TfrPreviewForm.Print: boolean;
761 var
762 Pages: String;
763 ind: Integer;
764
RebuildReportnull765 function RebuildReport: boolean;
766 begin
767 result := true;
768 if TfrReport(Doc).CanRebuild then
769 begin
770 if TfrReport(Doc).ChangePrinter(ind, Printer.PrinterIndex) then
771 begin
772 TfrEMFPages(EMFPages).Free;
773 EMFPages := nil;
774 TfrReport(Doc).PrepareReport;
775 Connect(Doc);
776 end
777 else
778 result := false;
779 end;
780 end;
781
782 procedure PrintReport(NumCopies: Integer);
783 begin
784 ConnectBack;
785 TfrReport(Doc).PrintPreparedReport(Pages, NumCopies);
786 Connect(Doc);
787 RedrawAll;
788 end;
789
790 begin
791 result := false;
792 if (EMFPages = nil) or (Printer.Printers.Count = 0) then Exit;
793 ind := Printer.PrinterIndex;
794 {$IFDEF PRINTDIALOG_NATIVE_PRINTDIALOG}
795 if TfrReport(Doc).DefaultCopies<1 then
796 prnDialog.Copies := 1
797 else
798 prnDialog.Copies:= TfrReport(Doc).DefaultCopies;
799 prnDialog.MaxPage := TfrEMFPages(EMFPages).Count;
800 prnDialog.MinPage:=1;
801 prnDialog.FromPage := 1;
802 prnDialog.ToPage := prnDialog.MaxPage;
803 if prnDialog.Execute then begin
804 if not RebuildReport then
805 exit;
806 Pages := format('%d-%d',[prnDialog.FromPage,prnDialog.ToPage]);
807 PrintReport(prnDialog.Copies);
808 end;
809 {$ELSE}
810 frPrintForm := TfrPrintForm.Create(nil);
811 frPrintForm.E1.Value:=TfrReport(Doc).DefaultCopies;
812 frPrintForm.cbCollate.Checked:=TfrReport(Doc).DefaultCollate;
813 // with frPrintForm do
814 // begin
815 if frPrintForm.ShowModal = mrOk then
816 begin
817 if TfrReport(Doc).RebuildPrinter and ((Printer.PrinterIndex <> ind) or Prn.UseVirtualPrinter) then
818 begin
819 if not RebuildReport then
820 exit;
821 end;
822
823 if frPrintForm.RB1.Checked then
824 Pages := ''
825 else
826 if frPrintForm.RB2.Checked then
827 Pages := IntToStr(CurPage)
828 else
829 Pages := frPrintForm.E2.Text;
830
831 TfrReport(Doc).DefaultCollate:=frPrintForm.cbCollate.Checked;
832 PrintReport(frPrintForm.E1.Value);
833 end;
834 frPrintForm.Free;
835 // end;
836 {$ENDIF}
837 result := true;
838 end;
839
840 procedure TfrPreviewForm.CreateExportFilterItems;
841 var
842 M: TMenuItem;
843 i: Integer;
844 B:TbitMap;
845 begin
846 if lrExportFilters.Count>0 then
847 begin
848 PopupMenu1.Items.Clear;
849 for i:=0 to lrExportFilters.Count-1 do
850 begin
851 M:=TMenuItem.Create(Self);
852 M.Tag:=I;
853 M.Caption:=TlrPreviewToolsAbstract(lrExportFilters[i]).Caption;
854 M.OnClick:=@ExportFilterItemExecClick;
855
856 B := TbitMap.Create;
857 B.LoadFromResourceName(HInstance, TlrPreviewToolsAbstract(lrExportFilters[i]).ClassName);
858 M.Bitmap.Assign(B);
859 B.Free;
860
861 PopupMenu1.Items.Add(M);
862 end;
863 end
864 else
865 SpeedButton1.Visible:=false;
866 end;
867
868 procedure TfrPreviewForm.ExportFilterItemExecClick(Sender: TObject);
869 var
870 i:integer;
871 begin
872 i:=TMenuItem(Sender).Tag;
873 ConnectBack;
874 TlrPreviewToolsAbstract(lrExportFilters[i]).Execute(TfrReport(Doc));
875 Connect(Doc);
876 Invalidate;
877 end;
878
ExportToWithFilterIndexnull879 function TfrPreviewForm.ExportToWithFilterIndex(AFilterIndex: Integer;
880 const AFileName: string):boolean;
881 var
882 S, S1:string;
883 i: SizeInt;
884 begin
885 if (AFilterIndex<0) or (AFilterIndex>=ExportFilters.Count) then
886 raise exception.Create(sExportFilterIndexError);
887 ConnectBack;
888
889 S:=Trim(AFileName);
890 if (S <> '') and (ExtractFileExt(S) = '') and (S[Length(S)]<>'.') then
891 begin
892 S1:=ExportFilters[AFilterIndex].FilterExt;
893 i:=Pos('.', S1);
894 if i>0 then
895 Delete(S1, 1, i-1);
896 S:=S+S1;
897 end;
898
899 TfrReport(Doc).ExportTo(ExportFilters[AFilterIndex].ClassRef, S);
900 Connect(Doc);
901 Result:=true;
902 end;
903
904 procedure TfrPreviewForm.Connect(ADoc: Pointer);
905 begin
906 Doc := ADoc;
907 if EMFPages <> nil then
908 TfrEMFPages(EMFPages).Free;
909 EMFPages := TfrReport(Doc).EMFPages;
910 TfrReport(Doc).EMFPages := TfrEMFPages.Create(TfrReport(Doc));
911 end;
912
913 procedure TfrPreviewForm.ConnectBack;
914 begin
915 TfrReport(Doc).EMFPages.Free;
916 TfrReport(Doc).EMFPages := TfrEMFPages(EMFPages);
917 EMFPages := nil;
918 end;
919
920 procedure TfrPreviewForm.ScrollbarDelta(const VertDelta, HorzDelta: Integer);
921 begin
922 if VertDelta<>0 then
923 VScrollBar.Position:=VScrollBar.Position + VertDelta;
924 if HorzDelta<>0 then
925 HScrollBar.Position:=HScrollBar.Position + HorzDelta;
926 end;
927
928 procedure TfrPreviewForm.MouseWheelDown(Sender: TObject; Shift: TShiftState;
929 MousePos: TPoint; var Handled: Boolean);
930 begin
931 if ssCtrl in shift then
932 BtZoomoutClick(sender)
933 else
934 if ssShift in Shift then
935 ScrollbarDelta(VScrollbar.SmallChange, 0)
936 else
937 ScrollBarDelta(VScrollbar.LargeChange, 0);
938 Handled := True;
939 end;
940
941 procedure TfrPreviewForm.MouseWheelUp(Sender: TObject; Shift: TShiftState;
942 MousePos: TPoint; var Handled: Boolean);
943 begin
944 if ssCtrl in shift then
945 BtZoomInClick(sender)
946 else
947 if ssShift in Shift then
948 ScrollbarDelta(-VScrollbar.SmallChange, 0)
949 else
950 ScrollBarDelta(-VScrollbar.LargeChange, 0);
951 Handled := True;
952 end;
953
954 {procedure TfrPreviewForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
955 begin
956 with Msg.MinMaxInfo^ do
957 begin
958 ptMaxSize.x := Screen.Width;
959 ptMaxSize.y := Screen.Height;
960 ptMaxPosition.x := 0;
961 ptMaxPosition.y := 0;
962 end;
963 end;
964 }
965 procedure TfrPreviewForm.SetGrayedButtons(Value: Boolean);
966 var
967 i: Integer;
968 c: TControl;
969 begin
970 for i := 0 to PanTop.ControlCount - 1 do
971 begin
972 c := PanTop.Controls[i];
973 if c is TBitBtn then
974 TBitBtn(c).Enabled := Value; //** GrayedInactive := Value;
975 end;
976 end;
977
978 procedure TfrPreviewForm.RedrawAll;
979 var
980 i: Integer;
981 begin
982 if EMFPages = nil then Exit;
983 per := LastScale;
984 mode := LastScaleMode;
985 if mode = mdPageWidth then
986 N1.Checked := True
987 else if mode = mdOnePage then
988 N2.Checked := True
989 else if mode = mdTwoPages then
990 N3.Checked := True
991 else
992 for i := 0 to ProcMenu.Items.Count - 1 do
993 if ProcMenu.Items[i].Tag = per * 100 then
994 ProcMenu.Items[i].Checked := True;
995
996 CurPage := 1;
997 ShowPageNum;
998 ofx := 0; ofy := 0; OldH := 0; OldV := 0;
999 HScrollBar.Position := 0;
1000 VScrollBar.Position := 0;
1001 FormResize(nil);
1002 for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
1003 begin
1004 TfrEMFPages(EMFPages)[i]^.Visible := False;
1005 TfrEMFPages(EMFPages).Draw(i, Canvas, Rect(0, 0, 0, 0));
1006 end;
1007 PBox.Repaint;
1008 end;
1009
1010 procedure TfrPreviewForm.FormResize(Sender: TObject);
1011 var
1012 i, j, y, d, nx, dwx, dwy, maxx, maxy, maxdy, curx: Integer;
1013 Pages: TfrEMFPages;
1014 begin
1015 if EMFPages = nil then Exit;
1016 Pages := TfrEMFPages(EMFPages);
1017 PaintAllowed := False;
1018 with Pages[CurPage - 1]^.PrnInfo do
1019 begin
1020 dwx := Pgw; dwy := Pgh;
1021 end;
1022 case mode of
1023 mdNone:;
1024 mdPageWidth: per := (PBox.Width - 20) / dwx;
1025 mdOnePage: per := (PBox.Height - 20) / dwy;
1026 mdTwoPages: per := (PBox.Width - 30) / (2 * dwx);
1027 end;
1028 ZoomBtn.Caption := IntToStr(Round(per * 100)) + '%';
1029 nx := 0; maxx := 10; j := 0;
1030 for i := 0 to Pages.Count - 1 do
1031 begin
1032 d := maxx + 10 + Round(Pages[i]^.PrnInfo.Pgw * per);
1033 if d > PBox.Width then
1034 begin
1035 if nx < j then nx := j;
1036 j := 0;
1037 maxx := 10;
1038 end
1039 else
1040 begin
1041 maxx := d;
1042 Inc(j);
1043 if i = Pages.Count - 1 then
1044 if nx < j then nx := j;
1045 end;
1046 end;
1047 if nx = 0 then nx := 1;
1048 if mode = mdOnePage then nx := 1;
1049 if mode = mdTwoPages then nx := 2;
1050 y := 10;
1051 i := 0;
1052 maxx := 0; maxy := 0;
1053 while i < Pages.Count do
1054 begin
1055 j := 0; maxdy := 0; curx := 10;
1056 while (j < nx) and (i + j < Pages.Count) do
1057 begin
1058 dwx := Round(Pages[i + j]^.PrnInfo.Pgw * per);
1059 dwy := Round(Pages[i + j]^.PrnInfo.Pgh * per);
1060 if (nx = 1) and (dwx < PBox.Width) then
1061 begin
1062 d := (PBox.Width - dwx) div 2;
1063 Pages[i + j]^.r := Rect(d, y, d + dwx, y + dwy);
1064 end
1065 else
1066 Pages[i + j]^.r := Rect(curx, y, curx + dwx, y + dwy);
1067 if maxx < Pages[i + j]^.r.Right then
1068 maxx := Pages[i + j]^.r.Right;
1069 if maxy < Pages[i + j]^.r.Bottom then
1070 maxy := Pages[i + j]^.r.Bottom;
1071 Inc(j);
1072 if maxdy < dwy then maxdy := dwy;
1073 Inc(curx, dwx + 10);
1074 end;
1075 Inc(y, maxdy + 10);
1076 Inc(i, nx);
1077 end;
1078
1079 // REMOVE: scrolls size hacks
1080 //VScrollBar.Height := RPanel.Height - PgUp.height - PgDown.height;
1081 //if RPanel.Visible then
1082 // HScrollbar.Width := BPanel.Width - HScrollbar.Left - RPanel.Width;
1083
1084 if maxx < 0 then maxx := 0 else Inc(maxx, 10);
1085 if maxy < 0 then maxy := 0 else Inc(maxy, 10);
1086
1087 HScrollBar.Max := maxx;
1088 VScrollBar.Max := maxy;
1089 VScrollBar.PageSize := Scrollbox1.ClientHeight;
1090 Hscrollbar.PageSize := Scrollbox1.ClientWidth;
1091 HScrollBar.Enabled := maxx <> 0;
1092 VScrollBar.Enabled := maxy <> 0;
1093
1094 SetToCurPage;
1095 PaintAllowed := True;
1096 LastScale := per;
1097 LastScaleMode := mode;
1098 end;
1099
1100 procedure TfrPreviewForm.BtZoomOutClick(Sender: TObject);
1101 begin
1102 if EMFPages = nil then Exit;
1103 ofx := 0;
1104 if LastScale > 0.1 then
1105 begin
1106 mode := mdNone;
1107 per := (LastScale - 0.1);
1108 HScrollBar.Position := 0;
1109 FormResize(nil);
1110 PBox.Repaint;
1111 end;
1112 end;
1113
1114 procedure TfrPreviewForm.BtZoomInClick(Sender: TObject);
1115 begin
1116 if EMFPages = nil then Exit;
1117 ofx := 0;
1118 if LastScale < 100 then
1119 begin
1120 mode := mdNone;
1121 per := (LastScale + 0.1);
1122 HScrollBar.Position := 0;
1123 FormResize(nil);
1124 PBox.Repaint;
1125 end;
1126 end;
1127
1128 procedure TfrPreviewForm.BtPgFirstClick(Sender: TObject);
1129 begin
1130 if EMFPages = nil then Exit;
1131 if CurPage > 1 then
1132 CurPage := 1;
1133 ShowPageNum;
1134 SetToCurPage;
1135 end;
1136
1137 procedure TfrPreviewForm.BtPgLastClick(Sender: TObject);
1138 begin
1139 if EMFPages = nil then Exit;
1140 if CurPage < TfrEMFPages(EMFPages).Count then
1141 CurPage := TfrEMFPages(EMFPages).Count;
1142 ShowPageNum;
1143 SetToCurPage;
1144 end;
1145
1146 procedure TfrPreviewForm.PageSetupBtnClick(Sender: TObject);
1147 var
1148 w, h, p, Ind: Integer;
1149 CurrentPage : TfrPage;
1150 WasOk: Boolean;
1151 R: TfrReport;
1152 lOrientation : TPrinterOrientation;
PointsToMMStrnull1153 function PointsToMMStr(value:Integer): string;
1154 begin
1155 result := IntToStr(Trunc(value*5/18+0.5));
1156 end;
MMStrToPointsnull1157 function MMStrToPoints(value:string): Integer;
1158 begin
1159 result := Trunc(Trunc(StrToFloatDef(value, 0.0))*18/5+0.5)
1160 end;
1161 begin
1162 if TfrEMFPages(EMFPages).Count = 0 then
1163 Exit;
1164 if (Doc = nil) or not TfrReport(Doc).ModifyPrepared then Exit;
1165 R := TfrReport(Doc);
1166 TfrEMFPages(EMFPages).ObjectsToPage(CurPage -1);
1167 CurrentPage := TfrEMFPages(EMFPages)[ CurPage -1 ]^.Page;
1168 frPgoptForm := TfrPgoptForm.Create(nil);
1169 with frPgoptForm, CurrentPage do
1170 begin
1171 CB1.Checked := PrintToPrevPage;
1172 CB5.Checked := not UseMargins;
1173 if Orientation = poPortrait then
1174 RB1.Checked := True
1175 else
1176 RB2.Checked := True;
1177 Prn.FillPapers(COMB1.Items);
1178 Ind := COMB1.Items.IndexOfObject(TObject(PtrInt(pgSize)));
1179 if Ind >= 0 then
1180 ComB1.ItemIndex := Ind
1181 else
1182 if COMB1.Items.count > 0 then
1183 COMB1.ItemIndex := 0;
1184 E1.Text := ''; E2.Text := '';
1185
1186 if pgSize = $100 then
1187 begin
1188 PaperWidth := round(Width * 25.4 / 72); // pt to mm
1189 PaperHeight := round(Height * 25.4 / 72); // pt to mm
1190 end;
1191
1192 E3.Text := PointsToMMStr(Margins.Left);
1193 E4.Text := PointsToMMStr(Margins.Top);
1194 E5.Text := PointsToMMStr(Margins.Right);
1195 E6.Text := PointsToMMStr(Margins.Bottom);
1196 E7.Text := PointsToMMStr(ColGap);
1197
1198 ecolCount.Value := ColCount;
1199 if LayoutOrder = loColumns then
1200 RBColumns.Checked := true
1201 else
1202 RBRows.Checked := true;
1203 WasOk := False;
1204 if ShowModal = mrOk then
1205 begin
1206 WasOk := True;
1207 PrintToPrevPage := CB1.Checked;
1208 UseMargins := not CB5.Checked;
1209 if RB1.Checked then
1210 lOrientation := poPortrait
1211 else
1212 lOrientation := poLandscape;
1213 Orientation := lOrientation;
1214 if RBColumns.Checked then
1215 LayoutOrder := loColumns
1216 else
1217 LayoutOrder := loRows;
1218
1219 p := frPgoptForm.pgSize;
1220 w := 0; h := 0;
1221 if p = $100 then
1222 try
1223 w := round(PaperWidth * 72 / 25.4); // mm to pt
1224 h := round(PaperHeight * 72 / 25.4); // mm to pt
1225 except
1226 on exception do p := 9; // A4
1227 end;
1228
1229 Margins.Left := MMStrToPoints(E3.Text);
1230 Margins.Top := MMStrToPoints(E4.Text);
1231 Margins.Right := MMStrToPoints(E5.Text);
1232 Margins.Bottom := MMStrToPoints(E6.Text);
1233 ColGap := MMStrToPoints(E7.Text);
1234
1235 ColCount := ecolCount.Value;
1236 ChangePaper(p, w, h, Orientation);
1237 end;
1238 end;
1239 frPgoptForm.Free;
1240 if WasOk then begin
1241 TfrReport( CurReport ).Pages[CurPage -1].ChangePaper(p, w, h, lOrientation);
1242 R.PrepareReport;
1243 Connect(R);
1244 RedrawAll;
1245 HScrollBar.Position := 0;
1246 VScrollBar.Position := 0;
1247 end;
1248
1249 end;
1250
1251 procedure TfrPreviewForm.SettingsBtnClick(Sender: TObject);
1252 var
1253 R: TfrReport;
1254 begin
1255 if (Doc = nil) or not TfrReport(Doc).ModifyPrepared then Exit;
1256 R := TfrReport(Doc);
1257 if ShowReportoptions(R) then begin
1258 R.PrepareReport;
1259 Connect(R);
1260 RedrawAll;
1261 HScrollBar.Position := 0;
1262 VScrollBar.Position := 0; ;
1263 end;
1264
1265 end;
1266
1267
TfrPreviewForm.ShowReportoptionsnull1268 Function TfrPreviewForm.ShowReportoptions( const CurReport : TObject ) : Boolean;
1269 var
1270 OldIndex: Integer;
1271 begin
1272 frDocOptForm := TfrDocOptForm.Create(nil);
1273 with frDocOptForm do
1274 begin
1275 Result := False;
1276 CB1.Checked := not TfrReport( CurReport ).PrintToDefault;
1277 CB2.Checked := TfrReport( CurReport ).DoublePass;
1278 edTitle.Text := TfrReport( CurReport ).Title;
1279 edComments.Text := TfrReport( CurReport ).Comments.Text;
1280 edKeyWords.Text := TfrReport( CurReport ).KeyWords;
1281 edSubject.Text := TfrReport( CurReport ).Subject;
1282 edAutor.Text := TfrReport( CurReport ).ReportAutor;
1283 edtMaj.Text := TfrReport( CurReport ).ReportVersionMajor;
1284 edtMinor.Text := TfrReport( CurReport ).ReportVersionMinor;
1285 edtRelease.Text := TfrReport( CurReport ).ReportVersionRelease;
1286 edtBuild.Text := TfrReport( CurReport ).ReportVersionBuild;
1287 edtRepCreateDate.Text := DateTimeToStr(TfrReport( CurReport ).ReportCreateDate);
1288 edtRepLastChangeDate.Text := DateTimeToStr(TfrReport( CurReport ).ReportLastChange);
1289 if ShowModal = mrOk then
1290 begin
1291 TfrReport( CurReport ).PrintToDefault := not CB1.Checked;
1292 TfrReport( CurReport ).DoublePass := CB2.Checked;
1293 OldIndex := Prn.PrinterIndex;
1294 Prn.PrinterIndex := -1;
1295 TfrReport( CurReport ).ChangePrinter(OldIndex, ListBox1.ItemIndex);
1296 TfrReport( CurReport ).Title:=edTitle.Text;
1297 TfrReport( CurReport ).Subject:=edSubject.Text;
1298 TfrReport( CurReport ).KeyWords:=edKeyWords.Text;
1299 TfrReport( CurReport ).Comments.Text:=edComments.Text;
1300 TfrReport( CurReport ).ReportVersionMajor:=edtMaj.Text;
1301 TfrReport( CurReport ).ReportVersionMinor:=edtMinor.Text;
1302 TfrReport( CurReport ).ReportVersionRelease:=edtRelease.Text;
1303 TfrReport( CurReport ).ReportVersionBuild:=edtBuild.Text;
1304 TfrReport( CurReport ).ReportAutor:=edAutor.Text;
1305 Result := True;
1306 end;
1307 CurPage := CurPage;
1308 Free;
1309 end;
1310
1311 end;
1312
1313
1314 procedure TfrPreviewForm.SpeedButton1Click(Sender: TObject);
1315 var
1316 R:TPoint;
1317 begin
1318 R:=ClientToScreen(Point(SpeedButton1.Left, SpeedButton1.Top + SpeedButton1.Height));
1319 PopupMenu1.PopUp(R.X, R.Y);
1320 end;
1321
1322 procedure TfrPreviewForm.SetToCurPage;
1323 begin
1324 if EMFPages = nil then Exit;
1325 if ofy <> TfrEMFPages(EMFPages)[CurPage - 1]^.r.Top - 10 then
1326 VScrollBar.Position := TfrEMFPages(EMFPages)[CurPage - 1]^.r.Top - 10;
1327
1328 PBox.Invalidate;
1329 end;
1330
1331 procedure TfrPreviewForm.ShowPageNum;
1332 begin
1333 if EMFPages = nil then Exit;
1334 LbPanel.Caption := sPg + ' ' + IntToStr(CurPage) + '/' +
1335 IntToStr(TfrEMFPages(EMFPages).Count);
1336
1337 if Assigned(FOnScrollPage) then
1338 FOnScrollPage(Self);
1339 end;
1340
1341 procedure TfrPreviewForm.VScrollBarChange(Sender: TObject);
1342 var
1343 {$IFDEF WIN32}
1344 r: TRect;
1345 pp: Integer;
1346 {$ENDIF}
1347 p: Integer;
1348 i: integer;
1349 Pages: TfrEMFPages;
1350 begin
1351 if EMFPages = nil then Exit;
1352 p := VScrollBar.Position;
1353 ofy := -p;
1354 {$IFDEF WIN32}
1355 pp := OldV - p;
1356 OldV := p;
1357 r := Rect(0, 0, PBox.Width, PBox.Height);
1358 ScrollWindowEx(PBox.Handle, 0, pp, @r, @r, 0, nil, SW_INVALIDATE);
1359 UpdateWindow(Pbox.Handle);
1360 {$ELSE}
1361 PBox.Invalidate;
1362 {$ENDIF}
1363 Pages := TfrEMFPages(EMFPages);
1364 for i := 0 to Pages.Count-1 do
1365 if (Pages[i]^.r.Top < -ofy + 11) and
1366 (Pages[i]^.r.Bottom > -ofy + 11) then
1367 begin
1368 CurPage := i + 1;
1369 ShowPageNum;
1370 break;
1371 end;
1372 end;
1373
1374 procedure TfrPreviewForm.HScrollBarChange(Sender: TObject);
1375 var
1376 p: Integer;
1377 {$IFDEF WIN32}
1378 pp: Integer;
1379 r: TRect;
1380 {$ENDIF}
1381 begin
1382 if EMFPages = nil then Exit;
1383 p := HScrollBar.Position;
1384 ofx := -p;
1385 {$IFDEF WIN32}
1386 pp := OldH - p;
1387 OldH := p;
1388 r := Rect(0, 0, PBox.Width, PBox.Height);
1389 ScrollWindowEx(PBox.Handle, pp, 0, @r, @r, 0, nil, SW_INVALIDATE);
1390 UpdateWindow(Pbox.Handle);
1391 {$ELSE}
1392 PBox.Invalidate;
1393 {$ENDIF}
1394 end;
1395
1396 procedure TfrPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
1397 Shift: TShiftState);
1398 begin
1399 if EMFPages = nil then Exit;
1400 if Key in [vk_Up, vk_Down, vk_Prior, vk_Next] then
1401 if VScrollBar.Enabled then VScrollBar.SetFocus;
1402 if Key in [vk_Left, vk_Right] then
1403 if HScrollBar.Enabled then HScrollBar.SetFocus;
1404 if Key = vk_Up then
1405 ScrollBarDelta(-VScrollBar.SmallChange, 0)
1406 else if Key = vk_Down then
1407 ScrollBarDelta(VScrollBar.SmallChange, 0)
1408 else if Key = vk_Left then
1409 ScrollBarDelta(0, -HScrollBar.SmallChange)
1410 else if Key = vk_Right then
1411 ScrollBarDelta(0, HScrollBar.SmallChange)
1412 else if Key = vk_Prior then
1413 if ssCtrl in Shift then
1414 PgUpClick(nil) else
1415 ScrollBarDelta(-VScrollBar.LargeChange, 0)
1416 else if Key = vk_Next then
1417 if ssCtrl in Shift then
1418 PgDownClick(nil) else
1419 ScrollBarDelta(VScrollBar.LargeChange, 0)
1420 else if Key = vk_Space then
1421 ZoomBtnClick(nil)
1422 else if Key = vk_Escape then
1423 ExitBtnClick(nil)
1424 else if Key = vk_Home then
1425 if ssCtrl in Shift then
1426 VScrollBar.Position := 0 else
1427 Exit
1428 else if Key = vk_End then
1429 if ssCtrl in Shift then
1430 begin
1431 CurPage := TfrEMFPages(EMFPages).Count;
1432 SetToCurPage;
1433 end
1434 else Exit
1435 else if ssCtrl in Shift then
1436 begin
1437 if Chr(Key) = 'O' then LoadBtnClick(nil)
1438 else if Chr(Key) = 'S' then SaveBtnClick(nil)
1439 else if (Chr(Key) = 'P') and PrintBtn.Visible then PrintBtnClick(nil)
1440 else if Chr(Key) = 'F' then FindBtnClick(nil)
1441 else if (Chr(Key) = 'E') and N5.Visible then EditBtnClick(nil)
1442 end
1443 else if Key = vk_F3 then
1444 begin
1445 if SearchFindStr <> '' then
1446 begin
1447 if SearchLastFoundPage <> CurPage - 1 then
1448 begin
1449 SearchLastFoundPage := CurPage - 1;
1450 SearchLastFoundObject := 0;
1451 end;
1452 FindText;
1453 end;
1454 end
1455 else if (Key = vk_Delete) and N5.Visible then
1456 DelPageBtnClick(nil)
1457 else if (Key = vk_Insert) and N5.Visible then
1458 NewPageBtnClick(nil)
1459 else Exit;
1460 Key := 0;
1461 end;
1462
1463 procedure TfrPreviewForm.PgUpClick(Sender: TObject);
1464 begin
1465 if EMFPages = nil then Exit;
1466 if CurPage > 1 then Dec(CurPage);
1467 ShowPageNum;
1468 SetToCurPage;
1469 end;
1470
1471 procedure TfrPreviewForm.PgDownClick(Sender: TObject);
1472 begin
1473 if EMFPages = nil then Exit;
1474 if CurPage < TfrEMFPages(EMFPages).Count then
1475 Inc(CurPage);
1476 ShowPageNum;
1477 SetToCurPage;
1478 end;
1479
1480 procedure TfrPreviewForm.ZoomBtnClick(Sender: TObject);
1481 var
1482 pt: TPoint;
1483 begin
1484 pt := ClientToScreen(Point(ZoomBtn.Left, ZoomBtn.Top + ZoomBtn.Height + 2));
1485 N4.Visible := False;
1486 N5.Visible := False;
1487 N6.Visible := False;
1488 N7.Visible := False;
1489 ProcMenu.Popup(pt.x + 4, pt.y + 6);
1490 end;
1491
1492 procedure TfrPreviewForm.N3Click(Sender: TObject);
1493 begin
1494 if EMFPages = nil then Exit;
1495 ofx := 0;
1496 with Sender as TMenuItem do
1497 begin
1498 case Tag of
1499 1: mode := mdPageWidth;
1500 2: mode := mdOnePage;
1501 3: mode := mdTwoPages;
1502 else
1503 begin
1504 mode := mdNone;
1505 per := Tag / 100;
1506 end;
1507 end;
1508 Checked := True;
1509 end;
1510 HScrollBar.Position := 0;
1511 FormResize(nil);
1512 PBox.Repaint;
1513 end;
1514
1515 procedure TfrPreviewForm.LoadBtnClick(Sender: TObject);
1516 begin
1517 if EMFPages = nil then Exit;
1518 OpenDialog.Filter := sRepFile + ' (*.frp)|*.frp';
1519 with OpenDialog do
1520 if Execute then
1521 LoadFromFile(FileName);
1522 end;
1523
1524 procedure TfrPreviewForm.SaveBtnClick(Sender: TObject);
1525 var
1526 i, Index: Integer;
1527 FilterStr: string;
1528 FilterInfo: TExportFilterItem;
1529 FExtList:TStringList;
1530 begin
1531 if EMFPages = nil then Exit;
1532 FExtList:=TStringList.Create;
1533 try
1534 Index := 1;
1535 if not (roHideDefaultFilter in TfrReport(Doc).Options) then
1536 begin
1537 FExtList.Add('*.frp');
1538 FilterStr := sRepFile + ' (*.frp)|*.frp';
1539 end else
1540 FilterStr := '';
1541
1542 for i := 0 to ExportFilters.Count - 1 do
1543 begin
1544 FilterInfo := ExportFilters[i];
1545 if FilterInfo.Enabled then
1546 begin
1547 FExtList.AddObject(FilterInfo.FilterExt, TObject(PtrInt(i+1)));
1548 if FilterStr <> '' then
1549 FilterStr := FilterStr + '|';
1550 FilterStr := FilterStr + FilterInfo.FilterDesc + '|' + FilterInfo.FilterExt;
1551 end;
1552 end;
1553
1554 SaveDialog.Filter := FilterStr;
1555 SaveDialog.FilterIndex := Index;
1556 if SaveDialog.Execute then
1557 begin
1558 Index := SaveDialog.FilterIndex - 1;
1559 if fExtList.Objects[Index]=nil then
1560 SaveToFile(SaveDialog.Filename) // using .frp
1561 else
1562 begin
1563 Index := PtrInt(fExtList.Objects[Index])-1;
1564 ExportToWithFilterIndex(Index, SaveDialog.FileName);
1565 end;
1566 end;
1567
1568 finally
1569 FExtList.Free;
1570 ScrollBox1.Invalidate;
1571 end;
1572 end;
1573
1574 procedure TfrPreviewForm.PrintBtnClick(Sender: TObject);
1575 begin
1576 Print;
1577 end;
1578
1579 procedure TfrPreviewForm.ExitBtnClick(Sender: TObject);
1580 begin
1581 if Doc = nil then Exit;
1582 if TfrReport(Doc).ModalPreview then
1583 ModalResult := mrOk else
1584 Close;
1585 end;
1586
1587 procedure TfrPreviewForm.LoadFromFile(const aName: String);
1588 begin
1589 if Doc = nil then Exit;
1590 TfrEMFPages(EMFPages).Free;
1591 EMFPages := nil;
1592 TfrReport(Doc).LoadPreparedReport(aName);
1593 Connect(Doc);
1594 CurPage := 1;
1595 FormResize(nil);
1596 PaintAllowed := False;
1597 ShowPageNum;
1598 SetToCurPage;
1599 PaintAllowed := True;
1600 PBox.Repaint;
1601 end;
1602
1603 procedure TfrPreviewForm.SaveToFile(const aName:String);
1604 begin
1605 if Doc = nil then Exit;
1606 ConnectBack;
1607 TfrReport(Doc).SavePreparedReport(ChangeFileExt(aName, '.frp'));
1608 Connect(Doc);
1609 end;
1610
TfrPreviewForm.FindInEMFPagesnull1611 function TfrPreviewForm.FindInEMFPages: boolean;
1612 var
1613 P:PfrPageInfo;
1614 V:TfrObject;
1615 i, j, SK:integer;
1616 Pages : TfrEMFPages;
1617 S:string;
1618 begin
1619 Result:=false;
1620 if not Assigned(EMFPages) then exit;
1621
1622 Pages := TfrEMFPages(EMFPages);
1623 Pages.ResetFindData;
1624
1625 for i:=SearchLastFoundPage to Pages.Count - 1 do
1626 begin
1627 P:=Pages[i];
1628
1629 if not Assigned(P^.Page) then
1630 Pages.ObjectsToPage(i);
1631
1632 if i = SearchLastFoundPage then
1633 SK:=SearchLastFoundObject + 1
1634 else
1635 SK:=0;
1636
1637 for j:=SK to P^.Page.Objects.Count - 1 do
1638 begin
1639 V:=TfrView(P^.Page.Objects[j]);
1640 if V is TfrMemoView then
1641 begin
1642 S:=TfrMemoView(V).Memo.Text;
1643 if not SearchCaseSensitive then
1644 S := UTF8UpperCase(S);
1645
1646 if UTF8Pos(SearchFindStr, S)>0 then
1647 begin
1648 TfrMemoView(V).FindHighlight:=true;
1649 CurPage:=i + 1;
1650
1651 SearchLastFoundPage:=i;
1652 SearchLastFoundObject:=j;
1653
1654 ShowPageNum;
1655 SetToCurPage;
1656 Result:=true;
1657 exit;
1658 end;
1659 end;
1660 end;
1661
1662 end;
1663 end;
1664
1665 procedure TfrPreviewForm.FindText;
1666 begin
1667 PaintAllowed := False;
1668 if not FindInEMFPages then
1669 ShowMessage(sFindTextNotFound);
1670 PaintAllowed := True;
1671 end;
1672
1673 procedure TfrPreviewForm.FindBtnClick(Sender: TObject);
1674 var
1675 SrchForm: TfrPreviewSearchForm;
1676 begin
1677 if Doc = nil then Exit;
1678
1679 SrchForm := TfrPreviewSearchForm.Create(nil);
1680 SrchForm.Edit1.Text:=SearchFindStr;
1681 SrchForm.GroupBox1.Checked[0]:=SearchCaseSensitive;
1682 SrchForm.GroupBox2.ItemIndex:=SearchDirecion;
1683
1684
1685 if SrchForm.ShowModal = mrOk then
1686 begin
1687 SearchFindStr := SrchForm.Edit1.Text;
1688 SearchCaseSensitive := SrchForm.GroupBox1.Checked[0];// CB1.Checked;
1689 SearchDirecion:=SrchForm.GroupBox2.ItemIndex;
1690
1691 if not SearchCaseSensitive then
1692 SearchFindStr := UTF8UpperCase(SearchFindStr);
1693 if SrchForm.GroupBox2.ItemIndex = 0 {RB1.Checked} then
1694 begin
1695 SearchLastFoundPage := 0;
1696 SearchLastFoundObject := 0;
1697 end
1698 else
1699 if SearchLastFoundPage <> CurPage - 1 then
1700 begin
1701 SearchLastFoundPage := CurPage - 1;
1702 SearchLastFoundObject := 0;
1703 end;
1704 FindText;
1705 end;
1706 SrchForm.Free;
1707 end;
1708
1709 procedure TfrPreviewForm.EditBtnClick(Sender: TObject);
1710 var
1711 R: TfrReport;
1712 begin
1713 if (Doc = nil) or not TfrReport(Doc).ModifyPrepared then Exit;
1714 { ConnectBack;
1715 TfrReport(Doc).EditPreparedReport(CurPage - 1);
1716 Connect(Doc);}
1717
1718 R:=TfrReport.Create(nil);
1719 R.EMFPages.Free;
1720 R.EMFPages := TfrEMFPages(EMFPages);
1721 EMFPages := nil;
1722 R.EditPreparedReport(CurPage - 1);
1723
1724 if EMFPages <> nil then
1725 TfrEMFPages(EMFPages).Free;
1726
1727 EMFPages := R.EMFPages;
1728 R.EMFPages:=nil;
1729 // TfrReport(Doc).EMFPages := TfrEMFPages.Create(TfrReport(Doc));
1730
1731 R.Free;
1732 RedrawAll;
1733 end;
1734
1735 procedure TfrPreviewForm.DelPageBtnClick(Sender: TObject);
1736 begin
1737 if Doc = nil then Exit;
1738 if TfrEMFPages(EMFPages).Count > 1 then
1739 if MessageBox(0, PChar(sRemovePg), PChar(sConfirm),
1740 mb_YesNo + mb_IconQuestion) = mrYes then
1741 begin
1742 TfrEMFPages(EMFPages).Delete(CurPage - 1);
1743 RedrawAll;
1744 end;
1745 end;
1746
1747 procedure TfrPreviewForm.NewPageBtnClick(Sender: TObject);
1748 begin
1749 if Doc = nil then Exit;
1750 TfrEMFPages(EMFPages).Insert(CurPage - 1, TfrReport(Doc).Pages[0]);
1751 RedrawAll;
1752 end;
1753
1754 procedure TfrPreviewForm.HelpBtnClick(Sender: TObject);
1755 begin
1756 Screen.Cursor := crHelp;
1757 SetCapture(Handle);
1758 end;
1759
1760 procedure TfrPreviewForm.FormMouseDown(Sender: TObject;
1761 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1762 begin
1763 Screen.Cursor := crDefault;
1764 end;
1765
1766 end.
1767
1768