mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-23 13:30:30 +01:00
e24d5e256c
1. Fix AV on TlrButtonPanel 2. Implement highlight find text in preview report window 3. Fix loading TlrCrossView from stream 4. Fixed speed save changes to the data in the report (after double click on preview report window) git-svn-id: trunk@46761 -
8116 lines
206 KiB
ObjectPascal
8116 lines
206 KiB
ObjectPascal
|
|
{*****************************************}
|
|
{ }
|
|
{ FastReport v2.3 }
|
|
{ Report Designer }
|
|
{ }
|
|
{ Copyright (c) 1998-99 by Tzyganenko A. }
|
|
{ }
|
|
{*****************************************}
|
|
|
|
unit LR_Desgn;
|
|
|
|
interface
|
|
|
|
{$I lr_vers.inc}
|
|
{.$Define ExtOI} // External Custom Object inspector (Christian)
|
|
{.$Define StdOI} // External Standard Object inspector (Jesus)
|
|
{$define sbod} // status bar owner draw
|
|
{$define ppaint}
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, LMessages,
|
|
Forms, Controls, Graphics, Dialogs,ComCtrls,
|
|
ExtCtrls, Buttons, StdCtrls,Menus,
|
|
|
|
LCLType,LCLIntf,LCLProc,GraphType,Printers, ActnList,
|
|
|
|
ObjectInspector, PropEdits,TypInfo,
|
|
|
|
LR_Class, LR_Color,LR_Edit;
|
|
|
|
|
|
const
|
|
MaxUndoBuffer = 100;
|
|
crPencil = 11;
|
|
dtFastReportForm = 1;
|
|
dtFastReportTemplate = 2;
|
|
dtLazReportForm = 3;
|
|
dtLazReportTemplate = 4;
|
|
|
|
type
|
|
TLoadReportEvent = procedure(Report: TfrReport; var ReportName: String) of object;
|
|
TSaveReportEvent = procedure(Report: TfrReport; var ReportName: String;
|
|
SaveAs: Boolean; var Saved: Boolean) of object;
|
|
|
|
TfrDesignerForm = class;
|
|
|
|
{ TfrDesigner }
|
|
|
|
TfrDesigner = class(TComponent) // fake component
|
|
private
|
|
FOnLoadReport: TLoadReportEvent;
|
|
FOnSaveReport: TSaveReportEvent;
|
|
FTemplDir: String;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Loaded; override;
|
|
published
|
|
property TemplateDir: String read FTemplDir write FTemplDir;
|
|
property OnLoadReport: TLoadReportEvent read FOnLoadReport write FOnLoadReport;
|
|
property OnSaveReport: TSaveReportEvent read FOnSaveReport write FOnSaveReport;
|
|
end;
|
|
|
|
TfrSelectionType = (ssBand, ssMemo, ssOther, ssMultiple, ssClipboardFull);
|
|
TfrSelectionStatus = set of TfrSelectionType;
|
|
TfrReportUnits = (ruPixels, ruMM, ruInches);
|
|
TfrShapeMode = (smFrame, smAll);
|
|
|
|
TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder, acDuplication);
|
|
PfrUndoObj = ^TfrUndoObj;
|
|
TfrUndoObj = record
|
|
Next: PfrUndoObj;
|
|
ObjID: Integer;
|
|
ObjPtr: TfrView;
|
|
Int: Integer;
|
|
end;
|
|
|
|
TfrUndoRec = record
|
|
Action: TfrUndoAction;
|
|
Page: Integer;
|
|
Objects: PfrUndoObj;
|
|
end;
|
|
|
|
PfrUndoRec1 = ^TfrUndoRec1;
|
|
TfrUndoRec1 = record
|
|
ObjPtr: TfrView;
|
|
Int: Integer;
|
|
end;
|
|
|
|
PfrUndoBuffer = ^TfrUndoBuffer;
|
|
TfrUndoBuffer = Array[0..MaxUndoBuffer - 1] of TfrUndoRec;
|
|
|
|
TfrMenuItemInfo = class(TObject)
|
|
private
|
|
MenuItem: TMenuItem;
|
|
Btn : TSpeedButton;
|
|
end;
|
|
|
|
TfrDesignerDrawMode = (dmAll, dmSelection, dmShape);
|
|
TfrCursorType = (ctNone, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8);
|
|
TfrDesignMode = (mdInsert, mdSelect);
|
|
|
|
TfrSplitInfo = record
|
|
SplRect: TRect;
|
|
SplX : Integer;
|
|
View1,
|
|
View2 : TfrView;
|
|
end;
|
|
|
|
TViewAction = procedure(View: TFrView; Data:PtrInt) of object;
|
|
|
|
{ TfrObjectInspector }
|
|
TfrObjectInspector = Class({$IFDEF EXTOI}TForm{$ELSE}TPanel{$ENDIF})
|
|
private
|
|
FSelectedObject: TObject;
|
|
fPropertyGrid : TCustomPropertiesGrid;
|
|
{$IFNDEF EXTOI}
|
|
fcboxObjList : TComboBox;
|
|
fBtn,fBtn2 : TButton;
|
|
fPanelHeader : TPanel;
|
|
fLastHeight : Word;
|
|
fDown : Boolean;
|
|
fPt : TPoint;
|
|
|
|
procedure BtnClick(Sender : TObject);
|
|
procedure HeaderMDown(Sender: TOBject; Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; X, Y: Integer);
|
|
procedure HeaderMMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X,
|
|
{%H-}Y: Integer);
|
|
procedure HeaderMUp(Sender: TOBject; {%H-}Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
|
|
{$ENDIF}
|
|
protected
|
|
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
|
|
{$IFDEF EXTOI}
|
|
procedure DoHide; override;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Select(Obj: TObject);
|
|
procedure cboxObjListOnChanged(Sender: TObject);
|
|
procedure SetModifiedEvent(AEvent: TNotifyEvent);
|
|
procedure Refresh;
|
|
property SelectedObject:TObject read FSelectedObject;
|
|
end;
|
|
|
|
TPaintSel = class;
|
|
|
|
{ TfrDesignerPage }
|
|
|
|
TfrDesignerPage = class(TCustomControl)
|
|
private
|
|
Down, // mouse button was pressed
|
|
Moved, // mouse was moved (with pressed btn)
|
|
DFlag, // was double click
|
|
RFlag: Boolean; // selecting objects by framing
|
|
Mode : TfrDesignMode; // current mode
|
|
CT : TfrCursorType; // cursor type
|
|
LastX, LastY: Integer; // here stored last mouse coords
|
|
SplitInfo: TfrSplitInfo;
|
|
RightBottom: Integer;
|
|
LeftTop: TPoint;
|
|
FirstBandMove: Boolean;
|
|
FDesigner: TfrDesignerForm;
|
|
|
|
fOldFocusRect : TRect;
|
|
fPaintSel: TPaintSel;
|
|
fPainting: boolean;
|
|
fResizeDialog: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; AClipRgn: HRGN);
|
|
procedure DrawPage(DrawMode: TfrDesignerDrawMode);
|
|
procedure DrawRectLine(Rect: TRect);
|
|
procedure DrawFocusRect(aRect: TRect);
|
|
procedure DrawHSplitter(Rect: TRect);
|
|
procedure DrawSelection(t: TfrView);
|
|
procedure DrawShape(t: TfrView);
|
|
|
|
procedure DrawDialog(N: Integer; AClipRgn: HRGN);
|
|
|
|
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure MUp(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
|
|
procedure MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
procedure CMMouseLeave(var {%H-}Message: TLMessage); message CM_MOUSELEAVE;
|
|
procedure DClick(Sender: TObject);
|
|
procedure MoveResize(Kx,Ky:Integer; UseFrames,AResize: boolean);
|
|
procedure EnableEvents(aOk: boolean = true);
|
|
|
|
// focusrect
|
|
procedure NPDrawFocusRect;
|
|
procedure NPEraseFocusRect;
|
|
// objects
|
|
procedure NPDrawLayerObjects(Rgn: HRGN; Start:Integer=10000);
|
|
procedure NPRedrawViewCheckBand(t: TfrView);
|
|
// selection
|
|
procedure NPPaintSelection; // this is the only function that works during Paint
|
|
procedure NPDrawSelection;
|
|
procedure NPEraseSelection;
|
|
|
|
protected
|
|
procedure Paint; override;
|
|
procedure WMEraseBkgnd(var {%H-}Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
|
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor destroy; override;
|
|
|
|
procedure Init;
|
|
procedure SetPage;
|
|
procedure GetMultipleSelected;
|
|
end;
|
|
|
|
TPaintTimeStatusItem = (ptsFocusRect);
|
|
TPaintTimeStatus = set of TPaintTimeStatusItem;
|
|
|
|
{ TPaintSel }
|
|
|
|
TPaintSel=class
|
|
private
|
|
fStatus: TPaintTimeStatus;
|
|
fFocusRect: TRect;
|
|
fOwner: TfrDesignerPage;
|
|
fGreenBullet,fGrayBullet: TPortableNetworkGraphic;
|
|
procedure InvalidateFocusRect;
|
|
procedure DrawOrInvalidateViewHandles(t:TfrView; aDraw:boolean);
|
|
procedure DrawOrInvalidateSelection(aDraw:boolean);
|
|
public
|
|
constructor Create(AOwner: TfrDesignerPage);
|
|
destructor Destroy; override;
|
|
procedure FocusRect(aRect:TRect);
|
|
procedure RemoveFocusRect;
|
|
procedure InvalidateSelection;
|
|
procedure PaintSelection;
|
|
procedure Paint;
|
|
end;
|
|
|
|
{ TfrDesignerForm }
|
|
|
|
TfrDesignerForm = class(TfrReportDesigner)
|
|
acDuplicate: TAction;
|
|
MenuItem2: TMenuItem;
|
|
tlsDBFields: TAction;
|
|
FileBeforePrintScript: TAction;
|
|
FileOpen: TAction;
|
|
FilePreview: TAction;
|
|
FileSaveAs: TAction;
|
|
FileSave: TAction;
|
|
acToggleFrames: TAction;
|
|
actList: TActionList;
|
|
frSpeedButton1: TSpeedButton;
|
|
frSpeedButton2: TSpeedButton;
|
|
frSpeedButton3: TSpeedButton;
|
|
frSpeedButton4: TSpeedButton;
|
|
frSpeedButton5: TSpeedButton;
|
|
frSpeedButton6: TSpeedButton;
|
|
frTBSeparator16: TPanel;
|
|
Image1: TImage;
|
|
ActionsImageList: TImageList;
|
|
ImgIndic: TImageList;
|
|
LinePanel: TPanel;
|
|
MenuItem1: TMenuItem;
|
|
OB7: TSpeedButton;
|
|
panTab: TPanel;
|
|
panForDlg: TPanel;
|
|
PgB4: TSpeedButton;
|
|
Tab1: TTabControl;
|
|
ScrollBox1: TScrollBox;
|
|
StatusBar1: TStatusBar;
|
|
frDock1: TPanel;
|
|
frDock2: TPanel;
|
|
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;
|
|
ImageList2: TImageList;
|
|
N38: TMenuItem;
|
|
Pan6: TMenuItem;
|
|
N39: TMenuItem;
|
|
N40: TMenuItem;
|
|
N42: TMenuItem;
|
|
MastMenu: TMenuItem;
|
|
N16: TMenuItem;
|
|
Panel2: TPanel;
|
|
FileBtn1: TSpeedButton;
|
|
FileBtn2: TSpeedButton;
|
|
FileBtn3: TSpeedButton;
|
|
FileBtn4: TSpeedButton;
|
|
CutB: TSpeedButton;
|
|
CopyB: TSpeedButton;
|
|
PstB: TSpeedButton;
|
|
ZB1: TSpeedButton;
|
|
ZB2: TSpeedButton;
|
|
SelAllB: TSpeedButton;
|
|
PgB1: TSpeedButton;
|
|
PgB2: TSpeedButton;
|
|
PgB3: TSpeedButton;
|
|
GB1: TSpeedButton;
|
|
GB2: TSpeedButton;
|
|
ExitB: TSpeedButton;
|
|
Panel3: TPanel;
|
|
AlB1: TSpeedButton;
|
|
AlB2: TSpeedButton;
|
|
AlB3: TSpeedButton;
|
|
AlB4: TSpeedButton;
|
|
AlB5: TSpeedButton;
|
|
FnB1: TSpeedButton;
|
|
FnB2: TSpeedButton;
|
|
FnB3: TSpeedButton;
|
|
ClB2: TSpeedButton;
|
|
HlB1: TSpeedButton;
|
|
AlB6: TSpeedButton;
|
|
AlB7: TSpeedButton;
|
|
Panel1: TPanel;
|
|
FrB1: TSpeedButton;
|
|
FrB2: TSpeedButton;
|
|
FrB3: TSpeedButton;
|
|
FrB4: TSpeedButton;
|
|
ClB1: TSpeedButton;
|
|
ClB3: TSpeedButton;
|
|
FrB5: TSpeedButton;
|
|
FrB6: TSpeedButton;
|
|
frTBSeparator1: TPanel;
|
|
frTBSeparator2: TPanel;
|
|
frTBSeparator3: TPanel;
|
|
frTBSeparator4: TPanel;
|
|
frTBSeparator5: TPanel;
|
|
frTBPanel1: TPanel;
|
|
C3: TComboBox;
|
|
C2: TComboBox;
|
|
frTBPanel2: TPanel;
|
|
frTBSeparator6: TPanel;
|
|
frTBSeparator7: TPanel;
|
|
frTBSeparator8: TPanel;
|
|
frTBSeparator9: TPanel;
|
|
frTBSeparator10: TPanel;
|
|
N37: TMenuItem;
|
|
Pan2: TMenuItem;
|
|
Pan3: TMenuItem;
|
|
Pan1: TMenuItem;
|
|
Pan4: TMenuItem;
|
|
Panel4: TPanel;
|
|
OB1: TSpeedButton;
|
|
OB2: TSpeedButton;
|
|
OB3: TSpeedButton;
|
|
OB4: TSpeedButton;
|
|
OB5: TSpeedButton;
|
|
frTBSeparator12: TPanel;
|
|
Panel5: TPanel;
|
|
Align1: TSpeedButton;
|
|
Align2: TSpeedButton;
|
|
Align3: TSpeedButton;
|
|
Align4: TSpeedButton;
|
|
Align5: TSpeedButton;
|
|
Align6: TSpeedButton;
|
|
Align7: TSpeedButton;
|
|
Align8: TSpeedButton;
|
|
Align9: TSpeedButton;
|
|
Align10: TSpeedButton;
|
|
frTBSeparator13: TPanel;
|
|
//** Tab1: TTabControl;
|
|
frDock4: TPanel;
|
|
HelpMenu: TMenuItem;
|
|
N34: TMenuItem;
|
|
GB3: TSpeedButton;
|
|
N46: TMenuItem;
|
|
N47: TMenuItem;
|
|
UndoB: TSpeedButton;
|
|
frTBSeparator14: TPanel;
|
|
AlB8: TSpeedButton;
|
|
RedoB: TSpeedButton;
|
|
N48: TMenuItem;
|
|
OB6: TSpeedButton;
|
|
frTBSeparator15: TPanel;
|
|
Panel6: TPanel;
|
|
Pan7: TMenuItem;
|
|
N14: TMenuItem;
|
|
Panel7: TPanel;
|
|
PBox1: TPaintBox;
|
|
N17: TMenuItem;
|
|
E1: TEdit;
|
|
Panel8: TPanel;
|
|
SB1: TSpeedButton;
|
|
SB2: TSpeedButton;
|
|
HelpBtn: TSpeedButton;
|
|
frTBSeparator11: TPanel;
|
|
N18: TMenuItem;
|
|
N22: TMenuItem;
|
|
N35: TMenuItem;
|
|
Popup2: TPopupMenu;
|
|
N41: TMenuItem;
|
|
N43: TMenuItem;
|
|
N44: TMenuItem;
|
|
StB1: TSpeedButton;
|
|
procedure acDuplicateExecute(Sender: TObject);
|
|
procedure acToggleFramesExecute(Sender: TObject);
|
|
procedure C2GetItems(Sender: TObject);
|
|
procedure FileBeforePrintScriptExecute(Sender: TObject);
|
|
procedure FileOpenExecute(Sender: TObject);
|
|
procedure FilePreviewExecute(Sender: TObject);
|
|
procedure FileSaveAsExecute(Sender: TObject);
|
|
procedure FileSaveExecute(Sender: TObject);
|
|
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 ScrollBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
procedure ScrollBox1DragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
procedure tlsDBFieldsExecute(Sender: TObject);
|
|
procedure ZB1Click(Sender: TObject);
|
|
procedure ZB2Click(Sender: TObject);
|
|
procedure PgB1Click(Sender: TObject);
|
|
procedure PgB2Click(Sender: TObject);
|
|
procedure OB2MouseDown(Sender: TObject; {%H-}Button: TMouseButton;
|
|
Shift: TShiftState; {%H-}X, {%H-}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 FileBtn3Click(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormHide(Sender: TObject);
|
|
procedure N8Click(Sender: TObject);
|
|
procedure C2DrawItem({%H-}Control: TWinControl; Index: Integer; Rect: TRect;
|
|
{%H-}State: TOwnerDrawState);
|
|
procedure HlB1Click(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 SB1Click(Sender: TObject);
|
|
procedure SB2Click(Sender: TObject);
|
|
procedure HelpBtnClick(Sender: TObject);
|
|
procedure FormMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
|
|
procedure N22Click(Sender: TObject);
|
|
procedure Tab1MouseDown(Sender: TObject; Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
|
|
procedure frDesignerFormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
|
procedure frDesignerFormCloseQuery(Sender: TObject; var CanClose: boolean);
|
|
procedure frSpeedButton1Click(Sender: TObject);
|
|
procedure StB1Click(Sender: TObject);
|
|
private
|
|
//
|
|
FirstSelected : TfrView; // First Selected Object
|
|
SelNum : Integer; // number of objects currently selected
|
|
MRFlag : Boolean; // several objects was selected
|
|
ObjRepeat : Boolean; // was pressed Shift + Insert Object
|
|
|
|
{ Private declarations }
|
|
fInBuildPage : Boolean;
|
|
|
|
PageView: TfrDesignerPage;
|
|
EditorForm: TfrEditorForm;
|
|
ColorSelector: TColorSelector;
|
|
MenuItems: TFpList;
|
|
ItemWidths: TStringList;
|
|
FCurPage: Integer;
|
|
FGridSize: Integer;
|
|
FGridShow, FGridAlign: Boolean;
|
|
FUnits: TfrReportUnits;
|
|
FGrayedButtons: Boolean;
|
|
FUndoBuffer, FRedoBuffer: TfrUndoBuffer;
|
|
FUndoBufferLength, FRedoBufferLength: Integer;
|
|
FirstTime: Boolean;
|
|
MaxItemWidth, MaxShortCutWidth: Integer;
|
|
// FirstInstance: Boolean;
|
|
EditAfterInsert: Boolean;
|
|
FCurDocName, FCaption: String;
|
|
fCurDocFileType: Integer;
|
|
ShapeMode: TfrShapeMode;
|
|
|
|
{$IFDEF StdOI}
|
|
ObjInsp : TObjectInspector;
|
|
PropHook : TPropertyEditorHook;
|
|
{$ELSE}
|
|
ObjInsp : TfrObjectInspector;
|
|
{$ENDIF}
|
|
procedure CreateNewReport;
|
|
procedure DuplicateSelection;
|
|
procedure ObjInspSelect(Obj:TObject);
|
|
procedure ObjInspRefresh;
|
|
|
|
procedure GetFontList;
|
|
procedure SetMenuBitmaps;
|
|
procedure SetCurPage(Value: Integer);
|
|
procedure SetGridSize(Value: Integer);
|
|
procedure SetGridShow(Value: Boolean);
|
|
procedure SetGridAlign(Value: Boolean);
|
|
procedure SetUnits(Value: TfrReportUnits);
|
|
procedure SetGrayedButtons(Value: Boolean);
|
|
procedure SetCurDocName(Value: String);
|
|
procedure SelectionChanged;
|
|
procedure ShowPosition;
|
|
procedure ShowContent;
|
|
procedure EnableControls;
|
|
procedure ResetSelection;
|
|
procedure DeleteObjects;
|
|
procedure AddPage(ClName : string);
|
|
procedure RemovePage(n: Integer);
|
|
procedure SetPageTitles;
|
|
//** procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
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 SelectAll;
|
|
procedure Unselect;
|
|
procedure CutToClipboard;
|
|
procedure CopyToClipboard;
|
|
procedure SaveState;
|
|
procedure RestoreState;
|
|
procedure ClearBuffer(Buffer: TfrUndoBuffer; var BufferLength: Integer);
|
|
procedure ClearUndoBuffer;
|
|
procedure ClearRedoBuffer;
|
|
procedure Undo(Buffer: PfrUndoBuffer);
|
|
procedure ReleaseAction(ActionRec: TfrUndoRec);
|
|
procedure AddAction(Buffer: PfrUndoBuffer; a: TfrUndoAction; List: TFpList);
|
|
procedure AddUndoAction(AUndoAction: TfrUndoAction);
|
|
procedure DoDrawText(aCanvas: TCanvas; aCaption: string;
|
|
Rect: TRect; Selected, aEnabled: Boolean; Flags: Longint);
|
|
procedure MeasureItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
|
|
var AWidth, AHeight: Integer);
|
|
procedure DrawItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
|
|
ARect: TRect; Selected: Boolean);
|
|
function FindMenuItem(AMenuItem: TMenuItem): TfrMenuItemInfo;
|
|
procedure SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn:TSpeedButton);
|
|
procedure FillMenuItems(MenuItem: TMenuItem);
|
|
procedure DeleteMenuItems(MenuItem: TMenuItem);
|
|
procedure OnActivateApp(Sender: TObject);
|
|
procedure OnDeactivateApp(Sender: TObject);
|
|
procedure GetDefaultSize(var dx, dy: Integer);
|
|
function SelStatus: TfrSelectionStatus;
|
|
procedure UpdScrollbars;
|
|
// procedure InsertDbFields;
|
|
{$ifdef sbod}
|
|
procedure DrawStatusPanel(const ACanvas:TCanvas; const rect: TRect);
|
|
procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
|
|
const Rect: TRect);
|
|
{$endif}
|
|
procedure DefineExtraPopupSelected(popup: TPopupMenu);
|
|
procedure SelectSameClassClick(Sender: TObject);
|
|
procedure SelectSameClass(View: TfrView);
|
|
function CheckFileModified: Integer;
|
|
private
|
|
FDuplicateCount: Integer;
|
|
FDupDeltaX,FDupDeltaY: Integer;
|
|
FDuplicateList: TFpList;
|
|
procedure ViewsAction(Views: TFpList; TheAction:TViewAction; Data: PtrInt;
|
|
OnlySel:boolean=true; WithUndoAction:boolean=true; WithRedraw:boolean=true);
|
|
procedure ToggleFrames(View: TfrView; Data: PtrInt);
|
|
procedure DuplicateView(View: TfrView; Data: PtrInt);
|
|
procedure ResetDuplicateCount;
|
|
function lrDesignAcceptDrag(const Source: TObject): TControl;
|
|
protected
|
|
procedure SetModified(AValue: Boolean);override;
|
|
function IniFileName:string;
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure WndProc(var Message: TLMessage); override;
|
|
procedure RegisterObject(ButtonBmp: TBitmap; const ButtonHint: String;
|
|
ButtonTag: Integer; ObjectType:TfrObjectType); override;
|
|
procedure RegisterTool(const MenuCaption: String; ButtonBmp: TBitmap;
|
|
OnClickEvnt: TNotifyEvent); override;
|
|
procedure BeforeChange; override;
|
|
procedure AfterChange; override;
|
|
procedure ShowMemoEditor;
|
|
procedure ShowEditor;
|
|
procedure RedrawPage; override;
|
|
procedure OnModify({%H-}sender: TObject);
|
|
function PointsToUnits(x: Integer): Double; override;
|
|
function UnitsToPoints(x: Double): Integer; override;
|
|
procedure MoveObjects(dx, dy: Integer; aResize: Boolean);
|
|
procedure UpdateStatus;
|
|
|
|
property CurDocName: String read FCurDocName write SetCurDocName;
|
|
property CurPage: Integer read FCurPage write SetCurPage;
|
|
property GridSize: Integer read FGridSize write SetGridSize;
|
|
property ShowGrid: Boolean read FGridShow write SetGridShow;
|
|
property GridAlign: Boolean read FGridAlign write SetGridAlign;
|
|
property Units: TfrReportUnits read FUnits write SetUnits;
|
|
property GrayedButtons: Boolean read FGrayedButtons write SetGrayedButtons;
|
|
end;
|
|
|
|
procedure frSetGlyph(aColor: TColor; sb: TSpeedButton; n: Integer);
|
|
function frCheckBand(b: TfrBandType): Boolean;
|
|
|
|
var
|
|
frTemplateDir: String;
|
|
edtScriptFontName : string = '';
|
|
edtScriptFontSize : integer = 0;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
{$R bullets.res}
|
|
{$R fr_pencil.res}
|
|
|
|
uses
|
|
LR_Pgopt, LR_GEdit, LR_Templ, LR_Newrp, LR_DsOpt, LR_Const, LR_Pars,
|
|
LR_Prntr, LR_Hilit, LR_Flds, LR_Dopt, LR_Ev_ed, LR_BndEd, LR_VBnd,
|
|
LR_BTyp, LR_Utils, LR_GrpEd, LR_About, LR_IFlds, LR_DBRel,LR_DBSet,
|
|
DB, lr_design_ins_filed, IniFiles;
|
|
|
|
type
|
|
THackView = class(TfrView)
|
|
end;
|
|
|
|
function GetUnusedBand: TfrBandType; forward;
|
|
procedure SendBandsToDown; forward;
|
|
procedure ClearClipBoard; forward;
|
|
function Objects: TFpList; forward;
|
|
procedure GetRegion; forward;
|
|
function TopSelected: Integer; forward;
|
|
|
|
var
|
|
// FirstInst : Boolean=True;// First instance
|
|
{
|
|
FirstSelected : TfrView; // First Selected Object
|
|
SelNum : Integer; // number of objects currently selected
|
|
MRFlag : Boolean; // several objects was selected
|
|
ObjRepeat : Boolean; // 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 : Integer;
|
|
LastAdjust : Integer;
|
|
LastFrameWidth : Single;
|
|
LastLineWidth : Single;
|
|
LastFrames : TfrFrameBorders;
|
|
LastFontStyle : Word;
|
|
LastFrameColor : TColor;
|
|
LastFillColor : TColor;
|
|
LastFontColor : TColor;
|
|
ClrButton : TSpeedButton;
|
|
FirstChange : Boolean;
|
|
ClipRgn : HRGN;
|
|
|
|
// globals
|
|
ClipBd : TFpList; // clipboard
|
|
GridBitmap : TBitmap; // for drawing grid in design time
|
|
ColorLocked : Boolean; // true to avoid unwished color change
|
|
|
|
frDesignerComp : TfrDesigner;
|
|
|
|
|
|
{----------------------------------------------------------------------------}
|
|
procedure AddRgn(var HR: HRGN; T: TfrView);
|
|
var
|
|
tr: HRGN;
|
|
begin
|
|
tr := t.GetClipRgn(rtExtended);
|
|
CombineRgn(HR, HR, TR, RGN_OR);
|
|
DeleteObject(TR);
|
|
end;
|
|
|
|
{ TPaintSel }
|
|
|
|
constructor TPaintSel.Create(AOwner: TfrDesignerPage);
|
|
begin
|
|
inherited Create;
|
|
fOwner := AOwner;
|
|
fGreenBullet := TPortableNetworkGraphic.Create;
|
|
fGrayBullet := TPortableNetworkGraphic.Create;
|
|
fGreenBullet.LoadFromResourceName(HInstance, 'bulletgreen');
|
|
fGrayBullet.LoadFromResourceName(HInstance, 'bulletgray');
|
|
end;
|
|
|
|
destructor TPaintSel.Destroy;
|
|
begin
|
|
fGrayBullet.Free;
|
|
fGreenBullet.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPaintSel.FocusRect(aRect: TRect);
|
|
begin
|
|
fFocusRect := aRect;
|
|
Include(fStatus, ptsFocusRect);
|
|
InvalidateFocusRect;
|
|
end;
|
|
|
|
procedure TPaintSel.RemoveFocusRect;
|
|
begin
|
|
InvalidateFocusRect;
|
|
end;
|
|
|
|
procedure TPaintSel.InvalidateSelection;
|
|
begin
|
|
DrawOrInvalidateSelection(false);
|
|
end;
|
|
|
|
procedure TPaintSel.PaintSelection;
|
|
begin
|
|
DrawOrInvalidateSelection(true);
|
|
end;
|
|
|
|
procedure TPaintSel.DrawOrInvalidateSelection(aDraw:boolean);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
Lst: TfpList;
|
|
begin
|
|
Lst := Objects;
|
|
if not Assigned(Lst) then exit;
|
|
for i:=0 to Lst.Count-1 do
|
|
begin
|
|
t := TfrView(Lst[i]);
|
|
if not t.Selected then
|
|
continue;
|
|
DrawOrInvalidateViewHandles(t, aDraw);
|
|
end;
|
|
end;
|
|
|
|
procedure TPaintSel.InvalidateFocusRect;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := fFocusRect;
|
|
fOwner.NormalizeRect(R);
|
|
InvalidateFrame(fOwner.Handle, @R, false, 1);
|
|
end;
|
|
|
|
procedure TPaintSel.DrawOrInvalidateViewHandles(t: TfrView; aDraw:boolean);
|
|
var
|
|
Bullet: TGraphic;
|
|
bdx, bdy: Integer;
|
|
|
|
procedure UpdateBullet(aBullet: TGraphic);
|
|
begin
|
|
Bullet := aBullet;
|
|
bdx := Bullet.Width div 2;
|
|
bdy := Bullet.Height div 2;
|
|
end;
|
|
|
|
procedure DrawPoint(x,y: Integer);
|
|
var
|
|
r: TRect;
|
|
begin
|
|
if aDraw then
|
|
//fOwner.Canvas.EllipseC(x, y, 1, 1)
|
|
fOwner.Canvas.Draw(x-bdx, y-bdy, Bullet)
|
|
else
|
|
begin
|
|
r := rect(x-bdx,y-bdy,x+bdx+1,y+bdy+1);
|
|
InvalidateRect(fOwner.Handle, @r, false);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
px, py: Integer;
|
|
begin
|
|
|
|
with t, fOwner.Canvas do
|
|
begin
|
|
if TfrDesignerForm(frDesigner).SelNum>1 then
|
|
UpdateBullet(fGrayBullet)
|
|
else
|
|
UpdateBullet(fGreenBullet);
|
|
|
|
px := x + dx div 2;
|
|
py := y + dy div 2;
|
|
|
|
DrawPoint(x, y);
|
|
|
|
if dx>0 then
|
|
DrawPoint(x + dx, y);
|
|
|
|
if dy>0 then
|
|
DrawPoint(x, y + dy);
|
|
|
|
if TfrDesignerForm(frDesigner).SelNum = 1 then
|
|
begin
|
|
if px>x then
|
|
DrawPoint(px, y);
|
|
|
|
if py>y then
|
|
DrawPoint(x, py);
|
|
|
|
if (py>y) and (px>x) then
|
|
begin
|
|
DrawPoint(px, y + dy);
|
|
DrawPoint(x + dx, py);
|
|
end;
|
|
end;
|
|
|
|
if (dx>0) and (dy>0) then
|
|
begin
|
|
if aDraw and (Objects.IndexOf(t) = fOwner.RightBottom) then
|
|
UpdateBullet(fGreenBullet);
|
|
DrawPoint(x + dx, y + dy);
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TPaintSel.Paint;
|
|
begin
|
|
if ptsFocusRect in FStatus then
|
|
begin
|
|
fOwner.Canvas.Brush.Style := bsSolid;
|
|
fOwner.Canvas.Pen.Style := psDot;
|
|
fOwner.Canvas.Pen.Color := clSkyBlue;
|
|
fOwner.Canvas.Brush.Style := bsClear;
|
|
fOwner.Canvas.Rectangle(fFocusRect);
|
|
Exclude(Fstatus, ptsFocusRect);
|
|
end;
|
|
end;
|
|
|
|
constructor TfrDesigner.Create(AOwner: TComponent);
|
|
begin
|
|
if Assigned(frDesignerComp) then
|
|
raise Exception.Create(sFRDesignerExists);
|
|
inherited Create(AOwner);
|
|
frDesignerComp:=Self;
|
|
end;
|
|
|
|
destructor TfrDesigner.Destroy;
|
|
begin
|
|
frDesignerComp:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
procedure TfrDesigner.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
frTemplateDir := TemplateDir;
|
|
end;
|
|
|
|
{--------------------------------------------------}
|
|
constructor TfrDesignerPage.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Parent := AOwner as TWinControl;
|
|
Color := clWhite;
|
|
EnableEvents;
|
|
fPaintSel := TPaintSel.Create(self);
|
|
end;
|
|
|
|
destructor TfrDesignerPage.destroy;
|
|
begin
|
|
fPaintSel.Free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.Init;
|
|
begin
|
|
Down := False;
|
|
DFlag:= False;
|
|
RFlag := False;
|
|
Cursor := crDefault;
|
|
CT := ctNone;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.SetPage;
|
|
var
|
|
Pgw,Pgh: Integer;
|
|
begin
|
|
if not Assigned(FDesigner.Page) then Exit;
|
|
|
|
FDesigner.panForDlg.Visible:=(FDesigner.Page is TfrPageDialog);
|
|
FDesigner.panel4.Visible :=not FDesigner.panForDlg.Visible;
|
|
|
|
if (FDesigner.Page is TfrPageDialog) then
|
|
begin
|
|
Color:=clBtnFace;
|
|
SetBounds(10, 10,TfrPageDialog(FDesigner.Page).Width,TfrPageDialog(FDesigner.Page).Height);
|
|
end
|
|
else
|
|
begin
|
|
Pgw := FDesigner.Page.PrnInfo.Pgw;
|
|
Pgh := FDesigner.Page.PrnInfo.Pgh;
|
|
if Pgw > Parent.Width then
|
|
SetBounds(10, 10, Pgw, Pgh)
|
|
else
|
|
SetBounds((Parent.Width - Pgw) div 2, 10, Pgw, Pgh);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.Paint;
|
|
begin
|
|
fPainting := true;
|
|
Draw(10000, 0);
|
|
fPaintSel.Paint;
|
|
fPainting := false;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.WMEraseBkgnd(var Message: TLMEraseBkgnd);
|
|
begin
|
|
//do nothing to avoid flicker
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DoContextPopup(MousePos: TPoint; var Handled: Boolean
|
|
);
|
|
begin
|
|
Handled := true;
|
|
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
|
|
begin
|
|
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;
|
|
end;
|
|
Pen.Mode := pmCopy;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor);
|
|
procedure DrawVertLine(X1,Y1,Y2: integer);
|
|
Var Cl : TColor;
|
|
begin
|
|
Cl:=Canvas.Pen.Color;
|
|
try
|
|
if Y2<Y1 then
|
|
while Y2<Y1 do
|
|
begin
|
|
Canvas.Pen.Color:=Color;
|
|
Canvas.MoveTo(X1,Y1);
|
|
Canvas.LineTo(X1,Y1+1);
|
|
//Canvas.Pixels[X1, Y1] := Color;
|
|
dec(Y1, 2);
|
|
end
|
|
else
|
|
while Y1<Y2 do
|
|
begin
|
|
Canvas.Pen.Color:=Color;
|
|
Canvas.MoveTo(X1,Y1);
|
|
Canvas.LineTo(X1,Y1+1);
|
|
//Canvas.Pixels[X1, Y1] := Color;
|
|
inc(Y1, 2);
|
|
end;
|
|
finally
|
|
Canvas.Pen.Color:=cl;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawHorzLine(X1,Y1,X2: integer);
|
|
Var Cl : TColor;
|
|
begin
|
|
Cl:=Canvas.Pen.Color;
|
|
try
|
|
if X2<X1 then
|
|
while X2<X1 do
|
|
begin
|
|
Canvas.Pen.Color:=Color;
|
|
Canvas.MoveTo(X1,Y1);
|
|
Canvas.LineTo(X1+1,Y1);
|
|
//Canvas.Pixels[X1, Y1] := Color;
|
|
dec(X1, 2);
|
|
end
|
|
else
|
|
while X1<X2 do
|
|
begin
|
|
Canvas.Pen.Color:=Color;
|
|
Canvas.MoveTo(X1,Y1);
|
|
Canvas.LineTo(X1+1,Y1);
|
|
//Canvas.Pixels[X1, Y1] := Color;
|
|
inc(X1, 2);
|
|
end;
|
|
finally
|
|
Canvas.Pen.Color:=cl;
|
|
end;
|
|
end;
|
|
begin
|
|
with aRect do
|
|
begin
|
|
DrawHorzLine(Left, Top, Right-1);
|
|
DrawVertLine(Right-1, Top, Bottom-1);
|
|
DrawHorzLine(Right-1, Bottom-1, Left);
|
|
DrawVertLine(Left, Bottom-1, Top);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DrawFocusRect(aRect: TRect);
|
|
var
|
|
DCIndex: Integer;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
DCIndex := SaveDC(Handle);
|
|
Pen.Mode := pmXor;
|
|
Pen.Color := clWhite;
|
|
//DrawRubberRect(Canvas, aRect, clWhite);
|
|
Pen.Width := 1;
|
|
Pen.Style := psDot;
|
|
MoveTo(aRect.Left, aRect.Top);
|
|
LineTo(aRect.Right, aRect.Top);
|
|
LineTo(aRect.Right, aRect.Bottom);
|
|
LineTo(aRect.left, aRect.Bottom);
|
|
LineTo(aRect.left, aRect.Top);
|
|
//Brush.Style := bsClear;
|
|
//Rectangle(aRect);
|
|
RestoreDC(Handle, DCIndex);
|
|
Pen.Mode := pmCopy;
|
|
fOldFocusRect:=aRect;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DrawSelection(t: TfrView);
|
|
var
|
|
px, py: Word;
|
|
procedure DrawPoint(x, y: Word);
|
|
begin
|
|
Canvas.EllipseC(x,y,1,1);
|
|
//Canvas.MoveTo(x, y);
|
|
//Canvas.LineTo(x, y);
|
|
end;
|
|
begin
|
|
if t.Selected then
|
|
with t, Self.Canvas do
|
|
begin
|
|
Pen.Width := 5;
|
|
Pen.Mode := pmXor;
|
|
Pen.Color := clWhite;
|
|
px := x + dx div 2;
|
|
py := y + dy div 2;
|
|
|
|
DrawPoint(x, y);
|
|
|
|
if dx>0 then
|
|
DrawPoint(x + dx, y);
|
|
|
|
if dy>0 then
|
|
DrawPoint(x, y + dy);
|
|
|
|
if (dx>0) and (dy>0) then
|
|
begin
|
|
if Objects.IndexOf(t) = RightBottom then
|
|
Pen.Color := clTeal;
|
|
DrawPoint(x + dx, y + dy);
|
|
end;
|
|
|
|
Pen.Color := clWhite;
|
|
if TfrDesignerForm(frDesigner).SelNum = 1 then
|
|
begin
|
|
if px>x then
|
|
DrawPoint(px, y);
|
|
|
|
if py>y then
|
|
DrawPoint(x, py);
|
|
|
|
if (py>y) and (px>x) then
|
|
begin
|
|
DrawPoint(px, y + dy);
|
|
DrawPoint(x + dx, py);
|
|
end;
|
|
end;
|
|
Pen.Mode := pmCopy;
|
|
// NOTE: ROP mode under gtk is used not only to draw with pen but
|
|
// also any other filled graphics, the problem is that brush
|
|
// handle is not invalidated when pen has changed as result
|
|
// the ROP mode is not updated and next operation will use
|
|
// the old XOR mode.
|
|
// TODO: Solve this problem in LCL-gtk, as workaround draw something
|
|
// using new pen.
|
|
EllipseC(-100,-100,1,1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DrawShape(t: TfrView);
|
|
begin
|
|
if t.Selected then
|
|
with t do
|
|
DrawFocusRect(Rect(x, y, x + dx + 1, y + dy + 1));
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DrawDialog(N: Integer; AClipRgn: HRGN);
|
|
Var
|
|
Dlg : TfrPageDialog;
|
|
i, iy : Integer;
|
|
t : TfrView;
|
|
Objects : TFpList;
|
|
begin
|
|
Dlg:=TfrPageDialog(FDesigner.Page);
|
|
|
|
with Canvas do
|
|
begin
|
|
Brush.Color := clGray;
|
|
FillRect(Rect(0,0, Width, Height + 20));
|
|
|
|
Brush.Color := clBtnFace;
|
|
Brush.Style := bsSolid;
|
|
Rectangle(Rect(0,0,FDesigner.Page.Width-1,FDesigner.Page.Height-1));
|
|
Brush.Color := clBlue;
|
|
Rectangle(Rect(0,0,FDesigner.Page.Width-1,20));
|
|
|
|
Canvas.TextRect(Rect(0,0,FDesigner.Page.Width-1,20), 1, 5, Dlg.Caption);
|
|
|
|
end;
|
|
|
|
|
|
Objects := FDesigner.Page.Objects;
|
|
|
|
for i:=0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
t.draw(Canvas);
|
|
|
|
iy:=1;
|
|
//Show indicator if script it's not empty
|
|
if t.Script.Count>0 then
|
|
begin
|
|
FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 0);
|
|
iy:=10;
|
|
end;
|
|
|
|
end;
|
|
|
|
FDesigner.ImageList2.Draw(Canvas, Width-14, Height-14, 1);
|
|
if not Down then
|
|
NPPaintSelection;
|
|
|
|
end;
|
|
|
|
procedure TfrDesignerPage.Draw(N: Integer; AClipRgn: HRGN);
|
|
var
|
|
i,iy : Integer;
|
|
t : TfrView;
|
|
R, R1 : HRGN;
|
|
Objects : TFpList;
|
|
|
|
procedure DrawBackground;
|
|
var
|
|
i, j: Integer;
|
|
Re: TRect;
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
if FDesigner.ShowGrid and (FDesigner.GridSize <> 18) then
|
|
begin
|
|
with GridBitmap.Canvas do
|
|
begin
|
|
Brush.Color := clWhite;
|
|
FillRect(Rect(0, 0, 8, 8));
|
|
Pixels[0, 0] := clBlack;
|
|
if FDesigner.GridSize = 4 then
|
|
begin
|
|
Pixels[4, 0] := clBlack;
|
|
Pixels[0, 4] := clBlack;
|
|
Pixels[4, 4] := clBlack;
|
|
end;
|
|
end;
|
|
Brush.Bitmap := GridBitmap;
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color := clWhite;
|
|
Brush.Style := bsSolid;
|
|
Brush.Bitmap:= nil;
|
|
end;
|
|
|
|
//FillRgn(Handle, R, Brush.Handle);
|
|
GetRgnBox(R, @Re);
|
|
FillRect(Re);
|
|
|
|
if FDesigner.ShowGrid and (FDesigner.GridSize = 18) then
|
|
begin
|
|
i := 0;
|
|
while i < Width do
|
|
begin
|
|
j := 0;
|
|
while j < Height do
|
|
begin
|
|
if RectVisible(Handle, Rect(i, j, i + 1, j + 1)) then
|
|
Pixels[i,j]:=clBlack;
|
|
Inc(j, FDesigner.GridSize);
|
|
end;
|
|
Inc(i, FDesigner.GridSize);
|
|
end;
|
|
end;
|
|
Brush.Style := bsClear;
|
|
Pen.Width := 1;
|
|
Pen.Color := clSilver;
|
|
Pen.Style := psSolid;
|
|
Pen.Mode := pmCopy;
|
|
with FDesigner.Page do
|
|
begin
|
|
if UseMargins then
|
|
Rectangle(LeftMargin, TopMargin, RightMargin, BottomMargin);
|
|
if ColCount > 1 then
|
|
begin
|
|
ColWidth := (RightMargin - LeftMargin) 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;
|
|
end;
|
|
end;
|
|
|
|
function ViewIsVisible(t: TfrView): Boolean;
|
|
var
|
|
Rn: HRGN;
|
|
begin
|
|
Rn := t.GetClipRgn(rtNormal);
|
|
Result := CombineRgn(Rn, Rn, AClipRgn, RGN_AND) <> NULLREGION;
|
|
if Result then
|
|
// will this view be really visible?
|
|
Result := CombineRgn(Rn, AClipRgn, R, RGN_AND) <> NULLREGION;
|
|
DeleteObject(Rn);
|
|
end;
|
|
|
|
begin
|
|
if FDesigner.Page = nil then Exit;
|
|
|
|
DocMode := dmDesigning;
|
|
|
|
Objects := FDesigner.Page.Objects;
|
|
|
|
if FDesigner.Page is TfrPageDialog then
|
|
begin
|
|
DrawDialog(N, AClipRgn);
|
|
Exit;
|
|
end;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('TfrDesignerPage.Draw INIT N=%d AClipRgn=%d',[N,AClipRgn]);
|
|
{$ENDIF}
|
|
|
|
if AClipRgn = 0 then
|
|
begin
|
|
with Canvas.ClipRect do
|
|
AClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
R:=CreateRectRgn(0, 0, Width, Height);
|
|
for i:=Objects.Count-1 downto 0 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
{$IFDEF DebugLR}
|
|
DebugLn('Draw ',InttoStr(i),' ',t.Name);
|
|
{$ENDIF}
|
|
if i <= N then
|
|
begin
|
|
if t.selected then
|
|
t.draw(canvas)
|
|
else
|
|
if ViewIsVisible(t) then
|
|
begin
|
|
R1 := CreateRectRgn(0, 0, 1, 1);
|
|
CombineRgn(R1, AClipRgn, R, RGN_AND);
|
|
SelectClipRgn(Canvas.Handle, R1);
|
|
DeleteObject(R1);
|
|
|
|
t.Draw(Canvas);
|
|
|
|
iy:=1;
|
|
//Show indicator if script it's not empty
|
|
if t.Script.Count>0 then
|
|
begin
|
|
FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 0);
|
|
iy:=10;
|
|
end;
|
|
|
|
//Show indicator if hightlight it's not empty
|
|
if (t is TfrCustomMemoView) and (Trim(TfrCustomMemoView(t).HighlightStr)<>'') then
|
|
FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 1);
|
|
end;
|
|
end;
|
|
R1 := t.GetClipRgn(rtNormal);
|
|
CombineRgn(R, R, R1, RGN_DIFF);
|
|
DeleteObject(R1);
|
|
SelectClipRgn(Canvas.Handle, R);
|
|
end;
|
|
|
|
CombineRgn(R, R, AClipRgn, RGN_AND);
|
|
|
|
DrawBackground;
|
|
|
|
DeleteObject(R);
|
|
DeleteObject(AClipRgn);
|
|
if AClipRgn=ClipRgn then
|
|
ClipRgn := 0;
|
|
|
|
SelectClipRgn(Canvas.Handle, 0);
|
|
|
|
if not Down then
|
|
NPPaintSelection;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.Draw DONE');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
begin
|
|
if DocMode <> dmDesigning then Exit;
|
|
{$ifdef ppaint}
|
|
if DrawMode=dmSelection then
|
|
begin
|
|
if not fPainting then
|
|
fPaintSel.InvalidateSelection;
|
|
exit;
|
|
end;
|
|
{$endif}
|
|
for i:=0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(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.GridSize;
|
|
p := Point(x, y);
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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 GridSize * GridSize;
|
|
y := y div GridSize * GridSize;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.GetMultipleSelected;
|
|
var
|
|
i, j, k: Integer;
|
|
t: TfrView;
|
|
begin
|
|
j := 0; k := 0;
|
|
LeftTop := Point(10000, 10000);
|
|
RightBottom := -1;
|
|
TfrDesignerForm(frDesigner).MRFlag := False;
|
|
if TfrDesignerForm(frDesigner).SelNum > 1 then {find right-bottom element}
|
|
begin
|
|
for i := 0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(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 := TfrView(Objects[RightBottom]);
|
|
OldRect := Rect(LeftTop.x, LeftTop.y, t.x + t.dx, t.y + t.dy);
|
|
OldRect1 := OldRect;
|
|
TfrDesignerForm(frDesigner).MRFlag := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.MDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
i: Integer;
|
|
f, DontChange, v: Boolean;
|
|
t: TfrView;
|
|
p: TPoint;
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('TfrDesignerPage.MDown(X=%d,Y=%d) INIT',[x,y]);
|
|
DebugLn('Down=%s RFlag=%s',[dbgs(Down),dbgs(RFlag)]);
|
|
{$ENDIF}
|
|
|
|
// In Lazarus there is no mousedown after doubleclick so
|
|
// just ignore mousedown when doubleclick is coming.
|
|
if ssDouble in Shift then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MDown DONE: doubleclick expected');
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
|
|
if (Button = mbRight) and Down and RFlag then
|
|
NPEraseFocusRect;
|
|
|
|
RFlag := False;
|
|
NPEraseSelection;
|
|
Down := True;
|
|
DontChange := False;
|
|
if Button = mbLeft then
|
|
begin
|
|
if (ssCtrl in Shift) or (Cursor = crCross) then
|
|
begin
|
|
RFlag := True;
|
|
if Cursor = crCross then
|
|
begin
|
|
NPEraseFocusRect;
|
|
RoundCoord(x, y);
|
|
OldRect1 := OldRect;
|
|
end;
|
|
OldRect := Rect(x, y, x, y);
|
|
FDesigner.Unselect;
|
|
TfrDesignerForm(frDesigner).SelNum := 0;
|
|
RightBottom := -1;
|
|
TfrDesignerForm(frDesigner).MRFlag := False;
|
|
TfrDesignerForm(frDesigner).FirstSelected := nil;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MDown DONE: Ctrl+Left o cursor=crCross');
|
|
{$ENDIF}
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
{$endif}
|
|
Exit;
|
|
end
|
|
else if Cursor = crPencil then
|
|
begin
|
|
with FDesigner do
|
|
begin
|
|
if GridAlign then
|
|
begin
|
|
if not FindNearestEdge(x, y) then
|
|
begin
|
|
x := Round(x / GridSize) * GridSize;
|
|
y := Round(y / GridSize) * GridSize;
|
|
end;
|
|
end;
|
|
end;
|
|
OldRect := Rect(x, y, x, y);
|
|
FDesigner.Unselect;
|
|
TfrDesignerForm(frDesigner).SelNum := 0;
|
|
RightBottom := -1;
|
|
TfrDesignerForm(frDesigner).MRFlag := False;
|
|
TfrDesignerForm(frDesigner).FirstSelected := nil;
|
|
LastX := x;
|
|
LastY := y;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MDown DONE: Left + cursor=crPencil');
|
|
{$ENDIF}
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
{$endif}
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if Cursor = crDefault then
|
|
begin
|
|
f := False;
|
|
for i := Objects.Count - 1 downto 0 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
V:=t.PointInView(X,Y);
|
|
{$IFDEF DebugLR}
|
|
DebugLn(t.Name,' PointInView(Rgn, X, Y)=',dbgs(V),' Selected=',dbgs(t.selected));
|
|
{$ENDIF}
|
|
if v then
|
|
begin
|
|
if ssShift in Shift then
|
|
begin
|
|
t.Selected := not t.Selected;
|
|
if t.Selected then
|
|
Inc(TfrDesignerForm(frDesigner).SelNum)
|
|
else
|
|
Dec(TfrDesignerForm(frDesigner).SelNum);
|
|
end
|
|
else
|
|
begin
|
|
if not t.Selected then
|
|
begin
|
|
FDesigner.Unselect;
|
|
TfrDesignerForm(frDesigner).SelNum := 1;
|
|
t.Selected := True;
|
|
end
|
|
else DontChange := True;
|
|
end;
|
|
|
|
if TfrDesignerForm(frDesigner).SelNum = 0 then
|
|
TfrDesignerForm(frDesigner).FirstSelected := nil
|
|
else
|
|
if TfrDesignerForm(frDesigner).SelNum = 1 then
|
|
TfrDesignerForm(frDesigner).FirstSelected := t
|
|
else
|
|
if TfrDesignerForm(frDesigner).FirstSelected <> nil then
|
|
if not TfrDesignerForm(frDesigner).FirstSelected.Selected then
|
|
TfrDesignerForm(frDesigner).FirstSelected := nil;
|
|
f := True;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if not f then
|
|
begin
|
|
FDesigner.Unselect;
|
|
TfrDesignerForm(frDesigner).SelNum := 0;
|
|
TfrDesignerForm(frDesigner).FirstSelected := nil;
|
|
if Button = mbLeft then
|
|
begin
|
|
RFlag := True;
|
|
OldRect := Rect(x, y, x, y);
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MDown DONE: Deselection o no selection');
|
|
{$ENDIF}
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
{$endif}
|
|
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
GetMultipleSelected;
|
|
if not DontChange then begin
|
|
FDesigner.SelectionChanged;
|
|
FDesigner.ResetDuplicateCount;
|
|
end;
|
|
end
|
|
else
|
|
if (Cursor = crSizeNWSE) and (FDesigner.Page is TfrPageDialog) then
|
|
begin
|
|
if (X > FDesigner.Page.Width - 10) and (X < FDesigner.Page.Width +10) and (Y > FDesigner.Page.Height - 10) and (Y < FDesigner.Page.Height + 10) then
|
|
fResizeDialog:=true
|
|
else
|
|
fResizeDialog:=false;
|
|
Exit;
|
|
end;
|
|
|
|
if TfrDesignerForm(frDesigner).SelNum = 0 then
|
|
begin // reset multiple selection
|
|
RightBottom := -1;
|
|
TfrDesignerForm(frDesigner).MRFlag := False;
|
|
end;
|
|
|
|
LastX := x;
|
|
LastY := y;
|
|
Moved := False;
|
|
FirstChange := True;
|
|
FirstBandMove := True;
|
|
|
|
if Button = mbRight then
|
|
begin
|
|
NPDrawSelection;
|
|
Down := False;
|
|
GetCursorPos(p{%H-});
|
|
//FDesigner.Popup1Popup(nil);
|
|
|
|
FDesigner.Popup1.PopUp(p.X,p.Y);
|
|
//**
|
|
{TrackPopupMenu(FDesigner.Popup1.Handle,
|
|
TPM_LEFTALIGN or TPM_RIGHTBUTTON, p.X, p.Y, 0, FDesigner.Handle, nil);
|
|
}
|
|
end
|
|
else if FDesigner.ShapeMode = smFrame then
|
|
DrawPage(dmShape);
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MDown DONE');
|
|
{$ENDIF}
|
|
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, '', FDesigner.Page));
|
|
t := TfrView(Objects.Last);}
|
|
t:=frCreateObject(ot, '', FDesigner.Page);
|
|
if t is TfrCustomMemoView then
|
|
TfrCustomMemoView(t).MonitorFontChanges;
|
|
end;
|
|
|
|
procedure CreateSection;
|
|
var
|
|
s: String;
|
|
begin
|
|
frBandTypesForm := TfrBandTypesForm.Create(FDesigner);
|
|
try
|
|
ObjectInserted := frBandTypesForm.ShowModal = mrOk;
|
|
if ObjectInserted then
|
|
begin
|
|
{ Objects.Add(TfrBandView.Create(FDesigner.Page));
|
|
t := TfrView(Objects.Last);}
|
|
t:=TfrBandView.Create(FDesigner.Page);
|
|
(t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
|
|
s := frGetBandName(frBandTypesForm.SelectedTyp);
|
|
THackView(t).BaseName := s;
|
|
SendBandsToDown;
|
|
end;
|
|
finally
|
|
frBandTypesForm.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure CreateSubReport;
|
|
begin
|
|
{ Objects.Add(TfrSubReportView.Create(FDesigner.Page));
|
|
t := TfrView(Objects.Last);}
|
|
t:=TfrSubReportView.Create(FDesigner.Page);
|
|
(t as TfrSubReportView).SubPage := CurReport.Pages.Count;
|
|
CurReport.Pages.Add;
|
|
end;
|
|
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('TfrDesignerPage.MUp INIT Button=%d Cursor=%d RFlag=%s',
|
|
[ord(Button),Cursor,dbgs(RFlag)]);
|
|
{$ENDIF}
|
|
if Button <> mbLeft then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: Button<>mbLeft');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
Down := False;
|
|
if FDesigner.ShapeMode = smFrame then
|
|
DrawPage(dmShape);
|
|
|
|
//inserting a new object
|
|
if Cursor = crCross then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('Inserting a New Object INIT');
|
|
{$ENDIF}
|
|
EnableEvents(false);
|
|
Mode := mdSelect;
|
|
if (OldRect.Left = OldRect.Right) and (OldRect.Top = OldRect.Bottom) then
|
|
OldRect := OldRect1
|
|
else
|
|
NPEraseFocusRect;
|
|
NormalizeRect(OldRect);
|
|
RFlag := False;
|
|
ObjectInserted := True;
|
|
|
|
if FDesigner.Panel4.Visible then
|
|
begin
|
|
with FDesigner.Panel4 do
|
|
begin
|
|
for i := 0 to ControlCount - 1 do
|
|
begin
|
|
if Controls[i] is TSpeedButton then
|
|
begin
|
|
with Controls[i] as TSpeedButton do
|
|
begin
|
|
if Down then
|
|
begin
|
|
if Tag = gtBand then
|
|
begin
|
|
if GetUnusedBand <> btNone then
|
|
CreateSection
|
|
else
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('Inserting a new object DONE: GetUnusedBand=btNone');
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: Inserting..');
|
|
{$ENDIF}
|
|
EnableEvents;
|
|
Exit;
|
|
end;
|
|
end
|
|
else if Tag = gtSubReport then
|
|
CreateSubReport
|
|
else
|
|
begin
|
|
if Tag >= gtAddIn then
|
|
begin
|
|
k := Tag - gtAddIn;
|
|
{ Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
|
|
t := TfrView(Objects.Last);}
|
|
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
|
|
end
|
|
else
|
|
AddObject(Tag);
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
with FDesigner.panForDlg do
|
|
begin
|
|
for i := 0 to ControlCount - 1 do
|
|
begin
|
|
if Controls[i] is TSpeedButton then
|
|
begin
|
|
with Controls[i] as TSpeedButton do
|
|
begin
|
|
if Down then
|
|
begin
|
|
if Tag >= gtAddIn then
|
|
begin
|
|
k := Tag - gtAddIn;
|
|
{ Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
|
|
t := TfrView(Objects.Last);}
|
|
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
|
|
end
|
|
else
|
|
AddObject(Tag);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ObjectInserted then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
debugLn('Object inserted begin');
|
|
{$ENDIF}
|
|
t.CreateUniqueName;
|
|
t.Canvas:=Canvas;
|
|
|
|
with OldRect do
|
|
begin
|
|
if (Left = Right) or (Top = Bottom) then
|
|
begin
|
|
dx := 40;
|
|
dy := 40;
|
|
if t is TfrCustomMemoView then
|
|
FDesigner.GetDefaultSize(dx, dy);
|
|
OldRect := Rect(Left, Top, Left + dx, Top + dy);
|
|
end;
|
|
end;
|
|
{$ifdef ppaint}
|
|
NPEraseSelection;
|
|
{$endif}
|
|
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
|
|
(TfrBandView(t).BandType in [btCrossHeader..btCrossFooter]) and
|
|
(t.dx > Width - 10) then
|
|
t.dx := 40;
|
|
t.FrameWidth := LastFrameWidth;
|
|
t.FrameColor := LastFrameColor;
|
|
t.FillColor := LastFillColor;
|
|
t.Selected := True;
|
|
|
|
if t.Typ <> gtBand then
|
|
t.Frames:=LastFrames;
|
|
|
|
if t is TfrCustomMemoView then
|
|
begin
|
|
with t as TfrCustomMemoView do
|
|
begin
|
|
Font.Name := LastFontName;
|
|
Font.Size := LastFontSize;
|
|
Font.Color := LastFontColor;
|
|
Font.Style := frSetFontStyle(LastFontStyle);
|
|
Adjust := LastAdjust;
|
|
end;
|
|
end
|
|
else
|
|
if t is TfrControl then
|
|
TfrControl(T).UpdateControlPosition;
|
|
|
|
TfrDesignerForm(frDesigner).SelNum := 1;
|
|
NPRedrawViewCheckBand(t);
|
|
|
|
with FDesigner do
|
|
begin
|
|
SelectionChanged;
|
|
AddUndoAction(acInsert);
|
|
if EditAfterInsert then
|
|
ShowEditor;
|
|
end;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLn('Object inserted end');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if not TfrDesignerForm(frDesigner).ObjRepeat then
|
|
begin
|
|
if FDesigner.Page is TfrPageReport then
|
|
FDesigner.OB1.Down := True
|
|
else
|
|
FDesigner.OB7.Down := True
|
|
end
|
|
else
|
|
NPEraseFocusRect;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('Inserting a New Object DONE');
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: Inserting ...');
|
|
{$ENDIF}
|
|
EnableEvents;
|
|
Exit;
|
|
end;
|
|
|
|
//line drawing
|
|
if Cursor = crPencil then
|
|
begin
|
|
DrawRectLine(OldRect);
|
|
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.BeginUpdate;
|
|
t.FrameWidth := LastLineWidth;
|
|
t.FrameColor := LastFrameColor;
|
|
t.EndUpdate;
|
|
TfrDesignerForm(frDesigner).SelNum := 1;
|
|
NPRedrawViewCheckBand(t);
|
|
FDesigner.SelectionChanged;
|
|
FDesigner.AddUndoAction(acInsert);
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: Line Drawing');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
// calculating which objects contains in frame (if user select it with mouse+Ctrl key)
|
|
if RFlag then
|
|
begin
|
|
NPEraseFocusRect;
|
|
RFlag := False;
|
|
NormalizeRect(OldRect);
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
with OldRect do
|
|
begin
|
|
if t.Typ <> gtBand then
|
|
begin
|
|
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(TfrDesignerForm(frDesigner).SelNum);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
GetMultipleSelected;
|
|
FDesigner.SelectionChanged;
|
|
NPDrawSelection;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: objects contained in frame');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//splitting
|
|
if Moved and TfrDesignerForm(frDesigner).MRFlag and (Cursor = crHSplit) then
|
|
begin
|
|
with SplitInfo do
|
|
begin
|
|
dx := SplRect.Left - SplX;
|
|
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;
|
|
NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: Splitting');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//resizing several objects
|
|
if Moved and TfrDesignerForm(frDesigner).MRFlag and (Cursor <> crDefault) then
|
|
begin
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
DeleteObject(ClipRgn);
|
|
ClipRgn:=0;
|
|
{$else}
|
|
NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
{$endif}
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE: resizing several objects');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//redrawing all moved or resized objects
|
|
if not Moved then
|
|
begin
|
|
NPDrawSelection;
|
|
{$IFDEF DebugLR}
|
|
DebugLn('redrawing all moved or resized objects');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if (TfrDesignerForm(frDesigner).SelNum >= 1) and Moved then
|
|
begin
|
|
if TfrDesignerForm(frDesigner).SelNum > 1 then
|
|
begin
|
|
//JRA DebugLn('HERE, ClipRgn', Dbgs(ClipRgn));
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
if ClipRgn<>0 then
|
|
DeleteObject(ClipRgn);
|
|
ClipRgn:=0;
|
|
{$else}
|
|
NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
{$endif}
|
|
GetMultipleSelected;
|
|
FDesigner.ShowPosition;
|
|
end
|
|
else
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
NormalizeCoord(t);
|
|
if Cursor <> crDefault then
|
|
t.Resized;
|
|
|
|
if T is TfrControl then
|
|
TfrControl(T).UpdateControlPosition;
|
|
|
|
{$ifdef ppaint}
|
|
NPDrawSelection;
|
|
if ClipRgn<>0 then
|
|
begin
|
|
DeleteObject(ClipRgn);
|
|
Invalidate;
|
|
end;
|
|
ClipRgn:=0;
|
|
{$else}
|
|
NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
{$endif}
|
|
FDesigner.ShowPosition;
|
|
end;
|
|
end;
|
|
|
|
if (FDesigner.Page is TfrPageDialog) and (fResizeDialog ) then
|
|
begin
|
|
Width:=X;
|
|
Height:=Y;
|
|
fResizeDialog:=false;
|
|
Mode:=mdSelect;
|
|
FDesigner.Page.Width:=X;
|
|
FDesigner.Page.Height:=Y;
|
|
DrawPage(dmAll);
|
|
FDesigner.Modified:=true;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if T is TfrControl then
|
|
TfrControl(T).UpdateControlPosition;
|
|
end;
|
|
end;
|
|
|
|
|
|
Moved := False;
|
|
CT := ctNone;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MUp DONE');
|
|
{$ENDIF}
|
|
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;
|
|
hr, hr1,Hr2: HRGN;
|
|
|
|
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 >= GridSize) or (kx <= -GridSize) or
|
|
(ky >= GridSize) or (ky <= -GridSize);
|
|
if Result then
|
|
begin
|
|
kx := kx - kx mod GridSize;
|
|
ky := ky - ky mod GridSize;
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('TfrDesignerPage.MMove(X=%d,Y=%d) INIT',[x,y]);
|
|
{$ENDIF}
|
|
Moved := True;
|
|
w := 2;
|
|
|
|
if FirstChange and Down and not RFlag then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := y - LastY;
|
|
if not FDesigner.GridAlign or GridCheck then
|
|
begin
|
|
GetRegion; //JRA 1
|
|
FDesigner.AddUndoAction(acEdit);
|
|
end;
|
|
end;
|
|
|
|
if not Down then
|
|
begin
|
|
if FDesigner.panForDlg.Visible then
|
|
begin
|
|
if FDesigner.OB7.Down then
|
|
begin
|
|
Mode := mdSelect;
|
|
if (X > FDesigner.Page.Width - 10) and (X < FDesigner.Page.Width + 10) and (Y > FDesigner.Page.Height - 10) and (Y < FDesigner.Page.Height + 10) then
|
|
Cursor := crSizeNWSE
|
|
else
|
|
Cursor := crDefault;
|
|
|
|
|
|
end
|
|
else
|
|
begin
|
|
Mode := mdInsert;
|
|
if Cursor <> crCross then
|
|
begin
|
|
RoundCoord(x, y);
|
|
kx := Width; ky := 40;
|
|
// if not FDesigner.OB3.Down then
|
|
FDesigner.GetDefaultSize(kx, ky);
|
|
OldRect := Rect(x, y, x + kx, y + ky);
|
|
NPDrawFocusRect;
|
|
end;
|
|
Cursor := crCross;
|
|
end;
|
|
end
|
|
else
|
|
if FDesigner.OB6.Down then
|
|
begin
|
|
Mode := mdSelect;
|
|
Cursor := crPencil;
|
|
end
|
|
else
|
|
if FDesigner.OB1.Down then
|
|
begin
|
|
Mode := mdSelect;
|
|
Cursor := crDefault;
|
|
end
|
|
else
|
|
begin
|
|
Mode := mdInsert;
|
|
if Cursor <> crCross then
|
|
begin
|
|
RoundCoord(x, y);
|
|
kx := Width; ky := 40;
|
|
if not FDesigner.OB3.Down then
|
|
FDesigner.GetDefaultSize(kx, ky);
|
|
OldRect := Rect(x, y, x + kx, y + ky);
|
|
NPDrawFocusRect;
|
|
end;
|
|
Cursor := crCross;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLn('Mode Insert=%s Down=%s',[dbgs(Mode=mdInsert),dbgs(Down)]);
|
|
{$ENDIF}
|
|
|
|
if (Mode = mdInsert) and not Down then
|
|
begin
|
|
NPEraseFocusRect;
|
|
RoundCoord(x, y);
|
|
OffsetRect(OldRect, x - OldRect.Left, y - OldRect.Top);
|
|
NPDrawFocusRect;
|
|
ShowSizes := True;
|
|
FDesigner.UpdateStatus;
|
|
ShowSizes := False;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: Mode Insert and not Down');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//cursor shapes
|
|
if not Down and (TfrDesignerForm(frDesigner).SelNum = 1) and (Mode = mdSelect) and
|
|
not FDesigner.OB6.Down then
|
|
begin
|
|
t := TfrView(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
|
|
NPEraseFocusRect;
|
|
if Cursor = crCross then
|
|
RoundCoord(x, y);
|
|
OldRect := Rect(OldRect.Left, OldRect.Top, x, y);
|
|
NPDrawFocusRect;
|
|
ShowSizes := True;
|
|
if Cursor = crCross then
|
|
FDesigner.UpdateStatus;
|
|
ShowSizes := False;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: DOWN and RFLag (sel alot of objs)');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//line drawing
|
|
if Down and (Cursor = crPencil) then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := y - LastY;
|
|
if FDesigner.GridAlign and not GridCheck then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: not gridcheck and gridalign');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
DrawRectLine(OldRect);
|
|
OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
|
|
DrawRectLine(OldRect);
|
|
Inc(LastX, kx);
|
|
Inc(LastY, ky);
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: Line drawing');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//check for multiple selected objects - right-bottom corner
|
|
if not Down and (TfrDesignerForm(frDesigner).SelNum > 1) and (Mode = mdSelect) then
|
|
begin
|
|
t := TfrView(Objects[RightBottom]);
|
|
if Cont(t.x + t.dx, t.y + t.dy, x, y) then
|
|
Cursor := crSizeNWSE
|
|
end;
|
|
|
|
//split checking
|
|
if not Down and (TfrDesignerForm(frDesigner).SelNum > 1) and (Mode = mdSelect) then
|
|
begin
|
|
for i := 0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if (t.Typ <> gtBand) 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 := TfrView(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 TfrDesignerForm(frDesigner).MRFlag and (Mode = mdSelect) and (Cursor = crHSplit) then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := 0;
|
|
if FDesigner.GridAlign and not GridCheck then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: Splitting not grid check');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
with SplitInfo do
|
|
begin
|
|
DrawHSplitter(SplRect);
|
|
SplRect := Rect(SplRect.Left + kx, SplRect.Top, SplRect.Right + kx, SplRect.Bottom);
|
|
DrawHSplitter(SplRect);
|
|
end;
|
|
Inc(LastX, kx);
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: Splitting');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
// sizing several objects
|
|
if Down and TfrDesignerForm(frDesigner).MRFlag and (Mode = mdSelect) and (Cursor <> crDefault) then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := y - LastY;
|
|
if FDesigner.GridAlign and not GridCheck then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: sizing seveal, not gridcheck');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
if FDesigner.ShapeMode = smFrame then
|
|
DrawPage(dmShape)
|
|
else
|
|
begin
|
|
hr := CreateRectRgn(0, 0, 0, 0);
|
|
hr1 := CreateRectRgn(0, 0, 0, 0);
|
|
end;
|
|
|
|
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 := TfrView(Objects[i]);
|
|
if (t.Selected) and not (lrrDontSize in T.Restrictions) then
|
|
begin
|
|
if FDesigner.ShapeMode = smAll then
|
|
AddRgn(hr, t);
|
|
x1 := (t.OriginalRect.Left - LeftTop.x) * nx;
|
|
x2 := t.OriginalRect.Right * nx;
|
|
dx := Round(x1 + x2) - (Round(x1) + Round(x2));
|
|
t.x := LeftTop.x + Round(x1);
|
|
t.dx := Round(x2) + dx;
|
|
|
|
y1 := (t.OriginalRect.Top - LeftTop.y) * ny;
|
|
y2 := t.OriginalRect.Bottom * ny;
|
|
dy := Round(y1 + y2) - (Round(y1) + Round(y2));
|
|
t.y := LeftTop.y + Round(y1);
|
|
t.dy := Round(y2) + dy;
|
|
if FDesigner.ShapeMode = smAll then
|
|
AddRgn(hr1, t);
|
|
end;
|
|
end;
|
|
|
|
if FDesigner.ShapeMode = smFrame then
|
|
DrawPage(dmShape)
|
|
else
|
|
begin
|
|
NPDrawLayerObjects(hr);
|
|
NPDrawLayerObjects(hr1);
|
|
end;
|
|
|
|
Inc(LastX, kx);
|
|
Inc(LastY, ky);
|
|
FDesigner.UpdateStatus;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: Sizing several objects');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
//moving
|
|
if Down and (Mode = mdSelect) and (TfrDesignerForm(frDesigner).SelNum >= 1) and (Cursor = crDefault) then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := y - LastY;
|
|
if FDesigner.GridAlign and not GridCheck then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: moving');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
if FirstBandMove and (TfrDesignerForm(frDesigner).SelNum = 1) and ((kx <> 0) or (ky <> 0)) and
|
|
not (ssAlt in Shift) then
|
|
begin
|
|
if Assigned(Objects[TopSelected]) and (TFrView(Objects[TopSelected]).Typ = gtBand) then
|
|
begin
|
|
Bnd := TfrView(Objects[TopSelected]);
|
|
for i := 0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Typ <> gtBand then
|
|
begin
|
|
|
|
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(TfrDesignerForm(frDesigner).SelNum);
|
|
end;
|
|
end;
|
|
end;
|
|
ColorLocked := True;
|
|
FDesigner.SelectionChanged;
|
|
GetMultipleSelected;
|
|
ColorLocked := False;
|
|
end;
|
|
end;
|
|
|
|
FirstBandMove := False;
|
|
|
|
MoveResize(kx,ky,FDesigner.ShapeMode=smFrame, false);
|
|
|
|
Inc(LastX, kx);
|
|
Inc(LastY, ky);
|
|
FDesigner.UpdateStatus;
|
|
end;
|
|
{$IFDEF DebugLR}
|
|
// else debugLn('Down=',BoolToStr(Down),' Mode=',IntToStr(Ord(Mode)),' SelNum=',IntToStr(Selnum),' Cursor=',IntToStr(Cursor));
|
|
{$ENDIF}
|
|
|
|
//resizing
|
|
if Down and (Mode = mdSelect) and (TfrDesignerForm(frDesigner).SelNum = 1) and (Cursor <> crDefault) then
|
|
begin
|
|
kx := x - LastX;
|
|
ky := y - LastY;
|
|
if FDesigner.GridAlign and not GridCheck then begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove DONE: resizing');
|
|
{$ENDIF}
|
|
Exit;
|
|
end;
|
|
|
|
t := TfrView(Objects[TopSelected]);
|
|
if (lrrDontSize in T.Restrictions) then
|
|
exit;
|
|
|
|
if FDesigner.ShapeMode = smFrame then
|
|
DrawPage(dmShape)
|
|
else
|
|
hr:=t.GetClipRgn(rtExtended);
|
|
w := 3;
|
|
|
|
if Cursor = crSizeNWSE then
|
|
begin
|
|
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;
|
|
CT := ct1;
|
|
end
|
|
else
|
|
begin
|
|
t.dx := t.dx + kx;
|
|
t.dy := t.dy + ky;
|
|
CT := ct2;
|
|
end;
|
|
end;
|
|
|
|
if Cursor = crSizeNESW then
|
|
begin
|
|
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;
|
|
CT := ct3;
|
|
end
|
|
else
|
|
begin
|
|
t.x := t.x + kx;
|
|
t.dx := t.dx - kx;
|
|
t.dy := t.dy + ky;
|
|
CT := ct4;
|
|
end;
|
|
end;
|
|
|
|
if Cursor = crSizeWE then
|
|
begin
|
|
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;
|
|
CT := ct5;
|
|
end
|
|
else
|
|
begin
|
|
t.dx := t.dx + kx;
|
|
CT := ct6;
|
|
end;
|
|
end;
|
|
|
|
if Cursor = crSizeNS then
|
|
begin
|
|
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;
|
|
CT := ct7;
|
|
end
|
|
else
|
|
begin
|
|
t.dy := t.dy + ky;
|
|
CT := ct8;
|
|
end;
|
|
end;
|
|
|
|
if FDesigner.ShapeMode = smFrame then
|
|
begin
|
|
DrawPage(dmShape);
|
|
{$IFDEF DebugLR}
|
|
DebugLn('MDown resizing 1');
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
Hr1:=CreateRectRgn(0,0,0,0);
|
|
Hr2:=t.GetClipRgn(rtExtended);
|
|
CombineRgn(hr1, hr, hr2, RGN_OR);
|
|
DeleteObject(Hr2);
|
|
NPDrawLayerObjects(hr1);
|
|
DeleteObject(Hr);
|
|
{$IFDEF DebugLR}
|
|
DebugLn('MDown resizing 2');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
Inc(LastX, kx);
|
|
Inc(LastY, ky);
|
|
end;
|
|
|
|
if fResizeDialog then
|
|
begin
|
|
Width:=X;
|
|
Height:=Y;
|
|
FDesigner.Page.Width:=X;
|
|
FDesigner.Page.Height:=Y;
|
|
DrawPage(dmAll);
|
|
// Invalidate;
|
|
// DrawDialog(0,0);
|
|
end;
|
|
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.MMove END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.DClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLnEnter('TfrDesignerPage.DClick INIT DFlag=%s',[dbgs(DFlag)]);
|
|
{$ENDIF}
|
|
Down := False;
|
|
if TfrDesignerForm(frDesigner).SelNum = 0 then
|
|
begin
|
|
if FDesigner.Page is TfrPageDialog then
|
|
FDesigner.ShowEditor
|
|
else
|
|
FDesigner.PgB3Click(nil);
|
|
DFlag := True;
|
|
end
|
|
else
|
|
if TfrDesignerForm(frDesigner).SelNum = 1 then
|
|
begin
|
|
DFlag := True;
|
|
FDesigner.ShowEditor;
|
|
end;
|
|
{$IFDEF DebugLR}
|
|
DebugLnExit('TfrDesignerPage.DClick DONE DFlag=%s',[dbgs(DFlag)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.MoveResize(Kx, Ky: Integer; UseFrames,AResize: boolean);
|
|
var
|
|
hr,hr1: HRGN;
|
|
i: Integer;
|
|
t: TFrView;
|
|
begin
|
|
If UseFrames then
|
|
DrawPage(dmShape)
|
|
else
|
|
begin
|
|
hr := CreateRectRgn(0, 0, 0, 0);
|
|
hr1 := CreateRectRgn(0, 0, 0, 0);
|
|
end;
|
|
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if (not t.Selected) or (AResize and (lrrDontSize in T.Restrictions)) or
|
|
((lrrDontMove in T.Restrictions) and not AResize) then
|
|
continue;
|
|
|
|
if FDesigner.ShapeMode = smAll then
|
|
AddRgn(hr, t);
|
|
if aResize then
|
|
begin
|
|
t.dx := t.dx + kx;
|
|
t.dy := t.dy + ky;
|
|
end
|
|
else
|
|
begin
|
|
t.x := t.x + kx;
|
|
t.y := t.y + ky;
|
|
end;
|
|
if FDesigner.ShapeMode = smAll then
|
|
AddRgn(hr1, t);
|
|
end;
|
|
|
|
if UseFrames then
|
|
DrawPage(dmShape)
|
|
else
|
|
begin
|
|
CombineRgn(hr, hr, hr1, RGN_OR);
|
|
DeleteObject(hr1);
|
|
NPDrawLayerObjects(hr);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.EnableEvents(aOk: boolean);
|
|
begin
|
|
if aOk then
|
|
begin
|
|
OnMouseDown := @MDown;
|
|
OnMouseUp := @MUp;
|
|
OnMouseMove := @MMove;
|
|
OnDblClick := @DClick;
|
|
end else
|
|
begin
|
|
OnMouseDown := nil;
|
|
OnMouseUp := nil;
|
|
OnMouseMove := nil;
|
|
OnDblClick := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPDrawFocusRect;
|
|
begin
|
|
{$ifdef ppaint}
|
|
fPaintSel.FocusRect(OldRect);
|
|
{$else}
|
|
DrawFocusRect(OldRect);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPEraseFocusRect;
|
|
begin
|
|
{$ifdef ppaint}
|
|
fPaintSel.RemoveFocusRect;
|
|
{$else}
|
|
DrawFocusRect(OldRect);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPDrawLayerObjects(Rgn: HRGN; Start:Integer=10000);
|
|
{$ifdef ppaint}
|
|
var
|
|
R: HRGN;
|
|
t: TfrView;
|
|
i: Integer;
|
|
{$endif}
|
|
begin
|
|
{$ifdef ppaint}
|
|
if Rgn = 0 then
|
|
begin
|
|
// here just make sure all objects, starting at Start
|
|
// are invalidated so in next paint cycle they are drawn
|
|
Rgn := CreateRectRgn(0, 0, 0, 0);
|
|
for i := Objects.Count-1 downto 0 do
|
|
if i<=Start then begin
|
|
t := TfrView(Objects[i]);
|
|
R := t.GetClipRgn(rtNormal);
|
|
CombineRgn(Rgn, Rgn, R, RGN_OR);
|
|
DeleteObject(R);
|
|
end;
|
|
end;
|
|
|
|
InvalidateRgn(Handle, Rgn, false);
|
|
|
|
DeleteObject(Rgn);
|
|
if Rgn=ClipRgn then
|
|
ClipRgn := 0;
|
|
|
|
SelectClipRgn(Canvas.Handle, 0);
|
|
|
|
{$else}
|
|
Draw(Start, Rgn);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPDrawSelection;
|
|
begin
|
|
{$ifdef ppaint}
|
|
fPaintSel.InvalidateSelection;
|
|
{$else}
|
|
DrawPage(dmSelection);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPPaintSelection;
|
|
begin
|
|
{$ifdef ppaint}
|
|
fPaintSel.PaintSelection;
|
|
{$else}
|
|
DrawPage(dmSelection);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPEraseSelection;
|
|
begin
|
|
{$ifdef ppaint}
|
|
fPaintSel.InvalidateSelection;
|
|
{$else}
|
|
DrawPage(dmSelection);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.NPRedrawViewCheckBand(t: TfrView);
|
|
begin
|
|
{$ifdef ppaint}
|
|
if t.typ = gtBand then
|
|
NPDrawLayerObjects(t.GetClipRgn(rtExtended))
|
|
else
|
|
fPaintSel.InvalidateSelection;
|
|
{$else}
|
|
if t.Typ = gtBand then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLn('A new band was inserted');
|
|
{$ENDIF}
|
|
Draw(10000, t.GetClipRgn(rtExtended))
|
|
end
|
|
else
|
|
begin
|
|
t.Draw(Canvas);
|
|
DrawSelection(t);
|
|
end;
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerPage.CMMouseLeave(var Message: TLMessage);
|
|
begin
|
|
if (Mode = mdInsert) and not Down then
|
|
begin
|
|
NPEraseFocusRect;
|
|
OffsetRect(OldRect, -10000, -10000);
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
procedure BDown(SB: TSpeedButton);
|
|
begin
|
|
SB.Down := True;
|
|
end;
|
|
|
|
procedure BUp(SB: TSpeedButton);
|
|
begin
|
|
SB.Down := False;
|
|
end;
|
|
{
|
|
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
|
|
FontType: Integer; Data: Pointer): Integer; stdcall;
|
|
begin
|
|
TfrDesignerForm(frDesigner).C2.Items.AddObject(StrPas(LogFont.lfFaceName), TObject(FontType));
|
|
Result := 1;
|
|
end;
|
|
}
|
|
|
|
function EnumFontsProc(
|
|
var LogFont: TEnumLogFontEx;
|
|
var {%H-}Metric: TNewTextMetricEx;
|
|
FontType: Longint;
|
|
{%H-}Data: LParam):LongInt; stdcall;
|
|
var
|
|
S: String;
|
|
Lst: TStrings;
|
|
begin
|
|
s := StrPas(LogFont.elfLogFont.lfFaceName);
|
|
Lst := TStrings(PtrInt(Data));
|
|
if Lst.IndexOf(S)<0 then
|
|
Lst.AddObject(S, TObject(PtrInt(FontType)));
|
|
Result := 1;
|
|
end;
|
|
|
|
constructor TfrDesignerForm.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
fInBuildPage:=False;
|
|
{$IFDEF STDOI}
|
|
// create the ObjectInspector
|
|
PropHook:= TPropertyEditorHook.Create;
|
|
ObjInsp := TObjectInspector.Create(Self);
|
|
ObjInsp.SetInitialBounds(10,10,220,400);
|
|
ObjInsp.ShowComponentTree := False;
|
|
ObjInsp.ShowFavoritePage := False;
|
|
ObjInsp.PropertyEditorHook := PropHook;
|
|
{$ELSE}
|
|
ObjInsp := TFrObjectInspector.Create(Self);
|
|
ObjInsp.SetModifiedEvent(@OnModify);
|
|
{$ENDIF}
|
|
{$ifdef sbod}
|
|
StatusBar1.Panels[1].Style := psOwnerDraw;
|
|
StatusBar1.OnDrawPanel := @StatusBar1Drawpanel;
|
|
Panel7.Visible := false;
|
|
{$endif}
|
|
end;
|
|
|
|
destructor TfrDesignerForm.Destroy;
|
|
begin
|
|
{$IFDEF EXTOI}
|
|
ObjInsp.Free;
|
|
{$ENDIF}
|
|
{$IFDEF STDOI}
|
|
PropHook.Free;
|
|
{$ENDIF}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.GetFontList;
|
|
var
|
|
DC: HDC;
|
|
Lf: TLogFont;
|
|
S: String;
|
|
{$IFDEF USE_PRINTER_FONTS}
|
|
Lst: TStrings;
|
|
i: Integer;
|
|
j: PtrInt;
|
|
{$ENDIF}
|
|
begin
|
|
C2.Items.Clear;
|
|
DC := GetDC(0);
|
|
try
|
|
Lf.lfFaceName := '';
|
|
Lf.lfCharSet := DEFAULT_CHARSET;
|
|
Lf.lfPitchAndFamily := 0;
|
|
EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, PtrInt(C2.Items), 0);
|
|
finally
|
|
ReleaseDC(0, DC);
|
|
end;
|
|
{$IFDEF USE_PRINTER_FONTS}
|
|
if not CurReport.PrintToDefault then
|
|
begin
|
|
// we could use prn.Printer.Fonts but we would be tied to
|
|
// implementation detail of list.objects[] encoded with fonttype
|
|
// that's why we collect the fonts ourselves here
|
|
//
|
|
Lst := TStringList.Create;
|
|
try
|
|
EnumFontFamiliesEx(Prn.Printer.Canvas.Handle, @Lf, @EnumFontsProc, PtrInt(Lst), 0);
|
|
for i:=0 to Lst.Count-1 do
|
|
if C2.Items.IndexOf(Lst[i])<0 then begin
|
|
j := PtrInt(Lst.Objects[i]) or $100;
|
|
C2.Items.AddObject(Lst[i], TObject(j));
|
|
end;
|
|
finally
|
|
Lst.free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then
|
|
begin
|
|
// font of selected memo has preference, select it
|
|
LastFontname := TfrCustomMemoView(FirstSelected).Font.Name;
|
|
LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size;
|
|
end else
|
|
if C2.Items.IndexOf(LastFontName)>=0 then
|
|
// last font name remains valid, keep it together with lastFontSize
|
|
else begin
|
|
// setup an initial font name and size
|
|
if C2.Items.Count>0 then
|
|
LastFontName := C2.Items[0]
|
|
else
|
|
LastFontName := '';
|
|
if C2.Items.IndexOf('Arial') <> -1 then
|
|
LastFontName := 'Arial'
|
|
else if C2.Items.IndexOf('helvetica [urw]')<>-1 then
|
|
LastFontName := 'helvetica [urw]'
|
|
else if C2.Items.IndexOf('Arial Cyr') <> -1 then
|
|
LastFontName := 'Arial Cyr';
|
|
LastFontSize := 10;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormCreate(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FGridSize := 4;
|
|
FGridAlign := True;
|
|
FGridShow := False; //True;
|
|
FUnits := TfrReportUnits(0);
|
|
EditAfterInsert := True;
|
|
ShapeMode := TfrShapeMode(1);
|
|
|
|
Busy := True;
|
|
FirstTime := True;
|
|
// FirstInstance := FirstInst;
|
|
|
|
PageView := TfrDesignerPage.Create(Self{ScrollBox1});
|
|
PageView.Parent := ScrollBox1;
|
|
PageView.FDesigner := Self;
|
|
PageView.PopupMenu := Popup1;
|
|
PageView.ShowHint := True;
|
|
|
|
PageView.OnDragDrop:=@ScrollBox1DragDrop;
|
|
PageView.OnDragOver:=@ScrollBox1DragOver;
|
|
|
|
ColorSelector := TColorSelector.Create(Self);
|
|
ColorSelector.OnColorSelected := @ColorSelected;
|
|
ColorSelector.Hide;
|
|
|
|
for i := 0 to frAddInsCount - 1 do
|
|
with frAddIns[i] do
|
|
begin
|
|
if Assigned(frAddIns[i].InitializeProc) then
|
|
frAddIns[i].InitializeProc;
|
|
RegisterObject(ButtonBMP, ButtonHint, Integer(gtAddIn) + i, ObjectType);
|
|
end;
|
|
|
|
for i := 0 to frToolsCount - 1 do
|
|
RegisterTool(frTools[i].Caption, frTools[i].ButtonBMP, frTools[i].OnClick);
|
|
|
|
EditorForm := TfrEditorForm.Create(nil);
|
|
|
|
MenuItems := TFpList.Create;
|
|
ItemWidths := TStringlist.Create;
|
|
{
|
|
if FirstInstance then
|
|
begin
|
|
//** Application.OnActivate := OnActivateApp;
|
|
//** Application.OnDeactivate := OnDeactivateApp;
|
|
end
|
|
else
|
|
begin
|
|
PgB1.Enabled := False;
|
|
PgB2.Enabled := False;
|
|
N41.Enabled := False;
|
|
N43.Enabled := False;
|
|
N29.Enabled := False;
|
|
N30.Enabled := False;
|
|
end;
|
|
FirstInst := False;
|
|
}
|
|
FCaption := sFRDesignerFormCapt;
|
|
//Panel1.Caption := sFRDesignerFormrect;
|
|
//Panel2.Caption := sFRDesignerFormStd;
|
|
//Panel3.Caption := sFRDesignerFormText;
|
|
//Panel5.Caption := sFRDesignerFormAlign;
|
|
//Panel6.Caption := sFRDesignerFormTools;
|
|
FileBtn1.Hint := sFRDesignerFormNewRp;
|
|
//FileBtn2.Hint := sFRDesignerFormOpenRp;
|
|
FileOpen.Hint:= sFRDesignerFormOpenRp;
|
|
FileOpen.Caption:= sFRDesignerForm_Open;
|
|
|
|
FileSave.Hint:= sFRDesignerFormSaveRp;
|
|
FilePreview.Hint := sFRDesignerFormPreview;
|
|
|
|
CutB.Hint := sFRDesignerFormCut;
|
|
CopyB.Hint := sFRDesignerFormCopy;
|
|
PstB.Hint := sFRDesignerFormPast;
|
|
UndoB.Hint := sFRDesignerFormUndo;
|
|
RedoB.Hint := sFRDesignerFormRedo;
|
|
ZB1.Hint := sFRDesignerFormBring;
|
|
ZB2.Hint := sFRDesignerFormBack;
|
|
SelAllB.Hint := sFRDesignerFormSelectAll;
|
|
PgB1.Hint := sFRDesignerFormAddPg;
|
|
PgB2.Hint := sFRDesignerFormRemovePg;
|
|
PgB3.Hint := sFRDesignerFormPgOption;
|
|
GB1.Hint := sFRDesignerFormGrid;
|
|
GB2.Hint := sFRDesignerFormGridAlign;
|
|
GB3.Hint := sFRDesignerFormFitGrid;
|
|
HelpBtn.Hint := sPreviewFormHelp;
|
|
ExitB.Caption := sFRDesignerFormClose;
|
|
ExitB.Hint := sFRDesignerFormCloseDesigner;
|
|
AlB1.Hint := sFRDesignerFormLeftAlign;
|
|
AlB2.Hint := sFRDesignerFormRightAlign;
|
|
AlB3.Hint := sFRDesignerFormCenerAlign;
|
|
AlB4.Hint := sFRDesignerFormNormalText;
|
|
AlB5.Hint := sFRDesignerFormVertCenter;
|
|
AlB6.Hint := sFRDesignerFormTopAlign;
|
|
AlB7.Hint := sFRDesignerFormBottomAlign;
|
|
AlB8.Hint := sFRDesignerFormWidthAlign;
|
|
FnB1.Hint := sFRDesignerFormBold;
|
|
FnB2.Hint := sFRDesignerFormItalic;
|
|
FnB3.Hint := sFRDesignerFormUnderLine;
|
|
ClB2.Hint := sFRDesignerFormFont;
|
|
HlB1.Hint := sFRDesignerFormHightLight;
|
|
C3.Hint := sFRDesignerFormFontSize;
|
|
C2.Hint := sFRDesignerFormFontName;
|
|
FrB1.Hint := sFRDesignerFormTopFrame;
|
|
FrB2.Hint := sFRDesignerFormleftFrame;
|
|
FrB3.Hint := sFRDesignerFormBottomFrame;
|
|
FrB4.Hint := sFRDesignerFormRightFrame;
|
|
FrB5.Hint := sFRDesignerFormAllFrame;
|
|
FrB6.Hint := sFRDesignerFormNoFrame;
|
|
ClB1.Hint := sFRDesignerFormBackColor;
|
|
ClB3.Hint := sFRDesignerFormFrameColor;
|
|
E1.Hint := sFRDesignerFormFrameWidth;
|
|
OB1.Hint := sFRDesignerFormSelObj;
|
|
OB2.Hint := sFRDesignerFormInsRect;
|
|
OB3.Hint := sFRDesignerFormInsBand;
|
|
OB4.Hint := sFRDesignerFormInsPict;
|
|
OB5.Hint := sFRDesignerFormInsSub;
|
|
OB6.Hint := sFRDesignerFormDrawLine;
|
|
Align1.Hint := sFRDesignerFormAlignLeftedge;
|
|
Align2.Hint := sFRDesignerFormAlignHorzCenter;
|
|
Align3.Hint := sFRDesignerFormCenterHWind;
|
|
Align4.Hint := sFRDesignerFormSpace;
|
|
Align5.Hint := sFRDesignerFormAlignRightEdge;
|
|
Align6.Hint := sFRDesignerFormAligneTop;
|
|
Align7.Hint := sFRDesignerFormAlignVertCenter;
|
|
Align8.Hint := sFRDesignerFormCenterVertWing;
|
|
Align9.Hint := sFRDesignerFormSpaceEqVert;
|
|
Align10.Hint := sFRDesignerFormAlignBottoms;
|
|
N2.Caption := sFRDesignerForm_Cut;
|
|
N1.Caption := sFRDesignerForm_Copy;
|
|
N3.Caption := sFRDesignerForm_Paste;
|
|
N5.Caption := sFRDesignerForm_Delete;
|
|
N16.Caption := sFRDesignerForm_SelectAll;
|
|
N6.Caption := sFRDesignerForm_Edit;
|
|
FileMenu.Caption := sFRDesignerForm_File;
|
|
N23.Caption := sFRDesignerForm_New;
|
|
//N19.Caption := sFRDesignerForm_Open;
|
|
//N20.Caption := sFRDesignerForm_Save;
|
|
//N17.Caption := sFRDesignerForm_SaveAs;
|
|
FileSaveAs.Caption:= sFRDesignerForm_Save;
|
|
FileSaveAs.Caption:= sFRDesignerForm_SaveAs;
|
|
FileBeforePrintScript.Caption := sFRDesignerForm_BeforePrintScript;
|
|
N42.Caption := sFRDesignerForm_Var;
|
|
N8.Caption := sFRDesignerForm_RptOpt;
|
|
N25.Caption := sFRDesignerForm_PgOpt;
|
|
N39.Caption := sFRDesignerForm_preview;
|
|
N10.Caption := sFRDesignerForm_Exit;
|
|
EditMenu.Caption := sFRDesignerForm_Edit2;
|
|
N46.Caption := sFRDesignerForm_Undo;
|
|
N48.Caption := sFRDesignerForm_Redo;
|
|
N11.Caption := sFRDesignerForm_Cut;
|
|
N12.Caption := sFRDesignerForm_Copy;
|
|
N13.Caption := sFRDesignerForm_Paste;
|
|
N27.Caption := sFRDesignerForm_Delete;
|
|
N28.Caption := sFRDesignerForm_SelectAll;
|
|
N36.Caption := sFRDesignerForm_Editp;
|
|
N29.Caption := sFRDesignerForm_AddPg;
|
|
N30.Caption := sFRDesignerForm_RemovePg;
|
|
N32.Caption := sFRDesignerForm_Bring;
|
|
N33.Caption := sFRDesignerForm_Back;
|
|
ToolMenu.Caption := sFRDesignerForm_Tools;
|
|
N37.Caption := sFRDesignerForm_ToolBars;
|
|
MastMenu.Caption := sFRDesignerForm_Tools2;
|
|
N14.Caption := sFRDesignerForm_Opts;
|
|
Pan1.Caption := sFRDesignerForm_Rect;
|
|
Pan2.Caption := sFRDesignerForm_Std;
|
|
Pan3.Caption := sFRDesignerForm_Text;
|
|
Pan4.Caption := sFRDesignerForm_Obj;
|
|
Pan5.Caption := sFRDesignerForm_Insp;
|
|
Pan6.Caption := sFRDesignerForm_AlignPalette;
|
|
Pan7.Caption := sFRDesignerForm_Tools3;
|
|
MenuItem2.Caption:= sFRDesignerForm_DataInsp;
|
|
N34.Caption := sFRDesignerForm_About;
|
|
N22.Caption := sFRDesignerForm_Help1;
|
|
N35.Caption := sFRDesignerForm_Help2;
|
|
StB1.Hint := sFRDesignerForm_Line;
|
|
//** FnB1.Glyph.Handle := LoadBitmap(hInstance, 'FR_BOLD');
|
|
//** FnB2.Glyph.Handle := LoadBitmap(hInstance, 'FR_ITALIC');
|
|
//** FnB3.Glyph.Handle := LoadBitmap(hInstance, 'FR_UNDRLINE');
|
|
|
|
N41.Caption := N29.Caption;
|
|
N41.OnClick := N29.OnClick;
|
|
N43.Caption := N30.Caption;
|
|
N43.OnClick := N30.OnClick;
|
|
N44.Caption := N25.Caption;
|
|
N44.OnClick := N25.OnClick;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.C2GetItems(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if C2.Items.Count=0 then begin
|
|
Screen.Cursor := crHourglass;
|
|
GetFontList;
|
|
i := C2.Items.IndexOf(LastFontName);
|
|
if i<>-1 then
|
|
C2.ItemIndex := i;
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FileBeforePrintScriptExecute(Sender: TObject);
|
|
begin
|
|
EditorForm.View := nil;
|
|
EditorForm.M2.Lines.Assign(CurReport.Script);
|
|
EditorForm.MemoPanel.Visible:=false;
|
|
EditorForm.CB1.OnClick:=nil;
|
|
EditorForm.CB1.Checked:=true;
|
|
EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
|
|
EditorForm.ScriptPanel.Align:=alClient;
|
|
if EditorForm.ShowModal = mrOk then
|
|
begin
|
|
CurReport.Script.Assign(EditorForm.M2.Lines);
|
|
end;
|
|
EditorForm.ScriptPanel.Align:=alBottom;
|
|
EditorForm.MemoPanel.Visible:=true;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FileOpenExecute(Sender: TObject);
|
|
var
|
|
FRepName:string;
|
|
begin
|
|
if CheckFileModified=mrCancel then
|
|
exit;
|
|
|
|
|
|
if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnLoadReport) then
|
|
begin
|
|
FRepName:='';
|
|
frDesignerComp.FOnLoadReport(CurReport, FRepName);
|
|
FCurDocFileType := dtLazReportForm;
|
|
CurDocName := FRepName;
|
|
end
|
|
else
|
|
with OpenDialog1 do
|
|
begin
|
|
Filter := sFormFile + ' (*.frf)|*.frf|' +
|
|
sLazFormFile + ' (*.lrf)|*.lrf' +
|
|
'';
|
|
InitialDir:=ExtractFilePath(ParamStrUTF8(0));
|
|
FileName := CurDocName;
|
|
FilterIndex := 2;
|
|
if Execute then
|
|
begin
|
|
ClearUndoBuffer;
|
|
CurDocName := OpenDialog1.FileName;
|
|
case FilterIndex of
|
|
1: // fastreport form format
|
|
begin
|
|
CurReport.LoadFromFile(CurDocName);
|
|
FCurDocFileType := dtFastReportForm;
|
|
end;
|
|
2: // lasreport form xml format
|
|
begin
|
|
CurReport.LoadFromXMLFile(CurDocName);
|
|
FCurDocFileType := dtLazReportForm;
|
|
end;
|
|
else
|
|
raise Exception.Create('Unrecognized file format');
|
|
end;
|
|
//FileModified := False;
|
|
Modified := False;
|
|
CurPage := 0; // do all
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FilePreviewExecute(Sender: TObject); // preview
|
|
var
|
|
v1, v2: Boolean;
|
|
TestRepStream:TMemoryStream;
|
|
Rep, SaveR:TfrReport;
|
|
|
|
procedure DoClearFormsName;
|
|
var
|
|
i:integer;
|
|
begin
|
|
for i:=0 to CurReport.Pages.Count - 1 do
|
|
if CurReport.Pages[i] is TfrPageDialog then
|
|
TfrPageDialog(CurReport.Pages[i]).Form.Name:='';
|
|
end;
|
|
|
|
procedure DoResoreFormsName;
|
|
var
|
|
i:integer;
|
|
begin
|
|
for i:=0 to CurReport.Pages.Count - 1 do
|
|
if CurReport.Pages[i] is TfrPageDialog then
|
|
TfrPageDialog(CurReport.Pages[i]).Form.Name:=TfrPageDialog(CurReport.Pages[i]).Name;
|
|
end;
|
|
begin
|
|
if CurReport is TfrCompositeReport then Exit;
|
|
Application.ProcessMessages;
|
|
SaveR:=CurReport;
|
|
TestRepStream:=TMemoryStream.Create;
|
|
CurReport.SaveToXMLStream(TestRepStream);
|
|
TestRepStream.Position:=0;
|
|
|
|
// DoClearFormsName;
|
|
CurReport:=nil;
|
|
|
|
Rep:=TfrReport.Create(SaveR.Owner);
|
|
|
|
Rep.OnBeginBand:=SaveR.OnBeginBand;
|
|
Rep.OnBeginColumn:=SaveR.OnBeginColumn;
|
|
Rep.OnBeginDoc:=SaveR.OnBeginDoc;
|
|
Rep.OnBeginPage:=SaveR.OnBeginPage;
|
|
Rep.OnDBImageRead:=SaveR.OnDBImageRead;
|
|
Rep.OnEndBand:=SaveR.OnEndBand;
|
|
Rep.OnEndDoc:=SaveR.OnEndDoc;
|
|
Rep.OnEndPage:=SaveR.OnEndPage;
|
|
Rep.OnEnterRect:=SaveR.OnEnterRect;
|
|
Rep.OnExportFilterSetup:=SaveR.OnExportFilterSetup;
|
|
Rep.OnGetValue:=SaveR.OnGetValue;
|
|
Rep.OnManualBuild:=SaveR.OnManualBuild;
|
|
Rep.OnMouseOverObject:=SaveR.OnMouseOverObject;
|
|
Rep.OnObjectClick:=SaveR.OnObjectClick;
|
|
Rep.OnPrintColumn:=SaveR.OnPrintColumn;
|
|
Rep.OnProgress:=SaveR.OnProgress;
|
|
Rep.OnUserFunction:=SaveR.OnUserFunction;
|
|
|
|
try
|
|
Rep.LoadFromXMLStream(TestRepStream);
|
|
Rep.ShowReport;
|
|
FreeAndNil(Rep)
|
|
except
|
|
on E:Exception do
|
|
begin
|
|
ShowMessage(E.Message);
|
|
if Assigned(Rep) then
|
|
FreeAndNil(Rep)
|
|
end;
|
|
end;
|
|
TestRepStream.Free;
|
|
CurReport:=SaveR;
|
|
CurPage := 0;
|
|
// DoResoreFormsName;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FileSaveAsExecute(Sender: TObject);
|
|
var
|
|
s: String;
|
|
begin
|
|
WasOk := False;
|
|
if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnSaveReport) then
|
|
begin
|
|
S:='';
|
|
frDesignerComp.FOnSaveReport(CurReport, S, true, WasOk);
|
|
if WasOk then
|
|
begin
|
|
CurDocName:=S;
|
|
Modified:=false;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
with SaveDialog1 do
|
|
begin
|
|
Filter := sFormFile + ' (*.frf)|*.frf|' +
|
|
sTemplFile + ' (*.frt)|*.frt|' +
|
|
sLazFormFile + ' (*.lrf)|*.lrf|' +
|
|
sLazTemplateFile + ' (*.lrt)|*.lrt';
|
|
InitialDir:=ExtractFilePath(ParamStrUTF8(0));
|
|
FileName := CurDocName;
|
|
FilterIndex := 3;
|
|
if Execute then
|
|
FCurDocFileType := FilterIndex;
|
|
case FCurDocFileType of
|
|
dtFastReportForm:
|
|
begin
|
|
s := ChangeFileExt(FileName, '.frf');
|
|
CurReport.SaveToFile(s);
|
|
CurDocName := s;
|
|
WasOk := True;
|
|
end;
|
|
dtFastReportTemplate,
|
|
dtLazReportTemplate:
|
|
begin
|
|
if FCurDocFileType = dtLazReportTemplate then
|
|
s := ExtractFileName(ChangeFileExt(FileName, '.lrt'))
|
|
else
|
|
s := ExtractFileName(ChangeFileExt(FileName, '.frt'));
|
|
if frTemplateDir <> '' then
|
|
s := AppendPathDelim(frTemplateDir) + s;
|
|
frTemplNewForm := TfrTemplNewForm.Create(nil);
|
|
if frTemplNewForm.ShowModal = mrOk then
|
|
begin
|
|
if frTemplateDir<>'' then
|
|
begin
|
|
if not DirectoryExistsUTF8(frTemplateDir) then begin
|
|
if not ForceDirectoriesUTF8(frTemplateDir) then begin
|
|
ShowMessage(sFrDesignerFormUnableToCreateTemplateDir);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if FCurDocFileType = dtLazReportTemplate then
|
|
CurReport.SaveTemplateXML(s, frTemplNewForm.Memo1.Lines, frTemplNewForm.Image1.Picture.Bitmap)
|
|
else
|
|
CurReport.SaveTemplate(s, frTemplNewForm.Memo1.Lines, frTemplNewForm.Image1.Picture.Bitmap);
|
|
WasOk := True;
|
|
end;
|
|
frTemplNewForm.Free;
|
|
end;
|
|
dtLazReportForm: // lasreport form xml format
|
|
begin
|
|
s := ChangeFileExt(FileName, '.lrf');
|
|
CurReport.SaveToXMLFile(s);
|
|
CurDocName := s;
|
|
WasOk := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FileSaveExecute(Sender: TObject);
|
|
var
|
|
S:string;
|
|
F:boolean;
|
|
begin
|
|
if CurDocName <> sUntitled then
|
|
begin
|
|
if Assigned(frDesignerComp) and Assigned(frDesignerComp.FOnSaveReport) then
|
|
begin
|
|
S:=CurDocName;
|
|
F:=false;
|
|
frDesignerComp.FOnSaveReport(CurReport, S, false, F);
|
|
if F then
|
|
begin
|
|
CurDocName:=S;
|
|
Modified := False;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FCurDocFileType=dtLazReportForm then
|
|
CurReport.SaveToXMLFile(curDocName)
|
|
else
|
|
CurReport.SaveToFile(CurDocName);
|
|
Modified := False;
|
|
end;
|
|
end
|
|
else
|
|
FileSaveAs.Execute;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.acDuplicateExecute(Sender: TObject);
|
|
begin
|
|
DuplicateSelection;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.acToggleFramesExecute(Sender: TObject);
|
|
begin
|
|
if DelEnabled then
|
|
ViewsAction(nil, @ToggleFrames, -1);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormShow(Sender: TObject);
|
|
var
|
|
CursorImage: TCursorImage;
|
|
begin
|
|
CursorImage := TCursorImage.Create;
|
|
try
|
|
CursorImage.LoadFromResourceName(hInstance, 'FR_PENCIL');
|
|
Screen.Cursors[crPencil] := CursorImage.ReleaseHandle;
|
|
finally
|
|
CursorImage.Free;
|
|
end;
|
|
{$ifndef sbod}
|
|
Panel7.Hide;
|
|
{$endif}
|
|
if FirstTime then
|
|
SetMenuBitmaps;
|
|
FirstTime := False;
|
|
// FileBtn1.Enabled := FirstInstance;
|
|
FilePreview.Enabled := {FirstInstance and }not (CurReport is TfrCompositeReport);
|
|
{ N23.Enabled := FirstInstance;
|
|
OB3.Enabled := FirstInstance;
|
|
OB5.Enabled := FirstInstance;}
|
|
|
|
ClearUndoBuffer;
|
|
ClearRedoBuffer;
|
|
Modified := False;
|
|
//FileModified := False;
|
|
Busy := True;
|
|
DocMode := dmDesigning;
|
|
|
|
//if C2.Items.Count=0 then
|
|
// GetFontList; // defered to speed loading
|
|
LastFontSize := 10;
|
|
{$IFDEF WIN32}
|
|
LastFontName := 'Arial';
|
|
{$ELSE}
|
|
LastFontName := 'helvetica [urw]';
|
|
{$ENDIF}
|
|
|
|
//** C2.Perform(CB_SETDROPPEDWIDTH, 170, 0);
|
|
CurPage := 0; // this cause page sizing
|
|
CurDocName := CurReport.FileName;
|
|
Unselect;
|
|
|
|
PageView.Init;
|
|
EnableControls;
|
|
|
|
BDown(OB1);
|
|
|
|
ColorLocked:=True;
|
|
frSetGlyph(clNone, ClB1, 1);
|
|
frSetGlyph(clNone, ClB2, 0);
|
|
frSetGlyph(clNone, ClB3, 2);
|
|
ColorLocked:=False;
|
|
|
|
ColorSelector.Hide;
|
|
|
|
LinePanel.Hide;
|
|
|
|
ShowPosition;
|
|
RestoreState;
|
|
FormResize(nil);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormHide(Sender: TObject);
|
|
begin
|
|
ClearUndoBuffer;
|
|
ClearRedoBuffer;
|
|
SaveState;
|
|
|
|
if CurReport<>nil then
|
|
CurReport.FileName := CurDocName;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormDestroy(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to MenuItems.Count - 1 do
|
|
TfrMenuItemInfo(MenuItems[i]).Free;
|
|
MenuItems.Free;
|
|
ItemWidths.Free;
|
|
PageView.Free;
|
|
ColorSelector.Free;
|
|
EditorForm.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormResize(Sender: TObject);
|
|
begin
|
|
if csDestroying in ComponentState then Exit;
|
|
|
|
//{$IFDEF WIN32}
|
|
//if FirstTime then
|
|
// self.OnShow(self);
|
|
//{$ENDIF}
|
|
|
|
with ScrollBox1 do
|
|
begin
|
|
HorzScrollBar.Position := 0;
|
|
VertScrollBar.Position := 0;
|
|
end;
|
|
if PageView<>nil then
|
|
PageView.SetPage;
|
|
StatusBar1.Top:=Height-StatusBar1.Height-3;
|
|
{$ifndef sbod}
|
|
Panel7.Top := StatusBar1.Top + 3;
|
|
Panel7.Show;
|
|
{$endif}
|
|
UpdScrollbars;
|
|
end;
|
|
|
|
//**
|
|
{
|
|
procedure TfrDesignerForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
|
|
begin // for best view - not actual in Win98 :(
|
|
with Msg.MinMaxInfo^ do
|
|
begin
|
|
ptMaxSize.x := Screen.Width;
|
|
ptMaxSize.y := Screen.Height;
|
|
ptMaxPosition.x := 0;
|
|
ptMaxPosition.y := 0;
|
|
end;
|
|
end;
|
|
}
|
|
procedure TfrDesignerForm.SetCurPage(Value: Integer);
|
|
begin // setting curpage and do all manipulation
|
|
fInBuildPage:=True;
|
|
try
|
|
FCurPage := Value;
|
|
Page := CurReport.Pages[CurPage];
|
|
ScrollBox1.VertScrollBar.Position := 0;
|
|
ScrollBox1.HorzScrollBar.Position := 0;
|
|
PageView.SetPage;
|
|
SetPageTitles;
|
|
Tab1.TabIndex := Value;
|
|
ResetSelection;
|
|
SendBandsToDown;
|
|
PageView.Invalidate;
|
|
finally
|
|
fInBuildPage:=False;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SetGridSize(Value: Integer);
|
|
begin
|
|
if FGridSize = Value then Exit;
|
|
FGridSize := Value;
|
|
PageView.Invalidate;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SetGridShow(Value: Boolean);
|
|
begin
|
|
if FGridShow = Value then Exit;
|
|
FGridShow:= Value;
|
|
GB1.Down := Value;
|
|
PageView.Invalidate;
|
|
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.SetGrayedButtons(Value: Boolean);
|
|
procedure DoButtons(t: Array of TControl);
|
|
var
|
|
i, j: Integer;
|
|
c: TWinControl;
|
|
c1: TControl;
|
|
begin
|
|
for i := Low(t) to High(t) do
|
|
begin
|
|
c := TWinControl(t[i]);
|
|
for j := 0 to c.ControlCount - 1 do
|
|
begin
|
|
c1 := c.Controls[j];
|
|
if c1 is TSpeedButton then
|
|
TSpeedButton(c1).Enabled := FGrayedButtons; //** GrayedInactive := FGrayedButtons;
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
FGrayedButtons := Value;
|
|
DoButtons([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SetCurDocName(Value: String);
|
|
begin
|
|
FCurDocName := Value;
|
|
// if FirstInstance then
|
|
Caption := FCaption + ' - ' + ExtractFileName(Value)
|
|
// else
|
|
// Caption := FCaption;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.RegisterObject(ButtonBmp: TBitmap;
|
|
const ButtonHint: String; ButtonTag: Integer; ObjectType: TfrObjectType);
|
|
var
|
|
b: TSpeedButton;
|
|
begin
|
|
b := TSpeedButton.Create(Self);
|
|
with b do
|
|
begin
|
|
Glyph := ButtonBmp;
|
|
Hint := ButtonHint;
|
|
Flat := True;
|
|
GroupIndex := 1;
|
|
Align:=alTop;
|
|
SetBounds(1000, 1000, 22, 22);
|
|
Visible:=True;
|
|
Tag := ButtonTag;
|
|
if ObjectType = otlReportView then
|
|
begin
|
|
OnMouseDown := @OB2MouseDown;
|
|
Parent := Panel4;
|
|
end
|
|
else
|
|
begin
|
|
OnMouseDown := @OB2MouseDown;
|
|
Parent := panForDlg;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.RegisterTool(const MenuCaption: String; ButtonBmp: TBitmap;
|
|
OnClickEvnt: TNotifyEvent);
|
|
var
|
|
m: TMenuItem;
|
|
b: TSpeedButton;
|
|
w:integer;
|
|
i: Integer;
|
|
begin
|
|
m := TMenuItem.Create(MastMenu);
|
|
m.Caption := MenuCaption;
|
|
m.OnClick := OnClickEvnt;
|
|
MastMenu.Enabled := True;
|
|
MastMenu.Add(m);
|
|
M.Bitmap.Assign(ButtonBmp);
|
|
Panel6.Height := 26;
|
|
Panel6.Width := 26;
|
|
|
|
W:=0;
|
|
for i:=0 to Panel6.ControlCount-1 do
|
|
if Panel6.Controls[i] is TSpeedButton then
|
|
begin
|
|
W:=W + Panel6.Controls[i].Width;
|
|
end;
|
|
|
|
b := TSpeedButton.Create(Self);
|
|
|
|
with b do
|
|
begin
|
|
Parent := Panel6;
|
|
Glyph := ButtonBmp;
|
|
Hint := MenuCaption;
|
|
Flat := True;
|
|
Align:=alLeft;
|
|
// Align:=alTop;
|
|
SetBounds(W, 1, 22, 22);
|
|
Visible:=True;
|
|
ShowHint:=True;
|
|
Tag := 36;
|
|
end;
|
|
b.OnClick := OnClickEvnt;
|
|
|
|
if Panel6.Width < (B.Left + B.Width) then
|
|
Panel6.Width:=W + B.Width + 4;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.AddPage(ClName : string);
|
|
begin
|
|
fInBuildPage:=True;
|
|
try
|
|
CurReport.Pages.Add(ClName);
|
|
|
|
Page := CurReport.Pages[CurReport.Pages.Count - 1];
|
|
if Page is TfrPageReport then
|
|
PgB3Click(nil)
|
|
else
|
|
WasOk:=True;
|
|
|
|
if WasOk then
|
|
begin
|
|
Modified := True;
|
|
CurPage := CurReport.Pages.Count - 1
|
|
end
|
|
else
|
|
begin
|
|
CurReport.Pages.Delete(CurReport.Pages.Count - 1);
|
|
CurPage := CurPage;
|
|
end;
|
|
finally
|
|
fInBuildPage:=False;
|
|
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 := TfrView(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
|
|
fInBuildPage:=True;
|
|
try
|
|
Modified := True;
|
|
with CurReport do
|
|
begin
|
|
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;
|
|
ClearUndoBuffer;
|
|
ClearRedoBuffer;
|
|
finally
|
|
fInBuildPage:=False;
|
|
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 := TfrView(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
|
|
begin
|
|
for i := 0 to Tab1.Tabs.Count - 1 do
|
|
begin
|
|
if not IsSubreport(i) then
|
|
s := sPg + IntToStr(i + 1);
|
|
if Tab1.Tabs[i] <> s then
|
|
Tab1.Tabs[i] := s;
|
|
end;
|
|
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);
|
|
Tab1.Tabs.Add(s);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.CutToClipboard;
|
|
var
|
|
i: Integer;
|
|
T: TfrView;
|
|
begin
|
|
ClearClipBoard;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if (t.Selected) and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
|
|
begin
|
|
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page));
|
|
TfrView(ClipBd.Last).Assign(t);
|
|
end;
|
|
end;
|
|
for i := Objects.Count - 1 downto 0 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
|
|
Page.Delete(i);
|
|
end;
|
|
SelNum := 0;
|
|
PageView.Invalidate;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.CopyToClipboard;
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
begin
|
|
ClearClipBoard;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected and not (doChildComponent in T.DesignOptions) then
|
|
begin
|
|
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, nil));
|
|
TfrView(ClipBd.Last).Assign(t);
|
|
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.ResetSelection;
|
|
begin
|
|
Unselect;
|
|
EnableControls;
|
|
ShowPosition;
|
|
end;
|
|
|
|
function TfrDesignerForm.PointsToUnits(x: Integer): 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): Integer;
|
|
begin
|
|
Result := Round(x);
|
|
case FUnits of
|
|
ruMM: Result := Round(x / 5 * 18);
|
|
ruInches: Result := Round(x * 25.4 / 5 * 18);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.RedrawPage;
|
|
begin
|
|
PageView.NPDrawLayerObjects(0);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.OnModify(sender: TObject);
|
|
begin
|
|
Modified:=true;
|
|
SelectionChanged;
|
|
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;
|
|
|
|
procedure CheckStepFactor(var pStep: integer; aValue: integer);
|
|
begin
|
|
if (ssAlt in Shift) or (Shift = [ssShift,ssCtrl]) then
|
|
pStep := aValue * 10
|
|
else
|
|
pStep := aValue;
|
|
end;
|
|
|
|
begin
|
|
{$IFNDEF EXTOI}
|
|
if (ActiveControl<>nil) and (ActiveControl.Parent=ObjInsp.fPropertyGrid) then
|
|
exit;
|
|
{$ENDIF}
|
|
StepX := 0; StepY := 0;
|
|
if (Key=VK_F11) then
|
|
ObjInsp.Visible:=not ObjInsp.Visible;
|
|
|
|
if (Key = VK_RETURN) and (ActiveControl = C3) then
|
|
begin
|
|
Key := 0;
|
|
DoClick(C3);
|
|
end;
|
|
if (Key = VK_RETURN) and (ActiveControl = E1) then
|
|
begin
|
|
Key := 0;
|
|
DoClick(E1);
|
|
end;
|
|
if (Key = VK_DELETE) and DelEnabled then
|
|
begin
|
|
DeleteObjects;
|
|
Key := 0;
|
|
end;
|
|
if (Key = VK_RETURN) and EditEnabled then
|
|
begin
|
|
if ssCtrl in Shift then
|
|
ShowMemoEditor
|
|
else
|
|
ShowEditor;
|
|
end;
|
|
if (Chr(Key) in ['1'..'9']) and (ssCtrl in Shift) and DelEnabled then
|
|
begin
|
|
E1.Text := Chr(Key);
|
|
DoClick(E1);
|
|
Key := 0;
|
|
end;
|
|
if (Chr(Key) = 'G') and (ssCtrl in Shift) then
|
|
begin
|
|
ShowGrid := not ShowGrid;
|
|
Key := 0;
|
|
end;
|
|
if (Chr(Key) = 'B') and (ssCtrl in Shift) then
|
|
begin
|
|
GridAlign := not GridAlign;
|
|
Key := 0;
|
|
end;
|
|
if CutEnabled then
|
|
if (Key = VK_DELETE) and (ssShift in Shift) then CutBClick(Self);
|
|
if CopyEnabled then
|
|
if (Key = VK_INSERT) and (ssCtrl in Shift) then CopyBClick(Self);
|
|
if PasteEnabled then
|
|
if (Key = VK_INSERT) and (ssShift in Shift) then PstBClick(Self);
|
|
|
|
if Key = VK_PRIOR then
|
|
with ScrollBox1.VertScrollBar do
|
|
begin
|
|
Position := Position - 200;
|
|
Key := 0;
|
|
end;
|
|
if Key = VK_NEXT then
|
|
with ScrollBox1.VertScrollBar do
|
|
begin
|
|
Position := Position + 200;
|
|
Key := 0;
|
|
end;
|
|
if SelNum > 0 then
|
|
begin
|
|
if Key = vk_Up then CheckStepFactor(StepY, -1)
|
|
else if Key = vk_Down then CheckStepFactor(StepY, 1)
|
|
else if Key = vk_Left then CheckStepFactor(StepX, -1)
|
|
else if Key = vk_Right then CheckStepFactor(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 := TfrView(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 := TfrView(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 := TfrView(Objects[TopSelected]);
|
|
if not (ssAlt in Shift) then
|
|
begin
|
|
PageView.NPEraseSelection;
|
|
Unselect;
|
|
SelNum := 1;
|
|
t1.Selected := True;
|
|
PageView.NPDrawSelection;
|
|
end
|
|
else
|
|
begin
|
|
if (t1.x >= t.x + t.dx) and (Key = VK_RIGHT) then
|
|
t.x := t1.x - t.dx
|
|
else if (t1.y > t.y + t.dy) and (Key = VK_DOWN) then
|
|
t.y := t1.y - t.dy
|
|
else if (t1.x + t1.dx <= t.x) and (Key = VK_LEFT) then
|
|
t.x := t1.x + t1.dx
|
|
else if (t1.y + t1.dy <= t.y) and (Key = VK_UP) then
|
|
t.y := t1.y + t1.dy;
|
|
RedrawPage;
|
|
end;
|
|
SelectionChanged;
|
|
end;
|
|
end;
|
|
Key := 0;
|
|
end; // if (StepX <> 0) or (StepY <> 0)
|
|
end; // if SelNum > 0 then
|
|
end;
|
|
|
|
procedure TfrDesignerForm.MoveObjects(dx, dy: Integer; aResize: Boolean);
|
|
begin
|
|
AddUndoAction(acEdit);
|
|
PageView.NPEraseSelection;
|
|
PageView.MoveResize(Dx,Dy, false, aResize);
|
|
ShowPosition;
|
|
PageView.GetMultipleSelected;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.UpdateStatus;
|
|
begin
|
|
{$ifdef sbod}
|
|
StatusBar1.Update;
|
|
{$else}
|
|
PBox1Paint(nil);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DeleteObjects;
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
begin
|
|
AddUndoAction(acDelete);
|
|
GetRegion; // JRA 3
|
|
PageView.NPEraseSelection;
|
|
for i := Objects.Count - 1 downto 0 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected and not (lrrDontDelete in T.Restrictions) then
|
|
Page.Delete(i);
|
|
end;
|
|
SetPageTitles;
|
|
ObjInsp.Select(nil);
|
|
ResetSelection;
|
|
FirstSelected := nil;
|
|
PageView.Invalidate;
|
|
end;
|
|
|
|
function TfrDesignerForm.SelStatus: TfrSelectionStatus;
|
|
var
|
|
t: TfrView;
|
|
begin
|
|
Result := [];
|
|
if SelNum = 1 then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
if t.Typ = gtBand then
|
|
Result := [ssBand]
|
|
else
|
|
if t is TfrCustomMemoView then
|
|
Result := [ssMemo]
|
|
else
|
|
Result := [ssOther];
|
|
end
|
|
else if SelNum > 1 then
|
|
Result := [ssMultiple];
|
|
|
|
if ClipBd.Count > 0 then
|
|
Result := Result + [ssClipboardFull];
|
|
end;
|
|
|
|
procedure TfrDesignerForm.UpdScrollbars;
|
|
begin
|
|
ScrollBox1.Autoscroll := False;
|
|
ScrollBox1.Autoscroll := True;
|
|
ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
|
|
end;
|
|
|
|
{$HINTS OFF}
|
|
{$ifdef sbod}
|
|
procedure TfrDesignerForm.DrawStatusPanel(const ACanvas: TCanvas;
|
|
const rect: TRect);
|
|
var
|
|
t: TfrView;
|
|
s: String;
|
|
nx, ny: Double;
|
|
x, y, dx, dy: Integer;
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Brush.Color := StatusBar1.Color;
|
|
FillRect(Rect);
|
|
ImageList1.Draw(ACanvas, Rect.Left + 2, Rect.Top+2, 0);
|
|
ImageList1.Draw(ACanvas, Rect.Left + 92, Rect.Top+2, 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 := TfrView(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(Rect.Left + 20, Rect.Top + 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(Rect.Left + 110, Rect.Top + 1, s);
|
|
|
|
if not ShowSizes and (t.Typ = gtPicture) then
|
|
begin
|
|
with t as TfrPictureView do
|
|
begin
|
|
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(Rect.Left + 170, Rect.Top + 1, '% ' + s);
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else if (SelNum > 0) and MRFlag then
|
|
begin
|
|
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(Rect.left + 170, Rect.Top + 1, '% ' + s);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.StatusBar1DrawPanel(StatusBar: TStatusBar;
|
|
Panel: TStatusPanel; const Rect: TRect);
|
|
begin
|
|
if Panel.Index=1 then
|
|
DrawStatusPanel(StatusBar.Canvas, Rect);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DefineExtraPopupSelected(popup: TPopupMenu);
|
|
var
|
|
m: TMenuItem;
|
|
begin
|
|
m := TMenuItem.Create(Popup);
|
|
m.Caption := '-';
|
|
Popup.Items.Add(m);
|
|
|
|
m := TMenuItem.Create(Popup);
|
|
m.Caption := sFRDesignerFormSelectSameClass;
|
|
m.OnClick := @SelectSameClassClick;
|
|
m.Tag := PtrInt(Objects[TopSelected]);
|
|
Popup.Items.Add(m);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SelectSameClassClick(Sender: TObject);
|
|
var
|
|
View: TfrView;
|
|
begin
|
|
if Sender is TMenuItem then
|
|
begin
|
|
View := TfrView(TMenuItem(Sender).Tag);
|
|
if Objects.IndexOf(View)>=0 then
|
|
begin
|
|
PageView.NPEraseSelection;
|
|
SelectSameClass(View);
|
|
PageView.GetMultipleSelected;
|
|
PageView.NPDrawSelection;
|
|
SelectionChanged;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SelectSameClass(View: TfrView);
|
|
var
|
|
i: Integer;
|
|
v: TfrView;
|
|
begin
|
|
SelNum := 0;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
v := TfrView(Objects[i]);
|
|
if v.ClassName=View.ClassName then
|
|
begin
|
|
v.Selected := True;
|
|
Inc(SelNum);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrDesignerForm.CheckFileModified: Integer;
|
|
begin
|
|
result := mrNo;
|
|
// if FileModified then
|
|
if Modified then
|
|
begin
|
|
result:=MessageDlg(sSaveChanges + ' ' + sTo + ' ' +
|
|
ExtractFileName(CurDocName) + '?',mtConfirmation,
|
|
[mbYes,mbNo,mbCancel],0);
|
|
|
|
if result = mrCancel then Exit;
|
|
if result = mrYes then
|
|
begin
|
|
FileSave.Execute;
|
|
// FileBtn3Click(nil);
|
|
if not WasOk then
|
|
result := mrCancel;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// if AList is specified always process the list being objects selected or not
|
|
// if AList is not specified, all objects are processed but check Selected state
|
|
procedure TfrDesignerForm.ViewsAction(Views: TFpList; TheAction: TViewAction;
|
|
Data: PtrInt; OnlySel:boolean=true; WithUndoAction:boolean=true;
|
|
WithRedraw:boolean=true);
|
|
var
|
|
i, n: Integer;
|
|
List: TFpList;
|
|
begin
|
|
if not assigned(TheAction) then
|
|
exit;
|
|
|
|
List := Views;
|
|
if List=nil then
|
|
List := Objects;
|
|
|
|
n := 0;
|
|
for i:=List.Count-1 downto 0 do begin
|
|
if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
|
|
continue;
|
|
inc(n);
|
|
end;
|
|
|
|
if n=0 then
|
|
exit;
|
|
|
|
if WithUndoAction then
|
|
AddUndoAction(acEdit);
|
|
|
|
if WithRedraw then begin
|
|
PageView.NPEraseSelection;
|
|
GetRegion;
|
|
end;
|
|
|
|
for i:=List.Count-1 downto 0 do begin
|
|
if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
|
|
continue;
|
|
TheAction(TfrView(List[i]), Data);
|
|
end;
|
|
|
|
if WithRedraw then
|
|
PageView.NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
end;
|
|
|
|
// data=0 remove all borders
|
|
// data=1 set all borders
|
|
// data=-1 toggle all borders
|
|
procedure TfrDesignerForm.ToggleFrames(View: TfrView; Data: PtrInt);
|
|
begin
|
|
if (Data=0) or ((Data=-1) and (View.Frames<>[])) then
|
|
View.Frames := []
|
|
else
|
|
if (Data=1) or ((Data=-1) and (View.Frames=[])) then
|
|
View.Frames := [frbLeft, frbTop, frbRight, frbBottom];
|
|
|
|
if SelNum=1 then
|
|
LastFrames := View.Frames;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DuplicateView(View: TfrView; Data: PtrInt);
|
|
var
|
|
t: TfrView;
|
|
begin
|
|
// check if view is unique instance band kind and if there is already one
|
|
if (View is TfrBandView) and
|
|
not (TfrBandView(View).BandType in [btMasterHeader..btSubDetailFooter,
|
|
btGroupHeader, btGroupFooter])
|
|
and frCheckBand(TfrBandView(View).BandType)
|
|
then
|
|
exit;
|
|
|
|
t := frCreateObject(View.Typ, View.ClassName, Page);
|
|
TfrView(t).Assign(View);
|
|
t.y := t.y + FDuplicateCount * FDupDeltaY;
|
|
t.x := t.x + FDuplicateCount * FDupDeltaX;
|
|
t.Selected := false;
|
|
|
|
if CurReport.FindObject(t.Name) <> nil then
|
|
t.CreateUniqueName;
|
|
|
|
// Objects.Add(t);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ResetDuplicateCount;
|
|
begin
|
|
FDuplicateCount := 0;
|
|
FreeThenNil(FDuplicateList);
|
|
end;
|
|
|
|
function TfrDesignerForm.lrDesignAcceptDrag(const Source: TObject): TControl;
|
|
begin
|
|
if Source is TControl then
|
|
Result:=Source as TControl
|
|
else
|
|
if Source is TDragControlObject then
|
|
Result:=(Source as TDragControlObject).Control
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
procedure TfrDesignerForm.SetModified(AValue: Boolean);
|
|
begin
|
|
inherited SetModified(AValue);
|
|
if AValue then
|
|
StatusBar1.Panels[2].Text:=sFRDesignerForm_Modified
|
|
else
|
|
StatusBar1.Panels[2].Text:='';
|
|
FileSave.Enabled:=AValue;
|
|
end;
|
|
|
|
function TfrDesignerForm.IniFileName: string;
|
|
begin
|
|
Result:=AppendPathDelim(lrConfigFolderName(false))+'lrDesigner.cfg';
|
|
end;
|
|
|
|
{$HINTS ON}
|
|
|
|
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 SetCtrlEnabled(const Ar: Array of TObject; en: Boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(Ar) to High(Ar) do
|
|
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
|
|
SetCtrlEnabled([FrB1, FrB2, FrB3, FrB4, FrB5, FrB6, ClB1, ClB3, E1, SB1, SB2, StB1],
|
|
RectTypEnabled);
|
|
SetCtrlEnabled([ClB2, C2, C3, FnB1, FnB2, FnB3, AlB1, AlB2, AlB3, AlB4, AlB5, AlB6, AlB7, AlB8, HlB1],
|
|
FontTypEnabled);
|
|
SetCtrlEnabled([ZB1, ZB2, N32, N33, GB3], ZEnabled);
|
|
SetCtrlEnabled([CutB, N11, N2], CutEnabled);
|
|
SetCtrlEnabled([CopyB, N12, N1], CopyEnabled);
|
|
SetCtrlEnabled([PstB, N13, N3], PasteEnabled);
|
|
SetCtrlEnabled([N27, N5], DelEnabled);
|
|
SetCtrlEnabled([N36, N6], EditEnabled);
|
|
if not C2.Enabled then
|
|
begin
|
|
C2.ItemIndex := -1;
|
|
C3.Text := '';
|
|
end;
|
|
|
|
StatusBar1.Repaint;
|
|
{$ifndef sbod}
|
|
PBox1.Invalidate;
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SelectionChanged;
|
|
var
|
|
t: TfrView;
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
debugLnEnter('TfrDesignerForm.SelectionChanged INIT, SelNum=%d',[SelNum]);
|
|
{$ENDIF}
|
|
Busy := True;
|
|
ColorSelector.Hide;
|
|
LinePanel.Hide;
|
|
EnableControls;
|
|
if Page is TfrPageReport then
|
|
begin
|
|
if SelNum = 1 then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
if t.Typ <> gtBand then
|
|
with t do
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLn('Not a band');
|
|
{$ENDIF}
|
|
FrB1.Down := (frbTop in Frames);
|
|
FrB2.Down := (frbLeft in Frames);
|
|
FrB3.Down := (frbBottom in Frames);
|
|
FrB4.Down := (frbRight in Frames);
|
|
E1.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2);
|
|
frSetGlyph(FillColor, ClB1, 1);
|
|
frSetGlyph(FrameColor, ClB3, 2);
|
|
if t is TfrCustomMemoView then
|
|
with t as TfrCustomMemoView do
|
|
begin
|
|
frSetGlyph(Font.Color, ClB2, 0);
|
|
if C2.ItemIndex <> C2.Items.IndexOf(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 := (Adjust and $4) <> 0;
|
|
AlB5.Down := (Adjust and $18) = $8;
|
|
AlB6.Down := (Adjust and $18) = 0;
|
|
AlB7.Down := (Adjust and $18) = $10;
|
|
case (Adjust and $3) of
|
|
0: BDown(AlB1);
|
|
1: BDown(AlB2);
|
|
2: BDown(AlB3);
|
|
3: BDown(AlB8);
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else if SelNum > 1 then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLn('Multiple selection');
|
|
{$ENDIF}
|
|
|
|
BUp(FrB1);
|
|
BUp(FrB2);
|
|
BUp(FrB3);
|
|
BUp(FrB4);
|
|
ColorLocked := True;
|
|
frSetGlyph(0, ClB1, 1);
|
|
ColorLocked := False;
|
|
E1.Text := '1';
|
|
C2.ItemIndex := -1;
|
|
C3.Text := '';
|
|
BUp(FnB1);
|
|
BUp(FnB2);
|
|
BUp(FnB3);
|
|
BDown(AlB1);
|
|
BUp(AlB4);
|
|
BUp(AlB5);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if ObjInsp.SelectedObject = Page then
|
|
PageView.Invalidate;
|
|
end;
|
|
Busy := False;
|
|
ShowPosition;
|
|
ShowContent;
|
|
ActiveControl := nil;
|
|
{$IFDEF DebugLR}
|
|
debugLnExit('TfrDesignerForm.SelectionChanged END, SelNum=%d',[SelNum]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ShowPosition;
|
|
begin
|
|
FillInspFields;
|
|
StatusBar1.Repaint;
|
|
{$ifndef sbod}
|
|
PBox1.Invalidate;
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ShowContent;
|
|
var
|
|
t: TfrView;
|
|
s: String;
|
|
begin
|
|
s := '';
|
|
if SelNum = 1 then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
s := t.Name;
|
|
if t is TfrBandView then
|
|
s := s + ': ' + frBandNames[TfrBandView(t).BandType]
|
|
else if t.Memo.Count > 0 then
|
|
s := s + ': ' + t.Memo[0];
|
|
end;
|
|
StatusBar1.Panels[3].Text := s;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DoClick(Sender: TObject);
|
|
var
|
|
i, j, b: Integer;
|
|
s : String;
|
|
t : TfrView;
|
|
begin
|
|
if Busy then
|
|
Exit;
|
|
AddUndoAction(acEdit);
|
|
PageView.NPEraseSelection;
|
|
GetRegion;
|
|
b:=(Sender as TControl).Tag;
|
|
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected and ((t.Typ <> gtBand) or (b = 16)) then
|
|
with t do
|
|
begin
|
|
if t is TfrCustomMemoView then
|
|
with t as TfrCustomMemoView do
|
|
case b of
|
|
7: if C2.ItemIndex >= 0 then
|
|
begin
|
|
Font.Name := C2.Items[C2.ItemIndex];
|
|
LastFontName := Font.Name;
|
|
end;
|
|
8: begin
|
|
Font.Size := StrToIntDef(C3.Text, LastFontSize);
|
|
LastFontSize := Font.Size;
|
|
end;
|
|
9: begin
|
|
LastFontStyle := frGetFontStyle(Font.Style);
|
|
//SetBit(LastFontStyle, not FnB1.Down, 2);
|
|
SetBit(LastFontStyle, FnB1.Down, 2);
|
|
Font.Style := frSetFontStyle(LastFontStyle);
|
|
end;
|
|
10: begin
|
|
LastFontStyle := frGetFontStyle(Font.Style);
|
|
//SetBit(LastFontStyle, not FnB2.Down, 1);
|
|
SetBit(LastFontStyle, FnB2.Down, 1);
|
|
Font.Style := frSetFontStyle(LastFontStyle);
|
|
end;
|
|
11..13:
|
|
begin
|
|
Adjust := (Adjust and $FC) + (b-11);
|
|
LastAdjust := Adjust;
|
|
end;
|
|
14: begin
|
|
Adjust := (Adjust and $FB) + Word(AlB4.Down) * 4;
|
|
LastAdjust := Adjust;
|
|
end;
|
|
15: begin
|
|
Adjust := (Adjust and $E7) + Word(AlB5.Down) * 8 + Word(AlB7.Down) * $10;
|
|
LastAdjust := Adjust;
|
|
end;
|
|
17: begin
|
|
Font.Color := ColorSelector.Color;
|
|
LastFontColor := Font.Color;
|
|
end;
|
|
18: begin
|
|
LastFontStyle := frGetFontStyle(Font.Style);
|
|
// SetBit(LastFontStyle, not FnB3.Down, 4);
|
|
SetBit(LastFontStyle, FnB3.Down, 4);
|
|
Font.Style := frSetFontStyle(LastFontStyle);
|
|
end;
|
|
22: begin
|
|
//Alignment:=tafrJustify;
|
|
Adjust := (Adjust and $FC) + 3;
|
|
LastAdjust := Adjust;
|
|
end;
|
|
end;
|
|
|
|
case b of
|
|
1:
|
|
begin //Top frame
|
|
if (Sender=frB1) and frB1.Down then
|
|
Frames:=Frames+[frbTop]
|
|
else
|
|
Frames:=Frames-[frbTop];
|
|
DRect := Rect(t.x - 10, t.y - 10, t.x + t.dx + 10, t.y + 10)
|
|
end;
|
|
2: //Left frame
|
|
begin
|
|
if (Sender=FrB2) and frB2.Down then
|
|
Frames:=Frames+[frbLeft]
|
|
else
|
|
Frames:=Frames-[frbLeft];
|
|
DRect := Rect(t.x - 10, t.y - 10, t.x + 10, t.y + t.dy + 10)
|
|
end;
|
|
3: //Bottom Frame
|
|
begin
|
|
if (Sender=FrB3) and frB3.Down then
|
|
Frames:=Frames+[frbBottom]
|
|
else
|
|
Frames:=Frames-[frbBottom];
|
|
DRect := Rect(t.x - 10, t.y + t.dy - 10, t.x + t.dx + 10, t.y + t.dy + 10)
|
|
end;
|
|
4: //Right Frame
|
|
begin
|
|
if (Sender=FrB4) and frB4.Down then
|
|
Frames:=Frames+[frbRight]
|
|
else
|
|
Frames:=Frames-[frbRight];
|
|
DRect := Rect(t.x + t.dx - 10, t.y - 10, t.x + t.dx + 10, t.y + t.dy + 10)
|
|
end;
|
|
20:
|
|
begin
|
|
if (Sender=FrB5) then
|
|
Frames:=[frbLeft, frbTop, frbRight, frbBottom];
|
|
|
|
LastFrames:=Frames;
|
|
end;
|
|
21:
|
|
begin
|
|
if (Sender=FrB6) then
|
|
Frames:=[];
|
|
LastFrames:=[];
|
|
end;
|
|
5:
|
|
begin
|
|
FillColor:=ColorSelector.Color;
|
|
LastFillColor := FillColor;
|
|
end;
|
|
6:
|
|
begin
|
|
s := E1.Text;
|
|
for j := 1 to Length(s) do
|
|
if s[j] in ['.', ','] then
|
|
s[j] := DecimalSeparator;
|
|
FrameWidth := StrToFloat(s);
|
|
if t is TfrLineView then
|
|
LastLineWidth := FrameWidth
|
|
else
|
|
LastFrameWidth := FrameWidth;
|
|
end;
|
|
19:
|
|
begin
|
|
FrameColor := ColorSelector.Color;
|
|
LastFrameColor := FrameColor;
|
|
end;
|
|
25..30:
|
|
FrameStyle:=TfrFrameStyle(b - 25);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
PageView.NPDrawLayerObjects(ClipRgn, TopSelected);
|
|
|
|
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
|
|
t: TfrCustomMemoView;
|
|
begin
|
|
t := TfrCustomMemoView(Objects[TopSelected]);
|
|
frHilightForm := TfrHilightForm.Create(nil);
|
|
with frHilightForm 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
|
|
AddUndoAction(acEdit);
|
|
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);
|
|
end;
|
|
end;
|
|
frHilightForm.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FillInspFields;
|
|
var
|
|
t: TfrView;
|
|
begin
|
|
ObjInspSelect(nil);
|
|
if SelNum = 0 then
|
|
ObjInspSelect(Page)
|
|
else
|
|
if SelNum = 1 then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
ObjInspSelect(t);
|
|
end else
|
|
if SelNum > 1 then
|
|
ObjInspSelect(Objects);
|
|
ObjInspRefresh;
|
|
end;
|
|
|
|
{
|
|
procedure TfrDesignerForm.OnModify(Item: Integer; var EditText: String);
|
|
var
|
|
t: TfrView;
|
|
i, k: Integer;
|
|
begin
|
|
AddUndoAction(acEdit);
|
|
if (Item = 0) and (SelNum = 1) then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
if CurReport.FindObject(fld[0]) = nil then
|
|
t.Name := fld[0] else
|
|
EditText := t.Name;
|
|
SetPageTitles;
|
|
end
|
|
else if Item in [1..5] then
|
|
begin
|
|
EditText := frParser.Calc(fld[Item]);
|
|
if Item <> 6 then
|
|
k := UnitsToPoints(StrToFloat(EditText)) else
|
|
k := StrToInt(EditText);
|
|
for i := 0 to Objects.Count-1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
with t do
|
|
case Item of
|
|
1: if (k > 0) and (k < Page.PrnInfo.Pgw) then
|
|
x := k;
|
|
2: if (k > 0) and (k < Page.PrnInfo.Pgh) then
|
|
y := k;
|
|
3: if (k > 0) and (k < Page.PrnInfo.Pgw) then
|
|
dx := k;
|
|
4: if (k > 0) and (k < Page.PrnInfo.Pgh) then
|
|
dy := k;
|
|
5: Visible := Boolean(k);
|
|
end;
|
|
end;
|
|
end;
|
|
FillInspFields;
|
|
if Item in [1..5] then
|
|
EditText := fld[Item];
|
|
RedrawPage;
|
|
StatusBar1.Repaint;
|
|
PBox1.Invalidate;
|
|
end;
|
|
}
|
|
procedure TfrDesignerForm.StB1Click(Sender: TObject);
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
if not LinePanel.Visible then
|
|
begin
|
|
LinePanel.Parent := Self;
|
|
with (Sender as TControl) do
|
|
p := Self.ScreenToClient(Parent.ClientToScreen(Point(Left, Top)));
|
|
LinePanel.SetBounds(p.X,p.Y + 26,LinePanel.Width,LinePanel.Height);
|
|
end;
|
|
LinePanel.Visible := not LinePanel.Visible;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ObjInspSelect(Obj: TObject);
|
|
{$IFDEF STDOI}
|
|
var
|
|
Selection: TPersistentSelectionList;
|
|
i: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STDOI}
|
|
Selection := TPersistentSelectionList.Create;
|
|
PropHook.LookupRoot:=nil;
|
|
if Obj is TPersistent then
|
|
begin
|
|
Selection.Add(TPersistent(Obj));
|
|
PropHook.LookupRoot:=TPersistent(Obj);
|
|
end else
|
|
if Obj is TFpList then
|
|
with frDesigner.page do
|
|
for i:=0 to Objects.Count-1 do
|
|
if TfrView(Objects[i]).Selected then
|
|
begin
|
|
if PropHook.LookupRoot=nil then
|
|
PropHook.LookupRoot := TPersistent(Objects[i]);
|
|
Selection.Add(TPersistent(Objects[i]));
|
|
end;
|
|
ObjInsp.Selection := Selection;
|
|
Selection.Free;
|
|
{$ELSE}
|
|
ObjInsp.Select(Obj);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DuplicateSelection;
|
|
var
|
|
t: TfrView;
|
|
q: TPoint;
|
|
p: TPoint;
|
|
i: Integer;
|
|
OldCount: Integer;
|
|
begin
|
|
if not DelEnabled then
|
|
exit;
|
|
|
|
OldCount := Objects.Count;
|
|
if OldCount=0 then
|
|
exit;
|
|
|
|
if FDuplicateList=nil then
|
|
begin
|
|
FDuplicateList := TFpList.Create;
|
|
for i:=0 to OldCount-1 do
|
|
if TfrView(Objects[i]).Selected then
|
|
FDuplicateList.Add(Objects[i]);
|
|
end;
|
|
|
|
if (FDuplicateList.Count=0) then
|
|
begin
|
|
ResetDuplicateCount;
|
|
exit;
|
|
end;
|
|
|
|
Inc(FDuplicateCount);
|
|
|
|
if FDuplicateCount=1 then
|
|
begin
|
|
|
|
// find reference rect in screen coords
|
|
if SelNum>1 then
|
|
begin
|
|
p := OldRect.TopLeft;
|
|
q := OldRect.BottomRight;
|
|
end else
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
p := Point(t.x, t.y);
|
|
q := point(t.x+t.dx, t.y+t.dy);
|
|
end;
|
|
p := PageView.ControlToScreen(p);
|
|
q := PageView.ControlToScreen(q);
|
|
|
|
// find duplicates delta based on current mouse cursor position
|
|
FDupDeltaX := (q.x-p.x);
|
|
FDupDeltaY := (q.y-p.y);
|
|
with Mouse.CursorPos do
|
|
begin
|
|
if x < p.x then
|
|
FDupDeltaX := -FDupDeltaX
|
|
else
|
|
if x < q.x then
|
|
FDupDeltaX := 0;
|
|
|
|
if y < p.y then
|
|
FDupDeltaY := -FDupDeltaY
|
|
else
|
|
if y < q.y then
|
|
FDupDeltaY := 0;
|
|
end;
|
|
end;
|
|
|
|
ViewsAction(FDuplicateList, @DuplicateView, 0, false, false, false);
|
|
|
|
if OldCount<>Objects.Count then
|
|
begin
|
|
SendBandsToDown;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
AddUndoAction(acDuplication);
|
|
end else
|
|
Dec(FDuplicateCount);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.CreateNewReport;
|
|
begin
|
|
if CheckFileModified=mrCancel then
|
|
exit;
|
|
ClearUndoBuffer;
|
|
CurReport.Pages.Clear;
|
|
CurReport.Pages.Add;
|
|
CurPage := 0;
|
|
CurDocName := sUntitled;
|
|
//FileModified := False;
|
|
Modified := False;
|
|
CurReport.ReportCreateDate:=Now;
|
|
|
|
FCurDocFileType := 3;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ObjInspRefresh;
|
|
begin
|
|
{$IFDEF STDOI}
|
|
//TODO: refresh
|
|
{$ELSE}
|
|
ObjInsp.Refresh;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ClB1Click(Sender: TObject);
|
|
var p : TPoint;
|
|
t : TfrView;
|
|
CL : TColor;
|
|
begin
|
|
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
|
|
with ColorSelector do SetBounds(p.X,p.Y + 26,Width,Height);
|
|
ColorSelector.Visible := True;
|
|
end;
|
|
ClrButton := Sender as TSpeedButton;
|
|
t := TfrView(Objects[TopSelected]);
|
|
CL:=clNone;
|
|
if Sender=ClB1 then
|
|
CL:=t.FillColor;
|
|
if (Sender=ClB2) and (t is TfrCustomMemoView) then
|
|
CL:=TfrCustomMemoView(t).Font.Color;
|
|
if Sender=ClB3 then
|
|
CL:=t.FrameColor;
|
|
ColorSelector.Color:=CL;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ColorSelected(Sender: TObject);
|
|
var
|
|
n: Integer;
|
|
begin
|
|
n := 0;
|
|
if ClrButton = ClB1 then
|
|
n := 1
|
|
else
|
|
if ClrButton = ClB3 then
|
|
n := 2;
|
|
{$IFDEF DebugLR}
|
|
DebugLn('ColorSelected');
|
|
{$ENDIF}
|
|
frSetGlyph(ColorSelector.Color, ClrButton, n);
|
|
|
|
DoClick(ClrButton);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.PBox1Paint(Sender: TObject);
|
|
var
|
|
t: TfrView;
|
|
s: String;
|
|
nx, ny: Double;
|
|
x, y, dx, dy: Integer;
|
|
begin
|
|
with PBox1.Canvas do
|
|
begin
|
|
FillRect(Rect(0, 0, PBox1.Width, PBox1.Height));
|
|
ImageList1.Draw(PBox1.Canvas, 2, 0, 0);
|
|
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 := TfrView(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
|
|
begin
|
|
with t as TfrPictureView do
|
|
begin
|
|
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;
|
|
end;
|
|
end
|
|
else if (SelNum > 0) and MRFlag then
|
|
begin
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.C2DrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
j: PtrInt;
|
|
begin
|
|
with C2.Canvas do
|
|
begin
|
|
Font.Name := 'default';
|
|
FillRect(Rect);
|
|
j := PtrInt(C2.Items.Objects[Index]);
|
|
{$IFDEF USE_PRINTER_FONTS}
|
|
if (j and $100 <> 0) then
|
|
ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top +1, 2)
|
|
else
|
|
{$ENDIF}
|
|
if ( j and TRUETYPE_FONTTYPE) <> 0 then
|
|
ImageList2.Draw(C2.Canvas, Rect.Left, Rect.Top + 1, 0);
|
|
TextOut(Rect.Left + 20, Rect.Top + 1, C2.Items[Index]);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ShowMemoEditor;
|
|
begin
|
|
EditorForm.View := TfrView(Objects[TopSelected]);
|
|
if EditorForm.ShowEditor = mrOk then
|
|
begin
|
|
PageView.NPDrawSelection;
|
|
PageView.NPDrawLayerObjects(EditorForm.View.GetClipRgn(rtExtended), TopSelected);
|
|
end;
|
|
|
|
ActiveControl := nil;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ShowEditor;
|
|
var
|
|
t: TfrView;
|
|
i: Integer;
|
|
bt: TfrBandType;
|
|
begin
|
|
SetCaptureControl(nil);
|
|
t := TfrView(Objects[TopSelected]);
|
|
|
|
if lrrDontModify in T.Restrictions then
|
|
exit;
|
|
|
|
if t.Typ = gtMemo then
|
|
ShowMemoEditor
|
|
else
|
|
if t.Typ = gtPicture then
|
|
begin
|
|
frGEditorForm := TfrGEditorForm.Create(nil);
|
|
with frGEditorForm do
|
|
begin
|
|
Image1.Picture.Assign((t as TfrPictureView).Picture);
|
|
if ShowModal = mrOk then
|
|
begin
|
|
AddUndoAction(acEdit);
|
|
(t as TfrPictureView).Picture.Assign(Image1.Picture);
|
|
PageView.NPDrawSelection;
|
|
PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
|
|
end;
|
|
end;
|
|
frGEditorForm.Free;
|
|
end
|
|
else
|
|
if t.Typ = gtBand then
|
|
begin
|
|
PageView.NPEraseSelection;
|
|
bt := (t as TfrBandView).BandType;
|
|
if bt in [btMasterData, btDetailData, btSubDetailData] then
|
|
begin
|
|
frBandEditorForm := TfrBandEditorForm.Create(nil);
|
|
frBandEditorForm.ShowEditor(t);
|
|
frBandEditorForm.Free;
|
|
end
|
|
else if bt = btGroupHeader then
|
|
begin
|
|
frGroupEditorForm := TfrGroupEditorForm.Create(nil);
|
|
frGroupEditorForm.ShowEditor(t);
|
|
frGroupEditorForm.Free;
|
|
end
|
|
else if bt = btCrossData then
|
|
begin
|
|
frVBandEditorForm := TfrVBandEditorForm.Create(nil);
|
|
frVBandEditorForm.ShowEditor(t);
|
|
frVBandEditorForm.Free;
|
|
end
|
|
else
|
|
PageView.DFlag := False;
|
|
PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
|
|
end
|
|
else
|
|
if t.Typ = gtSubReport then
|
|
CurPage := (t as TfrSubReportView).SubPage
|
|
else
|
|
if t.Typ = gtAddIn then
|
|
begin
|
|
for i := 0 to frAddInsCount - 1 do
|
|
if frAddIns[i].ClassRef.ClassName = t.ClassName then
|
|
begin
|
|
if Assigned(frAddIns[i].EditorProc) then
|
|
begin
|
|
if frAddIns[i].EditorProc(t) then
|
|
Modified:=true;
|
|
end
|
|
else
|
|
if frAddIns[i].EditorForm <> nil then
|
|
begin
|
|
PageView.NPEraseSelection;
|
|
frAddIns[i].EditorForm.ShowEditor(t);
|
|
PageView.NPDrawLayerObjects(t.GetClipRgn(rtExtended), TopSelected);
|
|
end
|
|
else
|
|
ShowMemoEditor;
|
|
break;
|
|
end;
|
|
end;
|
|
ShowContent;
|
|
ShowPosition;
|
|
ActiveControl := nil;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ReleaseAction(ActionRec: TfrUndoRec);
|
|
var
|
|
p, p1: PfrUndoObj;
|
|
begin
|
|
p := ActionRec.Objects;
|
|
while p <> nil do
|
|
begin
|
|
if ActionRec.Action in [acDelete, acEdit] then
|
|
p^.ObjPtr.Free;
|
|
p1 := p;
|
|
p := p^.Next;
|
|
FreeMem(p1, SizeOf(TfrUndoObj));
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ClearBuffer(Buffer: TfrUndoBuffer; var BufferLength: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to BufferLength - 1 do
|
|
ReleaseAction(Buffer[i]);
|
|
BufferLength := 0;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ClearUndoBuffer;
|
|
begin
|
|
ClearBuffer(FUndoBuffer, FUndoBufferLength);
|
|
N46.Enabled := False;
|
|
UndoB.Enabled := N46.Enabled;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ClearRedoBuffer;
|
|
begin
|
|
ClearBuffer(FRedoBuffer, FRedoBufferLength);
|
|
N48.Enabled := False;
|
|
RedoB.Enabled := N48.Enabled;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Undo(Buffer: PfrUndoBuffer);
|
|
var
|
|
p, p1: PfrUndoObj;
|
|
r: PfrUndoRec1;
|
|
BufferLength: Integer;
|
|
List: TFpList;
|
|
a: TfrUndoAction;
|
|
begin
|
|
if Buffer = @FUndoBuffer then
|
|
BufferLength := FUndoBufferLength
|
|
else
|
|
BufferLength := FRedoBufferLength;
|
|
|
|
if (Buffer^[BufferLength - 1].Page <> CurPage) then Exit;
|
|
|
|
List := TFpList.Create;
|
|
a := Buffer^[BufferLength - 1].Action;
|
|
p := Buffer^[BufferLength - 1].Objects;
|
|
while p <> nil do
|
|
begin
|
|
GetMem(r, SizeOf(TfrUndoRec1));
|
|
r^.ObjPtr := p^.ObjPtr;
|
|
r^.Int := p^.Int;
|
|
List.Add(r);
|
|
case Buffer^[BufferLength - 1].Action of
|
|
acInsert:
|
|
begin
|
|
r^.Int := Page.FindObjectByID(p^.ObjID);
|
|
r^.ObjPtr := TfrView(Objects[r^.Int]);
|
|
a := acDelete;
|
|
end;
|
|
acDelete: a := acInsert;
|
|
acEdit: r^.ObjPtr := TfrView(Objects[p^.Int]);
|
|
acZOrder:
|
|
begin
|
|
r^.Int := Page.FindObjectByID(p^.ObjID);
|
|
r^.ObjPtr := TfrView(Objects[r^.Int]);
|
|
p^.ObjPtr := r^.ObjPtr;
|
|
end;
|
|
end;
|
|
p := p^.Next;
|
|
end;
|
|
if Buffer = @FUndoBuffer then
|
|
AddAction(@FRedoBuffer, a, List) else
|
|
AddAction(@FUndoBuffer, a, List);
|
|
List.Free;
|
|
|
|
p := Buffer^[BufferLength - 1].Objects;
|
|
while p <> nil do
|
|
begin
|
|
case Buffer^[BufferLength - 1].Action of
|
|
acInsert: Page.Delete(Page.FindObjectByID(p^.ObjID));
|
|
acDelete: Objects.Insert(p^.Int, p^.ObjPtr);
|
|
acEdit:
|
|
begin
|
|
TfrView(Objects[p^.Int]).Assign(p^.ObjPtr);
|
|
p^.ObjPtr.Free;
|
|
end;
|
|
acZOrder: Objects[p^.Int] := p^.ObjPtr;
|
|
end;
|
|
p1 := p;
|
|
p := p^.Next;
|
|
FreeMem(p1, SizeOf(TfrUndoObj));
|
|
end;
|
|
|
|
if Buffer = @FUndoBuffer then
|
|
Dec(FUndoBufferLength)
|
|
else
|
|
Dec(FRedoBufferLength);
|
|
|
|
ResetSelection;
|
|
PageView.Invalidate;
|
|
N46.Enabled := FUndoBufferLength > 0;
|
|
UndoB.Enabled := N46.Enabled;
|
|
N48.Enabled := FRedoBufferLength > 0;
|
|
RedoB.Enabled := N48.Enabled;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.AddAction(Buffer: PfrUndoBuffer; a: TfrUndoAction; List: TFpList);
|
|
var
|
|
i: Integer;
|
|
p, p1: PfrUndoObj;
|
|
r: PfrUndoRec1;
|
|
t, t1: TfrView;
|
|
BufferLength: Integer;
|
|
begin
|
|
if Buffer = @FUndoBuffer then
|
|
BufferLength := FUndoBufferLength
|
|
else
|
|
BufferLength := FRedoBufferLength;
|
|
if BufferLength >= MaxUndoBuffer then
|
|
begin
|
|
ReleaseAction(Buffer^[0]);
|
|
for i := 0 to MaxUndoBuffer - 2 do
|
|
Buffer^[i] := Buffer^[i + 1];
|
|
BufferLength := MaxUndoBuffer - 1;
|
|
end;
|
|
Buffer^[BufferLength].Action := a;
|
|
Buffer^[BufferLength].Page := CurPage;
|
|
Buffer^[BufferLength].Objects := nil;
|
|
p := nil;
|
|
for i := 0 to List.Count - 1 do
|
|
begin
|
|
r := List[i];
|
|
t := r^.ObjPtr;
|
|
GetMem(p1, SizeOf(TfrUndoObj));
|
|
p1^.Next := nil;
|
|
|
|
if Buffer^[BufferLength].Objects = nil then
|
|
Buffer^[BufferLength].Objects := p1
|
|
else
|
|
p^.Next := p1;
|
|
|
|
p := p1;
|
|
case a of
|
|
acInsert: p^.ObjID := t.ID;
|
|
acDelete, acEdit:
|
|
begin
|
|
t1 := frCreateObject(t.Typ, t.ClassName, nil);
|
|
t1.Assign(t);
|
|
t1.ID := t.ID;
|
|
p^.ObjID := t.ID;
|
|
p^.ObjPtr := t1;
|
|
p^.Int := r^.Int;
|
|
end;
|
|
acZOrder:
|
|
begin
|
|
p^.ObjID := t.ID;
|
|
p^.Int := r^.Int;
|
|
end;
|
|
end;
|
|
FreeMem(r, SizeOf(TfrUndoRec1));
|
|
end;
|
|
if Buffer = @FUndoBuffer then
|
|
begin
|
|
FUndoBufferLength := BufferLength + 1;
|
|
N46.Enabled := True;
|
|
UndoB.Enabled := True;
|
|
end
|
|
else
|
|
begin
|
|
FRedoBufferLength := BufferLength + 1;
|
|
N48.Enabled := True;
|
|
RedoB.Enabled := True;
|
|
end;
|
|
Modified := True;
|
|
//FileModified := True;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.AddUndoAction(AUndoAction: TfrUndoAction);
|
|
var
|
|
i,j: Integer;
|
|
t: TfrView;
|
|
List: TFpList;
|
|
F:boolean;
|
|
|
|
procedure AddCurrent;
|
|
var
|
|
p: PfrUndoRec1;
|
|
begin
|
|
GetMem(p, SizeOf(TfrUndoRec1));
|
|
p^.ObjPtr := t;
|
|
p^.Int := i;
|
|
List.Add(p);
|
|
end;
|
|
|
|
begin
|
|
ClearRedoBuffer;
|
|
if not Assigned(Objects) then exit;
|
|
|
|
List := TFpList.Create;
|
|
|
|
// last FDuplicateList.Count objectes were duplicated
|
|
if AUndoAction = acDuplication then
|
|
j := Objects.Count - FDuplicateList.Count
|
|
else
|
|
j := 0;
|
|
|
|
for i := j to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
F:= ((AUndoAction = acDelete) and not (lrrDontDelete in t.Restrictions))
|
|
or
|
|
((AUndoAction = acEdit) and not (lrrDontModify in t.Restrictions))
|
|
or
|
|
(not (AUndoAction in [acDelete, acEdit]));
|
|
|
|
if (not (doUndoDisable in T.DesignOptions)) and ((AUndoAction in [acDuplication, acZOrder]) or t.Selected) and F then
|
|
AddCurrent;
|
|
end;
|
|
|
|
if List.Count>0 then
|
|
begin
|
|
if AUndoAction = acDuplication then
|
|
AUndoAction := acInsert;
|
|
AddAction(@FUndoBuffer, AUndoAction, List);
|
|
end;
|
|
List.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.BeforeChange;
|
|
begin
|
|
AddUndoAction(acEdit);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.AfterChange;
|
|
begin
|
|
PageView.NPDrawSelection;
|
|
PageView.NPDrawLayerObjects(0, TopSelected);
|
|
ObjInspRefresh;
|
|
end;
|
|
|
|
//Move selected object from front
|
|
procedure TfrDesignerForm.ZB1Click(Sender: TObject); // go up
|
|
var
|
|
i, j, n: Integer;
|
|
t: TfrView;
|
|
begin
|
|
AddUndoAction(acZOrder);
|
|
n:=Objects.Count;
|
|
i:=0;
|
|
j:=0;
|
|
while j < n do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
begin
|
|
Objects.Delete(i);
|
|
Objects.Add(t);
|
|
end
|
|
else Inc(i);
|
|
Inc(j);
|
|
end;
|
|
SendBandsToDown;
|
|
RedrawPage;
|
|
end;
|
|
|
|
//Send selected object to back
|
|
procedure TfrDesignerForm.ZB2Click(Sender: TObject); // go down
|
|
var
|
|
t: TfrView;
|
|
i, j, n: Integer;
|
|
begin
|
|
AddUndoAction(acZOrder);
|
|
n:=Objects.Count;
|
|
j:=0;
|
|
i:=n-1;
|
|
while j < n do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected 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;
|
|
if Sender<>pgB4 then
|
|
AddPage('TfrPageReport')
|
|
else
|
|
AddPage('TfrPageDialog');
|
|
end;
|
|
|
|
procedure TfrDesignerForm.PgB2Click(Sender: TObject); // remove page
|
|
begin
|
|
if MessageDlg(sRemovePg,mtConfirmation,[mbYes,mbNo],0)=mrYes then
|
|
RemovePage(CurPage);
|
|
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
|
|
AddUndoAction(acDelete);
|
|
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, t1: TfrView;
|
|
begin
|
|
Unselect;
|
|
SelNum := 0;
|
|
minx := 32767; miny := 32767;
|
|
with ClipBd do
|
|
for i := 0 to Count-1 do
|
|
begin
|
|
t := TfrView(Items[i]);
|
|
if t.x < minx then minx := t.x;
|
|
if t.y < miny then miny := t.y;
|
|
end;
|
|
for i := 0 to ClipBd.Count - 1 do
|
|
begin
|
|
t := TfrView(ClipBd.Items[i]);
|
|
if t.Typ = gtBand then
|
|
if not (TfrBandView(t).BandType in [btMasterHeader..btSubDetailFooter,
|
|
btGroupHeader, btGroupFooter]) and
|
|
frCheckBand(TfrBandView(t).BandType) then
|
|
continue;
|
|
if PageView.Left < 0 then
|
|
t.x := t.x - minx + ((-PageView.Left) div GridSize * GridSize) else
|
|
t.x := t.x - minx;
|
|
if PageView.Top < 0 then
|
|
t.y := t.y - miny + ((-PageView.Top) div GridSize * GridSize) else
|
|
t.y := t.y - miny;
|
|
Inc(SelNum);
|
|
t1 := frCreateObject(t.Typ, t.ClassName, Page);
|
|
t1.Assign(t);
|
|
if CurReport.FindObject(t1.Name) <> nil then
|
|
t1.CreateUniqueName;
|
|
end;
|
|
SelectionChanged;
|
|
SendBandsToDown;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
AddUndoAction(acInsert);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.UndoBClick(Sender: TObject); // undo
|
|
begin
|
|
Undo(@FUndoBuffer);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.RedoBClick(Sender: TObject); // redo
|
|
begin
|
|
Undo(@FRedoBuffer);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SelAllBClick(Sender: TObject); // select all
|
|
begin
|
|
PageView.NPEraseSelection;
|
|
SelectAll;
|
|
PageView.GetMultipleSelected;
|
|
PageView.NPDrawSelection;
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ExitBClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF MODALDESIGNER}
|
|
ModalResult := mrOk;
|
|
{$ELSE}
|
|
Close;
|
|
{$ENDIF}
|
|
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
|
|
begin
|
|
CreateNewReport;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N23Click(Sender: TObject); // create new from template
|
|
begin
|
|
frTemplForm := TfrTemplForm.Create(nil);
|
|
with frTemplForm do
|
|
if ShowModal = mrOk then
|
|
begin
|
|
if DefaultTemplate then
|
|
CreateNewReport
|
|
else
|
|
begin
|
|
ClearUndoBuffer;
|
|
if ExtractFileExt(TemplName) = '.lrt' then
|
|
CurReport.LoadTemplateXML(TemplName, nil, nil, True)
|
|
else
|
|
CurReport.LoadTemplate(TemplName, nil, nil, True);
|
|
CurDocName := sUntitled;
|
|
CurPage := 0; // do all
|
|
end;
|
|
end;
|
|
frTemplForm.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N42Click(Sender: TObject); // var editor
|
|
begin
|
|
if ShowEvEditor(CurReport) then
|
|
Modified := True;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.PgB3Click(Sender: TObject); // page setup
|
|
var
|
|
w, h, p: Integer;
|
|
begin
|
|
frPgoptForm := TfrPgoptForm.Create(nil);
|
|
with frPgoptForm, Page do
|
|
begin
|
|
CB1.Checked := PrintToPrevPage;
|
|
CB5.Checked := not UseMargins;
|
|
if Orientation = poPortrait then
|
|
RB1.Checked := True
|
|
else
|
|
RB2.Checked := True;
|
|
ComB1.Items := Prn.PaperNames;
|
|
ComB1.ItemIndex := Prn.GetArrayPos(pgSize);
|
|
E1.Text := ''; E2.Text := '';
|
|
|
|
if pgSize = $100 then
|
|
begin
|
|
E1.Text := IntToStr(Width div 10);
|
|
E2.Text := IntToStr(Height div 10);
|
|
end;
|
|
|
|
E3.Text := IntToStr(Margins.Left * 5 div 18);
|
|
E4.Text := IntToStr(Margins.Top * 5 div 18);
|
|
E5.Text := IntToStr(Margins.Right * 5 div 18);
|
|
E6.Text := IntToStr(Margins.Bottom * 5 div 18);
|
|
E7.Text := IntToStr(ColGap * 5 div 18);
|
|
ecolCount.Value := ColCount;
|
|
if LayoutOrder = loColumns then
|
|
RBColumns.Checked := true
|
|
else
|
|
RBRows.Checked := true;
|
|
WasOk := False;
|
|
if ShowModal = mrOk then
|
|
begin
|
|
Modified := True;
|
|
// FileModified := True;
|
|
WasOk := True;
|
|
PrintToPrevPage := CB1.Checked;
|
|
UseMargins := not CB5.Checked;
|
|
if RB1.Checked then
|
|
Orientation := poPortrait
|
|
else
|
|
Orientation := poLandscape;
|
|
if RBColumns.Checked then
|
|
LayoutOrder := loColumns
|
|
else
|
|
LayoutOrder := loRows;
|
|
|
|
p := Prn.PaperSizes[ComB1.ItemIndex];
|
|
w := 0; h := 0;
|
|
if p = $100 then
|
|
try
|
|
w := StrToInt(E1.Text) * 10;
|
|
h := StrToInt(E2.Text) * 10;
|
|
except
|
|
on exception do p := 9; // A4
|
|
end;
|
|
|
|
try
|
|
Margins.AsRect := Rect(StrToInt(E3.Text) * 18 div 5,
|
|
StrToInt(E4.Text) * 18 div 5,
|
|
StrToInt(E5.Text) * 18 div 5,
|
|
StrToInt(E6.Text) * 18 div 5);
|
|
ColGap := StrToInt(E7.Text) * 18 div 5;
|
|
except
|
|
on exception do
|
|
begin
|
|
Margins.AsRect := Rect(0, 0, 0, 0);
|
|
ColGap := 0;
|
|
end;
|
|
end;
|
|
ColCount := ecolCount.Value;
|
|
ChangePaper(p, w, h, Orientation);
|
|
CurPage := CurPage; // for repaint and other
|
|
UpdScrollbars;
|
|
end;
|
|
end;
|
|
frPgoptForm.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N8Click(Sender: TObject); // report setup
|
|
begin
|
|
frDocOptForm := TfrDocOptForm.Create(nil);
|
|
with frDocOptForm do
|
|
begin
|
|
CB1.Checked := not CurReport.PrintToDefault;
|
|
CB2.Checked := CurReport.DoublePass;
|
|
edTitle.Text := CurReport.Title;
|
|
edComments.Text := CurReport.Comments.Text;
|
|
edKeyWords.Text := CurReport.KeyWords;
|
|
edSubject.Text := CurReport.Subject;
|
|
edAutor.Text := CurReport.ReportAutor;
|
|
edtMaj.Text := CurReport.ReportVersionMajor;
|
|
edtMinor.Text := CurReport.ReportVersionMinor;
|
|
edtRelease.Text := CurReport.ReportVersionRelease;
|
|
edtBuild.Text := CurReport.ReportVersionBuild;
|
|
edtRepCreateDate.Text := DateTimeToStr(CurReport.ReportCreateDate);
|
|
edtRepLastChangeDate.Text := DateTimeToStr(CurReport.ReportLastChange);
|
|
if ShowModal = mrOk then
|
|
begin
|
|
CurReport.PrintToDefault := not CB1.Checked;
|
|
CurReport.DoublePass := CB2.Checked;
|
|
CurReport.ChangePrinter(Prn.PrinterIndex, ListBox1.ItemIndex);
|
|
{$IFDEF USE_PRINTER_FONTS}
|
|
// printer may have been changed, invalidate current list of fonts
|
|
C2.Items.Clear;
|
|
{$ENDIF}
|
|
CurReport.Title:=edTitle.Text;
|
|
CurReport.Subject:=edSubject.Text;
|
|
CurReport.KeyWords:=edKeyWords.Text;
|
|
CurReport.Comments.Text:=edComments.Text;
|
|
CurReport.ReportVersionMajor:=edtMaj.Text;
|
|
CurReport.ReportVersionMinor:=edtMinor.Text;
|
|
CurReport.ReportVersionRelease:=edtRelease.Text;
|
|
CurReport.ReportVersionBuild:=edtBuild.Text;
|
|
CurReport.ReportAutor:=edAutor.Text;
|
|
Modified := True;
|
|
end;
|
|
CurPage := CurPage;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N14Click(Sender: TObject); // grid menu
|
|
var
|
|
DesOptionsForm: TfrDesOptionsForm;
|
|
begin
|
|
DesOptionsForm := TfrDesOptionsForm.Create(nil);
|
|
with DesOptionsForm do
|
|
begin
|
|
CB1.Checked := ShowGrid;
|
|
CB2.Checked := GridAlign;
|
|
case GridSize of
|
|
4: RB1.Checked := True;
|
|
8: RB2.Checked := True;
|
|
18: RB3.Checked := True;
|
|
end;
|
|
if ShapeMode = smFrame then
|
|
RB4.Checked := True
|
|
else
|
|
RB5.Checked := True;
|
|
|
|
case Units of
|
|
ruPixels: RB6.Checked := True;
|
|
ruMM: RB7.Checked := True;
|
|
ruInches: RB8.Checked := True;
|
|
end;
|
|
|
|
//CB3.Checked := not GrayedButtons;
|
|
CB4.Checked := EditAfterInsert;
|
|
CB5.Checked := ShowBandTitles;
|
|
|
|
DesOptionsForm.ComboBox2.Text:=edtScriptFontName;
|
|
DesOptionsForm.SpinEdit2.Value:=edtScriptFontSize;
|
|
|
|
if ShowModal = mrOk then
|
|
begin
|
|
ShowGrid := CB1.Checked;
|
|
GridAlign := CB2.Checked;
|
|
if RB1.Checked then
|
|
GridSize := 4
|
|
else if RB2.Checked then
|
|
GridSize := 8
|
|
else
|
|
GridSize := 18;
|
|
if RB4.Checked then
|
|
ShapeMode := smFrame
|
|
else
|
|
ShapeMode := smAll;
|
|
if RB6.Checked then
|
|
Units := ruPixels
|
|
else if RB7.Checked then
|
|
Units := ruMM
|
|
else
|
|
Units := ruInches;
|
|
//GrayedButtons := not CB3.Checked;
|
|
EditAfterInsert := CB4.Checked;
|
|
ShowBandTitles := CB5.Checked;
|
|
|
|
edtScriptFontName:=DesOptionsForm.ComboBox2.Text;
|
|
edtScriptFontSize:=DesOptionsForm.SpinEdit2.Value;
|
|
|
|
RedrawPage;
|
|
SaveState;
|
|
end;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.GB1Click(Sender: TObject);
|
|
begin
|
|
ShowGrid := GB1.Down;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ScrollBox1DragDrop(Sender, Source: TObject; X,
|
|
Y: Integer);
|
|
var
|
|
Control :TControl;
|
|
t : TfrCustomMemoView;
|
|
dx, dy:integer;
|
|
begin
|
|
Control:=lrDesignAcceptDrag(Source);
|
|
if Assigned(lrFieldsList) and ((Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList)) then
|
|
begin
|
|
|
|
{ Objects.Add(frCreateObject(gtMemo, '', Page));
|
|
t:=TfrCustomMemoView(Objects.Last);}
|
|
t:=frCreateObject(gtMemo, '', Page) as TfrCustomMemoView;
|
|
if Assigned(t) then
|
|
begin
|
|
t.MonitorFontChanges;
|
|
t.Memo.Text:='['+lrFieldsList.SelectedField+']';
|
|
|
|
t.CreateUniqueName;
|
|
t.Canvas:=Canvas;
|
|
|
|
GetDefaultSize(dx, dy);
|
|
|
|
t.x := X;
|
|
t.y := Y;
|
|
t.dx := DX;
|
|
t.dy := DY;
|
|
|
|
{$ifdef ppaint}
|
|
PageView.NPEraseSelection;
|
|
{$endif}
|
|
Unselect;
|
|
|
|
t.FrameWidth := LastFrameWidth;
|
|
t.FrameColor := LastFrameColor;
|
|
t.FillColor := LastFillColor;
|
|
t.Selected := True;
|
|
|
|
if t.Typ <> gtBand then
|
|
t.Frames:=LastFrames;
|
|
|
|
t.Font.Name := LastFontName;
|
|
t.Font.Size := LastFontSize;
|
|
t.Font.Color := LastFontColor;
|
|
t.Font.Style := frSetFontStyle(LastFontStyle);
|
|
t.Adjust := LastAdjust;
|
|
|
|
SelNum := 1;
|
|
PageView.NPRedrawViewCheckBand(t);
|
|
|
|
SelectionChanged;
|
|
AddUndoAction(acInsert);
|
|
|
|
if Page is TfrPageReport then
|
|
OB1.Down := True
|
|
else
|
|
OB7.Down := True
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.ScrollBox1DragOver(Sender, Source: TObject; X,
|
|
Y: Integer; State: TDragState; var Accept: Boolean);
|
|
var
|
|
Control :TControl;
|
|
begin
|
|
Accept:= false;
|
|
if Page is TfrPageDialog then Exit;
|
|
Control:=lrDesignAcceptDrag(Source);
|
|
if Assigned(lrFieldsList) then
|
|
Accept:= (Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.tlsDBFieldsExecute(Sender: TObject);
|
|
begin
|
|
if Assigned(lrFieldsList) then
|
|
FreeThenNil(lrFieldsList)
|
|
else
|
|
lrFieldsList:=TlrFieldsList.Create(Self);
|
|
tlsDBFields.Checked:=Assigned(lrFieldsList);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.GB2Click(Sender: TObject);
|
|
begin
|
|
GridAlign := GB2.Down;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.GB3Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
begin
|
|
AddUndoAction(acEdit);
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
begin
|
|
t.x := Round(t.x / GridSize) * GridSize;
|
|
t.y := Round(t.y / GridSize) * GridSize;
|
|
t.dx := Round(t.dx / GridSize) * GridSize;
|
|
t.dy := Round(t.dy / GridSize) * GridSize;
|
|
if t.dx = 0 then t.dx := GridSize;
|
|
if t.dy = 0 then t.dy := GridSize;
|
|
end;
|
|
end;
|
|
RedrawPage;
|
|
ShowPosition;
|
|
PageView.GetMultipleSelected;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Tab1Change(Sender: TObject);
|
|
begin
|
|
if not fInBuildPage and (Tab1.TabIndex>=0) and (CurPage<>Tab1.TabIndex) then
|
|
CurPage := Tab1.TabIndex;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Popup1Popup(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t, t1: TfrView;
|
|
fl: Boolean;
|
|
begin
|
|
DeleteMenuItems(N2.Parent);
|
|
EnableControls;
|
|
|
|
while Popup1.Items.Count > 7 do
|
|
Popup1.Items.Delete(7);
|
|
|
|
if SelNum = 1 then
|
|
begin
|
|
DefineExtraPopupSelected(Popup1);
|
|
TfrView(Objects[TopSelected]).DefinePopupMenu(Popup1);
|
|
end
|
|
else
|
|
if SelNum > 1 then
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
fl := True;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t1 := TfrView(Objects[i]);
|
|
if t1.Selected then
|
|
if not (((t is TfrCustomMemoView) and (t1 is TfrCustomMemoView)) 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;
|
|
|
|
FillMenuItems(N2.Parent);
|
|
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 := ObjInsp.Visible;
|
|
Pan6.Checked := Panel5.Visible;
|
|
Pan7.Checked := Panel6.Visible;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Pan2Click(Sender: TObject);
|
|
|
|
procedure SetShow(c: Array of TWinControl; i: Integer; b: Boolean);
|
|
begin
|
|
if c[i] is TPanel then
|
|
begin
|
|
with c[i] as TPanel do
|
|
begin
|
|
Visible:=b;
|
|
{if IsFloat then
|
|
FloatWindow.Visible := b
|
|
else
|
|
begin
|
|
if b then
|
|
AddToDock(Parent as TPanel);
|
|
Visible := b;
|
|
(Parent as TPanel).AdjustBounds;
|
|
end; }
|
|
end;
|
|
end
|
|
else TForm(c[i]).Visible:=b;
|
|
end;
|
|
|
|
begin // each toolbar
|
|
with Sender as TMenuItem do
|
|
begin
|
|
Checked := not Checked;
|
|
SetShow([Panel1, Panel2, Panel3, Panel4, Panel5, ObjInsp, Panel6], Tag, Checked);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N34Click(Sender: TObject);
|
|
begin // about box
|
|
frAboutForm := TfrAboutForm.Create(nil);
|
|
frAboutForm.ShowModal;
|
|
frAboutForm.Free;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Tab1MouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
GetCursorPos(p{%H-});
|
|
|
|
if Button = mbRight then
|
|
Popup2.PopUp(p.X,p.Y);
|
|
|
|
//**
|
|
{if Button = mbRight then
|
|
TrackPopupMenu(Popup2.Handle,
|
|
TPM_LEFTALIGN or TPM_RIGHTBUTTON, p.X, p.Y, 0, Handle, nil);
|
|
}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.frDesignerFormClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
ObjInsp.ShowHint := False;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.frDesignerFormCloseQuery(Sender: TObject;
|
|
var CanClose: boolean);
|
|
var
|
|
Res:integer;
|
|
begin
|
|
// if FileModified and (CurReport<>nil) and
|
|
if (not PreparedReportEditor) and Modified and (CurReport<>nil) and
|
|
(not ((csDesigning in CurReport.ComponentState) and CurReport.StoreInForm)) then
|
|
begin
|
|
Res:=Application.MessageBox(PChar(sSaveChanges + ' ' + sTo + ' ' + ExtractFileName(CurDocName) + '?'),
|
|
PChar(sConfirm), mb_IconQuestion + mb_YesNoCancel);
|
|
|
|
case Res of
|
|
mrNo:
|
|
begin
|
|
CanClose := True;
|
|
// FileModified := False; // no means don't want changes
|
|
Modified := False; // no means don't want changes
|
|
ModalResult := mrCancel;
|
|
end;
|
|
mrYes:
|
|
begin
|
|
FileSave.Execute;
|
|
// FileBtn3Click(nil);
|
|
// CanClose := not FileModified;
|
|
CanClose := not Modified;
|
|
end;
|
|
else
|
|
CanClose := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
// state storing/retrieving
|
|
const
|
|
rsGridShow = 'GridShow';
|
|
rsGridAlign = 'GridAlign';
|
|
rsGridSize = 'GridSize';
|
|
rsUnits = 'Units';
|
|
rsButtons = 'GrayButtons';
|
|
rsEdit = 'EditAfterInsert';
|
|
rsSelection = 'Selection';
|
|
|
|
|
|
procedure TfrDesignerForm.SaveState;
|
|
var
|
|
Ini:TIniFile;
|
|
|
|
procedure DoSaveToolbars(t: Array of TPanel);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(t) to High(t) do
|
|
begin
|
|
{ if FirstInstance or (t[i] <> Panel6) then
|
|
SaveToolbarPosition(t[i]);
|
|
t[i].IsVisible:= False;}
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Ini:=TIniFile.Create(IniFileName);
|
|
Ini.WriteString('frEditorForm', 'ScriptFontName', edtScriptFontName);
|
|
Ini.WriteInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
|
|
|
|
Ini.WriteBool('frEditorForm', rsGridShow, ShowGrid);
|
|
Ini.WriteBool('frEditorForm', rsGridAlign, GridAlign);
|
|
Ini.WriteInteger('frEditorForm', rsGridSize, GridSize);
|
|
Ini.WriteInteger('frEditorForm', rsUnits, Word(Units));
|
|
Ini.WriteBool('frEditorForm', rsButtons, GrayedButtons);
|
|
Ini.WriteBool('frEditorForm', rsEdit, EditAfterInsert);
|
|
Ini.WriteInteger('frEditorForm', rsSelection, Integer(ShapeMode));
|
|
|
|
DoSaveToolbars([Panel1, Panel2, Panel3, Panel4, Panel5, Panel6]);
|
|
|
|
// Save ObjInsp Position
|
|
Ini.WriteInteger('ObjInsp', 'Left', ObjInsp.Left);
|
|
Ini.WriteInteger('ObjInsp', 'Top', ObjInsp.Top);
|
|
{ if SpeedButton1.Caption = '+' then
|
|
Ini.WriteInteger('Position', 'Height', FLastHeight)
|
|
else
|
|
Ini.WriteInteger('Position', 'Height', Height);}
|
|
Ini.WriteInteger('ObjInsp', 'Width', ObjInsp.Width);
|
|
Ini.WriteBool('ObjInsp', 'Visible', ObjInsp.Visible);
|
|
|
|
Ini.Free;
|
|
// ObjInsp.Visible:=False;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.RestoreState;
|
|
var
|
|
Ini:TIniFile;
|
|
|
|
{var
|
|
Ini: TRegIniFile;
|
|
Nm: String;
|
|
|
|
//** procedure DoRestoreToolbars(t: Array of TPanel);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(t) to High(t) do
|
|
RestoreToolbarPosition(t[i]);
|
|
end;
|
|
}
|
|
begin
|
|
if FileExistsUTF8(IniFileName) then
|
|
begin
|
|
Ini:=TIniFile.Create(IniFileName);
|
|
edtScriptFontName:=Ini.ReadString('frEditorForm', 'ScriptFontName', edtScriptFontName);
|
|
edtScriptFontSize:=Ini.ReadInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
|
|
GridSize := Ini.ReadInteger('frEditorForm', rsGridSize, 4);
|
|
GridAlign := Ini.ReadBool('frEditorForm', rsGridAlign, True);
|
|
ShowGrid := Ini.ReadBool('frEditorForm', rsGridShow, True);
|
|
Units := TfrReportUnits(Ini.ReadInteger('frEditorForm', rsUnits, 0));
|
|
// GrayedButtons := Ini.ReadBool('frEditorForm', rsButtons, False);
|
|
EditAfterInsert := Ini.ReadBool('frEditorForm', rsEdit, True);
|
|
ShapeMode := TfrShapeMode(Ini.ReadInteger('frEditorForm', rsSelection, 1));
|
|
|
|
ObjInsp.Left:=Ini.ReadInteger('ObjInsp', 'Left', ObjInsp.Left);
|
|
ObjInsp.Top:=Ini.ReadInteger('ObjInsp', 'Top', ObjInsp.Top);
|
|
{ if SpeedButton1.Caption = '+' then
|
|
Ini.WriteInteger('Position', 'Height', FLastHeight)
|
|
else
|
|
Ini.WriteInteger('Position', 'Height', Height);}
|
|
ObjInsp.Width:=Ini.ReadInteger('ObjInsp', 'Width', ObjInsp.Width);
|
|
ObjInsp.Visible:=Ini.ReadBool('ObjInsp', 'Visible', ObjInsp.Visible);
|
|
|
|
Ini.Free;
|
|
end;
|
|
|
|
{ Ini := TRegIniFile.Create(RegRootKey);
|
|
Nm := rsForm + Name;
|
|
Ini.Free;
|
|
//** 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(InspForm);
|
|
}
|
|
//TODO: restore ObjInsp position and size
|
|
(*
|
|
GridSize := 4;
|
|
GridAlign := True;
|
|
ShowGrid := False; //True;
|
|
Units := TfrReportUnits(0);
|
|
//GrayedButtons := True; //False;
|
|
EditAfterInsert := True;
|
|
ShapeMode := TfrShapeMode(1);
|
|
*)
|
|
|
|
if Panel6.Height < 26 then
|
|
Panel6.Height := 26;
|
|
if Panel6.Width < 26 then
|
|
Panel6.Width := 26;
|
|
if Panel6.ControlCount < 2 then
|
|
Panel6.Hide;
|
|
end;
|
|
|
|
|
|
{----------------------------------------------------------------------------}
|
|
// menu bitmaps
|
|
procedure TfrDesignerForm.SetMenuBitmaps;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
MaxItemWidth := 0; MaxShortCutWidth := 0;
|
|
|
|
FillMenuItems(FileMenu);
|
|
FillMenuItems(EditMenu);
|
|
FillMenuItems(ToolMenu);
|
|
FillMenuItems(HelpMenu);
|
|
|
|
SetMenuItemBitmap(N23, FileBtn1);
|
|
// SetMenuItemBitmap(N19, FileBtn2);
|
|
// SetMenuItemBitmap(N20, FileBtn3);
|
|
// SetMenuItemBitmap(N39, FileBtn4);
|
|
SetMenuItemBitmap(N10, ExitB);
|
|
|
|
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);
|
|
{
|
|
for i := 0 to Panel6.ControlCount-1 - 1 do
|
|
begin
|
|
if Panel6.Controls[i] is TSpeedButton then
|
|
SetMenuItemBitmap(MastMenu.Items[i], Panel6.Controls[i] as TSpeedButton);
|
|
end;
|
|
}
|
|
SetMenuItemBitmap(N41, PgB1);
|
|
SetMenuItemBitmap(N43, PgB2);
|
|
SetMenuItemBitmap(N44, PgB3);
|
|
end;
|
|
|
|
function TfrDesignerForm.FindMenuItem(AMenuItem: TMenuItem): TfrMenuItemInfo;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
for i := 0 to MenuItems.Count - 1 do
|
|
if TfrMenuItemInfo(MenuItems[i]).MenuItem = AMenuItem then
|
|
begin
|
|
Result := TfrMenuItemInfo(MenuItems[i]);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SetMenuItemBitmap(AMenuItem: TMenuItem; ABtn: TSpeedButton);
|
|
var
|
|
m: TfrMenuItemInfo;
|
|
begin
|
|
m := FindMenuItem(AMenuItem);
|
|
if m = nil then
|
|
begin
|
|
m := TfrMenuItemInfo.Create;
|
|
m.MenuItem := AMenuItem;
|
|
MenuItems.Add(m);
|
|
end;
|
|
m.Btn := ABtn;
|
|
//**
|
|
{ ModifyMenu(AMenuItem.Parent.Handle, AMenuItem.MenuIndex,
|
|
MF_BYPOSITION + MF_OWNERDRAW, AMenuItem.Command, nil);
|
|
}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FillMenuItems(MenuItem: TMenuItem);
|
|
var
|
|
i: Integer;
|
|
m: TMenuItem;
|
|
begin
|
|
for i := 0 to MenuItem.Count - 1 do
|
|
begin
|
|
m := MenuItem.Items[i];
|
|
SetMenuItemBitmap(m, nil);
|
|
if m.Count > 0 then FillMenuItems(m);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DeleteMenuItems(MenuItem: TMenuItem);
|
|
var
|
|
i, j: Integer;
|
|
m: TMenuItem;
|
|
begin
|
|
for i := 0 to MenuItem.Count - 1 do
|
|
begin
|
|
m := MenuItem.Items[i];
|
|
for j := 0 to MenuItems.Count - 1 do
|
|
if TfrMenuItemInfo(MenuItems[j]).MenuItem = m then
|
|
begin
|
|
TfrMenuItemInfo(MenuItems[j]).Free;
|
|
MenuItems.Delete(j);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DoDrawText(aCanvas: TCanvas; aCaption: string;
|
|
Rect: TRect; Selected, aEnabled: Boolean; Flags: Longint);
|
|
begin
|
|
with aCanvas do
|
|
begin
|
|
Brush.Style := bsClear;
|
|
if not aEnabled then
|
|
begin
|
|
if not Selected then
|
|
begin
|
|
OffsetRect(Rect, 1, 1);
|
|
Font.Color := clBtnHighlight;
|
|
DrawText(Handle, PChar(Caption), Length(Caption), Rect, Flags);
|
|
OffsetRect(Rect, -1, -1);
|
|
end;
|
|
Font.Color := clBtnShadow;
|
|
end;
|
|
DrawText(Handle, PChar(aCaption), Length(aCaption), Rect, Flags);
|
|
|
|
Brush.Style := bsSolid;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.DrawItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
|
|
ARect: TRect; Selected: Boolean);
|
|
var
|
|
GlyphRect: TRect;
|
|
Btn: TSpeedButton;
|
|
Glyph: TBitmap;
|
|
begin
|
|
MaxItemWidth := 0;
|
|
MaxShortCutWidth := 0;
|
|
with ACanvas do
|
|
begin
|
|
if Selected then
|
|
begin
|
|
Brush.Color := clHighlight;
|
|
Font.Color := clHighlightText
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color := clMenu;
|
|
Font.Color := clMenuText;
|
|
end;
|
|
if AMenuItem.Caption <> '-' then
|
|
begin
|
|
FillRect(ARect);
|
|
Btn := FindMenuItem(AMenuItem).Btn;
|
|
GlyphRect := Bounds(ARect.Left + 1, ARect.Top + (ARect.Bottom - ARect.Top - 16) div 2, 16, 16);
|
|
|
|
if AMenuItem.Checked then
|
|
begin
|
|
Glyph := TBitmap.Create;
|
|
if AMenuItem.RadioItem then
|
|
begin
|
|
// todo
|
|
//** Glyph.Handle := LoadBitmap(hInstance, 'FR_RADIO');
|
|
//BrushCopy(GlyphRect, Glyph, Rect(0, 0, 16, 16), Glyph.TransparentColor);
|
|
end
|
|
else
|
|
begin
|
|
//** Glyph.Handle := LoadBitmap(hInstance, 'FR_CHECK');
|
|
Draw(GlyphRect.Left, GlyphRect.Top, Glyph);
|
|
end;
|
|
Glyph.Free;
|
|
end
|
|
else if Btn <> nil then
|
|
begin
|
|
Glyph := TBitmap.Create;
|
|
Glyph.Width := 16; Glyph.Height := 16;
|
|
// todo
|
|
//** Btn.DrawGlyph(Glyph.Canvas, 0, 0, AMenuItem.Enabled);
|
|
//BrushCopy(GlyphRect, Glyph, Rect(0, 0, 16, 16), Glyph.TransparentColor);
|
|
Glyph.Free;
|
|
end;
|
|
ARect.Left := GlyphRect.Right + 4;
|
|
end;
|
|
|
|
if AMenuItem.Caption <> '-' then
|
|
begin
|
|
OffsetRect(ARect, 0, 2);
|
|
DoDrawText(ACanvas, AMenuItem.Caption, ARect, Selected, AMenuItem.Enabled, DT_LEFT);
|
|
if AMenuItem.ShortCut <> 0 then
|
|
begin
|
|
ARect.Left := StrToInt(ItemWidths.Values[AMenuItem.Parent.Name]) + 6;
|
|
DoDrawText(ACanvas, ShortCutToText(AMenuItem.ShortCut), ARect,
|
|
Selected, AMenuItem.Enabled, DT_LEFT);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Inc(ARect.Top, 4);
|
|
DrawEdge(Handle, ARect, EDGE_ETCHED, BF_TOP);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.MeasureItem(AMenuItem: TMenuItem; ACanvas: TCanvas;
|
|
var AWidth, AHeight: Integer);
|
|
var
|
|
w: Integer;
|
|
begin
|
|
w := ACanvas.TextWidth(AMenuItem.Caption) + 31;
|
|
if MaxItemWidth < w then
|
|
MaxItemWidth := w;
|
|
ItemWidths.Values[AMenuItem.Parent.Name] := IntToStr(MaxItemWidth);
|
|
|
|
if AMenuItem.ShortCut <> 0 then
|
|
begin
|
|
w := ACanvas.TextWidth(ShortCutToText(AMenuItem.ShortCut)) + 15;
|
|
if MaxShortCutWidth < w then
|
|
MaxShortCutWidth := w;
|
|
end;
|
|
|
|
if frGetWindowsVersion = '98' then
|
|
AWidth := MaxItemWidth
|
|
else
|
|
AWidth := MaxItemWidth + MaxShortCutWidth;
|
|
if AMenuItem.Caption <> '-' then
|
|
AHeight := 19 else
|
|
AHeight := 10;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.WndProc(var Message: TLMessage);
|
|
//var
|
|
//MenuItem: TMenuItem;
|
|
//CCanvas: TCanvas;
|
|
|
|
function FindItem(ItemId: Integer): TMenuItem;
|
|
begin
|
|
Result := MainMenu1.FindItem(ItemID, fkCommand);
|
|
if Result = nil then
|
|
Result := Popup1.FindItem(ItemID, fkCommand);
|
|
if Result = nil then
|
|
Result := Popup2.FindItem(ItemID, fkCommand);
|
|
end;
|
|
|
|
begin
|
|
case Message.Msg of
|
|
LM_COMMAND:
|
|
if Popup1.DispatchCommand(Message.wParam) or
|
|
Popup2.DispatchCommand(Message.wParam) then Exit;
|
|
//**
|
|
{ LM_INITMENUPOPUP:
|
|
with TWMInitMenuPopup(Message) do
|
|
if Popup1.DispatchPopup(MenuPopup) or
|
|
Popup2.DispatchPopup(MenuPopup) then Exit;
|
|
}
|
|
(*
|
|
LM_DRAWITEM:
|
|
with PDrawItemStruct(Message.LParam)^ do
|
|
begin
|
|
if (CtlType = ODT_MENU) and (Message.WParam = 0) then
|
|
begin
|
|
MenuItem := FindItem(ItemId);
|
|
if MenuItem <> nil then
|
|
begin
|
|
CCanvas := TControlCanvas.Create;
|
|
with CCanvas do
|
|
begin
|
|
Handle := _hDC;
|
|
DrawItem(MenuItem, CCanvas, rcItem, ItemState{//** and ODS_SELECTED} <> 0);
|
|
Free;
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
LM_MEASUREITEM:
|
|
with PMeasureItemStruct(Message.LParam)^ do
|
|
begin
|
|
if (CtlType = ODT_MENU) and (Message.WParam = 0) then
|
|
begin
|
|
MenuItem := FindItem(ItemId);
|
|
if MenuItem <> nil then
|
|
begin
|
|
MeasureItem(MenuItem, Canvas, Integer(ItemWidth), Integer(ItemHeight));
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
end;
|
|
inherited WndProc(Message);
|
|
end;
|
|
|
|
|
|
{----------------------------------------------------------------------------}
|
|
// alignment palette
|
|
function GetFirstSelected: TfrView;
|
|
begin
|
|
if TfrDesignerForm(frDesigner).FirstSelected <> nil then
|
|
Result := TfrDesignerForm(frDesigner).FirstSelected
|
|
else
|
|
Result :=TfrView(Objects[TopSelected]);
|
|
end;
|
|
|
|
function GetLeftObject: Integer;
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
x: Integer;
|
|
begin
|
|
t := TfrView(Objects[TopSelected]);
|
|
x := t.x;
|
|
Result := TopSelected;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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 :=TfrView(Objects[TopSelected]);
|
|
x := t.x + t.dx;
|
|
Result := TopSelected;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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 := TfrView(Objects[TopSelected]);
|
|
y := t.y;
|
|
Result := TopSelected;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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 := TfrView(Objects[TopSelected]);
|
|
y := t.y + t.dy;
|
|
Result := TopSelected;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
x := t.x;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.x := x;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align6Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
y: Integer;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
y := t.y;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.y := y;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align5Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
x: Integer;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
x := t.x+t.dx;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.x := x - t.dx;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align10Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
y: Integer;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
y := t.y + t.dy;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.y := y - t.dy;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align2Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
x: Integer;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
x := t.x + t.dx div 2;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.x := x - t.dx div 2;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align7Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
y: Integer;
|
|
begin
|
|
if SelNum < 2 then Exit;
|
|
BeforeChange;
|
|
t := GetFirstSelected;
|
|
y := t.y + t.dy div 2;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
t.y := y - t.dy div 2;
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align3Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
x: Integer;
|
|
begin
|
|
if SelNum = 0 then Exit;
|
|
BeforeChange;
|
|
t := TfrView(Objects[GetLeftObject]);
|
|
x := t.x;
|
|
t := TfrView(Objects[GetRightObject]);
|
|
x := x + (t.x + t.dx - x - Page.PrnInfo.Pgw) div 2;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then Dec(t.x, x);
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align8Click(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
y: Integer;
|
|
begin
|
|
if SelNum = 0 then Exit;
|
|
BeforeChange;
|
|
t := TfrView(Objects[GetTopObject]);
|
|
y := t.y;
|
|
t := TfrView(Objects[GetBottomObject]);
|
|
y := y + (t.y + t.dy - y - Page.PrnInfo.Pgh) div 2;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then Dec(t.y, y);
|
|
end;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align4Click(Sender: TObject);
|
|
var
|
|
s: TStringList;
|
|
i, dx: Integer;
|
|
t: TfrView;
|
|
begin
|
|
if SelNum < 3 then Exit;
|
|
BeforeChange;
|
|
s := TStringList.Create;
|
|
s.Sorted := True;
|
|
s.Duplicates := dupAccept;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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
|
|
TfrView(s.Objects[i]).x := TfrView(s.Objects[i-1]).x + dx;
|
|
s.Free;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.Align9Click(Sender: TObject);
|
|
var
|
|
s: TStringList;
|
|
i, dy: Integer;
|
|
t: TfrView;
|
|
begin
|
|
if SelNum < 3 then Exit;
|
|
BeforeChange;
|
|
s := TStringList.Create;
|
|
s.Sorted := True;
|
|
s.Duplicates := dupAccept;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(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
|
|
TfrView(s.Objects[i]).y := TfrView(s.Objects[i - 1]).y + dy;
|
|
s.Free;
|
|
PageView.GetMultipleSelected;
|
|
RedrawPage;
|
|
end;
|
|
|
|
|
|
{----------------------------------------------------------------------------}
|
|
// miscellaneous
|
|
function Objects: TFpList;
|
|
begin
|
|
if Assigned(frDesigner) and Assigned(frDesigner.Page) then
|
|
Result := frDesigner.Page.Objects
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure frSetGlyph(aColor: TColor; sb: TSpeedButton; n: Integer);
|
|
var
|
|
b : TBitmap;
|
|
s : TMemoryStream;
|
|
r : TRect;
|
|
t : TfrView;
|
|
i : Integer;
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLn('frSetGlyph(%s,%s,%d)',[colortostring(acolor),sb.Name,n]);
|
|
DebugLn('ColorLocked=%s sb.tag=%s',[dbgs(ColorLocked),dbgs(sb.tag)]);
|
|
{$ENDIF}
|
|
B:=sb.Glyph;
|
|
b.Width := 32;
|
|
b.Height:= 16;
|
|
with b.Canvas do
|
|
begin
|
|
b.Canvas.Handle; // force handle creation
|
|
Brush.Color:=clWhite;
|
|
FillRect(ClipRect);
|
|
r := Rect(n * 32, 0, n * 32 + 32, 16);
|
|
CopyRect(Rect(0, 0, 32, 16),
|
|
TfrDesignerForm(frDesigner).Image1.Picture.Bitmap.Canvas, r);
|
|
// JRA: workaround for copyrect not using transparency
|
|
// and bitmap using transparency only on reading stream
|
|
S := TMemorystream.Create;
|
|
B.SaveToStream(S);
|
|
S.Position:=0;
|
|
B.Transparent := True;
|
|
B.LoadFromStream(S);
|
|
S.Free;
|
|
|
|
if aColor = clNone then
|
|
begin
|
|
Brush.Color:=clBtnFace;
|
|
Pen.Color :=clBtnFace;
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color:=aColor;
|
|
Pen.Color:=aColor;
|
|
end;
|
|
Rectangle(Rect(0,12,15,15));
|
|
end;
|
|
|
|
i:=TopSelected;
|
|
if (i>-1) and not ColorLocked then
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
{$IFDEF DebugLR}
|
|
DebugLn('frSetGlyph: TopSelected=%s', [t.Name]);
|
|
{$ENDIF}
|
|
|
|
Case Sb.Tag of
|
|
5 : t.FillColor:=aColor; {ClB1}
|
|
17 : if (t is TfrCustomMemoView) then {ClB2}
|
|
TfrCustomMemoView(t).Font.Color:=aColor;
|
|
19 : t.FrameColor:=aColor; {ClB3}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TopSelected: Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Assigned(Objects) then
|
|
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
|
|
else
|
|
Result:=-1;
|
|
end;
|
|
|
|
function frCheckBand(b: TfrBandType): Boolean;
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Typ = gtBand then
|
|
if b = TfrBandView(t).BandType 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 := TfrView(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 := TfrView(Objects[i]);
|
|
if (t.Typ = gtBand) and (TfrBandView(t).BandType = 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 := TfrView(Objects[i]);
|
|
if (t.Typ = gtBand) and
|
|
(TfrBandView(t).BandType in [btCrossHeader..btCrossFooter]) then
|
|
begin
|
|
Objects.Delete(i);
|
|
Objects.Insert(k - 1, t);
|
|
end
|
|
else Inc(i);
|
|
Inc(j);
|
|
end;
|
|
end;
|
|
|
|
procedure ClearClipBoard;
|
|
var
|
|
t: TfrView;
|
|
begin
|
|
if Assigned(ClipBd) then
|
|
with ClipBd do
|
|
while Count > 0 do
|
|
begin
|
|
t := TfrView(Items[0]);
|
|
t.Free;
|
|
Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure GetRegion;
|
|
var
|
|
i: Integer;
|
|
t: TfrView;
|
|
R,R1: HRGN;
|
|
begin
|
|
ClipRgn := CreateRectRgn(0, 0, 0, 0);
|
|
for i := 0 to Objects.Count - 1 do
|
|
begin
|
|
t := TfrView(Objects[i]);
|
|
if t.Selected then
|
|
begin
|
|
R := t.GetClipRgn(rtExtended);
|
|
R1:=CreateRectRgn(0, 0, 0, 0);
|
|
CombineRgn(ClipRgn, R1, R, RGN_OR);
|
|
DeleteObject(R);
|
|
DeleteObject(R1);
|
|
end;
|
|
end;
|
|
FirstChange := False;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.GetDefaultSize(var dx, dy: Integer);
|
|
begin
|
|
dx := 96;
|
|
if GridSize = 18 then dx := 18 * 6;
|
|
dy := 18;
|
|
if GridSize = 18 then dy := 18;
|
|
if LastFontSize in [12, 13] then dy := 20;
|
|
if LastFontSize in [14..16] then dy := 24;
|
|
end;
|
|
|
|
|
|
procedure TfrDesignerForm.SB1Click(Sender: TObject);
|
|
var
|
|
d: Double;
|
|
begin
|
|
d := StrToFloat(E1.Text);
|
|
d := d + 1;
|
|
E1.Text := FloatToStrF(d, ffGeneral, 2, 2);
|
|
DoClick(E1);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.SB2Click(Sender: TObject);
|
|
var
|
|
d: Double;
|
|
begin
|
|
d := StrToFloat(E1.Text);
|
|
d := d - 1;
|
|
if d <= 0 then d := 1;
|
|
E1.Text := FloatToStrF(d, ffGeneral, 2, 2);
|
|
DoClick(E1);
|
|
end;
|
|
|
|
{type
|
|
THackBtn = class(TSpeedButton);
|
|
}
|
|
|
|
procedure TfrDesignerForm.HelpBtnClick(Sender: TObject);
|
|
begin
|
|
HelpBtn.Down := True;
|
|
Screen.Cursor := crHelp;
|
|
SetCaptureControl(Self);
|
|
//** THackBtn(HelpBtn).FMouseInControl := False;
|
|
HelpBtn.Invalidate;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.FormMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
c: TControl;
|
|
t: Integer;
|
|
begin
|
|
if HelpBtn.Down and (GetCaptureControl=Self) then
|
|
SetCaptureControl(nil);
|
|
HelpBtn.Down := False;
|
|
Screen.Cursor := crDefault;
|
|
c := FindControlAtPosition(Mouse.CursorPos, true);
|
|
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);
|
|
//DebugLn('TODO: HelpContext for tag=%d',[t]);
|
|
//** Application.HelpCommand(HELP_CONTEXTPOPUP, t);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrDesignerForm.N22Click(Sender: TObject);
|
|
begin
|
|
//** Application.HelpCommand(HELP_FINDER, 0);
|
|
end;
|
|
|
|
procedure TfrDesignerForm.OnActivateApp(Sender: TObject);
|
|
|
|
procedure SetWinZOrder(Form: TForm);
|
|
begin
|
|
SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
|
|
SWP_NOSIZE or SWP_NOACTIVATE);
|
|
end;
|
|
begin
|
|
// SetWinZOrder(InspForm);
|
|
{//**
|
|
if Panel1.IsFloat then SetWinZOrder(Panel1.FloatWindow);
|
|
if Panel2.IsFloat then SetWinZOrder(Panel2.FloatWindow);
|
|
if Panel3.IsFloat then SetWinZOrder(Panel3.FloatWindow);
|
|
if Panel4.IsFloat then SetWinZOrder(Panel4.FloatWindow);
|
|
if Panel5.IsFloat then SetWinZOrder(Panel5.FloatWindow);
|
|
if Panel6.IsFloat then SetWinZOrder(Panel6.FloatWindow);
|
|
}
|
|
end;
|
|
|
|
procedure TfrDesignerForm.OnDeactivateApp(Sender: TObject);
|
|
|
|
procedure SetWinZOrder(Form: TForm);
|
|
begin
|
|
SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
|
|
SWP_NOSIZE or SWP_NOACTIVATE);
|
|
end;
|
|
|
|
begin
|
|
if not Visible then Exit;
|
|
// SetWinZOrder(InspForm);
|
|
{//**
|
|
if Panel1.IsFloat then SetWinZOrder(Panel1.FloatWindow);
|
|
if Panel2.IsFloat then SetWinZOrder(Panel2.FloatWindow);
|
|
if Panel3.IsFloat then SetWinZOrder(Panel3.FloatWindow);
|
|
if Panel4.IsFloat then SetWinZOrder(Panel4.FloatWindow);
|
|
if Panel5.IsFloat then SetWinZOrder(Panel5.FloatWindow);
|
|
if Panel6.IsFloat then SetWinZOrder(Panel6.FloatWindow);
|
|
}
|
|
end;
|
|
|
|
Procedure InitGlobalDesigner;
|
|
begin
|
|
if Assigned(frDesigner) then
|
|
Exit;
|
|
frDesigner := TfrDesignerForm.Create(nil);
|
|
end;
|
|
|
|
{ TfrPanelObjectInspector }
|
|
|
|
{$IFNDEF EXTOI}
|
|
procedure TfrObjectInspector.BtnClick(Sender: TObject);
|
|
begin
|
|
if Sender=fBtn then
|
|
begin
|
|
if fBtn.Caption='-' then
|
|
begin
|
|
fLastHeight:=Height;
|
|
Height:=fPanelHeader.Height + 2*BorderWidth + 3;
|
|
fBtn.Caption:='+';
|
|
end
|
|
else
|
|
begin
|
|
Height:=fLastHeight;
|
|
fBtn.Caption:='-';
|
|
end;
|
|
end
|
|
else Visible:=False;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.HeaderMDown(Sender: TOBject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if Button=mbLeft then
|
|
begin
|
|
fDown:=True;
|
|
if (x>4) and (x<fPanelHeader.Width-4) and (y<=16) then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
debugLn('TfrObjectInspector.HeaderMDown()');
|
|
{$ENDIF}
|
|
fPanelHeader.Cursor:=crSize;
|
|
// get absolute mouse position (X,Y can not be used, because they
|
|
// are relative to what is moving)
|
|
fPt:=Mouse.CursorPos;
|
|
//DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt)]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.HeaderMMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
NewPt: TPoint;
|
|
begin
|
|
if fDown then
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
debugLn('TfrObjectInspector.HeaderMMove()');
|
|
{$ENDIF}
|
|
|
|
Case fPanelHeader.Cursor of
|
|
crSize :
|
|
begin
|
|
NewPt:=Mouse.CursorPos;
|
|
//DebugLn(['TfrObjectInspector.HeaderMDown ',dbgs(fPt),' New=',dbgs(NewPt)]);
|
|
SetBounds(Left+NewPt.X-fPt.X,Top+NewPt.Y-fPt.Y,Width,Height);
|
|
fPt:=NewPt;
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
procedure TfrObjectInspector.HeaderMUp(Sender: TOBject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
{$IFDEF DebugLR}
|
|
DebugLn('TfrObjectInspector.HeaderMUp()');
|
|
{$ENDIF}
|
|
fDown:=False;
|
|
fPanelHeader.Cursor:=crDefault;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TfrObjectInspector.CMVisibleChanged(var TheMessage: TLMessage);
|
|
begin
|
|
Inherited CMVisibleChanged(TheMessage);
|
|
|
|
if Visible then
|
|
begin
|
|
DoOnResize;
|
|
BringToFront;
|
|
Select(Objects);
|
|
end;
|
|
{$IFDEF DebugLR}
|
|
debugLn('TfrObjectInspector.CMVisibleChanged: %s', [dbgs(Visible)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF EXTOI}
|
|
procedure TfrObjectInspector.DoHide;
|
|
begin
|
|
//TODO Uncheck Menue Item
|
|
end;
|
|
{$ENDIF}
|
|
|
|
constructor TfrObjectInspector.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
|
|
{$IFDEF EXTOI}
|
|
Width :=220;
|
|
Height :=300;
|
|
Top :=Screen.Height div 2;
|
|
Left :=40;
|
|
Visible :=False;
|
|
Caption := 'Object Inspector';
|
|
FormStyle := fsStayOnTop;
|
|
// create the ObjectInspector
|
|
fPropertyGrid:=TCustomPropertiesGrid.Create(aOwner);
|
|
with fPropertyGrid do
|
|
begin
|
|
Name :='PropertyGrid';
|
|
Parent:=Self;
|
|
align := alclient;
|
|
ShowHint:=false; //cause problems in windows
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
Parent :=TWinControl(aOwner);
|
|
Width :=220;
|
|
Height :=300;
|
|
Top :=120;
|
|
Left :=40;
|
|
Borderstyle :=bsNone;
|
|
BevelInner :=bvLowered;
|
|
BevelOuter :=bvRaised;
|
|
BorderWidth :=1;
|
|
Visible :=False;
|
|
|
|
fDown :=False;
|
|
|
|
fPanelHeader:=TPanel.Create(self);
|
|
with fPanelHeader do
|
|
begin
|
|
Parent:=Self;
|
|
Color :=clSilver;
|
|
BorderStyle:=bsNone;
|
|
BevelInner:=bvNone;
|
|
BevelOuter:=bvNone;
|
|
Caption:=sObjectInspector;
|
|
AnchorSideLeft.Control := self;
|
|
AnchorSideTop.Control := self;
|
|
AnchorSideRight.Control := self;
|
|
AnchorSideRight.Side := asrBottom;
|
|
Anchors := [akTop, akLeft, akRight];
|
|
Top := 0;
|
|
Height := 18;
|
|
OnMouseDown:=@HeaderMDown;
|
|
OnMouseMove:=@HeaderMMove;
|
|
OnMouseUp :=@HeaderMUp;
|
|
end;
|
|
|
|
fBtn2:=TButton.Create(fPanelHeader);
|
|
with fBtn2 do
|
|
begin
|
|
Parent:=fPanelHeader;
|
|
AnchorSideTop.Control := fPanelHeader;
|
|
AnchorSideRight.Control := fPanelHeader;
|
|
AnchorSideRight.Side := asrBottom;
|
|
AnchorSideBottom.Control := fPanelHeader;
|
|
AnchorSideBottom.Side := asrBottom;
|
|
Anchors := [akTop, akRight, akBottom];
|
|
BorderSpacing.Around := 1;
|
|
Width := fPanelHeader.Height - 2*BorderSpacing.Around;
|
|
Caption:='x';
|
|
TabStop:=False;
|
|
OnClick:=@BtnClick;
|
|
end;
|
|
|
|
fBtn:=TButton.Create(fPanelHeader);
|
|
with fBtn do
|
|
begin
|
|
Parent:=fPanelHeader;
|
|
AnchorSideTop.Control := fPanelHeader;
|
|
AnchorSideRight.Control := fBtn2;
|
|
AnchorSideBottom.Control := fPanelHeader;
|
|
AnchorSideBottom.Side := asrBottom;
|
|
Anchors := [akTop, akRight, akBottom];
|
|
BorderSpacing.Around := 1;
|
|
Width := fPanelHeader.Height - 2*BorderSpacing.Around;
|
|
Caption:='-';
|
|
TabStop:=False;
|
|
OnClick:=@BtnClick;
|
|
end;
|
|
|
|
|
|
fcboxObjList := TComboBox.Create(Self);
|
|
with fcboxObjList do
|
|
begin
|
|
Parent:=Self;
|
|
AnchorSideLeft.Control := Self;
|
|
AnchorSideTop.Control := fPanelHeader;
|
|
AnchorSideTop.Side := asrBottom;
|
|
AnchorSideRight.Control := self;
|
|
AnchorSideRight.Side := asrBottom;
|
|
Anchors := [akTop, akLeft, akRight];
|
|
ShowHint := false; //cause problems in windows
|
|
Onchange := @cboxObjListOnChanged;
|
|
end;
|
|
fcboxObjList.Sorted:=true;
|
|
|
|
// create the ObjectInspector
|
|
fPropertyGrid:=TCustomPropertiesGrid.Create(aOwner);
|
|
with fPropertyGrid do
|
|
begin
|
|
Name :='PropertyGrid';
|
|
Parent:=Self;
|
|
AnchorSideLeft.Control := Self;
|
|
AnchorSideTop.Control := fcboxObjList;
|
|
AnchorSideTop.Side := asrBottom;
|
|
AnchorSideRight.Control := Self;
|
|
AnchorSideRight.Side := asrBottom;
|
|
AnchorSideBottom.Control := Self;
|
|
AnchorSideBottom.Side := asrBottom;
|
|
Anchors := [akTop, akLeft, akRight, akBottom];
|
|
ShowHint:=false; //cause problems in windows
|
|
fPropertyGrid.SaveOnChangeTIObject:=false;
|
|
DefaultItemHeight := fcboxObjList.Height-3;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TfrObjectInspector.Destroy;
|
|
begin
|
|
//fPropertyGrid.Free; // it's owned by OI form/Panel
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.Select(Obj: TObject);
|
|
var
|
|
i : Integer;
|
|
NewSel : TPersistentSelectionList;
|
|
begin
|
|
if (Objects.Count <> fcboxObjList.Items.Count) or (Assigned(Obj) and (fcboxObjList.Items.IndexOfObject(Obj) < 0)) then
|
|
begin
|
|
|
|
fcboxObjList.Clear;
|
|
fcboxObjList.AddItem(TfrObject(frDesigner.Page).Name, TObject(frDesigner.Page));
|
|
|
|
for i:=0 to Objects.Count-1 do
|
|
fcboxObjList.AddItem(TfrView(Objects[i]).Name, TObject(Objects[i]));
|
|
|
|
end;
|
|
|
|
FSelectedObject:=nil;
|
|
|
|
if (Obj=nil) or (Obj is TPersistent) then
|
|
begin
|
|
FSelectedObject:=Obj;
|
|
if Obj=nil then
|
|
fPropertyGrid.Selection := nil
|
|
else
|
|
begin
|
|
fcboxObjList.ItemIndex := fcboxObjList.Items.IndexOfObject(Obj);
|
|
NewSel := TPersistentSelectionList.Create;
|
|
try
|
|
NewSel.Add(TfrView(Obj));
|
|
fPropertyGrid.Selection := NewSel;
|
|
finally
|
|
NewSel.Free;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if Obj is TFpList then
|
|
with TFpList(Obj) do
|
|
begin
|
|
NewSel:=TPersistentSelectionList.Create;
|
|
try
|
|
for i:=0 to Count-1 do
|
|
if TfrView(Items[i]).Selected then
|
|
NewSel.Add(TfrView(Items[i]));
|
|
fPropertyGrid.Selection:=NewSel;
|
|
finally
|
|
NewSel.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.cboxObjListOnChanged(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
vObj: TObject;
|
|
begin
|
|
if fcboxObjList.ItemIndex >= 0 then
|
|
begin
|
|
TfrDesignerForm(frDesigner).SelNum := 0;
|
|
for i := 0 to Objects.Count - 1 do
|
|
TfrView(Objects[i]).Selected := False;
|
|
vObj := fcboxObjList.Items.Objects[fcboxObjList.ItemIndex];
|
|
if vObj is TfrView then
|
|
begin
|
|
TfrView(vObj).Selected:=True;
|
|
TfrDesignerForm(frDesigner).SelNum := 1;
|
|
frDesigner.Invalidate;
|
|
end;
|
|
Select(vObj);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.SetModifiedEvent(AEvent: TNotifyEvent);
|
|
begin
|
|
fPropertyGrid.OnModified:=AEvent;
|
|
end;
|
|
|
|
procedure TfrObjectInspector.Refresh;
|
|
begin
|
|
if not visible then
|
|
exit;
|
|
fPropertyGrid.RefreshPropertyValues;
|
|
end;
|
|
|
|
type
|
|
{ TfrCustomMemoViewDetailReportProperty }
|
|
|
|
TfrCustomMemoViewDetailReportProperty = class(TStringProperty)
|
|
private
|
|
FSaveRep:TfrReport;
|
|
FEditView:TfrCustomMemoView;
|
|
FDetailRrep: TlrDetailReport;
|
|
procedure DoSaveReportEvent(Report: TfrReport; var ReportName: String;
|
|
SaveAs: Boolean; var Saved: Boolean);
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure Edit; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
|
|
TfrViewDataFieldProperty = class(TStringProperty)
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure Edit; override;
|
|
end;
|
|
|
|
{ TfrPictureViewDataFieldProperty }
|
|
|
|
function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := inherited GetAttributes + [paDialog{, paValueList, paSortList}];
|
|
end;
|
|
|
|
type
|
|
TfrHackView = class(TfrView);
|
|
|
|
procedure TfrViewDataFieldProperty.Edit;
|
|
begin
|
|
if (GetComponent(0) is TfrView) and Assigned(CurReport) then
|
|
begin
|
|
frFieldsForm := TfrFieldsForm.Create(Application);
|
|
try
|
|
if frFieldsForm.ShowModal = mrOk then
|
|
begin
|
|
TfrHackView(GetComponent(0)).DataField:=frFieldsForm.DBField;
|
|
frDesigner.Modified:=true;
|
|
end;
|
|
finally
|
|
frFieldsForm.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomMemoViewDetailReportProperty.DoSaveReportEvent(Report: TfrReport;
|
|
var ReportName: String; SaveAs: Boolean; var Saved: Boolean);
|
|
begin
|
|
if Assigned(FDetailRrep) then
|
|
begin
|
|
FDetailRrep.ReportBody.Size:=0;
|
|
CurReport.SaveToXMLStream(FDetailRrep.ReportBody);
|
|
FDetailRrep.ReportDescription:=CurReport.Comments.Text;
|
|
Saved:=true;
|
|
end
|
|
else
|
|
Saved:=false;
|
|
end;
|
|
|
|
function TfrCustomMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := inherited GetAttributes + [paDialog, paValueList, paSortList];
|
|
end;
|
|
|
|
procedure TfrCustomMemoViewDetailReportProperty.Edit;
|
|
var
|
|
FSaveDesigner:TfrReportDesigner;
|
|
FSaveView:TfrView;
|
|
FSaveBand: TfrBand; // currently proceeded band
|
|
FSavePage: TfrPage; // currently proceeded page
|
|
FSaveGetPValue:TGetPValueEvent;
|
|
FSaveFunEvent:TFunctionEvent;
|
|
FSaveReportEvent: TSaveReportEvent;
|
|
|
|
///***DocMode: (dmDesigning, dmPrinting); // current mode
|
|
|
|
begin
|
|
if (GetComponent(0) is TfrCustomMemoView) and Assigned(CurReport) then
|
|
begin
|
|
FEditView:=GetComponent(0) as TfrCustomMemoView;
|
|
|
|
if FEditView.DetailReport = '' then
|
|
FEditView.DetailReport:=FEditView.Name + '_DetailReport';
|
|
FDetailRrep:=CurReport.DetailReports.Add(FEditView.DetailReport);
|
|
if not Assigned(FDetailRrep) then exit;
|
|
|
|
FSaveGetPValue:=frParser.OnGetValue;
|
|
FSaveFunEvent:=frParser.OnFunction;
|
|
FSaveDesigner:=frDesigner;
|
|
FSaveRep:=CurReport;
|
|
FSaveView:=CurView;
|
|
FSaveBand:=CurBand;
|
|
FSavePage:=CurPage;
|
|
// DocMode: (dmDesigning, dmPrinting); // current mode
|
|
frDesigner:=nil;
|
|
|
|
CurReport:=TfrReport.Create(nil);
|
|
CurReport.OnBeginBand:=FSaveRep.OnBeginBand;
|
|
CurReport.OnBeginColumn:=FSaveRep.OnBeginColumn;
|
|
CurReport.OnBeginDoc:=FSaveRep.OnBeginDoc;
|
|
CurReport.OnBeginPage:=FSaveRep.OnBeginPage;
|
|
CurReport.OnDBImageRead:=FSaveRep.OnDBImageRead;
|
|
CurReport.OnEndBand:=FSaveRep.OnEndBand;
|
|
CurReport.OnEndDoc:=FSaveRep.OnEndDoc;
|
|
CurReport.OnEndPage:=FSaveRep.OnEndPage;
|
|
CurReport.OnEnterRect:=FSaveRep.OnEnterRect;
|
|
CurReport.OnExportFilterSetup:=FSaveRep.OnExportFilterSetup;
|
|
CurReport.OnGetValue:=FSaveRep.OnGetValue;
|
|
CurReport.OnManualBuild:=FSaveRep.OnManualBuild;
|
|
CurReport.OnMouseOverObject:=FSaveRep.OnMouseOverObject;
|
|
CurReport.OnObjectClick:=FSaveRep.OnObjectClick;
|
|
CurReport.OnPrintColumn:=FSaveRep.OnPrintColumn;
|
|
CurReport.OnProgress:=FSaveRep.OnProgress;
|
|
CurReport.OnUserFunction:=FSaveRep.OnUserFunction;
|
|
|
|
FSaveReportEvent:=frDesignerComp.OnSaveReport;
|
|
frDesignerComp.OnSaveReport:=@DoSaveReportEvent;
|
|
|
|
//FDetailReport:=TStringStream.Create(Trim(FEditView.DetailReport.Text));
|
|
try
|
|
FDetailRrep.ReportBody.Position:=0;
|
|
if FDetailRrep.ReportBody.Size > 0 then
|
|
CurReport.LoadFromXMLStream(FDetailRrep.ReportBody);
|
|
|
|
if CurReport.DesignReport = mrOk then
|
|
begin
|
|
FDetailRrep.ReportBody.Size:=0;
|
|
CurReport.SaveToXMLStream(FDetailRrep.ReportBody);
|
|
FDetailRrep.ReportDescription:=CurReport.Comments.Text;
|
|
end;
|
|
|
|
if Assigned(frDesigner) then
|
|
FreeAndNil(frDesigner);
|
|
finally
|
|
frDesigner := FSaveDesigner;
|
|
CurReport := FSaveRep;
|
|
CurView := FSaveView;
|
|
CurBand := FSaveBand;
|
|
CurPage := FSavePage;
|
|
frParser.OnGetValue:=FSaveGetPValue;
|
|
frParser.OnFunction:=FSaveFunEvent;
|
|
frDesignerComp.OnSaveReport:=FSaveReportEvent;
|
|
|
|
frDesigner.Modified:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc);
|
|
var
|
|
I: Integer;
|
|
Values: TStringList;
|
|
begin
|
|
if Assigned(CurReport) then
|
|
begin
|
|
for i:=0 to CurReport.DetailReports.Count-1 do
|
|
Proc(CurReport.DetailReports.GetItem(i).ReportName);
|
|
end;
|
|
end;
|
|
|
|
type
|
|
|
|
{ TlrInternalTools }
|
|
|
|
TlrInternalTools = class
|
|
private
|
|
lrBMPInsFields : TBitmap;
|
|
procedure InsFieldsClick(Sender: TObject);
|
|
procedure InsertFieldsFormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean);
|
|
procedure InsertDbFields;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
FlrInternalTools:TlrInternalTools = nil;
|
|
|
|
{ TlrInternalTools }
|
|
|
|
procedure TlrInternalTools.InsFieldsClick(Sender: TObject);
|
|
begin
|
|
frInsertFieldsForm := TfrInsertFieldsForm.Create(nil);
|
|
frInsertFieldsForm.OnCloseQuery := @InsertFieldsFormCloseQuery;
|
|
Try
|
|
frInsertFieldsForm.ShowModal;
|
|
finally
|
|
frInsertFieldsForm.Free;
|
|
frInsertFieldsForm:=nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TlrInternalTools.InsertFieldsFormCloseQuery(Sender: TObject;
|
|
var CanClose: boolean);
|
|
begin
|
|
if (Sender=frInsertFieldsForm) and (frInsertFieldsForm.ModalResult=mrOk) then
|
|
InsertDbFields;
|
|
end;
|
|
|
|
procedure TlrInternalTools.InsertDbFields;
|
|
var
|
|
i, x, y, dx, dy, pdx, adx, tdx, tdy: Integer;
|
|
HeaderL, DataL: TFpList;
|
|
t, t1: TfrView;
|
|
b: TfrBandView;
|
|
f: TfrTField;
|
|
f1: TFieldDef;
|
|
fSize: Integer;
|
|
fName: String;
|
|
|
|
function FindDataset(DataSet: TfrTDataSet): String;
|
|
var
|
|
i,j: Integer;
|
|
|
|
function EnumComponents(f: TComponent): String;
|
|
var
|
|
i: Integer;
|
|
c: TComponent;
|
|
d: TfrDBDataSet;
|
|
begin
|
|
Result := '';
|
|
for i := 0 to f.ComponentCount - 1 do
|
|
begin
|
|
c := f.Components[i];
|
|
if c is TfrDBDataSet then
|
|
begin
|
|
d := c as TfrDBDataSet;
|
|
if d.GetDataSet = DataSet then
|
|
begin
|
|
if d.Owner = CurReport.Owner then
|
|
Result := d.Name else
|
|
Result := d.Owner.Name + '.' + d.Name;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := '';
|
|
for i := 0 to Screen.FormCount - 1 do
|
|
begin
|
|
Result := EnumComponents(Screen.Forms[i]);
|
|
if Result <> '' then Exit;
|
|
end;
|
|
|
|
with Screen do
|
|
begin
|
|
for i := 0 to CustomFormCount - 1 do
|
|
with CustomForms[i] do
|
|
if (ClassName = 'TDataModuleForm') then
|
|
for j := 0 to ComponentCount - 1 do
|
|
begin
|
|
if (Components[j] is TDataModule) then
|
|
Result:=EnumComponents(Components[j]);
|
|
if Result <> '' then Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
if frInsertFieldsForm=nil then
|
|
exit;
|
|
|
|
with frInsertFieldsForm do
|
|
begin
|
|
if (DataSet=nil) or (FieldsL.Items.Count = 0) or (FieldsL.SelCount = 0) then
|
|
exit;
|
|
|
|
HeaderL := TFpList.Create;
|
|
DataL := TFpList.Create;
|
|
try
|
|
x := frDesigner.Page.LeftMargin;
|
|
y := frDesigner.Page.TopMargin;
|
|
TfrDesignerForm(frDesigner).Unselect;
|
|
TfrDesignerForm(frDesigner).SelNum := 0;
|
|
for i := 0 to FieldsL.Items.Count - 1 do
|
|
if FieldsL.Selected[i] then
|
|
begin
|
|
f := TfrTField(DataSet.FindField(FieldsL.Items[i]));
|
|
fSize := 0;
|
|
if f <> nil then
|
|
begin
|
|
fSize := f.DisplayWidth;
|
|
fName := f.DisplayName;
|
|
end
|
|
else
|
|
begin
|
|
f1 := DataSet.FieldDefs[i];
|
|
fSize := f1.Size;
|
|
fName := f1.Name;
|
|
end;
|
|
|
|
if (fSize = 0) or (fSize > 255) then
|
|
fSize := 6;
|
|
|
|
t := frCreateObject(gtMemo, '', frDesigner.Page);
|
|
t.CreateUniqueName;
|
|
t.x := x;
|
|
t.y := y;
|
|
TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
|
|
with t as TfrCustomMemoView do
|
|
begin
|
|
Font.Name := LastFontName;
|
|
Font.Size := LastFontSize;
|
|
if HeaderCB.Checked then
|
|
Font.Style := [fsBold];
|
|
MonitorFontChanges;
|
|
end;
|
|
TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrCustomMemoView(t).Font);
|
|
t.Selected := True;
|
|
Inc(TfrDesignerForm(frDesigner).SelNum);
|
|
if HeaderCB.Checked then
|
|
begin
|
|
t.Memo.Add(fName);
|
|
t.dx := TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth(fName + ' ') div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
|
|
end
|
|
else
|
|
begin
|
|
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
|
|
'."' + FieldsL.Items[i] + '"]');
|
|
t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
|
|
end;
|
|
dx := t.dx;
|
|
// TfrDesignerForm(frDesigner).Page.Objects.Add(t);
|
|
if HeaderCB.Checked then
|
|
HeaderL.Add(t) else
|
|
DataL.Add(t);
|
|
if HeaderCB.Checked then
|
|
begin
|
|
t := frCreateObject(gtMemo, '', TfrDesignerForm(frDesigner).Page);
|
|
t.CreateUniqueName;
|
|
t.x := x;
|
|
t.y := y;
|
|
TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
|
|
if HorzRB.Checked then
|
|
Inc(t.y, 72) else
|
|
Inc(t.x, dx + TfrDesignerForm(frDesigner).GridSize * 2);
|
|
with t as TfrCustomMemoView do
|
|
begin
|
|
Font.Name := LastFontName;
|
|
Font.Size := LastFontSize;
|
|
MonitorFontChanges;
|
|
end;
|
|
t.Selected := True;
|
|
Inc(TfrDesignerForm(frDesigner).SelNum);
|
|
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
|
|
'."' + FieldsL.Items[i] + '"]');
|
|
t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
|
|
// TfrDesignerForm(frDesigner).Page.Objects.Add(t);
|
|
DataL.Add(t);
|
|
end;
|
|
if HorzRB.Checked then
|
|
Inc(x, t.dx + TfrDesignerForm(frDesigner).GridSize)
|
|
else
|
|
Inc(y, t.dy + TfrDesignerForm(frDesigner).GridSize);
|
|
|
|
if t is TfrControl then
|
|
TfrControl(T).UpdateControlPosition;
|
|
end;
|
|
|
|
if HorzRB.Checked then
|
|
begin
|
|
t := TfrView(DataL[DataL.Count - 1]);
|
|
adx := t.x + t.dx;
|
|
pdx := TfrDesignerForm(frDesigner).Page.RightMargin - TfrDesignerForm(frDesigner).Page.LeftMargin;
|
|
x := TfrDesignerForm(frDesigner).Page.LeftMargin;
|
|
if adx > pdx then
|
|
begin
|
|
for i := 0 to DataL.Count - 1 do
|
|
begin
|
|
t := TfrView(DataL[i]);
|
|
t.x := Round((t.x - x) / (adx / pdx)) + x;
|
|
t.dx := Round(t.dx / (adx / pdx));
|
|
end;
|
|
if HeaderCB.Checked then
|
|
for i := 0 to DataL.Count - 1 do
|
|
begin
|
|
t := TfrView(HeaderL[i]);
|
|
t1 := TfrView(DataL[i]);
|
|
t.x := Round((t.x - x) / (adx / pdx)) + x;
|
|
if t.dx > t1.dx then
|
|
t.dx := t1.dx;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if BandCB.Checked then
|
|
begin
|
|
if HeaderCB.Checked then
|
|
t := TfrView(HeaderL[DataL.Count - 1])
|
|
else
|
|
t := TfrView(DataL[DataL.Count - 1]);
|
|
dy := t.y + t.dy - TfrDesignerForm(frDesigner).Page.TopMargin;
|
|
b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
|
|
b.CreateUniqueName;
|
|
b.y := TfrDesignerForm(frDesigner).Page.TopMargin;
|
|
b.dy := dy;
|
|
b.Selected := True;
|
|
Inc(TfrDesignerForm(frDesigner).SelNum);
|
|
if not HeaderCB.Checked or not HorzRB.Checked then
|
|
begin
|
|
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
|
|
b.BandType := btMasterData;
|
|
b.DataSet := FindDataset(DataSet);
|
|
end
|
|
else
|
|
begin
|
|
if frCheckBand(btPageHeader) then
|
|
begin
|
|
Dec(TfrDesignerForm(frDesigner).SelNum);
|
|
b.Free;
|
|
end
|
|
else
|
|
begin
|
|
b.BandType := btPageHeader;
|
|
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
|
|
end;
|
|
b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
|
|
b.BandType := btMasterData;
|
|
b.DataSet := FindDataset(DataSet);
|
|
b.CreateUniqueName;
|
|
b.y := TfrDesignerForm(frDesigner).Page.TopMargin + 72;
|
|
b.dy := dy;
|
|
b.Selected := True;
|
|
Inc(TfrDesignerForm(frDesigner).SelNum);
|
|
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
|
|
end;
|
|
end;
|
|
TfrDesignerForm(frDesigner).SelectionChanged;
|
|
SendBandsToDown;
|
|
TfrDesignerForm(frDesigner).PageView.GetMultipleSelected;
|
|
TfrDesignerForm(frDesigner).RedrawPage;
|
|
TfrDesignerForm(frDesigner).AddUndoAction(acInsert);
|
|
finally
|
|
HeaderL.Free;
|
|
DataL.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TlrInternalTools.Create;
|
|
begin
|
|
inherited Create;
|
|
lrBMPInsFields := TBitmap.Create;
|
|
lrBMPInsFields.LoadFromResourceName(HInstance, 'lrd_ins_fields');
|
|
frRegisterTool(sInsertFields, lrBMPInsFields, @InsFieldsClick);
|
|
end;
|
|
|
|
destructor TlrInternalTools.Destroy;
|
|
begin
|
|
lrBMPInsFields.Free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
initialization
|
|
frDesigner:=nil;
|
|
ProcedureInitDesigner:=@InitGlobalDesigner;
|
|
|
|
ClipBd := TFpList.Create;
|
|
GridBitmap := TBitmap.Create;
|
|
with GridBitmap do
|
|
begin
|
|
Width := 8; Height := 8;
|
|
end;
|
|
LastFrames:=[];
|
|
LastFrameWidth := 1;
|
|
LastLineWidth := 2;
|
|
LastFillColor := clNone;
|
|
LastFrameColor := clBlack;
|
|
LastFontColor := clBlack;
|
|
LastFontStyle := 0;
|
|
LastAdjust := 0;
|
|
//** RegRootKey := 'Software\FastReport\' + Application.Title;
|
|
|
|
RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty);
|
|
RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty);
|
|
|
|
FlrInternalTools:=TlrInternalTools.Create;
|
|
finalization
|
|
If Assigned(frDesigner) then
|
|
begin
|
|
{$IFNDEF MODALDESIGNER}
|
|
if frDesigner.Visible then
|
|
frDesigner.Hide;
|
|
{$ENDIF}
|
|
frDesigner.Free;
|
|
end;
|
|
ClearClipBoard;
|
|
ClipBd.Free;
|
|
GridBitmap.Free;
|
|
FreeAndNil(FlrInternalTools);
|
|
end.
|
|
|