frxdesgn.pas

Fastreport最新版本的补丁

    AboutCmd: TAction;
    StandardTBCmd: TAction;
    TextTBCmd: TAction;
    FrameTBCmd: TAction;
    AlignTBCmd: TAction;
    ExtraTBCmd: TAction;
    InspectorTBCmd: TAction;
    DataTreeTBCmd: TAction;
    ReportTreeTBCmd: TAction;
    ToolbarsCmd: TAction;
    procedure ExitCmdExecute(Sender: TObject);
    procedure ObjectsButtonClick(Sender: TObject);
    procedure StatusBarDrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const ARect: TRect);
    procedure ScrollBoxMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ScrollBoxMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ScrollBoxResize(Sender: TObject);
    procedure ScaleCBClick(Sender: TObject);
    procedure ShowGridBClick(Sender: TObject);
    procedure AlignToGridBClick(Sender: TObject);
    procedure StatusBarDblClick(Sender: TObject);
    procedure StatusBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure InsertBandClick(Sender: TObject);
    procedure BandsPopupPopup(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NewReportCmdExecute(Sender: TObject);
    procedure ToolButtonClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FontColorBClick(Sender: TObject);
    procedure FrameStyleBClick(Sender: TObject);
    procedure TabChange(Sender: TObject);
    procedure UndoCmdExecute(Sender: TObject);
    procedure RedoCmdExecute(Sender: TObject);
    procedure CutCmdExecute(Sender: TObject);
    procedure CopyCmdExecute(Sender: TObject);
    procedure PasteCmdExecute(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure DeletePageCmdExecute(Sender: TObject);
    procedure NewDialogCmdExecute(Sender: TObject);
    procedure NewPageCmdExecute(Sender: TObject);
    procedure SaveCmdExecute(Sender: TObject);
    procedure SaveAsCmdExecute(Sender: TObject);
    procedure OpenCmdExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DeleteCmdExecute(Sender: TObject);
    procedure SelectAllCmdExecute(Sender: TObject);
    procedure EditCmdExecute(Sender: TObject);
    procedure TabChanging(Sender: TObject; var AllowChange: Boolean);
    procedure PageSettingsCmdExecute(Sender: TObject);
    procedure TopRulerDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure AlignLeftsBClick(Sender: TObject);
    procedure AlignRightsBClick(Sender: TObject);
    procedure AlignTopsBClick(Sender: TObject);
    procedure AlignBottomsBClick(Sender: TObject);
    procedure AlignHorzCentersBClick(Sender: TObject);
    procedure AlignVertCentersBClick(Sender: TObject);
    procedure CenterHorzBClick(Sender: TObject);
    procedure CenterVertBClick(Sender: TObject);
    procedure SpaceHorzBClick(Sender: TObject);
    procedure SpaceVertBClick(Sender: TObject);
    procedure SelectToolBClick(Sender: TObject);
    procedure PagePopupPopup(Sender: TObject);
    procedure BringToFrontCmdExecute(Sender: TObject);
    procedure SendToBackCmdExecute(Sender: TObject);
    procedure LangCBClick(Sender: TObject);
    procedure OpenScriptBClick(Sender: TObject);
    procedure SaveScriptBClick(Sender: TObject);
    procedure CodeWindowDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure CodeWindowDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure VariablesCmdExecute(Sender: TObject);
    procedure ObjectBandBClick(Sender: TObject);
    procedure PreviewCmdExecute(Sender: TObject);
    procedure HighlightBClick(Sender: TObject);
    procedure TabMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TabMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TabMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TabDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TabDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure SameWidthBClick(Sender: TObject);
    procedure SameHeightBClick(Sender: TObject);
    procedure NewItemCmdExecute(Sender: TObject);
    procedure TabOrderMIClick(Sender: TObject);
    procedure RunScriptBClick(Sender: TObject);
    procedure StopScriptBClick(Sender: TObject);
    procedure EvaluateBClick(Sender: TObject);
    procedure GroupCmdExecute(Sender: TObject);
    procedure UngroupCmdExecute(Sender: TObject);
    procedure ConnectionsMIClick(Sender: TObject);
    procedure LangSelectClick(Sender: TObject);
    procedure BreakPointBClick(Sender: TObject);
    procedure RunToCursorBClick(Sender: TObject);
    procedure CodeDockSiteDockOver(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
    procedure TabSetChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure FormShow(Sender: TObject);
    procedure AddChildMIClick(Sender: TObject);
    procedure FindCmdExecute(Sender: TObject);
    procedure ReplaceCmdExecute(Sender: TObject);
    procedure FindNextCmdExecute(Sender: TObject);
    procedure ReportDataCmdExecute(Sender: TObject);
    procedure ReportStylesCmdExecute(Sender: TObject);
    procedure ReportOptionsCmdExecute(Sender: TObject);
    procedure ShowRulersCmdExecute(Sender: TObject);
    procedure ShowGuidesCmdExecute(Sender: TObject);
    procedure DeleteGuidesCmdExecute(Sender: TObject);
    procedure OptionsCmdExecute(Sender: TObject);
    procedure HelpContentsCmdExecute(Sender: TObject);
    procedure AboutCmdExecute(Sender: TObject);
    procedure StandardTBCmdExecute(Sender: TObject);
    procedure TextTBCmdExecute(Sender: TObject);
    procedure FrameTBCmdExecute(Sender: TObject);
    procedure AlignTBCmdExecute(Sender: TObject);
    procedure ExtraTBCmdExecute(Sender: TObject);
    procedure InspectorTBCmdExecute(Sender: TObject);
    procedure DataTreeTBCmdExecute(Sender: TObject);
    procedure ReportTreeTBCmdExecute(Sender: TObject);
    procedure ToolbarsCmdExecute(Sender: TObject);
  private
    { Private declarations }
    ObjectSelectB: TToolButton;
    HandToolB: TToolButton;
    ZoomToolB: TToolButton;
    TextToolB: TToolButton;
    FormatToolB: TToolButton;
    ObjectBandB: TToolButton;

    FClipboard: TfrxClipboard;
    FCodeWindow: TfrxSyntaxMemo;
    FColor: TColor;
    FCoord1: String;
    FCoord2: String;
    FCoord3: String;
    FDialogForm: TfrxDialogForm;
    FEditAfterInsert: Boolean;
    FDataTree: TfrxDataTreeForm;
    FDropFields: Boolean;
    FGridAlign: Boolean;
    FGridSize1: Extended;
    FGridSize2: Extended;
    FGridSize3: Extended;
    FGridSize4: Extended;
    FInspector: TfrxObjectInspector;
    FLineStyle: TfrxFrameStyle;
    FLocalizedOI: Boolean;
    FModifiedBy: TObject;
    FMouseDown: Boolean;
    FOldDesignerComp: TfrxDesigner;
    FOldUnits: TfrxDesignerUnits;
    FPagePositions: TStrings;
    FPictureCache: TfrxPictureCache;
    FRecentFiles: TStringList;
    FRecentMenuIndex: Integer;
    FReportTree: TfrxReportTreeForm;
    FSampleFormat: TSampleFormat;
    FScale: Extended;
    FScriptFirstTime: Boolean;
    FScriptRunning: Boolean;
    FScriptStep: Boolean;
    FScriptStopped: Boolean;
    FSearchCase: Boolean;
    FSearchIndex: Integer;
    FSearchReplace: Boolean;
    FSearchReplaceText: String;
    FSearchText: String;
    FShowGrid: Boolean;
    FShowGuides: Boolean;
    FShowRulers: Boolean;
    FShowStartup: Boolean;
{$IFDEF UseTabset}
    FTabs: TTabSet;
{$ELSE}
    FTabs: TTabControl;
{$ENDIF}
    FToolsColor: TColor;
    FUndoBuffer: TfrxUndoBuffer;
    FUnits: TfrxDesignerUnits;
    FUnitsDblClicked: Boolean;
    FUpdatingControls: Boolean;
    FWatchList: TfrxWatchForm;
    FWorkspace: TfrxDesignerWorkspace;
    FWorkspaceColor: TColor;

    procedure AttachDialogFormEvents(Attach: Boolean);
    procedure CreateColorSelector(Sender: TToolButton);
    procedure CreateExtraToolbar;
    procedure CreateToolWindows;
    procedure CreateObjectsToolbar;
    procedure CreateWorkspace;
    procedure DialogFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DialogFormKeyPress(Sender: TObject; var Key: Char);
    procedure DialogFormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DialogFormModify(Sender: TObject);
    procedure Done;
    procedure DoTopmosts(Enable: Boolean);
    procedure FindOrReplace(replace: Boolean);
    procedure FindText;
    procedure Init;
    procedure NormalizeTopmosts;
    procedure OnCodeChanged(Sender: TObject);
    procedure OnCodeCompletion(const Name: String; List: TStrings);
    procedure OnColorChanged(Sender: TObject);
    procedure OnComponentMenuClick(Sender: TObject);
    procedure OnChangePosition(Sender: TObject);
    procedure OnDataTreeDblClick(Sender: TObject);
    procedure OnDisableDock(Sender: TObject; var DragObject: TDragDockObject);
    procedure OnEditObject(Sender: TObject);
    procedure OnEnableDock(Sender, Target: TObject; X, Y: Integer);
    procedure OnExtraToolClick(Sender: TObject);
    procedure OnInsertObject(Sender: TObject);
    procedure OnModify(Sender: TObject);
    procedure OnNotifyPosition(ARect: TfrxRect);
    procedure OnRunLine(Sender: TfsScript; const UnitName, SourcePos: String);
    procedure OnSelectionChanged(Sender: TObject);
    procedure OnStyleChanged(Sender: TObject);
    procedure OpenRecentFile(Sender: TObject);
    procedure ReadButtonImages;
    procedure ReloadObjects;
    procedure RestorePagePosition;
    procedure RestoreTopmosts;
    procedure SavePagePosition;
    procedure SaveState;
    procedure SetScale(Value: Extended);
    procedure SetGridAlign(const Value: Boolean);
    procedure SetShowGrid(const Value: Boolean);
    procedure SetShowRulers(const Value: Boolean);
    procedure SetToolsColor(const Value: TColor);
    procedure SetUnits(const Value: TfrxDesignerUnits);
    procedure SetWorkspaceColor(const Value: TColor);
    procedure SwitchToolbar;
    procedure UpdateCaption;
    procedure UpdateControls;
    procedure UpdatePageDimensions;
    procedure UpdateRecentFiles(NewFile: String);
    procedure UpdateStyles;
    procedure UpdateSyntaxType;
    function AskSave: Word;
    function GetPageIndex: Integer;
    function GetReportName: String;
    procedure SetShowGuides(const Value: Boolean);
    procedure Localize;
    procedure CreateLangMenu;
    procedure CMStartup(var Message: TMessage); message WM_USER + 1;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMEnable(var Message: TMessage); message WM_ENABLE;
    procedure WMActivateApp(var Message: TWMActivateApp); message WM_ACTIVATEAPP;
  protected
    procedure SetModified(const Value: Boolean); override;
    procedure SetPage(const Value: TfrxPage); override;
    function GetCode: TStrings; override;
  public
    { Public declarations }
    function CheckOp(Op: TfrxDesignerRestriction): Boolean;
    function InsertExpression(const Expr: String): String; override;
    procedure LoadFile(FileName: String; UseOnLoadEvent: Boolean);
    procedure Lock; override;
    procedure ReloadPages(Index: Integer); override;
    procedure ReloadReport; override;
    procedure RestoreState(RestoreDefault: Boolean = False;
      RestoreMainForm: Boolean = False);
    function SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean): Boolean;
    procedure SetReportDefaults;
    procedure SwitchToCodeWindow;
    procedure UpdateDataTree; override;
    procedure UpdatePage; override;
    function GetDefaultObjectSize: TfrxPoint;
    function mmToUnits(mm: Extended; X: Boolean = True): Extended;
    function UnitsTomm(mm: Extended; X: Boolean = True): Extended;

    property CodeWindow: TfrxSyntaxMemo read FCodeWindow;
    property DataTree: TfrxDataTreeForm read FDataTree;
    property DropFields: Boolean read FDropFields write FDropFields;
    property EditAfterInsert: Boolean read FEditAfterInsert write FEditAfterInsert;
    property GridAlign: Boolean read FGridAlign write SetGridAlign;
    property GridSize1: Extended read FGridSize1 write FGridSize1;
    property GridSize2: Extended read FGridSize2 write FGridSize2;
    property GridSize3: Extended read FGridSize3 write FGridSize3;
    property GridSize4: Extended read FGridSize4 write FGridSize4;
    property Inspector: TfrxObjectInspector read FInspector;
    property PictureCache: TfrxPictureCache read FPictureCache;
    property RecentFiles: TStringList read FRecentFiles;
    property ReportTree: TfrxReportTreeForm read FReportTree;
    property SampleFormat: TSampleFormat read FSampleFormat;
    property Scale: Extended read FScale write SetScale;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid;
    property ShowGuides: Boolean read FShowGuides write SetShowGuides;
    property ShowRulers: Boolean read FShowRulers write SetShowRulers;
    property ShowStartup: Boolean read FShowStartup write FShowStartup;
    property ToolsColor: TColor read FToolsColor write SetToolsColor;
    property Units: TfrxDesignerUnits read FUnits write SetUnits;
    property Workspace: TfrxDesignerWorkspace read FWorkspace;
    property WorkspaceColor: TColor read FWorkspaceColor write SetWorkspaceColor;
  end;

  TSampleFormat = class(TObject)
  private
    FMemo: TfrxCustomMemoView;
    procedure Clear;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ApplySample(Memo: TfrxCustomMemoView);
    procedure SetAsSample(Memo: TfrxCustomMemoView);
    property Memo: TfrxCustomMemoView read FMemo;
  end;

var
  frxDesignerComp: TfrxDesigner;

implementation

{$R *.DFM}
{$R *.RES}

uses
  TypInfo, IniFiles, Registry,
  frxDsgnIntf, frxUtils, frxPopupForm, frxDesgnWorkspace1,
  frxDesgnEditors, frxEditOptions, frxEditReport, frxEditPage, frxAbout,
  fs_itools, frxXML, frxEditReportData, frxEditVar, frxEditExpr,
  frxEditHighlight, frxEditStyle, frxNewItem,
  {$IFDEF FR_COM}frxStdWizard{frxAdoWizard},{$ELSE}frxStdWizard,{$ENDIF}
  frxEditTabOrder, frxCodeUtils, frxRes, frxrcDesgn, frxDMPClass,
  frxEvaluateForm, frxSearchDialog, frxConnEditor, fs_xml, frxVariables;

type
  THackControl = class(TWinControl);



{ TSampleFormat }

constructor TSampleFormat.Create;
begin
  Clear;
end;

destructor TSampleFormat.Destroy;
begin
  FMemo.Free;
  inherited;
end;

procedure TSampleFormat.Clear;
begin
  if FMemo <> nil then
    FMemo.Free;
  FMemo := TfrxMemoView.Create(nil);
  if frxDesignerComp <> nil then
  begin
    FMemo.Font := frxDesignerComp.DefaultFont;
    FMemo.RTLReading := frxDesignerComp.RTLLanguage;
  end;
end;

procedure TSampleFormat.ApplySample(Memo: TfrxCustomMemoView);
begin
  Memo.Color := FMemo.Color;
  if not (Memo is TfrxDMPMemoView) then
    Memo.Font := FMemo.Font;
  Memo.Frame.Assign(FMemo.Frame);
  Memo.HAlign := FMemo.HAlign;
  Memo.VAlign := FMemo.VAlign;
  Memo.RTLReading := FMemo.RTLReading;
end;

procedure TSampleFormat.SetAsSample(Memo: TfrxCustomMemoView);
begin
  FMemo.Color := Memo.Color;
  if not (Memo is TfrxDMPMemoView) then
    FMemo.Font := Memo.Font;
  FMemo.Frame.Assign(Memo.Frame);
  FMemo.HAlign := Memo.HAlign;
  FMemo.VAlign := Memo.VAlign;
  FMemo.RTLReading := Memo.RTLReading;
end;


{ TfrxDesigner }

constructor TfrxDesigner.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCloseQuery := True;
  FDefaultFont := TFont.Create;
  with FDefaultFont do
  begin
    Name := '宋体';
    Size := 10;
  end;
  FDefaultScriptLanguage := 'PascalScript';
  FDefaultLeftMargin := 10;
  FDefaultBottomMargin := 10;
  FDefaultRightMargin := 10;
  FDefaultTopMargin := 10;
  FDefaultPaperSize := DMPAPER_A4;
  FDefaultOrientation := poPortrait;
  frxDesignerComp := Self;
{$IFDEF Delphi10}
  FGradientStart := clWindow;
  FGradientEnd := $00B6D6DA;
{$ENDIF}

{$IFDEF FR_COM}
  FEvent := nil;
  FConnectionPoints := TConnectionPoints.Create(Self);
  FConnectionPoints.CreateConnectionPoint( IfrxDesignerEvents, ckSingle, EventSinkChanged );
  FConnectionPoint := FConnectionPoints.CreateConnectionPoint( IfrxDesignerEventDispatcher, ckMulti, nil );

  OnShowStartupScreen := OnDesignerStartupHandler;
{$ENDIF}
end;

destructor TfrxDesigner.Destroy;
begin
  FDefaultFont.Free;
  frxDesignerComp := nil;
  inherited Destroy;
end;

procedure TfrxDesigner.SetDefaultFont(const Value: TFont);
begin
  FDefaultFont.Assign(Value);
end;