rm_dsgform.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,142 行 · 第 1/5 页

unit RM_DsgForm;

interface

{$I RM.INC}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Printers, Menus, ComCtrls, ExtCtrls, Clipbrd, Commctrl,
  RM_Class, RM_Preview, RM_Common, RM_DsgCtrls, RM_Ctrls, RM_Insp,
  RM_EditorInsField
  {$IFDEF USE_INTERNAL_JVCL}
  , rm_JvInterpreter, rm_JvInterpreterParser, rm_JvInterpreterConst, rm_JvUtils
  {$ELSE}
  , JvInterpreter, JvInterpreterParser, JvInterpreterConst, rm_JvUtils
  {$ENDIF}

  {$IFDEF USE_SYNEDIT}
  , SynEdit, SynHighlighterPas, SynEditRegexSearch, SynEditSearch, SynEditTypes
  {$ELSE}
  {$IFDEF USE_INTERNAL_JVCL}
  , rm_JvEditor, rm_JvHLEditor {, rm_JvEditorCommon}
  {$ELSE}
  , JvEditor, JvHLEditor, JvEditorCommon
  {$ENDIF}
  {$ENDIF}

  {$IFDEF Delphi4}, ImgList{$ENDIF}
  {$IFDEF Delphi6}, Variants{$ENDIF};

