objectinspec.pas

一个模拟Delphi的快速开发环境RAD

unit ObjectInspec;

interface

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

type
  TObjectInspector = class(TForm)
    PageControl1: TPageControl;
    TabProperty: TTabSheet;
    TabEvent: TTabSheet;
    Panel1: TPanel;
    ComponentList: TComboBox;
    FontDialog1: TFontDialog;
    StatusBar1: TStatusBar;
    PropertyBox: TListBox;
    EventBox: TListBox;
    cbValue: TComboBox;
    edProperty: TEdit;
    Browse: TPanel;
    edEvent: TEdit;
    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);
  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  GetEventValueName: string;
    procedure SetPropertyValueName(Value:string) ;
    procedure SetcbValueIndex(Text:string);
  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;
     property  PropertyEditor: TPropertyEditor read fPropertyEditor;
     property  PropertyName: string read fPropertyName write fPropertyName;
     property  SelectComponent: TComponent read fComponent write fComponent;
     property  PropAttrs: TPropertyAttributes read fPropertyAttr;
 end;

var
  ObjectInspector: TObjectInspector;

implementation

uses Proxy, MainForm, utype, Editor,URegister,uconst;

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;

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:string;
   OrdValue,MinVal,MaxVal:integer;
   Data:PTypeData;
   S:TIntegerSet;
   J:Integer;
   TypeInfo1:PTypeInfo;
   MethodValue: TMethod;
begin
    Result:= '';
    if Sender = nil then Exit;
    if Info^.PropType^.Kind=tkMethod then begin
       MethodValue:= GetMethodProp(Sender,Info);
     //  PropValue:=(Designer as TProxyDesigner).GetMethodName(MethodValue);
       PropValue:= '';
       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;
                // PropValue:= WritePropInfo(PropList^[I], 0, Sender);
                 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);
begin
    if Info^.PropType^.Kind in [tkClass] then begin
       if IsA(Info^.PropType^, 'TCOMPONENT') then
          ListBox.Items.Add(Format('%-20s',[Info^.Name])+ Prop)
       else ListBox.Items.Add(Format('+%-20s',[Info^.Name])+ Prop);
    end
    else if Info^.PropType^.Kind in [tkSet] then
       ListBox.Items.Add(Format('+%-20s',[Info^.Name])+ Prop)
    else ListBox.Items.Add(Format('%-20s',[Info^.Name])+ Prop);
end;
begin
    EventCount:=0;
    Count:=GetPropList(Info,tkProperties,nil);   // 厚捞亥飘 加己狼 肮荐
    Count1:=GetPropList(Info,tkMethods,nil);   // 捞亥飘 加己狼 肮荐
    GetMem(PropList,Count*SizeOf(PPropInfo));
    GetMem(PropList1,Count1*SizeOf(PPropInfo));
    try
       GetPropList(Info,tkProperties,PropList);
       for I:=0 to Count-1 do begin
          Prop:= WritePropInfo(PropList^[I],I,Sender);
          AddPropItem(PropertyBox, PropList^[I]);
       end;
       GetPropList(Info,tkMethodS,PropList1);
       for I:=0 to Count1-1 do begin
          Prop:=WritePropInfo(PropList1^[I],I,Sender);
          AddPropItem(EventBox, PropList1^[I]);
       end;
    finally
       FreeMem(PropList,Count*SizeOf(PPropInfo));
       FreeMem(PropList1,Count1*SizeOf(PPropInfo));
    end;
end;

procedure TObjectInspector.ClearProperties;
begin
   PropertyBox.Clear;
   EventBox.Clear;
   PropertyList.Clear;
end;

// 哪欺惩飘俊 措茄 加己苞 捞亥飘 格废 弊府绊 弊 蔼阑 掘绰促.
procedure TObjectInspector.GetPropertyInfo(Sender: TObject);
var
  Info:PTypeInfo;
  Data:PTypeData;
begin
   Info:=Sender.ClassInfo;
   Data:=GetTypeData(Info);
   GetProperties(Sender as TComponent);
   WritePropertyInfo(Info,Data,Sender);
end;

{ The user has chosen a property, so get the editor,
  and initialize the property editor fields. }
procedure TObjectInspector.SetEditor(Editor: TPropertyEditor);
begin
   fPropertyEditor:=Editor;
   if Editor= nil then  Exit;
   Editor.Activate;
   fPropertyAttr:=Editor.GetAttributes;
   if (paDialog in PropAttrs) then SetEditBounds(Browse)
   else SetEditBounds(nil);
   cbValue.Clear;
   //加己捞 捞亥飘啊 酒聪绊 格废阑 啊瘤绊 乐栏搁 加己蔼狼 格废阑 焊咯霖促.
   if ((paValueList in PropAttrs) and (Editor.ClassName<>'TMethodProperty')) then begin
      Editor.GetValues(GetValueProc);
      SetEditBounds(cbValue);