objectinspec.~pas

delphi 写的delphi的程序 Handel is a free, standalone development tool created with Delphi 3 that enable

unit ObjectInspec;

interface

{$Include handel.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Grids, ExtCtrls,TypInfo,DsgnIntf, Buttons, Menus,
  DBTables, ImgList;

type
  TObjectInspector = class(TForm)
    PageControl1: TPageControl;
    TabProperty: TTabSheet;
    TabEvent: TTabSheet;
    Panel1: TPanel;
    ComponentList: TComboBox;
    FontDialog1: TFontDialog;
    PropertyBox: TListBox;
    EventBox: TListBox;
    cbValue: TComboBox;
    edProperty: TEdit;
    Browse: TPanel;
    InspectorMenu: TPopupMenu;
    StayOnTopItem: TMenuItem;
    HideItem: TMenuItem;
    HelpItem: TMenuItem;
    N9: TMenuItem;
    InformationItem: TMenuItem;
    StatusBar1: TStatusBar;
    cbEvent: TComboBox;
    TabCodeExplorer: TTabSheet;
    TreeView: TTreeView;
    TreeImages: TImageList;
    ExplorerMenu: TPopupMenu;
    AlphaSort1: TMenuItem;
    LineSort1: TMenuItem;
    N1: TMenuItem;
    ReFresh1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ComboValueChange(Sender: TObject);
    procedure StringGrid2DblClick(Sender: TObject);
    procedure PropertyBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure PropertyBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PropertyBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PropertyBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure EventBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure EventBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EventBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure EventBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PropertyBoxClick(Sender: TObject);
    procedure PropertyBoxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EventBoxClick(Sender: TObject);
    procedure cbValueDblClick(Sender: TObject);
    procedure BrowseClick(Sender: TObject);
    procedure edPropertyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edPropertyKeyPress(Sender: TObject; var Key: Char);
    procedure cbValueChange(Sender: TObject);
    procedure cbValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cbValueDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormActivate(Sender: TObject);
    procedure ComponentListClick(Sender: TObject);
   // procedure edEventDblClick(Sender: TObject);
    procedure PropertyBoxDblClick(Sender: TObject);
    procedure HideItemClick(Sender: TObject);
    procedure StayOnTopItemClick(Sender: TObject);
    procedure InformationItemClick(Sender: TObject);
    procedure cbEventDblClick(Sender: TObject);
    procedure cbEventKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeViewDblClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure AlphaSort1Click(Sender: TObject);
    procedure LineSort1Click(Sender: TObject);
    procedure ReFresh1Click(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure cbEventClick(Sender: TObject);
  private
    { Private declarations }
    EventCount:integer;
    fComponent: TComponent;
    fPropertyName : string;
    fPropertyAttr: TPropertyAttributes;
    PropertyList: TStringList;
    EventList: TStringList;
    SubPos:Integer;
    HalfWay: Integer;
    EditRect: TRect;
    SplitDrag: Boolean;
    fPropertyEditor: TPropertyEditor;
    function  ExtractComponentName(const S:string):string;
    procedure ClearProperties;
    procedure GetProperties(Component: TComponent);
    procedure GetPropEditor(Editor: TPropertyEditor);
    procedure GetEventEditor(Editor: TPropertyEditor);
    procedure SetEditor(Editor: TPropertyEditor);
    function  GetComponentName: string;
    function  GetComponent(var Wrapper:TComponent): TComponent;
    procedure EditorProperty;
    procedure PropSetValue(const Value: string);
    procedure UpdateValue;
    function  GetPropValue(Info:PPropInfo):TStringList;
    procedure InsertPropInfo(Info:PPropInfo;Sender:TObject);
    procedure DeletePropInfo(Info:PPropInfo;Sender:TObject);
    procedure SetEditBounds(AControl : TWinControl);
    procedure GetValueProc(const Value: string);
    procedure GetSubPropEditor(Editor: TPropertyEditor);
    function  GetPropertyName: string;
    function  GetEventName: string;
    function  GetPropertyValueName: string;
    function  GetPropertyBoxValue(DBName:string): string ;
    function  GetEventValueName: string;
    procedure SetPropertyValueName(Value:string) ;
    procedure SetcbValueIndex(Text:string);
    procedure ShowHelp;
    procedure GetPrpoertyItemList(ClassName:string;CanParent:Boolean);
    function  GetClassList(ClassName:string;CanParent:Boolean):string;
    function  ExtractComponentType(const S:string):string;
    procedure GetDatabaseNameList;
    procedure GetTableNameList;
    procedure GetEventValueProc(const Value: string);
    function  GetItemIndex(Component: TComponent): Integer;
  protected
    procedure Initialize(Component: TComponent);
  public
    { Public declarations }
     constructor CreateMain(Owner: TComponent; Component: TComponent);
     function  WritePropInfo(Info:PPropInfo;I:integer;Sender:TObject):string;
     procedure WritePropertyInfo(Info:PTypeInfo;Data:PTypeData;Sender:TObject);
     procedure GetPropertyInfo(Sender: TObject);
     procedure DisplayProperty(Wrapper,Component:TComponent);
     procedure InitializeInspector;
     procedure EditEventHandler(Index: Integer);
     procedure InsertIntoList(Item: string; LineNumber: Integer; Child: Boolean);
     property  PropertyEditor: TPropertyEditor read fPropertyEditor;
     property  PropertyName: string read GetPropertyName write fPropertyName;
     property  SelectComponent: TComponent read fComponent write fComponent;
     property  PropAttrs: TPropertyAttributes read fPropertyAttr;
 end;

var
  ObjectInspector: TObjectInspector;

implementation

uses Proxy, MainForm, utype, Editor,propedit,uconst, rttiinfo;

type
   TIntegerSet=set of 0..Sizeof(Integer)*8-1;

{$R *.DFM}

  TParamFlag = (pfVar, pfConst, pfArray);
  TParamFlags = set of TParamFlag;
  PParamString = PShortString;
  TParamInfo = record
    Flags: TParamFlags;
    ParamName: PParamString;
    ParamType: PParamString;
  end;
  TParamList = array[0..255] of TParamInfo;
  PParamList = ^TParamList;


{ Like 'is,' but works with a string. }
function IsA(PI : PTypeInfo; S : String) : Boolean;
var
   PTD : PTypeData;
   PTI : PTypeInfo;
   Found : Boolean;
Begin
  Found := False;
  S := UpperCase(S);
  PTI := PI;
  while (not Found) and (UpperCase(PTI^.Name) <> 'TOBJECT') do
  begin
    Found := UpperCase(PTI^.Name) = S;
    PTD := GetTypeData(PTI);
    PTI := PTD^.ParentInfo^;
  end;
  IsA := Found;
End;

{ Get the infromation for a parameter list, and store
  it in the ParamList argument. }
procedure GetParamInfo(Data: PTypeData; var Params: TParamList;
                       var ReturnType: PParamString);
var
  I: Integer;
  Ptr: PByte;
begin
  with Data^ do
  begin
    Ptr := PByte(@ParamList);
    for I := 0 to ParamCount-1 do
      with Params[I] do
      begin
        Flags := TParamFlags(Ptr^);
        Inc(Ptr);
        ParamName := PParamString(Ptr);
        Inc(Ptr, Length(ParamName^) + 1);
        ParamType := PParamString(Ptr);
        Inc(Ptr, Length(ParamType^) + 1);
      end;
    if MethodKind = mkFunction then
      ReturnType := PParamString(Ptr);
  end;
end;

{ Write the information for a method, including all the parameters.
  If the method is a function, then show the return type, too. }

function WriteMethodData(Data: PTypeData):string;
var
  I: Integer;
  Params: PParamList;
  Return: PParamString;
  MethodPara:string;
begin
  with Data^ do
  begin
    { Allocate memory to hold all the parameter information }
    GetMem(Params, ParamCount * SizeOf(TParamInfo));
    try
      GetParamInfo(Data, Params^, Return);
      { Write each parameter: }
      for I := 0 to ParamCount-1 do
        with Params^[I] do
        begin
          if pfVar in Flags then
            MethodPara:=MethodPara+'var ';
          if pfConst in Flags then
            MethodPara:=MethodPara+'const ';
          MethodPara:=MethodPara+ParamName^+ ': ';
          if pfArray in Flags then
            MethodPara:=MethodPara+'array of ';
          MethodPara:=MethodPara+ParamType^+';';
        end;
    finally
      FreeMem(Params, ParamCount * SizeOf(TParamInfo));
    end;
  end;
  if MethodPara[Length(MethodPara)]=';' then
     MethodPara:=Copy(MethodPara,1,Length(MethodPara)-1);
  Result:=MethodPara;
end;

// Custom Sort Procedure for treeview
function CustomSortProc(node1, node2: TTreenode; Data: Integer): Integer; stdcall;
begin
 Result := 0;
 // else sort on linenumbers
  if Integer(node1.Data) > Integer(node2.Data) then Result := 1;
  if Integer(node1.Data) < Integer(node2.Data) then Result := -1;
end;

constructor TObjectInspector.CreateMain(Owner: TComponent; Component: TComponent);
begin
  inherited Create(Owner);
  Initialize(Component);
  GetProperties(Component);
end;

function TObjectInspector.WritePropInfo(Info:PPropInfo;I:integer;Sender:TObject):string;
// 漂沥茄 加己 肚绰 捞亥飘俊 措茄 蔼阑 倒妨霖促.
var
   PropValue, Temp:string;
   OrdValue,MinVal,MaxVal:integer;
   Data:PTypeData;
   S:TIntegerSet;
   J:Integer;
   TypeInfo1:PTypeInfo;
   MethodValue: TMethod;
begin
    Result:= '';
    PropValue:= '';
    if Sender = nil then Exit;
    if Info^.PropType^.Kind = tkMethod then
    begin
       MethodValue:= GetMethodProp(Sender,Info);
       if (MethodValue.Code <> nil) then
          PropValue:= ProxyDesigner.GetMethodName(MethodValue)
       else
       begin
          Temp:= TControl(Sender).Name + Copy(Info^.Name, 3, Length(Info^.Name));
          J:= ProxyDesigner.Methods.IndexOf(Temp);
          if J <> -1 then PropValue:= ProxyDesigner.Methods[J];
       end;
       Inc(EventCount,1);
    end
    else
    begin
      case Info^.PropType^.Kind of
          tkString,tkLString:
             PropValue:= GetStrProp(Sender,Info);
          tkEnumeration:
          begin
              OrdValue:= GetOrdProp(Sender,Info);
              if Info.Name = 'BOOLEAN' then
              begin
                  if OrdValue = 0 then PropValue:= 'False'
                  else PropValue:= 'True'
              end
              else
              begin
                  PropValue:= GetEnumName(Info.PropType^,OrdValue);
              end;
          end;
          tkClass:
          begin
              Data:= GetTypeData(Info^.PropType^);
              if Data^.PropCount>0 then
                 PropValue:= '('+Data^.ClassType.ClassName+')';
          end;
          tkInteger:
          begin
              OrdValue := GetOrdProp(Sender,Info);
              PropValue:= UpperCase(Info.Name);
              if Pos('COLOR',PropValue)>0 then // 加己捞 Color牢 版快
                 PropValue:= ColorToString(TColor(OrdValue))
              else if Pos('CURSOR',PropValue)>0 then // 加己捞 cursor牢 版快
                 PropValue:= CursorToString(TCursor(OrdValue))
              else PropValue:= IntToStr(OrdValue);
          end;
          tkSet:
          begin
              Data:= GetTypeData(Info^.PropType^);
              TypeInfo1:= Data^.CompType^;
              Data  := GetTypeData(TypeInfo1);
              MinVal:= Data^.MinValue;
              MaxVal:= Data^.MaxValue;
              Integer(S):= GetOrdProp(Sender,Info);
              PropValue:='[';
              for J:=MinVal to MaxVal do
                if I in S then
                begin
                    if Length(PropValue)<>1 then PropValue:= PropValue+',';
                    PropValue:= PropValue + GetEnumName(TypeInfo1,J);
                 end;
              PropValue:= PropValue+']';
          end;
       end;
    end;
    Result:= PropValue;
end;

procedure TObjectInspector.InsertPropInfo(Info:PPropInfo;Sender:TObject);
// 窍困 加己阑 啊瘤绰 加己狼 窍困 加己阑 焊咯霖促.
var
   PropName, PropValue, Prop:string;
   Data:PTypeData;
   I, Count:Integer;
   TypeInfo:PTypeInfo;
   PropList:PPropList;
begin
   if Info = nil then Exit;
   if Sender<>nil then
   begin
      TypeInfo:= Info^.PropType^;
      Count:= GetPropList(TypeInfo,tkProperties,nil);
      GetMem(PropList, Count*SizeOf(PPropInfo));
      GetPropInfos(TypeInfo, PropList);
      case Info^.PropType^.Kind of
          tkClass:
          begin
              Data:= GetTypeData(Info^.PropType^);
              for I:=0 to Data^.PropCount - 1 do
              begin
                 PropName:= '  ' + PropList^[I].Name;
                 Prop:= Format('%-20s%-20s',[PropName, PropValue]);
                 PropertyBox.Items.Insert(PropertyBox.ItemIndex + 1, Prop);
              end;
          end;
      end;
      FreeMem(PropList, Count*SizeOf(PPropInfo));
   end;
end;

procedure TObjectInspector.DeletePropInfo(Info:PPropInfo;Sender:TObject);
// 窍困 加己阑 啊瘤绰 加己狼 窍困 加己阑 瘤款促.
var
   Data:PTypeData;
   I,MinVal,MaxVal:Integer;
   TypeInfo:PTypeInfo;
begin
   if Info = nil then Exit;
   if Sender <> nil then
   begin
      case Info^.PropType^.Kind of
          tkClass:
          begin
              Data:= GetTypeData(Info^.PropType^);
              for I:= Data^.PropCount - 1 downto 0 do
              begin
                 PropertyList.Delete(PropertyBox.ItemIndex + I + 1);
                 PropertyBox.Items.Delete(PropertyBox.ItemIndex + I + 1);
              end;
          end;
          tkSet:
          begin
              Data    := GetTypeData(Info^.PropType^);
              TypeInfo:= Data^.CompType^;
              Data    := GetTypeData(TypeInfo);
              MinVal  := Data^.MinValue;
              MaxVal  := Data^.MaxValue;
              for I:= MaxVal-MinVal  downto 0 do
              begin
                 PropertyList.Delete(PropertyBox.ItemIndex + I + 1);
                 PropertyBox.Items.Delete(PropertyBox.ItemIndex + I + 1);
              end;
          end;
      end;
   end;
end;

procedure TObjectInspector.WritePropertyInfo(Info:PTypeInfo;Data:PTypeData;Sender:TObject);
// 漂沥茄 努贰胶俊 措茄 加己苞 捞亥飘 沥焊甫 炼荤茄促.
var
   I,Count,Count1:integer;
   PropList,PropList1:PPropList;
   Prop:string;

procedure AddPropItem(ListBox:TListBox;Info:PPropInfo);
var
  Editor: TPropertyEditor;