type

  TRMUndoAction = (acInsert, acDelete, acEdit, acZOrder,
    acChangeCellSize, acChangeCellCount, acChangePage);
  TRMHighLighter = (rmhlNone, rmhlPascal, rmhlCBuilder, rmhlSql, rmhlPython, rmhlJava, rmhlVB,
    rmhlHtml, rmhlPerl, rmhlIni, rmhlCocoR, rmhlPhp, rmhlNQC);

  TRMSplitInfo = record
    SplRect: TRect;
    SplX: Integer;
    View1, View2: TRMView;
  end;

  {$IFDEF USE_SYNEDIT}
  TRMSynEditor = class(TSynEdit)
    {$ELSE}
  TRMSynEditor = class(TJvHLEditor)
    {$ENDIF}
  public
    procedure SetHighLighter(aHighLighter: TRMHighLighter);
    procedure SetGutterWidth(aWidth: Integer);
    procedure SetGroupUndo(aValue: Boolean);
    procedure SetUndoAfterSave(aValue: Boolean);
    procedure SetReservedForeColor(aValue: TColor);
    procedure SetCommentForeColor(aValue: TColor);

    function RMCanCut: Boolean;
    function RMCanCopy: Boolean;
    function RMCanPaste: Boolean;
    function RMCanUndo: Boolean;
    function RMCanRedo: Boolean;

    procedure RMClearUndoBuffer;
    procedure RMClipBoardCut;
    procedure RMClipBoardCopy;
    procedure RMClipBoardPaste;
    procedure RMDeleteSelected;
    procedure RMUndo;
    procedure RmRedo;
  end;

  TRMDesignerDrawMode = (dmAll, dmSelection, dmShape);
  TRMCursorType = (ctNone, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8);
  TRMShapeMode = (smFrame, smAll);
  TRMDesignerEditMode = (mdInsert, mdSelect);

  { TRMVirtualReportDesigner }
  TRMVirtualReportDesigner = class(TRMReportDesigner)
  private
    procedure SetCurPos(Value: Integer);
    function GetCurPos: Integer;
    procedure Back;
    function ParseDataType: IJvInterpreterDataType;
    procedure ParseToken;
    procedure NextToken;
    function Function1(aParams: PRMParamRecArray; var aParamCount: Integer): string;
    procedure SkipIdentifier1;
    procedure SkipToUntil1;
    procedure SkipStatement1;
    procedure SkipToEnd1;
    procedure FindToken1(TTyp1: TTokenTyp);
    procedure ErrorExpected(Exp: string);
    procedure FindOneFunc(aParams: PRMParamRecArray;
      var aIsEnd: Boolean; var aFuncName: string; var aParamCount: Integer);

    function PosBeg: Integer;
    function PosRow: Integer;
  protected
    {$IFDEF USE_SYNEDIT}
    FSearchBackwards: boolean;
    FSearchCaseSensitive: boolean;
    FSearchFromCaret: boolean;
    FSearchFromCaret1: Boolean;
    FSearchSelectionOnly: boolean;
    FSearchTextAtCaret: boolean;
    FSearchWholeWords: boolean;
    FSearchRegex: boolean;

    FSearchText: string;
    FSearchTextHistory: string;
    FReplaceText: string;
    FReplaceTextHistory: string;

    SynPasSyn1: TSynPasSyn;
    FSynEditSearch: TSynEditSearch;
    FSynEditRegexSearch: TSynEditRegexSearch;
    {$ELSE}
    FScriptCanReplace: Boolean;
    FFindDialog: TFindDialog;
    FReplaceDialog: TReplaceDialog;
    {$ENDIF}
    FCodeMemo: TRMSynEditor;
    Tab1: TRMTabControl;

    FSaveFuncPos, FSaveFuncRow: Integer;
    FSaveFuncBeginPos: Integer;
    FUnitSection: TUnitSection;
    FParsed: Boolean;
    FBacked: Boolean;
    TTyp: TTokenTyp;
    TokenStr1: string;
    PrevTTyp: TTokenTyp;
    Token: Variant;
    property TokenStr: string read TokenStr1;
    property CurPos: Integer read GetCurPos write SetCurPos;

    procedure ShowPosition; virtual; abstract;
    procedure EnableControls; virtual; abstract;
    procedure OnCodeMemoChangeEvent(Sender: TObject); virtual;
    procedure OnCodeMemoPaintGutterEvent(Sender: TObject; aCanvas: TCanvas); virtual;
    procedure DoSearchReplaceText(aReplace: Boolean; aBackwards: Boolean);
    procedure ShowSearchReplaceDialog(aReplace: Boolean);
    {$IFDEF USE_SYNEDIT}
    procedure OnCodeMemoReplaceText(Sender: TObject; const aSearch,
      aReplace: string; aLine, aColumn: Integer; var Action: TSynReplaceAction);
    procedure OnCodeMemoStatusChange(Sender: TObject; Changes: TSynStatusChanges);
    {$ELSE}
    procedure OnCodeMemoSelectionChangeEvent(Sender: TObject); virtual;

    procedure FindDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Show(Sender: TObject);
    procedure FindNext;
    procedure Replace_FindNext;
    {$ENDIF}

    {$IFDEF Raize}
    procedure Tab1Changing(Sender: TObject; NewIndex: Integer; var AllowChange: Boolean);
    {$ELSE}
    procedure Tab1Changing(Sender: TObject; var AllowChange: Boolean);
    {$ENDIF}
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    //  Event Editor
    procedure GetEventFunctions(aValues: TStrings; aParams: PRMParamRecArray;
      aParamCount: Integer); override;
    procedure EditMethod(aFuncName: string; aParams: PRMParamRecArray;
      aParamCount: Integer); override;
    procedure ClearEmptyEvent; override;
  end;

  TRMCustomDesignerForm = class;
  TRMWorkSpace = class;

  { TRMToolbarComponent }
  TRMToolbarComponent = class(TPanel)
  private
    FControlIndex: Integer;
    FDesignerForm: TRMCustomDesignerForm;
    FBandsMenu, FPopupMenuComponent: TPopupMenu;
    FBtnNoSelect, FBtnMemoView: TSpeedButton;
    FBtnUp, FBtnDown: {$IFDEF USE_TB2K}TSpeedButton{$ELSE}TRMToolbarButton{$ENDIF};
    FOldPageType: Integer;
    FBusy: Boolean;
    FObjectBand: TSpeedButton;
    FSelectedObjIndex: Integer;
    FImageList: TImageList;

    procedure OnBandMenuPopup(Sender: TObject);
    procedure OnAddBandEvent(Sender: TObject);
    procedure OnOB1ClickEvent(Sender: TObject);
    procedure OnButtonBandClickEvent(Sender: TObject);
    procedure OnOB2MouseDownEvent(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OnOB2ClickEvent(Sender: TObject);
    procedure OnOB2ClickEvent_1(Sender: TObject);
    procedure OnAddInObectMenuItemClick(Sender: TObject);

    procedure RefreshControls;
    procedure OnResizeEvent(Sender: TObject);
    procedure OnBtnUpClickEvent(Sender: TObject);
    procedure OnBtnDownClickEvent(Sender: TObject);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure CreateObjects;

    property btnNoSelect: TSpeedButton read FBtnNoSelect;
    property ObjectBand: TSpeedButton read FObjectBand;
    property SelectedObjIndex: Integer read FSelectedObjIndex;
  end;

  { TRMDesignerDialog }
  TRMCustomDesignerForm = class(TRMVirtualReportDesigner)
  private
    FObjRepeat: Boolean; // was pressed Shift + Insert Object
    FObjectPopupMenu: TPopupMenu;

    FAutoOpenLastFile: Boolean;
    FAutoChangeBandPos: Boolean;
    FWorkSpaceColor: TColor;
    FInspFormColor: TColor;
    FEditorForm: TForm;

    FToolbarComponent: TRMToolbarComponent;

    procedure SetGridShow(Value: Boolean);
    procedure SetGridAlign(Value: Boolean);
    procedure SetGridSize(Value: Integer);
  protected
    ObjID: Integer;
    FirstSelected: TRMView;
    SelNum: Integer; // number of objects currently selected
    FShowSizes: Boolean;
    FBusy: Boolean; // busy flag. need!
    FShapeMode: TRMShapeMode; // show selection: frame or bar
    FSplitInfo: TRMSplitInfo;
    FGridBitmap: TBitmap;
    FGridSize: Integer;
    FShowGrid, FGridAlign: Boolean;
    FUnlimitedHeight: Boolean;
    FCurPage: Integer;

    FWorkSpace: TRMWorkSpace;
    FFieldForm: TRMInsFieldsForm;

    procedure SetCurPage(Value: Integer); virtual; abstract; //
    procedure RefreshData; virtual; abstract;
    procedure DoFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual; abstract;
    function PageSetup: Boolean; virtual;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer); override;
    destructor Destroy; override;
    function EditorForm: TForm; override;
    procedure UnselectAll; virtual; abstract; //
    procedure SelectionChanged(aRefreshInspProp: Boolean); virtual; abstract; //
    procedure SetPageTabs; virtual; abstract; //
    procedure ResetSelection; virtual; abstract; //
    procedure ShowContent; virtual; abstract; //
    procedure AddUndoAction(aAction: TRMUndoAction); virtual; abstract; //

    procedure GetDefaultSize(var aWidth, aHeight: Integer);
    function IsBandsSelect(var Band: TRMView): Boolean;
    procedure SendBandsToDown;
    function IsSubreport(PageN: Integer): TRMView;
    function RMCheckBand(b: TRMBandType): Boolean;
    procedure GetRegion;
    procedure RedrawPage;
    procedure SetObjectID(t: TRMView);
    procedure ShowObjMsg; virtual;
    procedure ShowEditor; virtual;
    procedure SetRulerOffset; virtual;
    function TopSelected: Integer; virtual;

    property ToolbarComponent: TRMToolbarComponent read FToolbarComponent;
    property ObjectPopupMenu: TPopupMenu read FObjectPopupMenu write FObjectPopupMenu;
    property CurPage: Integer read FCurPage write SetCurPage;
    property ObjRepeat: Boolean read FObjRepeat write FObjRepeat;

    property GridAlign: Boolean read FGridAlign write SetGridAlign;
    property GridSize: Integer read FGridSize write SetGridSize;
    property ShowGrid: Boolean read FShowGrid write SetGridShow;
    property AutoOpenLastFile: Boolean read FAutoOpenLastFile write FAutoOpenLastFile;
    property AutoChangeBandPos: Boolean read FAutoChangeBandPos write FAutoChangeBandPos;
    property WorkSpaceColor: TColor read FWorkSpaceColor write FWorkSpaceColor;
    property InspFormColor: TColor read FInspFormColor write FInspFormColor;
  end;

  { TRMCustomFormWorkSpace }
  TRMDialogForm = class(TForm)
  private
    FDesignerForm: TRMCustomDesignerForm;
    procedure WMMove(var Message: TMessage); message WM_MOVE;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetPageFormProp;

    procedure OnFormResizeEvent(Sender: TObject);
    procedure OnFormKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure OnFormCloseQueryEvent(Sender: TObject; var CanClose: Boolean);
  end;

  { TRMWorkSpace }
  TRMWorkSpace = class(TPanel)
  private
    FBandMoved: Boolean;
    FDesignerForm: TRMCustomDesignerForm;
    FDisableDraw: Boolean;
    FMode: TRMDesignerEditMode; // current mode
    FMouseButtonDown: Boolean; // mouse button was pressed
    FDragFlag: Boolean;
    FCursorType: TRMCursorType; // current mouse cursor (sizing arrows)
    FDoubleClickFlag: Boolean; // was double click
    FObjectsSelecting: Boolean; // selecting objects by framing
    FLeftTop: TPoint;
    FRightBottom: Integer;
    FMoved: Boolean; // mouse was FMoved (with pressed btn)
    FLastX, FLastY: Integer; // here stored last mouse coords

    procedure RoundCoord(var x, y: Integer);
    procedure NormalizeCoord(t: TRMView);
    procedure NormalizeRect(var r: TRect);

    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure OnDoubleClickEvent(Sender: TObject);

    procedure DrawFocusRect(aRect: TRect);
    procedure DrawHSplitter(aRect: TRect);
    procedure DrawSelection(t: TRMView);
    procedure DrawShape(t: TRMView);
    procedure DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer);
  protected
    procedure Paint; override;
  public
    PageForm: TRMDialogForm;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Init;
    procedure SetPage;
    procedure GetMultipleSelected;
    procedure DrawPage(aDrawMode: TRMDesignerDrawMode);
    procedure Draw(N: Integer; aClipRgn: HRGN);
    procedure RedrawPage;

    procedure OnMouseMoveEvent(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure OnMouseDownEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnMouseUpEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure CopyToClipboard;
    procedure DeleteObjects(aAddUndoAction: Boolean);
    procedure PasteFromClipboard;
    procedure SelectAll;

    property DesignerForm: TRMCustomDesignerForm read FDesignerForm write FDesignerForm;
    property DisableDraw: Boolean read FDisableDraw write FDisableDraw;
    property EditMode: TRMDesignerEditMode read FMode write FMode; // current mode
    property MouseButtonDown: Boolean read FMouseButtonDown write FMouseButtonDown; // mouse button was pressed
  end;

var
  CF_REPORTMACHINE: Word;
  RM_LastFontName: string;
  RM_LastFontSize: Integer;
  RM_LastFontCharset: Word;
  RM_LastFontStyle: Word;
  RM_LastFontColor: TColor;
  RM_LastHAlign: TRMHAlign;
  RM_LastVAlign: TRMVAlign;
  RM_LastFillColor: TColor;
  RM_LastFrameWidth: Integer;
  RM_LastFrameColor: TColor;
  RM_LastLeftFrameVisible: Boolean;
  RM_LastTopFrameVIsible: Boolean;
  RM_LastRightFrameVisible: Boolean;
  RM_LastBottomFrameVisible: Boolean;
  RM_ClipRgn: HRGN;
  RM_OldRect, RM_OldRect1: TRect; // object rect after mouse was clicked
  RM_SelectedManyObject: Boolean; // several objects was selected
  RM_FirstChange, RM_FirstBandMove: Boolean;

  RM_Dsg_LastDataSet: string;
  RMTemplateDir: string = '';

implementation

uses
  RM_Const, RM_Const1, RM_Utils, RM_EditorBandType, RM_EditorMemo,
  RM_PageSetup
  {$IFDEF USE_SYNEDIT}
  , RM_EditorSearchText, RM_EditorReplaceText, RM_EditorConfirmReplace
  {$ENDIF};

type
  THackView = class(TRMView)
  end;

  THackDialogControl = class(TRMDialogControl)
  end;

  THackReport = class(TRMReport)
  end;

  THackPage = class(TRMCustomPage)
  end;

  THackReportPage = class(TRMReportPage)
  end;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  { TRMSynEdit }

procedure TRMSynEditor.SetHighLighter(aHighLighter: TRMHighLighter);
begin
  {$IFDEF USE_SYNEDIT}
  {$ELSE}
  HighLighter := THighLighter(aHighLighter);
  {$ENDIF}
end;

procedure TRMSynEditor.SetGutterWidth(aWidth: Integer);