rm_propinsp.pas

这是一个功能强大

    property OnFilterProp;
    property OnGetCaptionColor;
    property OnGetEditorClass;
    property OnClick;
{$IFDEF COMPILER5_UP}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses RM_EditorStrings, RM_Const, RM_Utils, RM_Class;

{$R RM_LNG5.RES}

const
  SNull = '(Null)';
  SString = 'String';
  SUnknown = '(Unknown)';
  SUnknownType = 'Unknown Type';
  srUnknown = '(Unknown)';
  srNone = '(None)';

{$IFDEF COMPILER6_UP}
  VarTypeNames: array[varEmpty..varInt64] of string = (
    'Unassigned', // varEmpty
    'Null', // varNull
    'Smallint', // varSmallint
    'Integer', // varInteger
    'Single', // varSingle
    'Double', // varDouble
    'Currency', // varCurrency
    'Date', // varDate
    'OleStr', // varOleStr
    '', // varDispatch
    '', // varError
    'Boolean', // varBoolean
    '', // varVariant
    '', // varUnknown
    '', // [varDecimal]
    '', // [undefined]
    'Shortint', // varShortInt
    'Byte', // varByte
    'Word', // varWord
    'LongWord', // varLongWord
    'Int64'); // varInt64
{$ELSE}
  VarTypeNames: array[0..varByte] of string = ('Unassigned', 'Null', 'Smallint',
    'Integer', 'Single', 'Double', 'Currency', 'Date', 'OleStr', '', '',
    'Boolean', '', '', '', '', '', 'Byte');
{$ENDIF}

{$IFDEF COMPILER6_UP}
  ModalResults: array[mrNone..mrYesToAll] of string = (
    'mrNone',
    'mrOk',
    'mrCancel',
    'mrAbort',
    'mrRetry',
    'mrIgnore',
    'mrYes',
    'mrNo',
    'mrAll',
    'mrNoToAll',
    'mrYesToAll');
{$ELSE}
  ModalResults: array[mrNone..mrYesToAll] of string = (
    'mrNone',
    'mrOk',
    'mrCancel',
    'mrAbort',
    'mrRetry',
    'mrIgnore',
    'mrYes',
    'mrNo',
    'mrAll',
    'mrNoToAll',
    'mrYesToAll');
{$ENDIF}

{$IFDEF COMPILER6_UP}
  ShortCuts: array[0..108] of TShortCut = (
    scNone,
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    Byte('A') or scCtrl or scAlt,
    Byte('B') or scCtrl or scAlt,
    Byte('C') or scCtrl or scAlt,
    Byte('D') or scCtrl or scAlt,
    Byte('E') or scCtrl or scAlt,
    Byte('F') or scCtrl or scAlt,
    Byte('G') or scCtrl or scAlt,
    Byte('H') or scCtrl or scAlt,
    Byte('I') or scCtrl or scAlt,
    Byte('J') or scCtrl or scAlt,
    Byte('K') or scCtrl or scAlt,
    Byte('L') or scCtrl or scAlt,
    Byte('M') or scCtrl or scAlt,
    Byte('N') or scCtrl or scAlt,
    Byte('O') or scCtrl or scAlt,
    Byte('P') or scCtrl or scAlt,
    Byte('Q') or scCtrl or scAlt,
    Byte('R') or scCtrl or scAlt,
    Byte('S') or scCtrl or scAlt,
    Byte('T') or scCtrl or scAlt,
    Byte('U') or scCtrl or scAlt,
    Byte('V') or scCtrl or scAlt,
    Byte('W') or scCtrl or scAlt,
    Byte('X') or scCtrl or scAlt,
    Byte('Y') or scCtrl or scAlt,
    Byte('Z') or scCtrl or scAlt,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);
{$ELSE}
  ShortCuts: array[0..108] of TShortCut = (
    scNone,
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    Byte('A') or scCtrl or scAlt,
    Byte('B') or scCtrl or scAlt,
    Byte('C') or scCtrl or scAlt,
    Byte('D') or scCtrl or scAlt,
    Byte('E') or scCtrl or scAlt,
    Byte('F') or scCtrl or scAlt,
    Byte('G') or scCtrl or scAlt,
    Byte('H') or scCtrl or scAlt,
    Byte('I') or scCtrl or scAlt,
    Byte('J') or scCtrl or scAlt,
    Byte('K') or scCtrl or scAlt,
    Byte('L') or scCtrl or scAlt,
    Byte('M') or scCtrl or scAlt,
    Byte('N') or scCtrl or scAlt,
    Byte('O') or scCtrl or scAlt,
    Byte('P') or scCtrl or scAlt,
    Byte('Q') or scCtrl or scAlt,
    Byte('R') or scCtrl or scAlt,
    Byte('S') or scCtrl or scAlt,
    Byte('T') or scCtrl or scAlt,
    Byte('U') or scCtrl or scAlt,
    Byte('V') or scCtrl or scAlt,
    Byte('W') or scCtrl or scAlt,
    Byte('X') or scCtrl or scAlt,
    Byte('Y') or scCtrl or scAlt,
    Byte('Z') or scCtrl or scAlt,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);
{$ENDIF}

