rm_insp.pas

这是一个功能强大

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 COMPILER6_UP}, 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;
{$IFNDEF COMPILER7_UP}
    FObjects: TStrings;
{$ENDIF}

    FOnGetObjects: TGetObjectsEvent;
    FOnSelectionChanged: TSelectionChangedEvent;

    function GetSplitterPos: Integer;
    procedure SetSplitterPos(Value: Integer);
    function GetSplitterPos1: Integer;
    procedure SetSplitterPos1(Value: Integer);
    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 WMLButtonDBLCLK(var Message: TWMNCLButtonDown); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDBLCLK(var Message: TWMNCRButtonDown); message WM_RBUTTONDBLCLK;
    procedure OnMoveEvent(Sender: TObject);
    function GetObjects: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure AddObject(aObject: TPersistent);
    procedure AddObjects(aObjects: array of TPersistent);
    procedure ClearObjects;
    procedure SetCurrentObject(aClassName, aName: string);
    procedure SetCurReport(aObject: TObject);
    procedure RestorePos;
    procedure Localize;

    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 Objects: TStrings read GetObjects;
    property cmbObjects: TComboBox read FcmbObjects;
  end;

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

implementation

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

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;

  TDataSetEditor = 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;

  {created by dejoy}
  TMethodEditor = class(TELClassPropEditor)
  private
  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;

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

  TStyleNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(aValues: TStrings); 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.ToolBar2.Visible := True;
  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;
  lParent: TPersistent;
  lCrossBand: Boolean;
begin
  lParent := GetInstance(0);
  lCrossBand := False;
  if (lParent is TRMCustomBandView) and TRMCustomBandView(lParent).IsCrossBand then
    lCrossBand := True;

  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (t <> lParent) then
    begin
      if lCrossBand and (TRMCustomBandView(t).BandType in [rmbtCrossChild]) then
        aValues.Add(t.Name);
      if (not lCrossBand) and (TRMCustomBandView(t).BandType in [rmbtChild]) then
        aValues.Add(t.Name);
    end;
  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;
  lParent: TPersistent;
  lCrossBand: Boolean;
begin
  lParent := GetInstance(0);
  lCrossBand := False;
  if (lParent is TRMCustomBandView) and TRMCustomBandView(lParent).IsCrossBand then
    lCrossBand := True;

  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (t <> lParent) then
    begin
      if lCrossBand and (TRMCustomBandView(t).BandType in [rmbtCrossMasterData, rmbtCrossDetailData]) then
        aValues.Add(t.Name);
      if (not lCrossBand) and (TRMCustomBandView(t).BandType in [rmbtMasterData, rmbtDetailData]) then
        aValues.Add(t.Name);
    end;
  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;
  lParent: TPersistent;
  lCrossBand: Boolean;
begin
  lParent := GetInstance(0);
  lCrossBand := False;
  if (lParent is TRMCustomBandView) and TRMCustomBandView(lParent).IsCrossBand then
    lCrossBand := True;

  lList := RMDesigner.PageObjects;
  for i := 0 to lList.Count - 1 do
  begin
    t := lList[i];
    if (t.IsBand) and (t <> lParent) then
    begin
      if lCrossBand and (TRMCustomBandView(t).BandType in [rmbtCrossGroupHeader]) then
        aValues.Add(t.Name);
      if (not lCrossBand) and (TRMCustomBandView(t).BandType in [rmbtGroupHeader]) then
        aValues.Add(t.Name);
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDataSetEditor }

function TDataSetEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog];
end;

procedure TDataSetEditor.Edit;
var
  tmp: TRMBandEditorForm;
begin
  tmp := TRMBandEditorForm.Create(nil);
  try
    if tmp.ShowEditor(TRMView(GetInstance(0))) = mrOK then
      SetStrValue(TRMBandMasterData(GetInstance(0)).DataSetName);
  finally
    tmp.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TGroupConditionEditor }

function TGroupConditionEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog];
end;