home *** CD-ROM | disk | FTP | other *** search
-
- {******************************************}
- { }
- { FastReport CLX v2.4 }
- { Report Designer }
- { }
- { Copyright (c) 1998-2001 by Tzyganenko A. }
- { }
- {******************************************}
-
- unit FR_Desgn;
-
- interface
-
- {$I FR.inc}
-
- uses
- SysUtils, Types, Classes, QGraphics, QControls,
- QForms, QDialogs, QStdCtrls, QButtons, QExtCtrls, QPrinters, QComCtrls,
- QMenus, QImgList, FR_Class, FR_Color,
- FR_Ctrls, FR_Dock, FR_Insp, FR_Flds1, FR_API, QTypes;
-
- const
- crPencil = 11;
-
- type
- TLoadReportEvent = procedure(Report: TfrReport; var ReportName: String;
- var Opened: Boolean) of object;
- TSaveReportEvent = procedure(Report: TfrReport; var ReportName: String;
- SaveAs: Boolean; var Saved: Boolean) of object;
-
- TfrDesignerForm = class;
-
- TfrDesigner = class(TComponent) // fake component
- private
- FCloseQuery: Boolean;
- FHideDisabledButtons: Boolean;
- FTemplDir: String;
- FOnLoadReport: TLoadReportEvent;
- FOnSaveReport: TSaveReportEvent;
- FOnShow: TNotifyEvent;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property CloseQuery: Boolean read FCloseQuery write FCloseQuery default True;
- property HideDisabledButtons: Boolean read FHideDisabledButtons write FHideDisabledButtons default True;
- property TemplateDir: String read FTemplDir write FTemplDir;
- property OnLoadReport: TLoadReportEvent read FOnLoadReport write FOnLoadReport;
- property OnSaveReport: TSaveReportEvent read FOnSaveReport write FOnSaveReport;
- property OnShow: TNotifyEvent read FOnShow write FOnShow;
- end;
-
- TfrSelectionType = (ssBand, ssMemo, ssOther, ssMultiple, ssClipboardFull);
- TfrSelectionStatus = set of TfrSelectionType;
- TfrReportUnits = (ruPixels, ruMM, ruInches);
- TfrShapeMode = (smFrame, smAll);
- TfrDesignerDrawMode = (dmAll, dmSelection, dmShape);
- TfrDesignerRestriction =
- (frdrDontEditObj, frdrDontModifyObj, frdrDontSizeObj, frdrDontMoveObj,
- frdrDontDeleteObj, frdrDontCreateObj,
- frdrDontDeletePage, frdrDontCreatePage, frdrDontEditPage,
- frdrDontCreateReport, frdrDontLoadReport, frdrDontSaveReport,
- frdrDontPreviewReport, frdrDontEditVariables, frdrDontChangeReportOptions);
- TfrDesignerRestrictions = set of TfrDesignerRestriction;
-
- TfrSplitInfo = record
- SplRect: TRect;
- SplX: Integer;
- View1, View2: TfrView;
- end;
-
- TfrDesignerPage = class(TPanel)
- private
- Down, // mouse button was pressed
- Moved, // mouse was moved (with pressed btn)
- DFlag, // was double click
- RFlag: Boolean; // selecting objects by framing
- Mode: (mdInsert, mdSelect); // current mode
- CT: (ctNone, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8); // cursor type
- LastX, LastY: Integer; // here stored last mouse coords
- SplitInfo: TfrSplitInfo;
- RightBottom: Integer;
- LeftTop: TPoint;
- FirstBandMove: Boolean;
- WasCtrl: Boolean;
- FDesigner: TfrDesignerForm;
- FDrag: Boolean;
- DisableDraw: Boolean;
- procedure NormalizeRect(var r: TRect);
- procedure NormalizeCoord(t: TfrView);
- function FindNearestEdge(var x, y: Integer): Boolean;
- procedure RoundCoord(var x, y: Integer);
- procedure Draw(N: Integer);
- procedure DrawPage(DrawMode: TfrDesignerDrawMode);
- procedure DrawRectLine(Rect: TRect);
- procedure DrawFocusRect(Rect: TRect);
- procedure DrawHSplitter(Rect: TRect);
- procedure DrawSelection(t: TfrView);
- procedure DrawShape(t: TfrView);
- procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure MUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure DClick(Sender: TObject);
- procedure DoDragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer);
- protected
- procedure Paint; override;
- procedure MouseLeave(AControl: TControl); override;
- public
- constructor Create(AOwner: TComponent); override;
- procedure Init;
- procedure SetPage;
- procedure GetMultipleSelected;
- end;
-
- TfrUndoBuffer = class(TObject)
- private
- FUndo, FRedo: TList;
- public
- constructor Create;
- destructor Destroy; override;
- procedure AddUndo(Report: TfrReport);
- procedure AddRedo(Report: TfrReport);
- procedure GetUndo(Report: TfrReport);
- procedure GetRedo(Report: TfrReport);
- procedure ClearUndo;
- procedure ClearRedo;
- end;
-
- TfrDesignerForm = class(TfrReportDesigner)
- StatusBar1: TStatusBar;
- frDock2: TfrDock;
- frDock3: TfrDock;
- Popup1: TPopupMenu;
- N1: TMenuItem;
- N2: TMenuItem;
- N3: TMenuItem;
- N5: TMenuItem;
- N6: TMenuItem;
- MainMenu1: TMainMenu;
- FileMenu: TMenuItem;
- EditMenu: TMenuItem;
- ToolMenu: TMenuItem;
- N10: TMenuItem;
- N11: TMenuItem;
- N12: TMenuItem;
- N13: TMenuItem;
- N19: TMenuItem;
- N20: TMenuItem;
- N21: TMenuItem;
- N23: TMenuItem;
- N24: TMenuItem;
- N25: TMenuItem;
- N27: TMenuItem;
- N28: TMenuItem;
- N26: TMenuItem;
- N29: TMenuItem;
- N30: TMenuItem;
- N31: TMenuItem;
- N32: TMenuItem;
- N33: TMenuItem;
- N36: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- ImageList1: TImageList;
- Pan5: TMenuItem;
- N8: TMenuItem;
- N38: TMenuItem;
- Pan6: TMenuItem;
- N39: TMenuItem;
- N40: TMenuItem;
- N42: TMenuItem;
- MastMenu: TMenuItem;
- N16: TMenuItem;
- N37: TMenuItem;
- Pan2: TMenuItem;
- Pan3: TMenuItem;
- Pan1: TMenuItem;
- Pan4: TMenuItem;
- Panel4: TfrToolBar;
- OB1: TToolButton;
- OB2: TToolButton;
- OB3: TToolButton;
- OB4: TToolButton;
- OB5: TToolButton;
- Panel5: TfrToolBar;
- Align1: TToolButton;
- Align2: TToolButton;
- Align3: TToolButton;
- Align4: TToolButton;
- Align5: TToolButton;
- Align6: TToolButton;
- Align7: TToolButton;
- Align8: TToolButton;
- Align9: TToolButton;
- Align10: TToolButton;
- Tab1: TTabControl;
- ScrollBox1: TScrollBox;
- frDock4: TfrDock;
- HelpMenu: TMenuItem;
- N34: TMenuItem;
- N46: TMenuItem;
- N47: TMenuItem;
- N48: TMenuItem;
- OB6: TToolButton;
- Pan7: TMenuItem;
- Image2: TImage;
- N14: TMenuItem;
- Panel7: TPanel;
- PBox1: TPaintBox;
- N17: TMenuItem;
- N18: TMenuItem;
- N22: TMenuItem;
- N35: TMenuItem;
- Popup2: TPopupMenu;
- N41: TMenuItem;
- N43: TMenuItem;
- N44: TMenuItem;
- Pan8: TMenuItem;
- N45: TMenuItem;
- N15: TMenuItem;
- Bevel1: TBevel;
- frDock1: TfrDock;
- Panel2: TfrToolBar;
- FileBtn1: TToolButton;
- FileBtn2: TToolButton;
- FileBtn3: TToolButton;
- FileBtn4: TToolButton;
- frTBSeparator1: TToolButton;
- CutB: TToolButton;
- CopyB: TToolButton;
- PstB: TToolButton;
- frTBSeparator2: TToolButton;
- UndoB: TToolButton;
- RedoB: TToolButton;
- frTBSeparator3: TToolButton;
- ZB1: TToolButton;
- ZB2: TToolButton;
- SelAllB: TToolButton;
- frTBSeparator4: TToolButton;
- PgB1: TToolButton;
- PgB4: TToolButton;
- PgB2: TToolButton;
- PgB3: TToolButton;
- frTBSeparator5: TToolButton;
- GB1: TToolButton;
- GB2: TToolButton;
- GB3: TToolButton;
- frTBSeparator11: TToolButton;
- HelpBtn: TToolButton;
- Panel3: TfrToolBar;
- FnB1: TToolButton;
- FnB2: TToolButton;
- FnB3: TToolButton;
- frTBSeparator6: TToolButton;
- ClB2: TToolButton;
- HlB1: TToolButton;
- frTBSeparator7: TToolButton;
- AlB1: TToolButton;
- AlB3: TToolButton;
- AlB2: TToolButton;
- AlB8: TToolButton;
- frTBSeparator8: TToolButton;
- AlB6: TToolButton;
- AlB5: TToolButton;
- AlB7: TToolButton;
- frTBSeparator9: TToolButton;
- AlB4: TToolButton;
- Panel1: TfrToolBar;
- FrB1: TToolButton;
- FrB2: TToolButton;
- FrB3: TToolButton;
- FrB4: TToolButton;
- frTBSeparator10: TToolButton;
- FrB5: TToolButton;
- FrB6: TToolButton;
- frTBSeparator15: TToolButton;
- ClB1: TToolButton;
- ClB3: TToolButton;
- StB1: TToolButton;
- MainImages: TImageList;
- ToolBar1: TToolBar;
- ToolBar2: TToolBar;
- ToolBar3: TToolBar;
- Panel6: TfrToolBar;
- ToolBar4: TToolBar;
- ToolBar5: TToolBar;
- ToolButton1: TToolButton;
- LinePanel: TPanel;
- ToolBar6: TToolBar;
- frSpeedButton7: TToolButton;
- frSpeedButton8: TToolButton;
- frSpeedButton9: TToolButton;
- frSpeedButton10: TToolButton;
- frSpeedButton11: TToolButton;
- frSpeedButton12: TToolButton;
- ImageList2: TImageList;
- frTBPanel2: TfrTBPanel;
- C4: TfrComboBox;
- frTBPanel1: TfrTBPanel;
- C3: TfrComboBox;
- C2: TfrFontComboBox;
- ExitB: TfrTBButton;
- DisabledImages: TImageList;
- Image1: TImage;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure DoClick(Sender: TObject);
- procedure ClB1Click(Sender: TObject);
- procedure GB1Click(Sender: TObject);
- procedure ZB1Click(Sender: TObject);
- procedure ZB2Click(Sender: TObject);
- procedure PgB1Click(Sender: TObject);
- procedure PgB2Click(Sender: TObject);
- procedure OB2MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure OB1Click(Sender: TObject);
- procedure CutBClick(Sender: TObject);
- procedure CopyBClick(Sender: TObject);
- procedure PstBClick(Sender: TObject);
- procedure SelAllBClick(Sender: TObject);
- procedure ExitBClick(Sender: TObject);
- procedure PgB3Click(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure N5Click(Sender: TObject);
- procedure N6Click(Sender: TObject);
- procedure GB2Click(Sender: TObject);
- procedure FileBtn1Click(Sender: TObject);
- procedure FileBtn2Click(Sender: TObject);
- procedure FileBtn3Click(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure N8Click(Sender: TObject);
- procedure HlB1Click(Sender: TObject);
- procedure FileBtn4Click(Sender: TObject);
- procedure N42Click(Sender: TObject);
- procedure Popup1Popup(Sender: TObject);
- procedure N23Click(Sender: TObject);
- procedure N37Click(Sender: TObject);
- procedure Pan2Click(Sender: TObject);
- procedure N14Click(Sender: TObject);
- procedure Align1Click(Sender: TObject);
- procedure Align2Click(Sender: TObject);
- procedure Align3Click(Sender: TObject);
- procedure Align4Click(Sender: TObject);
- procedure Align5Click(Sender: TObject);
- procedure Align6Click(Sender: TObject);
- procedure Align7Click(Sender: TObject);
- procedure Align8Click(Sender: TObject);
- procedure Align9Click(Sender: TObject);
- procedure Align10Click(Sender: TObject);
- procedure Tab1Change(Sender: TObject);
- procedure N34Click(Sender: TObject);
- procedure GB3Click(Sender: TObject);
- procedure UndoBClick(Sender: TObject);
- procedure RedoBClick(Sender: TObject);
- procedure N20Click(Sender: TObject);
- procedure PBox1Paint(Sender: TObject);
- procedure HelpBtnClick(Sender: TObject);
- procedure N22Click(Sender: TObject);
- procedure Tab1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure frSpeedButton1Click(Sender: TObject);
- procedure StB1Click(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure ScrollBox1Resize(Sender: TObject);
- procedure Tab1DragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- procedure Tab1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure Tab1MouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure Tab1DragDrop(Sender, Source: TObject; X, Y: Integer);
- procedure PgB4Click(Sender: TObject);
- procedure StatusBar1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure StatusBar1DblClick(Sender: TObject);
- procedure C2DblClick(Sender: TObject);
- procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- private
- { Private declarations }
- PageForm: TForm;
- PageView: TfrDesignerPage;
- InspForm: TfrInspForm;
- ColorSelector: TColorSelector;
- FCurPage: Integer;
- FGridSizeX, FGridSizeY: Integer;
- FGridShow, FGridAlign: Boolean;
- FUnits: TfrReportUnits;
- UndoBuffer: TfrUndoBuffer;
- FirstTime: Boolean;
- fld: Array[0..63] of String;
- EditAfterInsert: Boolean;
- FCurDocName, FCaption: String;
- ShapeMode: TfrShapeMode;
- PagePosition: TAlign;
- FPageType: TfrPageType;
- MDown, ChangeUnits: Boolean;
- UnlimitedHeight: Boolean;
- LastPt: TPoint;
- procedure SetMenuBitmaps;
- procedure SetCurPage(Value: Integer);
- procedure SetGridSize(Value: Integer);
- procedure SetGridShow(Value: Boolean);
- procedure SetGridAlign(Value: Boolean);
- procedure SetUnits(Value: TfrReportUnits);
- procedure SetCurDocName(Value: String);
- procedure SelectionChanged;
- procedure ShowPosition;
- procedure ShowContent;
- procedure EnableControls;
- procedure ResetSelection;
- procedure DeleteObjects;
- procedure AddPage;
- procedure RemovePage(n: Integer);
- procedure SetPageTitles;
- procedure DefMemoEditor(Sender: TObject);
- procedure DefPictureEditor(Sender: TObject);
- procedure DefTagEditor(Sender: TObject);
- procedure DefRestrEditor(Sender: TObject);
- procedure DefHighlightEditor(Sender: TObject);
- procedure DefFieldEditor(Sender: TObject);
- procedure DefDataSourceEditor(Sender: TObject);
- procedure DefCrossDataSourceEditor(Sender: TObject);
- procedure DefGroupEditor(Sender: TObject);
- procedure DefFontEditor(Sender: TObject);
- procedure FillInspFields;
- function RectTypEnabled: Boolean;
- function FontTypEnabled: Boolean;
- function ZEnabled: Boolean;
- function CutEnabled: Boolean;
- function CopyEnabled: Boolean;
- function PasteEnabled: Boolean;
- function DelEnabled: Boolean;
- function EditEnabled: Boolean;
- procedure ColorSelected(Sender: TObject);
- procedure MoveObjects(dx, dy: Integer; Resize: Boolean);
- procedure SelectAll;
- procedure Unselect;
- procedure NumberOfSelected;
- procedure CutToClipboard;
- procedure CopyToClipboard;
- procedure SaveState;
- procedure RestoreState;
- procedure Undo;
- procedure Redo;
- procedure AddUndo;
- procedure AddRedo;
- procedure ClearUndo;
- procedure ClearRedo;
- procedure InsFieldsClick(Sender: TObject);
- procedure SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn: TToolButton);
- function SelStatus: TfrSelectionStatus;
- procedure OnModify(Item: Integer);
- procedure PageFormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure PageFormResize(Sender: TObject);
- procedure PageFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- function BeforeEdit: Boolean;
- procedure AfterEdit;
- procedure DoEdit(ClassRef: TClass);
- procedure ShowFieldsDialog(Show: Boolean);
- procedure HeightChanged(Sender: TObject);
- procedure NotifyParentBands(OldName, NewName: String);
- procedure NotifySubReports(OldIndex, NewIndex: Integer);
- procedure InspSelectionChanged(ObjName: String);
- procedure InspGetObjects(List: TStrings);
- procedure AssignDefEditors;
- procedure Localize;
- procedure GetDefaultSize(var dx, dy: Integer);
- procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
- MousePos: TPoint; var Handled: Boolean);
- procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
- MousePos: TPoint; var Handled: Boolean);
- public
- { Public declarations }
- function GetModified: Boolean; override;
- procedure SetModified(Value: Boolean); override;
- procedure RegisterObject(ButtonBmp: TBitmap; ButtonHint: String;
- ButtonTag: Integer; IsControl: Boolean);
- procedure RegisterTool(MenuCaption: String; ButtonBmp: TBitmap;
- OnClick: TNotifyEvent);
- procedure BeforeChange; override;
- procedure AfterChange; override;
- procedure SelectObject(ObjName: String); override;
- function InsertDBField: String; override;
- function InsertExpression: String; override;
- procedure ShowMemoEditor(Sender: TObject);
- procedure ShowEditor;
- procedure RedrawPage; override;
- function PointsToUnits(x: Double): Double;
- function UnitsToPoints(x: Double): Double;
- property CurDocName: String read FCurDocName write SetCurDocName;
- property CurPage: Integer read FCurPage write SetCurPage;
- property GridSizeX: Integer read FGridSizeX write SetGridSize;
- property GridSizeY: Integer read FGridSizeY write SetGridSize;
- property ShowGrid: Boolean read FGridShow write SetGridShow;
- property GridAlign: Boolean read FGridAlign write SetGridAlign;
- property Units: TfrReportUnits read FUnits write SetUnits;
- property PageType: TfrPageType read FPageType;
- end;
-
-
- function frCheckBand(b: TfrBandType): Boolean;
-
- var
- frTemplateDir: String;
- DesignerRestrictions: TfrDesignerRestrictions;
-
-
- implementation
-
- {$R *.xfm}
- {$R *.res}
-
- uses
- FR_Pgopt, FR_GEdit, FR_Edit, FR_Templ, FR_Newrp, FR_DsOpt, FR_Const,
- FR_AttrE, FR_Prntr, FR_Hilit, FR_Dopt, FR_Dict, FR_BndEd, FR_VBnd, FR_Flds,
- FR_BTyp, FR_Utils, FR_GrpEd, FR_About, FR_IFlds, FR_Pars, FR_DBRel,
- FR_Restr, FR_DBSet, FR_PageF, FR_Expr, FR_Funcs, Variants, Qt;
-
- type
- THackView = class(TfrView)
- end;
-
- var
- FirstSelected: TfrView;
- SelNum: Integer; // number of objects currently selected
- MRFlag, // several objects was selected
- ObjRepeat, // was pressed Shift + Insert Object
- WasOk: Boolean; // was Ok pressed in dialog
- OldRect, OldRect1: TRect; // object rect after mouse was clicked
- Busy: Boolean; // busy flag. need!
- ShowSizes: Boolean;
- LastFontName: String;
- LastFontSize, LastAlignment: Integer;
- LastFrameWidth, LastLineWidth: Single;
- LastFrameTyp, LastFontStyle: Word;
- LastCharset: TFontCharset;
- LastFrameColor, LastFillColor, LastFontColor: TColor;
- ClrButton: TToolButton;
- FirstChange: Boolean;
- DesignerComp: TfrDesigner;
- InspBusy: Boolean;
-
- // globals
- ClipBd: TList; // clipboard
- GridBitmap: TBitmap; // for drawing grid in design time
-
-
- {----------------------------------------------------------------------------}
- // miscellaneous routines
- function Objects: TList;
- begin
- Result := frDesigner.Page.Objects;
- end;
-
- function TopSelected: Integer;
- var
- i: Integer;
- begin
- Result := Objects.Count - 1;
- for i := Objects.Count - 1 downto 0 do
- if TfrView(Objects[i]).Selected then
- begin
- Result := i;
- break;
- end;
- end;
-
- function frCheckBand(b: TfrBandType): Boolean;
- var
- i: Integer;
- t: TfrView;
- begin
- Result := False;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Typ = gtBand then
- if b = TfrBandType(t.FrameTyp) then
- begin
- Result := True;
- break;
- end;
- end;
- end;
-
- function GetUnusedBand: TfrBandType;
- var
- b: TfrBandType;
- begin
- Result := btNone;
- for b := btReportTitle to btNone do
- if not frCheckBand(b) then
- begin
- Result := b;
- break;
- end;
- if Result = btNone then Result := btMasterData;
- end;
-
- procedure SendBandsToDown;
- var
- i, j, n, k: Integer;
- t: TfrView;
- begin
- n := Objects.Count; j := 0; i := n - 1;
- k := 0;
- while j < n do
- begin
- t := Objects[i];
- if t.Typ = gtBand then
- begin
- Objects.Delete(i);
- Objects.Insert(0, t);
- Inc(k);
- end
- else
- Dec(i);
- Inc(j);
- end;
- for i := 0 to n - 1 do // sends btOverlay to back
- begin
- t := Objects[i];
- if (t.Typ = gtBand) and (t.FrameTyp = Integer(btOverlay)) then
- begin
- Objects.Delete(i);
- Objects.Insert(0, t);
- break;
- end;
- end;
- i := 0; j := 0;
- while j < n do // sends btCrossXXX to front
- begin
- t := Objects[i];
- if (t.Typ = gtBand) and
- (TfrBandType(t.FrameTyp) in [btCrossHeader..btCrossFooter]) then
- begin
- Objects.Delete(i);
- Objects.Insert(k - 1, t);
- end
- else Inc(i);
- Inc(j);
- end;
- end;
-
- procedure ClearClipBoard;
- var
- m: TMemoryStream;
- begin
- if Assigned(ClipBd) then
- with ClipBd do
- while Count > 0 do
- begin
- m := Items[0];
- m.Free;
- Delete(0);
- end;
- end;
-
- function IsBandsSelect(var Value: TfrView): Boolean;
- var
- i: Integer;
- begin
- Result := False;
- Value := nil;
- for i := 0 to Objects.Count - 1 do
- begin
- Value := Objects[i];
- if Value.Selected and (Value.Typ = gtBand) then
- begin
- Result := True;
- break;
- end;
- end;
- end;
-
-
- {----------------------------------------------------------------------------}
- constructor TfrDesigner.Create(AOwner: TComponent);
- begin
- if Assigned(DesignerComp) then
- raise Exception.Create('You already have one TfrDesigner component');
- inherited Create(AOwner);
- FCloseQuery := True;
- DesignerComp := Self;
- HideDisabledButtons := True;
- end;
-
- destructor TfrDesigner.Destroy;
- begin
- DesignerComp := nil;
- inherited Destroy;
- end;
-
-
- {--------------------------------------------------}
- constructor TfrDesignerPage.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- Parent := AOwner as TWinControl;
- BevelInner := bvNone;
- BevelOuter := bvNone;
- Color := clWhite;
- BorderStyle := bsNone;
- OnMouseDown := MDown;
- OnMouseUp := MUp;
- OnMouseMove := MMove;
- OnDblClick := DClick;
- OnDragOver := DoDragOver;
- OnDragDrop := DoDragDrop;
- end;
-
- procedure TfrDesignerPage.Init;
- begin
- Down := False; DFlag := False; RFlag := False;
- Cursor := crDefault; CT := ctNone;
- end;
-
- procedure TfrDesignerPage.SetPage;
- var
- Pgw, Pgh, Pgl, Pgt: Integer;
- begin
- Pgw := FDesigner.Page.PrnInfo.Pgw;
- Pgh := FDesigner.Page.PrnInfo.Pgh;
- if FDesigner.UnlimitedHeight then
- Pgh := Pgh * 3;
- Pgt := 10;
- if (Pgw > Parent.Width) or (FDesigner.PagePosition = alLeft) then
- Pgl := 10
- else if FDesigner.PagePosition = alClient then
- Pgl := (Parent.ClientWidth - Pgw) div 2
- else
- Pgl := Parent.ClientWidth - Pgw - 16;
-
-
- Align := alNone;
- if (FDesigner.PageType = ptDialog) and (FDesigner.PageForm <> nil) then
- SetBounds(0, 0, FDesigner.PageForm.ClientWidth, FDesigner.PageForm.ClientHeight)
- else
- begin
- SetBounds(Pgl, Pgt, Pgw, Pgh);
- TScrollBox(Parent).VertScrollBar.Range := Top + Height + 10;
- TScrollBox(Parent).HorzScrollBar.Range := Left + Width + 10;
- end;
- end;
-
- procedure TfrDesignerPage.Paint;
- begin
- Draw(10000);
- end;
-
- procedure TfrDesignerPage.NormalizeCoord(t: TfrView);
- begin
- if t.dx < 0 then
- begin
- t.dx := -t.dx;
- t.x := t.x - t.dx;
- end;
- if t.dy < 0 then
- begin
- t.dy := -t.dy;
- t.y := t.y - t.dy;
- end;
- end;
-
- procedure TfrDesignerPage.NormalizeRect(var r: TRect);
- var
- i: Integer;
- begin
- with r do
- begin
- if Left > Right then begin i := Left; Left := Right; Right := i end;
- if Top > Bottom then begin i := Top; Top := Bottom; Bottom := i end;
- end;
- end;
-
- procedure TfrDesignerPage.DrawHSplitter(Rect: TRect);
- begin
- with Canvas do
- begin
- Pen.Mode := pmXor;
- Pen.Color := clSilver;
- Pen.Width := 1;
- MoveTo(Rect.Left, Rect.Top);
- LineTo(Rect.Right, Rect.Bottom);
- Pen.Mode := pmCopy;
- end;
- end;
-
- procedure TfrDesignerPage.DrawRectLine(Rect: TRect);
- begin
- with Canvas do
- begin
- Pen.Mode := pmNot;
- Pen.Style := psSolid;
- Pen.Width := Round(LastLineWidth);
- with Rect do
- if Abs(Right - Left) > Abs(Bottom - Top) then
- begin
- MoveTo(Left, Top);
- LineTo(Right, Top);
- end
- else
- begin
- MoveTo(Left, Top);
- LineTo(Left, Bottom);
- end;
- Pen.Mode := pmCopy;
- end;
- end;
-
- procedure TfrDesignerPage.DrawFocusRect(Rect: TRect);
- begin
- with Canvas do
- begin
- Pen.Mode := pmXor;
- Pen.Color := clSilver;
- Pen.Width := 1;
- Pen.Style := psSolid;
- Brush.Style := bsClear;
- if (Rect.Right = Rect.Left + 1) or (Rect.Bottom = Rect.Top + 1) then
- begin
- if Rect.Right = Rect.Left + 1 then
- Dec(Rect.Right, 1) else
- Dec(Rect.Bottom, 1);
- MoveTo(Rect.Left, Rect.Top);
- LineTo(Rect.Right, Rect.Bottom);
- end
- else
- Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
- Pen.Mode := pmCopy;
- Brush.Style := bsSolid;
- end;
- end;
-
- procedure TfrDesignerPage.DrawSelection(t: TfrView);
- var
- px, py: Word;
-
- procedure Draw_Point(x, y: Word);
- var
- i: Integer;
- begin
- for i := 0 to 4 do
- begin
- Canvas.MoveTo(x - 2, y - 2 + i);
- Canvas.LineTo(x + 2, y - 2 + i);
- end;
- end;
-
- begin
- if t.Selected then
- with t, Canvas do
- begin
- Pen.Width := 1;
- Pen.Mode := pmXor;
- Pen.Color := clWhite;
- px := x + dx div 2;
- py := y + dy div 2;
- Draw_Point(x, y);
- if (dx <> 0) and (dy <> 0) then
- begin
- Draw_Point(x + dx, y);
- Draw_Point(x, y + dy);
- end;
- if Objects.IndexOf(t) = RightBottom then
- Pen.Color := clTeal;
- Draw_Point(x + dx, y + dy);
- Pen.Color := clWhite;
- if (SelNum = 1) and (dx <> 0) and (dy <> 0) then
- begin
- Draw_Point(px, y); Draw_Point(px, y + dy);
- Draw_Point(x, py); Draw_Point(x + dx, py);
- end;
- Pen.Mode := pmCopy;
- end;
- end;
-
- procedure TfrDesignerPage.DrawShape(t: TfrView);
- begin
- with t do
- if Selected then
- DrawFocusRect(Rect(x, y, x + dx + 1, y + dy + 1))
- end;
-
- procedure TfrDesignerPage.Draw(N: Integer{; ClipRgn: frHRGN});
- var
- i: Integer;
- t: TfrView;
- Objects: TList;
- c: TColor;
- Bmp, Bmp1: TBitmap;
- r1, r2, r3: frHRGN;
-
- procedure DrawBackground;
- var
- i, j: Integer;
- begin
- with Canvas do
- begin
- c := clBlack;
- if FDesigner.ShowGrid and (FDesigner.GridSizeX <> 18) then
- begin
- with GridBitmap.Canvas do
- begin
- if FDesigner.PageType = ptDialog then
- Brush.Color := FDesigner.Page.Color else
- Brush.Color := clWhite;
- FillRect(Rect(0, 0, 8, 8));
- Pen.Color := c;
- DrawPoint(0, 0);
- if FDesigner.GridSizeX = 4 then
- begin
- DrawPoint(4, 0);
- DrawPoint(0, 4);
- DrawPoint(4, 4);
- end;
- end;
- Brush.Bitmap := GridBitmap;
- end
- else
- begin
- if FDesigner.PageType = ptDialog then
- Brush.Color := FDesigner.Page.Color else
- Brush.Color := clWhite;
- Brush.Style := bsSolid;
- end;
- FillRect(Rect(0, 0, Width, Height));
- Pen.Color := c;
- if FDesigner.ShowGrid and (FDesigner.GridSizeX = 18) then
- begin
- i := 0;
- while i < Width do
- begin
- j := 0;
- while j < Height do
- begin
- if frRectVisible(Handle, Rect(i, j, i + 1, j + 1)) then
- DrawPoint(i, j);
- Inc(j, FDesigner.GridSizeY);
- end;
- Inc(i, FDesigner.GridSizeX);
- end;
- end;
- end;
- end;
-
- procedure DrawMargins;
- var
- i, j: Integer;
- begin
- with Canvas do
- begin
- Brush.Style := bsClear;
- Pen.Width := 1;
- Pen.Color := clGray;
- Pen.Style := psSolid;
- Pen.Mode := pmCopy;
- if FDesigner.PageType = ptReport then
- with FDesigner.Page do
- begin
- if UseMargins then
- Rectangle(LeftMargin, TopMargin, RightMargin, BottomMargin);
- if ColCount > 1 then
- begin
- ColWidth := (RightMargin - LeftMargin -
- ((ColCount - 1) * ColGap)) div ColCount;
- Pen.Style := psDot;
- j := LeftMargin;
- for i := 1 to ColCount do
- begin
- Rectangle(j, -1, j + ColWidth + 1, PrnInfo.Pgh + 1);
- Inc(j, ColWidth + ColGap);
- end;
- Pen.Style := psSolid;
- end;
- end;
- Brush.Style := bsSolid;
- end;
- end;
-
- procedure DrawObject(t: TfrView; Canvas: TCanvas);
- begin
- t.Draw(Canvas);
- if t.Script.Count > 0 then
- Canvas.Draw(t.x + 1, t.y + 1, Bmp);
- if (t is TfrMemoView) and (TfrMemoView(t).HighlightStr <> '') then
- Canvas.Draw(t.x + 1, t.y + 10, Bmp1);
- end;
-
- begin
- if (FDesigner.Page = nil) or DisableDraw then Exit;
- Bmp := TBitmap.Create;
- Bmp.LoadFromResourceName(hInstance, 'FR_SCRIPT');
- Bmp1 := TBitmap.Create;
- Bmp1.LoadFromResourceName(hInstance, 'FR_HIGHLIGHT');
- DocMode := dmDesigning;
- Objects := FDesigner.Page.Objects;
-
- Canvas.Start;
- r1 := frCreateRectRgn(0, 0, Width, Height);
- frSetClipRgn(Canvas.Handle, r1);
- r3 := frCreateRectRgn(0, 0, Width, Height);
-
- for i := Objects.Count - 1 downto 0 do
- begin
- t := Objects[i];
- DrawObject(t, Canvas);
- r2 := t.GetClipRgn(rtNormal);
- frExcludeClipRgn(Canvas.Handle, r2);
- frDeleteRgn(r2);
- end;
-
- DrawBackground;
- Canvas.Stop;
- frDeleteRgn(r1);
- frDeleteRgn(r3);
- DrawMargins;
-
- { DrawBackground;
- for i := 0 to Objects.Count - 1 do
- begin
- frSetTextCharacterExtra(Canvas.Handle, 0);
- t := Objects[i];
- DrawObject(t, Canvas);
- frSetTextCharacterExtra(Canvas.Handle, 0);
- end;
- DrawMargins;}
-
-
-
-
- if not Down then
- DrawPage(dmSelection);
- Bmp.Free;
- Bmp1.Free;
- end;
-
- procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
- var
- i: Integer;
- t: TfrView;
- begin
- if DocMode <> dmDesigning then Exit;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- case DrawMode of
- dmAll: t.Draw(Canvas);
- dmSelection: DrawSelection(t);
- dmShape: DrawShape(t);
- end;
- end;
- end;
-
- function TfrDesignerPage.FindNearestEdge(var x, y: Integer): Boolean;
- var
- i: Integer;
- t: TfrView;
- min: Double;
- p: TPoint;
- function DoMin(a: Array of TPoint): Boolean;
- var
- i: Integer;
- d: Double;
- begin
- Result := False;
- for i := Low(a) to High(a) do
- begin
- d := sqrt((x - a[i].x) * (x - a[i].x) + (y - a[i].y) * (y - a[i].y));
- if d < min then
- begin
- min := d;
- p := a[i];
- Result := True;
- end;
- end;
- end;
- begin
- Result := False;
- min := FDesigner.GridSizeX;
- p := Point(x, y);
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if DoMin([Point(t.x, t.y), Point(t.x + t.dx, t.y),
- Point(t.x + t.dx, t.y + t.dy), Point(t.x, t.y + t.dy)]) then
- Result := True;
- end;
- x := p.x; y := p.y;
- end;
-
- procedure TfrDesignerPage.RoundCoord(var x, y: Integer);
- begin
- with FDesigner do
- if GridAlign then
- begin
- x := x div GridSizeX * GridSizeX;
- y := y div GridSizeY * GridSizeY;
- end;
- end;
-
- procedure TfrDesignerPage.GetMultipleSelected;
- var
- i, j, k: Integer;
- t: TfrView;
- begin
- j := 0; k := 0;
- LeftTop := Point(10000, 10000);
- RightBottom := -1;
- MRFlag := False;
- if SelNum > 1 then {find right-bottom element}
- begin
- for i := 0 to Objects.Count-1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- t.OriginalRect := Rect(t.x, t.y, t.dx, t.dy);
- if (t.x + t.dx > j) or ((t.x + t.dx = j) and (t.y + t.dy > k)) then
- begin
- j := t.x + t.dx;
- k := t.y + t.dy;
- RightBottom := i;
- end;
- if t.x < LeftTop.x then LeftTop.x := t.x;
- if t.y < LeftTop.y then LeftTop.y := t.y;
- end;
- end;
- t := Objects[RightBottom];
- OldRect := Rect(LeftTop.x, LeftTop.y, t.x + t.dx, t.y + t.dy);
- OldRect1 := OldRect;
- MRFlag := True;
- end;
- end;
-
- procedure TfrDesignerPage.MDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- i: Integer;
- f, v: Boolean;
- t: TfrView;
- p: TPoint;
- Rgn: frHRGN;
- begin
- WasCtrl := ssCtrl in Shift;
- if DFlag then
- begin
- DFlag := False;
- Exit;
- end;
- if (Button = mbRight) and Down and RFlag then
- DrawFocusRect(OldRect);
- RFlag := False;
- DrawPage(dmSelection);
- Down := True;
- if Button = mbLeft then
- if (ssCtrl in Shift) or (Cursor = crCross) then
- begin
- RFlag := True;
- if Cursor = crCross then
- begin
- if FDesigner.PageType = ptReport then
- DrawFocusRect(OldRect);
- RoundCoord(x, y);
- OldRect1 := OldRect;
- end;
- OldRect := Rect(x, y, x, y);
- FDesigner.Unselect;
- SelNum := 0;
- RightBottom := -1;
- MRFlag := False;
- FirstSelected := nil;
- Exit;
- end
- else if Cursor = crPencil then
- begin
- with FDesigner do
- if GridAlign then
- if not FindNearestEdge(x, y) then
- begin
- x := Round(x / GridSizeX) * GridSizeX;
- y := Round(y / GridSizeY) * GridSizeY;
- end;
- OldRect := Rect(x, y, x, y);
- FDesigner.Unselect;
- SelNum := 0;
- RightBottom := -1;
- MRFlag := False;
- FirstSelected := nil;
- LastX := x;
- LastY := y;
- Exit;
- end;
- if Cursor = crDefault then
- begin
- f := False;
- for i := Objects.Count - 1 downto 0 do
- begin
- t := Objects[i];
- Rgn := t.GetClipRgn(rtNormal);
- v := frPtInRegion(Rgn, X, Y);
- frDeleteRgn(Rgn);
- // v := (x >= t.x) and (x < t.x + t.dx) and (y >= t.y) and (y < t.y + t.dy);
-
- if v then
- begin
- if ssShift in Shift then
- begin
- t.Selected := not t.Selected;
- if t.Selected then Inc(SelNum) else Dec(SelNum);
- end
- else if not t.Selected then
- begin
- FDesigner.Unselect;
- SelNum := 1;
- t.Selected := True;
- end;
- if SelNum = 0 then FirstSelected := nil
- else if SelNum = 1 then FirstSelected := t
- else if FirstSelected <> nil then
- if not FirstSelected.Selected then FirstSelected := nil;
- f := True;
- break;
- end;
- end;
- if not f then
- begin
- FDesigner.Unselect;
- SelNum := 0;
- FirstSelected := nil;
- if Button = mbLeft then
- begin
- RFlag := True;
- OldRect := Rect(x, y, x, y);
- Exit;
- end;
- end;
- GetMultipleSelected;
- end;
- if SelNum = 0 then
- begin // reset multiple selection
- RightBottom := -1;
- MRFlag := False;
- end;
- LastX := x;
- LastY := y;
- Moved := False;
- FirstChange := True;
- FirstBandMove := True;
- if Button = mbRight then
- begin
- DrawPage(dmSelection);
- Down := False;
- GetCursorPos(p);
- FDesigner.SelectionChanged;
- FDesigner.Popup1Popup(nil);
- FDesigner.Popup1.Popup(p.X, p.Y);
- end
- else if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape);
- end;
-
- procedure TfrDesignerPage.MUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
- var
- i, k, dx, dy: Integer;
- t: TfrView;
- ObjectInserted: Boolean;
-
- procedure AddObject(ot: Byte);
- begin
- Objects.Add(frCreateObject(ot, ''));
- t := Objects.Last;
- end;
-
- procedure CreateSection;
- var
- s: String;
- frBandTypesForm: TfrBandTypesForm;
-
- function IsSubreport(PageN: Integer): Boolean;
- var
- i, j: Integer;
- t: TfrView;
- begin
- Result := False;
- with CurReport do
- for i := 0 to Pages.Count - 1 do
- for j := 0 to Pages[i].Objects.Count - 1 do
- begin
- t := Pages[i].Objects[j];
- if t.Typ = gtSubReport then
- if TfrSubReportView(t).SubPage = PageN then
- begin
- Result := True;
- Exit;
- end;
- end;
- end;
-
- begin
- frBandTypesForm := TfrBandTypesForm.Create(nil);
- frBandTypesForm.IsSubreport := IsSubreport(FDesigner.CurPage);
- ObjectInserted := frBandTypesForm.ShowModal = mrOk;
- if ObjectInserted then
- begin
- Objects.Add(TfrBandView.Create);
- t := Objects.Last;
- (t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
- s := frBandNames[Integer(frBandTypesForm.SelectedTyp)];
- if Pos(' ', s) <> 0 then
- begin
- s[Pos(' ', s) + 1] := UpCase(s[Pos(' ', s) + 1]);
- Delete(s, Pos(' ', s), 1);
- end;
- THackView(t).BaseName := s;
- SendBandsToDown;
- end;
- frBandTypesForm.Free;
- end;
-
- procedure CreateSubReport;
- begin
- Objects.Add(TfrSubReportView.Create);
- t := Objects.Last;
- (t as TfrSubReportView).SubPage := CurReport.Pages.Count;
- CurReport.Pages.Add;
- end;
-
- begin
- if Button <> mbLeft then Exit;
- Down := False;
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape);
- // inserting a new object
- if Cursor = crCross then
- begin
- Mode := mdSelect;
- if FDesigner.PageType = ptReport then
- begin
- DrawFocusRect(OldRect);
- if (OldRect.Left = OldRect.Right) and (OldRect.Top = OldRect.Bottom) then
- OldRect := OldRect1;
- end;
- NormalizeRect(OldRect);
- RFlag := False;
- if DesignerRestrictions * [frdrDontCreateObj] = [] then
- begin
- ObjectInserted := True;
- FDesigner.AddUndo;
- with FDesigner.ToolBar4 do
- for i := 0 to ControlCount - 1 do
- if Controls[i] is TToolButton then
- with Controls[i] as TToolButton do
- if Down then
- begin
- if Tag = gtBand then
- if GetUnusedBand <> btNone then
- CreateSection else
- Exit
- else if Tag = gtSubReport then
- CreateSubReport
- else if Tag >= gtAddIn then
- begin
- k := Tag - gtAddIn;
- Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName));
- t := Objects.Last;
- end
- else
- AddObject(Tag);
- break;
- end;
- end
- else
- ObjectInserted := False;
- if ObjectInserted then
- begin
- t.CreateUniqueName;
- if t is TfrSubReportView then
- FDesigner.SetPageTitles;
- with OldRect do
- if (Left = Right) or (Top = Bottom) then
- begin
- dx := 36; dy := 36;
- if t is TfrMemoView then
- FDesigner.GetDefaultSize(dx, dy)
- else if FDesigner.PageType = ptDialog then
- begin
- dx := t.dx;
- dy := t.dy;
- end;
- OldRect := Rect(Left, Top, Left + dx, Top + dy);
- end;
- FDesigner.Unselect;
- t.x := OldRect.Left; t.y := OldRect.Top;
- t.dx := OldRect.Right - OldRect.Left; t.dy := OldRect.Bottom - OldRect.Top;
- if (t is TfrBandView) and
- (TfrBandType(t.FrameTyp) in [btCrossHeader..btCrossFooter]) and
- (t.dx > Width - 10) then
- t.dx := 40;
- if t.Typ <> gtAddIn then
- t.FrameWidth := LastFrameWidth;
- t.FrameColor := LastFrameColor;
- t.FillColor := LastFillColor;
- t.Selected := True;
- if t is TfrMemoView then
- with t as TfrMemoView do
- begin
- FrameTyp := LastFrameTyp;
- Font.Name := LastFontName;
- Font.Size := LastFontSize;
- Font.Color := LastFontColor;
- Font.Style := frSetFontStyle(LastFontStyle);
- Font.Charset := LastCharset;
- Alignment := LastAlignment;
- end;
- SelNum := 1;
- if t.Typ = gtBand then
- Draw(10000{, t.GetClipRgn(rtExtended)})
- else
- begin
- t.Draw(Canvas);
- DrawSelection(t);
- end;
- with FDesigner do
- begin
- SelectionChanged;
- if EditAfterInsert and not FDrag and not (t is TfrControl) then
- ShowEditor;
- end;
- end;
- if not ObjRepeat then
- FDesigner.OB1.Down := True else
- DrawFocusRect(OldRect);
- Exit;
- end;
- // line drawing
- if Cursor = crPencil then
- begin
- with OldRect do
- if (Left = Right) and (Top = Bottom) then
- Exit;
- if DesignerRestrictions * [frdrDontCreateObj] <> [] then Exit;
- DrawRectLine(OldRect);
- FDesigner.AddUndo;
- AddObject(gtLine);
- t.CreateUniqueName;
- t.x := OldRect.Left; t.y := OldRect.Top;
- t.dx := OldRect.Right - OldRect.Left; t.dy := OldRect.Bottom - OldRect.Top;
- if t.dx < 0 then
- begin
- t.dx := -t.dx; if Abs(t.dx) > Abs(t.dy) then t.x := OldRect.Right;
- end;
- if t.dy < 0 then
- begin
- t.dy := -t.dy; if Abs(t.dy) > Abs(t.dx) then t.y := OldRect.Bottom;
- end;
- t.Selected := True;
- t.FrameWidth := LastLineWidth;
- t.FrameColor := LastFrameColor;
- SelNum := 1;
- t.Draw(Canvas);
- DrawSelection(t);
- FDesigner.SelectionChanged;
- Exit;
- end;
-
- // calculating which objects contains in frame (if user select it with mouse+Ctrl key)
- if RFlag then
- begin
- DrawFocusRect(OldRect);
- RFlag := False;
- NormalizeRect(OldRect);
- SelNum := 0;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- with OldRect do
- if t.Typ <> gtBand then
- if not ((t.x > Right) or (t.x + t.dx < Left) or
- (t.y > Bottom) or (t.y + t.dy < Top)) then
- begin
- t.Selected := True;
- Inc(SelNum);
- end;
- end;
-
- if SelNum = 0 then
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- with OldRect do
- if not ((t.x > Right) or (t.x + t.dx < Left) or
- (t.y > Bottom) or (t.y + t.dy < Top)) then
- begin
- t.Selected := True;
- Inc(SelNum);
- end;
- end;
-
- GetMultipleSelected;
- FDesigner.SelectionChanged;
- DrawPage(dmSelection);
- Exit;
- end;
- // splitting
- if Moved and MRFlag and (Cursor = crHSplit) then
- begin
- with SplitInfo do
- begin
- dx := SplRect.Left - SplX;
- if DesignerRestrictions * [frdrDontMoveObj, frdrDontSizeObj] = [] then
- if ((View1.Restrictions and frrfDontSize) = 0) and
- ((View2.Restrictions and (frrfDontMove + frrfDontSize)) = 0) then
- if (View1.dx + dx > 0) and (View2.dx - dx > 0) then
- begin
- Inc(View1.dx, dx);
- Inc(View2.x, dx);
- Dec(View2.dx, dx);
- end;
- end;
- GetMultipleSelected;
- Draw(TopSelected{, ClipRgn});
- Exit;
- end;
- // resizing several objects
- if Moved and MRFlag and (Cursor <> crDefault) then
- begin
- Draw(TopSelected{, ClipRgn});
- Exit;
- end;
- // redrawing all moved or resized objects
- if not Moved then
- begin
- FDesigner.SelectionChanged;
- DrawPage(dmSelection);
- end;
- if (SelNum >= 1) and Moved then
- if SelNum > 1 then
- begin
- Draw(TopSelected{, ClipRgn});
- GetMultipleSelected;
- FDesigner.ShowPosition;
- end
- else
- begin
- t := Objects[TopSelected];
- NormalizeCoord(t);
- if Cursor <> crDefault then t.Resized;
- Draw(TopSelected{, ClipRgn});
- FDesigner.SelectionChanged;
- FDesigner.ShowPosition;
- end;
- Moved := False;
- CT := ctNone;
- end;
-
- procedure TfrDesignerPage.MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- var
- i, j, kx, ky, w, dx, dy: Integer;
- t, t1, Bnd: TfrView;
- nx, ny, x1, x2, y1, y2: Double;
- FAlign: Boolean;
- ii: Integer;
-
- function Cont(px, py, x, y: Integer): Boolean;
- begin
- Result := (x >= px - w) and (x <= px + w + 1) and
- (y >= py - w) and (y <= py + w + 1);
- end;
-
- function GridCheck: Boolean;
- begin
- with FDesigner do
- begin
- Result := (kx >= GridSizeX) or (kx <= -GridSizeX) or
- (ky >= GridSizeY) or (ky <= -GridSizeY);
- if Result then
- begin
- kx := kx - kx mod GridSizeX;
- ky := ky - ky mod GridSizeY;
- end;
- end;
- end;
-
- function CheckNegative(t: TfrView): Boolean;
- begin
- if (t.dx < 0) or (t.dy < 0) then
- begin
- NormalizeCoord(t);
- Result := True;
- end
- else
- Result := False;
- end;
-
- begin
- Moved := True;
- FDrag := False;
- FAlign := FDesigner.GridAlign;
- if ssAlt in Shift then
- FAlign := not FAlign;
-
- w := 2;
- if FirstChange and Down and not RFlag then
- begin
- kx := x - LastX;
- ky := y - LastY;
- if not FAlign or GridCheck then
- begin
- FirstChange := False;
- FDesigner.AddUndo;
- end;
- end;
-
- if not Down then
- if FDesigner.OB6.Down then
- begin
- Mode := mdSelect;
- Cursor := crPencil;
- end
- else if FDesigner.OB1.Down then
- begin
- Mode := mdSelect;
- Cursor := crDefault;
- if SelNum = 0 then
- begin
- ShowSizes := False;
- OldRect := Rect(x, y, x, y);
- FDesigner.PBox1Paint(nil);
- end;
- end
- else
- begin
- Mode := mdInsert;
- if Cursor <> crCross then
- begin
- RoundCoord(x, y);
- FDesigner.GetDefaultSize(kx, ky);
- if FDesigner.OB3.Down then
- kx := Width;
- OldRect := Rect(x, y, x + kx, y + ky);
- if FDesigner.PageType = ptReport then
- DrawFocusRect(OldRect);
- end;
- Cursor := crCross;
- end;
-
- if (Mode = mdInsert) and not Down then
- begin
- if FDesigner.PageType = ptReport then
- DrawFocusRect(OldRect);
- RoundCoord(x, y);
- OffsetRect(OldRect, x - OldRect.Left, y - OldRect.Top);
- if FDesigner.PageType = ptReport then
- DrawFocusRect(OldRect);
- ShowSizes := True;
- FDesigner.PBox1Paint(nil);
- ShowSizes := False;
- Exit;
- end;
-
- // cursor shapes
- if not Down and (SelNum = 1) and (Mode = mdSelect) and
- not FDesigner.OB6.Down then
- begin
- t := Objects[TopSelected];
- if Cont(t.x, t.y, x, y) or Cont(t.x + t.dx, t.y + t.dy, x, y) then
- Cursor := crSizeNWSE
- else if Cont(t.x + t.dx, t.y, x, y) or Cont(t.x, t.y + t.dy, x, y)then
- Cursor := crSizeNESW
- 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
- Cursor := crSizeNS
- 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
- Cursor := crSizeWE
- else
- Cursor := crDefault;
- end;
- // selecting a lot of objects
- if Down and RFlag then
- begin
- DrawFocusRect(OldRect);
- if Cursor = crCross then
- RoundCoord(x, y);
- OldRect := Rect(OldRect.Left, OldRect.Top, x, y);
- DrawFocusRect(OldRect);
- ShowSizes := True;
- if Cursor = crCross then
- FDesigner.PBox1Paint(nil);
- ShowSizes := False;
- Exit;
- end;
- // line drawing
- if Down and (Cursor = crPencil) then
- begin
- kx := x - LastX;
- ky := y - LastY;
- if FAlign and not GridCheck then Exit;
- DrawRectLine(OldRect);
- OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
- DrawRectLine(OldRect);
- Inc(LastX, kx);
- Inc(LastY, ky);
- Exit;
- end;
- // check for multiple selected objects - right-bottom corner
- if not Down and (SelNum > 1) and (Mode = mdSelect) then
- begin
- t := Objects[RightBottom];
- if Cont(t.x + t.dx, t.y + t.dy, x, y) then
- Cursor := crSizeNWSE
- end;
- // split checking
- if not Down and (SelNum > 1) and (Mode = mdSelect) then
- begin
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if (t.Typ <> gtBand) and (t.Typ <> gtLine) and t.Selected then
- if (x >= t.x) and (x <= t.x + t.dx) and (y >= t.y) and (y <= t.y + t.dy) then
- begin
- for j := 0 to Objects.Count - 1 do
- begin
- t1 := Objects[j];
- if (t1.Typ <> gtBand) and (t1 <> t) and t1.Selected then
- if ((t.x = t1.x + t1.dx) and ((x >= t.x) and (x <= t.x + 2))) or
- ((t1.x = t.x + t.dx) and ((x >= t1.x - 2) and (x <= t.x))) then
- begin
- Cursor := crHSplit;
- with SplitInfo do
- begin
- SplRect := Rect(x, t.y, x, t.y + t.dy);
- if t.x = t1.x + t1.dx then
- begin
- SplX := t.x;
- View1 := t1;
- View2 := t;
- end
- else
- begin
- SplX := t1.x;
- View1 := t;
- View2 := t1;
- end;
- SplRect.Left := SplX;
- SplRect.Right := SplX;
- end;
- end;
- end;
- end;
- end;
- end;
- // splitting
- if Down and MRFlag and (Mode = mdSelect) and (Cursor = crHSplit) then
- begin
- kx := x - LastX;
- ky := 0;
- if FAlign and not GridCheck then Exit;
- with SplitInfo do
- begin
- DrawHSplitter(SplRect);
- SplRect := Rect(SplRect.Left + kx, SplRect.Top, SplRect.Right + kx, SplRect.Bottom);
- DrawHSplitter(SplRect);
- end;
- Inc(LastX, kx);
- Exit;
- end;
- // sizing several objects
- if Down and MRFlag and (Mode = mdSelect) and (Cursor <> crDefault) then
- begin
- kx := x - LastX;
- ky := y - LastY;
- if FAlign and not GridCheck then Exit;
-
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape);
- if not ((OldRect.Right + kx < OldRect.Left) or (OldRect.Bottom + ky < OldRect.Top)) then
- OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
- nx := (OldRect.Right - OldRect.Left) / (OldRect1.Right - OldRect1.Left);
- ny := (OldRect.Bottom - OldRect.Top) / (OldRect1.Bottom - OldRect1.Top);
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- x1 := (t.OriginalRect.Left - LeftTop.x) * nx;
- x2 := t.OriginalRect.Right * nx;
- dx := Round(x1 + x2) - (Round(x1) + Round(x2));
- if DesignerRestrictions * [frdrDontSizeObj] = [] then
- if (t.Restrictions and frrfDontSize) = 0 then
- begin
- t.x := LeftTop.x + Round(x1); t.dx := Round(x2) + dx;
- end;
-
- y1 := (t.OriginalRect.Top - LeftTop.y) * ny;
- y2 := t.OriginalRect.Bottom * ny;
- dy := Round(y1 + y2) - (Round(y1) + Round(y2));
- if DesignerRestrictions * [frdrDontSizeObj] = [] then
- if (t.Restrictions and frrfDontSize) = 0 then
- begin
- t.y := LeftTop.y + Round(y1); t.dy := Round(y2) + dy;
- end;
- end;
- end;
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape)
- else
- Draw(10000);
- Inc(LastX, kx);
- Inc(LastY, ky);
- FDesigner.PBox1Paint(nil);
- Exit;
- end;
- // moving
- if Down and (Mode = mdSelect) and (SelNum >= 1) and (Cursor = crDefault) then
- begin
- kx := x - LastX;
- ky := y - LastY;
- if FAlign and not GridCheck then Exit;
- if FirstBandMove and (SelNum = 1) and ((kx <> 0) or (ky <> 0)) and
- not (ssAlt in Shift) then
- if TfrView(Objects[TopSelected]).Typ = gtBand then
- begin
- Bnd := Objects[TopSelected];
- if (Bnd.Restrictions and frrfDontMove) = 0 then
- begin
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Typ <> gtBand then
- if (t.x >= Bnd.x) and (t.x + t.dx <= Bnd.x + Bnd.dx) and
- (t.y >= Bnd.y) and (t.y + t.dy <= Bnd.y + Bnd.dy) then
- begin
- t.Selected := True;
- Inc(SelNum);
- end;
- end;
- FDesigner.SelectionChanged;
- GetMultipleSelected;
- end;
- end;
- FirstBandMove := False;
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape);
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if not t.Selected then continue;
- if DesignerRestrictions * [frdrDontMoveObj] = [] then
- if (t.Restrictions and frrfDontMove) = 0 then
- begin
- t.x := t.x + kx;
- t.y := t.y + ky;
- end;
- end;
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape)
- else
- Draw(10000);
- Inc(LastX, kx);
- Inc(LastY, ky);
- FDesigner.PBox1Paint(nil);
- end;
- // resizing
- if Down and (Mode = mdSelect) and (SelNum = 1) and (Cursor <> crDefault) then
- begin
- kx := x - LastX;
- ky := y - LastY;
- if FAlign and not GridCheck then Exit;
- t := Objects[TopSelected];
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape);
- w := 3;
- if (DesignerRestrictions * [frdrDontSizeObj] = []) and
- ((t.Restrictions and frrfDontSize) = 0) then
- begin
- if Cursor = crSizeNWSE then
- if (CT <> ct2) and ((CT = ct1) or Cont(t.x, t.y, LastX, LastY)) then
- begin
- t.x := t.x + kx;
- t.dx := t.dx - kx;
- t.y := t.y + ky;
- t.dy := t.dy - ky;
- if CheckNegative(t) then
- CT := ct2 else
- CT := ct1;
- end
- else
- begin
- t.dx := t.dx + kx;
- t.dy := t.dy + ky;
- if CheckNegative(t) then
- CT := ct1 else
- CT := ct2;
- end;
- if Cursor = crSizeNESW then
- if (CT <> ct4) and ((CT = ct3) or Cont(t.x + t.dx, t.y, LastX, LastY)) then
- begin
- t.y := t.y + ky;
- t.dx := t.dx + kx;
- t.dy := t.dy - ky;
- if CheckNegative(t) then
- CT := ct4 else
- CT := ct3;
- end
- else
- begin
- t.x := t.x + kx;
- t.dx := t.dx - kx;
- t.dy := t.dy + ky;
- if CheckNegative(t) then
- CT := ct3 else
- CT := ct4;
- end;
- if Cursor = crSizeWE then
- if (CT <> ct6) and ((CT = ct5) or Cont(t.x, t.y + t.dy div 2, LastX, LastY)) then
- begin
- t.x := t.x + kx;
- t.dx := t.dx - kx;
- if CheckNegative(t) then
- CT := ct6 else
- CT := ct5;
- end
- else
- begin
- t.dx := t.dx + kx;
- if CheckNegative(t) then
- CT := ct5 else
- CT := ct6;
- end;
- if Cursor = crSizeNS then
- if (CT <> ct8) and ((CT = ct7) or Cont(t.x + t.dx div 2, t.y, LastX, LastY)) then
- begin
- t.y := t.y + ky;
- t.dy := t.dy - ky;
- if CheckNegative(t) then
- CT := ct8 else
- CT := ct7;
- end
- else
- begin
- t.dy := t.dy + ky;
- if CheckNegative(t) then
- CT := ct7 else
- CT := ct8;
- end;
- end;
- if FDesigner.ShapeMode = smFrame then
- DrawPage(dmShape)
- else
- Draw(10000);
- Inc(LastX, kx);
- Inc(LastY, ky);
- FDesigner.PBox1Paint(nil);
- end;
-
- if shift = [ssLeft] then
- begin
- ii := 0;
- with TScrollBox(Parent) do
- begin
- if x > (ClientRect.Right + HorzScrollBar.Position) then
- begin
- ii := x - (ClientRect.Right + HorzScrollBar.Position);
- HorzScrollBar.Position := HorzScrollBar.Position + ii;
- end;
- if x < HorzScrollBar.Position then
- begin
- ii := HorzScrollBar.Position - x;
- HorzScrollBar.Position := HorzScrollBar.Position - ii;
- end;
- if y > (ClientRect.Bottom + VertScrollBar.Position) then
- begin
- ii := y - (ClientRect.Bottom + VertScrollBar.Position);
- VertScrollBar.Position := VertScrollBar.Position + ii;
- end;
- if y < VertScrollBar.Position then
- begin
- ii := VertScrollBar.Position - y;
- VertScrollBar.Position := VertScrollBar.Position - ii;
- end;
- end;
- if ii <> 0 then
- begin
- self.Refresh;
- DrawFocusRect(OldRect);
- end;
- end;
- end;
-
- procedure TfrDesignerPage.DClick(Sender: TObject);
- begin
- Down := False;
- if SelNum = 0 then
- if FDesigner.PageType = ptReport then
- begin
- FDesigner.PgB3Click(nil);
- DFlag := True;
- end
- else
- begin
- DFlag := True;
- FDesigner.Page.ScriptEditor(nil);
- end
- else if SelNum = 1 then
- begin
- DFlag := True;
- if WasCtrl then
- FDesigner.ShowMemoEditor(nil) else
- FDesigner.ShowEditor;
- end
- else Exit;
- end;
-
- procedure TfrDesignerPage.MouseLeave(AControl: TControl);
- begin
- if ((Mode = mdInsert) and not Down) or FDrag then
- begin
- if FDesigner.PageType = ptReport then
- DrawFocusRect(OldRect);
- OffsetRect(OldRect, -10000, -10000);
- end;
- end;
-
- procedure TfrDesignerPage.DoDragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- var
- kx, ky: Integer;
- begin
- Accept := (Source is TListBox) and
- (DesignerRestrictions * [frdrDontCreateObj] = []) and
- (FDesigner.PageType = ptReport);
- if not Accept then Exit;
- if not FDrag then
- begin
- FDrag := True;
- FDesigner.GetDefaultSize(kx, ky);
- OldRect := Rect(x - 4, y - 4, x + kx - 4, y + ky - 4);
- end
- else
- DrawFocusRect(OldRect);
- RoundCoord(x, y);
- OffsetRect(OldRect, x - OldRect.Left - 4, y - OldRect.Top - 4);
- DrawFocusRect(OldRect);
- end;
-
- procedure TfrDesignerPage.DoDragDrop(Sender, Source: TObject; X, Y: Integer);
- var
- t: TfrView;
- begin
- DrawPage(dmSelection);
- // emulating object insertion
- FDesigner.OB2.Down := True;
- Cursor := crCross;
- MUp(nil, mbLeft, [], 0, 0);
- t := Objects[TopSelected];
- t.Memo.Text := '[' + frFieldsDialog.DBField + ']';
- DrawSelection(t);
- t.Draw(Canvas);
- DrawSelection(t);
- end;
-
- { TfrUndoBuffer }
-
- constructor TfrUndoBuffer.Create;
- begin
- FUndo := TList.Create;
- FRedo := TList.Create;
- end;
-
- destructor TfrUndoBuffer.Destroy;
- begin
- ClearUndo;
- ClearRedo;
- FUndo.Free;
- FRedo.Free;
- inherited;
- end;
-
- procedure TfrUndoBuffer.AddUndo(Report: TfrReport);
- var
- m: TMemoryStream;
- begin
- m := TMemoryStream.Create;
- FUndo.Add(m);
- Report.SaveToStream(m);
- end;
-
- procedure TfrUndoBuffer.AddRedo(Report: TfrReport);
- var
- m: TMemoryStream;
- begin
- m := TMemoryStream.Create;
- FRedo.Add(m);
- Report.SaveToStream(m);
- end;
-
- procedure TfrUndoBuffer.GetUndo(Report: TfrReport);
- var
- m: TMemoryStream;
- begin
- m := FUndo[FUndo.Count - 1];
- m.Position := 0;
- Report.LoadFromStream(m);
- m.Free;
- FUndo.Delete(FUndo.Count - 1);
- end;
-
- procedure TfrUndoBuffer.GetRedo(Report: TfrReport);
- var
- m: TMemoryStream;
- begin
- m := FRedo[FRedo.Count - 1];
- m.Position := 0;
- Report.LoadFromStream(m);
- m.Free;
- FRedo.Delete(FRedo.Count - 1);
- end;
-
- procedure TfrUndoBuffer.ClearUndo;
- begin
- while FUndo.Count > 0 do
- begin
- TMemoryStream(FUndo[0]).Free;
- FUndo.Delete(0);
- end;
- end;
-
- procedure TfrUndoBuffer.ClearRedo;
- begin
- while FRedo.Count > 0 do
- begin
- TMemoryStream(FRedo[0]).Free;
- FRedo.Delete(0);
- end;
- end;
-
-
- {-----------------------------------------------------------------------------}
- procedure BDown(SB: TToolButton);
- begin
- SB.Down := True;
- end;
-
- procedure BUp(SB: TToolButton);
- begin
- SB.Down := False;
- end;
-
- procedure TfrDesignerForm.Localize;
- var
- b: TBitmap;
- begin
- FCaption := (S53080);
- Panel1.Caption := (S53081);
- Panel2.Caption := (S53082);
- Panel3.Caption := (S53083);
- Panel4.Caption := (S53084);
- Panel5.Caption := (S53085);
- Panel6.Caption := (S53086);
- FileBtn1.Hint := (S53087);
- FileBtn2.Hint := (S53088);
- FileBtn3.Hint := (S53089);
- FileBtn4.Hint := (S53090);
- CutB.Hint := (S53091);
- CopyB.Hint := (S53092);
- PstB.Hint := (S53093);
- UndoB.Hint := (S53094);
- RedoB.Hint := (S53095);
- ZB1.Hint := (S53096);
- ZB2.Hint := (S53097);
- SelAllB.Hint := (S53098);
- PgB1.Hint := (S53099);
- PgB2.Hint := (S53100);
- PgB3.Hint := (S53101);
- PgB4.Hint := (S53193);
- GB1.Hint := (S53102);
- GB2.Hint := (S53103);
- GB3.Hint := (S53104);
- HelpBtn.Hint := (S53032);
- ExitB.Caption := (S53105);
- ExitB.Hint := (S53106);
- AlB1.Hint := (S53107);
- AlB2.Hint := (S53108);
- AlB3.Hint := (S53109);
- AlB4.Hint := (S53110);
- AlB5.Hint := (S53111);
- AlB6.Hint := (S53112);
- AlB7.Hint := (S53113);
- AlB8.Hint := (S53114);
- FnB1.Hint := (S53115);
- FnB2.Hint := (S53116);
- FnB3.Hint := (S53117);
- ClB2.Hint := (S53118);
- HlB1.Hint := (S53119);
- C3.Hint := (S53120);
- C2.Hint := (S53121);
- FrB1.Hint := (S53122);
- FrB2.Hint := (S53123);
- FrB3.Hint := (S53124);
- FrB4.Hint := (S53125);
- FrB5.Hint := (S53126);
- FrB6.Hint := (S53127);
- ClB1.Hint := (S53128);
- ClB3.Hint := (S53129);
- C4.Hint := (S53130);
- OB1.Hint := (S53132);
- OB2.Hint := (S53133);
- OB3.Hint := (S53134);
- OB4.Hint := (S53135);
- OB5.Hint := (S53136);
- OB6.Hint := (S53137);
- Align1.Hint := (S53138);
- Align2.Hint := (S53139);
- Align3.Hint := (S53140);
- Align4.Hint := (S53141);
- Align5.Hint := (S53142);
- Align6.Hint := (S53143);
- Align7.Hint := (S53144);
- Align8.Hint := (S53145);
- Align9.Hint := (S53146);
- Align10.Hint := (S53147);
- N2.Caption := (S53148);
- N1.Caption := (S53149);
- N3.Caption := (S53150);
- N5.Caption := (S53151);
- N16.Caption := (S53152);
- N6.Caption := (S53153);
- FileMenu.Caption := (S53154);
- N23.Caption := (S53155);
- N19.Caption := (S53156);
- N20.Caption := (S53157);
- N42.Caption := (S53158);
- N8.Caption := (S53159);
- N25.Caption := (S53160);
- N39.Caption := (S53161);
- N10.Caption := (S53162);
- EditMenu.Caption := (S53163);
- N46.Caption := (S53164);
- N48.Caption := (S53165);
- N11.Caption := (S53166);
- N12.Caption := (S53167);
- N13.Caption := (S53168);
- N27.Caption := (S53169);
- N28.Caption := (S53170);
- N36.Caption := (S53171);
- N29.Caption := (S53172);
- N30.Caption := (S53173);
- N32.Caption := (S53174);
- N33.Caption := (S53175);
- ToolMenu.Caption := (S53176);
- N37.Caption := (S53177);
- MastMenu.Caption := (S53178);
- N14.Caption := (S53179);
- Pan1.Caption := (S53180);
- Pan2.Caption := (S53181);
- Pan3.Caption := (S53182);
- Pan4.Caption := (S53183);
- Pan5.Caption := (S53184);
- Pan6.Caption := (S53185);
- Pan7.Caption := (S53186);
- Pan8.Caption := (S53450);
- N34.Caption := (S53187);
- N17.Caption := (S53188);
- N22.Caption := (S53189);
- N35.Caption := (S53190);
- N15.Caption := (S53192);
- StB1.Hint := (S53191);
- N41.Caption := N29.Caption;
- N41.OnClick := N29.OnClick;
- N43.Caption := N30.Caption;
- N43.OnClick := N30.OnClick;
- N44.Caption := N25.Caption;
- N44.OnClick := N25.OnClick;
- N45.Caption := N15.Caption;
- N45.OnClick := N15.OnClick;
-
- b := TBitmap.Create;
- b.Width := 16; b.Height := 16;
- b.LoadFromResourceName(HInstance, 'FR_BOLD');
- MainImages.ReplaceMasked(28, b, clSilver);
- b.LoadFromResourceName(HInstance, 'FR_ITALIC');
- MainImages.ReplaceMasked(29, b, clSilver);
- b.LoadFromResourceName(HInstance, 'FR_UNDRLINE');
- MainImages.ReplaceMasked(30, b, clSilver);
- b.Free;
- end;
-
- procedure TfrDesignerForm.FormCreate(Sender: TObject);
- var
- i: Integer;
- begin
- Localize;
- Busy := True;
- FirstTime := True;
- UndoBuffer := TfrUndoBuffer.Create;
-
- PageView := TfrDesignerPage.Create(ScrollBox1);
- PageView.FDesigner := Self;
- PageView.PopupMenu := Popup1;
- PageView.ShowHint := True;
-
- ColorSelector := TColorSelector.Create(Self);
- ColorSelector.OnColorSelected := ColorSelected;
- ColorSelector.Hide;
-
- for i := 0 to frAddInsCount - 1 do
- with frAddIns[i] do
- if not IsControl then
- RegisterObject(ButtonBmp, ButtonHint, Integer(gtAddIn) + i, IsControl);
-
- for i := 0 to frAddInsCount - 1 do
- with frAddIns[i] do
- if IsControl then
- RegisterObject(ButtonBmp, ButtonHint, Integer(gtAddIn) + i, IsControl);
-
- if FirstInstance then
- begin
- RegisterTool((SInsertFields), Image2.Picture.Bitmap, InsFieldsClick);
- for i := 0 to frToolsCount - 1 do
- with frTools[i] do
- RegisterTool(Caption, ButtonBmp, OnClick);
- end;
-
- InspForm := TfrInspForm.Create(Self);
- with InspForm do
- begin
- ClearProperties;
- AddProperty('', 0, [frdtString], nil, Null, nil);
- OnModify := Self.OnModify;
- OnHeightChanged := HeightChanged;
- OnSelectionChanged := InspSelectionChanged;
- OnGetObjects := InspGetObjects;
- end;
- CurPage := 0;
- RestoreState;
-
- OnMouseWheelUp := FormMouseWheelUp;
- OnMouseWheelDown := FormMouseWheelDown;
- end;
-
- procedure TfrDesignerForm.FormShow(Sender: TObject);
-
- procedure DoHide(Obj: TObject; Enabled: Boolean);
- begin
- if Obj is TMenuItem then
- TMenuItem(Obj).Enabled := Enabled
- else
- begin
- if (DesignerComp <> nil) and DesignerComp.HideDisabledButtons then
- TControl(Obj).Visible := Enabled else
- TControl(Obj).Enabled := Enabled
- end
- end;
-
- begin
- // Screen.Cursors[crPencil].LoadFromResourceName(hInstance, 'FR_PENCIL');
- Panel7.Hide;
-
- if not FirstInstance then
- begin
- DoHide(PgB1, False);
- DoHide(PgB2, False);
- DoHide(N41, False);
- DoHide(N43, False);
- DoHide(N29, False);
- DoHide(N30, False);
- end;
-
- DoHide(FileBtn1, FirstInstance and (DesignerRestrictions * [frdrDontCreateReport] = []));
- DoHide(N23, FirstInstance and (DesignerRestrictions * [frdrDontCreateReport] = []));
-
- DoHide(FileBtn4, FirstInstance and not (CurReport is TfrCompositeReport) and
- (DesignerRestrictions * [frdrDontPreviewReport] = []));
- DoHide(N39, FirstInstance and not (CurReport is TfrCompositeReport) and
- (DesignerRestrictions * [frdrDontPreviewReport] = []));
-
- DoHide(OB3, FirstInstance);
- DoHide(OB5, FirstInstance);
-
- DoHide(FileBtn2, DesignerRestrictions * [frdrDontLoadReport] = []);
- DoHide(N19, DesignerRestrictions * [frdrDontLoadReport] = []);
-
- DoHide(FileBtn3, DesignerRestrictions * [frdrDontSaveReport] = []);
- DoHide(N17, DesignerRestrictions * [frdrDontSaveReport] = []);
- DoHide(N20, DesignerRestrictions * [frdrDontSaveReport] = []);
-
- DoHide(PgB1, DesignerRestrictions * [frdrDontCreatePage] = []);
- DoHide(N29, DesignerRestrictions * [frdrDontCreatePage] = []);
- DoHide(N41, DesignerRestrictions * [frdrDontCreatePage] = []);
-
- DoHide(PgB2, DesignerRestrictions * [frdrDontDeletePage] = []);
- DoHide(N30, DesignerRestrictions * [frdrDontDeletePage] = []);
- DoHide(N43, DesignerRestrictions * [frdrDontDeletePage] = []);
-
- DoHide(PgB3, DesignerRestrictions * [frdrDontEditPage] = []);
- DoHide(N25, DesignerRestrictions * [frdrDontEditPage] = []);
- DoHide(N44, DesignerRestrictions * [frdrDontEditPage] = []);
-
- DoHide(PgB4, DesignerRestrictions * [frdrDontCreatePage] = []);
- DoHide(N15, DesignerRestrictions * [frdrDontCreatePage] = []);
- DoHide(N45, DesignerRestrictions * [frdrDontCreatePage] = []);
-
- DoHide(N42, DesignerRestrictions * [frdrDontEditVariables] = []);
- DoHide(N8, DesignerRestrictions * [frdrDontChangeReportOptions] = []);
-
- if FirstTime then
- SetMenuBitmaps;
- FirstTime := False;
-
- ClearUndo;
- ClearRedo;
- Modified := False;
- CurReport.ComponentModified := False;
- Busy := True;
- DocMode := dmDesigning;
-
- LastFontName := C2.Items[0];
- if C2.Items.IndexOf('Arial') <> -1 then
- LastFontName := 'Arial';
- LastFontSize := 10;
-
- // CurPage := 0; // this cause page sizing
- if PageForm <> nil then
- PageForm.Show;
-
- if FirstInstance then
- CurDocName := CurReport.FileName else
- CurDocName := (SUntitled);
- Unselect;
- PageView.Init;
- EnableControls;
- OB1.Down := True;
- ColorSelector.Hide;
- LinePanel.Hide;
- ShowPosition;
- // RestoreState;
- // FormResize(nil);
- ScrollBox1.OnResize := ScrollBox1Resize;
- AssignDefEditors;
- if (DesignerComp <> nil) and Assigned(DesignerComp.OnShow) then
- DesignerComp.OnShow(Self);
- end;
-
- procedure TfrDesignerForm.FormDestroy(Sender: TObject);
- begin
- // workaround
- MainImages.Clear;
- DisabledImages.Clear;
- ImageList1.Clear;
- ImageList2.Clear;
- MainImages.Free;
- DisabledImages.Free;
-
- SaveState;
- CurReport.FileName := CurDocName;
- UndoBuffer.Free;
- InspForm.Free;
- if PageForm <> nil then
- PageForm.Hide;
- ScrollBox1.OnResize := nil;
-
- PageView.Free;
- if PageForm <> nil then
- begin
- PageForm.Free;
- PageForm := nil;
- end;
- if FirstInstance then
- ShowFieldsDialog(False);
- ColorSelector.Free;
- end;
-
- procedure TfrDesignerForm.FormResize(Sender: TObject);
- begin
- if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
- with ScrollBox1 do
- begin
- HorzScrollBar.Position := 0;
- VertScrollBar.Position := 0;
- end;
- PageView.SetPage;
- Panel7.Top := StatusBar1.Top + 3;
- Panel7.Show;
- end;
-
- procedure TfrDesignerForm.AssignDefEditors;
- begin
- frMemoEditor := DefMemoEditor;
- frPictureEditor := DefPictureEditor;
- frTagEditor := DefTagEditor;
- frRestrEditor := DefRestrEditor;
- frHighlightEditor := DefHighlightEditor;
- frFieldEditor := DefFieldEditor;
- frDataSourceEditor := DefDataSourceEditor;
- frCrossDataSourceEditor := DefCrossDataSourceEditor;
- frGroupEditor := DefGroupEditor;
- frFontEditor := DefFontEditor;
- end;
-
- procedure TfrDesignerForm.ScrollBox1Resize(Sender: TObject);
- begin
- PageView.SetPage;
- end;
-
- procedure TfrDesignerForm.SetCurPage(Value: Integer);
-
- procedure SwitchObjectsToolbar;
- var
- i: Integer;
- c: TControl;
- begin
- for i := 0 to Toolbar4.ControlCount - 1 do
- begin
- c := Toolbar4.Controls[i];
- if (c is TToolButton) and (c <> OB1) then
- c.Enabled := not c.Enabled;
- end;
- Panel4.AdjustBounds;
- if Panel4.IsFloat then
- begin
- Panel4.FloatWindow.ClientWidth := Panel4.Width;
- Panel4.FloatWindow.ClientHeight := Panel4.Height;
- end;
- end;
-
- procedure PrepareObjects;
- var
- i: Integer;
- t: TfrView;
- begin
- DocMode := dmDesigning;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- t.Draw(GridBitmap.Canvas);
- end;
- end;
-
- begin
- FCurPage := Value;
- Page := CurReport.Pages[FCurPage];
- FPageType := Page.PageType;
- FR_Class.CurPage := Page;
-
- if (FPageType = ptDialog) and (PageForm = nil) then
- begin
- if OB2.Enabled then
- SwitchObjectsToolbar;
- PageForm := TfrPageForm.Create(Self);
- PageForm.SetBounds(Page.Left, Page.Top, Page.Width, Page.Height);
- PageForm.OnCloseQuery := PageFormCloseQuery;
- PageForm.OnKeyDown := PageFormKeyDown;
- PageView.Color := clBtnFace;
- PageView.Parent := PageForm;
- PageForm.Icon := Icon;
- PageForm.Show;
- end
- else if (FPageType = ptReport) and (PageForm <> nil) then
- begin
- PageForm.OnResize := nil;
- if not OB2.Enabled then
- SwitchObjectsToolbar;
- PageView.Parent := ScrollBox1;
- PageView.Color := clWhite;
- PageForm.Free;
- PageForm := nil;
- end;
-
- if PageForm <> nil then
- begin
- PageForm.OnResize := nil;
- PageForm.SetBounds(Page.Left, Page.Top, Page.Width, Page.Height);
- PageForm.OnResize := PageFormResize;
- PageForm.Caption := Page.Caption;
- PageForm.Color := Page.Color;
- end;
- PageView.SetPage;
- ScrollBox1.VertScrollBar.Position := 0;
- ScrollBox1.HorzScrollBar.Position := 0;
- SetPageTitles;
- Tab1.OnChange := nil;
- Tab1.TabIndex := Value;
- Application.HandleMessage;
- Tab1.OnChange := Tab1Change;
- ResetSelection;
- SendBandsToDown;
- PrepareObjects;
- PageView.Repaint;
- end;
-
- procedure TfrDesignerForm.SetGridSize(Value: Integer);
- begin
- if FGridSizeX = Value then Exit;
- FGridSizeX := Value;
- FGridSizeY := Value;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.SetGridShow(Value: Boolean);
- begin
- if FGridShow = Value then Exit;
- FGridShow := Value;
- GB1.Down := Value;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.SetGridAlign(Value: Boolean);
- begin
- if FGridAlign = Value then Exit;
- GB2.Down := Value;
- FGridAlign := Value;
- end;
-
- procedure TfrDesignerForm.SetUnits(Value: TfrReportUnits);
- var
- s: String;
- begin
- FUnits := Value;
- case Value of
- ruPixels: s := (SPixels);
- ruMM: s := (SMM);
- ruInches: s := (SInches);
- end;
- StatusBar1.Panels[0].Text := s;
- ShowPosition;
- end;
-
- procedure TfrDesignerForm.SetCurDocName(Value: String);
- begin
- FCurDocName := Value;
- Caption := FCaption + ' - ' + ExtractFileName(Value);
- end;
-
- procedure TfrDesignerForm.SetModified(Value: Boolean);
- begin
- CurReport.Modified := Value;
- if Value and FirstInstance then
- CurReport.ComponentModified := True;
- FileBtn3.Enabled := Value and (DesignerRestrictions * [frdrDontSaveReport] = []);
- N20.Enabled := FileBtn3.Enabled;
- end;
-
- function TfrDesignerForm.GetModified: Boolean;
- begin
- Result := CurReport.Modified;
- end;
-
- procedure TfrDesignerForm.SelectObject(ObjName: String);
- var
- t: TfrView;
- begin
- t := Page.FindObject(ObjName);
- if t <> nil then // it's object name
- begin
- Unselect;
- SelNum := 1;
- t.Selected := True;
- SelectionChanged;
- RedrawPage;
- PageView.GetMultipleSelected;
- ShowPosition;
- end
- else if Pos('Page', ObjName) = 1 then // it's page name
- CurPage := StrToInt(Copy(ObjName, 5, 255)) - 1;
- end;
-
- function TfrDesignerForm.InsertDBField: String;
- begin
- Result := '';
- with TfrFieldsForm.Create(nil) do
- begin
- if ShowModal = mrOk then
- if DBField <> '' then
- Result := '[' + DBField + ']';
- Free;
- end;
- end;
-
- function TfrDesignerForm.InsertExpression: String;
- begin
- Result := '';
- with TfrExprForm.Create(nil) do
- begin
- if ShowModal = mrOk then
- begin
- Result := ExprMemo.Text;
- if Result <> '' then
- if not ((Result[1] = '[') and (Result[Length(Result)] = ']') and
- (Pos('[', Copy(Result, 2, 255)) = 0)) then
- Result := '[' + Result + ']';
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.RegisterObject(ButtonBmp: TBitmap;
- ButtonHint: String; ButtonTag: Integer; IsControl: Boolean);
- var
- b: TToolButton;
- begin
- MainImages.AddMasked(ButtonBMP, ButtonBMP.TransparentColor);
- DisabledImages.AddMasked(Image1.Picture.Bitmap, clSilver);
- b := TToolButton.Create(Self);
- with b do
- begin
- ImageIndex := MainImages.Count - 1;
-
- Hint := ButtonHint;
- Grouped := True;
- Style := tbsCheck;
- SetBounds(1000, 1000, 23, 23);
- Tag := ButtonTag;
- OnMouseDown := OB2MouseDown;
- Parent := ToolBar4;
- Enabled := not IsControl;
- end;
- end;
-
- procedure TfrDesignerForm.RegisterTool(MenuCaption: String; ButtonBmp: TBitmap;
- OnClick: TNotifyEvent);
- var
- m: TMenuItem;
- b: TfrTBButton;
- begin
- m := TMenuItem.Create(MastMenu);
-
- m.Caption := MenuCaption;
- m.OnClick := OnClick;
- MastMenu.Enabled := True;
- MastMenu.Add(m);
- Panel6.Height := 27; Panel6.Width := 27;
- b := TfrTBButton.Create(Self);
- with b do
- begin
- Parent := Panel6;
- Glyph := ButtonBmp;
- Hint := MenuCaption;
- Flat := True;
- SetBounds(1000, 1000, 23, 23);
- Tag := 36;
- end;
- b.OnClick := OnClick;
- Panel6.AdjustBounds;
- end;
-
- procedure TfrDesignerForm.AddPage;
- begin
- if DesignerRestrictions * [frdrDontCreatePage] <> [] then Exit;
- AddUndo;
- CurReport.Pages.Add;
- Page := CurReport.Pages[CurReport.Pages.Count - 1];
- Page.CreateUniqueName;
- PgB3Click(nil);
- if WasOk then
- begin
- Modified := True;
- CurPage := CurReport.Pages.Count - 1
- end
- else
- begin
- CurReport.Pages.Delete(CurReport.Pages.Count - 1);
- CurPage := CurPage;
- end;
- end;
-
- procedure TfrDesignerForm.RemovePage(n: Integer);
- procedure AdjustSubReports;
- var
- i, j: Integer;
- t: TfrView;
- begin
- with CurReport do
- for i := 0 to Pages.Count - 1 do
- begin
- j := 0;
- while j < Pages[i].Objects.Count do
- begin
- t := Pages[i].Objects[j];
- if t.Typ = gtSubReport then
- if TfrSubReportView(t).SubPage = n then
- begin
- Pages[i].Delete(j);
- Dec(j);
- end
- else if TfrSubReportView(t).SubPage > n then
- Dec(TfrSubReportView(t).SubPage);
- Inc(j);
- end;
- end;
- end;
- begin
- if DesignerRestrictions * [frdrDontDeletePage] <> [] then Exit;
- AddUndo;
- Modified := True;
- with CurReport do
- if (n >= 0) and (n < Pages.Count) then
- if Pages.Count = 1 then
- Pages[n].Clear else
- begin
- CurReport.Pages.Delete(n);
- Tab1.Tabs.Delete(n);
- Tab1.TabIndex := 0;
- AdjustSubReports;
- CurPage := 0;
- end;
- end;
-
- procedure TfrDesignerForm.SetPageTitles;
- var
- i: Integer;
- s: String;
-
- function IsSubreport(PageN: Integer): Boolean;
- var
- i, j: Integer;
- t: TfrView;
- begin
- Result := False;
- with CurReport do
- for i := 0 to Pages.Count - 1 do
- for j := 0 to Pages[i].Objects.Count - 1 do
- begin
- t := Pages[i].Objects[j];
- if t.Typ = gtSubReport then
- if TfrSubReportView(t).SubPage = PageN then
- begin
- s := t.Name;
- Result := True;
- Exit;
- end;
- end;
- end;
-
- begin
- if Tab1.Tabs.Count = CurReport.Pages.Count then
- for i := 0 to Tab1.Tabs.Count - 1 do
- begin
- if not IsSubreport(i) then
- s := (SPg) + IntToStr(i + 1);// CurReport.Pages[i].Name;
- if Tab1.Tabs[i].Caption <> s then
- Tab1.Tabs[i].Caption := s;
- end
- else
- begin
- Tab1.Tabs.Clear;
- for i := 0 to CurReport.Pages.Count - 1 do
- begin
- if not IsSubreport(i) then
- s := (SPg) + IntToStr(i + 1); //CurReport.Pages[i].Name;
- Tab1.Tabs.Add(s);
- end;
- end;
- end;
-
- procedure TfrDesignerForm.CutToClipboard;
- var
- i: Integer;
- t: TfrView;
- m: TMemoryStream;
- begin
- ClearClipBoard;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- m := TMemoryStream.Create;
- frWriteByte(m, t.Typ);
- frWriteString(m, t.ClassName);
- t.SaveToStream(m);
- ClipBd.Add(m);
- end;
- end;
- DeleteObjects;
- end;
-
- procedure TfrDesignerForm.CopyToClipboard;
- var
- i: Integer;
- t: TfrView;
- m: TMemoryStream;
- begin
- ClearClipBoard;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- m := TMemoryStream.Create;
- frWriteByte(m, t.Typ);
- frWriteString(m, t.ClassName);
- t.SaveToStream(m);
- ClipBd.Add(m);
- end;
- end;
- end;
-
- procedure TfrDesignerForm.SelectAll;
- var
- i: Integer;
- begin
- SelNum := 0;
- for i := 0 to Objects.Count - 1 do
- begin
- TfrView(Objects[i]).Selected := True;
- Inc(SelNum);
- end;
- end;
-
- procedure TfrDesignerForm.Unselect;
- var
- i: Integer;
- begin
- SelNum := 0;
- for i := 0 to Objects.Count - 1 do
- TfrView(Objects[i]).Selected := False;
- end;
-
- procedure TfrDesignerForm.NumberOfSelected;
- var
- i: Integer;
- begin
- SelNum := 0;
- for i := 0 to Objects.Count - 1 do
- if TfrView(Objects[i]).Selected then
- Inc(SelNum);
- end;
-
- procedure TfrDesignerForm.ResetSelection;
- begin
- Unselect;
- EnableControls;
- ShowPosition;
- end;
-
- function TfrDesignerForm.PointsToUnits(x: Double): Double;
- begin
- Result := x;
- case FUnits of
- ruMM: Result := x / 18 * 5;
- ruInches: Result := x / 18 * 5 / 25.4;
- end;
- end;
-
- function TfrDesignerForm.UnitsToPoints(x: Double): Double;
- begin
- Result := x;
- case FUnits of
- ruMM: Result := x / 5 * 18;
- ruInches: Result := x * 25.4 / 5 * 18;
- end;
- end;
-
- procedure TfrDesignerForm.RedrawPage;
- begin
- PageView.Draw(10000);
- end;
-
- procedure TfrDesignerForm.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- StepX, StepY: Integer;
- i, tx, ty, tx1, ty1, d, d1: Integer;
- t, t1: TfrView;
- begin
- // thank you for buggy CLX, Borland!
- if InspForm.Edit1.Focused then Exit;
- //
- StepX := 0; StepY := 0;
- if Key = key_F11 then
- InspForm.Grow;
- if (Key = key_Return) and (ActiveControl = C3) then
- begin
- Key := 0;
- DoClick(C3);
- end;
- if (Key = key_Return) and (ActiveControl = C4) then
- begin
- Key := 0;
- DoClick(C4);
- end;
- if (Key = key_Insert) and (Shift = []) and (PageType = ptReport) then
- begin
- ShowFieldsDialog(True);
- Key := 0;
- end;
- if (Key = key_Delete) and DelEnabled and (ActiveControl <> C3) then
- begin
- DeleteObjects;
- Key := 0;
- end;
- if (Key = key_Return) and EditEnabled then
- begin
- if ssCtrl in Shift then
- ShowMemoEditor(nil) else
- ShowEditor;
- end;
- if (Chr(Key) in ['1'..'9']) and (ssCtrl in Shift) and DelEnabled then
- begin
- C4.Text := Chr(Key);
- DoClick(C4);
- Key := 0;
- end;
- if (Chr(Key) = 'F') and (ssCtrl in Shift) and DelEnabled then
- begin
- FrB5.Click;
- Key := 0;
- end;
- if (Chr(Key) = 'D') and (ssCtrl in Shift) and DelEnabled then
- begin
- FrB6.Click;
- Key := 0;
- end;
- if (Chr(Key) = 'G') and (ssCtrl in Shift) then
- begin
- ShowGrid := not ShowGrid;
- Key := 0;
- end;
- if (ssCtrl in Shift) and EditEnabled then
- begin
- if Chr(Key) = 'B' then
- begin
- FnB1.Down := not FnB1.Down;
- DoClick(FnB1);
- end;
- if Chr(Key) = 'I' then
- begin
- FnB2.Down := not FnB2.Down;
- DoClick(FnB2);
- end;
- if Chr(Key) = 'U' then
- begin
- FnB3.Down := not FnB3.Down;
- DoClick(FnB3);
- end;
- end;
- if CutEnabled then
- if (Key = key_Delete) and (ssShift in Shift) then CutBClick(Self);
- if CopyEnabled then
- if (Key = key_Insert) and (ssCtrl in Shift) then CopyBClick(Self);
- if PasteEnabled then
- if (Key = key_Insert) and (ssShift in Shift) then PstBClick(Self);
- if Key = key_Prior then
- with ScrollBox1.VertScrollBar do
- begin
- Position := Position - 200;
- Key := 0;
- end;
- if Key = key_Next then
- with ScrollBox1.VertScrollBar do
- begin
- Position := Position + 200;
- Key := 0;
- end;
- if SelNum > 0 then
- begin
- if Key = key_Up then StepY := -1
- else if Key = key_Down then StepY := 1
- else if Key = key_Left then StepX := -1
- else if Key = key_Right then StepX := 1;
- if (StepX <> 0) or (StepY <> 0) then
- begin
- if ssCtrl in Shift then
- MoveObjects(StepX, StepY, False)
- else if ssShift in Shift then
- MoveObjects(StepX, StepY, True)
- else if SelNum = 1 then
- begin
- t := Objects[TopSelected];
- tx := t.x; ty := t.y; tx1 := t.x + t.dx; ty1 := t.y + t.dy;
- d := 10000; t1 := nil;
- for i := 0 to Objects.Count-1 do
- begin
- t := Objects[i];
- if not t.Selected and (t.Typ <> gtBand) then
- begin
- d1 := 10000;
- if StepX <> 0 then
- begin
- if t.y + t.dy < ty then
- d1 := ty - (t.y + t.dy)
- else if t.y > ty1 then
- d1 := t.y - ty1
- else if (t.y <= ty) and (t.y + t.dy >= ty1) then
- d1 := 0
- else
- d1 := t.y - ty;
- if ((t.x <= tx) and (StepX = 1)) or
- ((t.x + t.dx >= tx1) and (StepX = -1)) then
- d1 := 10000;
- if StepX = 1 then
- if t.x >= tx1 then
- d1 := d1 + t.x - tx1 else
- d1 := d1 + t.x - tx
- else if t.x + t.dx <= tx then
- d1 := d1 + tx - (t.x + t.dx) else
- d1 := d1 + tx1 - (t.x + t.dx);
- end
- else if StepY <> 0 then
- begin
- if t.x + t.dx < tx then
- d1 := tx - (t.x + t.dx)
- else if t.x > tx1 then
- d1 := t.x - tx1
- else if (t.x <= tx) and (t.x + t.dx >= tx1) then
- d1 := 0
- else
- d1 := t.x - tx;
- if ((t.y <= ty) and (StepY = 1)) or
- ((t.y + t.dy >= ty1) and (StepY = -1)) then
- d1 := 10000;
- if StepY = 1 then
- if t.y >= ty1 then
- d1 := d1 + t.y - ty1 else
- d1 := d1 + t.y - ty
- else if t.y + t.dy <= ty then
- d1 := d1 + ty - (t.y + t.dy) else
- d1 := d1 + ty1 - (t.y + t.dy);
- end;
- if d1 < d then
- begin
- d := d1;
- t1 := t;
- end;
- end;
- end;
- if t1 <> nil then
- begin
- t := Objects[TopSelected];
- if not (ssAlt in Shift) then
- begin
- PageView.DrawPage(dmSelection);
- Unselect;
- SelNum := 1;
- t1.Selected := True;
- PageView.DrawPage(dmSelection);
- end
- else if (DesignerRestrictions * [frdrDontMoveObj] = []) and
- ((t.Restrictions and frrfDontMove) = 0) then
- begin
- if (t1.x >= t.x + t.dx) and (Key = key_Right) then
- t.x := t1.x - t.dx
- else if (t1.y > t.y + t.dy) and (Key = key_Down) then
- t.y := t1.y - t.dy
- else if (t1.x + t1.dx <= t.x) and (Key = key_Left) then
- t.x := t1.x + t1.dx
- else if (t1.y + t1.dy <= t.y) and (Key = key_Up) then
- t.y := t1.y + t1.dy;
- RedrawPage;
- end;
- SelectionChanged;
- end;
- end;
- end;
- end;
- end;
-
- procedure TfrDesignerForm.MoveObjects(dx, dy: Integer; Resize: Boolean);
- var
- i: Integer;
- t: TfrView;
- begin
- AddUndo;
- FirstChange := False;
- PageView.DrawPage(dmSelection);
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- if Resize and (DesignerRestrictions * [frdrDontSizeObj] = []) and
- ((t.Restrictions and frrfDontSize) = 0) then
- begin
- Inc(t.dx, dx); Inc(t.dy, dy);
- end
- else if (DesignerRestrictions * [frdrDontMoveObj] = []) and
- ((t.Restrictions and frrfDontMove) = 0) then
- begin
- Inc(t.x, dx); Inc(t.y, dy);
- end;
- end;
- ShowPosition;
- PageView.GetMultipleSelected;
- PageView.Draw(TopSelected);
- end;
-
- procedure TfrDesignerForm.DeleteObjects;
- var
- i: Integer;
- t: TfrView;
- begin
- AddUndo;
- FirstChange := False;
- PageView.DrawPage(dmSelection);
- for i := Objects.Count - 1 downto 0 do
- begin
- t := Objects[i];
- if t.Selected and (DesignerRestrictions * [frdrDontDeleteObj] = []) and
- ((t.Restrictions and frrfDontDelete) = 0) then
- begin
- if (t is TfrBandView) and (TfrBandView(t).BandType = btChild) then
- NotifyParentBands(t.Name, '');
- Page.Delete(i);
- end;
- end;
- SetPageTitles;
- ResetSelection;
- FirstSelected := nil;
- PageView.Draw(10000);
- end;
-
- procedure TfrDesignerForm.NotifyParentBands(OldName, NewName: String);
- var
- i: Integer;
- t: TfrView;
- begin
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if (t is TfrBandView) and (TfrBandView(t).ChildBand = OldName) then
- TfrBandView(t).ChildBand := NewName;
- end;
- end;
-
- procedure TfrDesignerForm.NotifySubReports(OldIndex, NewIndex: Integer);
- var
- i, j: Integer;
- t: TfrView;
- begin
- with CurReport do
- for i := 0 to Pages.Count - 1 do
- for j := 0 to Pages[i].Objects.Count - 1 do
- begin
- t := Pages[i].Objects[j];
- if (t is TfrSubReportView) and (TfrSubReportView(t).SubPage = OldIndex) then
- TfrSubReportView(t).SubPage := NewIndex;
- end;
- end;
-
- function TfrDesignerForm.SelStatus: TfrSelectionStatus;
- var
- t: TfrView;
- begin
- Result := [];
- if SelNum = 1 then
- begin
- t := Objects[TopSelected];
- if t.Typ = gtBand then
- Result := [ssBand]
- else if t is TfrMemoView then
- Result := [ssMemo] else
- Result := [ssOther];
- end
- else if SelNum > 1 then
- Result := [ssMultiple];
- if ClipBd.Count > 0 then
- Result := Result + [ssClipboardFull];
- end;
-
- function TfrDesignerForm.RectTypEnabled: Boolean;
- begin
- Result := [ssMemo, ssOther, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.FontTypEnabled: Boolean;
- begin
- Result := [ssMemo, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.ZEnabled: Boolean;
- begin
- Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.CutEnabled: Boolean;
- begin
- Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.CopyEnabled: Boolean;
- begin
- Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.PasteEnabled: Boolean;
- begin
- Result := ssClipboardFull in SelStatus;
- end;
-
- function TfrDesignerForm.DelEnabled: Boolean;
- begin
- Result := [ssBand, ssMemo, ssOther, ssMultiple] * SelStatus <> [];
- end;
-
- function TfrDesignerForm.EditEnabled: Boolean;
- begin
- Result := [ssBand, ssMemo, ssOther] * SelStatus <> [];
- end;
-
- procedure TfrDesignerForm.EnableControls;
- procedure SetEnabled(const Ar: Array of TObject; en: Boolean);
- var
- i: Integer;
- begin
- for i := Low(Ar) to High(Ar) do
- if Ar[i] is TToolButton then
- begin
- (Ar[i] as TToolButton).Enabled := en;
- if not en then
- (Ar[i] as TToolButton).Down := False;
- end
- else if Ar[i] is TControl then
- (Ar[i] as TControl).Enabled := en
- else if Ar[i] is TMenuItem then
- (Ar[i] as TMenuItem).Enabled := en
- end;
- begin
- SetEnabled([FrB1, FrB2, FrB3, FrB4, FrB5, FrB6, ClB1, ClB3, C4, StB1],
- RectTypEnabled and (PageType = ptReport));
- SetEnabled([ClB2, C2, C3, FnB1, FnB2, FnB3, AlB1, AlB2, AlB3, AlB5, AlB6, AlB7, HlB1],
- FontTypEnabled);
- SetEnabled([ZB1, ZB2, N32, N33, GB3], ZEnabled);
- SetEnabled([CutB, N11, N2], CutEnabled);
- SetEnabled([CopyB, N12, N1], CopyEnabled);
- SetEnabled([PstB, N13, N3], PasteEnabled);
- SetEnabled([N27, N5], DelEnabled);
- SetEnabled([N36, N6], EditEnabled);
- StatusBar1.Repaint;
- PBox1Paint(nil);
- end;
-
- procedure TfrDesignerForm.SelectionChanged;
- var
- t: TfrView;
- begin
- Busy := True;
- ColorSelector.Hide;
- LinePanel.Hide;
- EnableControls;
- if SelNum = 1 then
- begin
- t := Objects[TopSelected];
- if t.Typ <> gtBand then
- with t do
- begin
- FrB1.Down := (FrameTyp and $8) <> 0;
- FrB2.Down := (FrameTyp and $4) <> 0;
- FrB3.Down := (FrameTyp and $2) <> 0;
- FrB4.Down := (FrameTyp and $1) <> 0;
- C4.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2);
- if t is TfrMemoView then
- with t as TfrMemoView do
- begin
- if C2.Text <> Font.Name then
- C2.ItemIndex := C2.Items.IndexOf(Font.Name);
- if C3.Text <> IntToStr(Font.Size) then
- C3.Text := IntToStr(Font.Size);
- FnB1.Down := fsBold in Font.Style;
- FnB2.Down := fsItalic in Font.Style;
- FnB3.Down := fsUnderline in Font.Style;
- // AlB4.Down := (Alignment and $4) <> 0;
- AlB5.Down := (Alignment and $18) = $8;
- AlB6.Down := (Alignment and $18) = 0;
- AlB7.Down := (Alignment and $18) = $10;
-
- AlB1.Down := (Alignment and $3) = 0;
- AlB2.Down := (Alignment and $3) = 1;
- AlB3.Down := (Alignment and $3) = 2;
- // AlB8.Down := (Alignment and $3) = 3;
- end;
- end;
- end
- else if SelNum > 1 then
- begin
- BUp(FrB1); BUp(FrB2); BUp(FrB3); BUp(FrB4);
- C4.Text := '1'; C2.Text := ''; C3.Text := '';
- BUp(FnB1); BUp(FnB2); BUp(FnB3);
- BDown(AlB1); BUp(AlB4); BUp(AlB5);
- end;
- ShowPosition;
- ShowContent;
- ActiveControl := nil;
- Busy := False;
- end;
-
- procedure TfrDesignerForm.ShowPosition;
- begin
- FillInspFields;
- if not InspBusy then
- InspForm.ItemsChanged;
- StatusBar1.Repaint;
- PBox1Paint(nil);
- end;
-
- procedure TfrDesignerForm.ShowContent;
- var
- t: TfrView;
- s: String;
- begin
- s := '';
- if SelNum = 1 then
- begin
- t := Objects[TopSelected];
- s := t.Name;
- if t is TfrBandView then
- s := s + ': ' + frBandNames[Integer(TfrBandView(t).BandType)]
- else if t.Memo.Count > 0 then
- s := s + ': ' + t.Memo[0];
- end;
- StatusBar1.Panels[2].Text := s;
- end;
-
- procedure SetBit(var w: Word; e: Boolean; m: Integer);
- begin
- if e then
- w := w or m else
- w := w and not m;
- end;
-
- procedure TfrDesignerForm.DoClick(Sender: TObject);
- var
- i, b: Integer;
- DRect: TRect;
- t: TfrView;
- begin
- if Busy then Exit;
- AddUndo;
- PageView.DrawPage(dmSelection);
- FirstChange := False;
- b := (Sender as TControl).Tag;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if (DesignerRestrictions * [frdrDontModifyObj] = []) then
- if t.Selected and ((t.Restrictions and frrfDontModify) = 0) and
- ((t.Typ <> gtBand) or (b = 16)) then
- with t do
- begin
- if t is TfrMemoView then
- with t as TfrMemoView do
- case b of
- 7: begin
- LastFontName := C2.Text;
- Font.Name := LastFontName;
- end;
- 8: begin
- Font.Size := StrToInt(C3.Text);
- LastFontSize := Font.Size;
- end;
- 9: begin
- LastFontStyle := frGetFontStyle(Font.Style);
- SetBit(LastFontStyle, FnB1.Down, 2);
- Font.Style := frSetFontStyle(LastFontStyle);
- end;
- 10: begin
- LastFontStyle := frGetFontStyle(Font.Style);
- SetBit(LastFontStyle, FnB2.Down, 1);
- Font.Style := frSetFontStyle(LastFontStyle);
- end;
- 11..13:
- begin
- Alignment := (Alignment and $FC) + (b - 11);
- LastAlignment := Alignment;
- end;
- 14: begin
- Alignment := (Alignment and $FB) + Word(AlB4.Down) * 4;
- LastAlignment := Alignment;
- end;
- 15: begin
- Alignment := (Alignment and $E7) + Word(AlB5.Down) * 8 + Word(AlB7.Down) * $10;
- LastAlignment := Alignment;
- end;
- 17: begin
- Font.Color := ColorSelector.Color;
- LastFontColor := Font.Color;
- end;
- 18: begin
- LastFontStyle := frGetFontStyle(Font.Style);
- SetBit(LastFontStyle, FnB3.Down, 4);
- Font.Style := frSetFontStyle(LastFontStyle);
- end;
- 22: begin
- Alignment := (Alignment and $FC) + 3;
- LastAlignment := Alignment;
- end;
- end;
- case b of
- 1:
- begin
- SetBit(FrameTyp, FrB1.Down, 8);
- DRect := Rect(t.x - 10, t.y - 10, t.x + t.dx + 10, t.y + 10)
- end;
- 2:
- begin
- SetBit(FrameTyp, FrB2.Down, 4);
- DRect := Rect(t.x - 10, t.y - 10, t.x + 10, t.y + t.dy + 10)
- end;
- 3:
- begin
- SetBit(FrameTyp, FrB3.Down, 2);
- DRect := Rect(t.x - 10, t.y + t.dy - 10, t.x + t.dx + 10, t.y + t.dy + 10)
- end;
- 4:
- begin
- SetBit(FrameTyp, FrB4.Down, 1);
- DRect := Rect(t.x + t.dx - 10, t.y - 10, t.x + t.dx + 10, t.y + t.dy + 10)
- end;
- 20:
- begin
- FrameTyp := FrameTyp or $F;
- LastFrameTyp := $F;
- end;
- 21:
- begin
- FrameTyp := FrameTyp and not $F;
- LastFrameTyp := 0;
- end;
- 5:
- begin
- FillColor := ColorSelector.Color;
- LastFillColor := FillColor;
- end;
- 6:
- begin
- FrameWidth := frStrToFloat(C4.Text);
- if t is TfrLineView then
- LastLineWidth := FrameWidth else
- LastFrameWidth := FrameWidth;
- end;
- 19:
- begin
- FrameColor := ColorSelector.Color;
- LastFrameColor := FrameColor;
- end;
- 25..30:
- FrameStyle := b - 25;
- end;
- end;
- end;
- PageView.Draw(TopSelected);
- FillInspFields;
- InspForm.ItemsChanged;
- ActiveControl := nil;
- if b in [20, 21] then SelectionChanged;
- end;
-
- procedure TfrDesignerForm.frSpeedButton1Click(Sender: TObject);
- begin
- LinePanel.Hide;
- DoClick(Sender);
- end;
-
- procedure TfrDesignerForm.HlB1Click(Sender: TObject);
- var
- i: Integer;
- t: TfrMemoView;
- begin
- t := Objects[TopSelected];
- with TfrHilightForm.Create(nil) do
- begin
- FontColor := t.Highlight.FontColor;
- FillColor := t.Highlight.FillColor;
- CB1.Checked := (t.Highlight.FontStyle and $2) <> 0;
- CB2.Checked := (t.Highlight.FontStyle and $1) <> 0;
- CB3.Checked := (t.Highlight.FontStyle and $4) <> 0;
- Edit1.Text := t.HighlightStr;
- if ShowModal = mrOk then
- begin
- AddUndo;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and (t is TfrMemoView) then
- begin
- t.HighlightStr := Edit1.Text;
- t.Highlight.FontColor := FontColor;
- t.Highlight.FillColor := FillColor;
- SetBit(t.Highlight.FontStyle, CB1.Checked, 2);
- SetBit(t.Highlight.FontStyle, CB2.Checked, 1);
- SetBit(t.Highlight.FontStyle, CB3.Checked, 4);
- SetBit(t.Highlight.FontStyle, False, 8);
- end;
- end;
- end;
- Free;
- end;
- RedrawPage;
- end;
-
- function TfrDesignerForm.BeforeEdit: Boolean;
- begin
- Result := (DesignerRestrictions * [frdrDontEditObj] = []) and
- ((TfrView(Objects[TopSelected]).Restrictions and frrfDontEditContents) = 0);
- if Result then
- PageView.DrawPage(dmSelection);
- end;
-
- procedure TfrDesignerForm.AfterEdit;
- begin
- PageView.Draw(TopSelected);
- end;
-
- procedure TfrDesignerForm.DoEdit(ClassRef: TClass);
- var
- f: TfrObjEditorForm;
- begin
- if BeforeEdit then
- begin
- f := TfrObjEditorForm(ClassRef.NewInstance);
- f.Create(nil);
- f.ShowEditor(Objects[TopSelected]);
- f.Free;
- AfterEdit;
- end;
- end;
-
- procedure TfrDesignerForm.DefMemoEditor(Sender: TObject);
- begin
- ShowMemoEditor(Sender);
- end;
-
- procedure TfrDesignerForm.DefPictureEditor(Sender: TObject);
- begin
- DoEdit(TfrGEditorForm);
- end;
-
- procedure TfrDesignerForm.DefTagEditor(Sender: TObject);
- var
- t: TfrView;
- begin
- if Sender = nil then
- t := Objects[TopSelected] else
- t := TfrView(Sender);
- if BeforeEdit then
- begin
- with TfrAttrEditorForm.Create(nil) do
- begin
- ShowEditor(t);
- Free;
- end;
- AfterEdit;
- end;
- end;
-
- procedure TfrDesignerForm.DefRestrEditor(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- begin
- if Sender = nil then
- t := Objects[TopSelected] else
- t := TfrView(Sender);
- with TfrRestrictionsForm.Create(nil) do
- begin
- with t do
- begin
- CB1.Checked := (Restrictions and frrfDontEditMemo) <> 0;
- CB2.Checked := (Restrictions and frrfDontEditScript) <> 0;
- CB3.Checked := (Restrictions and frrfDontEditContents) <> 0;
- CB4.Checked := (Restrictions and frrfDontModify) <> 0;
- CB5.Checked := (Restrictions and frrfDontSize) <> 0;
- CB6.Checked := (Restrictions and frrfDontMove) <> 0;
- CB7.Checked := (Restrictions and frrfDontDelete) <> 0;
- end;
- if ShowModal = mrOk then
- begin
- BeforeEdit;
- for i := 0 to frDesigner.Page.Objects.Count - 1 do
- begin
- t := frDesigner.Page.Objects[i];
- if t.Selected then
- t.Restrictions :=
- Word(CB1.Checked) * frrfDontEditMemo +
- Word(CB2.Checked) * frrfDontEditScript +
- Word(CB3.Checked) * frrfDontEditContents +
- Word(CB4.Checked) * frrfDontModify +
- Word(CB5.Checked) * frrfDontSize +
- Word(CB6.Checked) * frrfDontMove +
- Word(CB7.Checked) * frrfDontDelete;
- end;
- AfterEdit;
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.DefHighlightEditor(Sender: TObject);
- begin
- HlB1Click(nil);
- end;
-
- procedure TfrDesignerForm.DefFieldEditor(Sender: TObject);
- var
- t: TfrView;
- s: String;
- begin
- if BeforeEdit then
- begin
- t := Objects[TopSelected];
- s := InsertDBField;
- if s <> '' then
- begin
- BeforeChange;
- t.Prop['DataField'] := s;
- end;
- FillInspFields;
- InspForm.ItemsChanged;
- AfterEdit;
- end;
- end;
-
- procedure TfrDesignerForm.DefDataSourceEditor(Sender: TObject);
- begin
- DoEdit(TfrBandEditorForm);
- end;
-
- procedure TfrDesignerForm.DefCrossDataSourceEditor(Sender: TObject);
- begin
- DoEdit(TfrVBandEditorForm);
- end;
-
- procedure TfrDesignerForm.DefGroupEditor(Sender: TObject);
- begin
- DoEdit(TfrGroupEditorForm);
- end;
-
- procedure TfrDesignerForm.DefFontEditor(Sender: TObject);
- var
- t: TfrView;
- t1: TfrMemoView;
- i: Integer;
- fd: TFontDialog;
- begin
- if BeforeEdit then
- begin
- t1 := TfrMemoView(Objects[TopSelected]);
- fd := TFontDialog.Create(nil);
- with fd do
- begin
- Font.Assign(t1.Font);
- if Execute then
- begin
- BeforeChange;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontModify) = 0) then
- begin
- if Font.Name <> t1.Font.Name then
- TfrMemoView(t).Font.Name := Font.Name;
- if Font.Size <> t1.Font.Size then
- TfrMemoView(t).Font.Size := Font.Size;
- if Font.Color <> t1.Font.Color then
- TfrMemoView(t).Font.Color := Font.Color;
- if Font.Style <> t1.Font.Style then
- TfrMemoView(t).Font.Style := Font.Style;
- {$IFNDEF Delphi2}
- if Font.Charset <> t1.Font.Charset then
- begin
- TfrMemoView(t).Font.Charset := Font.Charset;
- LastCharset := Font.Charset;
- end;
- {$ENDIF}
- end;
- end;
- AfterChange;
- end;
- end;
- fd.Free;
- AfterEdit;
- end;
- end;
-
-
- // ---------------------------------------------------- inspector section begin
- type
- THackObject = class(TfrObject)
- end;
-
- procedure TfrDesignerForm.InspSelectionChanged(ObjName: String);
- begin
- SelectObject(ObjName);
- end;
-
- procedure TfrDesignerForm.InspGetObjects(List: TStrings);
- var
- i: Integer;
- begin
- List.Clear;
- for i := 0 to Objects.Count - 1 do
- List.Add(TfrView(Objects[i]).Name);
- for i := 0 to CurReport.Pages.Count - 1 do
- List.Add('Page' + IntToStr(i + 1));
- end;
-
- procedure TfrDesignerForm.FillInspFields;
- var
- t: TfrObject;
- s, s1: TStringList;
- i: Integer;
-
- procedure GetObjectProperties(t: TfrObject; s: TStrings);
- var
- i: Integer;
- p: PfrPropRec;
- begin
- s.Clear;
- for i := 0 to THackObject(t).PropList.Count - 1 do
- begin
- p := THackObject(t).PropList[i];
- if p^.PropType <> [] then
- s.Add(p^.PropName);
- end;
- end;
-
- procedure ExcludeStrings(t: TfrObject);
- var
- i: Integer;
- p: PfrPropRec;
- begin
- i := 0;
- while i < s.Count do
- begin
- p := t.PropRec[s[i]];
- if (s1.IndexOf(s[i]) = -1) or
- ((frdtOneObject in p^.PropType) and (SelNum > 1)) then
- s.Delete(i) else
- Inc(i);
- end;
- end;
-
- procedure FillProperties(t: TfrObject);
- var
- i: Integer;
- p: PfrPropRec;
- st: String;
- begin
- for i := 0 to s.Count - 1 do
- begin
- p := t.PropRec[s[i]];
- if (frdtHasEditor in p^.PropType) and not (frdtString in p^.PropType) then
- fld[i] := '(' + p^.PropName + ')'
- else
- begin
- st := t.Prop[p^.PropName];
- if (st <> fld[i]) and (fld[i] <> '-') then
- st := '';
- fld[i] := st;
- end;
- end;
- end;
-
- function ConvertToSize(s: String): String;
- var
- v: Double;
- begin
- v := frStrToFloat(s);
- if (FUnits = ruPixels) or (PageType = ptDialog) then
- Result := FloatToStrF(v, ffGeneral, 4, 2) else
- Result := FloatToStrF(PointsToUnits(v), ffFixed, 4, 2);
- end;
-
- procedure CreateProperties(t: TfrObject);
- var
- p: PfrPropRec;
- i: Integer;
- dt: TfrDataTypes;
- begin
- for i := 0 to s.Count - 1 do
- begin
- p := t.PropRec[s[i]];
- dt := p^.PropType;
- if frdtSize in p^.PropType then
- begin
- if fld[i] <> '' then
- fld[i] := ConvertToSize(fld[i]);
- if p^.PropType = [frdtSize] then
- if (Units = ruPixels) or (PageType = ptDialog) then
- dt := dt + [frdtInteger] else
- dt := dt + [frdtFloat];
- end;
-
- if not (frdtHasEditor in p^.PropType) then
- InspForm.AddProperty(s[i], fld[i], dt, p^.Enum, p^.EnumValues, p^.PropEditor) else
- InspForm.AddProperty(s[i], fld[i], p^.PropType, p^.Enum, p^.EnumValues, p^.PropEditor);
- end;
- end;
-
- begin
- if InspBusy then Exit;
- InspForm.ClearProperties;
- InspForm.ObjectName := '';
- InspForm.CurObject := nil;
-
- s := TStringList.Create;
- s1 := TStringList.Create;
-
- if SelNum > 0 then
- begin
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if TfrView(t).Selected then
- begin
- t.DefineProperties;
- GetObjectProperties(t, s1);
- if s.Count = 0 then
- s.Assign(s1) else
- ExcludeStrings(t);
- end;
- end;
-
- t := Objects[TopSelected];
- if SelNum = 1 then
- begin
- InspForm.ObjectName := TfrView(t).Name;
- InspForm.CurObject := t;
- end;
- s.Sort;
-
- for i := 0 to s.Count - 1 do
- fld[i] := '-';
-
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if TfrView(t).Selected then
- FillProperties(t);
- end;
-
- t := Objects[TopSelected];
- CreateProperties(t);
- end
- else
- begin
- t := Page;
- t.DefineProperties;
- GetObjectProperties(t, s);
- s.Sort;
- InspForm.CurObject := Page;
- InspForm.ObjectName := 'Page' + IntToStr(CurPage + 1);
- for i := 0 to s.Count - 1 do
- fld[i] := '-';
- FillProperties(t);
- CreateProperties(t);
- end;
-
- s.Free;
- s1.Free;
- end;
-
- procedure TfrDesignerForm.OnModify(Item: Integer);
- var
- t: TfrView;
- t1: TfrObject;
- PropName: String;
- i: Integer;
- v: Variant;
- CantAssign: Boolean;
-
- function CheckUnique(Obj: TfrView; Name: String): Boolean;
- begin
- Result := (CurReport.FindObject(Name) = nil) and
- (not (Obj is TfrControl) or (frDialogForm.FindComponent(Name) = nil));
- end;
-
- begin
- try
- PropName := InspForm.Items[Item];
- v := InspForm.PropValue[Item];
- if SelNum > 0 then
- begin
- if DesignerRestrictions * [frdrDontModifyObj] = [] then
- begin
- AddUndo;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- if PropName = 'Name' then
- begin
- if CheckUnique(t, v) then
- begin
- if (DesignerRestrictions * [frdrDontModifyObj] = []) and
- ((t.Restrictions and frrfDontModify) = 0) then
- begin
- NotifyParentBands(t.Name, v);
- t.Prop[PropName] := v;
- end;
- end
- end
- else
- begin
- CantAssign := ((PropName = 'Left') or (PropName = 'Top')) and
- (((t.Restrictions and frrfDontMove) <> 0) or
- (DesignerRestrictions * [frdrDontMoveObj] <> []));
- CantAssign := CantAssign or
- ((PropName = 'Width') or (PropName = 'Height')) and
- (((t.Restrictions and frrfDontSize) <> 0) or
- (DesignerRestrictions * [frdrDontSizeObj] <> []));
- if not CantAssign then
- if (frdtSize in t.PropRec[PropName].PropType) and (PageType = ptReport) then
- t.Prop[PropName] := UnitsToPoints(v) else
- t.Prop[PropName] := v;
- end;
- end;
- end;
- end
- end
- else if DesignerRestrictions * [frdrDontEditPage] = [] then
- begin
- CantAssign := False;
- t1 := Page;
- if frdtSize in t1.PropRec[PropName].PropType then
- v := UnitsToPoints(v);
- if (PropName = 'Type') and (Page.Objects.Count > 0) then
- begin
- CantAssign := Application.MessageBox((SDeleteObjects),
- (SWarning), [smbYes, smbNo], smsWarning) <> smbYes;
- if not CantAssign then
- Page.Clear;
- end;
-
- if not CantAssign then
- begin
- t1.Prop[PropName] := v;
- Modified := True;
- with Page do
- ChangePaper(pgSize, pgWidth, pgHeight, pgBin, pgOr);
- if PropName <> 'Type' then
- InspBusy := True;
- CurPage := CurPage;
- InspBusy := False;
- end;
- end;
-
- finally
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- SetPageTitles;
- if frFieldsDialog <> nil then
- frFieldsDialog.RefreshData;
- StatusBar1.Repaint;
- PBox1Paint(nil);
- end;
- end;
- // ---------------------------------------------------- inspector section end
-
- procedure TfrDesignerForm.StB1Click(Sender: TObject);
- var
- p: TPoint;
- begin
- ColorSelector.Hide;
- if not LinePanel.Visible then
- begin
- LinePanel.Parent := Self;
- with (Sender as TControl) do
- p := Self.ScreenToClient(Parent.ClientToScreen(Point(Left, Top)));
- LinePanel.Left := p.X;
- LinePanel.Top := p.Y + 26;
- end;
- LinePanel.Visible := not LinePanel.Visible;
- end;
-
- procedure TfrDesignerForm.ClB1Click(Sender: TObject);
- var
- p: TPoint;
- t: TfrView;
- begin
- LinePanel.Hide;
- with (Sender as TControl) do
- p := Self.ScreenToClient(Parent.ClientToScreen(Point(Left, Top)));
- if ColorSelector.Left = p.X then
- ColorSelector.Visible := not ColorSelector.Visible
- else
- begin
- ColorSelector.Left := p.X;
- ColorSelector.Top := p.Y + 26;
- ColorSelector.Visible := True;
- end;
- ColorSelector.Color := clNone;
- ClrButton := Sender as TToolButton;
- t := Objects[TopSelected];
- if ClrButton = ClB1 then
- ColorSelector.Color := t.FillColor
- else if (ClrButton = ClB2) and (t is TfrMemoView) then
- ColorSelector.Color := TfrMemoView(t).Font.Color
- else if ClrButton = ClB3 then
- ColorSelector.Color := t.FrameColor
- end;
-
- procedure TfrDesignerForm.ColorSelected(Sender: TObject);
- begin
- DoClick(ClrButton);
- end;
-
- procedure TfrDesignerForm.PBox1Paint(Sender: TObject);
- var
- t: TfrView;
- p: TPoint;
- s: String;
- nx, ny: Double;
- x, y, dx, dy: Integer;
-
- function TopLeft: TPoint;
- var
- i: Integer;
- t: TfrView;
- begin
- Result.x := 10000; Result.y := 10000;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- if t.x < Result.x then
- Result.x := t.x;
- if t.y < Result.y then
- Result.y := t.y;
- end;
- end;
- end;
-
- begin
- with PBox1.Canvas do
- begin
- FillRect(Rect(0, 0, PBox1.Width, PBox1.Height));
- ImageList1.Draw(PBox1.Canvas, 2, 0, 0);
- if not ((SelNum = 0) and (PageView.Mode = mdSelect)) then
- ImageList1.Draw(PBox1.Canvas, 92, 0, 1);
- if (SelNum = 1) or ShowSizes then
- begin
- t := nil;
- if ShowSizes then
- begin
- x := OldRect.Left; y := OldRect.Top;
- dx := OldRect.Right - x; dy := OldRect.Bottom - y;
- end
- else
- begin
- t := Objects[TopSelected];
- x := t.x; y := t.y; dx := t.dx; dy := t.dy;
- end;
- if FUnits = ruPixels then
- s := IntToStr(x) + ';' + IntToStr(y) else
- s := FloatToStrF(PointsToUnits(x), ffFixed, 4, 2) + '; ' +
- FloatToStrF(PointsToUnits(y), ffFixed, 4, 2);
- TextOut(20, 1, s);
- if FUnits = ruPixels then
- s := IntToStr(dx) + ';' + IntToStr(dy) else
- s := FloatToStrF(PointsToUnits(dx), ffFixed, 4, 2) + '; ' +
- FloatToStrF(PointsToUnits(dy), ffFixed, 4, 2);
- TextOut(110, 1, s);
- if not ShowSizes and (t.Typ = gtPicture) then
- with t as TfrPictureView do
- if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
- begin
- s := IntToStr(dx * 100 div Picture.Width) + ',' +
- IntToStr(dy * 100 div Picture.Height);
- TextOut(170, 1, '% ' + s);
- end;
- end
- else if (SelNum > 0) and MRFlag then
- begin
- p := TopLeft;
- if FUnits = ruPixels then
- s := IntToStr(p.x) + ';' + IntToStr(p.y) else
- s := FloatToStrF(PointsToUnits(p.x), ffFixed, 4, 2) + '; ' +
- FloatToStrF(PointsToUnits(p.y), ffFixed, 4, 2);
- TextOut(20, 1, s);
-
- nx := 0; ny := 0;
- if OldRect1.Right - OldRect1.Left <> 0 then
- nx := (OldRect.Right - OldRect.Left) / (OldRect1.Right - OldRect1.Left);
- if OldRect1.Bottom - OldRect1.Top <> 0 then
- ny := (OldRect.Bottom - OldRect.Top) / (OldRect1.Bottom - OldRect1.Top);
- s := IntToStr(Round(nx * 100)) + ',' + IntToStr(Round(ny * 100));
- TextOut(170, 1, '% ' + s);
- end
- else if (SelNum = 0) and (PageView.Mode = mdSelect) then
- begin
- x := OldRect.Left; y := OldRect.Top;
- if FUnits = ruPixels then
- s := IntToStr(x) + ';' + IntToStr(y) else
- s := FloatToStrF(PointsToUnits(x), ffFixed, 4, 2) + '; ' +
- FloatToStrF(PointsToUnits(y), ffFixed, 4, 2);
- TextOut(20, 1, s);
- end
- end;
- end;
-
- procedure TfrDesignerForm.ShowMemoEditor(Sender: TObject);
- var
- t: TfrView;
- begin
- if Sender = nil then
- t := Objects[TopSelected] else
- t := TfrView(Sender);
- with TfrEditorForm.Create(Self) do
- begin
- if ShowEditor(t) = mrOk then
- begin
- PageView.DrawPage(dmSelection);
- PageView.Draw(TopSelected);
- end;
- Free;
- end;
- ActiveControl := nil;
- end;
-
- procedure TfrDesignerForm.ShowEditor;
- var
- t: TfrView;
- bt: TfrBandType;
- begin
- t := Objects[TopSelected];
- if (DesignerRestrictions * [frdrDontEditObj] <> []) or
- ((t.Restrictions and frrfDontEditContents) <> 0) then Exit;
- if t.Typ = gtSubReport then
- CurPage := (t as TfrSubReportView).SubPage
- else if t.Typ <> gtBand then
- begin
- PageView.DrawPage(dmSelection);
- t.ShowEditor;
- PageView.Draw(TopSelected);
- end
- else
- begin
- PageView.DrawPage(dmSelection);
- bt := (t as TfrBandView).BandType;
- if bt in [btMasterData, btDetailData, btSubDetailData] then
- with TfrBandEditorForm.Create(nil) do
- begin
- ShowEditor(t);
- Free;
- end
- else if bt = btGroupHeader then
- with TfrGroupEditorForm.Create(nil) do
- begin
- ShowEditor(t);
- Free;
- end
- else if bt = btCrossData then
- with TfrVBandEditorForm.Create(nil) do
- begin
- ShowEditor(t);
- Free;
- end
- else
- PageView.DFlag := False;
- PageView.Draw(TopSelected);
- end;
- ShowContent;
- ShowPosition;
- ActiveControl := nil;
- end;
-
- //-------------------------------------------------------------- undo/redo -----
-
- procedure TfrDesignerForm.Undo;
- var
- n: Integer;
- begin
- n := CurPage;
- AddRedo;
- PageView.DisableDraw := True;
- UndoBuffer.GetUndo(CurReport);
- if n < CurReport.Pages.Count then
- CurPage := n else
- CurPage := 0;
- ResetSelection;
- PageView.DisableDraw := False;
- RedrawPage;
- N46.Enabled := UndoBuffer.FUndo.Count > 0;
- UndoB.Enabled := N46.Enabled;
- end;
-
- procedure TfrDesignerForm.Redo;
- var
- n: Integer;
- begin
- n := CurPage;
- UndoBuffer.AddUndo(CurReport);
- PageView.DisableDraw := True;
- UndoBuffer.GetRedo(CurReport);
- if n < CurReport.Pages.Count then
- CurPage := n else
- CurPage := 0;
- ResetSelection;
- PageView.DisableDraw := False;
- RedrawPage;
- N46.Enabled := True;
- UndoB.Enabled := True;
- N48.Enabled := UndoBuffer.FRedo.Count > 0;
- RedoB.Enabled := N48.Enabled;
- end;
-
- procedure TfrDesignerForm.AddUndo;
- begin
- UndoBuffer.AddUndo(CurReport);
- UndoBuffer.ClearRedo;
- N46.Enabled := True;
- UndoB.Enabled := True;
- N48.Enabled := False;
- RedoB.Enabled := False;
- Modified := True;
- end;
-
- procedure TfrDesignerForm.AddRedo;
- begin
- UndoBuffer.AddRedo(CurReport);
- N48.Enabled := True;
- RedoB.Enabled := True;
- Modified := True;
- end;
-
- procedure TfrDesignerForm.ClearUndo;
- begin
- UndoBuffer.ClearUndo;
- N46.Enabled := False;
- UndoB.Enabled := False;
- end;
-
- procedure TfrDesignerForm.ClearRedo;
- begin
- UndoBuffer.ClearRedo;
- N48.Enabled := False;
- RedoB.Enabled := False;
- end;
-
- //------------------------------------------------------------------------------
-
- procedure TfrDesignerForm.BeforeChange;
- begin
- AddUndo;
- end;
-
- procedure TfrDesignerForm.AfterChange;
- begin
- PageView.DrawPage(dmSelection);
- PageView.Draw(TopSelected);
- FillInspFields;
- InspForm.ItemsChanged;
- end;
-
- procedure TfrDesignerForm.ZB1Click(Sender: TObject); // go up
- var
- i, j, n: Integer;
- t: TfrView;
- begin
- AddUndo;
- n := Objects.Count; i := 0; j := 0;
- while j < n do
- begin
- t := Objects[i];
- if t.Selected and (DesignerRestrictions * [frdrDontMoveObj] = []) and
- ((t.Restrictions and frrfDontMove) = 0) then
- begin
- Objects.Delete(i);
- Objects.Add(t);
- end
- else
- Inc(i);
- Inc(j);
- end;
- SendBandsToDown;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.ZB2Click(Sender: TObject); // go down
- var
- t: TfrView;
- i, j, n: Integer;
- begin
- AddUndo;
- n := Objects.Count; j := 0; i := n - 1;
- while j < n do
- begin
- t := Objects[i];
- if t.Selected and (DesignerRestrictions * [frdrDontMoveObj] = []) and
- ((t.Restrictions and frrfDontMove) = 0) then
- begin
- Objects.Delete(i);
- Objects.Insert(0, t);
- end
- else
- Dec(i);
- Inc(j);
- end;
- SendBandsToDown;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.PgB1Click(Sender: TObject); // add page
- begin
- ResetSelection;
- AddPage;
- end;
-
- procedure TfrDesignerForm.PgB2Click(Sender: TObject); // remove page
- begin
- if CurReport.Pages.Count > 1 then
- if Application.MessageBox((SRemovePg),
- (SConfirm), [smbYes, smbNo], smsWarning) = smbYes then
- RemovePage(CurPage);
- end;
-
- procedure TfrDesignerForm.PgB4Click(Sender: TObject); // add dialog page
- begin
- if DesignerRestrictions * [frdrDontCreatePage] <> [] then Exit;
- AddUndo;
- CurReport.Pages.Add;
- Page := CurReport.Pages[CurReport.Pages.Count - 1];
- Page.CreateUniqueName;
- Page.PageType := ptDialog;
- Modified := True;
- CurPage := CurReport.Pages.Count - 1;
- end;
-
- procedure TfrDesignerForm.OB1Click(Sender: TObject);
- begin
- ObjRepeat := False;
- end;
-
- procedure TfrDesignerForm.OB2MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- ObjRepeat := ssShift in Shift;
- PageView.Cursor := crDefault;
- end;
-
- procedure TfrDesignerForm.CutBClick(Sender: TObject); //cut
- begin
- AddUndo;
- CutToClipboard;
- FirstSelected := nil;
- EnableControls;
- ShowPosition;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.CopyBClick(Sender: TObject); //copy
- begin
- CopyToClipboard;
- EnableControls;
- end;
-
- procedure TfrDesignerForm.PstBClick(Sender: TObject); //paste
- var
- i, minx, miny: Integer;
- t: TfrView;
- b: Byte;
- m: TMemoryStream;
- Band: TfrView;
-
- procedure UnselectLeaveBand;
- var
- i: Integer;
- begin
- SelNum := 0;
- for i := 0 to Objects.Count - 1 do
- if TfrView(Objects[i]).Typ <> gtBand then
- TfrView(Objects[i]).Selected := False;
- end;
-
- procedure CreateName(t: TfrView);
- begin
- if CurReport.FindObject(t.Name) <> nil then
- t.CreateUniqueName;
- t.Prop['Name'] := t.Name;
- end;
-
- begin
- if DesignerRestrictions * [frdrDontCreateObj] <> [] then Exit;
- AddUndo;
- UnselectLeaveBand;
- if not IsBandsSelect(Band) then
- Band := nil else
- Band.Selected := False;
- SelNum := 0;
- minx := 32767; miny := 32767;
- with ClipBd do
- for i := 0 to Count - 1 do
- begin
- m := Items[i];
- m.Position := 0;
- b := frReadByte(m);
- t := frCreateObject(b, frReadString(m));
- frVersion := frCurrentVersion;
- t.LoadFromStream(m);
- if t.x < minx then minx := t.x;
- if t.y < miny then miny := t.y;
- t.Free;
- end;
-
- for i := 0 to ClipBd.Count - 1 do
- begin
- m := ClipBd.Items[i];
- m.Position := 0;
- b := frReadByte(m);
- t := frCreateObject(b, frReadString(m));
- frVersion := frCurrentVersion;
- t.LoadFromStream(m);
- CreateName(t);
- if t.Typ = gtBand then
- if not (TfrBandType(t.FrameTyp) in [btMasterHeader..btSubDetailFooter,
- btGroupHeader, btGroupFooter]) and
- frCheckBand(TfrBandType(t.FrameTyp)) then
- begin
- t.Free;
- continue;
- end;
- if PageView.Left < 0 then
- t.x := t.x - minx + ((-PageView.Left) div GridSizeX * GridSizeX) else
- t.x := t.x - minx;
-
- if PageView.Top < 0 then
- t.y := t.y - miny + ((-PageView.Top) div GridSizeY * GridSizeY) else
- t.y := t.y - miny;
- if Band <> nil then
- t.y := band.y;
- t.Selected := True;
- Inc(SelNum);
- Objects.Add(t);
- end;
- SelectionChanged;
- SendBandsToDown;
- PageView.GetMultipleSelected;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.UndoBClick(Sender: TObject); // undo
- begin
- Undo;
- end;
-
- procedure TfrDesignerForm.RedoBClick(Sender: TObject); // redo
- begin
- Redo;
- end;
-
- procedure TfrDesignerForm.SelAllBClick(Sender: TObject); // select all
- begin
- PageView.DrawPage(dmSelection);
- SelectAll;
- PageView.GetMultipleSelected;
- PageView.DrawPage(dmSelection);
- SelectionChanged;
- end;
-
- procedure TfrDesignerForm.ExitBClick(Sender: TObject);
- begin
- ModalResult := mrOk;
- Close;
- end;
-
-
- procedure TfrDesignerForm.N5Click(Sender: TObject); // popup delete command
- begin
- DeleteObjects;
- end;
-
- procedure TfrDesignerForm.N6Click(Sender: TObject); // popup edit command
- begin
- ShowEditor;
- end;
-
- procedure TfrDesignerForm.FileBtn1Click(Sender: TObject); // create new
- var
- w: TMessageButton;
- begin
- if DesignerRestrictions * [frdrDontCreateReport] <> [] then Exit;
- if Modified then
- begin
- w := Application.MessageBox((SSaveChanges) + ' ' + (STo) + ' ' +
- ExtractFileName(CurDocName) + '?',
- (SConfirm), [smbYes, smbNo, smbCancel], smsWarning);
- if w = smbCancel then Exit;
- if w = smbYes then
- begin
- FileBtn3Click(nil);
- if not WasOk then Exit;
- end;
- end;
- ClearUndo;
- ClearRedo;
- CurReport.Clear;
- CurReport.Pages.Add;
- CurReport.Pages[CurReport.Pages.Count - 1].CreateUniqueName;
- CurPage := 0;
- CurDocName := (SUntitled);
- Modified := False;
- CurReport.ComponentModified := True;
- if frFieldsDialog <> nil then
- frFieldsDialog.RefreshData;
- end;
-
- procedure TfrDesignerForm.N23Click(Sender: TObject); // create new from template
- begin
- if DesignerComp <> nil then
- frTemplateDir := DesignerComp.TemplateDir;
- if DesignerRestrictions * [frdrDontCreateReport] <> [] then Exit;
- with TfrTemplForm.Create(nil) do
- begin
- if ShowModal = mrOk then
- begin
- ClearUndo;
- ClearRedo;
- CurReport.LoadTemplate(TemplName, nil, nil, True);
- CurDocName := (SUntitled);
- CurPage := 0; // do all
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.FileBtn2Click(Sender: TObject); // open
- var
- w: TMessageButton;
- rName: String;
- Opened: Boolean;
- begin
- if DesignerRestrictions * [frdrDontLoadReport] <> [] then Exit;
- w := smbNo;
- if Modified then
- w := Application.MessageBox((SSaveChanges) + ' ' + (STo) + ' ' +
- ExtractFileName(CurDocName) + '?',
- (SConfirm), [smbYes, smbNo, smbCancel], smsWarning);
- if w = smbCancel then Exit;
- if w = smbYes then
- begin
- FileBtn3Click(nil);
- if not WasOk then Exit;
- end;
-
- PageView.DisableDraw := True;
- Opened := True;
- if (DesignerComp <> nil) and Assigned(DesignerComp.OnLoadReport) then
- begin
- rName := '';
- DesignerComp.OnLoadReport(CurReport, rName, Opened);
- end
- else
- begin
- OpenDialog1.Filter :=
- (SFormFile) + ' (*.frf)|*.frf|' +
- (SDictFile) + ' (*.frd)|*.frd';
-
- Opened := OpenDialog1.Execute;
- rName := OpenDialog1.FileName;
- if Opened then
- if OpenDialog1.FilterIndex = 1 then
- CurReport.LoadFromFile(rName)
- else
- begin
- CurReport.Dictionary.LoadFromFile(rName);
- Opened := False;
- end;
- end;
-
- PageView.DisableDraw := False;
- if Opened then
- begin
- ClearUndo;
- ClearRedo;
- CurDocName := rName;
- Modified := False;
- CurReport.ComponentModified := True;
- CurPage := 0; // do all
- if frFieldsDialog <> nil then
- frFieldsDialog.RefreshData;
- end;
- end;
-
- procedure TfrDesignerForm.N20Click(Sender: TObject); // save as
- var
- rName: String;
- Saved: Boolean;
- begin
- if DesignerRestrictions * [frdrDontSaveReport] <> [] then Exit;
- WasOk := False;
-
- if (DesignerComp <> nil) and Assigned(DesignerComp.OnSaveReport) then
- begin
- Saved := True;
- rName := CurDocName;
- DesignerComp.OnSaveReport(CurReport, rName, True, Saved);
- if Saved then
- begin
- CurDocName := rName;
- WasOk := True;
- end;
- end
- else
- begin
- with SaveDialog1 do
- begin
- Filter := (SFormFile) + ' (*.frf)|*.frf|' +
- (STemplFile) + ' (*.frt)|*.frt|' +
- (SDictFile) + ' (*.frd)|*.frd';
- FileName := CurDocName;
- FilterIndex := 1;
- if Execute then
- if FilterIndex = 1 then
- begin
- rName := ChangeFileExt(FileName, '.frf');
- CurReport.SaveToFile(rName);
- CurDocName := rName;
- WasOk := True;
- end
- else if FilterIndex = 2 then
- begin
- rName := ChangeFileExt(FileName, '.frt');
- if DesignerComp <> nil then
- frTemplateDir := DesignerComp.TemplateDir;
- if frTemplateDir <> '' then
- rName := frTemplateDir + '\' + ExtractFileName(rName);
- with TfrTemplNewForm.Create(nil) do
- begin
- if ShowModal = mrOk then
- begin
- CurReport.SaveTemplate(rName, Memo1.Lines, Image1.Picture.Bitmap);
- WasOk := True;
- end;
- Free;
- end;
- end
- else
- begin
- rName := ChangeFileExt(FileName, '.frd');
- CurReport.Dictionary.SaveToFile(rName);
- end;
- end;
- end;
- if WasOk then
- Modified := False;
- end;
-
- procedure TfrDesignerForm.FileBtn3Click(Sender: TObject); // save
- var
- rName: String;
- Saved: Boolean;
- begin
- if DesignerRestrictions * [frdrDontSaveReport] <> [] then Exit;
- if CurDocName <> (SUntitled) then
- begin
- WasOk := True;
- if (DesignerComp <> nil) and Assigned(DesignerComp.OnSaveReport) then
- begin
- Saved := True;
- rName := CurDocName;
- DesignerComp.OnSaveReport(CurReport, rName, False, Saved);
- if Saved then
- Modified := False;
- end
- else
- begin
- CurReport.SaveToFile(CurDocName);
- Modified := False;
- end;
- end
- else
- N20Click(nil);
- end;
-
- procedure TfrDesignerForm.FormCloseQuery(Sender: TObject;
- var CanClose: Boolean);
- var
- w: TMessageButton;
- begin
- if (CurReport = nil) or
- ((csDesigning in CurReport.ComponentState) and CurReport.StoreInDFM) or
- not Modified or not FirstInstance or
- (DesignerRestrictions * [frdrDontSaveReport] <> []) or
- ((DesignerComp <> nil) and not DesignerComp.CloseQuery) then
- CanClose := True
- else
- begin
- w := Application.MessageBox(PChar((SSaveChanges) + ' ' + (STo) + ' ' +
- ExtractFileName(CurDocName) + '?'),
- PChar((SConfirm)), [smbYes, smbNo, smbCancel], smsWarning);
- CanClose := False;
- if w = smbNo then
- begin
- CanClose := True;
- ModalResult := mrCancel;
- end
- else if w = smbYes then
- begin
- FileBtn3Click(nil);
- CanClose := WasOk;
- end;
- end;
- if CanClose = True then
- if FirstInstance then
- frDesignerDoneModal := True else
- frDesigner1DoneModal := True;
- end;
-
- procedure TfrDesignerForm.PageFormCloseQuery(Sender: TObject;
- var CanClose: Boolean);
- begin
- CanClose := False;
- end;
-
- procedure TfrDesignerForm.PageFormResize(Sender: TObject);
- begin
- Page.Left := PageForm.Left;
- Page.Top := PageForm.Top;
- Page.Width := PageForm.Width;
- Page.Height := PageForm.Height;
- PageView.SetBounds(0, 0, PageForm.ClientWidth, PageForm.ClientHeight);
- Modified := True;
- end;
-
- procedure TfrDesignerForm.PageFormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if (Chr(Key) = 'C') and (ssCtrl in Shift) then
- Key := key_Insert;
- if (Chr(Key) = 'X') and (ssCtrl in Shift) then
- begin
- Key := key_Delete;
- Shift := [ssShift];
- end;
- if (Chr(Key) = 'V') and (ssCtrl in Shift) then
- begin
- Key := key_Insert;
- Shift := [ssShift];
- end;
- if (Chr(Key) = 'A') and (ssCtrl in Shift) then
- SelAllBClick(nil);
- FormKeyDown(Sender, Key, Shift);
- end;
-
- procedure TfrDesignerForm.FileBtn4Click(Sender: TObject); // preview
- var
- v: Boolean;
- begin
- if CurReport is TfrCompositeReport then Exit;
- v := CurReport.ModalPreview;
- Application.ProcessMessages;
- CurReport.ModalPreview := True;
- Unselect;
- RedrawPage;
- Page := nil;
- try
- PageView.DisableDraw := True;
- InspForm.HideProperties := True;
- InspForm.ItemsChanged;
- CurReport.PrepareReport;
- CurReport.ShowPreparedReport;
- finally
- CurReport.ModalPreview := v;
- SetFocus;
- PageView.DisableDraw := False;
- InspForm.HideProperties := False;
- CurPage := CurPage;
- SelectionChanged;
- AssignDefEditors;
- if (DesignerComp <> nil) and Assigned(DesignerComp.OnShow) then
- DesignerComp.OnShow(Self);
- Screen.Cursor := crDefault;
- end;
- end;
-
- procedure TfrDesignerForm.N42Click(Sender: TObject); // data dictionary editor
- begin
- with TfrDictForm.Create(nil) do
- begin
- Doc := CurReport;
- if ShowModal = mrOk then
- begin
- if frFieldsDialog <> nil then
- frFieldsDialog.RefreshData;
- Modified := True;
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.PgB3Click(Sender: TObject); // page options
- var
- w, h, p: Integer;
- frPgoptForm: TfrPgoptForm;
- begin
- frPgoptForm := TfrPgoptForm.Create(nil);
- with frPgoptForm, Page do
- begin
- CB1.Checked := PrintToPrevPage;
- CB5.Checked := not UseMargins;
- CB2.Checked := UnlimitedHeight;
- if pgOr = poPortrait then
- RB1.Checked := True else
- RB2.Checked := True;
- ComB1.Items := Prn.PaperNames;
- ComB1.ItemIndex := Prn.GetSizeIndex(pgSize);
- E3.Text := FloatToStrF(pgMargins.Left * 5 / 18, ffGeneral, 4, 2);
- E4.Text := FloatToStrF(pgMargins.Top * 5 / 18, ffGeneral, 4, 2);
- E5.Text := FloatToStrF(pgMargins.Right * 5 / 18, ffGeneral, 4, 2);
- E6.Text := FloatToStrF(pgMargins.Bottom * 5 / 18, ffGeneral, 4, 2);
- E7.Text := FloatToStrF(ColGap * 5 / 18, ffGeneral, 4, 2);
- Edit1.Text := IntToStr(ColCount);
- WasOk := False;
- if (ShowModal = mrOk) and (DesignerRestrictions * [frdrDontEditPage] = []) then
- begin
- Modified := True;
- WasOk := True;
- PrintToPrevPage := CB1.Checked;
- UseMargins := not CB5.Checked;
- UnlimitedHeight := CB2.Checked;
- if RB1.Checked then
- pgOr := poPortrait else
- pgOr := poLandscape;
- p := Prn.PaperSizes[ComB1.ItemIndex];
- w := 0; h := 0;
- try
- pgMargins := Rect(Round(frStrToFloat(E3.Text) * 18 / 5),
- Round(frStrToFloat(E4.Text) * 18 / 5),
- Round(frStrToFloat(E5.Text) * 18 / 5),
- Round(frStrToFloat(E6.Text) * 18 / 5));
- ColGap := Round(frStrToFloat(E7.Text) * 18 / 5);
- except
- on exception do
- begin
- pgMargins := Rect(0, 0, 0, 0);
- ColGap := 0;
- end;
- end;
- ColCount := StrToInt(Edit1.Text);
- ChangePaper(p, w, h, 0, pgOr);
- CurPage := CurPage; // for repaint and other
- end;
- end;
- frPgoptForm.Free;
- end;
-
- procedure TfrDesignerForm.N8Click(Sender: TObject); // report options
- begin
- with TfrDocOptForm.Create(nil) do
- begin
- CB1.Checked := not CurReport.PrintToDefault;
- CB2.Checked := CurReport.DoublePass;
- if ShowModal = mrOk then
- begin
- CurReport.PrintToDefault := not CB1.Checked;
- CurReport.DoublePass := CB2.Checked;
- CurReport.ChangePrinter(Prn.PrinterIndex, LB1.ItemIndex);
- Modified := True;
- end;
- CurPage := CurPage;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.N14Click(Sender: TObject); // designer options
- var
- DesOptionsForm: TfrDesOptionsForm;
- begin
- DesOptionsForm := TfrDesOptionsForm.Create(nil);
- with DesOptionsForm do
- begin
- CB1.Checked := ShowGrid;
- CB2.Checked := GridAlign;
- case GridSizeX of
- 4: RB1.Checked := True;
- 8: RB2.Checked := True;
- 18: RB3.Checked := True;
- end;
- case Units of
- ruPixels: RB6.Checked := True;
- ruMM: RB7.Checked := True;
- ruInches: RB8.Checked := True;
- end;
- CB4.Checked := EditAfterInsert;
- CB5.Checked := ShowBandTitles;
- case PagePosition of
- alClient: RB9.Checked := True;
- alLeft: RB10.Checked := True;
- alRight: RB11.Checked := True;
- end;
- if ShowModal = mrOk then
- begin
- ShowGrid := CB1.Checked;
- GridAlign := CB2.Checked;
- if RB1.Checked then
- GridSizeX := 4
- else if RB2.Checked then
- GridSizeX := 8
- else
- GridSizeX := 18;
- ShapeMode := smFrame;
- if RB6.Checked then
- Units := ruPixels
- else if RB7.Checked then
- Units := ruMM
- else
- Units := ruInches;
- if RB9.Checked then
- PagePosition := alClient
- else if RB10.Checked then
- PagePosition := alLeft
- else
- PagePosition := alRight;
- EditAfterInsert := CB4.Checked;
- ShowBandTitles := CB5.Checked;
- CurPage := CurPage;
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.GB1Click(Sender: TObject);
- begin
- ShowGrid := GB1.Down;
- end;
-
- procedure TfrDesignerForm.GB2Click(Sender: TObject);
- begin
- GridAlign := GB2.Down;
- end;
-
- procedure TfrDesignerForm.GB3Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- begin
- AddUndo;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- begin
- t.x := Round(t.x / GridSizeX) * GridSizeX;
- t.y := Round(t.y / GridSizeY) * GridSizeY;
- t.dx := Round(t.dx / GridSizeX) * GridSizeX;
- t.dy := Round(t.dy / GridSizeY) * GridSizeY;
- if t.dx = 0 then t.dx := GridSizeX;
- if t.dy = 0 then t.dy := GridSizeY;
- end;
- end;
- RedrawPage;
- ShowPosition;
- PageView.GetMultipleSelected;
- end;
-
- procedure TfrDesignerForm.Tab1Change(Sender: TObject);
- begin
- CurPage := Tab1.TabIndex;
- end;
-
- procedure TfrDesignerForm.Popup1Popup(Sender: TObject);
- var
- i: Integer;
- t, t1: TfrView;
- fl: Boolean;
- begin
- EnableControls;
- while Popup1.Items.Count > 7 do
- Popup1.Items.Delete(7);
-
- if SelNum = 1 then
- begin
- t := Objects[TopSelected];
- t.DefinePopupMenu(Popup1);
- end
- else if SelNum > 1 then
- begin
- t := Objects[TopSelected];
- fl := True;
- for i := 0 to Objects.Count - 1 do
- begin
- t1 := Objects[i];
- if t1.Selected then
- if not (((t is TfrMemoView) and (t1 is TfrMemoView)) or
- ((t.Typ <> gtAddIn) and (t.Typ = t1.Typ)) or
- ((t.Typ = gtAddIn) and (t.ClassName = t1.ClassName))) then
- begin
- fl := False;
- break;
- end;
- end;
- if fl and not (t.Typ = gtBand) then t.DefinePopupMenu(Popup1);
- end;
-
- SetMenuItemBitmap(N2, CutB);
- SetMenuItemBitmap(N1, CopyB);
- SetMenuItemBitmap(N3, PstB);
- SetMenuItemBitmap(N16, SelAllB);
- end;
-
- procedure TfrDesignerForm.N37Click(Sender: TObject);
- begin // toolbars
- Pan1.Checked := Panel1.IsVisible;
- Pan2.Checked := Panel2.IsVisible;
- Pan3.Checked := Panel3.IsVisible;
- Pan4.Checked := Panel4.IsVisible;
- Pan5.Checked := InspForm.Visible;
- Pan6.Checked := Panel5.IsVisible;
- Pan7.Checked := Panel6.IsVisible;
- Pan8.Checked := frFieldsDialog <> nil;
- end;
-
- procedure TfrDesignerForm.Pan2Click(Sender: TObject);
- procedure SetShow(c: Array of TWinControl; i: Integer; b: Boolean);
- begin
- if c[i] is TfrToolBar then
- with c[i] as TfrToolBar do
- begin
- if IsFloat then
- FloatWindow.Visible := b
- else
- begin
- if b then
- AddToDock(Parent as TfrDock);
- Visible := b;
- (Parent as TfrDock).AdjustBounds;
- end;
- end
- else
- (c[i] as TForm).Visible := b;
- end;
- begin // each toolbar
- with Sender as TMenuItem do
- begin
- Checked := not Checked;
- if Tag = 7 then // insert fields
- ShowFieldsDialog(Checked)
- else
- SetShow([Panel1, Panel2, Panel3, Panel4, Panel5, InspForm, Panel6], Tag, Checked);
- end;
- end;
-
- procedure TfrDesignerForm.N34Click(Sender: TObject);
- begin // about box
- with TfrAboutForm.Create(nil) do
- begin
- ShowModal;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.Tab1MouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- GetCursorPos(LastPt);
- if Button = mbRight then
- Popup2.Popup(LastPt.X, LastPt.Y) else
- MDown := True;
- end;
-
- procedure TfrDesignerForm.Tab1DragOver(Sender, Source: TObject; X,
- Y: Integer; State: TDragState; var Accept: Boolean);
- begin
- Accept := Source is TTabControl;
- end;
-
- procedure TfrDesignerForm.Tab1MouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- MDown := False;
- end;
-
- procedure TfrDesignerForm.Tab1MouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
- begin
- { if MDown and (Abs(x - LastPt.X) > 8) then
- Tab1.BeginDrag(False);}
- end;
-
- procedure TfrDesignerForm.Tab1DragDrop(Sender, Source: TObject; X,
- Y: Integer);
- var
- i, HitIndex: Integer;
- begin
- HitIndex := Tab1.IndexOfTabAt(X, Y);
-
- if CurPage > HitIndex then
- begin
- NotifySubReports(CurPage, -1);
- for i := CurPage - 1 downto HitIndex do
- NotifySubReports(i, i + 1);
- NotifySubReports(-1, HitIndex);
- end
- else
- begin
- NotifySubReports(CurPage, -1);
- for i := CurPage + 1 to HitIndex do
- NotifySubReports(i, i - 1);
- NotifySubReports(-1, HitIndex);
- end;
-
- Tab1.Tabs.Delete(CurPage);
- if HitIndex < Tab1.Tabs.Count then
- Tab1.Tabs.Insert(HitIndex) else
- Tab1.Tabs.Add('');
-
- CurReport.Pages.Move(CurPage, HitIndex);
- SetPageTitles;
- Modified := True;
- RedrawPage;
- Tab1.TabIndex := HitIndex;
- end;
-
- procedure TfrDesignerForm.ShowFieldsDialog(Show: Boolean);
- begin
- if Show then
- begin
- if frFieldsDialog = nil then
- begin
- frFieldsDialog := TfrInsFieldsForm.Create(Self);
- frFieldsDialog.OnHeightChanged := HeightChanged;
- frFieldsDialog.Show;
- end
- else
- frFieldsDialog.Grow;
- frFieldsDialog.SetFocus;
- end
- else
- begin
- if frFieldsDialog <> nil then
- begin
- frFieldsDialog.Free;
- frFieldsDialog := nil;
- end;
- end;
- end;
-
- procedure TfrDesignerForm.HeightChanged(Sender: TObject);
- var
- r1, r2: TRect;
- p: TPoint;
- Panel, Pan1, Pan2: TPanel;
- h: Integer;
- begin
- if (frFieldsDialog = nil) or not InspForm.Visible then Exit;
- r1 := InspForm.BoundsRect;
- r2 := frFieldsDialog.BoundsRect;
-
- if ((r1.Left >= r2.Left) and (r1.Left <= r2.Right)) or
- ((r1.Right >= r2.Left) and (r1.Right <= r2.Right)) then
- begin
- Panel := TPanel.Create(Panel7);
- Panel.Parent := Panel7;
- Panel.SetBounds(2000, 0, 10, ScrollBox1.Height - 2);
-
- Pan1 := TPanel.Create(Panel);
- Pan1.Parent := Panel;
-
- Pan2 := TPanel.Create(Panel);
- Pan2.Parent := Panel;
- Pan2.SetBounds(r2.Left, r2.Top, r2.Right - r2.Left, r2.Bottom - r2.Top);
-
- if r1.Top < r2.Top then
- Pan2.Align := alBottom else
- Pan2.Align := alTop;
- Pan1.Align := alClient;
-
- p := ScrollBox1.ClientToScreen(Point(0, -1));
- if InspForm.ClientHeight < 20 then
- h := 0 else
- h := Pan1.Height;
- InspForm.SetBounds(InspForm.Left, Pan1.Top + p.Y,
- InspForm.Width, h);
- frFieldsDialog.SetBounds(frFieldsDialog.Left, Pan2.Top + p.Y,
- frFieldsDialog.Width, Pan2.Height);
- Pan1.Free;
- Pan2.Free;
- Panel.Free;
- end;
- end;
-
-
- {----------------------------------------------------------------------------}
- // state storing/retrieving
- const
- rsGridShow = 'GridShow';
- rsGridAlign = 'GridAlign';
- rsGridSize = 'GridSize';
- rsUnits = 'Units';
- rsButtons = 'GrayButtons';
- rsEdit = 'EditAfterInsert';
- rsSelection = 'Selection';
- rsPagePos = 'PagePosition';
- rsBandTitles = 'BandTitles';
- rsProps = 'LocalizedPropNames';
- rsPgHeight = 'UnlimitedHeight';
-
-
- procedure TfrDesignerForm.SaveState;
- var
- Nm: String;
-
- procedure DoSaveToolbars(t: Array of TfrToolBar);
- var
- i: Integer;
- begin
- for i := Low(t) to High(t) do
- begin
- if FirstInstance or (t[i] <> Panel6) then
- SaveToolbarPosition(frIni, t[i]);
- t[i].IsVisible := False;
- end;
- end;
-
- begin
- Nm := rsForm + ClassName;
- frIni.WriteBool(Nm, rsGridShow, ShowGrid);
- frIni.WriteBool(Nm, rsGridAlign, GridAlign);
- frIni.WriteInteger(Nm, rsGridSize, GridSizeX);
- frIni.WriteInteger(Nm, rsUnits, Word(Units));
- frIni.WriteBool(Nm, rsEdit, EditAfterInsert);
- frIni.WriteInteger(Nm, rsSelection, Integer(ShapeMode));
- frIni.WriteInteger(Nm, rsPagePos, Integer(PagePosition));
- frIni.WriteBool(Nm, rsBandTitles, ShowBandTitles);
- frIni.WriteBool(rsForm + InspForm.ClassName, rsVisible, InspForm.Visible);
- frIni.WriteInteger(rsForm + InspForm.ClassName, 'SplitPos', InspForm.SplitterPos);
- frIni.WriteBool(rsForm + TfrInsFieldsForm.ClassName, rsVisible,
- (frFieldsDialog <> nil) and frFieldsDialog.Visible);
- frIni.WriteBool(Nm, rsPgHeight, UnlimitedHeight);
-
- DoSaveToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
- SaveFormPosition(frIni, InspForm);
- SaveFormPosition(frIni, Self);
- end;
-
- procedure TfrDesignerForm.RestoreState;
- var
- Nm: String;
-
- procedure DoRestoreToolbars(t: Array of TfrToolBar);
- var
- i: Integer;
- begin
- for i := Low(t) to High(t) do
- RestoreToolbarPosition(frIni, t[i]);
- end;
-
- begin
- Nm := rsForm + ClassName;
- GridSizeX := frIni.ReadInteger(Nm, rsGridSize, 4);
- if GridSizeX = 0 then
- GridSizeX := 4;
- GridAlign := frIni.ReadBool(Nm, rsGridAlign, True);
- ShowGrid := frIni.ReadBool(Nm, rsGridShow, True);
- Units := TfrReportUnits(frIni.ReadInteger(Nm, rsUnits, 0));
- EditAfterInsert := frIni.ReadBool(Nm, rsEdit, True);
- ShapeMode := smFrame;//TfrShapeMode(frIni.ReadInteger(Nm, rsSelection, 1));
- PagePosition := TAlign(frIni.ReadInteger(Nm, rsPagePos, 5));
- ShowBandTitles := frIni.ReadBool(Nm, rsBandTitles, True);
- UnlimitedHeight := frIni.ReadBool(Nm, rsPgHeight, False);
- RestoreFormPosition(frIni, InspForm);
- InspForm.SplitterPos := frIni.ReadInteger(rsForm + InspForm.ClassName, 'SplitPos', 75);
- if InspForm.SplitterPos < 20 then
- InspForm.SplitterPos := 20;
- InspForm.Visible := frIni.ReadBool(rsForm + InspForm.ClassName, rsVisible, True);
-
- if FirstInstance then
- if frIni.ReadBool(rsForm + TfrInsFieldsForm.ClassName, rsVisible, True) then
- ShowFieldsDialog(True);
-
- DoRestoreToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
- if Panel6.Height < 26 then
- Panel6.Height := 26;
- if Panel6.Width < 26 then
- Panel6.Width := 26;
- if Panel6.ControlCount < 2 then
- Panel6.Hide;
- frDock1.AdjustBounds;
- frDock2.AdjustBounds;
- frDock3.AdjustBounds;
- frDock4.AdjustBounds;
- RestoreFormPosition(frIni, Self);
- end;
-
-
- {----------------------------------------------------------------------------}
- // menu bitmaps
- procedure TfrDesignerForm.SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn: TToolButton);
- begin
- AMenuItem.ImageIndex := ABtn.ImageIndex;
- end;
-
- procedure TfrDesignerForm.SetMenuBitmaps;
- var
- i: Integer;
- begin
- MainMenu1.Images := MainImages;
- Popup1.Images := MainImages;
- Popup2.Images := MainImages;
-
- SetMenuItemBitmap(N23, FileBtn1);
- SetMenuItemBitmap(N19, FileBtn2);
- SetMenuItemBitmap(N20, FileBtn3);
- SetMenuItemBitmap(N39, FileBtn4);
-
- SetMenuItemBitmap(N46, UndoB);
- SetMenuItemBitmap(N48, RedoB);
- SetMenuItemBitmap(N11, CutB);
- SetMenuItemBitmap(N12, CopyB);
- SetMenuItemBitmap(N13, PstB);
- SetMenuItemBitmap(N28, SelAllB);
- SetMenuItemBitmap(N29, PgB1);
- SetMenuItemBitmap(N30, PgB2);
- SetMenuItemBitmap(N32, ZB1);
- SetMenuItemBitmap(N33, ZB2);
- SetMenuItemBitmap(N35, HelpBtn);
- SetMenuItemBitmap(N15, PgB4);
- for i := 0 to MastMenu.Count - 1 do
- MastMenu.Items[i].Bitmap := TfrTBButton(Panel6.Controls[i + 1]).Glyph;
-
- SetMenuItemBitmap(N41, PgB1);
- SetMenuItemBitmap(N43, PgB2);
- SetMenuItemBitmap(N44, PgB3);
- SetMenuItemBitmap(N45, PgB4);
- end;
-
- {----------------------------------------------------------------------------}
- // alignment palette
- function GetFirstSelected: TfrView;
- begin
- if FirstSelected <> nil then
- Result := FirstSelected else
- Result := Objects[TopSelected];
- end;
-
- function GetLeftObject: Integer;
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- begin
- t := Objects[TopSelected];
- x := t.x;
- Result := TopSelected;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- if t.x < x then
- begin
- x := t.x;
- Result := i;
- end;
- end;
- end;
-
- function GetRightObject: Integer;
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- begin
- t := Objects[TopSelected];
- x := t.x + t.dx;
- Result := TopSelected;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- if t.x + t.dx > x then
- begin
- x := t.x + t.dx;
- Result := i;
- end;
- end;
- end;
-
- function GetTopObject: Integer;
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- t := Objects[TopSelected];
- y := t.y;
- Result := TopSelected;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- if t.y < y then
- begin
- y := t.y;
- Result := i;
- end;
- end;
- end;
-
- function GetBottomObject: Integer;
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- t := Objects[TopSelected];
- y := t.y + t.dy;
- Result := TopSelected;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then
- if t.y + t.dy > y then
- begin
- y := t.y + t.dy;
- Result := i;
- end;
- end;
- end;
-
- procedure TfrDesignerForm.Align1Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- band: TfrView;
- s: TStringList;
- y: Integer;
- begin
- if DesignerRestrictions * [frdrDontMoveObj] <> [] then Exit;
- if IsBandsSelect(band) then
- begin
- BeforeChange;
- s := TStringList.Create;
- s.Sorted := True;
- s.Duplicates := dupAccept;
- t := Objects[GetLeftObject];
- x := Page.LeftMargin;
- y := t.y;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if (t.y >= band.y) and (t.y + t.dy <= band.y + band.dy) and
- (t.Typ <> gtBand) then
- s.AddObject(Format('%4.4d', [t.x]), t);
- end;
- for i := 0 to s.Count - 1 do
- begin
- t := TfrView(s.Objects[i]);
- if (t.Restrictions and frrfDontMove) = 0 then
- begin
- t.x := x;
- t.y := y;
- end;
- x := x + t.dx;
- end;
- s.Free;
- PageView.GetMultipleSelected;
- RedrawPage;
- Exit;
- end;
-
- if SelNum < 2 then Exit;
- BeforeChange;
- t := GetFirstSelected;
- x := t.x;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.x := x;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align6Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- if (SelNum < 2) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := GetFirstSelected;
- y := t.y;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.y := y;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align5Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- band: TfrView;
- s: TStringList;
- y: Integer;
- begin
- if DesignerRestrictions * [frdrDontMoveObj] <> [] then Exit;
- if IsBandsSelect(band) then
- begin
- BeforeChange;
- s := TStringList.Create;
- s.Sorted := True;
- s.Duplicates := dupAccept;
- t := Objects[GetRightObject];
- x := Page.RightMargin;
- y := t.y;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if (t.y >= band.y) and (t.y + t.dy <= band.y + band.dy) and
- (t.Typ <> gtBand) then
- s.AddObject(Format('%4.4d', [t.x]), t);
- end;
- for i := s.Count - 1 downto 0 do
- begin
- t := TfrView(s.Objects[i]);
- if (t.Restrictions and frrfDontMove) = 0 then
- begin
- t.x := x - t.dx;
- t.y := y;
- end;
- x := x - t.dx;
- end;
- s.Free;
- PageView.GetMultipleSelected;
- RedrawPage;
- Exit;
- end;
-
- if SelNum < 2 then Exit;
- BeforeChange;
- t := GetFirstSelected;
- x := t.x + t.dx;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.x := x - t.dx;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align10Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- if (SelNum < 2) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := GetFirstSelected;
- y := t.y + t.dy;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.y := y - t.dy;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align2Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- begin
- if (SelNum < 2) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := GetFirstSelected;
- x := t.x + t.dx div 2;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.x := x - t.dx div 2;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align7Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- if (SelNum < 2) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := GetFirstSelected;
- y := t.y + t.dy div 2;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.y := y - t.dy div 2;
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align3Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- x: Integer;
- begin
- if (SelNum = 0) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := Objects[GetLeftObject];
- x := t.x;
- t := Objects[GetRightObject];
- x := x + (t.x + t.dx - x - PageView.Width) div 2;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- Dec(t.x, x);
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align8Click(Sender: TObject);
- var
- i: Integer;
- t: TfrView;
- y: Integer;
- begin
- if (SelNum = 0) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- t := Objects[GetTopObject];
- y := t.y;
- t := Objects[GetBottomObject];
- y := y + (t.y + t.dy - y - PageView.Height) div 2;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- Dec(t.y, y);
- end;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align4Click(Sender: TObject);
- var
- s: TStringList;
- i, dx: Integer;
- t: TfrView;
- begin
- if (SelNum < 3) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- s := TStringList.Create;
- s.Sorted := True;
- s.Duplicates := dupAccept;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then s.AddObject(Format('%4.4d', [t.x]), t);
- end;
- dx := (TfrView(s.Objects[s.Count - 1]).x - TfrView(s.Objects[0]).x) div (s.Count - 1);
- for i := 1 to s.Count - 2 do
- begin
- t := TfrView(s.Objects[i]);
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.x := TfrView(s.Objects[i - 1]).x + dx;
- end;
- s.Free;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
- procedure TfrDesignerForm.Align9Click(Sender: TObject);
- var
- s: TStringList;
- i, dy: Integer;
- t: TfrView;
- begin
- if (SelNum < 3) or (DesignerRestrictions * [frdrDontMoveObj] <> []) then Exit;
- BeforeChange;
- s := TStringList.Create;
- s.Sorted := True;
- s.Duplicates := dupAccept;
- for i := 0 to Objects.Count - 1 do
- begin
- t := Objects[i];
- if t.Selected then s.AddObject(Format('%4.4d', [t.y]), t);
- end;
- dy := (TfrView(s.Objects[s.Count - 1]).y - TfrView(s.Objects[0]).y) div (s.Count - 1);
- for i := 1 to s.Count - 2 do
- begin
- t := TfrView(s.Objects[i]);
- if t.Selected and ((t.Restrictions and frrfDontMove) = 0) then
- t.y := TfrView(s.Objects[i - 1]).y + dy;
- end;
- s.Free;
- PageView.GetMultipleSelected;
- FillInspFields;
- InspForm.ItemsChanged;
- RedrawPage;
- end;
-
-
- procedure TfrDesignerForm.GetDefaultSize(var dx, dy: Integer);
- begin
- dx := 96;
- if GridSizeX = 18 then dx := 18 * 6;
- dy := 18;
- if GridSizeY = 18 then dy := 18;
- if LastFontSize in [12, 13] then dy := 20;
- if LastFontSize in [14..16] then dy := 24;
- end;
-
-
- procedure TfrDesignerForm.InsFieldsClick(Sender: TObject);
- begin
- if PageType = ptDialog then Exit;
- with TfrInsertFieldsForm.Create(nil) do
- begin
- Unselect;
- if ShowModal = mrOk then
- begin
- NumberOfSelected;
- SelectionChanged;
- SendBandsToDown;
- PageView.GetMultipleSelected;
- RedrawPage;
- end;
- Free;
- end;
- end;
-
- procedure TfrDesignerForm.HelpBtnClick(Sender: TObject);
- begin
- HelpBtn.Down := True;
- Screen.Cursor := crHelp;
- // SetCapture(Handle);
- HelpBtn.Invalidate;
- end;
-
- procedure TfrDesignerForm.FormMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- c: TControl;
- t: Integer;
- begin
- HelpBtn.Down := False;
- Screen.Cursor := crDefault;
- c := frControlAtPos(Self, Point(X, Y));
- if (c <> nil) and (c <> HelpBtn) then
- begin
- t := c.Tag;
- if (c.Parent = Panel4) and (t > 4) then
- t := 5;
- if c.Parent = Panel4 then
- Inc(t, 430) else
- Inc(t, 400);
- Application.ContextHelp(t);
- end;
- end;
-
- procedure TfrDesignerForm.N22Click(Sender: TObject);
- begin
- // Application.HelpCommand(HELP_FINDER, 0);
- end;
-
- procedure TfrDesignerForm.FormMouseWheelUp(Sender: TObject;
- Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
- begin
- ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - 8;
- end;
-
- procedure TfrDesignerForm.FormMouseWheelDown(Sender: TObject;
- Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
- begin
- ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + 8;
- end;
-
-
- procedure TfrDesignerForm.StatusBar1MouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- ChangeUnits := X < 75;
- end;
-
- procedure TfrDesignerForm.StatusBar1DblClick(Sender: TObject);
- begin
- if ChangeUnits then
- if Units = ruInches then
- Units := ruPixels else
- Units := Succ(Units)
- end;
-
- procedure TfrDesignerForm.C2DblClick(Sender: TObject);
- begin
- frFontEditor(nil);
- end;
-
- procedure DoInit;
- begin
- frDesignerClass := TfrDesignerForm;
- ClipBd := TList.Create;
- GridBitmap := TBitmap.Create;
- with GridBitmap do
- begin
- Width := 8; Height := 8;
- end;
- LastFrameTyp := 0;
- LastFrameWidth := 1;
- LastLineWidth := 2;
- LastFillColor := clNone;
- LastFrameColor := clBlack;
- LastFontColor := clBlack;
- LastFontStyle := 0;
- LastAlignment := 0;
- LastCharset := TFontCharset(frCharset);
- end;
-
-
-
-
- initialization
- DoInit;
-
- finalization
- ClearClipBoard;
- ClipBd.Free;
- GridBitmap.Free;
-
- end.
-
-