type
  TCustomListBoxAccess = class(TCustomListBox);

var
  FSaveOnAfterInitEvent: TRMRMOnAfterInit;
  FPropInfoList: TRMPropInfoList = nil;

procedure ELGetObjectsProps(ADesigner: Pointer; AObjList: TList; AKinds: TTypeKinds;
  AOnlyNestable: Boolean; AGetEditorClassProc: TELGetEditorClassProc; AResult: TList);

type
  TObjProps = record
    Props: PPropList;
    Count: Integer;
  end;

var
  LPropLists: array of TObjProps;
  LIntersection: array of array of PPropInfo;
  LI, LJ, LK, LIndex, LObjCount: Integer;
  LEditorClass: TELPropEditorClass;
  LEditor: TELPropEditor;
  LAttrs: TELPropAttrs;
  LObj: TPersistent;

begin
  LObjCount := AObjList.Count;
    { Create prop lists }
  SetLength(LPropLists, LObjCount);
  for LI := 0 to LObjCount - 1 do
  begin
    LObj := AObjList[LI];
    LPropLists[LI].Count := GetPropList(LObj.ClassInfo, AKinds, nil);
    GetMem(LPropLists[LI].Props, LPropLists[LI].Count * SizeOf(Pointer));
    try
      GetPropList(LObj.ClassInfo, AKinds, LPropLists[LI].Props);
    except
      FreeMem(LPropLists[LI].Props);
      raise;
    end;
  end;
  try
        { Initialize intersection }
    SetLength(LIntersection, LPropLists[0].Count);
    for LI := 0 to LPropLists[0].Count - 1 do
    begin
      SetLength(LIntersection[LI], LObjCount);
      LIntersection[LI][0] := LPropLists[0].Props[LI];
    end;
        { Intersect }
    for LI := 1 to LObjCount - 1 do
      for LJ := High(LIntersection) downto 0 do
      begin
        LIndex := -1;
        for LK := 0 to LPropLists[LI].Count - 1 do
          if (LPropLists[LI].Props[LK].PropType^ = LIntersection[LJ][0].PropType^) and
            SameText(LPropLists[LI].Props[LK].Name, LIntersection[LJ][0].Name) then
          begin
            LIndex := LK;
            Break;
          end;
        if LIndex <> -1 then
          LIntersection[LJ][LI] := LPropLists[LI].Props[LK]
        else
        begin
          for LK := LJ + 1 to High(LIntersection) do
            LIntersection[LK - 1] := LIntersection[LK];
          SetLength(LIntersection, Length(LIntersection) - 1);
        end;
      end;
        { Create property editors }
    for LI := 0 to High(LIntersection) do
    begin
                { Determine editor class }
      LEditorClass := AGetEditorClassProc(TPersistent(AObjList[0]), LIntersection[LI][0]);
      for LJ := 0 to LObjCount - 1 do
        if AGetEditorClassProc(TPersistent(AObjList[LJ]), LIntersection[LI][LJ]) <> LEditorClass then
        begin
          LEditorClass := nil;
          Break;
        end;
                { Create editor }
      if LEditorClass <> nil then
      begin
        LEditor := LEditorClass.Create(ADesigner, AObjList.Count);
        try
          for LJ := 0 to AObjList.Count - 1 do
            LEditor.SetPropEntry(LJ, TPersistent(AObjList[LJ]), LIntersection[LI][LJ]);
          LAttrs := LEditor.GetAttrs;
          if ((LObjCount = 1) or (praMultiSelect in LAttrs)) and
            (not AOnlyNestable or not (praNotNestable in LAttrs)) then
            AResult.Add(LEditor)
          else