rm_insp.pas

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

unit RM_Insp;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, Comctrls, RM_Common, RM_DsgCtrls, RM_PropInsp, TypInfo
  {$IFDEF USE_TB2K}
  , TB2Item, TB2Dock, TB2Toolbar
  {$ELSE}
  {$IFDEF USE_INTERNALTB97}
  , RM_TB97Ctls, RM_TB97Tlbr, RM_TB97
  {$ELSE}
  , TB97Ctls, TB97Tlbr, TB97
  {$ENDIF}
  {$ENDIF}
  {$IFDEF Delphi6}, Variants{$ENDIF};

const
  RMCompletionStr: array[0..21] of string = (
    'arrayd * array declaration (var) *array[0..|] of ;',
    'arrayc * array declaration (const) *array[0..|] of = ()',
    'ifeb * if then else *if | then/nbegin/n/nend/nelse/nbegin/n/nend;',
    'ife * if then (no begin/end) else (no begin/end) *if | then/n/nelse',
    'ifb * if statement *if | then/nbegin/n/nend;',
    'ifs * if (no begin/end) *if | then',
    'casee * case statement (with else) *case | of /n  : ;/n  : ;/nelse/n  ;/nend;',
    'cases * case statement *case | of/n  : ;/n  : ;/nend;',
    'forb * for statement *for | :=  to  do/nbegin/n/nend;',
    'fors * for (no begin/end) *for | :=  to  do',
    'whiles * while (no begin) *while | do',
    'whileb * while statement *while | do/nbegin/n/nend;',
    'procedure * procedure declaration *procedure |();/nbegin/n/nend;',
    'function * function declaration *function |(): ;/nbegin/n/nend;',
    'withs * with (no begin) *with | do',
    'withb * with statement *with | do/nbegin/n/nend;',
    'trycf * try finally (with Create/Free) *variable := typename.Create;/ntry/n/nfinally/n  variable.Free;/nend;',
    'tryf * try finally *try/n  |/nfinally/n/nend;',
    'trye * try except *try/n  |/nexcept/n/nend;',
    'classc * class declaration (with Create/Destroy overrides) *T| = class(T)/nprivate/n/nprotected/n/npublic/n  constructor Create; override;/n  destructor Destroy; override;/npublished/n/nend;',
    'classd * class declaration (no parts) *T| = class(T)/n/nend;',
    'classf * class declaration (all parts) *T| = class(T)/nprivate/n/nprotected/n/npublic/n/npublished/n/nend;'
    );
