⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxdesgn.pas

📁 报表控件。FastReport 是非常强大的报表控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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 ReportStylesMIClick(Sender: TObject);
    procedure NewItemCmdExecute(Sender: TObject);
    procedure TabOrderMIClick(Sender: TObject);
    procedure RunScriptBClick(Sender: TObject);
    procedure StopScriptBClick(Sender: TObject);
    procedure EvaluateBClick(Sender: TObject);
    procedure FindMIClick(Sender: TObject);
    procedure FindNextMIClick(Sender: TObject);
    procedure GroupCmdExecute(Sender: TObject);
    procedure UngroupCmdExecute(Sender: TObject);
    procedure DataLVClick(Sender: TObject);
    procedure DataLVDblClick(Sender: TObject);
    procedure DataLVKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DataLVChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ConnectionsMIClick(Sender: TObject);
    procedure LangSelectClick(Sender: TObject);
    procedure HelpContentsMIClick(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;
    FRecentFiles: TStringList;
    FRecentMenuIndex: Integer;
    FReportTree: TfrxReportTreeForm;
    FSampleFormat: TSampleFormat;
    FScale: Extended;
    FScriptFirstTime: Boolean;
    FScriptRunning: Boolean;
    FScriptStopped: Boolean;
    FSearchCase: Boolean;
    FSearchIndex: Integer;
    FSearchReplace: Boolean;
    FSearchReplaceText: String;
    FSearchText: String;
    FShowGrid: Boolean;
    FShowGuides: Boolean;
    FShowRulers: Boolean;
    FShowStartup: Boolean;
    FToolsColor: TColor;
    FUndoBuffer: TfrxUndoBuffer;
    FUnits: TfrxDesignerUnits;
    FUnitsDblClicked: Boolean;
    FUpdatingControls: Boolean;
    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 FindText;
    procedure Init;
    procedure OnCodeChanged(Sender: TObject);
    procedure OnColorChanged(Sender: TObject);
    procedure OnComponentMenuClick(Sender: TObject);
    procedure OnChangePosition(Sender: TObject);
    procedure OnDataTreeDblClick(Sender: TObject);
    procedure OnEditObject(Sender: TObject);
    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 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 UpdateDataControls;
    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 CMStartup(var Message: TMessage); message WM_USER + 1;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure Localize;
    procedure CreateLangMenu;
  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);
    procedure SaveFile(SaveAs: Boolean; UseOnSaveEvent: 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 RecentFiles: TStringList read FRecentFiles;
    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, frxFormUtils, frxPopupForm, frxDesgnWorkspace1,
  frxDesgnEditors, frxEditOptions, frxEditReport, frxEditPage, frxAbout,
  fs_itools, frxXML, frxEditReportData, frxEditVar, frxEditExpr,
  frxEditHighlight, frxEditStyle, frxNewItem,
  frxStdWizard,
  frxEditTabOrder, frxCodeUtils, frxRes, frxrcDesgn, frxDMPClass,
  frxEvaluateForm, frxSearchDialog, frxConnEditor;

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.BrushStyle := FMemo.BrushStyle;
  Memo.HAlign := FMemo.HAlign;
  Memo.VAlign := FMemo.VAlign;
  Memo.LineSpacing := FMemo.LineSpacing;
  Memo.ParentFont := FMemo.ParentFont;
  Memo.RTLReading := FMemo.RTLReading;
end;

procedure TSampleFormat.SetAsSample(Memo: TfrxCustomMemoView);
begin
  if Memo = nil then
    Clear
  else
    FMemo.Assign(Memo);
  FMemo.FlowTo := nil;
end;


{ TfrxDesigner }

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

  FCloseQuery := True;
  FDefaultFont := TFont.Create;
  with FDefaultFont do
  begin
    Name := 'Arial';
    Size := 10;
  end;
  FDefaultScriptLanguage := 'PascalScript';
  FDefaultLeftMargin := 10;
  FDefaultBottomMargin := 10;
  FDefaultRightMargin := 10;
  FDefaultTopMargin := 10;
  FDefaultPaperSize := DMPAPER_A4;
  FDefaultOrientation := poPortrait;
  frxDesignerComp := Self;

end;

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

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



{ TfrxDesignerForm }

{ Form events }
{------------------------------------------------------------------------------}

procedure TfrxDesignerForm.FormCreate(Sender: TObject);
begin

  ReadButtonImages;
  CreateObjectsToolbar;
  CreateWorkspace;
  CreateToolWindows;
  Init;
  RestoreState;
  CreateExtraToolbar;

  Localize;

  CreateLangMenu;

  with ScaleCB.Items do
  begin
    Clear;
    Add('25%');
    Add('50%');
    Add('75%');
    Add('100%');
    Add('150%');
    Add('200%');
    Add(frxResources.Get('zmPageWidth'));
    Add(frxResources.Get('zmWholePage'));
  end;

  if Screen.PixelsPerInch > 96 then
  begin
    StyleCB.Font.Height := -11;
    FontNameCB.Font.Height := -11;
    FontSizeCB.Font.Height := -11;
    ScaleCB.Font.Height := -11;
    FrameWidthCB.Font.Height := -11;
  end;

  ReloadPages(0);
  UpdateCaption;
  UpdateRecentFiles('');

  ConnectionsMI.Visible := False;
  if frxDesignerComp <> nil then
  begin
    ConnectionsMI.Visible := frxDesignerComp.Standalone;
    if Assigned(frxDesignerComp.FOnShow) then
      frxDesignerComp.FOnShow(Self);
  end;
end;

procedure TfrxDesignerForm.FormDestroy(Sender: TObject);
begin
  SaveState;
  Done;
end;

procedure TfrxDesignerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FModalFinished := True;
end;

procedure TfrxDesignerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  w: Word;
begin
  if FScriptRunning then
  begin
    CanClose := False;
    Exit;
  end;

  CanClose := True;
  Report.ScriptText := CodeWindow.Lines;

  if (frxDesignerComp <> nil) and not frxDesignerComp.CloseQuery then
    Exit;

  if Modified and not (csDesigning in Report.ComponentState) and CheckOp(drDontSaveReport) then
  begin
    w := AskSave;

    if IsPreviewDesigner then
    begin
      if w = mrNo then
        Modified := False
    end
    else if w = mrYes then
      SaveFile(False, True);

    if not IsPreviewDesigner then
    begin
      if w = mrNo then 
        Modified := False
      else
        Modified := True;
    end;

    if w = mrCancel then
      CanClose := False;
  end;
end;

procedure TfrxDesignerForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (FDialogForm <> nil) and (ActiveControl <> FInspector.Edit1) then
    THackControl(FWorkspace).KeyDown(Key, Shift);

  if Key = vk_Return then
    if ActiveControl = FontSizeCB then
      ToolButtonClick(FontSizeCB)
    else if ActiveControl = ScaleCB then
      ScaleCBClick(Self);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then
    if Key = vk_Insert then
      if Shift = [ssShift] then
        PasteCmdExecute(nil)
      else if Shift = [ssCtrl] then
        CopyCmdExecute(nil);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -