1
2 {*****************************************}
3 { }
4 { FastReport v2.3 }
5 { Report Designer }
6 { }
7 { Copyright (c) 1998-99 by Tzyganenko A. }
8 { }
9 {*****************************************}
10
11 unit LR_Desgn;
12
13 interface
14
15 {$I lr_vers.inc}
16 {.$Define ExtOI} // External Custom Object inspector (Christian)
17 {.$Define StdOI} // External Standard Object inspector (Jesus)
18 {$define sbod} // status bar owner draw
19 {$define ppaint}
20 uses
21 Classes, SysUtils, Types, LazFileUtils, LazUTF8, LMessages,
22 Forms, Controls, Graphics, Dialogs, ComCtrls,
23 ExtCtrls, Buttons, StdCtrls, Menus,
24
25 LCLType,LCLIntf,LCLProc,GraphType,Printers, ActnList,
26
27 ObjectInspector, PropEdits, GraphPropEdits,
28
29 LR_Class, LR_Color,LR_Edit;
30
31
32 const
33 MaxUndoBuffer = 100;
34 crPencil = 11;
35 dtFastReportForm = 1;
36 dtFastReportTemplate = 2;
37 dtLazReportForm = 3;
38 dtLazReportTemplate = 4;
39
40 type
41 TLoadReportEvent = procedure(Report: TfrReport; var ReportName: String) of object;
42 TSaveReportEvent = procedure(Report: TfrReport; var ReportName: String;
43 SaveAs: Boolean; var Saved: Boolean) of object;
44
45 TfrDesignerForm = class;
46 //TlrTabEditControl = class(TCustomTabControl);
47
48 { TfrDesigner }
49
50 TfrDesigner = class(TComponent) // fake component
51 private
52 FOnLoadReport: TLoadReportEvent;
53 FOnSaveReport: TSaveReportEvent;
54 FTemplDir: String;
55 public
56 constructor Create(AOwner: TComponent); override;
57 destructor Destroy; override;
58 procedure Loaded; override;
59 published
60 property TemplateDir: String read FTemplDir write FTemplDir;
61 property OnLoadReport: TLoadReportEvent read FOnLoadReport write FOnLoadReport;
62 property OnSaveReport: TSaveReportEvent read FOnSaveReport write FOnSaveReport;
63 end;
64
65 TfrSelectionType = (ssBand, ssMemo, ssOther, ssMultiple, ssClipboardFull);
66 TfrSelectionStatus = set of TfrSelectionType;
67 TfrReportUnits = (ruPixels, ruMM, ruInches);
68 TfrShapeMode = (smFrame, smAll);
69
70 TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder, acDuplication);
71 PfrUndoObj = ^TfrUndoObj;
72 TfrUndoObj = record
73 Next: PfrUndoObj;
74 ObjID: Integer;
75 ObjPtr: TfrView;
76 Int: Integer;
77 end;
78
79 TfrUndoRec = record
80 Action: TfrUndoAction;
81 Page: Integer;
82 Objects: PfrUndoObj;
83 end;
84
85 PfrUndoRec1 = ^TfrUndoRec1;
86 TfrUndoRec1 = record
87 ObjPtr: TfrView;
88 Int: Integer;
89 end;
90
91 PfrUndoBuffer = ^TfrUndoBuffer;
92 TfrUndoBuffer = Array[0..MaxUndoBuffer - 1] of TfrUndoRec;
93
94 TfrMenuItemInfo = class(TObject)
95 private
96 MenuItem: TMenuItem;
97 Btn : TSpeedButton;
98 end;
99
100 TfrDesignerDrawMode = (dmAll, dmSelection, dmShape);
101 TfrCursorType = (ctNone, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8);
102 TfrDesignMode = (mdInsert, mdSelect);
103
104 TfrSplitInfo = record
105 SplRect: TRect;
106 SplX : Integer;
107 View1,
108 View2 : TfrView;
109 end;
110
111 TViewAction = procedure(View: TFrView; Data:PtrInt) of object;
112
113 { TfrObjectInspector }
114 TfrObjectInspector = Class({$IFDEF EXTOI}TForm{$ELSE}TPanel{$ENDIF})
115 private
116 FSelectedObject: TObject;
117 fPropertyGrid : TCustomPropertiesGrid;
118 {$IFNDEF EXTOI}
119 fcboxObjList : TComboBox;
120 fBtn,fBtn2 : TButton;
121 fPanelHeader : TPanel;
122 fLastHeight : Word;
123 fDown : Boolean;
124 fPt : TPoint;
125
126 procedure BtnClick(Sender : TObject);
127 procedure HeaderMDown(Sender: TOBject; Button: TMouseButton;
128 {%H-}Shift: TShiftState; X, Y: Integer);
129 procedure HeaderMMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X,
130 {%H-}Y: Integer);
131 procedure HeaderMUp(Sender: TOBject; {%H-}Button: TMouseButton;
132 {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
133 {$ENDIF}
134 protected
135 procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
136 {$IFDEF EXTOI}
137 procedure DoHide; override;
138 {$ENDIF}
139 public
140 constructor Create(aOwner : TComponent); override;
141 destructor Destroy; override;
142
143 procedure Select(Obj: TObject);
144 procedure cboxObjListOnChanged(Sender: TObject);
145 procedure SetModifiedEvent(AEvent: TNotifyEvent);
146 procedure Refresh;
147 property SelectedObject:TObject read FSelectedObject;
148 end;
149
150 TPaintSel = class;
151 TAlignGuides = class;
152
153 { TfrDesignerPage }
154
155 TfrDesignerPage = class(TCustomControl)
156 private
157 Down, // mouse button was pressed
158 Moved, // mouse was moved (with pressed btn)
159 DFlag, // was double click
160 RFlag: Boolean; // selecting objects by framing
161 Mode : TfrDesignMode; // current mode
162 CT : TfrCursorType; // cursor type
163 LastX, LastY: Integer; // here stored last mouse coords
164 SplitInfo: TfrSplitInfo;
165 RightBottom: Integer;
166 LeftTop: TPoint;
167 FirstBandMove: Boolean;
168 FDesigner: TfrDesignerForm;
169
170 fOldFocusRect : TRect;
171 fPaintSel: TPaintSel;
172 fPainting: boolean;
173 fResizeDialog:boolean;
174 fGuides: TAlignGuides;
175
176 procedure NormalizeRect(var r: TRect);
177 procedure NormalizeCoord(t: TfrView);
FindNearestEdgenull178 function FindNearestEdge(var x, y: Integer): Boolean;
179 procedure RoundCoord(var x, y: Integer);
180 procedure Draw(N: Integer; AClipRgn: HRGN);
181 procedure DrawPage(DrawMode: TfrDesignerDrawMode);
182 procedure DrawRectLine(Rect: TRect);
183 procedure DrawFocusRect(aRect: TRect);
184 procedure DrawHSplitter(Rect: TRect);
185 procedure DrawSelection(t: TfrView);
186 procedure DrawShape(t: TfrView);
187
188 procedure DrawDialog(N: Integer; AClipRgn: HRGN);
189
190 procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
191 procedure MUp(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
192 procedure MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
193 procedure CMMouseLeave(var {%H-}Message: TLMessage); message CM_MOUSELEAVE;
194 procedure DClick(Sender: TObject);
195 procedure MoveResize(Kx,Ky:Integer; UseFrames,AResize: boolean);
196 procedure EnableEvents(aOk: boolean = true);
197
198 // focusrect
199 procedure NPDrawFocusRect;
200 procedure NPEraseFocusRect;
201 // objects
202 procedure NPDrawLayerObjects(Rgn: HRGN; Start:Integer=10000);
203 procedure NPRedrawViewCheckBand(t: TfrView);
204 // selection
thatnull205 procedure NPPaintSelection; // this is the only function that works during Paint
206 procedure NPDrawSelection;
207 procedure NPEraseSelection;
208
209 protected
210 procedure Paint; override;
211 procedure WMEraseBkgnd(var {%H-}Message: TLMEraseBkgnd); message LM_ERASEBKGND;
212 procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
213 public
214 constructor Create(AOwner: TComponent); override;
215 destructor destroy; override;
216
217 procedure Init;
218 procedure SetPage;
219 procedure GetMultipleSelected;
220 procedure CheckGuides;
221 end;
222
223 TPaintTimeStatusItem = (ptsFocusRect);
224 TPaintTimeStatus = set of TPaintTimeStatusItem;
225
226 { TPaintSel }
227
228 TPaintSel=class
229 private
230 fStatus: TPaintTimeStatus;
231 fFocusRect: TRect;
232 fOwner: TfrDesignerPage;
233 fGreenBullet,fGrayBullet: TPortableNetworkGraphic;
234 procedure InvalidateFocusRect;
235 procedure DrawOrInvalidateViewHandles(t:TfrView; aDraw:boolean);
236 procedure DrawOrInvalidateSelection(aDraw:boolean);
237 public
238 constructor Create(AOwner: TfrDesignerPage);
239 destructor Destroy; override;
240 procedure FocusRect(aRect:TRect);
241 procedure RemoveFocusRect;
242 procedure InvalidateSelection;
243 procedure PaintSelection;
244 procedure Paint;
245 end;
246
247 { TAlignGuides }
248
249 TAlignGuides = class
250 private
251 fOwner: TfrDesignerPage;
252 fSelBounds: TRect;
253 fSelMouse: TPoint;
254 fX,fY: Integer;
255 px,py: PInteger;
256 fMoveSelectionTracking: boolean;
257 procedure InvalidateHorzGuide;
258 procedure InvalidateVertGuide;
259 procedure PaintGuides;
260 procedure ChangeGuide(vert, show: boolean; value:Integer);
FindAnyGuidenull261 function FindAnyGuide(const vert: boolean; const ax,ay:Integer; out snap: Integer;
262 skipSel:boolean; skipTyp:TfrSetOfTyp): boolean;
263 public
264 constructor Create(aOwner: TfrDesignerPage);
265 procedure Paint;
266 procedure FindGuides(ax, ay:Integer; skipSel:boolean=false; skipTyp:TfrSetOfTyp=[]);
SnapToGuidenull267 function SnapToGuide(var ax, ay: Integer): boolean;
SnapSelectionToGuidenull268 function SnapSelectionToGuide(const kx, ky: Integer; var ax, ay:Integer): boolean;
269 procedure HideGuides;
270 procedure ResetMoveSelection(ax, ay: Integer);
271 //property X: PInteger read px;
272 //property Y: PInteger read py;
273 end;
274
275 { TfrDesignerForm }
276
277 TfrDesignerForm = class(TfrReportDesigner)
278 acDuplicate: TAction;
279 edtRedo: TAction;
280 edtUndo: TAction;
281 btnGuides: TSpeedButton;
282 MenuItem2: TMenuItem;
283 IEPopupMenu: TPopupMenu;
284 IEButton: TSpeedButton;
285 tlsDBFields: TAction;
286 FileBeforePrintScript: TAction;
287 FileOpen: TAction;
288 FilePreview: TAction;
289 FileSaveAs: TAction;
290 FileSave: TAction;
291 acToggleFrames: TAction;
292 actList: TActionList;
293 frSpeedButton1: TSpeedButton;
294 frSpeedButton2: TSpeedButton;
295 frSpeedButton3: TSpeedButton;
296 frSpeedButton4: TSpeedButton;
297 frSpeedButton5: TSpeedButton;
298 frSpeedButton6: TSpeedButton;
299 frTBSeparator16: TPanel;
300 Image1: TImage;
301 ActionsImageList: TImageList;
302 ImgIndic: TImageList;
303 LinePanel: TPanel;
304 MenuItem1: TMenuItem;
305 OB7: TSpeedButton;
306 panTab: TPanel;
307 panForDlg: TPanel;
308 PgB4: TSpeedButton;
309 Tab1: TTabControl;
310 ScrollBox1: TScrollBox;
311 StatusBar1: TStatusBar;
312 frDock1: TPanel;
313 frDock2: TPanel;
314 Popup1: TPopupMenu;
315 N1: TMenuItem;
316 N2: TMenuItem;
317 N3: TMenuItem;
318 N5: TMenuItem;
319 N6: TMenuItem;
320 MainMenu1: TMainMenu;
321 FileMenu: TMenuItem;
322 EditMenu: TMenuItem;
323 ToolMenu: TMenuItem;
324 N10: TMenuItem;
325 N11: TMenuItem;
326 N12: TMenuItem;
327 N13: TMenuItem;
328 N19: TMenuItem;
329 N20: TMenuItem;
330 N21: TMenuItem;
331 N23: TMenuItem;
332 N24: TMenuItem;
333 N25: TMenuItem;
334 N27: TMenuItem;
335 N28: TMenuItem;
336 N26: TMenuItem;
337 N29: TMenuItem;
338 N30: TMenuItem;
339 N31: TMenuItem;
340 N32: TMenuItem;
341 N33: TMenuItem;
342 N36: TMenuItem;
343 OpenDialog1: TOpenDialog;
344 SaveDialog1: TSaveDialog;
345 ImageList1: TImageList;
346 Pan5: TMenuItem;
347 N8: TMenuItem;
348 ImageList2: TImageList;
349 N38: TMenuItem;
350 Pan6: TMenuItem;
351 N39: TMenuItem;
352 N40: TMenuItem;
353 N42: TMenuItem;
354 MastMenu: TMenuItem;
355 N16: TMenuItem;
356 Panel2: TPanel;
357 FileBtn1: TSpeedButton;
358 FileBtn2: TSpeedButton;
359 FileBtn3: TSpeedButton;
360 FileBtn4: TSpeedButton;
361 CutB: TSpeedButton;
362 CopyB: TSpeedButton;
363 PstB: TSpeedButton;
364 ZB1: TSpeedButton;
365 ZB2: TSpeedButton;
366 SelAllB: TSpeedButton;
367 PgB1: TSpeedButton;
368 PgB2: TSpeedButton;
369 PgB3: TSpeedButton;
370 GB1: TSpeedButton;
371 GB2: TSpeedButton;
372 ExitB: TSpeedButton;
373 Panel3: TPanel;
374 AlB1: TSpeedButton;
375 AlB2: TSpeedButton;
376 AlB3: TSpeedButton;
377 AlB4: TSpeedButton;
378 AlB5: TSpeedButton;
379 FnB1: TSpeedButton;
380 FnB2: TSpeedButton;
381 FnB3: TSpeedButton;
382 ClB2: TSpeedButton;
383 HlB1: TSpeedButton;
384 AlB6: TSpeedButton;
385 AlB7: TSpeedButton;
386 Panel1: TPanel;
387 FrB1: TSpeedButton;
388 FrB2: TSpeedButton;
389 FrB3: TSpeedButton;
390 FrB4: TSpeedButton;
391 ClB1: TSpeedButton;
392 ClB3: TSpeedButton;
393 FrB5: TSpeedButton;
394 FrB6: TSpeedButton;
395 frTBSeparator1: TPanel;
396 frTBSeparator2: TPanel;
397 frTBSeparator3: TPanel;
398 frTBSeparator4: TPanel;
399 frTBSeparator5: TPanel;
400 frTBPanel1: TPanel;
401 C3: TComboBox;
402 C2: TComboBox;
403 frTBPanel2: TPanel;
404 frTBSeparator6: TPanel;
405 frTBSeparator7: TPanel;
406 frTBSeparator8: TPanel;
407 frTBSeparator9: TPanel;
408 frTBSeparator10: TPanel;
409 N37: TMenuItem;
410 Pan2: TMenuItem;
411 Pan3: TMenuItem;
412 Pan1: TMenuItem;
413 Pan4: TMenuItem;
414 Panel4: TPanel;
415 OB1: TSpeedButton;
416 OB2: TSpeedButton;
417 OB3: TSpeedButton;
418 OB4: TSpeedButton;
419 OB5: TSpeedButton;
420 frTBSeparator12: TPanel;
421 Panel5: TPanel;
422 Align1: TSpeedButton;
423 Align2: TSpeedButton;
424 Align3: TSpeedButton;
425 Align4: TSpeedButton;
426 Align5: TSpeedButton;
427 Align6: TSpeedButton;
428 Align7: TSpeedButton;
429 Align8: TSpeedButton;
430 Align9: TSpeedButton;
431 Align10: TSpeedButton;
432 frTBSeparator13: TPanel;
433 frDock4: TPanel;
434 HelpMenu: TMenuItem;
435 N34: TMenuItem;
436 GB3: TSpeedButton;
437 N46: TMenuItem;
438 N47: TMenuItem;
439 UndoB: TSpeedButton;
440 frTBSeparator14: TPanel;
441 AlB8: TSpeedButton;
442 RedoB: TSpeedButton;
443 N48: TMenuItem;
444 OB6: TSpeedButton;
445 frTBSeparator15: TPanel;
446 Panel6: TPanel;
447 Pan7: TMenuItem;
448 N14: TMenuItem;
449 Panel7: TPanel;
450 PBox1: TPaintBox;
451 N17: TMenuItem;
452 E1: TEdit;
453 Panel8: TPanel;
454 SB1: TSpeedButton;
455 SB2: TSpeedButton;
456 HelpBtn: TSpeedButton;
457 frTBSeparator11: TPanel;
458 N18: TMenuItem;
459 N22: TMenuItem;
460 N35: TMenuItem;
461 Popup2: TPopupMenu;
462 N41: TMenuItem;
463 N43: TMenuItem;
464 N44: TMenuItem;
465 StB1: TSpeedButton;
466 procedure acDuplicateExecute(Sender: TObject);
467 procedure acToggleFramesExecute(Sender: TObject);
468 procedure btnGuidesClick(Sender: TObject);
469 procedure C2GetItems(Sender: TObject);
470 procedure edtRedoExecute(Sender: TObject);
471 procedure edtUndoExecute(Sender: TObject);
472 procedure FileBeforePrintScriptExecute(Sender: TObject);
473 procedure FileOpenExecute(Sender: TObject);
474 procedure FilePreviewExecute(Sender: TObject);
475 procedure FileSaveAsExecute(Sender: TObject);
476 procedure FileSaveExecute(Sender: TObject);
477 procedure FormCreate(Sender: TObject);
478 procedure FormDestroy(Sender: TObject);
479 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
480 procedure DoClick(Sender: TObject);
481 procedure ClB1Click(Sender: TObject);
482 procedure GB1Click(Sender: TObject);
483 procedure ScrollBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
484 procedure ScrollBox1DragOver(Sender, Source: TObject; X, Y: Integer;
485 State: TDragState; var Accept: Boolean);
486 procedure IEButtonClick(Sender: TObject);
487 procedure tlsDBFieldsExecute(Sender: TObject);
488 procedure ZB1Click(Sender: TObject);
489 procedure ZB2Click(Sender: TObject);
490 procedure PgB1Click(Sender: TObject);
491 procedure PgB2Click(Sender: TObject);
492 procedure OB2MouseDown(Sender: TObject; {%H-}Button: TMouseButton;
493 Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
494 procedure OB1Click(Sender: TObject);
495 procedure CutBClick(Sender: TObject);
496 procedure CopyBClick(Sender: TObject);
497 procedure PstBClick(Sender: TObject);
498 procedure SelAllBClick(Sender: TObject);
499 procedure ExitBClick(Sender: TObject);
500 procedure PgB3Click(Sender: TObject);
501 procedure FormResize(Sender: TObject);
502 procedure N5Click(Sender: TObject);
503 procedure N6Click(Sender: TObject);
504 procedure GB2Click(Sender: TObject);
505 procedure FileBtn1Click(Sender: TObject);
506 //procedure FileBtn3Click(Sender: TObject);
507 procedure FormShow(Sender: TObject);
508 procedure FormHide(Sender: TObject);
509 procedure N8Click(Sender: TObject);
510 procedure C2DrawItem({%H-}Control: TWinControl; Index: Integer; Rect: TRect;
511 {%H-}State: TOwnerDrawState);
512 procedure HlB1Click(Sender: TObject);
513 procedure N42Click(Sender: TObject);
514 procedure Popup1Popup(Sender: TObject);
515 procedure N23Click(Sender: TObject);
516 procedure N37Click(Sender: TObject);
517 procedure Pan2Click(Sender: TObject);
518 procedure N14Click(Sender: TObject);
519 procedure Align1Click(Sender: TObject);
520 procedure Align2Click(Sender: TObject);
521 procedure Align3Click(Sender: TObject);
522 procedure Align4Click(Sender: TObject);
523 procedure Align5Click(Sender: TObject);
524 procedure Align6Click(Sender: TObject);
525 procedure Align7Click(Sender: TObject);
526 procedure Align8Click(Sender: TObject);
527 procedure Align9Click(Sender: TObject);
528 procedure Align10Click(Sender: TObject);
529 procedure Tab1Change(Sender: TObject);
530 procedure N34Click(Sender: TObject);
531 procedure GB3Click(Sender: TObject);
532 //procedure N20Click(Sender: TObject);
533 procedure PBox1Paint(Sender: TObject);
534 procedure SB1Click(Sender: TObject);
535 procedure SB2Click(Sender: TObject);
536 procedure HelpBtnClick(Sender: TObject);
537 procedure FormMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
538 {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
539 procedure N22Click(Sender: TObject);
540 procedure Tab1MouseDown(Sender: TObject; Button: TMouseButton;
541 {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
542 procedure frDesignerFormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
543 procedure frDesignerFormCloseQuery(Sender: TObject; var CanClose: boolean);
544 procedure frSpeedButton1Click(Sender: TObject);
545 procedure StB1Click(Sender: TObject);
546 private
547 //
548 FirstSelected : TfrView; // First Selected Object
549 SelNum : Integer; // number of objects currently selected
550 MRFlag : Boolean; // several objects was selected
551 ObjRepeat : Boolean; // was pressed Shift + Insert Object
552
553 { Private declarations }
554 fInBuildPage : Boolean;
555
556 PageView: TfrDesignerPage;
557 EditorForm: TfrEditorForm;
558 ColorSelector: TColorSelector;
559 MenuItems: TFpList;
560 ItemWidths: TStringList;
561 FCurPage: Integer;
562 FGridSize: Integer;
563 FGridShow, FGridAlign, FGuidesShow: Boolean;
564 FUnits: TfrReportUnits;
565 FGrayedButtons: Boolean;
566 FUndoBuffer, FRedoBuffer: TfrUndoBuffer;
567 FUndoBufferLength, FRedoBufferLength: Integer;
568 FirstTime: Boolean;
569 MaxItemWidth, MaxShortCutWidth: Integer;
570 // FirstInstance: Boolean;
571 EditAfterInsert: Boolean;
572 FCurDocName, FCaption: String;
573 fCurDocFileType: Integer;
574 ShapeMode: TfrShapeMode;
575 FReportPopupPoint: TPoint;
576 FLastOpenDirectory: string;
577 FLastSaveDirectory: string;
578
579 {$IFDEF StdOI}
580 ObjInsp : TObjectInspector;
581 PropHook : TPropertyEditorHook;
582 {$ELSE}
583 ObjInsp : TfrObjectInspector;
584 {$ENDIF}
585 procedure CreateNewReport;
586 procedure DuplicateSelection;
587 procedure ObjInspSelect(Obj:TObject);
588 procedure ObjInspRefresh;
589 procedure DataInspectorRefresh;
590
591 procedure GetFontList;
592 procedure SetMenuBitmaps;
593 procedure SetCurPage(Value: Integer);
594 procedure SetGridSize(Value: Integer);
595 procedure SetGridShow(Value: Boolean);
596 procedure SetGridAlign(Value: Boolean);
597 procedure SetGuidesShow(AValue: boolean);
598 procedure SetUnits(Value: TfrReportUnits);
599 procedure SetGrayedButtons(Value: Boolean);
600 procedure SetCurDocName(Value: String);
601 procedure SelectionChanged;
602 procedure ShowPosition;
603 procedure ShowContent;
604 procedure EnableControls;
605 procedure ResetSelection;
606 procedure DeleteObjects;
607 procedure AddPage(ClName : string);
608 procedure RemovePage(n: Integer);
609 procedure SetPageTitles;
610 //** procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
611 procedure FillInspFields;
RectTypEnablednull612 function RectTypEnabled: Boolean;
FontTypEnablednull613 function FontTypEnabled: Boolean;
ZEnablednull614 function ZEnabled: Boolean;
CutEnablednull615 function CutEnabled: Boolean;
CopyEnablednull616 function CopyEnabled: Boolean;
PasteEnablednull617 function PasteEnabled: Boolean;
DelEnablednull618 function DelEnabled: Boolean;
EditEnablednull619 function EditEnabled: Boolean;
620 procedure ColorSelected(Sender: TObject);
621 procedure SelectAll;
622 procedure Unselect;
623 procedure CutToClipboard;
624 procedure CopyToClipboard;
625 procedure SaveState;
626 procedure RestoreState;
627 procedure ClearBuffer(Buffer: TfrUndoBuffer; var BufferLength: Integer);
628 procedure ClearUndoBuffer;
629 procedure ClearRedoBuffer;
630 procedure Undo(Buffer: PfrUndoBuffer);
631 procedure ReleaseAction(ActionRec: TfrUndoRec);
632 procedure AddAction(Buffer: PfrUndoBuffer; a: TfrUndoAction; List: TFpList);
633 procedure AddUndoAction(AUndoAction: TfrUndoAction);
634 procedure DoDrawText(aCanvas: TCanvas; aCaption: string;
635 Rect: TRect; Selected, aEnabled: Boolean; Flags: Longint);
636 procedure MeasureItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
637 var AWidth, AHeight: Integer);
638 procedure DrawItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
639 ARect: TRect; Selected: Boolean);
FindMenuItemnull640 function FindMenuItem(AMenuItem: TMenuItem): TfrMenuItemInfo;
641 procedure SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn:TSpeedButton);
642 procedure FillMenuItems(MenuItem: TMenuItem);
643 procedure DeleteMenuItems(MenuItem: TMenuItem);
644 procedure OnActivateApp(Sender: TObject);
645 procedure OnDeactivateApp(Sender: TObject);
646 procedure GetDefaultSize(var dx, dy: Integer);
SelStatusnull647 function SelStatus: TfrSelectionStatus;
648 procedure UpdScrollbars;
649 // procedure InsertDbFields;
650 {$ifdef sbod}
651 procedure DrawStatusPanel(const ACanvas:TCanvas; const rect: TRect);
652 procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
653 const Rect: TRect);
654 {$endif}
655 procedure DefineExtraPopupSelected(popup: TPopupMenu);
656 procedure SelectSameClassClick(Sender: TObject);
657 procedure SelectSameClass(View: TfrView);
CheckFileModifiednull658 function CheckFileModified: Integer;
659 private
660 FDuplicateCount: Integer;
661 FDupDeltaX,FDupDeltaY: Integer;
662 FDuplicateList: TFpList;
663 procedure ViewsAction(Views: TFpList; TheAction:TViewAction; Data: PtrInt;
664 OnlySel:boolean=true; WithUndoAction:boolean=true; WithRedraw:boolean=true);
665 procedure ToggleFrames(View: TfrView; Data: PtrInt);
666 procedure DuplicateView(View: TfrView; Data: PtrInt);
667 procedure ResetDuplicateCount;
lrDesignAcceptDragnull668 function lrDesignAcceptDrag(const Source: TObject): TControl;
669 procedure InplaceEditorMenuClick(Sender: TObject);
670 private
671 FTabMouseDown:boolean;
672 //FTabsPage:TlrTabEditControl;
673 procedure TabsEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
674 procedure TabsEditDragDrop(Sender, Source: TObject; X, Y: Integer);
675 procedure TabsEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
676 procedure TabsEditMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
677 procedure TabsEditMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
678 procedure ShowIEButton(AView: TfrMemoView);
679 procedure HideIEButton;
680 protected
681 procedure SetModified(AValue: Boolean);override;
IniFileNamenull682 function IniFileName:string;
683 public
684 constructor Create(aOwner : TComponent); override;
685 destructor Destroy; override;
686
687 procedure WndProc(var Message: TLMessage); override;
688 procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: String;
689 ButtonTag: Integer; ObjectType:TfrObjectType); override;
690 procedure RegisterTool(const MenuCaption: String; ButtonBmp: TBitmap;
691 OnClickEvnt: TNotifyEvent); override;
692 procedure BeforeChange; override;
693 procedure AfterChange; override;
694 procedure ShowMemoEditor;
695 procedure ShowEditor;
696 procedure ShowDialogPgEditor(APage:TfrPageDialog);
697 procedure RedrawPage; override;
698 procedure OnModify({%H-}sender: TObject);
PointsToUnitsnull699 function PointsToUnits(x: Integer): Double; override;
UnitsToPointsnull700 function UnitsToPoints(x: Double): Integer; override;
701 procedure MoveObjects(dx, dy: Integer; aResize: Boolean);
702 procedure UpdateStatus;
703
704 property CurDocName: String read FCurDocName write SetCurDocName;
705 property CurPage: Integer read FCurPage write SetCurPage;
706 property GridSize: Integer read FGridSize write SetGridSize;
707 property ShowGrid: Boolean read FGridShow write SetGridShow;
708 property GridAlign: Boolean read FGridAlign write SetGridAlign;
709 property ShowGuides: boolean read FGuidesShow write SetGuidesShow;
710 property Units: TfrReportUnits read FUnits write SetUnits;
711 property GrayedButtons: Boolean read FGrayedButtons write SetGrayedButtons;
712 end;
713
714 procedure frSetGlyph(aColor: TColor; sb: TSpeedButton; n: Integer);
frCheckBandnull715 function frCheckBand(b: TfrBandType): Boolean;
716
717 var
718 frTemplateDir: String;
719 edtScriptFontName : string = '';
720 edtScriptFontSize : integer = 0;
721 edtUseIE : boolean = false;
722
723 implementation
724
725 {$R *.lfm}
726 {$R bullets.res}
727 {$R fr_pencil.res}
728
729 uses
730 LR_Pgopt, LR_GEdit, LR_Templ, LR_Newrp, LR_DsOpt, LR_Const, LR_Pars,
731 LR_Prntr, LR_Hilit, LR_Flds, LR_Dopt, LR_Ev_ed, LR_BndEd, LR_VBnd,
732 LR_BTyp, LR_Utils, LR_GrpEd, LR_About, LR_IFlds, LR_DBRel,LR_DBSet,
733 DB, lr_design_ins_filed, IniFiles, LR_DSet, math;
734
735 type
736 THackView = class(TfrView)
737 end;
738
739 function GetUnusedBand: TfrBandType; forward;
740 procedure SendBandsToDown; forward;
741 procedure ClearClipBoard; forward;
742 function Objects: TFpList; forward;
743 procedure GetRegion; forward;
744 function TopSelected: Integer; forward;
745
746 var
747 // FirstInst : Boolean=True;// First instance
748 {
749 FirstSelected : TfrView; // First Selected Object
750 SelNum : Integer; // number of objects currently selected
751 MRFlag : Boolean; // several objects was selected
752 ObjRepeat : Boolean; // was pressed Shift + Insert Object
753 }
754 WasOk : Boolean; // was Ok pressed in dialog
755 OldRect,OldRect1 : TRect; // object rect after mouse was clicked
756 Busy : Boolean; // busy flag. need!
757 ShowSizes : Boolean;
758 LastFontName : String;
759 LastFontSize : Integer;
760 LastAdjust : Integer;
761 LastFrameWidth : Single;
762 LastLineWidth : Single;
763 LastFrames : TfrFrameBorders;
764 LastFontStyle : Word;
765 LastFrameColor : TColor;
766 LastFillColor : TColor;
767 LastFontColor : TColor;
768 ClrButton : TSpeedButton;
769 FirstChange : Boolean;
770 ClipRgn : HRGN;
771
772 // globals
773 ClipBd : TFpList; // clipboard
774 GridBitmap : TBitmap; // for drawing grid in design time
775 ColorLocked : Boolean; // true to avoid unwished color change
776
777 frDesignerComp : TfrDesigner;
778
779
780 {----------------------------------------------------------------------------}
781 procedure AddRgn(var HR: HRGN; T: TfrView);
782 var
783 tr: HRGN;
784 begin
785 tr := t.GetClipRgn(rtExtended);
786 CombineRgn(HR, HR, TR, RGN_OR);
787 DeleteObject(TR);
788 end;
789
SelectionBoundsnull790 function SelectionBounds(out r: TRect): boolean;
791 var
792 i: Integer;
793 t: TfrView;
794 begin
795 r := rect(Maxint, MaxInt, 0 , 0);
796 result := false;
797 with r do
798 for i:=0 to Objects.Count-1 do
799 begin
800 t := TfrView(Objects[i]);
801 if t.Selected then begin
802 if t.x<left then left := t.x;
803 if t.x+t.dx>right then right := t.x+t.dx;
804 if t.y<top then top := t.y;
805 if t.y+t.dy>bottom then bottom := t.y+t.dy;
806 result := true;
807 end;
808 end;
809 end;
810
811 { TAlignGuides }
812
813 procedure TAlignGuides.InvalidateHorzGuide;
814 var
815 r: TRect;
816 begin
817 if (px<>nil) then
818 begin
819 r := Rect(px^-4, 0 , px^+4, fOwner.ClientHeight-1);
820 InvalidateRect(fOwner.Handle, @r, false);
821 end;
822 end;
823
824 procedure TAlignGuides.InvalidateVertGuide;
825 var
826 r: TRect;
827 begin
828 if (py<>nil) then
829 begin
830 r := Rect(0, py^-4, fOwner.ClientWidth-1, py^+4);
831 InvalidateRect(fOwner.Handle, @r, false);
832 end;
833 end;
834
835 procedure TAlignGuides.PaintGuides;
836 var
837 oldStyle: TPenStyle;
838 oldColor: TColor;
839 oldCosmetic: Boolean;
840 i, v, oldWidth: Integer;
841 t: TfrView;
842 begin
843 if (px<>nil) or (py<>nil) then
844 with fOwner.Canvas do
845 begin
846 oldStyle := Pen.Style;
847 oldColor := Pen.Color;
848 oldCosmetic := Pen.Cosmetic;
849 oldWidth := Pen.Width;
850
851 // paint object's aligned sides
852 // TODO: make an option for the fixed values
853 // TODO: a different visualization hint could be having
854 // the view redraw itself in a distinctive color?
855
856 Pen.Cosmetic := true;
857 Pen.Style := psSolid;
858 Pen.Width := 5;
859 Pen.Color := clSkyBlue;
860
861 for i:=0 to Objects.Count-1 do
862 begin
863 t := TfrView(Objects[i]);
864 if px<>nil then
865 if t.FindAlignSide(false, px^, v) and (v=px^) then
866 begin
867 MoveTo(px^, t.y);
868 LineTo(px^, t.y + t.dy);
869 end;
870 if py<>nil then
871 if t.FindAlignSide(true, py^, v) and (v=py^) then
872 begin
873 MoveTo(t.x, py^);
874 LineTo(t.x + t.dx, py^);
875 end;
876 end;
877
878 // paint guides
879 // TODO: make an option for the fixed values
880
881 Pen.Style := psDash;
882 Pen.Cosmetic := false;
883 Pen.Width := 1;
884
885 if px<>nil then
886 begin
887 Pen.Color := clRed;
888 MoveTo(px^, 0);
889 LineTo(px^, fOwner.ClientHeight);
890 end;
891 if py<>nil then
892 begin
893 Pen.Color := clBlue;
894 MoveTo(0, py^);
895 LineTo(fOwner.ClientWidth, py^);
896 end;
897
898 Pen.Cosmetic := oldCosmetic;
899 Pen.Style := oldStyle;
900 Pen.Color := oldColor;
901 Pen.Width := oldWidth;
902 end;
903 end;
904
905 procedure TAlignGuides.ChangeGuide(vert, show: boolean; value: Integer);
906 begin
907 if vert then
908 begin
909 InvalidateVertGuide;
910 if show then begin
911 fy := value;
912 py := @fy;
913 InvalidateVertGuide;
914 end else
915 py := nil;
916 end else
917 begin
918 InvalidateHorzGuide;
919 if show then begin
920 fx := value;
921 px := @fx;
922 InvalidateHorzGuide;
923 end else
924 px := nil;
925 end;
926 end;
927
928 procedure TAlignGuides.Paint;
929 begin
930 PaintGuides;
931 end;
932
FindAnyGuidenull933 function TAlignGuides.FindAnyGuide(const vert: boolean; const ax, ay: Integer;
934 out snap: Integer; skipSel: boolean; skipTyp: TfrSetOfTyp): boolean;
935 var
936 i, value: Integer;
937 t: TfrView;
938 begin
939 result := false;
940
941 // TODO: start looking at the nearest object to (ax, ay)
942
943 if vert then value := ay
944 else value := ax;
945
946 for i := Objects.Count-1 downto 0 do
947 begin
948 t := TfrView(Objects[i]);
949 if (skipSel and t.Selected) or
950 (t.typ in skipTyp) then
951 continue;
952 if t.FindAlignSide(vert, value, snap) then begin
953 result := true;
954 break;
955 end;
956 end;
957
958 if vert then
959 begin
960 if result and (py<>nil) and (py^=snap) then
961 exit;
962 ChangeGuide(true, result, snap);
963 end else
964 begin
965 if result and (px<>nil) and (px^=snap) then
966 exit;
967 ChangeGuide(false, result, snap);
968 end;
969 end;
970
971 constructor TAlignGuides.Create(aOwner: TfrDesignerPage);
972 begin
973 inherited create;
974 fOwner := aOwner;
975 end;
976
977 procedure TAlignGuides.FindGuides(ax, ay: Integer; skipSel: boolean;
978 skipTyp: TfrSetOfTyp);
979 var
980 dummy: Integer;
981 begin
982 FindAnyGuide(true, ax, ay, dummy, skipSel, skipTyp);
983 FindAnyGuide(false, ax, ay, dummy, skipSel, skipTyp);
984 end;
985
SnapToGuidenull986 function TAlignGuides.SnapToGuide(var ax, ay: Integer): boolean;
987 var
988 newX, newY: Integer;
989 begin
990 newX := ax; newY := ay;
991 if (px<>nil) and (Abs(ax-px^)<=lrSnapDistance) then
992 newX := px^;
993 if (py<>nil) and (Abs(ay-py^)<=lrSnapDistance) then
994 newY := py^;
995 result := (newX<>ax) or (newY<>ay);
996 if result then
997 begin
998 ax := newX;
999 ay := newY;
1000 end;
1001 end;
1002
SnapSelectionToGuidenull1003 function TAlignGuides.SnapSelectionToGuide(const kx, ky: Integer; var ax,
1004 ay: Integer): boolean;
1005 var
1006 moveBounds, displayedBounds: TRect;
1007 snap, deltaX, deltaY, snapDeltaX, snapDeltaY: Integer;
1008 pts: array[0..2] of TPoint;
1009
1010 procedure TestPoints(vert: boolean; var delta:integer);
1011 var
1012 p: TPoint;
1013 begin
1014 delta := 0;
1015 for p in pts do
1016 begin
1017 if FindAnyGuide(vert, p.x, p.y, snap, true, []) then
1018 begin
1019 if vert then delta := snap - p.y
1020 else delta := snap - p.x;
1021 result := true;
1022 break;
1023 end;
1024 end;
1025 end;
1026
1027 begin
1028 result := false;
1029
1030 if not fMoveSelectionTracking then begin
1031 if not SelectionBounds(fSelBounds) then
1032 exit;
1033 HideGuides;
1034 fMoveSelectionTracking := true;
1035 end;
1036
1037 // real bounds
1038 moveBounds := fSelBounds;
1039 deltaX := ax - fSelMouse.x;
1040 deltaY := ay - fSelMouse.y;
1041 moveBounds.Offset(deltaX, deltaY);
1042
1043 // find potential snap points
1044 snapDeltaX := 0;
1045 snapDeltaY := 0;
1046
1047 pts[2] := Point(ax, ay); // could be ommited if less matching guides are needed
1048
1049 if deltaX<0 then
1050 begin
1051 pts[0] := Point(moveBounds.left, ay);
1052 pts[1] := Point(moveBounds.right, ay);
1053 end else
1054 if deltaX>0 then
1055 begin
1056 pts[0] := Point(moveBounds.right, ay);
1057 pts[1] := Point(moveBounds.left, ay);
1058 end;
1059 if deltaX<>0 then
1060 TestPoints(false, snapDeltaX);
1061
1062 if deltaY<0 then
1063 begin
1064 pts[0] := Point(ax, moveBounds.top);
1065 pts[1] := Point(ax, moveBounds.Bottom);
1066 end else
1067 if deltaY>0 then
1068 begin
1069 pts[0] := Point(ax, moveBounds.Bottom);
1070 pts[1] := Point(ax, moveBounds.top);
1071 end;
1072 if deltaY<>0 then
1073 TestPoints(true, snapDeltaY);
1074
1075 // adjust the moving bounds by the extra snapping if it exists
1076 moveBounds.Offset(snapDeltaX, snapDeltaY);
1077 // get displayed bounds
1078 // TODO: Optmize: should not be necessary to compute displayed bounds for this
1079 SelectionBounds(displayedBounds);
1080 // cheating new mouse values
1081 ax := (ax - kx) + (moveBounds.Left - displayedBounds.Left);
1082 ay := (ay - ky) + (moveBounds.Top - displayedBounds.Top);
1083
1084 result := true; // either we snap to something or not, we always succeed
1085 end;
1086
1087 procedure TAlignGuides.HideGuides;
1088 begin
1089 InvalidateHorzGuide;
1090 InvalidateVertGuide;
1091 px := nil;
1092 py := nil;
1093 fMoveSelectionTracking := false;
1094 end;
1095
1096 procedure TAlignGuides.ResetMoveSelection(ax, ay: Integer);
1097 begin
1098 fMoveSelectionTracking := false;
1099 fSelMouse := Point(ax, ay);
1100 end;
1101
1102 { TPaintSel }
1103
1104 constructor TPaintSel.Create(AOwner: TfrDesignerPage);
1105 begin
1106 inherited Create;
1107 fOwner := AOwner;
1108 fGreenBullet := TPortableNetworkGraphic.Create;
1109 fGrayBullet := TPortableNetworkGraphic.Create;
1110 fGreenBullet.LoadFromResourceName(HInstance, 'bulletgreen');
1111 fGrayBullet.LoadFromResourceName(HInstance, 'bulletgray');
1112 end;
1113
1114 destructor TPaintSel.Destroy;
1115 begin
1116 fGrayBullet.Free;
1117 fGreenBullet.Free;
1118 inherited Destroy;
1119 end;
1120
1121 procedure TPaintSel.FocusRect(aRect: TRect);
1122 begin
1123 fFocusRect := aRect;
1124 Include(fStatus, ptsFocusRect);
1125 InvalidateFocusRect;
1126 end;
1127
1128 procedure TPaintSel.RemoveFocusRect;
1129 begin
1130 InvalidateFocusRect;
1131 end;
1132
1133 procedure TPaintSel.InvalidateSelection;
1134 begin
1135 DrawOrInvalidateSelection(false);
1136 end;
1137
1138 procedure TPaintSel.PaintSelection;
1139 begin
1140 DrawOrInvalidateSelection(true);
1141 end;
1142
1143 procedure TPaintSel.DrawOrInvalidateSelection(aDraw:boolean);
1144 var
1145 i: Integer;
1146 t: TfrView;
1147 Lst: TfpList;
1148 begin
1149 Lst := Objects;
1150 if not Assigned(Lst) then exit;
1151 for i:=0 to Lst.Count-1 do
1152 begin
1153 t := TfrView(Lst[i]);
1154 if not t.Selected then
1155 continue;
1156 DrawOrInvalidateViewHandles(t, aDraw);
1157 end;
1158 end;
1159
1160 procedure TPaintSel.InvalidateFocusRect;
1161 var
1162 R: TRect;
1163 begin
1164 R := fFocusRect;
1165 fOwner.NormalizeRect(R);
1166 InvalidateFrame(fOwner.Handle, @R, false, 1);
1167 end;
1168
1169 procedure TPaintSel.DrawOrInvalidateViewHandles(t: TfrView; aDraw:boolean);
1170 var
1171 Bullet: TGraphic;
1172 bdx, bdy: Integer;
1173
1174 procedure UpdateBullet(aBullet: TGraphic);
1175 begin
1176 Bullet := aBullet;
1177 bdx := Bullet.Width div 2;
1178 bdy := Bullet.Height div 2;
1179 end;
1180
1181 procedure DrawPoint(x,y: Integer);
1182 var
1183 r: TRect;
1184 begin
1185 if aDraw then
1186 //fOwner.Canvas.EllipseC(x, y, 1, 1)
1187 fOwner.Canvas.Draw(x-bdx, y-bdy, Bullet)
1188 else
1189 begin
1190 r := rect(x-bdx,y-bdy,x+bdx+1,y+bdy+1);
1191 InvalidateRect(fOwner.Handle, @r, false);
1192 end;
1193 end;
1194
1195 var
1196 px, py: Integer;
1197 begin
1198
1199 with t, fOwner.Canvas do
1200 begin
1201 if TfrDesignerForm(frDesigner).SelNum>1 then
1202 UpdateBullet(fGrayBullet)
1203 else
1204 UpdateBullet(fGreenBullet);
1205
1206 px := x + dx div 2;
1207 py := y + dy div 2;
1208
1209 DrawPoint(x, y);
1210
1211 if dx>0 then
1212 DrawPoint(x + dx, y);
1213
1214 if dy>0 then
1215 DrawPoint(x, y + dy);
1216
1217 if TfrDesignerForm(frDesigner).SelNum = 1 then
1218 begin
1219 if px>x then
1220 DrawPoint(px, y);
1221
1222 if py>y then
1223 DrawPoint(x, py);
1224
1225 if (py>y) and (px>x) then
1226 begin
1227 DrawPoint(px, y + dy);
1228 DrawPoint(x + dx, py);
1229 end;
1230 end;
1231
1232 if (dx>0) and (dy>0) then
1233 begin
1234 if aDraw and (Objects.IndexOf(t) = fOwner.RightBottom) then
1235 UpdateBullet(fGreenBullet);
1236 DrawPoint(x + dx, y + dy);
1237 end;
1238
1239 end;
1240
1241 end;
1242
1243 procedure TPaintSel.Paint;
1244 begin
1245 if ptsFocusRect in FStatus then
1246 begin
1247 fOwner.Canvas.Brush.Style := bsSolid;
1248 fOwner.Canvas.Pen.Style := psDot;
1249 fOwner.Canvas.Pen.Color := clSkyBlue;
1250 fOwner.Canvas.Brush.Style := bsClear;
1251 fOwner.Canvas.Rectangle(fFocusRect);
1252 Exclude(Fstatus, ptsFocusRect);
1253 end;
1254 end;
1255
1256 constructor TfrDesigner.Create(AOwner: TComponent);
1257 begin
1258 if Assigned(frDesignerComp) then
1259 raise Exception.Create(sFRDesignerExists);
1260 inherited Create(AOwner);
1261 frDesignerComp:=Self;
1262 end;
1263
1264 destructor TfrDesigner.Destroy;
1265 begin
1266 frDesignerComp:=nil;
1267 inherited Destroy;
1268 end;
1269
1270 {----------------------------------------------------------------------------}
1271 procedure TfrDesigner.Loaded;
1272 begin
1273 inherited Loaded;
1274 frTemplateDir := TemplateDir;
1275 end;
1276
1277 {--------------------------------------------------}
1278 constructor TfrDesignerPage.Create(AOwner: TComponent);
1279 begin
1280 inherited Create(AOwner);
1281 Parent := AOwner as TWinControl;
1282 Color := clWhite;
1283 EnableEvents;
1284 fPaintSel := TPaintSel.Create(self);
1285 fGuides := TAlignGuides.Create(self);
1286 end;
1287
1288 destructor TfrDesignerPage.destroy;
1289 begin
1290 fGuides.Free;
1291 fPaintSel.Free;
1292 inherited destroy;
1293 end;
1294
1295 procedure TfrDesignerPage.Init;
1296 begin
1297 Down := False;
1298 DFlag:= False;
1299 RFlag := False;
1300 Cursor := crDefault;
1301 CT := ctNone;
1302 end;
1303
1304 procedure TfrDesignerPage.SetPage;
1305 var
1306 Pgw,Pgh: Integer;
1307 begin
1308 if not Assigned(FDesigner.Page) then Exit;
1309
1310 FDesigner.panForDlg.Visible:=(FDesigner.Page is TfrPageDialog);
1311 FDesigner.panel4.Visible :=not FDesigner.panForDlg.Visible;
1312
1313 if (FDesigner.Page is TfrPageDialog) then
1314 begin
1315 Color:=clBtnFace;
1316 SetBounds(10, 10,TfrPageDialog(FDesigner.Page).Width,TfrPageDialog(FDesigner.Page).Height);
1317 end
1318 else
1319 begin
1320 Pgw := FDesigner.Page.PrnInfo.Pgw;
1321 Pgh := FDesigner.Page.PrnInfo.Pgh;
1322 if Pgw > Parent.Width then
1323 SetBounds(10, 10, Pgw, Pgh)
1324 else
1325 SetBounds((Parent.Width - Pgw) div 2, 10, Pgw, Pgh);
1326 end;
1327 end;
1328
1329 procedure TfrDesignerPage.Paint;
1330 begin
1331 fPainting := true;
1332 Draw(10000, 0);
1333 fGuides.Paint;
1334 fPaintSel.Paint;
1335 fPainting := false;
1336 end;
1337
1338 procedure TfrDesignerPage.WMEraseBkgnd(var Message: TLMEraseBkgnd);
1339 begin
1340 //do nothing to avoid flicker
1341 end;
1342
1343 procedure TfrDesignerPage.DoContextPopup(MousePos: TPoint; var Handled: Boolean
1344 );
1345 begin
1346 Handled := true;
1347 end;
1348
1349 procedure TfrDesignerPage.NormalizeCoord(t: TfrView);
1350 begin
1351 if t.dx < 0 then
1352 begin
1353 t.dx := -t.dx;
1354 t.x := t.x - t.dx;
1355 end;
1356 if t.dy < 0 then
1357 begin
1358 t.dy := -t.dy;
1359 t.y := t.y - t.dy;
1360 end;
1361 end;
1362
1363 procedure TfrDesignerPage.NormalizeRect(var r: TRect);
1364 var
1365 i: Integer;
1366 begin
1367 with r do
1368 begin
1369 if Left > Right then
1370 begin
1371 i := Left;
1372 Left := Right;
1373 Right := i;
1374 end;
1375 if Top > Bottom then
1376 begin
1377 i := Top;
1378 Top := Bottom;
1379 Bottom := i;
1380 end;
1381 end;
1382 end;
1383
1384 procedure TfrDesignerPage.DrawHSplitter(Rect: TRect);
1385 begin
1386 with Canvas do
1387 begin
1388 Pen.Mode := pmXor;
1389 Pen.Color := clSilver;
1390 Pen.Width := 1;
1391 MoveTo(Rect.Left, Rect.Top);
1392 LineTo(Rect.Right, Rect.Bottom);
1393 Pen.Mode := pmCopy;
1394 end;
1395 end;
1396
1397 procedure TfrDesignerPage.DrawRectLine(Rect: TRect);
1398 begin
1399 with Canvas do
1400 begin
1401 Pen.Mode := pmNot;
1402 Pen.Style := psSolid;
1403 Pen.Width := Round(LastLineWidth);
1404 with Rect do
1405 begin
1406 if Abs(Right - Left) > Abs(Bottom - Top) then
1407 begin
1408 MoveTo(Left, Top);
1409 LineTo(Right, Top);
1410 end
1411 else
1412 begin
1413 MoveTo(Left, Top);
1414 LineTo(Left, Bottom);
1415 end;
1416 end;
1417 Pen.Mode := pmCopy;
1418 end;
1419 end;
1420
1421 procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor);
1422 procedure DrawVertLine(X1,Y1,Y2: integer);
1423 Var Cl : TColor;
1424 begin
1425 Cl:=Canvas.Pen.Color;
1426 try
1427 if Y2<Y1 then
1428 while Y2<Y1 do
1429 begin
1430 Canvas.Pen.Color:=Color;
1431 Canvas.MoveTo(X1,Y1);
1432 Canvas.LineTo(X1,Y1+1);
1433 //Canvas.Pixels[X1, Y1] := Color;
1434 dec(Y1, 2);
1435 end
1436 else
1437 while Y1<Y2 do
1438 begin
1439 Canvas.Pen.Color:=Color;
1440 Canvas.MoveTo(X1,Y1);
1441 Canvas.LineTo(X1,Y1+1);
1442 //Canvas.Pixels[X1, Y1] := Color;
1443 inc(Y1, 2);
1444 end;
1445 finally
1446 Canvas.Pen.Color:=cl;
1447 end;
1448 end;
1449
1450 procedure DrawHorzLine(X1,Y1,X2: integer);
1451 Var Cl : TColor;
1452 begin
1453 Cl:=Canvas.Pen.Color;
1454 try
1455 if X2<X1 then
1456 while X2<X1 do
1457 begin
1458 Canvas.Pen.Color:=Color;
1459 Canvas.MoveTo(X1,Y1);
1460 Canvas.LineTo(X1+1,Y1);
1461 //Canvas.Pixels[X1, Y1] := Color;
1462 dec(X1, 2);
1463 end
1464 else
1465 while X1<X2 do
1466 begin
1467 Canvas.Pen.Color:=Color;
1468 Canvas.MoveTo(X1,Y1);
1469 Canvas.LineTo(X1+1,Y1);
1470 //Canvas.Pixels[X1, Y1] := Color;
1471 inc(X1, 2);
1472 end;
1473 finally
1474 Canvas.Pen.Color:=cl;
1475 end;
1476 end;
1477 begin
1478 with aRect do
1479 begin
1480 DrawHorzLine(Left, Top, Right-1);
1481 DrawVertLine(Right-1, Top, Bottom-1);
1482 DrawHorzLine(Right-1, Bottom-1, Left);
1483 DrawVertLine(Left, Bottom-1, Top);
1484 end;
1485 end;
1486
1487 procedure TfrDesignerPage.DrawFocusRect(aRect: TRect);
1488 var
1489 DCIndex: Integer;
1490 begin
1491 with Canvas do
1492 begin
1493 DCIndex := SaveDC(Handle);
1494 Pen.Mode := pmXor;
1495 Pen.Color := clWhite;
1496 //DrawRubberRect(Canvas, aRect, clWhite);
1497 Pen.Width := 1;
1498 Pen.Style := psDot;
1499 MoveTo(aRect.Left, aRect.Top);
1500 LineTo(aRect.Right, aRect.Top);
1501 LineTo(aRect.Right, aRect.Bottom);
1502 LineTo(aRect.left, aRect.Bottom);
1503 LineTo(aRect.left, aRect.Top);
1504 //Brush.Style := bsClear;
1505 //Rectangle(aRect);
1506 RestoreDC(Handle, DCIndex);
1507 Pen.Mode := pmCopy;
1508 fOldFocusRect:=aRect;
1509 end;
1510 end;
1511
1512 procedure TfrDesignerPage.DrawSelection(t: TfrView);
1513 var
1514 px, py: Word;
1515 procedure DrawPoint(x, y: Word);
1516 begin
1517 Canvas.EllipseC(x,y,1,1);
1518 //Canvas.MoveTo(x, y);
1519 //Canvas.LineTo(x, y);
1520 end;
1521 begin
1522 if t.Selected then
1523 with t, Self.Canvas do
1524 begin
1525 Pen.Width := 5;
1526 Pen.Mode := pmXor;
1527 Pen.Color := clWhite;
1528 px := x + dx div 2;
1529 py := y + dy div 2;
1530
1531 DrawPoint(x, y);
1532
1533 if dx>0 then
1534 DrawPoint(x + dx, y);
1535
1536 if dy>0 then
1537 DrawPoint(x, y + dy);
1538
1539 if (dx>0) and (dy>0) then
1540 begin
1541 if Objects.IndexOf(t) = RightBottom then
1542 Pen.Color := clTeal;
1543 DrawPoint(x + dx, y + dy);
1544 end;
1545
1546 Pen.Color := clWhite;
1547 if TfrDesignerForm(frDesigner).SelNum = 1 then
1548 begin
1549 if px>x then
1550 DrawPoint(px, y);
1551
1552 if py>y then
1553 DrawPoint(x, py);
1554
1555 if (py>y) and (px>x) then
1556 begin
1557 DrawPoint(px, y + dy);
1558 DrawPoint(x + dx, py);
1559 end;
1560 end;
1561 Pen.Mode := pmCopy;
1562 // NOTE: ROP mode under gtk is used not only to draw with pen but
1563 // also any other filled graphics, the problem is that brush
1564 // handle is not invalidated when pen has changed as result
1565 // the ROP mode is not updated and next operation will use
1566 // the old XOR mode.
1567 // TODO: Solve this problem in LCL-gtk, as workaround draw something
1568 // using new pen.
1569 EllipseC(-100,-100,1,1);
1570 end;
1571 end;
1572
1573 procedure TfrDesignerPage.DrawShape(t: TfrView);
1574 begin
1575 if t.Selected then
1576 with t do
1577 DrawFocusRect(Rect(x, y, x + dx + 1, y + dy + 1));
1578 end;
1579
1580 procedure TfrDesignerPage.DrawDialog(N: Integer; AClipRgn: HRGN);
1581 Var
1582 Dlg : TfrPageDialog;
1583 i, iy : Integer;
1584 t : TfrView;
1585 Objects : TFpList;
1586 begin
1587 Dlg:=TfrPageDialog(FDesigner.Page);
1588
1589 with Canvas do
1590 begin
1591 Brush.Color := clGray;
1592 FillRect(Rect(0,0, Width, Height + 20));
1593
1594 Brush.Color := clBtnFace;
1595 Brush.Style := bsSolid;
1596 Rectangle(Rect(0,0,FDesigner.Page.Width-1,FDesigner.Page.Height-1));
1597 Brush.Color := clBlue;
1598 Rectangle(Rect(0,0,FDesigner.Page.Width-1,20));
1599
1600 Canvas.TextRect(Rect(0,0,FDesigner.Page.Width-1,20), 1, 5, Dlg.Caption);
1601
1602 end;
1603
1604
1605 Objects := FDesigner.Page.Objects;
1606
1607 for i:=0 to Objects.Count-1 do
1608 begin
1609 t := TfrView(Objects[i]);
1610 t.draw(Canvas);
1611
1612 iy:=1;
1613 //Show indicator if script it's not empty
1614 if t.Script.Count>0 then
1615 begin
1616 FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 0);
1617 iy:=10;
1618 end;
1619
1620 end;
1621
1622 FDesigner.ImageList2.Draw(Canvas, Width-14, Height-14, 1);
1623 if not Down then
1624 NPPaintSelection;
1625
1626 end;
1627
1628 procedure TfrDesignerPage.Draw(N: Integer; AClipRgn: HRGN);
1629 var
1630 i,iy : Integer;
1631 t : TfrView;
1632 R, R1 : HRGN;
1633 Objects : TFpList;
1634
1635 procedure DrawBackground;
1636 var
1637 i, j: Integer;
1638 Re: TRect;
1639 begin
1640 with Canvas do
1641 begin
1642 if FDesigner.ShowGrid and (FDesigner.GridSize <> 18) then
1643 begin
1644 with GridBitmap.Canvas do
1645 begin
1646 Brush.Color := clWhite;
1647 FillRect(Rect(0, 0, 8, 8));
1648 Pixels[0, 0] := clBlack;
1649 if FDesigner.GridSize = 4 then
1650 begin
1651 Pixels[4, 0] := clBlack;
1652 Pixels[0, 4] := clBlack;
1653 Pixels[4, 4] := clBlack;
1654 end;
1655 end;
1656 Brush.Bitmap := GridBitmap;
1657 end
1658 else
1659 begin
1660 Brush.Color := clWhite;
1661 Brush.Style := bsSolid;
1662 Brush.Bitmap:= nil;
1663 end;
1664
1665 //FillRgn(Handle, R, Brush.Handle);
1666 GetRgnBox(R, @Re);
1667 FillRect(Re);
1668
1669 if FDesigner.ShowGrid and (FDesigner.GridSize = 18) then
1670 begin
1671 i := 0;
1672 while i < Width do
1673 begin
1674 j := 0;
1675 while j < Height do
1676 begin
1677 if RectVisible(Handle, Rect(i, j, i + 1, j + 1)) then
1678 Pixels[i,j]:=clBlack;
1679 Inc(j, FDesigner.GridSize);
1680 end;
1681 Inc(i, FDesigner.GridSize);
1682 end;
1683 end;
1684 Brush.Style := bsClear;
1685 Pen.Width := 1;
1686 Pen.Color := clSilver;
1687 Pen.Style := psSolid;
1688 Pen.Mode := pmCopy;
1689 with FDesigner.Page do
1690 begin
1691 if UseMargins then
1692 Rectangle(LeftMargin, TopMargin, RightMargin, BottomMargin);
1693 if ColCount > 1 then
1694 begin
1695 ColWidth := (RightMargin - LeftMargin - (ColCount-1)*ColGap) div ColCount;
1696 Pen.Style := psDot;
1697 j := LeftMargin;
1698 for i := 1 to ColCount do
1699 begin
1700 Rectangle(j, -1, j + ColWidth + 1, PrnInfo.Pgh + 1);
1701 Inc(j, ColWidth + ColGap);
1702 end;
1703 Pen.Style := psSolid;
1704 end;
1705 end;
1706 end;
1707 end;
1708
ViewIsVisiblenull1709 function ViewIsVisible(t: TfrView): Boolean;
1710 var
1711 Rn: HRGN;
1712 begin
1713 Rn := t.GetClipRgn(rtNormal);
1714 Result := CombineRgn(Rn, Rn, AClipRgn, RGN_AND) <> NULLREGION;
1715 if Result then
1716 // will this view be really visible?
1717 Result := CombineRgn(Rn, AClipRgn, R, RGN_AND) <> NULLREGION;
1718 DeleteObject(Rn);
1719 end;
1720
1721 begin
1722 if FDesigner.Page = nil then Exit;
1723
1724 DocMode := dmDesigning;
1725
1726 Objects := FDesigner.Page.Objects;
1727
1728 if FDesigner.Page is TfrPageDialog then
1729 begin
1730 DrawDialog(N, AClipRgn);
1731 Exit;
1732 end;
1733
1734 {$IFDEF DebugLR}
1735 DebugLnEnter('TfrDesignerPage.Draw INIT N=%d AClipRgn=%d',[N,AClipRgn]);
1736 {$ENDIF}
1737
1738 if AClipRgn = 0 then
1739 begin
1740 with Canvas.ClipRect do
1741 AClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
1742 end;
1743
1744 R:=CreateRectRgn(0, 0, Width, Height);
1745 for i:=Objects.Count-1 downto 0 do
1746 begin
1747 t := TfrView(Objects[i]);
1748 {$IFDEF DebugLR}
1749 DebugLn('Draw ',InttoStr(i),' ',t.Name);
1750 {$ENDIF}
1751 if i <= N then
1752 begin
1753 if t.selected then
1754 t.draw(canvas)
1755 else
1756 if ViewIsVisible(t) then
1757 begin
1758 R1 := CreateRectRgn(0, 0, 1, 1);
1759 CombineRgn(R1, AClipRgn, R, RGN_AND);
1760 SelectClipRgn(Canvas.Handle, R1);
1761 DeleteObject(R1);
1762
1763 t.Draw(Canvas);
1764
1765 iy:=1;
1766 //Show indicator if script it's not empty
1767 if t.Script.Count>0 then
1768 begin
1769 FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 0);
1770 iy:=10;
1771 end;
1772
1773 //Show indicator if hightlight it's not empty
1774 if (t is TfrCustomMemoView) and (Trim(TfrCustomMemoView(t).HighlightStr)<>'') then
1775 FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 1);
1776 end;
1777 end;
1778 R1 := t.GetClipRgn(rtNormal);
1779 CombineRgn(R, R, R1, RGN_DIFF);
1780 DeleteObject(R1);
1781 SelectClipRgn(Canvas.Handle, R);
1782 end;
1783
1784 CombineRgn(R, R, AClipRgn, RGN_AND);
1785
1786 DrawBackground;
1787
1788 DeleteObject(R);
1789 DeleteObject(AClipRgn);
1790 if AClipRgn=ClipRgn then
1791 ClipRgn := 0;
1792
1793 SelectClipRgn(Canvas.Handle, 0);
1794
1795 if not Down then
1796 NPPaintSelection;
1797
1798 {$IFDEF DebugLR}
1799 DebugLnExit('TfrDesignerPage.Draw DONE');
1800 {$ENDIF}
1801 end;
1802
1803 procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
1804 var
1805 i: Integer;
1806 t: TfrView;
1807 begin
1808 if DocMode <> dmDesigning then Exit;
1809 {$ifdef ppaint}
1810 if DrawMode=dmSelection then
1811 begin
1812 if not fPainting then
1813 fPaintSel.InvalidateSelection;
1814 exit;
1815 end;
1816 {$endif}
1817 for i:=0 to Objects.Count-1 do
1818 begin
1819 t := TfrView(Objects[i]);
1820 case DrawMode of
1821 dmAll: t.Draw(Canvas);
1822 dmSelection: DrawSelection(t);
1823 dmShape: DrawShape(t);
1824 end;
1825 end;
1826 end;
1827
TfrDesignerPage.FindNearestEdgenull1828 function TfrDesignerPage.FindNearestEdge(var x, y: Integer): Boolean;
1829 var
1830 i: Integer;
1831 t: TfrView;
1832 min: Double;
1833 p: TPoint;
1834
DoMinnull1835 function DoMin(a: Array of TPoint): Boolean;
1836 var
1837 i: Integer;
1838 d: Double;
1839 begin
1840 Result := False;
1841 for i := Low(a) to High(a) do
1842 begin
1843 d := sqrt((x - a[i].x) * (x - a[i].x) + (y - a[i].y) * (y - a[i].y));
1844 if d < min then
1845 begin
1846 min := d;
1847 p := a[i];
1848 Result := True;
1849 end;
1850 end;
1851 end;
1852
1853 begin
1854 Result := False;
1855 min := FDesigner.GridSize;
1856 p := Point(x, y);
1857 for i := 0 to Objects.Count - 1 do
1858 begin
1859 t := TfrView(Objects[i]);
1860 if DoMin([Point(t.x, t.y), Point(t.x + t.dx, t.y),
1861 Point(t.x + t.dx, t.y + t.dy), Point(t.x, t.y + t.dy)]) then
1862 Result := True;
1863 end;
1864
1865 x := p.x;
1866 y := p.y;
1867 end;
1868
1869 procedure TfrDesignerPage.RoundCoord(var x, y: Integer);
1870 begin
1871 with FDesigner do
1872 begin
1873
1874 if ShowGuides and fGuides.SnapToGuide(x, y) then
1875 exit;
1876
1877 if GridAlign then
1878 begin
1879 x := x div GridSize * GridSize;
1880 y := y div GridSize * GridSize;
1881 end;
1882 end;
1883 end;
1884
1885 procedure TfrDesignerPage.GetMultipleSelected;
1886 var
1887 i, j, k: Integer;
1888 t: TfrView;
1889 begin
1890 j := 0; k := 0;
1891 LeftTop := Point(10000, 10000);
1892 RightBottom := -1;
1893 TfrDesignerForm(frDesigner).MRFlag := False;
1894 if TfrDesignerForm(frDesigner).SelNum > 1 then {find right-bottom element}
1895 begin
1896 for i := 0 to Objects.Count-1 do
1897 begin
1898 t := TfrView(Objects[i]);
1899 if t.Selected then
1900 begin
1901 t.OriginalRect := Rect(t.x, t.y, t.dx, t.dy);
1902 if (t.x + t.dx > j) or ((t.x + t.dx = j) and (t.y + t.dy > k)) then
1903 begin
1904 j := t.x + t.dx;
1905 k := t.y + t.dy;
1906 RightBottom := i;
1907 end;
1908 if t.x < LeftTop.x then LeftTop.x := t.x;
1909 if t.y < LeftTop.y then LeftTop.y := t.y;
1910 end;
1911 end;
1912 t := TfrView(Objects[RightBottom]);
1913 OldRect := Rect(LeftTop.x, LeftTop.y, t.x + t.dx, t.y + t.dy);
1914 OldRect1 := OldRect;
1915 TfrDesignerForm(frDesigner).MRFlag := True;
1916 end;
1917 end;
1918
1919 procedure TfrDesignerPage.CheckGuides;
1920 begin
1921 if not FDesigner.ShowGuides then
1922 fGuides.HideGuides;
1923 end;
1924
1925 procedure TfrDesignerPage.MDown(Sender: TObject; Button: TMouseButton;
1926 Shift: TShiftState; X, Y: Integer);
1927 var
1928 i: Integer;
1929 f, DontChange, v: Boolean;
1930 t: TfrView;
1931 p: TPoint;
1932 begin
1933 {$IFDEF DebugLR}
1934 DebugLnEnter('TfrDesignerPage.MDown(X=%d,Y=%d) INIT',[x,y]);
1935 DebugLn('Down=%s RFlag=%s',[dbgs(Down),dbgs(RFlag)]);
1936 {$ENDIF}
1937
1938 // In Lazarus there is no mousedown after doubleclick so
1939 // just ignore mousedown when doubleclick is coming.
1940 if ssDouble in Shift then begin
1941 {$IFDEF DebugLR}
1942 DebugLnExit('TfrDesignerPage.MDown DONE: doubleclick expected');
1943 {$ENDIF}
1944 exit;
1945 end;
1946
1947 if (Button = mbRight) and Down and RFlag then
1948 NPEraseFocusRect;
1949
1950 RFlag := False;
1951 NPEraseSelection;
1952 Down := True;
1953 DontChange := False;
1954 if Button = mbLeft then
1955 begin
1956 if (ssCtrl in Shift) or (Cursor = crCross) then
1957 begin
1958 RFlag := True;
1959 if Cursor = crCross then
1960 begin
1961 NPEraseFocusRect;
1962 RoundCoord(x, y);
1963 OldRect1 := OldRect;
1964 end;
1965 OldRect := Rect(x, y, x, y);
1966 FDesigner.Unselect;
1967 TfrDesignerForm(frDesigner).SelNum := 0;
1968 RightBottom := -1;
1969 TfrDesignerForm(frDesigner).MRFlag := False;
1970 TfrDesignerForm(frDesigner).FirstSelected := nil;
1971 {$IFDEF DebugLR}
1972 DebugLnExit('TfrDesignerPage.MDown DONE: Ctrl+Left o cursor=crCross');
1973 {$ENDIF}
1974 {$ifdef ppaint}
1975 NPDrawSelection;
1976 {$endif}
1977 Exit;
1978 end
1979 else if Cursor = crPencil then
1980 begin
1981 with FDesigner do
1982 begin
1983 if ShowGuides and fGuides.SnapToGuide(x, y) then
1984 // x and/or y are at the right value now
1985 else begin
1986 if GridAlign then
1987 begin
1988 if not FindNearestEdge(x, y) then
1989 begin
1990 x := Round(x / GridSize) * GridSize;
1991 y := Round(y / GridSize) * GridSize;
1992 end;
1993 end;
1994 end;
1995 end;
1996 OldRect := Rect(x, y, x, y);
1997 FDesigner.Unselect;
1998 TfrDesignerForm(frDesigner).SelNum := 0;
1999 RightBottom := -1;
2000 TfrDesignerForm(frDesigner).MRFlag := False;
2001 TfrDesignerForm(frDesigner).FirstSelected := nil;
2002 LastX := x;
2003 LastY := y;
2004 {$IFDEF DebugLR}
2005 DebugLnExit('TfrDesignerPage.MDown DONE: Left + cursor=crPencil');
2006 {$ENDIF}
2007 {$ifdef ppaint}
2008 NPDrawSelection;
2009 {$endif}
2010 Exit;
2011 end;
2012 end;
2013
2014 if FDesigner.ShowGuides then
2015 fGuides.ResetMoveSelection(x, y);
2016
2017 if Cursor = crDefault then
2018 begin
2019 f := False;
2020 for i := Objects.Count - 1 downto 0 do
2021 begin
2022 t := TfrView(Objects[i]);
2023 V:=t.PointInView(X,Y);
2024 {$IFDEF DebugLR}
2025 DebugLn(t.Name,' PointInView(Rgn, X, Y)=',dbgs(V),' Selected=',dbgs(t.selected));
2026 {$ENDIF}
2027 if v then
2028 begin
2029 if ssShift in Shift then
2030 begin
2031 t.Selected := not t.Selected;
2032 if t.Selected then
2033 Inc(TfrDesignerForm(frDesigner).SelNum)
2034 else
2035 Dec(TfrDesignerForm(frDesigner).SelNum);
2036 end
2037 else
2038 begin
2039 if not t.Selected then
2040 begin
2041 FDesigner.Unselect;
2042 TfrDesignerForm(frDesigner).SelNum := 1;
2043 t.Selected := True;
2044 end
2045 else DontChange := True;
2046 end;
2047
2048 if TfrDesignerForm(frDesigner).SelNum = 0 then
2049 TfrDesignerForm(frDesigner).FirstSelected := nil
2050 else
2051 if TfrDesignerForm(frDesigner).SelNum = 1 then
2052 TfrDesignerForm(frDesigner).FirstSelected := t
2053 else
2054 if TfrDesignerForm(frDesigner).FirstSelected <> nil then
2055 if not TfrDesignerForm(frDesigner).FirstSelected.Selected then
2056 TfrDesignerForm(frDesigner).FirstSelected := nil;
2057 f := True;
2058 break;
2059 end;
2060 end;
2061
2062 if not f then
2063 begin
2064 FDesigner.Unselect;
2065 TfrDesignerForm(frDesigner).SelNum := 0;
2066 TfrDesignerForm(frDesigner).FirstSelected := nil;
2067 if Button = mbLeft then
2068 begin
2069 RFlag := True;
2070 OldRect := Rect(x, y, x, y);
2071 {$IFDEF DebugLR}
2072 DebugLnExit('TfrDesignerPage.MDown DONE: Deselection o no selection');
2073 {$ENDIF}
2074 {$ifdef ppaint}
2075 NPDrawSelection;
2076 {$endif}
2077
2078 Exit;
2079 end;
2080 end;
2081
2082 GetMultipleSelected;
2083 if not DontChange then
2084 begin
2085 FDesigner.SelectionChanged;
2086 FDesigner.ResetDuplicateCount;
2087 end;
2088 end
2089 else
2090 if (Cursor = crSizeNWSE) and (FDesigner.Page is TfrPageDialog) then
2091 begin
2092 if (X > FDesigner.Page.Width - 10) and (X < FDesigner.Page.Width +10) and (Y > FDesigner.Page.Height - 10) and (Y < FDesigner.Page.Height + 10) then
2093 fResizeDialog:=true
2094 else
2095 fResizeDialog:=false;
2096 Exit;
2097 end;
2098
2099 if TfrDesignerForm(frDesigner).SelNum = 0 then
2100 begin // reset multiple selection
2101 RightBottom := -1;
2102 TfrDesignerForm(frDesigner).MRFlag := False;
2103 end;
2104
2105 LastX := x;
2106 LastY := y;
2107 Moved := False;
2108 FirstChange := True;
2109 FirstBandMove := True;
2110
2111 if Button = mbRight then
2112 begin
2113 NPDrawSelection;
2114 Down := False;
2115 GetCursorPos(p{%H-});
2116 //FDesigner.Popup1Popup(nil);
2117
2118 FDesigner.Popup1.PopUp(p.X,p.Y);
2119 //**
2120 {TrackPopupMenu(FDesigner.Popup1.Handle,
2121 TPM_LEFTALIGN or TPM_RIGHTBUTTON, p.X, p.Y, 0, FDesigner.Handle, nil);
2122 }
2123 end
2124 else if FDesigner.ShapeMode = smFrame then
2125 DrawPage(dmShape);
2126
2127 {$IFDEF DebugLR}
2128 DebugLnExit('TfrDesignerPage.MDown DONE');
2129 {$ENDIF}
2130 end;
2131
2132 procedure TfrDesignerPage.MUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
2133 X, Y: Integer);
2134 var
2135 i, k, dx, dy: Integer;
2136 t: TfrView;
2137 ObjectInserted: Boolean;
2138
2139 procedure AddObject(ot: Byte);
2140 begin
2141 { Objects.Add(frCreateObject(ot, '', FDesigner.Page));
2142 t := TfrView(Objects.Last);}
2143 t:=frCreateObject(ot, '', FDesigner.Page);
2144 if t is TfrCustomMemoView then
2145 TfrCustomMemoView(t).MonitorFontChanges;
2146 end;
2147
2148 procedure CreateSection;
2149 var
2150 s: String;
2151 begin
2152 frBandTypesForm := TfrBandTypesForm.Create(FDesigner);
2153 try
2154 ObjectInserted := frBandTypesForm.ShowModal = mrOk;
2155 if ObjectInserted then
2156 begin
2157 { Objects.Add(TfrBandView.Create(FDesigner.Page));
2158 t := TfrView(Objects.Last);}
2159 t:=TfrBandView.Create(FDesigner.Page);
2160 (t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
2161 s := frGetBandName(frBandTypesForm.SelectedTyp);
2162 THackView(t).BaseName := s;
2163 SendBandsToDown;
2164 end;
2165 finally
2166 frBandTypesForm.Free;
2167 end;
2168 end;
2169
2170 procedure CreateSubReport;
2171 begin
2172 t:=TfrSubReportView.Create(FDesigner.Page);
2173 (t as TfrSubReportView).SubPage := CurReport.Pages.Add;
2174 end;
2175
2176 begin
2177 {$IFDEF DebugLR}
2178 DebugLnEnter('TfrDesignerPage.MUp INIT Button=%d Cursor=%d RFlag=%s',
2179 [ord(Button),Cursor,dbgs(RFlag)]);
2180 {$ENDIF}
2181 if Button <> mbLeft then
2182 begin
2183 {$IFDEF DebugLR}
2184 DebugLnExit('TfrDesignerPage.MUp DONE: Button<>mbLeft');
2185 {$ENDIF}
2186 Exit;
2187 end;
2188
2189 Down := False;
2190 if FDesigner.ShapeMode = smFrame then
2191 DrawPage(dmShape);
2192
2193 //inserting a new object
2194 if Cursor = crCross then
2195 begin
2196 {$IFDEF DebugLR}
2197 DebugLnEnter('Inserting a New Object INIT');
2198 {$ENDIF}
2199 EnableEvents(false);
2200 Mode := mdSelect;
2201 if (OldRect.Left = OldRect.Right) and (OldRect.Top = OldRect.Bottom) then
2202 OldRect := OldRect1
2203 else
2204 NPEraseFocusRect;
2205 NormalizeRect(OldRect);
2206 RFlag := False;
2207 ObjectInserted := True;
2208
2209 if FDesigner.Panel4.Visible then
2210 begin
2211 with FDesigner.Panel4 do
2212 begin
2213 for i := 0 to ControlCount - 1 do
2214 begin
2215 if Controls[i] is TSpeedButton then
2216 begin
2217 with Controls[i] as TSpeedButton do
2218 begin
2219 if Down then
2220 begin
2221 if Tag = gtBand then
2222 begin
2223 if GetUnusedBand <> btNone then
2224 CreateSection
2225 else
2226 begin
2227 {$IFDEF DebugLR}
2228 DebugLnExit('Inserting a new object DONE: GetUnusedBand=btNone');
2229 DebugLnExit('TfrDesignerPage.MUp DONE: Inserting..');
2230 {$ENDIF}
2231 EnableEvents;
2232 Exit;
2233 end;
2234 end
2235 else if Tag = gtSubReport then
2236 CreateSubReport
2237 else
2238 begin
2239 if Tag >= gtAddIn then
2240 begin
2241 k := Tag - gtAddIn;
2242 { Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
2243 t := TfrView(Objects.Last);}
2244 t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
2245 end
2246 else
2247 AddObject(Tag);
2248 end;
2249 break;
2250 end;
2251 end;
2252 end;
2253 end;
2254 end;
2255 end
2256 else
2257 begin
2258 with FDesigner.panForDlg do
2259 begin
2260 for i := 0 to ControlCount - 1 do
2261 begin
2262 if Controls[i] is TSpeedButton then
2263 begin
2264 with Controls[i] as TSpeedButton do
2265 begin
2266 if Down then
2267 begin
2268 if Tag >= gtAddIn then
2269 begin
2270 k := Tag - gtAddIn;
2271 { Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
2272 t := TfrView(Objects.Last);}
2273 t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
2274 end
2275 else
2276 AddObject(Tag);
2277 break;
2278 end;
2279 end;
2280 end;
2281 end;
2282 end;
2283 end;
2284
2285 if ObjectInserted then
2286 begin
2287 {$IFDEF DebugLR}
2288 debugLn('Object inserted begin');
2289 {$ENDIF}
2290 t.CreateUniqueName;
2291 t.Canvas:=Canvas;
2292
2293 with OldRect do
2294 begin
2295 if (Left = Right) or (Top = Bottom) then
2296 begin
2297 dx := 40;
2298 dy := 40;
2299 if t is TfrCustomMemoView then
2300 FDesigner.GetDefaultSize(dx, dy);
2301 OldRect := Rect(Left, Top, Left + dx, Top + dy);
2302 end;
2303 end;
2304 {$ifdef ppaint}
2305 NPEraseSelection;
2306 {$endif}
2307 FDesigner.Unselect;
2308 t.x := OldRect.Left;
2309 t.y := OldRect.Top;
2310 t.dx := OldRect.Right - OldRect.Left;
2311 t.dy := OldRect.Bottom - OldRect.Top;
2312
2313 if (t is TfrBandView) and
2314 (TfrBandView(t).BandType in [btCrossHeader..btCrossFooter]) and
2315 (t.dx > Width - 10) then
2316 t.dx := 40;
2317 t.FrameWidth := LastFrameWidth;
2318 t.FrameColor := LastFrameColor;
2319 t.FillColor := LastFillColor;
2320 t.Selected := True;
2321
2322 if t.Typ <> gtBand then
2323 t.Frames:=LastFrames;
2324
2325 if t is TfrCustomMemoView then
2326 begin
2327 with t as TfrCustomMemoView do
2328 begin
2329 Font.Name := LastFontName;
2330 Font.Size := LastFontSize;
2331 Font.Color := LastFontColor;
2332 Font.Style := frSetFontStyle(LastFontStyle);
2333 Adjust := LastAdjust;
2334 end;
2335 end
2336 else
2337 if t is TfrControl then
2338 TfrControl(T).UpdateControlPosition;
2339
2340 TfrDesignerForm(frDesigner).SelNum := 1;
2341 NPRedrawViewCheckBand(t);
2342
2343 with FDesigner do
2344 begin
2345 SelectionChanged;
2346 AddUndoAction(acInsert);
2347 if EditAfterInsert then
2348 ShowEditor;
2349 end;
2350
2351 {$IFDEF DebugLR}
2352 DebugLn('Object inserted end');
2353 {$ENDIF}
2354 end;
2355
2356 if not TfrDesignerForm(frDesigner).ObjRepeat then
2357 begin
2358 if FDesigner.Page is TfrPageReport then
2359 FDesigner.OB1.Down := True
2360 else
2361 FDesigner.OB7.Down := True
2362 end
2363 else
2364 NPEraseFocusRect;
2365
2366 {$IFDEF DebugLR}
2367 DebugLnExit('Inserting a New Object DONE');
2368 DebugLnExit('TfrDesignerPage.MUp DONE: Inserting ...');
2369 {$ENDIF}
2370 EnableEvents;
2371 Exit;
2372 end;
2373
2374 //line drawing
2375 if Cursor = crPencil then
2376 begin
2377 DrawRectLine(OldRect);
2378 AddObject(gtLine);
2379 t.CreateUniqueName;
2380 t.x := OldRect.Left; t.y := OldRect.Top;
2381 t.dx := OldRect.Right - OldRect.Left;
2382 t.dy := OldRect.Bottom - OldRect.Top;
2383 if t.dx < 0 then
2384 begin
2385 t.dx := -t.dx; if Abs(t.dx) > Abs(t.dy) then t.x := OldRect.Right;
2386 end;
2387 if t.dy < 0 then
2388 begin
2389 t.dy := -t.dy; if Abs(t.dy) > Abs(t.dx) then t.y := OldRect.Bottom;
2390 end;
2391 t.Selected := True;
2392 t.BeginUpdate;
2393 t.FrameWidth := LastLineWidth;
2394 t.FrameColor := LastFrameColor;
2395 t.EndUpdate;
2396 TfrDesignerForm(frDesigner).SelNum := 1;
2397 NPRedrawViewCheckBand(t);
2398 FDesigner.SelectionChanged;
2399 FDesigner.AddUndoAction(acInsert);
2400 {$IFDEF DebugLR}
2401 DebugLnExit('TfrDesignerPage.MUp DONE: Line Drawing');
2402 {$ENDIF}
2403 Exit;
2404 end;
2405
2406 // calculating which objects contains in frame (if user select it with mouse+Ctrl key)
2407 if RFlag then
2408 begin
2409 NPEraseFocusRect;
2410 RFlag := False;
2411 NormalizeRect(OldRect);
2412 for i := 0 to Objects.Count - 1 do
2413 begin
2414 t := TfrView(Objects[i]);
2415 with OldRect do
2416 begin
2417 if t.Typ <> gtBand then
2418 begin
2419 if not ((t.x > Right) or (t.x + t.dx < Left) or
2420 (t.y > Bottom) or (t.y + t.dy < Top)) then
2421 begin
2422 t.Selected := True;
2423 Inc(TfrDesignerForm(frDesigner).SelNum);
2424 end;
2425 end;
2426 end;
2427 end;
2428 GetMultipleSelected;
2429 FDesigner.SelectionChanged;
2430 NPDrawSelection;
2431 {$IFDEF DebugLR}
2432 DebugLnExit('TfrDesignerPage.MUp DONE: objects contained in frame');
2433 {$ENDIF}
2434 Exit;
2435 end;
2436
2437 //splitting
2438 if Moved and TfrDesignerForm(frDesigner).MRFlag and (Cursor = crHSplit) then
2439 begin
2440 with SplitInfo do
2441 begin
2442 dx := SplRect.Left - SplX;
2443 if (View1.dx + dx > 0) and (View2.dx - dx > 0) then
2444 begin
2445 Inc(View1.dx, dx);
2446 Inc(View2.x, dx);
2447 Dec(View2.dx, dx);
2448 end;
2449 end;
2450 GetMultipleSelected;
2451 NPDrawLayerObjects(ClipRgn, TopSelected);
2452 {$IFDEF DebugLR}
2453 DebugLnExit('TfrDesignerPage.MUp DONE: Splitting');
2454 {$ENDIF}
2455 Exit;
2456 end;
2457
2458 //resizing several objects
2459 if Moved and TfrDesignerForm(frDesigner).MRFlag and (Cursor <> crDefault) then
2460 begin
2461 {$ifdef ppaint}
2462 NPDrawSelection;
2463 DeleteObject(ClipRgn);
2464 ClipRgn:=0;
2465 {$else}
2466 NPDrawLayerObjects(ClipRgn, TopSelected);
2467 {$endif}
2468 {$IFDEF DebugLR}
2469 DebugLnExit('TfrDesignerPage.MUp DONE: resizing several objects');
2470 {$ENDIF}
2471 Exit;
2472 end;
2473
2474 //redrawing all moved or resized objects
2475 if not Moved then
2476 begin
2477 NPDrawSelection;
2478 {$IFDEF DebugLR}
2479 DebugLn('redrawing all moved or resized objects');
2480 {$ENDIF}
2481 end;
2482
2483 if (TfrDesignerForm(frDesigner).SelNum >= 1) and Moved then
2484 begin
2485 if TfrDesignerForm(frDesigner).SelNum > 1 then
2486 begin
2487 //JRA DebugLn('HERE, ClipRgn', Dbgs(ClipRgn));
2488 {$ifdef ppaint}
2489 NPDrawSelection;
2490 if ClipRgn<>0 then
2491 DeleteObject(ClipRgn);
2492 ClipRgn:=0;
2493 {$else}
2494 NPDrawLayerObjects(ClipRgn, TopSelected);
2495 {$endif}
2496 GetMultipleSelected;
2497 FDesigner.ShowPosition;
2498 end
2499 else
2500 begin
2501 t := TfrView(Objects[TopSelected]);
2502 NormalizeCoord(t);
2503 if Cursor <> crDefault then
2504 t.Resized;
2505
2506 if T is TfrControl then
2507 TfrControl(T).UpdateControlPosition;
2508
2509 {$ifdef ppaint}
2510 NPDrawSelection;
2511 if ClipRgn<>0 then
2512 begin
2513 DeleteObject(ClipRgn);
2514 Invalidate;
2515 end;
2516 ClipRgn:=0;
2517 {$else}
2518 NPDrawLayerObjects(ClipRgn, TopSelected);
2519 {$endif}
2520 FDesigner.ShowPosition;
2521
2522 if T is TfrMemoView then
2523 FDesigner.ShowIEButton(T as TfrMemoView);
2524 end;
2525 end;
2526
2527 if (FDesigner.Page is TfrPageDialog) and (fResizeDialog ) then
2528 begin
2529 Width:=X;
2530 Height:=Y;
2531 fResizeDialog:=false;
2532 Mode:=mdSelect;
2533 FDesigner.Page.Width:=X;
2534 FDesigner.Page.Height:=Y;
2535 DrawPage(dmAll);
2536 FDesigner.Modified:=true;
2537 for i := 0 to Objects.Count - 1 do
2538 begin
2539 t := TfrView(Objects[i]);
2540 if T is TfrControl then
2541 TfrControl(T).UpdateControlPosition;
2542 end;
2543 end;
2544
2545
2546 Moved := False;
2547 CT := ctNone;
2548 {$IFDEF DebugLR}
2549 DebugLnExit('TfrDesignerPage.MUp DONE');
2550 {$ENDIF}
2551 end;
2552
2553 procedure TfrDesignerPage.MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
2554 var
2555 i, j, kx, ky, w, dx, dy: Integer;
2556 t, t1, Bnd: TfrView;
2557 nx, ny, x1, x2, y1, y2: Double;
2558 hr, hr1,Hr2: HRGN;
2559
Contnull2560 function Cont(px, py, x, y: Integer): Boolean;
2561 begin
2562 Result := (x >= px - w) and (x <= px + w + 1) and
2563 (y >= py - w) and (y <= py + w + 1);
2564 end;
2565
GridChecknull2566 function GridCheck:Boolean;
2567 begin
2568 with FDesigner do
2569 begin
2570 Result := (kx >= GridSize) or (kx <= -GridSize) or
2571 (ky >= GridSize) or (ky <= -GridSize);
2572 if Result then
2573 begin
2574 kx := kx - kx mod GridSize;
2575 ky := ky - ky mod GridSize;
2576 end;
2577 end;
2578 end;
2579
SnapCoordsnull2580 function SnapCoords: boolean;
2581 begin
2582 result := true;
2583 if FDesigner.ShowGuides and fGuides.SnapToGuide(x, y) then begin
2584 kx := x - LastX;
2585 ky := y - LastY;
2586 end else begin
2587 kx := x - LastX;
2588 ky := y - LastY;
2589 if FDesigner.GridAlign and not GridCheck then
2590 result := false;
2591 end;
2592 end;
2593
2594 begin
2595 {$IFDEF DebugLR}
2596 DebugLnEnter('TfrDesignerPage.MMove(X=%d,Y=%d) INIT',[x,y]);
2597 {$ENDIF}
2598 Moved := True;
2599 w := 2;
2600
2601 if FDesigner.ShowGuides then
2602 begin
2603 if not down then
2604 // normal snap guide to any object
2605 fGuides.FindGuides(x, y)
2606 else
2607 if (Cursor = crPencil) or
2608 (Cursor = crCross) then
2609 // normal snap to guide for inserting objects or drawing lines
2610 fGuides.FindGuides(x, y)
2611 else
2612 if (TfrDesignerForm(frDesigner).SelNum >= 1) then
2613 // don't create a guide for the object(s) being resized
2614 fGuides.FindGuides(x, y, true);
2615 end;
2616
2617 if FirstChange and Down and not RFlag then
2618 begin
2619 kx := x - LastX;
2620 ky := y - LastY;
2621 if not FDesigner.GridAlign or GridCheck then
2622 begin
2623 GetRegion; //JRA 1
2624 FDesigner.AddUndoAction(acEdit);
2625 end;
2626 end;
2627
2628 if not Down then
2629 begin
2630 if FDesigner.panForDlg.Visible then
2631 begin
2632 if FDesigner.OB7.Down then
2633 begin
2634 Mode := mdSelect;
2635 if (X > FDesigner.Page.Width - 10) and (X < FDesigner.Page.Width + 10) and (Y > FDesigner.Page.Height - 10) and (Y < FDesigner.Page.Height + 10) then
2636 Cursor := crSizeNWSE
2637 else
2638 Cursor := crDefault;
2639
2640
2641 end
2642 else
2643 begin
2644 Mode := mdInsert;
2645 if Cursor <> crCross then
2646 begin
2647 RoundCoord(x, y);
2648 kx := Width; ky := 40;
2649 // if not FDesigner.OB3.Down then
2650 FDesigner.GetDefaultSize(kx, ky);
2651 OldRect := Rect(x, y, x + kx, y + ky);
2652 NPDrawFocusRect;
2653 end;
2654 Cursor := crCross;
2655 end;
2656 end
2657 else
2658 if FDesigner.OB6.Down then
2659 begin
2660 Mode := mdSelect;
2661 Cursor := crPencil;
2662 end
2663 else
2664 if FDesigner.OB1.Down then
2665 begin
2666 Mode := mdSelect;
2667 Cursor := crDefault;
2668 end
2669 else
2670 begin
2671 Mode := mdInsert;
2672 if Cursor <> crCross then
2673 begin
2674 RoundCoord(x, y);
2675 kx := Width; ky := 40;
2676 if not FDesigner.OB3.Down then
2677 FDesigner.GetDefaultSize(kx, ky);
2678 OldRect := Rect(x, y, x + kx, y + ky);
2679 NPDrawFocusRect;
2680 end;
2681 Cursor := crCross;
2682 end;
2683 end;
2684
2685 {$IFDEF DebugLR}
2686 DebugLn('Mode Insert=%s Down=%s',[dbgs(Mode=mdInsert),dbgs(Down)]);
2687 {$ENDIF}
2688
2689 if (Mode = mdInsert) and not Down then
2690 begin
2691 NPEraseFocusRect;
2692 RoundCoord(x, y);
2693 OffsetRect(OldRect, x - OldRect.Left, y - OldRect.Top);
2694 NPDrawFocusRect;
2695 ShowSizes := True;
2696 FDesigner.UpdateStatus;
2697 ShowSizes := False;
2698 {$IFDEF DebugLR}
2699 DebugLnExit('TfrDesignerPage.MMove DONE: Mode Insert and not Down');
2700 {$ENDIF}
2701 Exit;
2702 end;
2703
2704 //cursor shapes
2705 if not Down and (TfrDesignerForm(frDesigner).SelNum = 1) and (Mode = mdSelect) and
2706 not FDesigner.OB6.Down then
2707 begin
2708 t := TfrView(Objects[TopSelected]);
2709 if Cont(t.x, t.y, x, y) or Cont(t.x + t.dx, t.y + t.dy, x, y) then
2710 Cursor := crSizeNWSE
2711 else if Cont(t.x + t.dx, t.y, x, y) or Cont(t.x, t.y + t.dy, x, y)then
2712 Cursor := crSizeNESW
2713 else if Cont(t.x + t.dx div 2, t.y, x, y) or Cont(t.x + t.dx div 2, t.y + t.dy, x, y) then
2714 Cursor := crSizeNS
2715 else if Cont(t.x, t.y + t.dy div 2, x, y) or Cont(t.x + t.dx, t.y + t.dy div 2, x, y) then
2716 Cursor := crSizeWE
2717 else
2718 Cursor := crDefault;
2719 end;
2720
2721 if Down then
2722 FDesigner.HideIEButton;
2723
2724 //selecting a lot of objects
2725 if Down and RFlag then
2726 begin
2727 NPEraseFocusRect;
2728 if Cursor = crCross then
2729 RoundCoord(x, y);
2730 OldRect := Rect(OldRect.Left, OldRect.Top, x, y);
2731 NPDrawFocusRect;
2732 ShowSizes := True;
2733 if Cursor = crCross then
2734 FDesigner.UpdateStatus;
2735 ShowSizes := False;
2736 {$IFDEF DebugLR}
2737 DebugLnExit('TfrDesignerPage.MMove DONE: DOWN and RFLag (sel alot of objs)');
2738 {$ENDIF}
2739 Exit;
2740 end;
2741
2742 //line drawing
2743 if Down and (Cursor = crPencil) then
2744 begin
2745 if not SnapCoords then begin
2746 {$IFDEF DebugLR}
2747 DebugLnExit('TfrDesignerPage.MMove DONE: not gridcheck and gridalign');
2748 {$ENDIF}
2749 Exit;
2750 end;
2751 DrawRectLine(OldRect);
2752 OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
2753 DrawRectLine(OldRect);
2754 Inc(LastX, kx);
2755 Inc(LastY, ky);
2756 {$IFDEF DebugLR}
2757 DebugLnExit('TfrDesignerPage.MMove DONE: Line drawing');
2758 {$ENDIF}
2759 Exit;
2760 end;
2761
2762 //check for multiple selected objects - right-bottom corner
2763 if not Down and (TfrDesignerForm(frDesigner).SelNum > 1) and (Mode = mdSelect) then
2764 begin
2765 t := TfrView(Objects[RightBottom]);
2766 if Cont(t.x + t.dx, t.y + t.dy, x, y) then
2767 Cursor := crSizeNWSE
2768 end;
2769
2770 //split checking
2771 if not Down and (TfrDesignerForm(frDesigner).SelNum > 1) and (Mode = mdSelect) then
2772 begin
2773 for i := 0 to Objects.Count-1 do
2774 begin
2775 t := TfrView(Objects[i]);
2776 if (t.Typ <> gtBand) and t.Selected then
2777 if (x >= t.x) and (x <= t.x + t.dx) and (y >= t.y) and (y <= t.y + t.dy) then
2778 begin
2779 for j := 0 to Objects.Count - 1 do
2780 begin
2781 t1 := TfrView(Objects[j]);
2782 if (t1.Typ <> gtBand) and (t1 <> t) and t1.Selected then
2783 if ((t.x = t1.x + t1.dx) and ((x >= t.x) and (x <= t.x + 2))) or
2784 ((t1.x = t.x + t.dx) and ((x >= t1.x - 2) and (x <= t.x))) then
2785 begin
2786 Cursor := crHSplit;
2787 with SplitInfo do
2788 begin
2789 SplRect := Rect(x, t.y, x, t.y + t.dy);
2790 if t.x = t1.x + t1.dx then
2791 begin
2792 SplX := t.x;
2793 View1 := t1;
2794 View2 := t;
2795 end
2796 else
2797 begin
2798 SplX := t1.x;
2799 View1 := t;
2800 View2 := t1;
2801 end;
2802 SplRect.Left := SplX;
2803 SplRect.Right := SplX;
2804 end;
2805 end;
2806 end;
2807 end;
2808 end;
2809 end;
2810
2811 // splitting
2812 if Down and TfrDesignerForm(frDesigner).MRFlag and (Mode = mdSelect) and (Cursor = crHSplit) then
2813 begin
2814 kx := x - LastX;
2815 ky := 0;
2816 if FDesigner.GridAlign and not GridCheck then begin
2817 {$IFDEF DebugLR}
2818 DebugLnExit('TfrDesignerPage.MMove DONE: Splitting not grid check');
2819 {$ENDIF}
2820 Exit;
2821 end;
2822 with SplitInfo do
2823 begin
2824 DrawHSplitter(SplRect);
2825 SplRect := Rect(SplRect.Left + kx, SplRect.Top, SplRect.Right + kx, SplRect.Bottom);
2826 DrawHSplitter(SplRect);
2827 end;
2828 Inc(LastX, kx);
2829 {$IFDEF DebugLR}
2830 DebugLnExit('TfrDesignerPage.MMove DONE: Splitting');
2831 {$ENDIF}
2832 Exit;
2833 end;
2834
2835 // sizing several objects
2836 if Down and TfrDesignerForm(frDesigner).MRFlag and (Mode = mdSelect) and (Cursor <> crDefault) then
2837 begin
2838 if not SnapCoords then begin
2839 {$IFDEF DebugLR}
2840 DebugLnExit('TfrDesignerPage.MMove DONE: sizing seveal, not gridcheck');
2841 {$ENDIF}
2842 Exit;
2843 end;
2844
2845 if FDesigner.ShapeMode = smFrame then
2846 DrawPage(dmShape)
2847 else
2848 begin
2849 hr := CreateRectRgn(0, 0, 0, 0);
2850 hr1 := CreateRectRgn(0, 0, 0, 0);
2851 end;
2852
2853 OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
2854 nx := (OldRect.Right - OldRect.Left) / (OldRect1.Right - OldRect1.Left);
2855 ny := (OldRect.Bottom - OldRect.Top) / (OldRect1.Bottom - OldRect1.Top);
2856 for i := 0 to Objects.Count - 1 do
2857 begin
2858 t := TfrView(Objects[i]);
2859 if (t.Selected) and not (lrrDontSize in T.Restrictions) then
2860 begin
2861 if FDesigner.ShapeMode = smAll then
2862 AddRgn(hr, t);
2863 x1 := (t.OriginalRect.Left - LeftTop.x) * nx;
2864 x2 := t.OriginalRect.Right * nx;
2865 dx := Round(x1 + x2) - (Round(x1) + Round(x2));
2866 t.x := LeftTop.x + Round(x1);
2867 t.dx := Round(x2) + dx;
2868
2869 y1 := (t.OriginalRect.Top - LeftTop.y) * ny;
2870 y2 := t.OriginalRect.Bottom * ny;
2871 dy := Round(y1 + y2) - (Round(y1) + Round(y2));
2872 t.y := LeftTop.y + Round(y1);
2873 t.dy := Round(y2) + dy;
2874 if FDesigner.ShapeMode = smAll then
2875 AddRgn(hr1, t);
2876 end;
2877 end;
2878
2879 if FDesigner.ShapeMode = smFrame then
2880 DrawPage(dmShape)
2881 else
2882 begin
2883 NPDrawLayerObjects(hr);
2884 NPDrawLayerObjects(hr1);
2885 end;
2886
2887 Inc(LastX, kx);
2888 Inc(LastY, ky);
2889 FDesigner.UpdateStatus;
2890 {$IFDEF DebugLR}
2891 DebugLnExit('TfrDesignerPage.MMove DONE: Sizing several objects');
2892 {$ENDIF}
2893 Exit;
2894 end;
2895
2896 //moving
2897 if Down and (Mode = mdSelect) and (TfrDesignerForm(frDesigner).SelNum >= 1) and (Cursor = crDefault) then
2898 begin
2899 kx := x - LastX;
2900 ky := y - LastY;
2901 if FDesigner.ShowGuides and fGuides.SnapSelectionToGuide(kx, ky, x, y) then
2902 begin
2903 kx := x - LastX;
2904 ky := y - LastY;
2905 end else begin
2906 if FDesigner.GridAlign and not GridCheck then begin
2907 {$IFDEF DebugLR}
2908 DebugLnExit('TfrDesignerPage.MMove DONE: moving');
2909 {$ENDIF}
2910 Exit;
2911 end;
2912 end;
2913 if FirstBandMove and (TfrDesignerForm(frDesigner).SelNum = 1) and ((kx <> 0) or (ky <> 0)) and
2914 not (ssAlt in Shift) then
2915 begin
2916 if Assigned(Objects[TopSelected]) and (TFrView(Objects[TopSelected]).Typ = gtBand) then
2917 begin
2918 Bnd := TfrView(Objects[TopSelected]);
2919 for i := 0 to Objects.Count-1 do
2920 begin
2921 t := TfrView(Objects[i]);
2922 if t.Typ <> gtBand then
2923 begin
2924
2925 if (t.x >= Bnd.x) and (t.x + t.dx <= Bnd.x + Bnd.dx) and
2926 (t.y >= Bnd.y) and (t.y + t.dy <= Bnd.y + Bnd.dy) then
2927 begin
2928 t.Selected := True;
2929 Inc(TfrDesignerForm(frDesigner).SelNum);
2930 end;
2931 end;
2932 end;
2933 ColorLocked := True;
2934 FDesigner.SelectionChanged;
2935 GetMultipleSelected;
2936 ColorLocked := False;
2937 end;
2938 end;
2939
2940 FirstBandMove := False;
2941
2942 MoveResize(kx,ky,FDesigner.ShapeMode=smFrame, false);
2943
2944 Inc(LastX, kx);
2945 Inc(LastY, ky);
2946 FDesigner.UpdateStatus;
2947 end;
2948 {$IFDEF DebugLR}
2949 // else debugLn('Down=',BoolToStr(Down),' Mode=',IntToStr(Ord(Mode)),' SelNum=',IntToStr(Selnum),' Cursor=',IntToStr(Cursor));
2950 {$ENDIF}
2951
2952 //resizing
2953 if Down and (Mode = mdSelect) and (TfrDesignerForm(frDesigner).SelNum = 1) and (Cursor <> crDefault) then
2954 begin
2955 if FDesigner.ShowGuides then
2956 fGuides.SnapToGuide(x, y);
2957 kx := x - LastX;
2958 ky := y - LastY;
2959 if FDesigner.GridAlign and not GridCheck then begin
2960 {$IFDEF DebugLR}
2961 DebugLnExit('TfrDesignerPage.MMove DONE: resizing');
2962 {$ENDIF}
2963 Exit;
2964 end;
2965
2966 t := TfrView(Objects[TopSelected]);
2967 if (lrrDontSize in T.Restrictions) then
2968 exit;
2969
2970 if FDesigner.ShapeMode = smFrame then
2971 DrawPage(dmShape)
2972 else
2973 hr:=t.GetClipRgn(rtExtended);
2974 w := 3;
2975
2976 if Cursor = crSizeNWSE then
2977 begin
2978 if (CT <> ct2) and ((CT = ct1) or Cont(t.x, t.y, LastX, LastY)) then
2979 begin
2980 t.x := t.x + kx;
2981 t.dx := t.dx - kx;
2982 t.y := t.y + ky;
2983 t.dy := t.dy - ky;
2984 CT := ct1;
2985 end
2986 else
2987 begin
2988 t.dx := t.dx + kx;
2989 t.dy := t.dy + ky;
2990 CT := ct2;
2991 end;
2992 end;
2993
2994 if Cursor = crSizeNESW then
2995 begin
2996 if (CT <> ct4) and ((CT = ct3) or Cont(t.x + t.dx, t.y, LastX, LastY)) then
2997 begin
2998 t.y := t.y + ky;
2999 t.dx := t.dx + kx;
3000 t.dy := t.dy - ky;
3001 CT := ct3;
3002 end
3003 else
3004 begin
3005 t.x := t.x + kx;
3006 t.dx := t.dx - kx;
3007 t.dy := t.dy + ky;
3008 CT := ct4;
3009 end;
3010 end;
3011
3012 if Cursor = crSizeWE then
3013 begin
3014 if (CT <> ct6) and ((CT = ct5) or Cont(t.x, t.y + t.dy div 2, LastX, LastY)) then
3015 begin
3016 t.x := t.x + kx;
3017 t.dx := t.dx - kx;
3018 CT := ct5;
3019 end
3020 else
3021 begin
3022 t.dx := t.dx + kx;
3023 CT := ct6;
3024 end;
3025 end;
3026
3027 if Cursor = crSizeNS then
3028 begin
3029 if (CT <> ct8) and ((CT = ct7) or Cont(t.x + t.dx div 2, t.y, LastX, LastY)) then
3030 begin
3031 t.y := t.y + ky;
3032 t.dy := t.dy - ky;
3033 CT := ct7;
3034 end
3035 else
3036 begin
3037 t.dy := t.dy + ky;
3038 CT := ct8;
3039 end;
3040 end;
3041
3042 if FDesigner.ShapeMode = smFrame then
3043 begin
3044 DrawPage(dmShape);
3045 {$IFDEF DebugLR}
3046 DebugLn('MDown resizing 1');
3047 {$ENDIF}
3048 end
3049 else
3050 begin
3051 Hr1:=CreateRectRgn(0,0,0,0);
3052 Hr2:=t.GetClipRgn(rtExtended);
3053 CombineRgn(hr1, hr, hr2, RGN_OR);
3054 DeleteObject(Hr2);
3055 NPDrawLayerObjects(hr1);
3056 DeleteObject(Hr);
3057 {$IFDEF DebugLR}
3058 DebugLn('MDown resizing 2');
3059 {$ENDIF}
3060 end;
3061
3062 Inc(LastX, kx);
3063 Inc(LastY, ky);
3064 end;
3065
3066 if fResizeDialog then
3067 begin
3068 Width:=X;
3069 Height:=Y;
3070 FDesigner.Page.Width:=X;
3071 FDesigner.Page.Height:=Y;
3072 DrawPage(dmAll);
3073 // Invalidate;
3074 // DrawDialog(0,0);
3075 end;
3076
3077 {$IFDEF DebugLR}
3078 DebugLnExit('TfrDesignerPage.MMove END');
3079 {$ENDIF}
3080 end;
3081
3082 procedure TfrDesignerPage.DClick(Sender: TObject);
3083 begin
3084 {$IFDEF DebugLR}
3085 DebugLnEnter('TfrDesignerPage.DClick INIT DFlag=%s',[dbgs(DFlag)]);
3086 {$ENDIF}
3087 Down := False;
3088 if TfrDesignerForm(frDesigner).SelNum = 0 then
3089 begin
3090 if FDesigner.Page is TfrPageDialog then
3091 FDesigner.ShowDialogPgEditor(TfrPageDialog(FDesigner.Page))
3092 //FDesigner.ShowEditor
3093 else
3094 FDesigner.PgB3Click(nil);
3095 DFlag := True;
3096 end
3097 else
3098 if TfrDesignerForm(frDesigner).SelNum = 1 then
3099 begin
3100 DFlag := True;
3101 FDesigner.ShowEditor;
3102 end;
3103 {$IFDEF DebugLR}
3104 DebugLnExit('TfrDesignerPage.DClick DONE DFlag=%s',[dbgs(DFlag)]);
3105 {$ENDIF}
3106 end;
3107
3108 procedure TfrDesignerPage.MoveResize(Kx, Ky: Integer; UseFrames,AResize: boolean);
3109 var
3110 hr,hr1: HRGN;
3111 i: Integer;
3112 t: TFrView;
3113 begin
3114 If UseFrames then
3115 DrawPage(dmShape)
3116 else
3117 begin
3118 hr := CreateRectRgn(0, 0, 0, 0);
3119 hr1 := CreateRectRgn(0, 0, 0, 0);
3120 end;
3121
3122 for i := 0 to Objects.Count - 1 do
3123 begin
3124 t := TfrView(Objects[i]);
3125 if (not t.Selected) or (AResize and (lrrDontSize in T.Restrictions)) or
3126 ((lrrDontMove in T.Restrictions) and not AResize) then
3127 continue;
3128
3129 if FDesigner.ShapeMode = smAll then
3130 AddRgn(hr, t);
3131 if aResize then
3132 begin
3133 t.dx := t.dx + kx;
3134 t.dy := t.dy + ky;
3135 end
3136 else
3137 begin
3138 t.x := t.x + kx;
3139 t.y := t.y + ky;
3140 end;
3141 if FDesigner.ShapeMode = smAll then
3142 AddRgn(hr1, t);
3143 end;
3144
3145 if UseFrames then
3146 DrawPage(dmShape)
3147 else
3148 begin
3149 CombineRgn(hr, hr, hr1, RGN_OR);
3150 DeleteObject(hr1);
3151 NPDrawLayerObjects(hr);
3152 end;
3153 end;
3154
3155 procedure TfrDesignerPage.EnableEvents(aOk: boolean);
3156 begin
3157 if aOk then
3158 begin
3159 OnMouseDown := @MDown;
3160 OnMouseUp := @MUp;
3161 OnMouseMove := @MMove;
3162 OnDblClick := @DClick;
3163 end else
3164 begin
3165 OnMouseDown := nil;
3166 OnMouseUp := nil;
3167 OnMouseMove := nil;
3168 OnDblClick := nil;
3169 end;
3170 end;
3171
3172 procedure TfrDesignerPage.NPDrawFocusRect;
3173 begin
3174 {$ifdef ppaint}
3175 fPaintSel.FocusRect(OldRect);
3176 {$else}
3177 DrawFocusRect(OldRect);
3178 {$endif}
3179 end;
3180
3181 procedure TfrDesignerPage.NPEraseFocusRect;
3182 begin
3183 {$ifdef ppaint}
3184 fPaintSel.RemoveFocusRect;
3185 {$else}
3186 DrawFocusRect(OldRect);
3187 {$endif}
3188 end;
3189
3190 procedure TfrDesignerPage.NPDrawLayerObjects(Rgn: HRGN; Start:Integer=10000);
3191 {$ifdef ppaint}
3192 var
3193 R: HRGN;
3194 t: TfrView;
3195 i: Integer;
3196 {$endif}
3197 begin
3198 {$ifdef ppaint}
3199 if Rgn = 0 then
3200 begin
3201 // here just make sure all objects, starting at Start
3202 // are invalidated so in next paint cycle they are drawn
3203 Rgn := CreateRectRgn(0, 0, 0, 0);
3204 for i := Objects.Count-1 downto 0 do
3205 if i<=Start then begin
3206 t := TfrView(Objects[i]);
3207 R := t.GetClipRgn(rtNormal);
3208 CombineRgn(Rgn, Rgn, R, RGN_OR);
3209 DeleteObject(R);
3210 end;
3211 end;
3212
3213 InvalidateRgn(Handle, Rgn, false);
3214
3215 DeleteObject(Rgn);
3216 if Rgn=ClipRgn then
3217 ClipRgn := 0;
3218
3219 SelectClipRgn(Canvas.Handle, 0);
3220
3221 {$else}
3222 Draw(Start, Rgn);
3223 {$endif}
3224 end;
3225
3226 procedure TfrDesignerPage.NPDrawSelection;
3227 begin
3228 {$ifdef ppaint}
3229 fPaintSel.InvalidateSelection;
3230 {$else}
3231 DrawPage(dmSelection);
3232 {$endif}
3233 end;
3234
3235 procedure TfrDesignerPage.NPPaintSelection;
3236 begin
3237 {$ifdef ppaint}
3238 fPaintSel.PaintSelection;
3239 {$else}
3240 DrawPage(dmSelection);
3241 {$endif}
3242 end;
3243
3244 procedure TfrDesignerPage.NPEraseSelection;
3245 begin
3246 {$ifdef ppaint}
3247 fPaintSel.InvalidateSelection;
3248 {$else}
3249 DrawPage(dmSelection);
3250 {$endif}
3251 end;
3252
3253 procedure TfrDesignerPage.NPRedrawViewCheckBand(t: TfrView);
3254 begin
3255 {$ifdef ppaint}
3256 if t.typ = gtBand then
3257 NPDrawLayerObjects(t.GetClipRgn(rtExtended))
3258 else
3259 fPaintSel.InvalidateSelection;
3260 {$else}
3261 if t.Typ = gtBand then
3262 begin
3263 {$IFDEF DebugLR}
3264 DebugLn('A new band was inserted');
3265 {$ENDIF}
3266 Draw(10000, t.GetClipRgn(rtExtended))
3267 end
3268 else
3269 begin
3270 t.Draw(Canvas);
3271 DrawSelection(t);
3272 end;
3273 {$endif}
3274 end;
3275
3276 procedure TfrDesignerPage.CMMouseLeave(var Message: TLMessage);
3277 begin
3278 if (Mode = mdInsert) and not Down then
3279 begin
3280 NPEraseFocusRect;
3281 OffsetRect(OldRect, -10000, -10000);
3282 end;
3283 fGuides.HideGuides;
3284 end;
3285
3286 {-----------------------------------------------------------------------------}
3287 procedure BDown(SB: TSpeedButton);
3288 begin
3289 SB.Down := True;
3290 end;
3291
3292 procedure BUp(SB: TSpeedButton);
3293 begin
3294 SB.Down := False;
3295 end;
3296 {
3297 function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
3298 FontType: Integer; Data: Pointer): Integer; stdcall;
3299 begin
3300 TfrDesignerForm(frDesigner).C2.Items.AddObject(StrPas(LogFont.lfFaceName), TObject(FontType));
3301 Result := 1;
3302 end;
3303 }
3304
3305 function EnumFontsProc(
3306 var LogFont: TEnumLogFontEx;
3307 var {%H-}Metric: TNewTextMetricEx;
3308 FontType: Longint;
3309 {%H-}Data: LParam):LongInt; stdcall;
3310 var
3311 S: String;
3312 Lst: TStrings;
3313 begin
3314 s := StrPas(LogFont.elfLogFont.lfFaceName);
3315 Lst := TStrings(PtrInt(Data));
3316 Lst.AddObject(S, TObject(PtrInt(FontType)));
3317 Result := 1;
3318 end;
3319
3320 constructor TfrDesignerForm.Create(aOwner: TComponent);
3321 begin
3322 inherited Create(aOwner);
3323 fInBuildPage:=False;
3324 {$IFDEF STDOI}
3325 // create the ObjectInspector
3326 PropHook:= TPropertyEditorHook.Create;
3327 ObjInsp := TObjectInspector.Create(Self);
3328 ObjInsp.SetInitialBounds(10,10,220,400);
3329 ObjInsp.ShowComponentTree := False;
3330 ObjInsp.ShowFavoritePage := False;
3331 ObjInsp.PropertyEditorHook := PropHook;
3332 {$ELSE}
3333 ObjInsp := TFrObjectInspector.Create(Self);
3334 ObjInsp.SetModifiedEvent(@OnModify);
3335 {$ENDIF}
3336 {$ifdef sbod}
3337 StatusBar1.Panels[1].Style := psOwnerDraw;
3338 StatusBar1.OnDrawPanel := @StatusBar1Drawpanel;
3339 Panel7.Visible := false;
3340 {$endif}
3341
3342 { FTabsPage:=TlrTabEditControl((Tab1.Tabs as TTabControlNoteBookStrings).NoteBook);
3343 FTabsPage.DragMode:=dmManual;
3344 FTabsPage.OnDragOver:=@TabsEditDragOver;
3345 FTabsPage.OnDragDrop:=@TabsEditDragDrop;
3346 FTabsPage.OnMouseDown:=@TabsEditMouseDown;
3347 FTabsPage.OnMouseMove:=@TabsEditMouseMove;
3348 FTabsPage.OnMouseUp:=@TabsEditMouseUp;}
3349
3350 Tab1.DragMode:=dmManual;
3351 Tab1.OnDragOver:=@TabsEditDragOver;
3352 Tab1.OnDragDrop:=@TabsEditDragDrop;
3353 Tab1.OnMouseDown:=@TabsEditMouseDown;
3354 Tab1.OnMouseMove:=@TabsEditMouseMove;
3355 Tab1.OnMouseUp:=@TabsEditMouseUp;
3356
3357 end;
3358
3359 destructor TfrDesignerForm.Destroy;
3360 begin
3361 {$IFDEF EXTOI}
3362 ObjInsp.Free;
3363 {$ENDIF}
3364 {$IFDEF STDOI}
3365 PropHook.Free;
3366 {$ENDIF}
3367 inherited Destroy;
3368 end;
3369
3370 procedure TfrDesignerForm.GetFontList;
3371 var
3372 DC: HDC;
3373 Lf: TLogFont;
3374 SysList: TStringList;
3375 {$IFDEF USE_PRINTER_FONTS}
3376 PrnList: TStringList;
3377 i: Integer;
3378 j: PtrInt;
3379 {$ENDIF}
3380 begin
3381 SysList := TStringList.Create;
3382 SysList.Duplicates := dupIgnore;
3383 SysList.Sorted := true;
3384 try
3385 DC := GetDC(0);
3386 try
3387 Lf.lfFaceName := '';
3388 Lf.lfCharSet := DEFAULT_CHARSET;
3389 Lf.lfPitchAndFamily := 0;
3390 EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, PtrInt(SysList), 0);
3391 finally
3392 ReleaseDC(0, DC);
3393 end;
3394 {$IFDEF USE_PRINTER_FONTS}
3395 if not CurReport.PrintToDefault then
3396 begin
3397 PrnList := TStringList.Create;
3398 PrnList.Duplicates := dupIgnore;
3399 PrnList.Sorted := true;
3400 try
3401 // we could use prn.Printer.Fonts but we would be tied to
3402 // implementation detail of list.objects[] encoded with fonttype
3403 // that's why we collect the fonts ourselves here
3404 //
3405 EnumFontFamiliesEx(Prn.Printer.Canvas.Handle, @Lf, @EnumFontsProc, PtrInt(PrnList), 0);
3406 for i:=0 to PrnList.Count-1 do
3407 if SysList.IndexOf(PrnList[i])<0 then begin
3408 j := PtrInt(PrnList.Objects[i]) or $100;
3409 SysList.AddObject(PrnList[i], TObject(PtrInt(j)));
3410 end;
3411 finally
3412 PrnList.Free;
3413 end;
3414 end;
3415 {$ENDIF}
3416 if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then
3417 begin
3418 // font of selected memo has preference, select it
3419 LastFontname := TfrCustomMemoView(FirstSelected).Font.Name;
3420 LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size;
3421 end else
3422 if SysList.IndexOf(LastFontName)>=0 then
3423 // last font name remains valid, keep it together with lastFontSize
3424 else begin
3425 // setup an initial font name and size
3426 if SysList.Count>0 then
3427 LastFontName := SysList[0]
3428 else
3429 LastFontName := '';
3430 if SysList.IndexOf('Arial') <> -1 then
3431 LastFontName := 'Arial'
3432 else if SysList.IndexOf('helvetica [urw]')<>-1 then
3433 LastFontName := 'helvetica [urw]'
3434 else if SysList.IndexOf('Arial Cyr') <> -1 then
3435 LastFontName := 'Arial Cyr';
3436 LastFontSize := 10;
3437 end;
3438 finally
3439 C2.Items.Assign(SysList);
3440 SysList.Free;
3441 end;
3442 end;
3443
3444 procedure TfrDesignerForm.FormCreate(Sender: TObject);
3445 var
3446 i: Integer;
3447 begin
3448 FGridSize := 4;
3449 FGridAlign := True;
3450 FGridShow := False; //True;
3451 FUnits := TfrReportUnits(0);
3452 EditAfterInsert := True;
3453 ShapeMode := TfrShapeMode(1);
3454
3455 Busy := True;
3456 FirstTime := True;
3457 // FirstInstance := FirstInst;
3458
3459 PageView := TfrDesignerPage.Create(Self{ScrollBox1});
3460 PageView.Parent := ScrollBox1;
3461 PageView.FDesigner := Self;
3462 PageView.PopupMenu := Popup1;
3463 PageView.ShowHint := True;
3464
3465 PageView.OnDragDrop:=@ScrollBox1DragDrop;
3466 PageView.OnDragOver:=@ScrollBox1DragOver;
3467 IEPopupMenu.Parent:=PageView;
3468
3469 ColorSelector := TColorSelector.Create(Self);
3470 ColorSelector.OnColorSelected := @ColorSelected;
3471 ColorSelector.Hide;
3472
3473 for i := 0 to frAddInsCount - 1 do
3474 with frAddIns[i] do
3475 begin
3476 if Assigned(frAddIns[i].InitializeProc) then
3477 frAddIns[i].InitializeProc;
3478 RegisterObject(ButtonBMP, ButtonHint, Integer(gtAddIn) + i, ObjectType);
3479 end;
3480
3481 for i := 0 to frToolsCount - 1 do
3482 RegisterTool(frTools[i].Caption, frTools[i].ButtonBMP, frTools[i].OnClick);
3483
3484 EditorForm := TfrEditorForm.Create(nil);
3485
3486 MenuItems := TFpList.Create;
3487 ItemWidths := TStringlist.Create;
3488
3489 IEPopupMenu.Parent:=PageView;
3490 {
3491 if FirstInstance then
3492 begin
3493 //** Application.OnActivate := OnActivateApp;
3494 //** Application.OnDeactivate := OnDeactivateApp;
3495 end
3496 else
3497 begin
3498 PgB1.Enabled := False;
3499 PgB2.Enabled := False;
3500 N41.Enabled := False;
3501 N43.Enabled := False;
3502 N29.Enabled := False;
3503 N30.Enabled := False;
3504 end;
3505 FirstInst := False;
3506 }
3507 FCaption := sFRDesignerFormCapt;
3508 //Panel1.Caption := sFRDesignerFormrect;
3509 //Panel2.Caption := sFRDesignerFormStd;
3510 //Panel3.Caption := sFRDesignerFormText;
3511 //Panel5.Caption := sFRDesignerFormAlign;
3512 //Panel6.Caption := sFRDesignerFormTools;
3513 FileBtn1.Hint := sFRDesignerFormNewRp;
3514 //FileBtn2.Hint := sFRDesignerFormOpenRp;
3515 FileOpen.Hint:= sFRDesignerFormOpenRp;
3516 FileOpen.Caption:= sFRDesignerForm_Open;
3517
3518 FileSave.Hint:= sFRDesignerFormSaveRp;
3519 FilePreview.Hint := sFRDesignerFormPreview;
3520
3521 edtUndo.Caption := sFRDesignerForm_Undo;
3522 edtUndo.Hint := sFRDesignerFormUndo;
3523 edtRedo.Caption := sFRDesignerForm_Redo;
3524 edtRedo.Hint := sFRDesignerFormRedo;
3525
3526 CutB.Hint := sFRDesignerFormCut;
3527 CopyB.Hint := sFRDesignerFormCopy;
3528 PstB.Hint := sFRDesignerFormPast;
3529 ZB1.Hint := sFRDesignerFormBring;
3530 ZB2.Hint := sFRDesignerFormBack;
3531 SelAllB.Hint := sFRDesignerFormSelectAll;
3532 PgB1.Hint := sFRDesignerFormAddPg;
3533 PgB2.Hint := sFRDesignerFormRemovePg;
3534 PgB3.Hint := sFRDesignerFormPgOption;
3535 GB1.Hint := sFRDesignerFormGrid;
3536 GB2.Hint := sFRDesignerFormGridAlign;
3537 GB3.Hint := sFRDesignerFormFitGrid;
3538 HelpBtn.Hint := sPreviewFormHelp;
3539 ExitB.Caption := sFRDesignerFormClose;
3540 ExitB.Hint := sFRDesignerFormCloseDesigner;
3541 AlB1.Hint := sFRDesignerFormLeftAlign;
3542 AlB2.Hint := sFRDesignerFormRightAlign;
3543 AlB3.Hint := sFRDesignerFormCenerAlign;
3544 AlB4.Hint := sFRDesignerFormNormalText;
3545 AlB5.Hint := sFRDesignerFormVertCenter;
3546 AlB6.Hint := sFRDesignerFormTopAlign;
3547 AlB7.Hint := sFRDesignerFormBottomAlign;
3548 AlB8.Hint := sFRDesignerFormWidthAlign;
3549 FnB1.Hint := sFRDesignerFormBold;
3550 FnB2.Hint := sFRDesignerFormItalic;
3551 FnB3.Hint := sFRDesignerFormUnderLine;
3552 ClB2.Hint := sFRDesignerFormFont;
3553 HlB1.Hint := sFRDesignerFormHightLight;
3554 C3.Hint := sFRDesignerFormFontSize;
3555 C2.Hint := sFRDesignerFormFontName;
3556 FrB1.Hint := sFRDesignerFormTopFrame;
3557 FrB2.Hint := sFRDesignerFormleftFrame;
3558 FrB3.Hint := sFRDesignerFormBottomFrame;
3559 FrB4.Hint := sFRDesignerFormRightFrame;
3560 FrB5.Hint := sFRDesignerFormAllFrame;
3561 FrB6.Hint := sFRDesignerFormNoFrame;
3562 ClB1.Hint := sFRDesignerFormBackColor;
3563 ClB3.Hint := sFRDesignerFormFrameColor;
3564 E1.Hint := sFRDesignerFormFrameWidth;
3565 OB1.Hint := sFRDesignerFormSelObj;
3566 OB2.Hint := sFRDesignerFormInsRect;
3567 OB3.Hint := sFRDesignerFormInsBand;
3568 OB4.Hint := sFRDesignerFormInsPict;
3569 OB5.Hint := sFRDesignerFormInsSub;
3570 OB6.Hint := sFRDesignerFormDrawLine;
3571 Align1.Hint := sFRDesignerFormAlignLeftedge;
3572 Align2.Hint := sFRDesignerFormAlignHorzCenter;
3573 Align3.Hint := sFRDesignerFormCenterHWind;
3574 Align4.Hint := sFRDesignerFormSpace;
3575 Align5.Hint := sFRDesignerFormAlignRightEdge;
3576 Align6.Hint := sFRDesignerFormAligneTop;
3577 Align7.Hint := sFRDesignerFormAlignVertCenter;
3578 Align8.Hint := sFRDesignerFormCenterVertWing;
3579 Align9.Hint := sFRDesignerFormSpaceEqVert;
3580 Align10.Hint := sFRDesignerFormAlignBottoms;
3581 N2.Caption := sFRDesignerForm_Cut;
3582 N1.Caption := sFRDesignerForm_Copy;
3583 N3.Caption := sFRDesignerForm_Paste;
3584 N5.Caption := sFRDesignerForm_Delete;
3585 N16.Caption := sFRDesignerForm_SelectAll;
3586 N6.Caption := sFRDesignerForm_Edit;
3587 FileMenu.Caption := sFRDesignerForm_File;
3588 N23.Caption := sFRDesignerForm_New;
3589 //N19.Caption := sFRDesignerForm_Open;
3590 //N20.Caption := sFRDesignerForm_Save;
3591 //N17.Caption := sFRDesignerForm_SaveAs;
3592 FileSave.Caption:= sFRDesignerForm_Save;
3593 FileSaveAs.Caption:= sFRDesignerForm_SaveAs;
3594 FileBeforePrintScript.Caption := sFRDesignerForm_BeforePrintScript;
3595 N42.Caption := sFRDesignerForm_Var;
3596 N8.Caption := sFRDesignerForm_RptOpt;
3597 N25.Caption := sFRDesignerForm_PgOpt;
3598 N39.Caption := sFRDesignerForm_preview;
3599 N10.Caption := sFRDesignerForm_Exit;
3600 EditMenu.Caption := sFRDesignerForm_Edit2;
3601 N11.Caption := sFRDesignerForm_Cut;
3602 N12.Caption := sFRDesignerForm_Copy;
3603 N13.Caption := sFRDesignerForm_Paste;
3604 N27.Caption := sFRDesignerForm_Delete;
3605 N28.Caption := sFRDesignerForm_SelectAll;
3606 N36.Caption := sFRDesignerForm_Editp;
3607 N29.Caption := sFRDesignerForm_AddPg;
3608 N30.Caption := sFRDesignerForm_RemovePg;
3609 N32.Caption := sFRDesignerForm_Bring;
3610 N33.Caption := sFRDesignerForm_Back;
3611 ToolMenu.Caption := sFRDesignerForm_Tools;
3612 N37.Caption := sFRDesignerForm_ToolBars;
3613 MastMenu.Caption := sFRDesignerForm_Tools2;
3614 N14.Caption := sFRDesignerForm_Opts;
3615 Pan1.Caption := sFRDesignerForm_Rect;
3616 Pan2.Caption := sFRDesignerForm_Std;
3617 Pan3.Caption := sFRDesignerForm_Text;
3618 Pan4.Caption := sFRDesignerForm_Obj;
3619 Pan5.Caption := sFRDesignerForm_Insp;
3620 Pan6.Caption := sFRDesignerForm_AlignPalette;
3621 Pan7.Caption := sFRDesignerForm_Tools3;
3622 MenuItem2.Caption:= sFRDesignerForm_DataInsp;
3623 N34.Caption := sFRDesignerForm_About;
3624 N22.Caption := sFRDesignerForm_Help1;
3625 N35.Caption := sFRDesignerForm_Help2;
3626 StB1.Hint := sFRDesignerForm_Line;
3627 //** FnB1.Glyph.Handle := LoadBitmap(hInstance, 'FR_BOLD');
3628 //** FnB2.Glyph.Handle := LoadBitmap(hInstance, 'FR_ITALIC');
3629 //** FnB3.Glyph.Handle := LoadBitmap(hInstance, 'FR_UNDRLINE');
3630
3631 N41.Caption := N29.Caption;
3632 N41.OnClick := N29.OnClick;
3633 N43.Caption := N30.Caption;
3634 N43.OnClick := N30.OnClick;
3635 N44.Caption := N25.Caption;
3636 N44.OnClick := N25.OnClick;
3637 end;
3638
3639 procedure TfrDesignerForm.C2GetItems(Sender: TObject);
3640 var
3641 i: Integer;
3642 begin
3643 if C2.Items.Count=0 then begin
3644 Screen.Cursor := crHourglass;
3645 GetFontList;
3646 i := C2.Items.IndexOf(LastFontName);
3647 if i<>-1 then
3648 C2.ItemIndex := i;
3649 Screen.Cursor := crDefault;
3650 end;
3651 end;
3652
3653 procedure TfrDesignerForm.edtRedoExecute(Sender: TObject);
3654 begin
3655 Undo(@FRedoBuffer);
3656 end;
3657
3658 procedure TfrDesignerForm.edtUndoExecute(Sender: TObject);
3659 begin
3660 Undo(@FUndoBuffer);
3661 end;
3662
3663 procedure TfrDesignerForm.FileBeforePrintScriptExecute(Sender: TObject);
3664 begin
3665 //EditorForm.View := nil;
3666 EditorForm.M2.Lines.Assign(CurReport.Script);
3667 EditorForm.MemoPanel.Visible:=false;
3668 EditorForm.CB1.OnClick:=nil;
3669 EditorForm.CB1.Checked:=true;
3670 EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
3671 EditorForm.ScriptPanel.Align:=alClient;
3672 if EditorForm.ShowEditor(nil) = mrOk then
3673 begin
3674 CurReport.Script.Assign(EditorForm.M2.Lines);
3675 end;
3676 EditorForm.ScriptPanel.Align:=alBottom;
3677 EditorForm.MemoPanel.Visible:=true;
3678 end;
3679
3680 procedure TfrDesignerForm.FileOpenExecute(Sender: TObject);
3681 var
3682 FRepName:string;
3683 begin
3684 if CheckFileModified=mrCancel then
3685 exit;
3686
3687
3688 if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnLoadReport) then
3689 begin
3690 FRepName:='';
3691 frDesignerComp.FOnLoadReport(CurReport, FRepName);
3692 FCurDocFileType := dtLazReportForm;
3693 CurDocName := FRepName;
3694 end
3695 else
3696 with OpenDialog1 do
3697 begin
3698 Filter := sFormFile + ' (*.frf)|*.frf|' +
3699 sLazFormFile + ' (*.lrf)|*.lrf' +
3700 '';
3701 if InitialDir='' then
3702 begin
3703 InitialDir := FLastOpenDirectory;
3704 if InitialDir='' then
3705 InitialDir := FLastSaveDirectory;
3706 if InitialDir='' then
3707 InitialDir:=ExtractFilePath(ParamStrUTF8(0));
3708 end;
3709
3710 FileName := CurDocName;
3711 FilterIndex := 2;
3712 if Execute then
3713 begin
3714 ClearUndoBuffer;
3715 CurDocName := OpenDialog1.FileName;
3716 case FilterIndex of
3717 1: // fastreport form format
3718 begin
3719 FLastOpenDirectory := ExtractFilePath(CurDocName);
3720 CurReport.LoadFromFile(CurDocName);
3721 FCurDocFileType := dtFastReportForm;
3722 end;
3723 2: // lasreport form xml format
3724 begin
3725 FLastOpenDirectory := ExtractFilePath(CurDocName);
3726 CurReport.LoadFromXMLFile(CurDocName);
3727 FCurDocFileType := dtLazReportForm;
3728 end;
3729 else
3730 raise Exception.Create('Unrecognized file format');
3731 end;
3732 //FileModified := False;
3733 Modified := False;
3734 CurPage := 0; // do all
3735 end;
3736 end;
3737 end;
3738
3739 procedure TfrDesignerForm.FilePreviewExecute(Sender: TObject); // preview
3740 var
3741 TestRepStream:TMemoryStream;
3742 Rep, SaveR:TfrReport;
3743 FSaveGetPValue: TGetPValueEvent;
3744 FSaveFunEvent: TFunctionEvent;
3745
3746 procedure DoClearFormsName;
3747 var
3748 i:integer;
3749 begin
3750 for i:=0 to CurReport.Pages.Count - 1 do
3751 if CurReport.Pages[i] is TfrPageDialog then
3752 TfrPageDialog(CurReport.Pages[i]).Form.Name:='';
3753 end;
3754
3755 procedure DoResoreFormsName;
3756 var
3757 i:integer;
3758 begin
3759 for i:=0 to CurReport.Pages.Count - 1 do
3760 if CurReport.Pages[i] is TfrPageDialog then
3761 TfrPageDialog(CurReport.Pages[i]).Form.Name:=TfrPageDialog(CurReport.Pages[i]).Name;
3762 end;
3763 begin
3764 if CurReport is TfrCompositeReport then Exit;
3765 Application.ProcessMessages;
3766 SaveR:=CurReport;
3767 TestRepStream:=TMemoryStream.Create;
3768 CurReport.SaveToXMLStream(TestRepStream);
3769 TestRepStream.Position:=0;
3770
3771 // DoClearFormsName;
3772 CurReport:=nil;
3773
3774 FSaveGetPValue:=frParser.OnGetValue;
3775 FSaveFunEvent:=frParser.OnFunction;
3776
Repnull3777 Rep:=TfrReport.Create(SaveR.Owner);
3778
3779 Rep.OnBeginBand:=SaveR.OnBeginBand;
3780 Rep.OnBeginColumn:=SaveR.OnBeginColumn;
3781 Rep.OnBeginDoc:=SaveR.OnBeginDoc;
3782 Rep.OnBeginPage:=SaveR.OnBeginPage;
3783 Rep.OnDBImageRead:=SaveR.OnDBImageRead;
3784 Rep.OnEndBand:=SaveR.OnEndBand;
3785 Rep.OnEndDoc:=SaveR.OnEndDoc;
3786 Rep.OnEndPage:=SaveR.OnEndPage;
3787 Rep.OnEnterRect:=SaveR.OnEnterRect;
3788 Rep.OnExportFilterSetup:=SaveR.OnExportFilterSetup;
3789 Rep.OnGetValue:=SaveR.OnGetValue;
3790 Rep.OnManualBuild:=SaveR.OnManualBuild;
3791 Rep.OnMouseOverObject:=SaveR.OnMouseOverObject;
3792 Rep.OnObjectClick:=SaveR.OnObjectClick;
3793 Rep.OnPrintColumn:=SaveR.OnPrintColumn;
3794 Rep.OnProgress:=SaveR.OnProgress;
3795 Rep.OnUserFunction:=SaveR.OnUserFunction;
3796
3797 try
3798 Rep.LoadFromXMLStream(TestRepStream);
3799 Rep.FileName:=SaveR.FileName;
3800 Rep.ShowReport;
3801 FreeAndNil(Rep)
3802 except
3803 on E:Exception do
3804 begin
3805 ShowMessage(E.Message);
3806 if Assigned(Rep) then
3807 FreeAndNil(Rep)
3808 end;
3809 end;
3810 TestRepStream.Free;
3811 CurReport:=SaveR;
3812 CurPage := 0;
3813 frParser.OnGetValue := FSaveGetPValue;
3814 frParser.OnFunction := FSaveFunEvent;
3815 // DoResoreFormsName;
3816 end;
3817
3818 procedure TfrDesignerForm.FileSaveAsExecute(Sender: TObject);
3819 var
3820 s: String;
3821 begin
3822 WasOk := False;
3823 if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnSaveReport) then
3824 begin
3825 S:='';
3826 frDesignerComp.FOnSaveReport(CurReport, S, true, WasOk);
3827 if WasOk then
3828 begin
3829 CurDocName:=S;
3830 Modified:=false;
3831 end;
3832 end
3833 else
3834 begin
3835 with SaveDialog1 do
3836 begin
3837 Filter := sFormFile + ' (*.frf)|*.frf|' +
3838 sTemplFile + ' (*.frt)|*.frt|' +
3839 sLazFormFile + ' (*.lrf)|*.lrf|' +
3840 sLazTemplateFile + ' (*.lrt)|*.lrt';
3841
3842 if InitialDir='' then
3843 begin
3844 InitialDir := FLastSaveDirectory;
3845 if InitialDir='' then
3846 InitialDir := FLastOpenDirectory;
3847 if InitialDir='' then
3848 InitialDir:=ExtractFilePath(ParamStrUTF8(0));
3849 end;
3850 FileName := CurDocName;
3851 FilterIndex := 3;
3852 if Execute then
3853 begin
3854 FLastSaveDirectory := ExtractFilePath(Filename);
3855 FCurDocFileType := FilterIndex;
3856 end;
3857 case FCurDocFileType of
3858 dtFastReportForm:
3859 begin
3860 s := ChangeFileExt(FileName, '.frf');
3861 CurReport.SaveToFile(s);
3862 CurDocName := s;
3863 WasOk := True;
3864 end;
3865 dtFastReportTemplate,
3866 dtLazReportTemplate:
3867 begin
3868 if FCurDocFileType = dtLazReportTemplate then
3869 s := ExtractFileName(ChangeFileExt(FileName, '.lrt'))
3870 else
3871 s := ExtractFileName(ChangeFileExt(FileName, '.frt'));
3872 if frTemplateDir <> '' then
3873 s := AppendPathDelim(frTemplateDir) + s;
3874 frTemplNewForm := TfrTemplNewForm.Create(nil);
3875 if frTemplNewForm.ShowModal = mrOk then
3876 begin
3877 if frTemplateDir<>'' then
3878 begin
3879 if not DirectoryExistsUTF8(frTemplateDir) then begin
3880 if not ForceDirectoriesUTF8(frTemplateDir) then begin
3881 ShowMessage(sFrDesignerFormUnableToCreateTemplateDir);
3882 exit;
3883 end;
3884 end;
3885 end;
3886 if FCurDocFileType = dtLazReportTemplate then
3887 CurReport.SaveTemplateXML(s, frTemplNewForm.Memo1.Lines, frTemplNewForm.Image1.Picture.Bitmap)
3888 else
3889 CurReport.SaveTemplate(s, frTemplNewForm.Memo1.Lines, frTemplNewForm.Image1.Picture.Bitmap);
3890 WasOk := True;
3891 end;
3892 frTemplNewForm.Free;
3893 end;
3894 dtLazReportForm: // lasreport form xml format
3895 begin
3896 s := ChangeFileExt(FileName, '.lrf');
3897 CurReport.SaveToXMLFile(s);
3898 CurDocName := s;
3899 WasOk := True;
3900 end;
3901 end;
3902 end;
3903 end;
3904 end;
3905
3906 procedure TfrDesignerForm.FileSaveExecute(Sender: TObject);
3907 var
3908 S:string;
3909 F:boolean;
3910 begin
3911 if CurDocName <> sUntitled then
3912 begin
3913 if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnSaveReport) then
3914 begin
3915 S:=CurDocName;
3916 F:=false;
3917 frDesignerComp.FOnSaveReport(CurReport, S, false, F);
3918 if F then
3919 begin
3920 CurDocName:=S;
3921 Modified := False;
3922 end;
3923 end
3924 else
3925 begin
3926 if FCurDocFileType=dtLazReportForm then
3927 CurReport.SaveToXMLFile(curDocName)
3928 else
3929 CurReport.SaveToFile(CurDocName);
3930 Modified := False;
3931 end;
3932 end
3933 else
3934 FileSaveAs.Execute;
3935 end;
3936
3937 procedure TfrDesignerForm.acDuplicateExecute(Sender: TObject);
3938 begin
3939 DuplicateSelection;
3940 end;
3941
3942 procedure TfrDesignerForm.acToggleFramesExecute(Sender: TObject);
3943 begin
3944 if DelEnabled then
3945 ViewsAction(nil, @ToggleFrames, -1);
3946 end;
3947
3948 procedure TfrDesignerForm.btnGuidesClick(Sender: TObject);
3949 begin
3950 ShowGuides := btnGuides.Down;
3951 end;
3952
3953 procedure TfrDesignerForm.FormShow(Sender: TObject);
3954 var
3955 CursorImage: TCursorImage;
3956 begin
3957 CursorImage := TCursorImage.Create;
3958 try
3959 CursorImage.LoadFromResourceName(hInstance, 'FR_PENCIL');
3960 Screen.Cursors[crPencil] := CursorImage.ReleaseHandle;
3961 finally
3962 CursorImage.Free;
3963 end;
3964 {$ifndef sbod}
3965 Panel7.Hide;
3966 {$endif}
3967 if FirstTime then
3968 SetMenuBitmaps;
3969 FirstTime := False;
3970 // FileBtn1.Enabled := FirstInstance;
3971 FilePreview.Enabled := {FirstInstance and }not (CurReport is TfrCompositeReport);
3972 { N23.Enabled := FirstInstance;
3973 OB3.Enabled := FirstInstance;
3974 OB5.Enabled := FirstInstance;}
3975
3976 ClearUndoBuffer;
3977 ClearRedoBuffer;
3978 Modified := False;
3979 //FileModified := False;
3980 Busy := True;
3981 DocMode := dmDesigning;
3982
3983 if C2.Items.Count=0 then
3984 GetFontList;
3985
3986 LastFontSize := 10;
3987 {$IFDEF MSWINDOWS}
3988 LastFontName := 'Arial';
3989 {$ELSE}
3990 LastFontName := 'helvetica [urw]';
3991 {$ENDIF}
3992
3993 //** C2.Perform(CB_SETDROPPEDWIDTH, 170, 0);
3994 CurPage := 0; // this cause page sizing
3995 CurDocName := CurReport.FileName;
3996 Unselect;
3997
3998 PageView.Init;
3999 EnableControls;
4000
4001 BDown(OB1);
4002
4003 ColorLocked:=True;
4004 frSetGlyph(clNone, ClB1, 1);
4005 frSetGlyph(clNone, ClB2, 0);
4006 frSetGlyph(clNone, ClB3, 2);
4007 ColorLocked:=False;
4008
4009 ColorSelector.Hide;
4010
4011 LinePanel.Hide;
4012
4013 ShowPosition;
4014 RestoreState;
4015 FormResize(nil);
4016 end;
4017
4018 procedure TfrDesignerForm.FormHide(Sender: TObject);
4019 begin
4020 ClearUndoBuffer;
4021 ClearRedoBuffer;
4022 SaveState;
4023
4024 if CurReport<>nil then
4025 CurReport.FileName := CurDocName;
4026 end;
4027
4028 procedure TfrDesignerForm.FormDestroy(Sender: TObject);
4029 var
4030 i: Integer;
4031 begin
4032 for i := 0 to MenuItems.Count - 1 do
4033 TfrMenuItemInfo(MenuItems[i]).Free;
4034 MenuItems.Free;
4035 ItemWidths.Free;
4036 PageView.Free;
4037 ColorSelector.Free;
4038 EditorForm.Free;
4039 end;
4040
4041 procedure TfrDesignerForm.FormResize(Sender: TObject);
4042 begin
4043 if csDestroying in ComponentState then Exit;
4044
4045 //{$IFDEF WIN32}
4046 //if FirstTime then
4047 // self.OnShow(self);
4048 //{$ENDIF}
4049
4050 with ScrollBox1 do
4051 begin
4052 HorzScrollBar.Position := 0;
4053 VertScrollBar.Position := 0;
4054 end;
4055 if PageView<>nil then
4056 PageView.SetPage;
4057 StatusBar1.Top:=Height-StatusBar1.Height-3;
4058 {$ifndef sbod}
4059 Panel7.Top := StatusBar1.Top + 3;
4060 Panel7.Show;
4061 {$endif}
4062 UpdScrollbars;
4063 end;
4064
4065 //**
4066 {
4067 procedure TfrDesignerForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
4068 begin // for best view - not actual in Win98 :(
4069 with Msg.MinMaxInfo^ do
4070 begin
4071 ptMaxSize.x := Screen.Width;
4072 ptMaxSize.y := Screen.Height;
4073 ptMaxPosition.x := 0;
4074 ptMaxPosition.y := 0;
4075 end;
4076 end;
4077 }
4078 procedure TfrDesignerForm.SetCurPage(Value: Integer);
4079 begin // setting curpage and do all manipulation
4080 fInBuildPage:=True;
4081 try
4082 FCurPage := Value;
4083 Page := CurReport.Pages[CurPage];
4084 ScrollBox1.VertScrollBar.Position := 0;
4085 ScrollBox1.HorzScrollBar.Position := 0;
4086 PageView.SetPage;
4087 SetPageTitles;
4088 Tab1.TabIndex := Value;
4089 ResetSelection;
4090 SendBandsToDown;
4091 PageView.Invalidate;
4092 UpdScrollbars;
4093 finally
4094 fInBuildPage:=False;
4095 end;
4096 end;
4097
4098 procedure TfrDesignerForm.SetGridSize(Value: Integer);
4099 begin
4100 if FGridSize = Value then Exit;
4101 FGridSize := Value;
4102 PageView.Invalidate;
4103 end;
4104
4105 procedure TfrDesignerForm.SetGridShow(Value: Boolean);
4106 begin
4107 if FGridShow = Value then Exit;
4108 FGridShow:= Value;
4109 GB1.Down := Value;
4110 PageView.Invalidate;
4111 end;
4112
4113 procedure TfrDesignerForm.SetGridAlign(Value: Boolean);
4114 begin
4115 if FGridAlign = Value then Exit;
4116 GB2.Down := Value;
4117 FGridAlign := Value;
4118 end;
4119
4120 procedure TfrDesignerForm.SetGuidesShow(AValue: boolean);
4121 begin
4122 if FGuidesShow = AValue then Exit;
4123 FGuidesShow := AValue;
4124 btnGuides.Down := AValue;
4125 PageView.CheckGuides;
4126 end;
4127
4128 procedure TfrDesignerForm.SetUnits(Value: TfrReportUnits);
4129 var
4130 s: String;
4131 begin
4132 FUnits := Value;
4133 case Value of
4134 ruPixels: s := sPixels;
4135 ruMM: s := sMM;
4136 ruInches: s := sInches;
4137 end;
4138 StatusBar1.Panels[0].Text := s;
4139 ShowPosition;
4140 end;
4141
4142 procedure TfrDesignerForm.SetGrayedButtons(Value: Boolean);
4143 procedure DoButtons(t: Array of TControl);
4144 var
4145 i, j: Integer;
4146 c: TWinControl;
4147 c1: TControl;
4148 begin
4149 for i := Low(t) to High(t) do
4150 begin
4151 c := TWinControl(t[i]);
4152 for j := 0 to c.ControlCount - 1 do
4153 begin
4154 c1 := c.Controls[j];
4155 if c1 is TSpeedButton then
4156 TSpeedButton(c1).Enabled := FGrayedButtons; //** GrayedInactive := FGrayedButtons;
4157 end;
4158 end;
4159 end;
4160 begin
4161 FGrayedButtons := Value;
4162 DoButtons([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
4163 end;
4164
4165 procedure TfrDesignerForm.SetCurDocName(Value: String);
4166 begin
4167 FCurDocName := Value;
4168 // if FirstInstance then
4169 Caption := FCaption + ' - ' + ExtractFileName(Value)
4170 // else
4171 // Caption := FCaption;
4172 end;
4173
4174 procedure TfrDesignerForm.RegisterObject(ButtonBmp: TBitmap;
4175 const ButtonHint: String; ButtonTag: Integer; ObjectType: TfrObjectType);
4176 var
4177 b: TSpeedButton;
4178 begin
4179 b := TSpeedButton.Create(Self);
4180 with b do
4181 begin
4182 Glyph := ButtonBmp;
4183 Hint := ButtonHint;
4184 Flat := True;
4185 GroupIndex := 1;
4186 Align:=alTop;
4187 SetBounds(1000, 1000, 22, 22);
4188 Visible:=True;
4189 Tag := ButtonTag;
4190 if ObjectType = otlReportView then
4191 begin
4192 OnMouseDown := @OB2MouseDown;
4193 Parent := Panel4;
4194 end
4195 else
4196 begin
4197 OnMouseDown := @OB2MouseDown;
4198 Parent := panForDlg;
4199 end;
4200 end;
4201 end;
4202
4203 procedure TfrDesignerForm.RegisterTool(const MenuCaption: String; ButtonBmp: TBitmap;
4204 OnClickEvnt: TNotifyEvent);
4205 var
4206 m: TMenuItem;
4207 b: TSpeedButton;
4208 w:integer;
4209 i: Integer;
4210 begin
4211 m := TMenuItem.Create(MastMenu);
4212 m.Caption := MenuCaption;
4213 m.OnClick := OnClickEvnt;
4214 MastMenu.Enabled := True;
4215 MastMenu.Add(m);
4216 M.Bitmap.Assign(ButtonBmp);
4217 Panel6.Height := 26;
4218 Panel6.Width := 26;
4219
4220 W:=0;
4221 for i:=0 to Panel6.ControlCount-1 do
4222 if Panel6.Controls[i] is TSpeedButton then
4223 begin
4224 W:=W + Panel6.Controls[i].Width;
4225 end;
4226
4227 b := TSpeedButton.Create(Self);
4228
4229 with b do
4230 begin
4231 Parent := Panel6;
4232 Glyph := ButtonBmp;
4233 Hint := MenuCaption;
4234 Flat := True;
4235 Align:=alLeft;
4236 // Align:=alTop;
4237 SetBounds(W, 1, 22, 22);
4238 Visible:=True;
4239 ShowHint:=True;
4240 Tag := 36;
4241 end;
4242 b.OnClick := OnClickEvnt;
4243
4244 if Panel6.Width < (B.Left + B.Width) then
4245 Panel6.Width:=W + B.Width + 4;
4246 end;
4247
4248 procedure TfrDesignerForm.AddPage(ClName : string);
4249 begin
4250 fInBuildPage:=True;
4251 try
4252 CurReport.Pages.Add(ClName);
4253
4254 Page := CurReport.Pages[CurReport.Pages.Count - 1];
4255 if Page is TfrPageReport then
4256 PgB3Click(nil)
4257 else
4258 WasOk:=True;
4259
4260 if WasOk then
4261 begin
4262 Modified := True;
4263 CurPage := CurReport.Pages.Count - 1
4264 end
4265 else
4266 begin
4267 CurReport.Pages.Delete(CurReport.Pages.Count - 1);
4268 CurPage := CurPage;
4269 end;
4270 finally
4271 fInBuildPage:=False;
4272 end;
4273 end;
4274
4275 procedure TfrDesignerForm.RemovePage(n: Integer);
4276
4277 procedure AdjustSubReports(APage:TfrPage);
4278 var
4279 i, j: Integer;
4280 t: TfrView;
4281 begin
4282 for i := 0 to CurReport.Pages.Count - 1 do
4283 begin
4284 j := 0;
4285 while j < CurReport.Pages[i].Objects.Count do
4286 begin
4287 t := TfrView(CurReport.Pages[i].Objects[j]);
4288 if (T is TfrSubReportView) and (TfrSubReportView(t).SubPage = APage) then
4289 begin
4290 CurReport.Pages[i].Delete(j);
4291 Dec(j);
4292 end;
4293 Inc(j);
4294 end;
4295 end;
4296 end;
4297
4298 begin
4299 fInBuildPage:=True;
4300 try
4301 Modified := True;
4302 with CurReport do
4303 begin
4304 if (n >= 0) and (n < Pages.Count) then
4305 if Pages.Count = 1 then
4306 Pages[n].Clear
4307 else
4308 begin
4309 AdjustSubReports(Pages[n]);
4310 CurReport.Pages.Delete(n);
4311 Tab1.Tabs.Delete(n);
4312 Tab1.TabIndex := 0;
4313 CurPage := 0;
4314 end;
4315 end;
4316 ClearUndoBuffer;
4317 ClearRedoBuffer;
4318 finally
4319 fInBuildPage:=False;
4320 end;
4321 end;
4322
4323 procedure TfrDesignerForm.SetPageTitles;
4324 var
4325 i: Integer;
4326 s: String;
4327
IsSubreportnull4328 function IsSubreport(PageN: Integer): Boolean;
4329 var
4330 i, j: Integer;
4331 t: TfrView;
4332 begin
4333 Result := False;
4334 for i := 0 to CurReport.Pages.Count - 1 do
4335 for j := 0 to CurReport.Pages[i].Objects.Count - 1 do
4336 begin
4337 t := TfrView(CurReport.Pages[i].Objects[j]);
4338 if (T is TfrSubReportView) and (TfrSubReportView(t).SubPage = CurReport.Pages[PageN]) then
4339 begin
4340 s := t.Name;
4341 Result := True;
4342 Exit;
4343 end;
4344 end;
4345 end;
4346
4347 begin
4348 if Tab1.Tabs.Count = CurReport.Pages.Count then
4349 begin
4350 for i := 0 to Tab1.Tabs.Count - 1 do
4351 begin
4352 if not IsSubreport(i) then
4353 s := sPg + IntToStr(i + 1);
4354 if Tab1.Tabs[i] <> s then
4355 Tab1.Tabs[i] := s;
4356 end;
4357 end
4358 else
4359 begin
4360 Tab1.Tabs.Clear;
4361 for i := 0 to CurReport.Pages.Count - 1 do
4362 begin
4363 if not IsSubreport(i) then
4364 s := sPg + IntToStr(i + 1);
4365 Tab1.Tabs.Add(s);
4366 end;
4367 end;
4368 end;
4369
4370 procedure TfrDesignerForm.CutToClipboard;
4371 var
4372 i: Integer;
4373 T: TfrView;
4374 begin
4375 ClearClipBoard;
4376 for i := 0 to Objects.Count - 1 do
4377 begin
4378 t := TfrView(Objects[i]);
4379 if (t.Selected) and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
4380 begin
4381 // ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page));
4382 ClipBd.Add(frCreateObject(t.Typ, t.ClassName, nil));
4383 TfrView(ClipBd.Last).Assign(t);
4384 end;
4385 end;
4386 for i := Objects.Count - 1 downto 0 do
4387 begin
4388 t := TfrView(Objects[i]);
4389 if t.Selected and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
4390 Page.Delete(i);
4391 end;
4392 SelNum := 0;
4393 PageView.Invalidate;
4394 end;
4395
4396 procedure TfrDesignerForm.CopyToClipboard;
4397 var
4398 i: Integer;
4399 t: TfrView;
4400 begin
4401 ClearClipBoard;
4402 for i := 0 to Objects.Count - 1 do
4403 begin
4404 t := TfrView(Objects[i]);
4405 if t.Selected and not (doChildComponent in T.DesignOptions) then
4406 begin
4407 ClipBd.Add(frCreateObject(t.Typ, t.ClassName, nil));
4408 TfrView(ClipBd.Last).Assign(t);
4409 end;
4410 end;
4411 end;
4412
4413 procedure TfrDesignerForm.SelectAll;
4414 var
4415 i: Integer;
4416 begin
4417 SelNum := 0;
4418 for i := 0 to Objects.Count - 1 do
4419 begin
4420 TfrView(Objects[i]).Selected := True;
4421 Inc(SelNum);
4422 end;
4423 end;
4424
4425 procedure TfrDesignerForm.Unselect;
4426 var
4427 i: Integer;
4428 begin
4429 SelNum := 0;
4430 for i := 0 to Objects.Count - 1 do
4431 TfrView(Objects[i]).Selected := False;
4432 end;
4433
4434 procedure TfrDesignerForm.ResetSelection;
4435 begin
4436 Unselect;
4437 EnableControls;
4438 ShowPosition;
4439 end;
4440
PointsToUnitsnull4441 function TfrDesignerForm.PointsToUnits(x: Integer): Double;
4442 begin
4443 Result := x;
4444 case FUnits of
4445 ruMM: Result := x / 18 * 5;
4446 ruInches: Result := x / 18 * 5 / 25.4;
4447 end;
4448 end;
4449
TfrDesignerForm.UnitsToPointsnull4450 function TfrDesignerForm.UnitsToPoints(x: Double): Integer;
4451 begin
4452 Result := Round(x);
4453 case FUnits of
4454 ruMM: Result := Round(x / 5 * 18);
4455 ruInches: Result := Round(x * 25.4 / 5 * 18);
4456 end;
4457 end;
4458
4459 procedure TfrDesignerForm.RedrawPage;
4460 begin
4461 PageView.NPDrawLayerObjects(0);
4462 end;
4463
4464 procedure TfrDesignerForm.OnModify(sender: TObject);
4465 begin
4466 Modified:=true;
4467 SelectionChanged;
4468 end;
4469
4470 procedure TfrDesignerForm.FormKeyDown(Sender: TObject; var Key: Word;
4471 Shift: TShiftState);
4472 var
4473 StepX, StepY: Integer;
4474 i, tx, ty, tx1, ty1, d, d1: Integer;
4475 t, t1: TfrView;
4476
4477 procedure CheckStepFactor(var pStep: integer; aValue: integer);
4478 begin
4479 if (ssAlt in Shift) or (Shift = [ssShift,ssCtrl]) then
4480 pStep := aValue * 10
4481 else
4482 pStep := aValue;
4483 end;
4484
4485 procedure CheckPastePoint;
4486 var
4487 P: TPoint;
4488 begin
4489 P := PageView.ScreenToClient(Mouse.CursorPos);
4490 if PtInRect(PageView.ClientRect, p) then
4491 FReportPopupPoint := p;
4492 end;
4493
4494 begin
4495 {$IFNDEF EXTOI}
4496 if (ActiveControl<>nil) and (ActiveControl.Parent=ObjInsp.fPropertyGrid) then
4497 exit;
4498 {$ENDIF}
4499 StepX := 0; StepY := 0;
4500 if (Key=VK_F11) then
4501 ObjInsp.Visible:=not ObjInsp.Visible;
4502
4503 if (Key = VK_RETURN) and (ActiveControl = C3) then
4504 begin
4505 Key := 0;
4506 DoClick(C3);
4507 end;
4508 if (Key = VK_RETURN) and (ActiveControl = E1) then
4509 begin
4510 Key := 0;
4511 DoClick(E1);
4512 end;
4513 if (Key = VK_DELETE) and DelEnabled then
4514 begin
4515 DeleteObjects;
4516 Key := 0;
4517 end;
4518 if (Key = VK_RETURN) and EditEnabled then
4519 begin
4520 if ssCtrl in Shift then
4521 ShowMemoEditor
4522 else
4523 ShowEditor;
4524 end;
4525 if (Chr(Key) in ['1'..'9']) and (ssCtrl in Shift) and DelEnabled then
4526 begin
4527 E1.Text := Chr(Key);
4528 DoClick(E1);
4529 Key := 0;
4530 end;
4531 if (Chr(Key) = 'G') and (ssCtrl in Shift) then
4532 begin
4533 ShowGrid := not ShowGrid;
4534 Key := 0;
4535 end;
4536 if (Chr(Key) = 'B') and (ssCtrl in Shift) then
4537 begin
4538 GridAlign := not GridAlign;
4539 Key := 0;
4540 end;
4541 if (Chr(Key) = 'V') and (ssCtrl in Shift) and PasteEnabled then
4542 CheckPastePoint;
4543
4544 if CutEnabled then
4545 if (Key = VK_DELETE) and (ssShift in Shift) then CutBClick(Self);
4546 if CopyEnabled then
4547 if (Key = VK_INSERT) and (ssCtrl in Shift) then CopyBClick(Self);
4548 if PasteEnabled then
4549 if (Key = VK_INSERT) and (ssShift in Shift) then PstBClick(Self);
4550
4551 if Key = VK_PRIOR then
4552 with ScrollBox1.VertScrollBar do
4553 begin
4554 Position := Position - 200;
4555 Key := 0;
4556 end;
4557 if Key = VK_NEXT then
4558 with ScrollBox1.VertScrollBar do
4559 begin
4560 Position := Position + 200;
4561 Key := 0;
4562 end;
4563 if SelNum > 0 then
4564 begin
4565 if Key = vk_Up then CheckStepFactor(StepY, -1)
4566 else if Key = vk_Down then CheckStepFactor(StepY, 1)
4567 else if Key = vk_Left then CheckStepFactor(StepX, -1)
4568 else if Key = vk_Right then CheckStepFactor(StepX, 1);
4569 if (StepX <> 0) or (StepY <> 0) then
4570 begin
4571 if ssCtrl in Shift then
4572 MoveObjects(StepX, StepY, False)
4573 else if ssShift in Shift then
4574 MoveObjects(StepX, StepY, True)
4575 else if SelNum = 1 then
4576 begin
4577 t := TfrView(Objects[TopSelected]);
4578 tx := t.x; ty := t.y; tx1 := t.x + t.dx; ty1 := t.y + t.dy;
4579 d := 10000; t1 := nil;
4580 for i := 0 to Objects.Count-1 do
4581 begin
4582 t := TfrView(Objects[i]);
4583 if not t.Selected and (t.Typ <> gtBand) then
4584 begin
4585 d1 := 10000;
4586 if StepX <> 0 then
4587 begin
4588 if t.y + t.dy < ty then
4589 d1 := ty - (t.y + t.dy)
4590 else if t.y > ty1 then
4591 d1 := t.y - ty1
4592 else if (t.y <= ty) and (t.y + t.dy >= ty1) then
4593 d1 := 0
4594 else
4595 d1 := t.y - ty;
4596 if ((t.x <= tx) and (StepX = 1)) or
4597 ((t.x + t.dx >= tx1) and (StepX = -1)) then
4598 d1 := 10000;
4599 if StepX = 1 then
4600 if t.x >= tx1 then
4601 d1 := d1 + t.x - tx1 else
4602 d1 := d1 + t.x - tx
4603 else if t.x + t.dx <= tx then
4604 d1 := d1 + tx - (t.x + t.dx) else
4605 d1 := d1 + tx1 - (t.x + t.dx);
4606 end
4607 else if StepY <> 0 then
4608 begin
4609 if t.x + t.dx < tx then
4610 d1 := tx - (t.x + t.dx)
4611 else if t.x > tx1 then
4612 d1 := t.x - tx1
4613 else if (t.x <= tx) and (t.x + t.dx >= tx1) then
4614 d1 := 0
4615 else
4616 d1 := t.x - tx;
4617 if ((t.y <= ty) and (StepY = 1)) or
4618 ((t.y + t.dy >= ty1) and (StepY = -1)) then
4619 d1 := 10000;
4620 if StepY = 1 then
4621 if t.y >= ty1 then
4622 d1 := d1 + t.y - ty1 else
4623 d1 := d1 + t.y - ty
4624 else if t.y + t.dy <= ty then
4625 d1 := d1 + ty - (t.y + t.dy) else
4626 d1 := d1 + ty1 - (t.y + t.dy);
4627 end;
4628 if d1 < d then
4629 begin
4630 d := d1;
4631 t1 := t;
4632 end;
4633 end;
4634 end;
4635 if t1 <> nil then
4636 begin
4637 t := TfrView(Objects[TopSelected]);
4638 if not (ssAlt in Shift) then
4639 begin
4640 PageView.NPEraseSelection;
4641 Unselect;
4642 SelNum := 1;
4643 t1.Selected := True;
4644 PageView.NPDrawSelection;
4645 end
4646 else
4647 begin
4648 if (t1.x >= t.x + t.dx) and (Key = VK_RIGHT) then
4649 t.x := t1.x - t.dx
4650 else if (t1.y > t.y + t.dy) and (Key = VK_DOWN) then
4651 t.y := t1.y - t.dy
4652 else if (t1.x + t1.dx <= t.x) and (Key = VK_LEFT) then
4653 t.x := t1.x + t1.dx
4654 else if (t1.y + t1.dy <= t.y) and (Key = VK_UP) then
4655 t.y := t1.y + t1.dy;
4656 RedrawPage;
4657 end;
4658 SelectionChanged;
4659 end;
4660 end;
4661 Key := 0;
4662 end; // if (StepX <> 0) or (StepY <> 0)
4663 end; // if SelNum > 0 then
4664 end;
4665
4666 procedure TfrDesignerForm.MoveObjects(dx, dy: Integer; aResize: Boolean);
4667 begin
4668 AddUndoAction(acEdit);
4669 PageView.NPEraseSelection;
4670 PageView.MoveResize(Dx,Dy, false, aResize);
4671 ShowPosition;
4672 PageView.GetMultipleSelected;
4673 end;
4674
4675 procedure TfrDesignerForm.UpdateStatus;
4676 begin
4677 {$ifdef sbod}
4678 StatusBar1.Update;
4679 {$else}
4680 PBox1Paint(nil);
4681 {$endif}
4682 end;
4683
4684 procedure TfrDesignerForm.DeleteObjects;
4685 var
4686 i: Integer;
4687 t: TfrView;
4688 begin
4689 AddUndoAction(acDelete);
4690 PageView.NPEraseSelection;
4691 for i := Objects.Count - 1 downto 0 do
4692 begin
4693 t := TfrView(Objects[i]);
4694 if t.Selected and not (lrrDontDelete in T.Restrictions) then
4695 Page.Delete(i);
4696 end;
4697 SetPageTitles;
4698 ObjInsp.Select(nil);
4699 ResetSelection;
4700 FirstSelected := nil;
4701 PageView.Invalidate;
4702 end;
4703
SelStatusnull4704 function TfrDesignerForm.SelStatus: TfrSelectionStatus;
4705 var
4706 t: TfrView;
4707 begin
4708 Result := [];
4709 if SelNum = 1 then
4710 begin
4711 t := TfrView(Objects[TopSelected]);
4712 if t.Typ = gtBand then
4713 Result := [ssBand]
4714 else
4715 if t is TfrCustomMemoView then
4716 Result := [ssMemo]
4717 else
4718 Result := [ssOther];
4719 end
4720 else if SelNum > 1 then
4721 Result := [ssMultiple];
4722
4723 if ClipBd.Count > 0 then
4724 Result := Result + [ssClipboardFull];
4725 end;
4726
4727 procedure TfrDesignerForm.UpdScrollbars;
4728 begin
4729 ScrollBox1.Autoscroll := False;
4730 ScrollBox1.Autoscroll := True;
4731 ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
4732 end;
4733
4734 {$PUSH}
4735 {$HINTS OFF}
4736 {$ifdef sbod}
4737 procedure TfrDesignerForm.DrawStatusPanel(const ACanvas: TCanvas;
4738 const rect: TRect);
4739 var
4740 t: TfrView;
4741 s: String;
4742 nx, ny: Double;
4743 x, y, dx, dy: Integer;
4744 begin
4745 with ACanvas do
4746 begin
4747 Brush.Color := StatusBar1.Color;
4748 FillRect(Rect);
4749 ImageList1.Draw(ACanvas, Rect.Left + 2, Rect.Top+2, 0);
4750 ImageList1.Draw(ACanvas, Rect.Left + 92, Rect.Top+2, 1);
4751 if (SelNum = 1) or ShowSizes then
4752 begin
4753 t := nil;
4754 if ShowSizes then
4755 begin
4756 x := OldRect.Left;
4757 y := OldRect.Top;
4758 dx := OldRect.Right - x;
4759 dy := OldRect.Bottom - y;
4760 end
4761 else
4762 begin
4763 t := TfrView(Objects[TopSelected]);
4764 x := t.x;
4765 y := t.y;
4766 dx := t.dx;
4767 dy := t.dy;
4768 end;
4769
4770 if FUnits = ruPixels then
4771 s := IntToStr(x) + ';' + IntToStr(y)
4772 else
4773 s := FloatToStrF(PointsToUnits(x), ffFixed, 4, 2) + '; ' +
4774 FloatToStrF(PointsToUnits(y), ffFixed, 4, 2);
4775
4776 TextOut(Rect.Left + 20, Rect.Top + 1, s);
4777 if FUnits = ruPixels then
4778 s := IntToStr(dx) + ';' + IntToStr(dy)
4779 else
4780 s := FloatToStrF(PointsToUnits(dx), ffFixed, 4, 2) + '; ' +
4781 FloatToStrF(PointsToUnits(dy), ffFixed, 4, 2);
4782 TextOut(Rect.Left + 110, Rect.Top + 1, s);
4783
4784 if not ShowSizes and (t.Typ = gtPicture) then
4785 begin
4786 with t as TfrPictureView do
4787 begin
4788 if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
4789 begin
4790 s := IntToStr(dx * 100 div Picture.Width) + ',' +
4791 IntToStr(dy * 100 div Picture.Height);
4792 TextOut(Rect.Left + 170, Rect.Top + 1, '% ' + s);
4793 end;
4794 end;
4795 end;
4796 end
4797 else if (SelNum > 0) and MRFlag then
4798 begin
4799 nx := 0;
4800 ny := 0;
4801 if OldRect1.Right - OldRect1.Left <> 0 then
4802 nx := (OldRect.Right - OldRect.Left) / (OldRect1.Right - OldRect1.Left);
4803 if OldRect1.Bottom - OldRect1.Top <> 0 then
4804 ny := (OldRect.Bottom - OldRect.Top) / (OldRect1.Bottom - OldRect1.Top);
4805 s := IntToStr(Round(nx * 100)) + ',' + IntToStr(Round(ny * 100));
4806 TextOut(Rect.left + 170, Rect.Top + 1, '% ' + s);
4807 end;
4808 end;
4809 end;
4810
4811 procedure TfrDesignerForm.StatusBar1DrawPanel(StatusBar: TStatusBar;
4812 Panel: TStatusPanel; const Rect: TRect);
4813 begin
4814 if Panel.Index=1 then
4815 DrawStatusPanel(StatusBar.Canvas, Rect);
4816 end;
4817
4818 procedure TfrDesignerForm.DefineExtraPopupSelected(popup: TPopupMenu);
4819 var
4820 m: TMenuItem;
4821 begin
4822 m := TMenuItem.Create(Popup);
4823 m.Caption := '-';
4824 Popup.Items.Add(m);
4825
4826 m := TMenuItem.Create(Popup);
4827 m.Caption := sFRDesignerFormSelectSameClass;
4828 m.OnClick := @SelectSameClassClick;
4829 m.Tag := PtrInt(Objects[TopSelected]);
4830 Popup.Items.Add(m);
4831 end;
4832
4833 procedure TfrDesignerForm.SelectSameClassClick(Sender: TObject);
4834 var
4835 View: TfrView;
4836 begin
4837 if Sender is TMenuItem then
4838 begin
4839 View := TfrView(TMenuItem(Sender).Tag);
4840 if Objects.IndexOf(View)>=0 then
4841 begin
4842 PageView.NPEraseSelection;
4843 SelectSameClass(View);
4844 PageView.GetMultipleSelected;
4845 PageView.NPDrawSelection;
4846 SelectionChanged;
4847 end;
4848 end;
4849 end;
4850
4851 procedure TfrDesignerForm.SelectSameClass(View: TfrView);
4852 var
4853 i: Integer;
4854 v: TfrView;
4855 begin
4856 SelNum := 0;
4857 for i := 0 to Objects.Count - 1 do
4858 begin
4859 v := TfrView(Objects[i]);
4860 if v.ClassName=View.ClassName then
4861 begin
4862 v.Selected := True;
4863 Inc(SelNum);
4864 end;
4865 end;
4866 end;
4867
TfrDesignerForm.CheckFileModifiednull4868 function TfrDesignerForm.CheckFileModified: Integer;
4869 begin
4870 result := mrNo;
4871 // if FileModified then
4872 if Modified then
4873 begin
4874 result:=MessageDlg(sSaveChanges + ' ' + sTo + ' ' +
4875 ExtractFileName(CurDocName) + '?',mtConfirmation,
4876 [mbYes,mbNo,mbCancel],0);
4877
4878 if result = mrCancel then Exit;
4879 if result = mrYes then
4880 begin
4881 FileSave.Execute;
4882 // FileBtn3Click(nil);
4883 if not WasOk then
4884 result := mrCancel;
4885 end;
4886 end;
4887 end;
4888
4889 // if AList is specified always process the list being objects selected or not
4890 // if AList is not specified, all objects are processed but check Selected state
4891 procedure TfrDesignerForm.ViewsAction(Views: TFpList; TheAction: TViewAction;
4892 Data: PtrInt; OnlySel:boolean=true; WithUndoAction:boolean=true;
4893 WithRedraw:boolean=true);
4894 var
4895 i, n: Integer;
4896 List: TFpList;
4897 begin
4898 if not assigned(TheAction) then
4899 exit;
4900
4901 List := Views;
4902 if List=nil then
4903 List := Objects;
4904
4905 n := 0;
4906 for i:=List.Count-1 downto 0 do begin
4907 if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
4908 continue;
4909 inc(n);
4910 end;
4911
4912 if n=0 then
4913 exit;
4914
4915 if WithUndoAction then
4916 AddUndoAction(acEdit);
4917
4918 if WithRedraw then begin
4919 PageView.NPEraseSelection;
4920 GetRegion;
4921 end;
4922
4923 for i:=List.Count-1 downto 0 do begin
4924 if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
4925 continue;
4926 TheAction(TfrView(List[i]), Data);
4927 end;
4928
4929 if WithRedraw then
4930 PageView.NPDrawLayerObjects(ClipRgn, TopSelected);
4931 end;
4932
4933 // data=0 remove all borders
4934 // data=1 set all borders
4935 // data=-1 toggle all borders
4936 procedure TfrDesignerForm.ToggleFrames(View: TfrView; Data: PtrInt);
4937 begin
4938 if (Data=0) or ((Data=-1) and (View.Frames<>[])) then
4939 View.Frames := []
4940 else
4941 if (Data=1) or ((Data=-1) and (View.Frames=[])) then
4942 View.Frames := [frbLeft, frbTop, frbRight, frbBottom];
4943
4944 if SelNum=1 then
4945 LastFrames := View.Frames;
4946 end;
4947
4948 procedure TfrDesignerForm.DuplicateView(View: TfrView; Data: PtrInt);
4949 var
4950 t: TfrView;
4951 begin
4952 // check if view is unique instance band kind and if there is already one
4953 if (View is TfrBandView) and
4954 not (TfrBandView(View).BandType in [btMasterHeader..btSubDetailFooter,
4955 btGroupHeader, btGroupFooter])
4956 and frCheckBand(TfrBandView(View).BandType)
4957 then
4958 exit;
4959
4960 t := frCreateObject(View.Typ, View.ClassName, Page);
4961 TfrView(t).Assign(View);
4962 t.y := t.y + FDuplicateCount * FDupDeltaY;
4963 t.x := t.x + FDuplicateCount * FDupDeltaX;
4964 t.Selected := false;
4965
4966 if CurReport.FindObject(t.Name) <> nil then
4967 t.CreateUniqueName;
4968
4969 // Objects.Add(t);
4970 end;
4971
4972 procedure TfrDesignerForm.ResetDuplicateCount;
4973 begin
4974 FDuplicateCount := 0;
4975 FreeThenNil(FDuplicateList);
4976 end;
4977
lrDesignAcceptDragnull4978 function TfrDesignerForm.lrDesignAcceptDrag(const Source: TObject): TControl;
4979 begin
4980 if Source is TControl then
4981 Result:=Source as TControl
4982 else
4983 if Source is TDragControlObject then
4984 Result:=(Source as TDragControlObject).Control
4985 else
4986 Result:=nil;
4987 end;
4988
4989 procedure TfrDesignerForm.InplaceEditorMenuClick(Sender: TObject);
4990 var
4991 t: TfrView;
4992 begin
4993 t := TfrView(Objects[TopSelected]);
4994 if T is TfrMemoView then
4995 begin
4996 TfrMemoView(T).Memo.Text:='[' + (Sender as TMenuItem).Caption + ']';
4997 PageView.Invalidate;
4998 frDesigner.Modified:=true;
4999 end;
5000 end;
5001
5002 {$endif}
5003
5004 procedure TfrDesignerForm.TabsEditDragOver(Sender, Source: TObject; X,
5005 Y: Integer; State: TDragState; var Accept: Boolean);
5006 begin
5007 //Accept:=(Source = FTabsPage) and (FTabsPage.IndexOfPageAt(X, Y) <> Tab1.TabIndex);
5008 Accept:=(Source = Tab1) and (Tab1.IndexOfTabAt(X, Y) <> Tab1.TabIndex);
5009 end;
5010
5011 procedure TfrDesignerForm.TabsEditDragDrop(Sender, Source: TObject; X,
5012 Y: Integer);
5013 var
5014 NewIndex: Integer;
5015 begin
5016 //NewIndex:=FTabsPage.IndexOfPageAt(X, Y);
5017 NewIndex:=Tab1.IndexOfTabAt(X, Y);
5018 //ShowMessageFmt('New index = %d', [NewIndex]);
5019 if (NewIndex>-1) and (NewIndex < CurReport.Pages.Count) then
5020 begin
5021 CurReport.Pages.Move(CurPage, NewIndex);
5022 Tab1.Tabs.Move(CurPage, NewIndex);
5023 SetPageTitles;
5024
5025 ClearUndoBuffer;
5026 ClearRedoBuffer;
5027 Modified := True;
5028 Tab1.TabIndex:=NewIndex;
5029 RedrawPage;
5030 end;
5031 end;
5032
5033 procedure TfrDesignerForm.TabsEditMouseDown(Sender: TObject;
5034 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
5035 begin
5036 FTabMouseDown:=true;
5037 end;
5038
5039 procedure TfrDesignerForm.TabsEditMouseMove(Sender: TObject;
5040 Shift: TShiftState; X, Y: Integer);
5041 begin
5042 if FTabMouseDown then
5043 //FTabsPage.BeginDrag(false);
5044 Tab1.BeginDrag(false);
5045 end;
5046
5047 procedure TfrDesignerForm.TabsEditMouseUp(Sender: TObject;
5048 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
5049 begin
5050 FTabMouseDown:=false;
5051 end;
5052
5053 procedure TfrDesignerForm.ShowIEButton(AView:TfrMemoView);
5054 var
5055 lrObj: TfrObject;
5056 Band: TfrBandView;
5057 i, L, j: Integer;
5058 C: TComponent;
5059 M: TMenuItem;
5060 begin
5061 if not edtUseIE then exit;
5062 Band:=nil;
5063 for i:=0 to Objects.Count-1 do
5064 begin
5065 lrObj:=TfrObject(Objects[i]);
5066 if lrObj is TfrBandView then
5067 begin
5068 if (AView.y >= TfrBandView(lrObj).y) and ((AView.dy + AView.y) <= (lrObj.y+lrObj.dy)) then
5069 Band:=TfrBandView(lrObj);
5070 end;
5071 end;
5072 if not Assigned(Band) then exit;
5073
5074
5075 C:=frFindComponent(CurReport.Owner, Band.DataSet);
5076 if C is TfrDBDataSet then
5077 C:=TfrDBDataSet(C).DataSet;
5078
5079 if (not Assigned(C)) or (not (C is TDataSet)) then exit;
5080
5081 L:=TDataSet(C).Fields.Count;
5082 if (L = 0) then
5083 begin
5084 TDataSet(C).FieldDefs.Update;
5085 L:=TDataSet(C).FieldDefs.Count;
5086 end;
5087
5088 if L > 0 then
5089 begin
5090 IEButton.Parent:=PageView;
5091 IEButton.Visible:=true;
5092 IEButton.Left:=AView.X + AView.dx;
5093 IEButton.Top:=AView.y;
5094 IEButton.Height:=Max(10, AView.dy);
5095
5096 IEPopupMenu.Items.Clear;
5097 if TDataSet(C).Fields.Count>0 then
5098 begin
5099 for j:=0 to TDataSet(C).Fields.Count-1 do
5100 begin
5101 M:=TMenuItem.Create(IEPopupMenu.Owner);
5102 M.Caption:=TDataSet(C).Name + '."'+TDataSet(C).Fields[j].FieldName+'"';
5103 M.OnClick:=@InplaceEditorMenuClick;
5104 IEPopupMenu.Items.Add(M);
5105 end;
5106 end
5107 else
5108 begin
5109 for j:=0 to TDataSet(C).FieldDefs.Count-1 do
5110 begin
5111 M:=TMenuItem.Create(IEPopupMenu.Owner);
5112 M.Caption:=TDataSet(C).Name + '."'+TDataSet(C).FieldDefs[j].Name+'"';
5113 M.OnClick:=@InplaceEditorMenuClick;
5114 IEPopupMenu.Items.Add(M);
5115 end;
5116 end;
5117 end;
5118 end;
5119
5120 procedure TfrDesignerForm.HideIEButton;
5121 begin
5122 IEButton.Visible:=false;
5123 end;
5124
5125 procedure TfrDesignerForm.SetModified(AValue: Boolean);
5126 begin
5127 inherited SetModified(AValue);
5128 if AValue then
5129 StatusBar1.Panels[2].Text:=sFRDesignerForm_Modified
5130 else
5131 StatusBar1.Panels[2].Text:='';
5132 FileSave.Enabled:=AValue;
5133 end;
5134
TfrDesignerForm.IniFileNamenull5135 function TfrDesignerForm.IniFileName: string;
5136 begin
5137 Result:=AppendPathDelim(lrConfigFolderName(false))+'lrDesigner.cfg';
5138 end;
5139
5140 {$POP}
5141
RectTypEnablednull5142 function TfrDesignerForm.RectTypEnabled: Boolean;
5143 begin
5144 Result := [ssMemo, ssOther, ssMultiple] * SelStatus <> [];
5145 end;
5146
TfrDesignerForm.FontTypEnablednull5147 function TfrDesignerForm.FontTypEnabled: Boolean;
5148 begin
5149 Result := [ssMemo, ssMultiple] * SelStatus <> [];
5150 end;
5151
ZEnablednull5152 function TfrDesignerForm.ZEnabled: Boolean;
5153 begin
5154 Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
5155 end;
5156
CutEnablednull5157 function TfrDesignerForm.CutEnabled: Boolean;
5158 begin
5159 Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
5160 end;
5161
TfrDesignerForm.CopyEnablednull5162 function TfrDesignerForm.CopyEnabled: Boolean;
5163 begin
5164 Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
5165 end;
5166
TfrDesignerForm.PasteEnablednull5167 function TfrDesignerForm.PasteEnabled: Boolean;
5168 begin
5169 Result := ssClipboardFull in SelStatus;
5170 end;
5171
TfrDesignerForm.DelEnablednull5172 function TfrDesignerForm.DelEnabled: Boolean;
5173 begin
5174 Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
5175 end;
5176
EditEnablednull5177 function TfrDesignerForm.EditEnabled: Boolean;
5178 begin
5179 Result:=[ssBand,ssMemo,ssOther]*SelStatus <> [];
5180 end;
5181
5182 procedure TfrDesignerForm.EnableControls;
5183
5184 procedure SetCtrlEnabled(const Ar: Array of TObject; en: Boolean);
5185 var
5186 i: Integer;
5187 begin
5188 for i := Low(Ar) to High(Ar) do
5189 if Ar[i] is TControl then
5190 (Ar[i] as TControl).Enabled := en
5191 else if Ar[i] is TMenuItem then
5192 (Ar[i] as TMenuItem).Enabled := en;
5193 end;
5194
5195 begin
5196 SetCtrlEnabled([FrB1, FrB2, FrB3, FrB4, FrB5, FrB6, ClB1, ClB3, E1, SB1, SB2, StB1],
5197 RectTypEnabled);
5198 SetCtrlEnabled([ClB2, C2, C3, FnB1, FnB2, FnB3, AlB1, AlB2, AlB3, AlB4, AlB5, AlB6, AlB7, AlB8, HlB1],
5199 FontTypEnabled);
5200 SetCtrlEnabled([ZB1, ZB2, N32, N33, GB3], ZEnabled);
5201 SetCtrlEnabled([CutB, N11, N2], CutEnabled);
5202 SetCtrlEnabled([CopyB, N12, N1], CopyEnabled);
5203 SetCtrlEnabled([PstB, N13, N3], PasteEnabled);
5204 SetCtrlEnabled([N27, N5], DelEnabled);
5205 SetCtrlEnabled([N36, N6], EditEnabled);
5206 if not C2.Enabled then
5207 begin
5208 C2.ItemIndex := -1;
5209 C3.Text := '';
5210 end;
5211
5212 StatusBar1.Repaint;
5213 {$ifndef sbod}
5214 PBox1.Invalidate;
5215 {$endif}
5216 end;
5217
5218 procedure TfrDesignerForm.SelectionChanged;
5219 var
5220 t: TfrView;
5221 begin
5222 {$IFDEF DebugLR}
5223 debugLnEnter('TfrDesignerForm.SelectionChanged INIT, SelNum=%d',[SelNum]);
5224 {$ENDIF}
5225 HideIEButton;
5226 Busy := True;
5227 ColorSelector.Hide;
5228 LinePanel.Hide;
5229 EnableControls;
5230 if Page is TfrPageReport then
5231 begin
5232 if SelNum = 1 then
5233 begin
5234 t := TfrView(Objects[TopSelected]);
5235 if t.Typ <> gtBand then
5236 with t do
5237 begin
5238 {$IFDEF DebugLR}
5239 DebugLn('Not a band');
5240 {$ENDIF}
5241 FrB1.Down := (frbTop in Frames);
5242 FrB2.Down := (frbLeft in Frames);
5243 FrB3.Down := (frbBottom in Frames);
5244 FrB4.Down := (frbRight in Frames);
5245 E1.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2);
5246 frSetGlyph(FillColor, ClB1, 1);
5247 frSetGlyph(FrameColor, ClB3, 2);
5248 if t is TfrCustomMemoView then
5249 with t as TfrCustomMemoView do
5250 begin
5251 frSetGlyph(Font.Color, ClB2, 0);
5252 if C2.ItemIndex <> C2.Items.IndexOf(Font.Name) then
5253 C2.ItemIndex := C2.Items.IndexOf(Font.Name);
5254
5255 if C3.Text <> IntToStr(Font.Size) then
5256 C3.Text := IntToStr(Font.Size);
5257
5258 FnB1.Down := fsBold in Font.Style;
5259 FnB2.Down := fsItalic in Font.Style;
5260 FnB3.Down := fsUnderline in Font.Style;
5261
5262 AlB4.Down := (Adjust and $4) <> 0;
5263 AlB5.Down := (Adjust and $18) = $8;
5264 AlB6.Down := (Adjust and $18) = 0;
5265 AlB7.Down := (Adjust and $18) = $10;
5266 case (Adjust and $3) of
5267 0: BDown(AlB1);
5268 1: BDown(AlB2);
5269 2: BDown(AlB3);
5270 3: BDown(AlB8);
5271 end;
5272 end;
5273 end;
5274
5275
5276 if T is TfrMemoView then
5277 ShowIEButton(T as TfrMemoView);
5278 end
5279 else if SelNum > 1 then
5280 begin
5281 {$IFDEF DebugLR}
5282 DebugLn('Multiple selection');
5283 {$ENDIF}
5284
5285 BUp(FrB1);
5286 BUp(FrB2);
5287 BUp(FrB3);
5288 BUp(FrB4);
5289 ColorLocked := True;
5290 frSetGlyph(0, ClB1, 1);
5291 ColorLocked := False;
5292 E1.Text := '1';
5293 C2.ItemIndex := -1;
5294 C3.Text := '';
5295 BUp(FnB1);
5296 BUp(FnB2);
5297 BUp(FnB3);
5298 BDown(AlB1);
5299 BUp(AlB4);
5300 BUp(AlB5);
5301 end;
5302 end
5303 else
5304 begin
5305 if ObjInsp.SelectedObject = Page then
5306 PageView.Invalidate;
5307 end;
5308 Busy := False;
5309 ShowPosition;
5310 ShowContent;
5311 ActiveControl := nil;
5312 {$IFDEF DebugLR}
5313 debugLnExit('TfrDesignerForm.SelectionChanged END, SelNum=%d',[SelNum]);
5314 {$ENDIF}
5315 end;
5316
5317 procedure TfrDesignerForm.ShowPosition;
5318 begin
5319 FillInspFields;
5320 StatusBar1.Repaint;
5321 {$ifndef sbod}
5322 PBox1.Invalidate;
5323 {$endif}
5324 end;
5325
5326 procedure TfrDesignerForm.ShowContent;
5327 var
5328 t: TfrView;
5329 s: String;
5330 begin
5331 s := '';
5332 if SelNum = 1 then
5333 begin
5334 t := TfrView(Objects[TopSelected]);
5335 s := t.Name;
5336 if t is TfrBandView then
5337 s := s + ': ' + frBandNames[TfrBandView(t).BandType]
5338 else if t.Memo.Count > 0 then
5339 s := s + ': ' + t.Memo[0];
5340 end;
5341 StatusBar1.Panels[3].Text := s;
5342 end;
5343
5344 procedure TfrDesignerForm.DoClick(Sender: TObject);
5345 var
5346 i, j, b: Integer;
5347 s : String;
5348 t : TfrView;
5349 begin
5350 if Busy then
5351 Exit;
5352 AddUndoAction(acEdit);
5353 PageView.NPEraseSelection;
5354 GetRegion;
5355 b:=(Sender as TControl).Tag;
5356
5357 for i := 0 to Objects.Count - 1 do
5358 begin
5359 t := TfrView(Objects[i]);
5360 if t.Selected and ((t.Typ <> gtBand) or (b = 16)) then
5361 with t do
5362 begin
5363 if t is TfrCustomMemoView then
5364 with t as TfrCustomMemoView do
5365 case b of
5366 7: if C2.ItemIndex >= 0 then
5367 begin
5368 Font.Name := C2.Items[C2.ItemIndex];
5369 LastFontName := Font.Name;
5370 end;
5371 8: begin
5372 Font.Size := StrToIntDef(C3.Text, LastFontSize);
5373 LastFontSize := Font.Size;
5374 end;
5375 9: begin
5376 LastFontStyle := frGetFontStyle(Font.Style);
5377 //SetBit(LastFontStyle, not FnB1.Down, 2);
5378 SetBit(LastFontStyle, FnB1.Down, 2);
5379 Font.Style := frSetFontStyle(LastFontStyle);
5380 end;
5381 10: begin
5382 LastFontStyle := frGetFontStyle(Font.Style);
5383 //SetBit(LastFontStyle, not FnB2.Down, 1);
5384 SetBit(LastFontStyle, FnB2.Down, 1);
5385 Font.Style := frSetFontStyle(LastFontStyle);
5386 end;
5387 11..13:
5388 begin
5389 Adjust := (Adjust and $FC) + (b-11);
5390 LastAdjust := Adjust;
5391 end;
5392 14: begin
5393 Adjust := (Adjust and $FB) + Word(AlB4.Down) * 4;
5394 LastAdjust := Adjust;
5395 end;
5396 15: begin
5397 Adjust := (Adjust and $E7) + Word(AlB5.Down) * 8 + Word(AlB7.Down) * $10;
5398 LastAdjust := Adjust;
5399 end;
5400 17: begin
5401 Font.Color := ColorSelector.Color;
5402 LastFontColor := Font.Color;
5403 end;
5404 18: begin
5405 LastFontStyle := frGetFontStyle(Font.Style);
5406 // SetBit(LastFontStyle, not FnB3.Down, 4);
5407 SetBit(LastFontStyle, FnB3.Down, 4);
5408 Font.Style := frSetFontStyle(LastFontStyle);
5409 end;
5410 22: begin
5411 //Alignment:=tafrJustify;
5412 Adjust := (Adjust and $FC) + 3;
5413 LastAdjust := Adjust;
5414 end;
5415 end;
5416
5417 case b of
5418 1:
5419 begin //Top frame
5420 if (Sender=frB1) and frB1.Down then
5421 Frames:=Frames+[frbTop]
5422 else
5423 Frames:=Frames-[frbTop];
5424 DRect := Rect(t.x - 10, t.y - 10, t.x + t.dx + 10, t.y + 10)
5425 end;
5426 2: //Left frame
5427 begin
5428 if (Sender=FrB2) and frB2.Down then
5429 Frames:=Frames+[frbLeft]
5430 else
5431 Frames:=Frames-[frbLeft];
5432 DRect := Rect(t.x - 10, t.y - 10, t.x + 10, t.y + t.dy + 10)
5433 end;
5434 3: //Bottom Frame
5435 begin
5436 if (Sender=FrB3) and frB3.Down then
5437 Frames:=Frames+[frbBottom]
5438 else
5439 Frames:=Frames-[frbBottom];
5440 DRect := Rect(t.x - 10, t.y + t.dy - 10, t.x + t.dx + 10, t.y + t.dy + 10)
5441 end;
5442 4: //Right Frame
5443 begin
5444 if (Sender=FrB4) and frB4.Down then
5445 Frames:=Frames+[frbRight]
5446 else
5447 Frames:=Frames-[frbRight];
5448 DRect := Rect(t.x + t.dx - 10, t.y - 10, t.x + t.dx + 10, t.y + t.dy + 10)
5449 end;
5450 20:
5451 begin
5452 if (Sender=FrB5) then
5453 Frames:=[frbLeft, frbTop, frbRight, frbBottom];
5454
5455 LastFrames:=Frames;
5456 end;
5457 21:
5458 begin
5459 if (Sender=FrB6) then
5460 Frames:=[];
5461 LastFrames:=[];
5462 end;
5463 5:
5464 begin
5465 FillColor:=ColorSelector.Color;
5466 LastFillColor := FillColor;
5467 end;
5468 6:
5469 begin
5470 s := E1.Text;
5471 for j := 1 to Length(s) do
5472 if s[j] in ['.', ','] then
5473 s[j] := DecimalSeparator;
5474 FrameWidth := StrToFloat(s);
5475 if t is TfrLineView then
5476 LastLineWidth := FrameWidth
5477 else
5478 LastFrameWidth := FrameWidth;
5479 end;
5480 19:
5481 begin
5482 FrameColor := ColorSelector.Color;
5483 LastFrameColor := FrameColor;
5484 end;
5485 25..30:
5486 FrameStyle:=TfrFrameStyle(b - 25);
5487 end;
5488 end;
5489 end;
5490
5491 PageView.NPDrawLayerObjects(ClipRgn, TopSelected);
5492 if b<>8 then // without this you can't enter more then 1 digits in Fontsize-combobox
5493 ActiveControl := nil;
5494 if b in [20, 21] then
5495 SelectionChanged;
5496 end;
5497
5498 procedure TfrDesignerForm.frSpeedButton1Click(Sender: TObject);
5499 begin
5500 LinePanel.Hide;
5501 DoClick(Sender);
5502 end;
5503
5504 procedure TfrDesignerForm.HlB1Click(Sender: TObject);
5505 var
5506 t: TfrCustomMemoView;
5507 begin
5508 t := TfrCustomMemoView(Objects[TopSelected]);
5509 frHilightForm := TfrHilightForm.Create(nil);
5510 with frHilightForm do
5511 begin
5512 FontColor := t.Highlight.FontColor;
5513 FillColor := t.Highlight.FillColor;
5514 CB1.Checked := (t.Highlight.FontStyle and $2) <> 0;
5515 CB2.Checked := (t.Highlight.FontStyle and $1) <> 0;
5516 CB3.Checked := (t.Highlight.FontStyle and $4) <> 0;
5517 Edit1.Text := t.HighlightStr;
5518 if ShowModal = mrOk then
5519 begin
5520 AddUndoAction(acEdit);
5521 t.HighlightStr := Edit1.Text;
5522 t.Highlight.FontColor := FontColor;
5523 t.Highlight.FillColor := FillColor;
5524 SetBit(t.Highlight.FontStyle, CB1.Checked, 2);
5525 SetBit(t.Highlight.FontStyle, CB2.Checked, 1);
5526 SetBit(t.Highlight.FontStyle, CB3.Checked, 4);
5527 end;
5528 end;
5529 frHilightForm.Free;
5530 end;
5531
5532 procedure TfrDesignerForm.FillInspFields;
5533 var
5534 t: TfrView;
5535 begin
5536 if SelNum = 0 then
5537 ObjInspSelect(Page)
5538 else
5539 if SelNum = 1 then
5540 begin
5541 t := TfrView(Objects[TopSelected]);
5542 ObjInspSelect(t);
5543 end else
5544 if SelNum > 1 then
5545 ObjInspSelect(Objects);
5546 ObjInspRefresh;
5547 end;
5548
5549 {
5550 procedure TfrDesignerForm.OnModify(Item: Integer; var EditText: String);
5551 var
5552 t: TfrView;
5553 i, k: Integer;
5554 begin
5555 AddUndoAction(acEdit);
5556 if (Item = 0) and (SelNum = 1) then
5557 begin
5558 t := TfrView(Objects[TopSelected]);
5559 if CurReport.FindObject(fld[0]) = nil then
5560 t.Name := fld[0] else
5561 EditText := t.Name;
5562 SetPageTitles;
5563 end
5564 else if Item in [1..5] then
5565 begin
5566 EditText := frParser.Calc(fld[Item]);
5567 if Item <> 6 then
5568 k := UnitsToPoints(StrToFloat(EditText)) else
5569 k := StrToInt(EditText);
5570 for i := 0 to Objects.Count-1 do
5571 begin
5572 t := TfrView(Objects[i]);
5573 if t.Selected then
5574 with t do
5575 case Item of
5576 1: if (k > 0) and (k < Page.PrnInfo.Pgw) then
5577 x := k;
5578 2: if (k > 0) and (k < Page.PrnInfo.Pgh) then
5579 y := k;
5580 3: if (k > 0) and (k < Page.PrnInfo.Pgw) then
5581 dx := k;
5582 4: if (k > 0) and (k < Page.PrnInfo.Pgh) then
5583 dy := k;
5584 5: Visible := Boolean(k);
5585 end;
5586 end;
5587 end;
5588 FillInspFields;
5589 if Item in [1..5] then
5590 EditText := fld[Item];
5591 RedrawPage;
5592 StatusBar1.Repaint;
5593 PBox1.Invalidate;
5594 end;
5595 }
5596 procedure TfrDesignerForm.StB1Click(Sender: TObject);
5597 var
5598 p: TPoint;
5599 begin
5600 if not LinePanel.Visible then
5601 begin
5602 LinePanel.Parent := Self;
5603 with (Sender as TControl) do
5604 p := Self.ScreenToClient(Parent.ClientToScreen(Point(Left, Top)));
5605 LinePanel.SetBounds(p.X,p.Y + 26,LinePanel.Width,LinePanel.Height);
5606 end;
5607 LinePanel.Visible := not LinePanel.Visible;
5608 end;
5609
5610 procedure TfrDesignerForm.ObjInspSelect(Obj: TObject);
5611 {$IFDEF STDOI}
5612 var
5613 Selection: TPersistentSelectionList;
5614 i: Integer;
5615 {$ENDIF}
5616 begin
5617 {$IFDEF STDOI}
5618 Selection := TPersistentSelectionList.Create;
5619 PropHook.LookupRoot:=nil;
5620 if Obj is TPersistent then
5621 begin
5622 Selection.Add(TPersistent(Obj));
5623 PropHook.LookupRoot:=TPersistent(Obj);
5624 end else
5625 if Obj is TFpList then
5626 with frDesigner.page do
5627 for i:=0 to Objects.Count-1 do
5628 if TfrView(Objects[i]).Selected then
5629 begin
5630 if PropHook.LookupRoot=nil then
5631 PropHook.LookupRoot := TPersistent(Objects[i]);
5632 Selection.Add(TPersistent(Objects[i]));
5633 end;
5634 ObjInsp.Selection := Selection;
5635 Selection.Free;
5636 {$ELSE}
5637 ObjInsp.Select(Obj);
5638 {$ENDIF}
5639 end;
5640
5641 procedure TfrDesignerForm.DuplicateSelection;
5642 var
5643 t: TfrView;
5644 q: TPoint;
5645 p: TPoint;
5646 i: Integer;
5647 OldCount: Integer;
5648 begin
5649 if not DelEnabled then
5650 exit;
5651
5652 OldCount := Objects.Count;
5653 if OldCount=0 then
5654 exit;
5655
5656 if FDuplicateList=nil then
5657 begin
5658 FDuplicateList := TFpList.Create;
5659 for i:=0 to OldCount-1 do
5660 if TfrView(Objects[i]).Selected then
5661 FDuplicateList.Add(Objects[i]);
5662 end;
5663
5664 if (FDuplicateList.Count=0) then
5665 begin
5666 ResetDuplicateCount;
5667 exit;
5668 end;
5669
5670 Inc(FDuplicateCount);
5671
5672 if FDuplicateCount=1 then
5673 begin
5674
5675 // find reference rect in screen coords
5676 if SelNum>1 then
5677 begin
5678 p := OldRect.TopLeft;
5679 q := OldRect.BottomRight;
5680 end else
5681 begin
5682 t := TfrView(Objects[TopSelected]);
5683 p := Point(t.x, t.y);
5684 q := point(t.x+t.dx, t.y+t.dy);
5685 end;
5686 p := PageView.ControlToScreen(p);
5687 q := PageView.ControlToScreen(q);
5688
5689 // find duplicates delta based on current mouse cursor position
5690 FDupDeltaX := (q.x-p.x);
5691 FDupDeltaY := (q.y-p.y);
5692 with Mouse.CursorPos do
5693 begin
5694 if x < p.x then
5695 FDupDeltaX := -FDupDeltaX
5696 else
5697 if x < q.x then
5698 FDupDeltaX := 0;
5699
5700 if y < p.y then
5701 FDupDeltaY := -FDupDeltaY
5702 else
5703 if y < q.y then
5704 FDupDeltaY := 0;
5705 end;
5706 end;
5707
5708 ViewsAction(FDuplicateList, @DuplicateView, 0, false, false, false);
5709
5710 if OldCount<>Objects.Count then
5711 begin
5712 SendBandsToDown;
5713 PageView.GetMultipleSelected;
5714 RedrawPage;
5715 AddUndoAction(acDuplication);
5716 end else
5717 Dec(FDuplicateCount);
5718 end;
5719
5720 procedure TfrDesignerForm.CreateNewReport;
5721 begin
5722 if CheckFileModified=mrCancel then
5723 exit;
5724 ClearUndoBuffer;
5725 CurReport.Pages.Clear;
5726 CurReport.Pages.Add;
5727 CurPage := 0;
5728 CurDocName := sUntitled;
5729 //FileModified := False;
5730 Modified := False;
5731 CurReport.ReportCreateDate:=Now;
5732
5733 FCurDocFileType := 3;
5734 end;
5735
5736 procedure TfrDesignerForm.ObjInspRefresh;
5737 begin
5738 {$IFDEF STDOI}
5739 //TODO: refresh
5740 {$ELSE}
5741 ObjInsp.Refresh;
5742 {$ENDIF}
5743 end;
5744
5745 procedure TfrDesignerForm.DataInspectorRefresh;
5746 begin
5747 if Assigned(lrFieldsList) then
5748 lrFieldsList.RefreshDSList;
5749 end;
5750
5751 procedure TfrDesignerForm.ClB1Click(Sender: TObject);
5752 var p : TPoint;
5753 t : TfrView;
5754 CL : TColor;
5755 begin
5756 with (Sender as TControl) do
5757 p := Self.ScreenToClient(Parent.ClientToScreen(Point(Left, Top)));
5758 if ColorSelector.Left = p.X then
5759 ColorSelector.Visible := not ColorSelector.Visible
5760 else
5761 begin
5762 with ColorSelector do SetBounds(p.X,p.Y + 26,Width,Height);
5763 ColorSelector.Visible := True;
5764 end;
5765 ClrButton := Sender as TSpeedButton;
5766 t := TfrView(Objects[TopSelected]);
5767 CL:=clNone;
5768 if Sender=ClB1 then
5769 CL:=t.FillColor;
5770 if (Sender=ClB2) and (t is TfrCustomMemoView) then
5771 CL:=TfrCustomMemoView(t).Font.Color;
5772 if Sender=ClB3 then
5773 CL:=t.FrameColor;
5774 ColorSelector.Color:=CL;
5775 end;
5776
5777 procedure TfrDesignerForm.ColorSelected(Sender: TObject);
5778 var
5779 n: Integer;
5780 begin
5781 n := 0;
5782 if ClrButton = ClB1 then
5783 n := 1
5784 else
5785 if ClrButton = ClB3 then
5786 n := 2;
5787 {$IFDEF DebugLR}
5788 DebugLn('ColorSelected');
5789 {$ENDIF}
5790 frSetGlyph(ColorSelector.Color, ClrButton, n);
5791
5792 DoClick(ClrButton);
5793 end;
5794
5795 procedure TfrDesignerForm.PBox1Paint(Sender: TObject);
5796 var
5797 t: TfrView;
5798 s: String;
5799 nx, ny: Double;
5800 x, y, dx, dy: Integer;
5801 begin
5802 with PBox1.Canvas do
5803 begin
5804 FillRect(Rect(0, 0, PBox1.Width, PBox1.Height));
5805 ImageList1.Draw(PBox1.Canvas, 2, 0, 0);
5806 ImageList1.Draw(PBox1.Canvas, 92, 0, 1);
5807 if (SelNum = 1) or ShowSizes then
5808 begin
5809 t := nil;
5810 if ShowSizes then
5811 begin
5812 x := OldRect.Left;
5813 y := OldRect.Top;
5814 dx := OldRect.Right - x;
5815 dy := OldRect.Bottom - y;
5816 end
5817 else
5818 begin
5819 t := TfrView(Objects[TopSelected]);
5820 x := t.x;
5821 y := t.y;
5822 dx := t.dx;
5823 dy := t.dy;
5824 end;
5825
5826 if FUnits = ruPixels then
5827 s := IntToStr(x) + ';' + IntToStr(y)
5828 else
5829 s := FloatToStrF(PointsToUnits(x), ffFixed, 4, 2) + '; ' +
5830 FloatToStrF(PointsToUnits(y), ffFixed, 4, 2);
5831
5832 TextOut(20, 1, s);
5833 if FUnits = ruPixels then
5834 s := IntToStr(dx) + ';' + IntToStr(dy)
5835 else
5836 s := FloatToStrF(PointsToUnits(dx), ffFixed, 4, 2) + '; ' +
5837 FloatToStrF(PointsToUnits(dy), ffFixed, 4, 2);
5838 TextOut(110, 1, s);
5839
5840 if not ShowSizes and (t.Typ = gtPicture) then
5841 begin
5842 with t as TfrPictureView do
5843 begin
5844 if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
5845 begin
5846 s := IntToStr(dx * 100 div Picture.Width) + ',' +
5847 IntToStr(dy * 100 div Picture.Height);
5848 TextOut(170, 1, '% ' + s);
5849 end;
5850 end;
5851 end;
5852 end
5853 else if (SelNum > 0) and MRFlag then
5854 begin
5855 nx := 0;
5856 ny := 0;
5857 if OldRect1.Right - OldRect1.Left <> 0 then
5858 nx := (OldRect.Right - OldRect.Left) / (OldRect1.Right - OldRect1.Left);
5859 if OldRect1.Bottom - OldRect1.Top <> 0 then
5860 ny := (OldRect.Bottom - OldRect.Top) / (OldRect1.Bottom - OldRect1.Top);
5861 s := IntToStr(Round(nx * 100)) + ',' + IntToStr(Round(ny * 100));
5862 TextOut(170, 1, '% ' + s);
5863 end;
5864 end;
5865 end;
5866
5867 procedure TfrDesignerForm.C2DrawItem(Control: TWinControl; Index: Integer;
5868 Rect: TRect; State: TOwnerDrawState);
5869 var
5870 j: PtrInt;
5871 begin
5872 with C2.Canvas do
5873 begin
5874 Font.Name := 'default';
5875 FillRect(Rect);
5876 j := PtrInt(C2.Items.Objects[Index]);
5877 {$IFDEF USE_PRINTER_FONTS}
5878 if (j and $100 <> 0) then
5879 ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top +1, 2)
5880 else
5881 {$ENDIF}
5882 if ( j and TRUETYPE_FONTTYPE) <> 0 then
5883 ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top + 1, 0);
5884 TextOut(Rect.Left + 20, Rect.Top + 1, C2.Items[Index]);
5885 end;
5886 end;
5887
5888 procedure TfrDesignerForm.ShowMemoEditor;
5889 begin
5890 if EditorForm.ShowEditor(TfrView(Objects[TopSelected])) = mrOk then
5891 begin
5892 PageView.NPDrawSelection;
5893 PageView.NPDrawLayerObjects(EditorForm.View.GetClipRgn(rtExtended), TopSelected);
5894 end;
5895
5896 ActiveControl := nil;
5897 end;
5898
5899 procedure TfrDesignerForm.ShowEditor;
5900 var
5901 t: TfrView;
5902 i: Integer;
5903 bt: TfrBandType;
5904 begin
5905 SetCaptureControl(nil);
5906 t := TfrView(Objects[TopSelected]);
5907
5908 if lrrDontModify in T.Restrictions then
5909 exit;
5910
5911 if t.Typ = gtMemo then
5912 ShowMemoEditor
5913 else
5914 if t.Typ = gtPicture then
5915 begin
5916 frGEditorForm := TfrGEditorForm.Create(nil);
5917 with frGEditorForm do
5918 begin
5919 Image1.Picture.Assign((t as TfrPictureView).Picture);
5920 if ShowModal = mrOk then
5921 begin
5922 AddUndoAction(acEdit);
5923 (t as TfrPictureView).Picture.Assign(Image1.Picture);
5924 PageView.NPDrawSelection;
5925 PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
5926 end;
5927 end;
5928 frGEditorForm.Free;
5929 end
5930 else
5931 if t.Typ = gtBand then
5932 begin
5933 PageView.NPEraseSelection;
5934 bt := (t as TfrBandView).BandType;
5935 if bt in [btMasterData, btDetailData, btSubDetailData] then
5936 begin
5937 frBandEditorForm := TfrBandEditorForm.Create(nil);
5938 frBandEditorForm.ShowEditor(t);
5939 frBandEditorForm.Free;
5940 end
5941 else if bt = btGroupHeader then
5942 begin
5943 frGroupEditorForm := TfrGroupEditorForm.Create(nil);
5944 frGroupEditorForm.ShowEditor(t);
5945 frGroupEditorForm.Free;
5946 end
5947 else if bt = btCrossData then
5948 begin
5949 frVBandEditorForm := TfrVBandEditorForm.Create(nil);
5950 frVBandEditorForm.ShowEditor(t);
5951 frVBandEditorForm.Free;
5952 end
5953 else
5954 PageView.DFlag := False;
5955 PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
5956 end
5957 else
5958 if t.Typ = gtSubReport then
5959 CurPage := (t as TfrSubReportView).SubPage.PageIndex
5960 else
5961 if t.Typ = gtAddIn then
5962 begin
5963 for i := 0 to frAddInsCount - 1 do
5964 if frAddIns[i].ClassRef.ClassName = t.ClassName then
5965 begin
5966 if Assigned(frAddIns[i].EditorProc) then
5967 begin
5968 if frAddIns[i].EditorProc(t) then
5969 Modified:=true;
5970 end
5971 else
5972 if frAddIns[i].EditorForm <> nil then
5973 begin
5974 PageView.NPEraseSelection;
5975 frAddIns[i].EditorForm.ShowEditor(t);
5976 PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
5977 end
5978 else
5979 ShowMemoEditor;
5980 break;
5981 end;
5982 end;
5983 ShowContent;
5984 ShowPosition;
5985 ActiveControl := nil;
5986 end;
5987
5988 procedure TfrDesignerForm.ShowDialogPgEditor(APage: TfrPageDialog);
5989 begin
5990 EditorForm.M2.Lines.Assign(APage.Script);
5991 EditorForm.MemoPanel.Visible:=false;
5992 EditorForm.CB1.OnClick:=nil;
5993 EditorForm.CB1.Checked:=true;
5994 EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
5995 EditorForm.ScriptPanel.Align:=alClient;
5996 if EditorForm.ShowEditor(nil) = mrOk then
5997 begin
5998 APage.Script.Assign(EditorForm.M2.Lines);
5999 frDesigner.Modified:=true;
6000 end;
6001 EditorForm.ScriptPanel.Align:=alBottom;
6002 EditorForm.MemoPanel.Visible:=true;
6003 ActiveControl := nil;
6004 end;
6005
6006 procedure TfrDesignerForm.ReleaseAction(ActionRec: TfrUndoRec);
6007 var
6008 p, p1: PfrUndoObj;
6009 begin
6010 p := ActionRec.Objects;
6011 while p <> nil do
6012 begin
6013 if ActionRec.Action in [acDelete, acEdit] then
6014 p^.ObjPtr.Free;
6015 p1 := p;
6016 p := p^.Next;
6017 FreeMem(p1, SizeOf(TfrUndoObj));
6018 end;
6019 end;
6020
6021 procedure TfrDesignerForm.ClearBuffer(Buffer: TfrUndoBuffer; var BufferLength: Integer);
6022 var
6023 i: Integer;
6024 begin
6025 for i := 0 to BufferLength - 1 do
6026 ReleaseAction(Buffer[i]);
6027 BufferLength := 0;
6028 end;
6029
6030 procedure TfrDesignerForm.ClearUndoBuffer;
6031 begin
6032 ClearBuffer(FUndoBuffer, FUndoBufferLength);
6033 edtUndo.Enabled := False;
6034 end;
6035
6036 procedure TfrDesignerForm.ClearRedoBuffer;
6037 begin
6038 ClearBuffer(FRedoBuffer, FRedoBufferLength);
6039 edtRedo.Enabled := False;
6040 end;
6041
6042 procedure TfrDesignerForm.Undo(Buffer: PfrUndoBuffer);
6043 var
6044 p, p1: PfrUndoObj;
6045 r: PfrUndoRec1;
6046 BufferLength: Integer;
6047 List: TFpList;
6048 a: TfrUndoAction;
6049 begin
6050 if Buffer = @FUndoBuffer then
6051 BufferLength := FUndoBufferLength
6052 else
6053 BufferLength := FRedoBufferLength;
6054
6055 if (Buffer^[BufferLength - 1].Page <> CurPage) then Exit;
6056
6057 List := TFpList.Create;
6058 a := Buffer^[BufferLength - 1].Action;
6059 p := Buffer^[BufferLength - 1].Objects;
6060 while p <> nil do
6061 begin
6062 GetMem(r, SizeOf(TfrUndoRec1));
6063 r^.ObjPtr := p^.ObjPtr;
6064 r^.Int := p^.Int;
6065 List.Add(r);
6066 case Buffer^[BufferLength - 1].Action of
6067 acInsert:
6068 begin
6069 r^.Int := Page.FindObjectByID(p^.ObjID);
6070 r^.ObjPtr := TfrView(Objects[r^.Int]);
6071 a := acDelete;
6072 end;
6073 acDelete: a := acInsert;
6074 acEdit: r^.ObjPtr := TfrView(Objects[p^.Int]);
6075 acZOrder:
6076 begin
6077 r^.Int := Page.FindObjectByID(p^.ObjID);
6078 r^.ObjPtr := TfrView(Objects[r^.Int]);
6079 p^.ObjPtr := r^.ObjPtr;
6080 end;
6081 end;
6082 p := p^.Next;
6083 end;
6084 if Buffer = @FUndoBuffer then
6085 AddAction(@FRedoBuffer, a, List) else
6086 AddAction(@FUndoBuffer, a, List);
6087 List.Free;
6088
6089 p := Buffer^[BufferLength - 1].Objects;
6090 while p <> nil do
6091 begin
6092 case Buffer^[BufferLength - 1].Action of
6093 acInsert: Page.Delete(Page.FindObjectByID(p^.ObjID));
6094 acDelete: Objects.Insert(p^.Int, p^.ObjPtr);
6095 acEdit:
6096 begin
6097 TfrView(Objects[p^.Int]).Assign(p^.ObjPtr);
6098 p^.ObjPtr.Free;
6099 end;
6100 acZOrder: Objects[p^.Int] := p^.ObjPtr;
6101 end;
6102 p1 := p;
6103 p := p^.Next;
6104 FreeMem(p1, SizeOf(TfrUndoObj));
6105 end;
6106
6107 if Buffer = @FUndoBuffer then
6108 Dec(FUndoBufferLength)
6109 else
6110 Dec(FRedoBufferLength);
6111
6112 ResetSelection;
6113 PageView.Invalidate;
6114 edtUndo.Enabled := FUndoBufferLength > 0;
6115 edtRedo.Enabled := FRedoBufferLength > 0;
6116 end;
6117
6118 procedure TfrDesignerForm.AddAction(Buffer: PfrUndoBuffer; a: TfrUndoAction; List: TFpList);
6119 var
6120 i: Integer;
6121 p, p1: PfrUndoObj;
6122 r: PfrUndoRec1;
6123 t, t1: TfrView;
6124 BufferLength: Integer;
6125 begin
6126 if Buffer = @FUndoBuffer then
6127 BufferLength := FUndoBufferLength
6128 else
6129 BufferLength := FRedoBufferLength;
6130 if BufferLength >= MaxUndoBuffer then
6131 begin
6132 ReleaseAction(Buffer^[0]);
6133 for i := 0 to MaxUndoBuffer - 2 do
6134 Buffer^[i] := Buffer^[i + 1];
6135 BufferLength := MaxUndoBuffer - 1;
6136 end;
6137 Buffer^[BufferLength].Action := a;
6138 Buffer^[BufferLength].Page := CurPage;
6139 Buffer^[BufferLength].Objects := nil;
6140 p := nil;
6141 for i := 0 to List.Count - 1 do
6142 begin
6143 r := List[i];
6144 t := r^.ObjPtr;
6145 GetMem(p1, SizeOf(TfrUndoObj));
6146 p1^.Next := nil;
6147
6148 if Buffer^[BufferLength].Objects = nil then
6149 Buffer^[BufferLength].Objects := p1
6150 else
6151 p^.Next := p1;
6152
6153 p := p1;
6154 case a of
6155 acInsert: p^.ObjID := t.ID;
6156 acDelete, acEdit:
6157 begin
6158 t1 := frCreateObject(t.Typ, t.ClassName, nil);
6159 t1.Assign(t);
6160 t1.ID := t.ID;
6161 p^.ObjID := t.ID;
6162 p^.ObjPtr := t1;
6163 p^.Int := r^.Int;
6164 end;
6165 acZOrder:
6166 begin
6167 p^.ObjID := t.ID;
6168 p^.Int := r^.Int;
6169 end;
6170 end;
6171 FreeMem(r, SizeOf(TfrUndoRec1));
6172 end;
6173 if Buffer = @FUndoBuffer then
6174 begin
6175 FUndoBufferLength := BufferLength + 1;
6176 edtUndo.Enabled := True;
6177 end
6178 else
6179 begin
6180 FRedoBufferLength := BufferLength + 1;
6181 edtRedo.Enabled := True;
6182 end;
6183 Modified := True;
6184 //FileModified := True;
6185 end;
6186
6187 procedure TfrDesignerForm.AddUndoAction(AUndoAction: TfrUndoAction);
6188 var
6189 i,j: Integer;
6190 t: TfrView;
6191 List: TFpList;
6192 F:boolean;
6193
6194 procedure AddCurrent;
6195 var
6196 p: PfrUndoRec1;
6197 begin
6198 GetMem(p, SizeOf(TfrUndoRec1));
6199 p^.ObjPtr := t;
6200 p^.Int := i;
6201 List.Add(p);
6202 end;
6203
6204 begin
6205 ClearRedoBuffer;
6206 if not Assigned(Objects) then exit;
6207
6208 List := TFpList.Create;
6209
6210 // last FDuplicateList.Count objectes were duplicated
6211 if AUndoAction = acDuplication then
6212 j := Objects.Count - FDuplicateList.Count
6213 else
6214 j := 0;
6215
6216 for i := j to Objects.Count - 1 do
6217 begin
6218 t := TfrView(Objects[i]);
6219 F:= ((AUndoAction = acDelete) and not (lrrDontDelete in t.Restrictions))
6220 or
6221 ((AUndoAction = acEdit) and not (lrrDontModify in t.Restrictions))
6222 or
6223 (not (AUndoAction in [acDelete, acEdit]));
6224
6225 if (not (doUndoDisable in T.DesignOptions)) and ((AUndoAction in [acDuplication, acZOrder]) or t.Selected) and F then
6226 AddCurrent;
6227 end;
6228
6229 if List.Count>0 then
6230 begin
6231 if AUndoAction = acDuplication then
6232 AUndoAction := acInsert;
6233 AddAction(@FUndoBuffer, AUndoAction, List);
6234 end;
6235 List.Free;
6236 end;
6237
6238 procedure TfrDesignerForm.BeforeChange;
6239 begin
6240 AddUndoAction(acEdit);
6241 end;
6242
6243 procedure TfrDesignerForm.AfterChange;
6244 begin
6245 PageView.NPDrawSelection;
6246 PageView.NPDrawLayerObjects(0, TopSelected);
6247 ObjInspRefresh;
6248 DataInspectorRefresh;
6249 end;
6250
6251 //Move selected object from front
6252 procedure TfrDesignerForm.ZB1Click(Sender: TObject); // go up
6253 var
6254 i, j, n: Integer;
6255 t: TfrView;
6256 begin
6257 AddUndoAction(acZOrder);
6258 n:=Objects.Count;
6259 i:=0;
6260 j:=0;
6261 while j < n do
6262 begin
6263 t := TfrView(Objects[i]);
6264 if t.Selected then
6265 begin
6266 Objects.Delete(i);
6267 Objects.Add(t);
6268 end
6269 else Inc(i);
6270 Inc(j);
6271 end;
6272 SendBandsToDown;
6273 RedrawPage;
6274 end;
6275
6276 //Send selected object to back
6277 procedure TfrDesignerForm.ZB2Click(Sender: TObject); // go down
6278 var
6279 t: TfrView;
6280 i, j, n: Integer;
6281 begin
6282 AddUndoAction(acZOrder);
6283 n:=Objects.Count;
6284 j:=0;
6285 i:=n-1;
6286 while j < n do
6287 begin
6288 t := TfrView(Objects[i]);
6289 if t.Selected then
6290 begin
6291 Objects.Delete(i);
6292 Objects.Insert(0, t);
6293 end
6294 else Dec(i);
6295 Inc(j);
6296 end;
6297 SendBandsToDown;
6298 RedrawPage;
6299 end;
6300
6301 procedure TfrDesignerForm.PgB1Click(Sender: TObject); // add page
6302 begin
6303 ResetSelection;
6304 if Sender<>pgB4 then
6305 AddPage('TfrPageReport')
6306 else
6307 AddPage('TfrPageDialog');
6308 end;
6309
6310 procedure TfrDesignerForm.PgB2Click(Sender: TObject); // remove page
6311 begin
6312 if MessageDlg(sRemovePg,mtConfirmation,[mbYes,mbNo],0)=mrYes then
6313 RemovePage(CurPage);
6314 end;
6315
6316 procedure TfrDesignerForm.OB1Click(Sender: TObject);
6317 begin
6318 ObjRepeat := False;
6319 end;
6320
6321 procedure TfrDesignerForm.OB2MouseDown(Sender: TObject; Button: TMouseButton;
6322 Shift: TShiftState; X, Y: Integer);
6323 begin
6324 ObjRepeat := ssShift in Shift;
6325 PageView.Cursor := crDefault;
6326 end;
6327
6328 procedure TfrDesignerForm.CutBClick(Sender: TObject); //cut
6329 begin
6330 AddUndoAction(acDelete);
6331 CutToClipboard;
6332 FirstSelected := nil;
6333 EnableControls;
6334 ShowPosition;
6335 RedrawPage;
6336 end;
6337
6338 procedure TfrDesignerForm.CopyBClick(Sender: TObject); //copy
6339 begin
6340 CopyToClipboard;
6341 EnableControls;
6342 end;
6343
6344 procedure TfrDesignerForm.PstBClick(Sender: TObject); //paste
6345 var
6346 i, minx, miny, xoffset, yoffset: Integer;
6347 t, t1: TfrView;
6348 begin
6349 Unselect;
6350 SelNum := 0;
6351 minx := 32767;
6352 miny := 32767;
6353 xoffset := FReportPopupPoint.x;
6354 yoffset := FReportPopupPoint.y;
6355 for i := 0 to ClipBd.Count-1 do
6356 begin
6357 t := TfrView(ClipBd[i]);
6358 if t.x < minx then minx := t.x;
6359 if t.y < miny then miny := t.y;
6360 end;
6361 for i := 0 to ClipBd.Count - 1 do
6362 begin
6363 t := TfrView(ClipBd[i]);
6364 if t.Typ = gtBand then
6365 if not (TfrBandView(t).BandType in [btMasterHeader..btSubDetailFooter,
6366 btGroupHeader, btGroupFooter]) and
6367 frCheckBand(TfrBandView(t).BandType) then
6368 continue;
6369 t.x := t.x - minx + xoffset;
6370 if PageView.Left < 0 then
6371 t.x := t.x + ((-PageView.Left) div GridSize * GridSize);
6372 t.y := t.y - miny + yoffset;
6373 if PageView.Top < 0 then
6374 t.y := t.y + ((-PageView.Top) div GridSize * GridSize);
6375 Inc(SelNum);
6376 t1 := frCreateObject(t.Typ, t.ClassName, Page);
6377 t1.Assign(t);
6378 if CurReport.FindObject(t1.Name) <> nil then
6379 t1.CreateUniqueName;
6380 end;
6381 SelectionChanged;
6382 SendBandsToDown;
6383 PageView.GetMultipleSelected;
6384 RedrawPage;
6385 AddUndoAction(acInsert);
6386 end;
6387
6388 procedure TfrDesignerForm.SelAllBClick(Sender: TObject); // select all
6389 begin
6390 PageView.NPEraseSelection;
6391 SelectAll;
6392 PageView.GetMultipleSelected;
6393 PageView.NPDrawSelection;
6394 SelectionChanged;
6395 end;
6396
6397 procedure TfrDesignerForm.ExitBClick(Sender: TObject);
6398 begin
6399 {$IFDEF MODALDESIGNER}
6400 ModalResult := mrOk;
6401 {$ELSE}
6402 Close;
6403 {$ENDIF}
6404 end;
6405
6406
6407 procedure TfrDesignerForm.N5Click(Sender: TObject); // popup delete command
6408 begin
6409 DeleteObjects;
6410 end;
6411
6412 procedure TfrDesignerForm.N6Click(Sender: TObject); // popup edit command
6413 begin
6414 ShowEditor;
6415 end;
6416
6417 procedure TfrDesignerForm.FileBtn1Click(Sender: TObject); // create new
6418 begin
6419 CreateNewReport;
6420 end;
6421
6422 procedure TfrDesignerForm.N23Click(Sender: TObject); // create new from template
6423 begin
6424 frTemplForm := TfrTemplForm.Create(nil);
6425 with frTemplForm do
6426 if ShowModal = mrOk then
6427 begin
6428 if DefaultTemplate then
6429 CreateNewReport
6430 else
6431 begin
6432 ClearUndoBuffer;
6433 if ExtractFileExt(TemplName) = '.lrt' then
6434 CurReport.LoadTemplateXML(TemplName, nil, nil, True)
6435 else
6436 CurReport.LoadTemplate(TemplName, nil, nil, True);
6437 CurDocName := sUntitled;
6438 CurPage := 0; // do all
6439 end;
6440 end;
6441 frTemplForm.Free;
6442 end;
6443
6444 procedure TfrDesignerForm.N42Click(Sender: TObject); // var editor
6445 begin
6446 if ShowEvEditor(CurReport) then
6447 Modified := True;
6448 end;
6449
6450 procedure TfrDesignerForm.PgB3Click(Sender: TObject); // page setup
6451 var
6452 w, h, p: Integer;
6453 function PointsToMMStr(value:Integer): string;
6454 begin
6455 result := IntToStr(Trunc(value*5/18+0.5));
6456 end;
6457 function MMStrToPoints(value:string): Integer;
6458 begin
6459 result := Trunc(Trunc(StrToFloatDef(value, 0.0))*18/5+0.5)
6460 end;
6461 begin
6462 frPgoptForm := TfrPgoptForm.Create(nil);
6463 with frPgoptForm, Page do
6464 begin
6465 CB1.Checked := PrintToPrevPage;
6466 CB5.Checked := not UseMargins;
6467 if Orientation = poPortrait then
6468 RB1.Checked := True
6469 else
6470 RB2.Checked := True;
6471 Prn.FillPapers(COMB1.Items);
6472 ComB1.ItemIndex := COMB1.Items.IndexOfObject(TObject(PtrInt(pgSize)));
6473 E1.Text := ''; E2.Text := '';
6474
6475 if pgSize = $100 then
6476 begin
6477 PaperWidth := round(Width * 25.4 / 72); // pt to mm
6478 PaperHeight := round(Height * 25.4 / 72); // pt to mm
6479 end;
6480
6481 E3.Text := PointsToMMStr(Margins.Left);
6482 E4.Text := PointsToMMStr(Margins.Top);
6483 E5.Text := PointsToMMStr(Margins.Right);
6484 E6.Text := PointsToMMStr(Margins.Bottom);
6485 E7.Text := PointsToMMStr(ColGap);
6486
6487 ecolCount.Value := ColCount;
6488 if LayoutOrder = loColumns then
6489 RBColumns.Checked := true
6490 else
6491 RBRows.Checked := true;
6492 WasOk := False;
6493 if ShowModal = mrOk then
6494 begin
6495 Modified := True;
6496 // FileModified := True;
6497 WasOk := True;
6498 PrintToPrevPage := CB1.Checked;
6499 UseMargins := not CB5.Checked;
6500 if RB1.Checked then
6501 Orientation := poPortrait
6502 else
6503 Orientation := poLandscape;
6504 if RBColumns.Checked then
6505 LayoutOrder := loColumns
6506 else
6507 LayoutOrder := loRows;
6508
6509 p := frPgoptForm.pgSize;
6510 w := 0; h := 0;
6511 if p = $100 then
6512 try
6513 w := round(PaperWidth * 72 / 25.4); // mm to pt
6514 h := round(PaperHeight * 72 / 25.4); // mm to pt
6515 except
6516 on exception do p := 9; // A4
6517 end;
6518
6519 Margins.Left := MMStrToPoints(E3.Text);
6520 Margins.Top := MMStrToPoints(E4.Text);
6521 Margins.Right := MMStrToPoints(E5.Text);
6522 Margins.Bottom := MMStrToPoints(E6.Text);
6523 ColGap := MMStrToPoints(E7.Text);
6524
6525 ColCount := ecolCount.Value;
6526 ChangePaper(p, w, h, Orientation);
6527 CurPage := CurPage; // for repaint and other
6528 UpdScrollbars;
6529 end;
6530 end;
6531 frPgoptForm.Free;
6532 end;
6533
6534 procedure TfrDesignerForm.N8Click(Sender: TObject); // report setup
6535 begin
6536 frDocOptForm := TfrDocOptForm.Create(nil);
6537 with frDocOptForm do
6538 begin
6539 CB1.Checked := not CurReport.PrintToDefault;
6540 CB2.Checked := CurReport.DoublePass;
6541 edTitle.Text := CurReport.Title;
6542 edComments.Text := CurReport.Comments.Text;
6543 edKeyWords.Text := CurReport.KeyWords;
6544 edSubject.Text := CurReport.Subject;
6545 edAutor.Text := CurReport.ReportAutor;
6546 edtMaj.Text := CurReport.ReportVersionMajor;
6547 edtMinor.Text := CurReport.ReportVersionMinor;
6548 edtRelease.Text := CurReport.ReportVersionRelease;
6549 edtBuild.Text := CurReport.ReportVersionBuild;
6550 edtRepCreateDate.Text := DateTimeToStr(CurReport.ReportCreateDate);
6551 edtRepLastChangeDate.Text := DateTimeToStr(CurReport.ReportLastChange);
6552 if ShowModal = mrOk then
6553 begin
6554 CurReport.PrintToDefault := not CB1.Checked;
6555 CurReport.DoublePass := CB2.Checked;
6556 CurReport.ChangePrinter(Prn.PrinterIndex, ListBox1.ItemIndex);
6557 {$IFDEF USE_PRINTER_FONTS}
6558 // printer may have been changed, invalidate current list of fonts
6559 C2.Items.Clear;
6560 {$ENDIF}
6561 CurReport.Title:=edTitle.Text;
6562 CurReport.Subject:=edSubject.Text;
6563 CurReport.KeyWords:=edKeyWords.Text;
6564 CurReport.Comments.Text:=edComments.Text;
6565 CurReport.ReportVersionMajor:=edtMaj.Text;
6566 CurReport.ReportVersionMinor:=edtMinor.Text;
6567 CurReport.ReportVersionRelease:=edtRelease.Text;
6568 CurReport.ReportVersionBuild:=edtBuild.Text;
6569 CurReport.ReportAutor:=edAutor.Text;
6570 Modified := True;
6571 end;
6572 CurPage := CurPage;
6573 Free;
6574 end;
6575 end;
6576
6577 procedure TfrDesignerForm.N14Click(Sender: TObject); // grid menu
6578 var
6579 DesOptionsForm: TfrDesOptionsForm;
6580 begin
6581 DesOptionsForm := TfrDesOptionsForm.Create(nil);
6582 with DesOptionsForm do
6583 begin
6584 CB1.Checked := ShowGrid;
6585 CB2.Checked := GridAlign;
6586 case GridSize of
6587 4: RB1.Checked := True;
6588 8: RB2.Checked := True;
6589 18: RB3.Checked := True;
6590 end;
6591 if ShapeMode = smFrame then
6592 RB4.Checked := True
6593 else
6594 RB5.Checked := True;
6595
6596 case Units of
6597 ruPixels: RB6.Checked := True;
6598 ruMM: RB7.Checked := True;
6599 ruInches: RB8.Checked := True;
6600 end;
6601
6602 //CB3.Checked := not GrayedButtons;
6603 CB4.Checked := EditAfterInsert;
6604 CB5.Checked := ShowBandTitles;
6605
6606 DesOptionsForm.ComboBox2.Text:=edtScriptFontName;
6607 DesOptionsForm.SpinEdit2.Value:=edtScriptFontSize;
6608 DesOptionsForm.CheckBox2.Checked:=edtUseIE;
6609
6610 if ShowModal = mrOk then
6611 begin
6612 ShowGrid := CB1.Checked;
6613 GridAlign := CB2.Checked;
6614 if RB1.Checked then
6615 GridSize := 4
6616 else if RB2.Checked then
6617 GridSize := 8
6618 else
6619 GridSize := 18;
6620 if RB4.Checked then
6621 ShapeMode := smFrame
6622 else
6623 ShapeMode := smAll;
6624 if RB6.Checked then
6625 Units := ruPixels
6626 else if RB7.Checked then
6627 Units := ruMM
6628 else
6629 Units := ruInches;
6630 //GrayedButtons := not CB3.Checked;
6631 EditAfterInsert := CB4.Checked;
6632 ShowBandTitles := CB5.Checked;
6633
6634 edtScriptFontName:=DesOptionsForm.ComboBox2.Text;
6635 edtScriptFontSize:=DesOptionsForm.SpinEdit2.Value;
6636 edtUseIE:=DesOptionsForm.CheckBox2.Checked;
6637
6638 RedrawPage;
6639 SaveState;
6640 end;
6641 Free;
6642 end;
6643 end;
6644
6645 procedure TfrDesignerForm.GB1Click(Sender: TObject);
6646 begin
6647 ShowGrid := GB1.Down;
6648 end;
6649
6650 procedure TfrDesignerForm.ScrollBox1DragDrop(Sender, Source: TObject; X,
6651 Y: Integer);
6652 var
6653 Control :TControl;
6654 t : TfrCustomMemoView;
6655 dx, dy:integer;
6656 begin
6657 Control:=lrDesignAcceptDrag(Source);
6658 if Assigned(lrFieldsList) and ((Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList)) then
6659 begin
6660
6661 { Objects.Add(frCreateObject(gtMemo, '', Page));
6662 t:=TfrCustomMemoView(Objects.Last);}
6663 t:=frCreateObject(gtMemo, '', Page) as TfrCustomMemoView;
6664 if Assigned(t) then
6665 begin
6666 t.MonitorFontChanges;
6667 t.Memo.Text:='['+lrFieldsList.SelectedField+']';
6668
6669 t.CreateUniqueName;
6670 t.Canvas:=Canvas;
6671
6672 GetDefaultSize(dx, dy);
6673
6674 t.x := X;
6675 t.y := Y;
6676 t.dx := DX;
6677 t.dy := DY;
6678
6679 {$ifdef ppaint}
6680 PageView.NPEraseSelection;
6681 {$endif}
6682 Unselect;
6683
6684 t.FrameWidth := LastFrameWidth;
6685 t.FrameColor := LastFrameColor;
6686 t.FillColor := LastFillColor;
6687 t.Selected := True;
6688
6689 if t.Typ <> gtBand then
6690 t.Frames:=LastFrames;
6691
6692 t.Font.Name := LastFontName;
6693 t.Font.Size := LastFontSize;
6694 t.Font.Color := LastFontColor;
6695 t.Font.Style := frSetFontStyle(LastFontStyle);
6696 t.Adjust := LastAdjust;
6697
6698 SelNum := 1;
6699 PageView.NPRedrawViewCheckBand(t);
6700
6701 SelectionChanged;
6702 AddUndoAction(acInsert);
6703
6704 if Page is TfrPageReport then
6705 OB1.Down := True
6706 else
6707 OB7.Down := True
6708
6709 end;
6710 end;
6711 end;
6712
6713 procedure TfrDesignerForm.ScrollBox1DragOver(Sender, Source: TObject; X,
6714 Y: Integer; State: TDragState; var Accept: Boolean);
6715 var
6716 Control :TControl;
6717 begin
6718 Accept:= false;
6719 if Page is TfrPageDialog then Exit;
6720 Control:=lrDesignAcceptDrag(Source);
6721 if Assigned(lrFieldsList) then
6722 Accept:= (Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList);
6723 end;
6724
6725 procedure TfrDesignerForm.IEButtonClick(Sender: TObject);
6726 var
6727 P: TPoint;
6728 begin
6729 P:=IEButton.ClientToScreen(Point(IEButton.Width, IEButton.Height));
6730 IEPopupMenu.PopUp(P.X, P.Y);
6731 end;
6732
6733 procedure TfrDesignerForm.tlsDBFieldsExecute(Sender: TObject);
6734 begin
6735 if Assigned(lrFieldsList) then
6736 FreeThenNil(lrFieldsList)
6737 else
6738 lrFieldsList:=TlrFieldsList.Create(Self);
6739 tlsDBFields.Checked:=Assigned(lrFieldsList);
6740 end;
6741
6742 procedure TfrDesignerForm.GB2Click(Sender: TObject);
6743 begin
6744 GridAlign := GB2.Down;
6745 end;
6746
6747 procedure TfrDesignerForm.GB3Click(Sender: TObject);
6748 var
6749 i: Integer;
6750 t: TfrView;
6751 begin
6752 AddUndoAction(acEdit);
6753 for i := 0 to Objects.Count - 1 do
6754 begin
6755 t := TfrView(Objects[i]);
6756 if t.Selected then
6757 begin
6758 t.x := Round(t.x / GridSize) * GridSize;
6759 t.y := Round(t.y / GridSize) * GridSize;
6760 t.dx := Round(t.dx / GridSize) * GridSize;
6761 t.dy := Round(t.dy / GridSize) * GridSize;
6762 if t.dx = 0 then t.dx := GridSize;
6763 if t.dy = 0 then t.dy := GridSize;
6764 end;
6765 end;
6766 RedrawPage;
6767 ShowPosition;
6768 PageView.GetMultipleSelected;
6769 end;
6770
6771 procedure TfrDesignerForm.Tab1Change(Sender: TObject);
6772 begin
6773 if not fInBuildPage and (Tab1.TabIndex>=0) and (CurPage<>Tab1.TabIndex) then
6774 CurPage := Tab1.TabIndex;
6775 end;
6776
6777 procedure TfrDesignerForm.Popup1Popup(Sender: TObject);
6778 var
6779 i: Integer;
6780 t, t1: TfrView;
6781 fl: Boolean;
6782 begin
6783 FReportPopupPoint := PageView.ScreenToClient(Popup1.PopupPoint);
6784 DeleteMenuItems(N2.Parent);
6785 EnableControls;
6786
6787 while Popup1.Items.Count > 7 do
6788 Popup1.Items.Delete(7);
6789
6790 if SelNum = 1 then
6791 begin
6792 DefineExtraPopupSelected(Popup1);
6793 TfrView(Objects[TopSelected]).DefinePopupMenu(Popup1);
6794 end
6795 else
6796 if SelNum > 1 then
6797 begin
6798 t := TfrView(Objects[TopSelected]);
6799 fl := True;
6800 for i := 0 to Objects.Count - 1 do
6801 begin
6802 t1 := TfrView(Objects[i]);
6803 if t1.Selected then
6804 if not (((t is TfrCustomMemoView) and (t1 is TfrCustomMemoView)) or
6805 ((t.Typ <> gtAddIn) and (t.Typ = t1.Typ)) or
6806 ((t.Typ = gtAddIn) and (t.ClassName = t1.ClassName))) then
6807 begin
6808 fl := False;
6809 break;
6810 end;
6811 end;
6812
6813 if fl and not (t.Typ = gtBand) then
6814 t.DefinePopupMenu(Popup1);
6815 end;
6816
6817 FillMenuItems(N2.Parent);
6818 SetMenuItemBitmap(N2, CutB);
6819 SetMenuItemBitmap(N1, CopyB);
6820 SetMenuItemBitmap(N3, PstB);
6821 SetMenuItemBitmap(N16, SelAllB);
6822 end;
6823
6824 procedure TfrDesignerForm.N37Click(Sender: TObject);
6825 begin // toolbars
6826 Pan1.Checked := Panel1.IsVisible;
6827 Pan2.Checked := Panel2.IsVisible;
6828 Pan3.Checked := Panel3.IsVisible;
6829 Pan4.Checked := Panel4.IsVisible;
6830 Pan5.Checked := ObjInsp.Visible;
6831 Pan6.Checked := Panel5.Visible;
6832 Pan7.Checked := Panel6.Visible;
6833 end;
6834
6835 procedure TfrDesignerForm.Pan2Click(Sender: TObject);
6836
6837 procedure SetShow(c: Array of TWinControl; i: Integer; b: Boolean);
6838 begin
6839 if c[i] is TPanel then
6840 begin
6841 with c[i] as TPanel do
6842 begin
6843 Visible:=b;
6844 {if IsFloat then
6845 FloatWindow.Visible := b
6846 else
6847 begin
6848 if b then
6849 AddToDock(Parent as TPanel);
6850 Visible := b;
6851 (Parent as TPanel).AdjustBounds;
6852 end; }
6853 end;
6854 end
6855 else TForm(c[i]).Visible:=b;
6856 end;
6857
6858 begin // each toolbar
6859 with Sender as TMenuItem do
6860 begin
6861 Checked := not Checked;
6862 SetShow([Panel1, Panel2, Panel3, Panel4, Panel5, ObjInsp, Panel6], Tag, Checked);
6863 end;
6864 end;
6865
6866 procedure TfrDesignerForm.N34Click(Sender: TObject);
6867 begin // about box
6868 frAboutForm := TfrAboutForm.Create(nil);
6869 frAboutForm.ShowModal;
6870 frAboutForm.Free;
6871 end;
6872
6873 procedure TfrDesignerForm.Tab1MouseDown(Sender: TObject;
6874 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
6875 var
6876 p: TPoint;
6877 begin
6878 GetCursorPos(p{%H-});
6879
6880 if Button = mbRight then
6881 Popup2.PopUp(p.X,p.Y);
6882
6883 //**
6884 {if Button = mbRight then
6885 TrackPopupMenu(Popup2.Handle,
6886 TPM_LEFTALIGN or TPM_RIGHTBUTTON, p.X, p.Y, 0, Handle, nil);
6887 }
6888 end;
6889
6890 procedure TfrDesignerForm.frDesignerFormClose(Sender: TObject;
6891 var CloseAction: TCloseAction);
6892 begin
6893 ObjInsp.ShowHint := False;
6894 end;
6895
6896 procedure TfrDesignerForm.frDesignerFormCloseQuery(Sender: TObject;
6897 var CanClose: boolean);
6898 var
6899 Res:integer;
6900 begin
6901 // if FileModified and (CurReport<>nil) and
6902 if (not PreparedReportEditor) and Modified and (CurReport<>nil) and
6903 (not ((csDesigning in CurReport.ComponentState) and CurReport.StoreInForm)) then
6904 begin
6905 Res:=Application.MessageBox(PChar(sSaveChanges + ' ' + sTo + ' ' + ExtractFileName(CurDocName) + '?'),
6906 PChar(sConfirm), mb_IconQuestion + mb_YesNoCancel);
6907
6908 case Res of
6909 mrNo:
6910 begin
6911 CanClose := True;
6912 // FileModified := False; // no means don't want changes
6913 Modified := False; // no means don't want changes
6914 ModalResult := mrCancel;
6915 end;
6916 mrYes:
6917 begin
6918 FileSave.Execute;
6919 // FileBtn3Click(nil);
6920 // CanClose := not FileModified;
6921 CanClose := not Modified;
6922 end;
6923 else
6924 CanClose := False;
6925 end;
6926 end;
6927 end;
6928
6929 {----------------------------------------------------------------------------}
6930 // state storing/retrieving
6931 const
6932 rsGridShow = 'GridShow';
6933 rsGridAlign = 'GridAlign';
6934 rsGridSize = 'GridSize';
6935 rsGuidesShow = 'GuidesShow';
6936 rsUnits = 'Units';
6937 rsButtons = 'GrayButtons';
6938 rsEdit = 'EditAfterInsert';
6939 rsSelection = 'Selection';
6940
6941
6942 procedure TfrDesignerForm.SaveState;
6943 var
6944 Ini:TIniFile;
6945
6946 procedure DoSaveToolbars(t: Array of TPanel);
6947 var
6948 i: Integer;
6949 begin
6950 for i := Low(t) to High(t) do
6951 begin
6952 { if FirstInstance or (t[i] <> Panel6) then
6953 SaveToolbarPosition(t[i]);
6954 t[i].IsVisible:= False;}
6955 end;
6956 end;
6957
6958 begin
6959 Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
6960 Ini.WriteString('frEditorForm', 'ScriptFontName', edtScriptFontName);
6961 Ini.WriteInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
6962
6963 Ini.WriteBool('frEditorForm', rsGridShow, ShowGrid);
6964 Ini.WriteBool('frEditorForm', rsGridAlign, GridAlign);
6965 Ini.WriteBool('frEditorForm', rsGuidesShow, ShowGuides);
6966 Ini.WriteInteger('frEditorForm', rsGridSize, GridSize);
6967 Ini.WriteInteger('frEditorForm', rsUnits, Word(Units));
6968 Ini.WriteBool('frEditorForm', rsButtons, GrayedButtons);
6969 Ini.WriteBool('frEditorForm', rsEdit, EditAfterInsert);
6970 Ini.WriteInteger('frEditorForm', rsSelection, Integer(ShapeMode));
6971 Ini.WriteBool('frEditorForm', 'UseInplaceEditor', edtUseIE);
6972 Ini.WriteString('frEditorForm', 'LastOpenDirectory', FLastOpenDirectory);
6973 Ini.WriteString('frEditorForm', 'LastSaveDirectory', FLastSaveDirectory);
6974
6975 DoSaveToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
6976
6977 // Save ObjInsp Position
6978 Ini.WriteInteger('ObjInsp', 'Left', ObjInsp.Left);
6979 Ini.WriteInteger('ObjInsp', 'Top', ObjInsp.Top);
6980 { if IEButton.Caption = '+' then
6981 Ini.WriteInteger('Position', 'Height', FLastHeight)
6982 else
6983 Ini.WriteInteger('Position', 'Height', Height);}
6984 Ini.WriteInteger('ObjInsp', 'Width', ObjInsp.Width);
6985 Ini.WriteBool('ObjInsp', 'Visible', ObjInsp.Visible);
6986
6987 Ini.Free;
6988 // ObjInsp.Visible:=False;
6989 end;
6990
6991 procedure TfrDesignerForm.RestoreState;
6992 var
6993 Ini:TIniFile;
6994
6995 {var
6996 Ini: TRegIniFile;
6997 Nm: String;
6998
6999 //** procedure DoRestoreToolbars(t: Array of TPanel);
7000 var
7001 i: Integer;
7002 begin
7003 for i := Low(t) to High(t) do
7004 RestoreToolbarPosition(t[i]);
7005 end;
7006 }
7007 begin
7008 if FileExistsUTF8(IniFileName) then
7009 begin
7010 Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
7011 edtScriptFontName:=Ini.ReadString('frEditorForm', 'ScriptFontName', edtScriptFontName);
7012 edtScriptFontSize:=Ini.ReadInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
7013 GridSize := Ini.ReadInteger('frEditorForm', rsGridSize, 4);
7014 GridAlign := Ini.ReadBool('frEditorForm', rsGridAlign, True);
7015 ShowGrid := Ini.ReadBool('frEditorForm', rsGridShow, True);
7016 ShowGuides := Ini.ReadBool('frEditorForm', rsGuidesShow, true);
7017 Units := TfrReportUnits(Ini.ReadInteger('frEditorForm', rsUnits, 0));
7018 // GrayedButtons := Ini.ReadBool('frEditorForm', rsButtons, False);
7019 EditAfterInsert := Ini.ReadBool('frEditorForm', rsEdit, True);
7020 ShapeMode := TfrShapeMode(Ini.ReadInteger('frEditorForm', rsSelection, 1));
7021 edtUseIE:=Ini.ReadBool('frEditorForm', 'UseInplaceEditor', edtUseIE);
7022 FLastOpenDirectory := Ini.ReadString('frEditorForm', 'LastOpenDirectory', '');
7023 FLastSaveDirectory := Ini.ReadString('frEditorForm', 'LastSaveDirectory', '');
7024
7025 ObjInsp.Left:=Ini.ReadInteger('ObjInsp', 'Left', ObjInsp.Left);
7026 ObjInsp.Top:=Ini.ReadInteger('ObjInsp', 'Top', ObjInsp.Top);
7027 { if IEButton.Caption = '+' then
7028 Ini.WriteInteger('Position', 'Height', FLastHeight)
7029 else
7030 Ini.WriteInteger('Position', 'Height', Height);}
7031 ObjInsp.Width:=Ini.ReadInteger('ObjInsp', 'Width', ObjInsp.Width);
7032 ObjInsp.Visible:=Ini.ReadBool('ObjInsp', 'Visible', ObjInsp.Visible);
7033
7034 Ini.Free;
7035 end;
7036
7037 { Ini := TRegIniFile.Create(RegRootKey);
7038 Nm := rsForm + Name;
7039 Ini.Free;
7040 //** DoRestoreToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
7041 if Panel6.Height < 26 then
7042 Panel6.Height := 26;
7043 if Panel6.Width < 26 then
7044 Panel6.Width := 26;
7045 if Panel6.ControlCount < 2 then
7046 Panel6.Hide;
7047 frDock1.AdjustBounds;
7048 frDock2.AdjustBounds;
7049 frDock3.AdjustBounds;
7050 frDock4.AdjustBounds;
7051 RestoreFormPosition(InspForm);
7052 }
7053 //TODO: restore ObjInsp position and size
7054 (*
7055 GridSize := 4;
7056 GridAlign := True;
7057 ShowGrid := False; //True;
7058 Units := TfrReportUnits(0);
7059 //GrayedButtons := True; //False;
7060 EditAfterInsert := True;
7061 ShapeMode := TfrShapeMode(1);
7062 *)
7063
7064 if Panel6.Height < 26 then
7065 Panel6.Height := 26;
7066 if Panel6.Width < 26 then
7067 Panel6.Width := 26;
7068 if Panel6.ControlCount < 2 then
7069 Panel6.Hide;
7070 end;
7071
7072
7073 {----------------------------------------------------------------------------}
7074 // menu bitmaps
7075 procedure TfrDesignerForm.SetMenuBitmaps;
7076 begin
7077 MaxItemWidth := 0; MaxShortCutWidth := 0;
7078
7079 FillMenuItems(FileMenu);
7080 FillMenuItems(EditMenu);
7081 FillMenuItems(ToolMenu);
7082 FillMenuItems(HelpMenu);
7083
7084 SetMenuItemBitmap(N23, FileBtn1);
7085 // SetMenuItemBitmap(N19, FileBtn2);
7086 // SetMenuItemBitmap(N20, FileBtn3);
7087 // SetMenuItemBitmap(N39, FileBtn4);
7088 SetMenuItemBitmap(N10, ExitB);
7089
7090 SetMenuItemBitmap(N11, CutB);
7091 SetMenuItemBitmap(N12, CopyB);
7092 SetMenuItemBitmap(N13, PstB);
7093 SetMenuItemBitmap(N28, SelAllB);
7094 SetMenuItemBitmap(N29, PgB1);
7095 SetMenuItemBitmap(N30, PgB2);
7096 SetMenuItemBitmap(N32, ZB1);
7097 SetMenuItemBitmap(N33, ZB2);
7098 SetMenuItemBitmap(N35, HelpBtn);
7099 {
7100 for i := 0 to Panel6.ControlCount-1 - 1 do
7101 begin
7102 if Panel6.Controls[i] is TSpeedButton then
7103 SetMenuItemBitmap(MastMenu.Items[i], Panel6.Controls[i] as TSpeedButton);
7104 end;
7105 }
7106 SetMenuItemBitmap(N41, PgB1);
7107 SetMenuItemBitmap(N43, PgB2);
7108 SetMenuItemBitmap(N44, PgB3);
7109 end;
7110
FindMenuItemnull7111 function TfrDesignerForm.FindMenuItem(AMenuItem: TMenuItem): TfrMenuItemInfo;
7112 var
7113 i: Integer;
7114 begin
7115 Result := nil;
7116 for i := 0 to MenuItems.Count - 1 do
7117 if TfrMenuItemInfo(MenuItems[i]).MenuItem = AMenuItem then
7118 begin
7119 Result := TfrMenuItemInfo(MenuItems[i]);
7120 Exit;
7121 end;
7122 end;
7123
7124 procedure TfrDesignerForm.SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn: TSpeedButton);
7125 var
7126 m: TfrMenuItemInfo;
7127 begin
7128 m := FindMenuItem(AMenuItem);
7129 if m = nil then
7130 begin
7131 m := TfrMenuItemInfo.Create;
7132 m.MenuItem := AMenuItem;
7133 MenuItems.Add(m);
7134 end;
7135 m.Btn := ABtn;
7136 //**
7137 { ModifyMenu(AMenuItem.Parent.Handle, AMenuItem.MenuIndex,
7138 MF_BYPOSITION + MF_OWNERDRAW, AMenuItem.Command, nil);
7139 }
7140 end;
7141
7142 procedure TfrDesignerForm.FillMenuItems(MenuItem: TMenuItem);
7143 var
7144 i: Integer;
7145 m: TMenuItem;
7146 begin
7147 for i := 0 to MenuItem.Count - 1 do
7148 begin
7149 m := MenuItem.Items[i];
7150 SetMenuItemBitmap(m, nil);
7151 if m.Count > 0 then FillMenuItems(m);
7152 end;
7153 end;
7154
7155 procedure TfrDesignerForm.DeleteMenuItems(MenuItem: TMenuItem);
7156 var
7157 i, j: Integer;
7158 m: TMenuItem;
7159 begin
7160 for i := 0 to MenuItem.Count - 1 do
7161 begin
7162 m := MenuItem.Items[i];
7163 for j := 0 to MenuItems.Count - 1 do
7164 if TfrMenuItemInfo(MenuItems[j]).MenuItem = m then
7165 begin
7166 TfrMenuItemInfo(MenuItems[j]).Free;
7167 MenuItems.Delete(j);
7168 break;
7169 end;
7170 end;
7171 end;
7172
7173 procedure TfrDesignerForm.DoDrawText(aCanvas: TCanvas; aCaption: string;
7174 Rect: TRect; Selected, aEnabled: Boolean; Flags: Longint);
7175 begin
7176 with aCanvas do
7177 begin
7178 Brush.Style := bsClear;
7179 if not aEnabled then
7180 begin
7181 if not Selected then
7182 begin
7183 OffsetRect(Rect, 1, 1);
7184 Font.Color := clBtnHighlight;
7185 DrawText(Handle, PChar(Caption), Length(Caption), Rect, Flags);
7186 OffsetRect(Rect, -1, -1);
7187 end;
7188 Font.Color := clBtnShadow;
7189 end;
7190 DrawText(Handle, PChar(aCaption), Length(aCaption), Rect, Flags);
7191
7192 Brush.Style := bsSolid;
7193 end;
7194 end;
7195
7196 procedure TfrDesignerForm.DrawItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
7197 ARect: TRect; Selected: Boolean);
7198 var
7199 GlyphRect: TRect;
7200 Btn: TSpeedButton;
7201 Glyph: TBitmap;
7202 begin
7203 MaxItemWidth := 0;
7204 MaxShortCutWidth := 0;
7205 with ACanvas do
7206 begin
7207 if Selected then
7208 begin
7209 Brush.Color := clHighlight;
7210 Font.Color := clHighlightText
7211 end
7212 else
7213 begin
7214 Brush.Color := clMenu;
7215 Font.Color := clMenuText;
7216 end;
7217 if AMenuItem.Caption <> '-' then
7218 begin
7219 FillRect(ARect);
7220 Btn := FindMenuItem(AMenuItem).Btn;
7221 GlyphRect := Bounds(ARect.Left + 1, ARect.Top + (ARect.Bottom - ARect.Top - 16) div 2, 16, 16);
7222
7223 if AMenuItem.Checked then
7224 begin
7225 Glyph := TBitmap.Create;
7226 if AMenuItem.RadioItem then
7227 begin
7228 // todo
7229 //** Glyph.Handle := LoadBitmap(hInstance, 'FR_RADIO');
7230 //BrushCopy(GlyphRect, Glyph, Rect(0, 0, 16, 16), Glyph.TransparentColor);
7231 end
7232 else
7233 begin
7234 //** Glyph.Handle := LoadBitmap(hInstance, 'FR_CHECK');
7235 Draw(GlyphRect.Left, GlyphRect.Top, Glyph);
7236 end;
7237 Glyph.Free;
7238 end
7239 else if Btn <> nil then
7240 begin
7241 Glyph := TBitmap.Create;
7242 Glyph.Width := 16; Glyph.Height := 16;
7243 // todo
7244 //** Btn.DrawGlyph(Glyph.Canvas, 0, 0, AMenuItem.Enabled);
7245 //BrushCopy(GlyphRect, Glyph, Rect(0, 0, 16, 16), Glyph.TransparentColor);
7246 Glyph.Free;
7247 end;
7248 ARect.Left := GlyphRect.Right + 4;
7249 end;
7250
7251 if AMenuItem.Caption <> '-' then
7252 begin
7253 OffsetRect(ARect, 0, 2);
7254 DoDrawText(ACanvas, AMenuItem.Caption, ARect, Selected, AMenuItem.Enabled, DT_LEFT);
7255 if AMenuItem.ShortCut <> 0 then
7256 begin
7257 ARect.Left := StrToInt(ItemWidths.Values[AMenuItem.Parent.Name]) + 6;
7258 DoDrawText(ACanvas, ShortCutToText(AMenuItem.ShortCut), ARect,
7259 Selected, AMenuItem.Enabled, DT_LEFT);
7260 end;
7261 end
7262 else
7263 begin
7264 Inc(ARect.Top, 4);
7265 DrawEdge(Handle, ARect, EDGE_ETCHED, BF_TOP);
7266 end;
7267 end;
7268 end;
7269
7270 procedure TfrDesignerForm.MeasureItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
7271 var AWidth, AHeight: Integer);
7272 var
7273 w: Integer;
7274 begin
7275 w := ACanvas.TextWidth(AMenuItem.Caption) + 31;
7276 if MaxItemWidth < w then
7277 MaxItemWidth := w;
7278 ItemWidths.Values[AMenuItem.Parent.Name] := IntToStr(MaxItemWidth);
7279
7280 if AMenuItem.ShortCut <> 0 then
7281 begin
7282 w := ACanvas.TextWidth(ShortCutToText(AMenuItem.ShortCut)) + 15;
7283 if MaxShortCutWidth < w then
7284 MaxShortCutWidth := w;
7285 end;
7286
7287 if frGetWindowsVersion = '98' then
7288 AWidth := MaxItemWidth
7289 else
7290 AWidth := MaxItemWidth + MaxShortCutWidth;
7291 if AMenuItem.Caption <> '-' then
7292 AHeight := 19 else
7293 AHeight := 10;
7294 end;
7295
7296 procedure TfrDesignerForm.WndProc(var Message: TLMessage);
7297 //var
7298 //MenuItem: TMenuItem;
7299 //CCanvas: TCanvas;
7300
7301 function FindItem(ItemId: Integer): TMenuItem;
7302 begin
7303 Result := MainMenu1.FindItem(ItemID, fkCommand);
7304 if Result = nil then
7305 Result := Popup1.FindItem(ItemID, fkCommand);
7306 if Result = nil then
7307 Result := Popup2.FindItem(ItemID, fkCommand);
7308 end;
7309
7310 begin
7311 case Message.Msg of
7312 LM_COMMAND:
7313 if Popup1.DispatchCommand(Message.wParam) or
7314 Popup2.DispatchCommand(Message.wParam) then Exit;
7315 //**
7316 { LM_INITMENUPOPUP:
7317 with TWMInitMenuPopup(Message) do
7318 if Popup1.DispatchPopup(MenuPopup) or
7319 Popup2.DispatchPopup(MenuPopup) then Exit;
7320 }
7321 (*
7322 LM_DRAWITEM:
7323 with PDrawItemStruct(Message.LParam)^ do
7324 begin
7325 if (CtlType = ODT_MENU) and (Message.WParam = 0) then
7326 begin
7327 MenuItem := FindItem(ItemId);
7328 if MenuItem <> nil then
7329 begin
7330 CCanvas := TControlCanvas.Create;
7331 with CCanvas do
7332 begin
7333 Handle := _hDC;
7334 DrawItem(MenuItem, CCanvas, rcItem, ItemState{//** and ODS_SELECTED} <> 0);
7335 Free;
7336 end;
7337 Exit;
7338 end;
7339 end;
7340 end;
7341 LM_MEASUREITEM:
7342 with PMeasureItemStruct(Message.LParam)^ do
7343 begin
7344 if (CtlType = ODT_MENU) and (Message.WParam = 0) then
7345 begin
7346 MenuItem := FindItem(ItemId);
7347 if MenuItem <> nil then
7348 begin
7349 MeasureItem(MenuItem, Canvas, Integer(ItemWidth), Integer(ItemHeight));
7350 Exit;
7351 end;
7352 end;
7353 end;
7354 *)
7355 end;
7356 inherited WndProc(Message);
7357 end;
7358
7359
7360 {----------------------------------------------------------------------------}
7361 // alignment palette
7362 function GetFirstSelected: TfrView;
7363 begin
7364 if TfrDesignerForm(frDesigner).FirstSelected <> nil then
7365 Result := TfrDesignerForm(frDesigner).FirstSelected
7366 else
7367 Result :=TfrView(Objects[TopSelected]);
7368 end;
7369
7370 function GetLeftObject: Integer;
7371 var
7372 i: Integer;
7373 t: TfrView;
7374 x: Integer;
7375 begin
7376 t := TfrView(Objects[TopSelected]);
7377 x := t.x;
7378 Result := TopSelected;
7379 for i := 0 to Objects.Count - 1 do
7380 begin
7381 t := TfrView(Objects[i]);
7382 if t.Selected then
7383 if t.x < x then
7384 begin
7385 x := t.x;
7386 Result := i;
7387 end;
7388 end;
7389 end;
7390
7391 function GetRightObject: Integer;
7392 var
7393 i: Integer;
7394 t: TfrView;
7395 x: Integer;
7396 begin
7397 t :=TfrView(Objects[TopSelected]);
7398 x := t.x + t.dx;
7399 Result := TopSelected;
7400 for i := 0 to Objects.Count - 1 do
7401 begin
7402 t := TfrView(Objects[i]);
7403 if t.Selected then
7404 if t.x + t.dx > x then
7405 begin
7406 x := t.x + t.dx;
7407 Result := i;
7408 end;
7409 end;
7410 end;
7411
7412 function GetTopObject: Integer;
7413 var
7414 i: Integer;
7415 t: TfrView;
7416 y: Integer;
7417 begin
7418 t := TfrView(Objects[TopSelected]);
7419 y := t.y;
7420 Result := TopSelected;
7421 for i := 0 to Objects.Count - 1 do
7422 begin
7423 t := TfrView(Objects[i]);
7424 if t.Selected then
7425 if t.y < y then
7426 begin
7427 y := t.y;
7428 Result := i;
7429 end;
7430 end;
7431 end;
7432
7433 function GetBottomObject: Integer;
7434 var
7435 i: Integer;
7436 t: TfrView;
7437 y: Integer;
7438 begin
7439 t := TfrView(Objects[TopSelected]);
7440 y := t.y + t.dy;
7441 Result := TopSelected;
7442 for i := 0 to Objects.Count - 1 do
7443 begin
7444 t := TfrView(Objects[i]);
7445 if t.Selected then
7446 if t.y + t.dy > y then
7447 begin
7448 y := t.y + t.dy;
7449 Result := i;
7450 end;
7451 end;
7452 end;
7453
7454 procedure TfrDesignerForm.Align1Click(Sender: TObject);
7455 var
7456 i: Integer;
7457 t: TfrView;
7458 x: Integer;
7459 begin
7460 if SelNum < 2 then Exit;
7461 BeforeChange;
7462 t := GetFirstSelected;
7463 x := t.x;
7464 for i := 0 to Objects.Count - 1 do
7465 begin
7466 t := TfrView(Objects[i]);
7467 if t.Selected then
7468 t.x := x;
7469 end;
7470 PageView.GetMultipleSelected;
7471 RedrawPage;
7472 end;
7473
7474 procedure TfrDesignerForm.Align6Click(Sender: TObject);
7475 var
7476 i: Integer;
7477 t: TfrView;
7478 y: Integer;
7479 begin
7480 if SelNum < 2 then Exit;
7481 BeforeChange;
7482 t := GetFirstSelected;
7483 y := t.y;
7484 for i := 0 to Objects.Count - 1 do
7485 begin
7486 t := TfrView(Objects[i]);
7487 if t.Selected then
7488 t.y := y;
7489 end;
7490 PageView.GetMultipleSelected;
7491 RedrawPage;
7492 end;
7493
7494 procedure TfrDesignerForm.Align5Click(Sender: TObject);
7495 var
7496 i: Integer;
7497 t: TfrView;
7498 x: Integer;
7499 begin
7500 if SelNum < 2 then Exit;
7501 BeforeChange;
7502 t := GetFirstSelected;
7503 x := t.x+t.dx;
7504 for i := 0 to Objects.Count - 1 do
7505 begin
7506 t := TfrView(Objects[i]);
7507 if t.Selected then
7508 t.x := x - t.dx;
7509 end;
7510 PageView.GetMultipleSelected;
7511 RedrawPage;
7512 end;
7513
7514 procedure TfrDesignerForm.Align10Click(Sender: TObject);
7515 var
7516 i: Integer;
7517 t: TfrView;
7518 y: Integer;
7519 begin
7520 if SelNum < 2 then Exit;
7521 BeforeChange;
7522 t := GetFirstSelected;
7523 y := t.y + t.dy;
7524 for i := 0 to Objects.Count - 1 do
7525 begin
7526 t := TfrView(Objects[i]);
7527 if t.Selected then
7528 t.y := y - t.dy;
7529 end;
7530 PageView.GetMultipleSelected;
7531 RedrawPage;
7532 end;
7533
7534 procedure TfrDesignerForm.Align2Click(Sender: TObject);
7535 var
7536 i: Integer;
7537 t: TfrView;
7538 x: Integer;
7539 begin
7540 if SelNum < 2 then Exit;
7541 BeforeChange;
7542 t := GetFirstSelected;
7543 x := t.x + t.dx div 2;
7544 for i := 0 to Objects.Count - 1 do
7545 begin
7546 t := TfrView(Objects[i]);
7547 if t.Selected then
7548 t.x := x - t.dx div 2;
7549 end;
7550 PageView.GetMultipleSelected;
7551 RedrawPage;
7552 end;
7553
7554 procedure TfrDesignerForm.Align7Click(Sender: TObject);
7555 var
7556 i: Integer;
7557 t: TfrView;
7558 y: Integer;
7559 begin
7560 if SelNum < 2 then Exit;
7561 BeforeChange;
7562 t := GetFirstSelected;
7563 y := t.y + t.dy div 2;
7564 for i := 0 to Objects.Count - 1 do
7565 begin
7566 t := TfrView(Objects[i]);
7567 if t.Selected then
7568 t.y := y - t.dy div 2;
7569 end;
7570 PageView.GetMultipleSelected;
7571 RedrawPage;
7572 end;
7573
7574 procedure TfrDesignerForm.Align3Click(Sender: TObject);
7575 var
7576 i: Integer;
7577 t: TfrView;
7578 x: Integer;
7579 begin
7580 if SelNum = 0 then Exit;
7581 BeforeChange;
7582 t := TfrView(Objects[GetLeftObject]);
7583 x := t.x;
7584 t := TfrView(Objects[GetRightObject]);
7585 x := x + (t.x + t.dx - x - Page.PrnInfo.Pgw) div 2;
7586 for i := 0 to Objects.Count - 1 do
7587 begin
7588 t := TfrView(Objects[i]);
7589 if t.Selected then Dec(t.x, x);
7590 end;
7591 PageView.GetMultipleSelected;
7592 RedrawPage;
7593 end;
7594
7595 procedure TfrDesignerForm.Align8Click(Sender: TObject);
7596 var
7597 i: Integer;
7598 t: TfrView;
7599 y: Integer;
7600 begin
7601 if SelNum = 0 then Exit;
7602 BeforeChange;
7603 t := TfrView(Objects[GetTopObject]);
7604 y := t.y;
7605 t := TfrView(Objects[GetBottomObject]);
7606 y := y + (t.y + t.dy - y - Page.PrnInfo.Pgh) div 2;
7607 for i := 0 to Objects.Count - 1 do
7608 begin
7609 t := TfrView(Objects[i]);
7610 if t.Selected then Dec(t.y, y);
7611 end;
7612 PageView.GetMultipleSelected;
7613 RedrawPage;
7614 end;
7615
7616 procedure TfrDesignerForm.Align4Click(Sender: TObject);
7617 var
7618 s: TStringList;
7619 i, dx: Integer;
7620 t: TfrView;
7621 begin
7622 if SelNum < 3 then Exit;
7623 BeforeChange;
7624 s := TStringList.Create;
7625 s.Sorted := True;
7626 s.Duplicates := dupAccept;
7627 for i := 0 to Objects.Count - 1 do
7628 begin
7629 t := TfrView(Objects[i]);
7630 if t.Selected then s.AddObject(Format('%4.4d', [t.x]), t);
7631 end;
7632 dx := (TfrView(s.Objects[s.Count - 1]).x - TfrView(s.Objects[0]).x) div (s.Count - 1);
7633 for i := 1 to s.Count - 2 do
7634 TfrView(s.Objects[i]).x := TfrView(s.Objects[i-1]).x + dx;
7635 s.Free;
7636 PageView.GetMultipleSelected;
7637 RedrawPage;
7638 end;
7639
7640 procedure TfrDesignerForm.Align9Click(Sender: TObject);
7641 var
7642 s: TStringList;
7643 i, dy: Integer;
7644 t: TfrView;
7645 begin
7646 if SelNum < 3 then Exit;
7647 BeforeChange;
7648 s := TStringList.Create;
7649 s.Sorted := True;
7650 s.Duplicates := dupAccept;
7651 for i := 0 to Objects.Count - 1 do
7652 begin
7653 t := TfrView(Objects[i]);
7654 if t.Selected then s.AddObject(Format('%4.4d', [t.y]), t);
7655 end;
7656 dy := (TfrView(s.Objects[s.Count - 1]).y - TfrView(s.Objects[0]).y) div (s.Count - 1);
7657 for i := 1 to s.Count - 2 do
7658 TfrView(s.Objects[i]).y := TfrView(s.Objects[i - 1]).y + dy;
7659 s.Free;
7660 PageView.GetMultipleSelected;
7661 RedrawPage;
7662 end;
7663
7664
7665 {----------------------------------------------------------------------------}
7666 // miscellaneous
7667 function Objects: TFpList;
7668 begin
7669 if Assigned(frDesigner) and Assigned(frDesigner.Page) then
7670 Result := frDesigner.Page.Objects
7671 else
7672 Result := nil;
7673 end;
7674
7675 procedure frSetGlyph(aColor: TColor; sb: TSpeedButton; n: Integer);
7676 var
7677 b : TBitmap;
7678 s : TMemoryStream;
7679 r : TRect;
7680 t : TfrView;
7681 i : Integer;
7682 begin
7683 {$IFDEF DebugLR}
7684 DebugLn('frSetGlyph(%s,%s,%d)',[colortostring(acolor),sb.Name,n]);
7685 DebugLn('ColorLocked=%s sb.tag=%s',[dbgs(ColorLocked),dbgs(sb.tag)]);
7686 {$ENDIF}
7687 B:=sb.Glyph;
7688 b.Width := 32;
7689 b.Height:= 16;
7690 with b.Canvas do
7691 begin
7692 b.Canvas.Handle; // force handle creation
7693 Brush.Color:=clWhite;
7694 FillRect(ClipRect);
7695 r := Rect(n * 32, 0, n * 32 + 32, 16);
7696 CopyRect(Rect(0, 0, 32, 16),
7697 TfrDesignerForm(frDesigner).Image1.Picture.Bitmap.Canvas, r);
7698 // JRA: workaround for copyrect not using transparency
7699 // and bitmap using transparency only on reading stream
7700 S := TMemorystream.Create;
7701 B.SaveToStream(S);
7702 S.Position:=0;
7703 B.Transparent := True;
7704 B.LoadFromStream(S);
7705 S.Free;
7706
7707 if aColor = clNone then
7708 begin
7709 Brush.Color:=clBtnFace;
7710 Pen.Color :=clBtnFace;
7711 end
7712 else
7713 begin
7714 Brush.Color:=aColor;
7715 Pen.Color:=aColor;
7716 end;
7717 Rectangle(Rect(0,12,15,15));
7718 end;
7719
7720 i:=TopSelected;
7721 if (i>-1) and not ColorLocked then
7722 begin
7723 t := TfrView(Objects[i]);
7724 {$IFDEF DebugLR}
7725 DebugLn('frSetGlyph: TopSelected=%s', [t.Name]);
7726 {$ENDIF}
7727
7728 Case Sb.Tag of
7729 5 : t.FillColor:=aColor; {ClB1}
7730 17 : if (t is TfrCustomMemoView) then {ClB2}
7731 TfrCustomMemoView(t).Font.Color:=aColor;
7732 19 : t.FrameColor:=aColor; {ClB3}
7733 end;
7734 end;
7735 end;
7736
7737 function TopSelected: Integer;
7738 var
7739 i: Integer;
7740 begin
7741 if Assigned(Objects) then
7742 begin
7743 Result := Objects.Count - 1;
7744 for i := Objects.Count - 1 downto 0 do
7745 if TfrView(Objects[i]).Selected then
7746 begin
7747 Result := i;
7748 break;
7749 end;
7750 end
7751 else
7752 Result:=-1;
7753 end;
7754
7755 function frCheckBand(b: TfrBandType): Boolean;
7756 var
7757 i: Integer;
7758 t: TfrView;
7759 begin
7760 Result := False;
7761 for i := 0 to Objects.Count - 1 do
7762 begin
7763 t := TfrView(Objects[i]);
7764 if t.Typ = gtBand then
7765 if b = TfrBandView(t).BandType then
7766 begin
7767 Result := True;
7768 break;
7769 end;
7770 end;
7771 end;
7772
7773 function GetUnusedBand: TfrBandType;
7774 var
7775 b: TfrBandType;
7776 begin
7777 Result := btNone;
7778 for b := btReportTitle to btNone do
7779 if not frCheckBand(b) then
7780 begin
7781 Result := b;
7782 break;
7783 end;
7784 if Result = btNone then Result := btMasterData;
7785 end;
7786
7787 procedure SendBandsToDown;
7788 var
7789 i, j, n, k: Integer;
7790 t: TfrView;
7791 begin
7792 n := Objects.Count; j := 0; i := n - 1;
7793 k := 0;
7794 while j < n do
7795 begin
7796 t := TfrView(Objects[i]);
7797 if t.Typ = gtBand then
7798 begin
7799 Objects.Delete(i);
7800 Objects.Insert(0, t);
7801 Inc(k);
7802 end
7803 else Dec(i);
7804 Inc(j);
7805 end;
7806 for i := 0 to n - 1 do // sends btOverlay to back
7807 begin
7808 t := TfrView(Objects[i]);
7809 if (t.Typ = gtBand) and (TfrBandView(t).BandType = btOverlay) then
7810 begin
7811 Objects.Delete(i);
7812 Objects.Insert(0, t);
7813 break;
7814 end;
7815 end;
7816 i := 0; j := 0;
7817 while j < n do // sends btCrossXXX to front
7818 begin
7819 t := TfrView(Objects[i]);
7820 if (t.Typ = gtBand) and
7821 (TfrBandView(t).BandType in [btCrossHeader..btCrossFooter]) then
7822 begin
7823 Objects.Delete(i);
7824 Objects.Insert(k - 1, t);
7825 end
7826 else Inc(i);
7827 Inc(j);
7828 end;
7829 end;
7830
7831 procedure ClearClipBoard;
7832 var
7833 t: TfrView;
7834 begin
7835 if Assigned(ClipBd) then
7836 with ClipBd do
7837 while Count > 0 do
7838 begin
7839 t := TfrView(Items[0]);
7840 t.Free;
7841 Delete(0);
7842 end;
7843 end;
7844
7845 procedure GetRegion;
7846 var
7847 i: Integer;
7848 t: TfrView;
7849 R,R1: HRGN;
7850 begin
7851 ClipRgn := CreateRectRgn(0, 0, 0, 0);
7852 for i := 0 to Objects.Count - 1 do
7853 begin
7854 t := TfrView(Objects[i]);
7855 if t.Selected then
7856 begin
7857 R := t.GetClipRgn(rtExtended);
7858 R1:=CreateRectRgn(0, 0, 0, 0);
7859 CombineRgn(ClipRgn, R1, R, RGN_OR);
7860 DeleteObject(R);
7861 DeleteObject(R1);
7862 end;
7863 end;
7864 FirstChange := False;
7865 end;
7866
7867 procedure TfrDesignerForm.GetDefaultSize(var dx, dy: Integer);
7868 begin
7869 dx := 96;
7870 if GridSize = 18 then dx := 18 * 6;
7871 dy := 18;
7872 if GridSize = 18 then dy := 18;
7873 if LastFontSize in [12, 13] then dy := 20;
7874 if LastFontSize in [14..16] then dy := 24;
7875 end;
7876
7877
7878 procedure TfrDesignerForm.SB1Click(Sender: TObject);
7879 var
7880 d: Double;
7881 begin
7882 d := StrToFloat(E1.Text);
7883 d := d + 1;
7884 E1.Text := FloatToStrF(d, ffGeneral, 2, 2);
7885 DoClick(E1);
7886 end;
7887
7888 procedure TfrDesignerForm.SB2Click(Sender: TObject);
7889 var
7890 d: Double;
7891 begin
7892 d := StrToFloat(E1.Text);
7893 d := d - 1;
7894 if d <= 0 then d := 1;
7895 E1.Text := FloatToStrF(d, ffGeneral, 2, 2);
7896 DoClick(E1);
7897 end;
7898
7899 {type
7900 THackBtn = class(TSpeedButton);
7901 }
7902
7903 procedure TfrDesignerForm.HelpBtnClick(Sender: TObject);
7904 begin
7905 HelpBtn.Down := True;
7906 Screen.Cursor := crHelp;
7907 SetCaptureControl(Self);
7908 //** THackBtn(HelpBtn).FMouseInControl := False;
7909 HelpBtn.Invalidate;
7910 end;
7911
7912 procedure TfrDesignerForm.FormMouseDown(Sender: TObject;
7913 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
7914 var
7915 c: TControl;
7916 t: Integer;
7917 begin
7918 if HelpBtn.Down and (GetCaptureControl=Self) then
7919 SetCaptureControl(nil);
7920 HelpBtn.Down := False;
7921 Screen.Cursor := crDefault;
7922 c := FindControlAtPosition(Mouse.CursorPos, true);
7923 if (c <> nil) and (c <> HelpBtn) then
7924 begin
7925 t := c.Tag;
7926 if (c.Parent = Panel4) and (t > 4) then
7927 t := 5;
7928 if c.Parent = Panel4 then
7929 Inc(t, 430) else
7930 Inc(t, 400);
7931 //DebugLn('TODO: HelpContext for tag=%d',[t]);
7932 //** Application.HelpCommand(HELP_CONTEXTPOPUP, t);
7933 end;
7934 end;
7935
7936 procedure TfrDesignerForm.N22Click(Sender: TObject);
7937 begin
7938 //** Application.HelpCommand(HELP_FINDER, 0);
7939 end;
7940
7941 procedure TfrDesignerForm.OnActivateApp(Sender: TObject);
7942
7943 procedure SetWinZOrder(Form: TForm);
7944 begin
7945 SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
7946 SWP_NOSIZE or SWP_NOACTIVATE);
7947 end;
7948 begin
7949 // SetWinZOrder(InspForm);
7950 {//**
7951 if Panel1.IsFloat then SetWinZOrder(Panel1.FloatWindow);
7952 if Panel2.IsFloat then SetWinZOrder(Panel2.FloatWindow);
7953 if Panel3.IsFloat then SetWinZOrder(Panel3.FloatWindow);
7954 if Panel4.IsFloat then SetWinZOrder(Panel4.FloatWindow);
7955 if Panel5.IsFloat then SetWinZOrder(Panel5.FloatWindow);
7956 if Panel6.IsFloat then SetWinZOrder(Panel6.FloatWindow);
7957 }
7958 end;
7959
7960 procedure TfrDesignerForm.OnDeactivateApp(Sender: TObject);
7961
7962 procedure SetWinZOrder(Form: TForm);
7963 begin
7964 SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
7965 SWP_NOSIZE or SWP_NOACTIVATE);
7966 end;
7967
7968 begin
7969 if not Visible then Exit;
7970 // SetWinZOrder(InspForm);
7971 {//**
7972 if Panel1.IsFloat then SetWinZOrder(Panel1.FloatWindow);
7973 if Panel2.IsFloat then SetWinZOrder(Panel2.FloatWindow);
7974 if Panel3.IsFloat then SetWinZOrder(Panel3.FloatWindow);
7975 if Panel4.IsFloat then SetWinZOrder(Panel4.FloatWindow);
7976 if Panel5.IsFloat then SetWinZOrder(Panel5.FloatWindow);
7977 if Panel6.IsFloat then SetWinZOrder(Panel6.FloatWindow);
7978 }
7979 end;
7980
7981 Procedure InitGlobalDesigner;
7982 begin
7983 if Assigned(frDesigner) then
7984 Exit;
7985 frDesigner := TfrDesignerForm.Create(nil);
7986 end;
7987
7988 { TfrPanelObjectInspector }
7989
7990 {$IFNDEF EXTOI}
7991 procedure TfrObjectInspector.BtnClick(Sender: TObject);
7992 begin
7993 if Sender=fBtn then
7994 begin
7995 if fBtn.Caption='-' then
7996 begin
7997 fLastHeight:=Height;
7998 Height:=fPanelHeader.Height + 2*BorderWidth + 3;
7999 fBtn.Caption:='+';
8000 end
8001 else
8002 begin
8003 Height:=fLastHeight;
8004 fBtn.Caption:='-';
8005 end;
8006 end
8007 else Visible:=False;
8008 end;
8009
8010 procedure TfrObjectInspector.HeaderMDown(Sender: TOBject;
8011 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
8012 begin
8013 if Button=mbLeft then
8014 begin
8015 fDown:=True;
8016 if (x>4) and (x<fPanelHeader.Width-4) and (y<=16) then
8017 begin
8018 {$IFDEF DebugLR}
8019 debugLn('TfrObjectInspector.HeaderMDown()');
8020 {$ENDIF}
8021 fPanelHeader.Cursor:=crSize;
8022 // get absolute mouse position (X,Y can not be used, because they
8023 // are relative to what is moving)
8024 fPt:=Mouse.CursorPos;
8025 //DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt)]);
8026 end;
8027 end;
8028 end;
8029
8030 procedure TfrObjectInspector.HeaderMMove(Sender: TObject;
8031 Shift: TShiftState; X, Y: Integer);
8032 var
8033 NewPt: TPoint;
8034 begin
8035 if fDown then
8036 begin
8037 {$IFDEF DebugLR}
8038 debugLn('TfrObjectInspector.HeaderMMove()');
8039 {$ENDIF}
8040
8041 Case fPanelHeader.Cursor of
8042 crSize :
8043 begin
8044 NewPt:=Mouse.CursorPos;
8045 //DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt),' New=',dbgs(NewPt)]);
8046 SetBounds(Left+NewPt.X-fPt.X,Top+NewPt.Y-fPt.Y,Width,Height);
8047 fPt:=NewPt;
8048 end;
8049 end;
8050 end
8051 end;
8052
8053 procedure TfrObjectInspector.HeaderMUp(Sender: TOBject;
8054 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
8055 begin
8056 {$IFDEF DebugLR}
8057 DebugLn('TfrObjectInspector.HeaderMUp()');
8058 {$ENDIF}
8059 fDown:=False;
8060 fPanelHeader.Cursor:=crDefault;
8061 end;
8062
8063 {$ENDIF}
8064
8065 procedure TfrObjectInspector.CMVisibleChanged(var TheMessage: TLMessage);
8066 begin
8067 Inherited CMVisibleChanged(TheMessage);
8068
8069 if Visible then
8070 begin
8071 DoOnResize;
8072 BringToFront;
8073 Select(Objects);
8074 end;
8075 {$IFDEF DebugLR}
8076 debugLn('TfrObjectInspector.CMVisibleChanged: %s', [dbgs(Visible)]);
8077 {$ENDIF}
8078 end;
8079
8080 {$IFDEF EXTOI}
8081 procedure TfrObjectInspector.DoHide;
8082 begin
8083 //TODO Uncheck Menue Item
8084 end;
8085 {$ENDIF}
8086
8087 constructor TfrObjectInspector.Create(aOwner: TComponent);
8088 begin
8089 inherited Create(aOwner);
8090
8091 {$IFDEF EXTOI}
8092 Width :=220;
8093 Height :=300;
8094 Top :=Screen.Height div 2;
8095 Left :=40;
8096 Visible :=False;
8097 Caption := 'Object Inspector';
8098 FormStyle := fsStayOnTop;
8099 // create the ObjectInspector
8100 fPropertyGrid:=TCustomPropertiesGrid.Create(aOwner);
8101 with fPropertyGrid do
8102 begin
8103 Name :='PropertyGrid';
8104 Parent:=Self;
8105 align := alclient;
8106 ShowHint:=false; //cause problems in windows
8107 end;
8108
8109 {$ELSE}
8110
8111 Parent :=TWinControl(aOwner);
8112 Width :=220;
8113 Height :=300;
8114 Top :=120;
8115 Left :=40;
8116 Borderstyle :=bsNone;
8117 BevelInner :=bvLowered;
8118 BevelOuter :=bvRaised;
8119 BorderWidth :=1;
8120 Visible :=False;
8121
8122 fDown :=False;
8123
8124 fPanelHeader:=TPanel.Create(self);
8125 with fPanelHeader do
8126 begin
8127 Parent:=Self;
8128 Color :=clSilver;
8129 BorderStyle:=bsNone;
8130 BevelInner:=bvNone;
8131 BevelOuter:=bvNone;
8132 Caption:=sObjectInspector;
8133 AnchorSideLeft.Control := self;
8134 AnchorSideTop.Control := self;
8135 AnchorSideRight.Control := self;
8136 AnchorSideRight.Side := asrBottom;
8137 Anchors := [akTop, akLeft, akRight];
8138 Top := 0;
8139 Height := 18;
8140 OnMouseDown:=@HeaderMDown;
8141 OnMouseMove:=@HeaderMMove;
8142 OnMouseUp :=@HeaderMUp;
8143 end;
8144
8145 fBtn2:=TButton.Create(fPanelHeader);
8146 with fBtn2 do
8147 begin
8148 Parent:=fPanelHeader;
8149 AnchorSideTop.Control := fPanelHeader;
8150 AnchorSideRight.Control := fPanelHeader;
8151 AnchorSideRight.Side := asrBottom;
8152 AnchorSideBottom.Control := fPanelHeader;
8153 AnchorSideBottom.Side := asrBottom;
8154 Anchors := [akTop, akRight, akBottom];
8155 BorderSpacing.Around := 1;
8156 Width := fPanelHeader.Height - 2*BorderSpacing.Around;
8157 Caption:='x';
8158 TabStop:=False;
8159 OnClick:=@BtnClick;
8160 end;
8161
8162 fBtn:=TButton.Create(fPanelHeader);
8163 with fBtn do
8164 begin
8165 Parent:=fPanelHeader;
8166 AnchorSideTop.Control := fPanelHeader;
8167 AnchorSideRight.Control := fBtn2;
8168 AnchorSideBottom.Control := fPanelHeader;
8169 AnchorSideBottom.Side := asrBottom;
8170 Anchors := [akTop, akRight, akBottom];
8171 BorderSpacing.Around := 1;
8172 Width := fPanelHeader.Height - 2*BorderSpacing.Around;
8173 Caption:='-';
8174 TabStop:=False;
8175 OnClick:=@BtnClick;
8176 end;
8177
8178
8179 fcboxObjList := TComboBox.Create(Self);
8180 with fcboxObjList do
8181 begin
8182 Parent:=Self;
8183 AnchorSideLeft.Control := Self;
8184 AnchorSideTop.Control := fPanelHeader;
8185 AnchorSideTop.Side := asrBottom;
8186 AnchorSideRight.Control := self;
8187 AnchorSideRight.Side := asrBottom;
8188 Anchors := [akTop, akLeft, akRight];
8189 ShowHint := false; //cause problems in windows
8190 Onchange := @cboxObjListOnChanged;
8191 end;
8192 fcboxObjList.Sorted:=true;
8193
8194 // create the ObjectInspector
8195 fPropertyGrid:=TCustomPropertiesGrid.Create(aOwner);
8196 with fPropertyGrid do
8197 begin
8198 Name :='PropertyGrid';
8199 Parent:=Self;
8200 AnchorSideLeft.Control := Self;
8201 AnchorSideTop.Control := fcboxObjList;
8202 AnchorSideTop.Side := asrBottom;
8203 AnchorSideRight.Control := Self;
8204 AnchorSideRight.Side := asrBottom;
8205 AnchorSideBottom.Control := Self;
8206 AnchorSideBottom.Side := asrBottom;
8207 Anchors := [akTop, akLeft, akRight, akBottom];
8208 ShowHint:=false; //cause problems in windows
8209 fPropertyGrid.SaveOnChangeTIObject:=false;
8210 DefaultItemHeight := fcboxObjList.Height-3;
8211 end;
8212 {$ENDIF}
8213 end;
8214
8215 destructor TfrObjectInspector.Destroy;
8216 begin
8217 //fPropertyGrid.Free; // it's owned by OI form/Panel
8218 inherited Destroy;
8219 end;
8220
8221 procedure TfrObjectInspector.Select(Obj: TObject);
8222 var
8223 i : Integer;
8224 NewSel : TPersistentSelectionList;
8225 begin
8226 if (Objects.Count <> fcboxObjList.Items.Count) or (Assigned(Obj) and (fcboxObjList.Items.IndexOfObject(Obj) < 0)) then
8227 begin
8228
8229 fcboxObjList.Clear;
8230 fcboxObjList.AddItem(TfrObject(frDesigner.Page).Name, TObject(frDesigner.Page));
8231
8232 for i:=0 to Objects.Count-1 do
8233 fcboxObjList.AddItem(TfrView(Objects[i]).Name, TObject(Objects[i]));
8234
8235 end;
8236
8237 FSelectedObject:=nil;
8238
8239 if (Obj=nil) or (Obj is TPersistent) then
8240 begin
8241 FSelectedObject:=Obj;
8242 NewSel := TPersistentSelectionList.Create;
8243 try
8244 if Obj<>nil then
8245 begin
8246 fcboxObjList.ItemIndex := fcboxObjList.Items.IndexOfObject(Obj);
8247 NewSel.Add(TfrView(Obj));
8248 end;
8249 fPropertyGrid.Selection := NewSel
8250 finally
8251 NewSel.Free;
8252 end;
8253 end
8254 else
8255 if Obj is TFpList then
8256 with TFpList(Obj) do
8257 begin
8258 NewSel:=TPersistentSelectionList.Create;
8259 try
8260 for i:=0 to Count-1 do
8261 if TfrView(Items[i]).Selected then
8262 NewSel.Add(TfrView(Items[i]));
8263 fPropertyGrid.Selection:=NewSel;
8264 finally
8265 NewSel.Free;
8266 end;
8267 end;
8268 end;
8269
8270 procedure TfrObjectInspector.cboxObjListOnChanged(Sender: TObject);
8271 var
8272 i: Integer;
8273 vObj: TObject;
8274 begin
8275 if fcboxObjList.ItemIndex >= 0 then
8276 begin
8277 TfrDesignerForm(frDesigner).SelNum := 0;
8278 for i := 0 to Objects.Count - 1 do
8279 TfrView(Objects[i]).Selected := False;
8280 vObj := fcboxObjList.Items.Objects[fcboxObjList.ItemIndex];
8281 if vObj is TfrView then
8282 begin
8283 TfrView(vObj).Selected:=True;
8284 TfrDesignerForm(frDesigner).SelNum := 1;
8285 frDesigner.Invalidate;
8286 end;
8287 Select(vObj);
8288 end;
8289 end;
8290
8291 procedure TfrObjectInspector.SetModifiedEvent(AEvent: TNotifyEvent);
8292 begin
8293 fPropertyGrid.OnModified:=AEvent;
8294 end;
8295
8296 procedure TfrObjectInspector.Refresh;
8297 begin
8298 if not visible then
8299 exit;
8300 fPropertyGrid.RefreshPropertyValues;
8301 end;
8302
8303 type
8304 { TfrCustomMemoViewDetailReportProperty }
8305
8306 TfrCustomMemoViewDetailReportProperty = class(TStringProperty)
8307 private
8308 FSaveRep:TfrReport;
8309 FEditView:TfrCustomMemoView;
8310 FDetailRrep: TlrDetailReport;
8311 procedure DoSaveReportEvent(Report: TfrReport; var ReportName: String;
8312 SaveAs: Boolean; var Saved: Boolean);
8313 public
GetAttributesnull8314 function GetAttributes: TPropertyAttributes; override;
8315 procedure Edit; override;
8316 procedure GetValues(Proc: TGetStrProc); override;
8317 end;
8318
8319
8320 TfrViewDataFieldProperty = class(TStringProperty)
8321 public
GetAttributesnull8322 function GetAttributes: TPropertyAttributes; override;
8323 procedure Edit; override;
8324 end;
8325
8326 { TTfrBandViewChildProperty }
8327
8328 TTfrBandViewChildProperty = class(TStringProperty)
8329 public
GetAttributesnull8330 function GetAttributes: TPropertyAttributes; override;
8331 procedure GetValues(Proc: TGetStrProc); override;
8332 end;
8333
8334 { TTfrBandViewChildProperty }
8335
GetAttributesnull8336 function TTfrBandViewChildProperty.GetAttributes: TPropertyAttributes;
8337 begin
8338 Result:=inherited GetAttributes + [paValueList, paSortList];
8339 end;
8340
8341 procedure TTfrBandViewChildProperty.GetValues(Proc: TGetStrProc);
8342 var
8343 I: Integer;
8344 begin
8345 if Assigned(frDesigner) and Assigned(frDesigner.Page) then
8346 begin
8347 for i:=0 to frDesigner.Page.Objects.Count-1 do
8348 if TObject(frDesigner.Page.Objects[i]) is TfrBandView then
8349 if (TfrBandView(frDesigner.Page.Objects[i]).BandType = btChild) and
8350 (TfrBandView(GetComponent(0)) <> TfrBandView(frDesigner.Page.Objects[i])) then
8351 Proc(TfrBandView(frDesigner.Page.Objects[i]).Name);
8352 end;
8353 end;
8354
8355 { TfrPictureViewDataFieldProperty }
8356
GetAttributesnull8357 function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes;
8358 begin
8359 Result := inherited GetAttributes + [paDialog{, paValueList, paSortList}];
8360 end;
8361
8362 type
8363 TfrHackView = class(TfrView);
8364
8365 procedure TfrViewDataFieldProperty.Edit;
8366 begin
8367 if (GetComponent(0) is TfrView) and Assigned(CurReport) then
8368 begin
8369 frFieldsForm := TfrFieldsForm.Create(Application);
8370 try
8371 if frFieldsForm.ShowModal = mrOk then
8372 begin
8373 TfrHackView(GetComponent(0)).DataField:='[' + frFieldsForm.DBField + ']';
8374 frDesigner.Modified:=true;
8375 end;
8376 finally
8377 frFieldsForm.Free;
8378 end;
8379 end;
8380 end;
8381
8382 procedure TfrCustomMemoViewDetailReportProperty.DoSaveReportEvent(Report: TfrReport;
8383 var ReportName: String; SaveAs: Boolean; var Saved: Boolean);
8384 begin
8385 if Assigned(FDetailRrep) then
8386 begin
8387 FDetailRrep.ReportBody.Size:=0;
8388 CurReport.SaveToXMLStream(FDetailRrep.ReportBody);
8389 FDetailRrep.ReportDescription:=CurReport.Comments.Text;
8390 Saved:=true;
8391 end
8392 else
8393 Saved:=false;
8394 end;
8395
GetAttributesnull8396 function TfrCustomMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes;
8397 begin
8398 Result := inherited GetAttributes + [paDialog, paValueList, paSortList];
8399 end;
8400
8401 procedure TfrCustomMemoViewDetailReportProperty.Edit;
8402 var
8403 FSaveDesigner:TfrReportDesigner;
8404 FSaveView:TfrView;
8405 FSaveBand: TfrBand; // currently proceeded band
8406 FSavePage: TfrPage; // currently proceeded page
8407 FSaveGetPValue:TGetPValueEvent;
8408 FSaveFunEvent:TFunctionEvent;
8409 FSaveReportEvent: TSaveReportEvent;
8410 begin
8411 if (GetComponent(0) is TfrCustomMemoView) and Assigned(CurReport) then
8412 begin
8413 FEditView:=GetComponent(0) as TfrCustomMemoView;
8414
8415 if FEditView.DetailReport = '' then
8416 FEditView.DetailReport:=FEditView.Name + '_DetailReport';
8417 FDetailRrep:=CurReport.DetailReports.Add(FEditView.DetailReport);
8418 if not Assigned(FDetailRrep) then exit;
8419
8420 FSaveGetPValue:=frParser.OnGetValue;
8421 FSaveFunEvent:=frParser.OnFunction;
FSaveDesignernull8422 FSaveDesigner:=frDesigner;
8423 FSaveRep:=CurReport;
8424 FSaveView:=CurView;
8425 FSaveBand:=CurBand;
8426 FSavePage:=CurPage;
8427
8428 frDesigner:=nil;
8429
8430 CurReport:=TfrReport.Create(nil);
8431 CurReport.OnBeginBand:=FSaveRep.OnBeginBand;
8432 CurReport.OnBeginColumn:=FSaveRep.OnBeginColumn;
8433 CurReport.OnBeginDoc:=FSaveRep.OnBeginDoc;
8434 CurReport.OnBeginPage:=FSaveRep.OnBeginPage;
8435 CurReport.OnDBImageRead:=FSaveRep.OnDBImageRead;
8436 CurReport.OnEndBand:=FSaveRep.OnEndBand;
8437 CurReport.OnEndDoc:=FSaveRep.OnEndDoc;
8438 CurReport.OnEndPage:=FSaveRep.OnEndPage;
8439 CurReport.OnEnterRect:=FSaveRep.OnEnterRect;
8440 CurReport.OnExportFilterSetup:=FSaveRep.OnExportFilterSetup;
8441 CurReport.OnGetValue:=FSaveRep.OnGetValue;
8442 CurReport.OnManualBuild:=FSaveRep.OnManualBuild;
8443 CurReport.OnMouseOverObject:=FSaveRep.OnMouseOverObject;
8444 CurReport.OnObjectClick:=FSaveRep.OnObjectClick;
8445 CurReport.OnPrintColumn:=FSaveRep.OnPrintColumn;
8446 CurReport.OnProgress:=FSaveRep.OnProgress;
8447 CurReport.OnUserFunction:=FSaveRep.OnUserFunction;
8448
8449 FSaveReportEvent:=frDesignerComp.OnSaveReport;
8450 frDesignerComp.OnSaveReport:=@DoSaveReportEvent;
8451
8452 try
8453 FDetailRrep.ReportBody.Position:=0;
8454 if FDetailRrep.ReportBody.Size > 0 then
8455 CurReport.LoadFromXMLStream(FDetailRrep.ReportBody);
8456
8457 if CurReport.DesignReport = mrOk then
8458 begin
8459 FDetailRrep.ReportBody.Size:=0;
8460 CurReport.SaveToXMLStream(FDetailRrep.ReportBody);
8461 FDetailRrep.ReportDescription:=CurReport.Comments.Text;
8462 end;
8463
8464 if Assigned(frDesigner) then
8465 FreeAndNil(frDesigner);
8466 finally
8467 frDesigner := FSaveDesigner;
8468 CurReport := FSaveRep;
8469 CurView := FSaveView;
8470 CurBand := FSaveBand;
8471 CurPage := FSavePage;
8472 frParser.OnGetValue:=FSaveGetPValue;
8473 frParser.OnFunction:=FSaveFunEvent;
8474 frDesignerComp.OnSaveReport:=FSaveReportEvent;
8475
8476 frDesigner.Modified:=true;
8477 end;
8478 end;
8479 end;
8480
8481 procedure TfrCustomMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc);
8482 var
8483 I: Integer;
8484 begin
8485 if Assigned(CurReport) then
8486 begin
8487 for i:=0 to CurReport.DetailReports.Count-1 do
8488 Proc(CurReport.DetailReports.GetItem(i).ReportName);
8489 end;
8490 end;
8491
8492 type
8493
8494 { TlrInternalTools }
8495
8496 TlrInternalTools = class
8497 private
8498 lrBMPInsFields : TBitmap;
8499 procedure InsFieldsClick(Sender: TObject);
8500 procedure InsertFieldsFormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean);
8501 procedure InsertDbFields;
8502 public
8503 constructor Create;
8504 destructor Destroy; override;
8505 end;
8506
8507 var
8508 FlrInternalTools:TlrInternalTools = nil;
8509
8510 { TlrInternalTools }
8511
8512 procedure TlrInternalTools.InsFieldsClick(Sender: TObject);
8513 begin
8514 frInsertFieldsForm := TfrInsertFieldsForm.Create(nil);
8515 frInsertFieldsForm.OnCloseQuery := @InsertFieldsFormCloseQuery;
8516 Try
8517 frInsertFieldsForm.ShowModal;
8518 finally
8519 frInsertFieldsForm.Free;
8520 frInsertFieldsForm:=nil;
8521 end;
8522 end;
8523
8524 procedure TlrInternalTools.InsertFieldsFormCloseQuery(Sender: TObject;
8525 var CanClose: boolean);
8526 begin
8527 if (Sender=frInsertFieldsForm) and (frInsertFieldsForm.ModalResult=mrOk) then
8528 InsertDbFields;
8529 end;
8530
8531 procedure TlrInternalTools.InsertDbFields;
8532 var
8533 i, x, y, dx, dy, pdx, adx: Integer;
8534 HeaderL, DataL: TFpList;
8535 t, t1: TfrView;
8536 b: TfrBandView;
8537 f: TfrTField;
8538 f1: TFieldDef;
8539 fSize: Integer;
8540 fName: String;
8541
FindDatasetnull8542 function FindDataset(DataSet: TfrTDataSet): String;
8543 var
8544 i,j: Integer;
8545
EnumComponentsnull8546 function EnumComponents(f: TComponent): String;
8547 var
8548 i: Integer;
8549 c: TComponent;
8550 d: TfrDBDataSet;
8551 begin
8552 Result := '';
8553 for i := 0 to f.ComponentCount - 1 do
8554 begin
8555 c := f.Components[i];
8556 if c is TfrDBDataSet then
8557 begin
8558 d := c as TfrDBDataSet;
8559 if d.GetDataSet = DataSet then
8560 begin
8561 if d.Owner = CurReport.Owner then
8562 Result := d.Name else
8563 Result := d.Owner.Name + '.' + d.Name;
8564 break;
8565 end;
8566 end;
8567 end;
8568 end;
8569
8570 begin
8571 Result := '';
8572 for i := 0 to Screen.FormCount - 1 do
8573 begin
8574 Result := EnumComponents(Screen.Forms[i]);
8575 if Result <> '' then Exit;
8576 end;
8577
8578 with Screen do
8579 begin
8580 for i := 0 to CustomFormCount - 1 do
8581 with CustomForms[i] do
8582 if (ClassName = 'TDataModuleForm') then
8583 for j := 0 to ComponentCount - 1 do
8584 begin
8585 if (Components[j] is TDataModule) then
8586 Result:=EnumComponents(Components[j]);
8587 if Result <> '' then Exit;
8588 end;
8589 end;
8590 end;
8591 begin
8592 if frInsertFieldsForm=nil then
8593 exit;
8594
8595 with frInsertFieldsForm do
8596 begin
8597 if (DataSet=nil) or (FieldsL.Items.Count = 0) or (FieldsL.SelCount = 0) then
8598 exit;
8599
8600 HeaderL := TFpList.Create;
8601 DataL := TFpList.Create;
8602 try
8603 x := frDesigner.Page.LeftMargin;
8604 y := frDesigner.Page.TopMargin;
8605 TfrDesignerForm(frDesigner).Unselect;
8606 TfrDesignerForm(frDesigner).SelNum := 0;
8607 for i := 0 to FieldsL.Items.Count - 1 do
8608 if FieldsL.Selected[i] then
8609 begin
8610 f := TfrTField(DataSet.FindField(FieldsL.Items[i]));
8611 fSize := 0;
8612 if f <> nil then
8613 begin
8614 fSize := f.DisplayWidth;
8615 fName := f.DisplayName;
8616 end
8617 else
8618 begin
8619 f1 := DataSet.FieldDefs[i];
8620 fSize := f1.Size;
8621 fName := f1.Name;
8622 end;
8623
8624 if (fSize = 0) or (fSize > 255) then
8625 fSize := 6;
8626
8627 t := frCreateObject(gtMemo, '', frDesigner.Page);
8628 t.CreateUniqueName;
8629 t.x := x;
8630 t.y := y;
8631 TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
8632 with t as TfrCustomMemoView do
8633 begin
8634 Font.Name := LastFontName;
8635 Font.Size := LastFontSize;
8636 if HeaderCB.Checked then
8637 Font.Style := [fsBold];
8638 MonitorFontChanges;
8639 end;
8640 TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrCustomMemoView(t).Font);
8641 t.Selected := True;
8642 Inc(TfrDesignerForm(frDesigner).SelNum);
8643 if HeaderCB.Checked then
8644 begin
8645 t.Memo.Add(fName);
8646 t.dx := TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth(fName + ' ') div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
8647 end
8648 else
8649 begin
8650 t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
8651 '."' + FieldsL.Items[i] + '"]');
8652 t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
8653 end;
8654 dx := t.dx;
8655 // TfrDesignerForm(frDesigner).Page.Objects.Add(t);
8656 if HeaderCB.Checked then
8657 HeaderL.Add(t) else
8658 DataL.Add(t);
8659 if HeaderCB.Checked then
8660 begin
8661 t := frCreateObject(gtMemo, '', TfrDesignerForm(frDesigner).Page);
8662 t.CreateUniqueName;
8663 t.x := x;
8664 t.y := y;
8665 TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
8666 if HorzRB.Checked then
8667 Inc(t.y, 72) else
8668 Inc(t.x, dx + TfrDesignerForm(frDesigner).GridSize * 2);
8669 with t as TfrCustomMemoView do
8670 begin
8671 Font.Name := LastFontName;
8672 Font.Size := LastFontSize;
8673 MonitorFontChanges;
8674 end;
8675 t.Selected := True;
8676 Inc(TfrDesignerForm(frDesigner).SelNum);
8677 t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
8678 '."' + FieldsL.Items[i] + '"]');
8679 t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
8680 // TfrDesignerForm(frDesigner).Page.Objects.Add(t);
8681 DataL.Add(t);
8682 end;
8683 if HorzRB.Checked then
8684 Inc(x, t.dx + TfrDesignerForm(frDesigner).GridSize)
8685 else
8686 Inc(y, t.dy + TfrDesignerForm(frDesigner).GridSize);
8687
8688 if t is TfrControl then
8689 TfrControl(T).UpdateControlPosition;
8690 end;
8691
8692 if HorzRB.Checked then
8693 begin
8694 t := TfrView(DataL[DataL.Count - 1]);
8695 adx := t.x + t.dx;
8696 pdx := TfrDesignerForm(frDesigner).Page.RightMargin - TfrDesignerForm(frDesigner).Page.LeftMargin;
8697 x := TfrDesignerForm(frDesigner).Page.LeftMargin;
8698 if adx > pdx then
8699 begin
8700 for i := 0 to DataL.Count - 1 do
8701 begin
8702 t := TfrView(DataL[i]);
8703 t.x := Round((t.x - x) / (adx / pdx)) + x;
8704 t.dx := Round(t.dx / (adx / pdx));
8705 end;
8706 if HeaderCB.Checked then
8707 for i := 0 to DataL.Count - 1 do
8708 begin
8709 t := TfrView(HeaderL[i]);
8710 t1 := TfrView(DataL[i]);
8711 t.x := Round((t.x - x) / (adx / pdx)) + x;
8712 if t.dx > t1.dx then
8713 t.dx := t1.dx;
8714 end;
8715 end;
8716 end;
8717
8718 if BandCB.Checked then
8719 begin
8720 if HeaderCB.Checked then
8721 t := TfrView(HeaderL[DataL.Count - 1])
8722 else
8723 t := TfrView(DataL[DataL.Count - 1]);
8724 dy := t.y + t.dy - TfrDesignerForm(frDesigner).Page.TopMargin;
8725 b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
8726 b.CreateUniqueName;
8727 b.y := TfrDesignerForm(frDesigner).Page.TopMargin;
8728 b.dy := dy;
8729 b.Selected := True;
8730 Inc(TfrDesignerForm(frDesigner).SelNum);
8731 if not HeaderCB.Checked or not HorzRB.Checked then
8732 begin
8733 // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
8734 b.BandType := btMasterData;
8735 b.DataSet := FindDataset(DataSet);
8736 end
8737 else
8738 begin
8739 if frCheckBand(btPageHeader) then
8740 begin
8741 Dec(TfrDesignerForm(frDesigner).SelNum);
8742 b.Free;
8743 end
8744 else
8745 begin
8746 b.BandType := btPageHeader;
8747 // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
8748 end;
8749 b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
8750 b.BandType := btMasterData;
8751 b.DataSet := FindDataset(DataSet);
8752 b.CreateUniqueName;
8753 b.y := TfrDesignerForm(frDesigner).Page.TopMargin + 72;
8754 b.dy := dy;
8755 b.Selected := True;
8756 Inc(TfrDesignerForm(frDesigner).SelNum);
8757 // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
8758 end;
8759 end;
8760 TfrDesignerForm(frDesigner).SelectionChanged;
8761 SendBandsToDown;
8762 TfrDesignerForm(frDesigner).PageView.GetMultipleSelected;
8763 TfrDesignerForm(frDesigner).RedrawPage;
8764 TfrDesignerForm(frDesigner).AddUndoAction(acInsert);
8765 finally
8766 HeaderL.Free;
8767 DataL.Free;
8768 end;
8769 end;
8770 end;
8771
8772 constructor TlrInternalTools.Create;
8773 begin
8774 inherited Create;
8775 lrBMPInsFields := TBitmap.Create;
8776 lrBMPInsFields.LoadFromResourceName(HInstance, 'lrd_ins_fields');
8777 frRegisterTool(sInsertFields, lrBMPInsFields, @InsFieldsClick);
8778 end;
8779
8780 destructor TlrInternalTools.Destroy;
8781 begin
8782 lrBMPInsFields.Free;
8783 inherited destroy;
8784 end;
8785
8786 initialization
8787 frDesigner:=nil;
8788 ProcedureInitDesigner:=@InitGlobalDesigner;
8789
8790 ClipBd := TFpList.Create;
8791 GridBitmap := TBitmap.Create;
8792 with GridBitmap do
8793 begin
8794 Width := 8; Height := 8;
8795 end;
8796 LastFrames:=[];
8797 LastFrameWidth := 1;
8798 LastLineWidth := 2;
8799 LastFillColor := clNone;
8800 LastFrameColor := clBlack;
8801 LastFontColor := clBlack;
8802 LastFontStyle := 0;
8803 LastAdjust := 0;
8804 //** RegRootKey := 'Software\FastReport\' + Application.Title;
8805
8806 RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty);
8807 RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty);
8808
8809 RegisterPropertyEditor(TypeInfo(String), TfrBandView, 'Child', TTfrBandViewChildProperty);
8810
8811 FlrInternalTools:=TlrInternalTools.Create;
8812 finalization
8813 If Assigned(frDesigner) then
8814 begin
8815 {$IFNDEF MODALDESIGNER}
8816 if frDesigner.Visible then
8817 frDesigner.Hide;
8818 {$ENDIF}
8819 frDesigner.Free;
8820 end;
8821 ClearClipBoard;
8822 ClipBd.Free;
8823 GridBitmap.Free;
8824 FreeAndNil(FlrInternalTools);
8825 end.
8826
8827