type

  TGetObjectsEvent = procedure(List: TStrings) of object;
  TSelectionChangedEvent = procedure(ObjName: string) of object;

  { TRMInspForm }
  TRMInspForm = class(TRMToolWin)
  private
    FTab: TTabControl;
    FcmbObjects: TComboBox;
    FInsp: TELPropertyInspector;
    FPanelTop: TPanel;
    FSplitter1: TSplitter;
    FPanelBottom, FPanel2: TPanel;
    FLabelTitle, FLabelCommon: TLabel;

    FCurObjectClassName: string;
    FSaveHeight: Integer;

    FOnGetObjects: TGetObjectsEvent;
    FOnSelectionChanged: TSelectionChangedEvent;

    function GetSplitterPos: Integer;
    procedure SetSplitterPos(Value: Integer);
    function GetSplitterPos1: Integer;
    procedure SetSplitterPos1(Value: Integer);
    procedure Localize;
    procedure OnResizeEvent(Sender: TObject);
    procedure OnVisibleChangedEvent(Sender: TObject);
    procedure OnTabChangeEvent(Sender: TObject);
    procedure Panel2Resize(Sender: TObject);
    procedure Insp_OnClick(Sender: TObject);
    procedure OnGetEditorClassEvent(Sender: TObject;
      AInstance: TPersistent; APropInfo: PPropInfo; var AEditorClass: TELPropEditorClass);

    procedure cmbObjectsDropDown(Sender: TObject);
    procedure cmbObjectsClick(Sender: TObject);
    procedure cmbObjectsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);

    procedure WMLButtonDBLCLK(var Message: TWMNCLButtonDown); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDBLCLK(var Message: TWMNCRButtonDown); message WM_RBUTTONDBLCLK;
    procedure OnMoveEvent(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure AddObject(aObject: TPersistent);
    procedure ClearObjects;
    procedure SetCurrentObject(aClassName, s: string);
    procedure SetCurReport(aObject: TObject);
    procedure RestorePos;

    property Insp: TELPropertyInspector read FInsp;
    property Tab: TTabControl read FTab;
    property SplitterPos: Integer read GetSplitterPos write SetSplitterPos;
    property SplitterPos1: Integer read GetSplitterPos1 write SetSplitterPos1;
    property OnGetObjects: TGetObjectsEvent read FOnGetObjects write FOnGetObjects;
    property OnSelectionChanged: TSelectionChangedEvent read FOnSelectionChanged write FOnSelectionChanged;
    property cmbObjects: TComboBox read FcmbObjects;
  end;

procedure RMRegisterPropEditor(ATypeInfo: PTypeInfo; AObjectClass: TClass;
  const APropName: string; AEditorClass: TELPropEditorClass);

implementation

uses RM_Class, RM_Const, RM_Const1, RM_Utils, RM_EditorMemo,
  RM_EditorBand, RM_EditorCrossBand, RM_EditorGroup, RM_EditorCalc, RM_EditorHilit,
  RM_EditorPicture, RM_EditorFormat, RM_EditorExpr;

var
  FCurReport: TRMReport;
  FAddinPropEditors: TList;

type
  TRMAddinPropEditor = class
  private
  public
    TypeInfo: PTypeInfo;
    ObjectClass: TClass;
    PropName: string;
    EditorClass: TELPropEditorClass;
    constructor Create(ATypeInfo: PTypeInfo; AObjectClass: TClass;
      const APropName: string; AEditorClass: TELPropEditorClass);
  end;

constructor TRMAddinPropEditor.Create(ATypeInfo: PTypeInfo; AObjectClass: TClass;
  const APropName: string; AEditorClass: TELPropEditorClass);
begin
  inherited Create;
  TypeInfo := aTypeInfo;
  ObjectClass := aObjectClass;
  PropName := aPropName;
  EditorClass := aEditorClass;
end;

function RMAddinPropEditors: TList;
begin
  if FAddinPropEditors = nil then
    FAddinPropEditors := TList.Create;
  Result := FAddinPropEditors;
end;

procedure RMRegisterPropEditor(ATypeInfo: PTypeInfo; AObjectClass: TClass;
  const APropName: string; AEditorClass: TELPropEditorClass);
var
  liItem: TRMAddinPropEditor;
begin
  liItem := TRMAddinPropEditor.Create(aTypeInfo, aObjectClass, aPropName, aEditorClass);
  RMAddinPropEditors.Add(liItem);
end;

type
  THackView = class(TRMView)
  end;

  THackReportView = class(TRMReportView)
  end;

  THackPage = class(TRMCustomPage)
  end;

  TStringsPropEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TChildBandEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TGroupHeaderBandEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TGroupFooterBandEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TResetGroupNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TDataSetEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TCrossDataBandDataSourceEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TGroupConditionEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TExpressionEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TCalcOptionsEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  THighlightEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TShiftWithEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TMasterMemoViewEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TPictureView_PictureEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TPageBackPictureEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TDataFieldEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TDisplayFormatEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TMethodEditor = class(TELClassPropEditor)
  private
    procedure GetFuncParams(aParams: PRMParamRecArray; var aParamCount: Integer);
  protected
    function AllEqual: Boolean; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
    procedure Edit; override;
  end;

  TPicturePropEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TBitmapPropEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  { TStringsPropEditor }

function TStringsPropEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praMultiSelect, praDialog, praReadOnly];
end;

procedure TStringsPropEditor.Edit;
var
  tmp: TRMEditorForm;
begin
  tmp := TRMEditorForm(RMDesigner.EditorForm);
  tmp.Memo.Lines.Assign(TStrings(GetOrdValue(0)));
  if tmp.Execute then
    SetOrdValue(Longint(tmp.Memo.Lines));
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TChildBandEditor }

function TChildBandEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praMultiSelect, praValueList, praSortList];
end;

procedure TChildBandEditor.GetValues(AValues: TStrings);
var
  i: Integer;
  t: TRMView;
  lList: TList;
begin
  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (GetInstance(0) <> t) and
      (TRMCustomBandView(t).BandType in [rmbtChild]) then
      aValues.Add(t.Name);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TGroupHeaderBandEditor }

function TGroupHeaderBandEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praMultiSelect, praValueList, praSortList];
end;

procedure TGroupHeaderBandEditor.GetValues(AValues: TStrings);
var
  i: Integer;
  t: TRMView;
  lList: TList;
begin
  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (GetInstance(0) <> t) and
      (TRMCustomBandView(t).BandType in [rmbtMasterData, rmbtDetailData]) then
      aValues.Add(t.Name);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TGroupFooterBandEditor }

function TGroupFooterBandEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praMultiSelect, praValueList, praSortList];
end;

procedure TGroupFooterBandEditor.GetValues(AValues: TStrings);
var
  i: Integer;
  t: TRMView;
  lList: TList;
begin
  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (GetInstance(0) <> t) and
      (TRMCustomBandView(t).BandType in [rmbtGroupHeader]) then
      aValues.Add(t.Name);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TResetGroupNameEditor }

function TResetGroupNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praMultiSelect, praValueList, praSortList];
end;

procedure TResetGroupNameEditor.GetValues(AValues: TStrings);
var
  i: Integer;
  t: TRMView;
  lList: TList;
begin
  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if t.IsBand and (GetInstance(0) <> t) and
      (TRMCustomBandView(t).BandType in [rmbtGroupHeader]) then
      aValues.Add(t.Name);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}