aprstped.pas

来自「delphi编程控件」· PAS 代码 · 共 843 行 · 第 1/2 页

unit aprstped;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface
{$I aclver.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, aprstore, TypInfo, CommCtrl, autostrs
  {$IFDEF DELPHI4}, ImgList {$ENDIF};

type
  TfAutoPropertiesStoreEdit = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    PageControl1: TPageControl;
    TSAll: TTabSheet;
    TreeView: TTreeView;
    BOK: TButton;
    BCancel: TButton;
    RViewType: TRadioGroup;
    GTypeKinds: TGroupBox;
    CBAllTypeKinds: TCheckBox;
    LBTypeKinds: TListBox;
    ImageList1: TImageList;
    TSStoredProp: TTabSheet;
    TreeView1: TTreeView;
    TSNonStoredProp: TTabSheet;
    TreeView2: TTreeView;
    BHelp: TButton;
    Store: TAutoPropertiesStore;
    ProgressBar: TProgressBar;
    LHelp1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RViewTypeClick(Sender: TObject);
    procedure CBAllTypeKindsClick(Sender: TObject);
    procedure LBTypeKindsClick(Sender: TObject);
    procedure TreeViewKeyPress(Sender: TObject; var Key: Char);
    procedure TreeViewDblClick(Sender: TObject);
    procedure TreeView1KeyPress(Sender: TObject; var Key: Char);
    procedure TreeView2KeyPress(Sender: TObject; var Key: Char);
    procedure TreeView1DblClick(Sender: TObject);
    procedure TreeView2DblClick(Sender: TObject);
    procedure BHelpClick(Sender: TObject);
  private
    ComponentList : TStringList;
    ClassList : TStringList;
    PropNameList : TStringList;
    Form : TForm;

    procedure AddProperties(treenode : TTreeNode; AClassInfo : Pointer;
              AKind: TTypeKinds; const PropName : String; SubTypeFlag : Boolean;
              AObject : TPersistent);
    procedure FillPropNameList(AKind: TTypeKinds);
    function GetTypeKinds :  TTypeKinds;
    procedure BuildDefualtTree;
    procedure BuildClassesTree;
    procedure BuildPropertiesTree;
    procedure BuildClassPropertiesTree;
    procedure BuildPropertiesClassTree;
    procedure ChangeStoredProperty(ATreeNode : TTreeNode);
    function IsStoredProperty(Component : TComponent; PropName : String) : Boolean;
    procedure GetChildTreeNodes(AList : TList);
    procedure CreateDoubleTreeNode(AtreeNode : TTreeNode);
    procedure DeleteDoubleTreeNode(ATreeNode : TTreeNode);
    procedure TVKeyPress(ATreeView : TTreeView; var Key: Char);
    procedure TVDblClick(ATreeView : TTreeView);
  public
    FirstPropUpdate : Boolean;
    procedure Paint; override;   
    procedure UpdateComponentList;
    procedure UpdatePropTrees;
    procedure GetComponentByClasses(AClassName : ShortString; List : TStringList);
  end;

function AutoPropertiesStoreComponentEdit(AStore : TAutoPropertiesStore) : Boolean;

implementation


function AutoPropertiesStoreComponentEdit(AStore : TAutoPropertiesStore) : Boolean;
Var
  AForm : TfAutoPropertiesStoreEdit;
begin
  AForm := TfAutoPropertiesStoreEdit.Create(Nil);
  with AForm do begin
    Caption := LoadStr(AEC_PROPERTIESSTORE) + ': ' + AStore.Name;
    Store.Items := AStore.Items;
    Form :=  TForm(AStore.Owner);
    Top := Screen.Height div 10;
    Height := Screen.Height - Screen.Height div 8;    
    UpdateComponentList;
    FirstPropUpdate := True;
    ShowModal;
  end;
  if(AForm.ModalResult = mrOk) then begin
    AStore.Items := AForm.Store.Items;
    Result := True;
  end else Result := False;
  AForm.Free;
end;
{$R *.DFM}

procedure GetTreeNodeStructure(ATreeNode : TTreeNode; AList : TList);

procedure GetTreeNodeStructure_(ATreeNode : TTreeNode; AList : TList);
Var
  tr1 : TTreeNode;
begin
    if(ATreeNode.HasChildren) then begin
    tr1 := ATreeNode.GetFirstChild;
    while tr1 <> Nil do begin
      AList.Add(tr1);
      GetTreeNodeStructure_(tr1, AList);
      tr1 := ATreeNode.GetNextChild(tr1);
    end;
  end;
end;

begin
  AList.Clear;
  GetTreeNodeStructure_(ATreeNode, AList);
end;

procedure TfAutoPropertiesStoreEdit.Paint;
begin
  inherited;
  if(FirstPropUpdate) then begin
    FirstPropUpdate := False;
    LHelp1.Visible := False;
    Update;
    UpdatePropTrees;
  end;
end;

procedure TfAutoPropertiesStoreEdit.UpdateComponentList;
Var
  i : Integer;

begin
  ComponentList.AddObject(Form.Name, Form);
  ClassList.Add(Form.ClassName);
  for i := 0 to Form.ComponentCount - 1 do begin
    if(Form.Components[i].Name <> '') then begin
      ComponentList.AddObject(Form.Components[i].Name, Form.Components[i]);
      if(ClassList.IndexOf(Form.Components[i].ClassName) < 0) then
        ClassList.Add(Form.Components[i].ClassName)
    end;    
  end;
  ComponentList.Sort;
  ClassList.Sort;
end;

procedure TfAutoPropertiesStoreEdit.GetComponentByClasses(AClassName : ShortString; List : TStringList);
Var
  i : Integer;
begin
  List.Clear;
  for i := 0 to ComponentList.Count - 1 do
    if(ComponentList.Objects[i].ClassName = AClassName) then
      List.AddObject(ComponentList[i], ComponentList.Objects[i]);
end;

procedure TfAutoPropertiesStoreEdit.UpdatePropTrees;
Var
  List : TList;
  i : Integer;
  
  procedure SetCursor(AControl : TWinControl; ACursor : TCursor);
  Var
    i : Integer;
  begin
    AControl.Cursor := ACursor;
    for i := 0 to AControl.ControlCount - 1 do begin
      AControl.Controls[i].Cursor := ACursor;
      if(AControl.Controls[i] is TWinControl) then
        SetCursor(TWinControl(AControl.Controls[i]), ACursor);
    end;
  end;

begin
  case RViewType.ItemIndex of
    0: BuildDefualtTree;
    1: BuildClassesTree;
    2: BuildPropertiesTree;
    3: BuildClassPropertiesTree;
    4: BuildPropertiesClassTree;
  end;
  TreeView1.Items.Clear;
  TreeView2.Items.Clear;
  List := TList.Create;
  GetChildTreeNodes(List);
  ProgressBar.Max := List.Count;
  ProgressBar.Min := 0;
  LHelp1.Visible := False;
  SetCursor(self, crHourGlass);
  Application.ProcessMessages;
  ProgressBar.Visible := True;
  for i := 0 to List.Count - 1 do begin
    CreateDoubleTreeNode(TTreeNode(List[i]));
    ProgressBar.Position := i;
  end;
  ProgressBar.Visible := False;
  LHelp1.Visible := True;
  List.Free;
  SetCursor(self, crDefault);
end;

procedure TfAutoPropertiesStoreEdit.AddProperties(treenode : TTreeNode; AClassInfo : Pointer;
          AKind: TTypeKinds; const PropName : String; SubTypeFlag : Boolean; AObject : TPersistent);
Var
  i : Integer;
  FCount, FSize : Integer;
  FList : PPropList;
//  ftr : TTreeNode;
//  obj : TPersistent;
//  fClassInfo : Pointer;
//  fPTypeData : PTypeData;

  function IsThisClassType(fClassInfo : Pointer; AClassType : TClass) : Boolean;
  Var
   fPTD : PTypeData;
  begin
    fPTD := GetTypeData(fClassInfo);
    Result := False;
    while Not Result And (fPTD^.ClassType <> TObject) do begin
      if(fPTD^.ClassType = AClassType) then
        Result := True
      else fPTD := GetTypeData(fPTD.ParentInfo{$IFDEF DELPHI3_0}^{$ENDIF});
    end;
  end;

begin
  FCount := GetPropList(AClassInfo, AKind, nil);
  FSize := FCount * SizeOf(Pointer);
  GetMem(FList, FSize);
  GetPropList(AClassInfo, AKind, FList);
  for i := 0 to FCount - 1 do begin
    if(PropName = '') Or (CompareText(FList^[i]^.Name, PropName) = 0) then begin
      {ftr := }TreeView.Items.AddChild(treenode, FList^[i]^.Name);
{      if SubTypeFlag And (FList^[i]^.PropType.Kind = tkClass) then begin
        fClassInfo := FList^[i]^.PropType;
        obj := AObject;
        if IsthisClassType(fClassInfo, TPersistent)
        And Not IsthisClassType(fClassInfo, TComponent) then begin
          if (AObject <> Nil) And IsthisClassType(fClassInfo, TCollection) then begin
            obj := TPersistent(GetOrdProp(obj, FList^[i]));
            fClassInfo := TCollection(obj).Add.ClassInfo;
            obj := Nil;
          end;
          AddProperties(ftr, fClassInfo, AKind, PropName, True, obj);
        end;
      end;}
    end;
  end;
  FreeMem(FList, FSize);
end;

procedure TfAutoPropertiesStoreEdit.FillPropNameList(AKind: TTypeKinds);
Var
  i, j : Integer;
  FCount, FSize : Integer;
  FList : PPropList;
  SList : TStringList;
begin
  SList := TStringList.Create;
  PropNameList.Clear;
  for i := 0 to ClassList.Count - 1 do begin
    GetComponentByClasses(ClassList[i], SList);
    FCount := GetPropList(SList.Objects[0].ClassInfo, AKind, nil);
    FSize := FCount * SizeOf(Pointer);
    GetMem(FList, FSize);
    GetPropList(SList.Objects[0].ClassInfo, AKind, FList);
    for j := 0 to FCount - 1 do
      if(PropNameList.IndexOf(FList^[j]^.Name) < 0) then
        PropNameList.Add(FList^[j]^.Name);
    FreeMem(FList, FSize);
  end;
  PropNameList.Sort;
  SList.Free;
end;



function TfAutoPropertiesStoreEdit.GetTypeKinds :  TTypeKinds;
begin
  if CBAllTypeKinds.Checked then
    Result := tkProperties
  else begin
    Result := [];
    {$IFDEF DELPHI3_0}
    if(LBTypeKinds.Selected[0]) then
      Include(Result, tkArray);
    if(LBTypeKinds.Selected[1]) then
      Include(Result, tkChar);
    if(LBTypeKinds.Selected[2]) then
      Include(Result, tkClass);
    if(LBTypeKinds.Selected[3]) then
      Include(Result, tkEnumeration);
    if(LBTypeKinds.Selected[4]) then
      Include(Result, tkFloat);
    if(LBTypeKinds.Selected[5]) then
      Include(Result, tkInteger);
    if(LBTypeKinds.Selected[6]) then
      Include(Result, tkInterface);
    if(LBTypeKinds.Selected[7]) then
      Include(Result, tkLString);
    if(LBTypeKinds.Selected[8]) then
      Include(Result, tkRecord);
    if(LBTypeKinds.Selected[9]) then
      Include(Result, tkSet);
    if(LBTypeKinds.Selected[10]) then
      Include(Result, tkString);
    if(LBTypeKinds.Selected[11]) then
      Include(Result, tkVariant);
    if(LBTypeKinds.Selected[12]) then
      Include(Result, tkWChar);
    {$ELSE}
    if(LBTypeKinds.Selected[0]) then
      Include(Result, tkChar);
    if(LBTypeKinds.Selected[1]) then
      Include(Result, tkClass);
    if(LBTypeKinds.Selected[2]) then
      Include(Result, tkEnumeration);
    if(LBTypeKinds.Selected[3]) then
      Include(Result, tkFloat);
    if(LBTypeKinds.Selected[4]) then
      Include(Result, tkInteger);
    if(LBTypeKinds.Selected[5]) then
      Include(Result, tkLString);
    if(LBTypeKinds.Selected[6]) then
      Include(Result, tkLWString);
    if(LBTypeKinds.Selected[7]) then
      Include(Result, tkSet);
    if(LBTypeKinds.Selected[8]) then
      Include(Result, tkString);
    if(LBTypeKinds.Selected[9]) then
      Include(Result, tkVariant);
    if(LBTypeKinds.Selected[10]) then
      Include(Result, tkWChar);
    {$ENDIF}
  end;
end;

procedure TfAutoPropertiesStoreEdit.BuildDefualtTree;
Var
  i, j : Integer;
  trnode : TTreeNode;
  AKinds : TTypeKinds;
  FList : TList;
begin
  TreeView.Items.Clear;
  AKinds := GetTypeKinds;
  FList := TList.Create;
  for i := 0 to ComponentList.Count - 1 do begin
    trnode := TreeView.Items.Add(Nil, ComponentList[i]);
    AddProperties(trnode, ComponentList.Objects[i].ClassInfo, AKinds,
       '', True, TPersistent(ComponentList.Objects[i]));
    if Not trnode.HasChildren then   trnode.Free
    else begin
      GetTreeNodeStructure(trnode, FList);
      for j := 0 to FList.Count - 1 do
        if(IsStoredProperty(TComponent(ComponentList.Objects[i]), TTreeNode(FList[j]).Text)) then
          TTreeNode(FList[j]).StateIndex := 1;
    end;
  end;
  FList.Free;
end;

procedure TfAutoPropertiesStoreEdit.BuildClassesTree;
Var
  i, j, k : Integer;
  trnode, trcnode : TTreeNode;
  AKinds : TTypeKinds;
  List : TStringList;
  FList : TList;
begin
  TreeView.Items.Clear;
  AKinds := GetTypeKinds;
  List := TStringList.Create;
  FList := TList.Create;
  for i := 0 to ClassList.Count - 1 do begin
    GetComponentByClasses(ClassList[i], List);
    trcnode := TreeView.Items.Add(Nil, ClassList[i]);
    for j := 0 to List.Count - 1 do begin
      trnode := TreeView.Items.AddChild(trcnode, List[j]);
      AddProperties(trnode, List.Objects[j].ClassInfo, AKinds,
        '', True, TPersistent(List.Objects[j]));
      if Not trnode.HasChildren then trnode.Free
      else begin
        GetTreeNodeStructure(trnode, FList);
        for k := 0 to FList.Count - 1 do
          if(IsStoredProperty(TComponent(ComponentList.Objects[j]), TTreeNode(FList[k]).Text)) then
            TTreeNode(FList[k]).StateIndex := 1;
      end;
    end;
    if Not trcnode.HasChildren then trcnode.Free;
  end;
  List.Free;
  FList.Free;
end;

procedure TfAutoPropertiesStoreEdit.BuildClassPropertiesTree;
Var
  i, j, k : Integer;
  trcnode, trnode1 : TTreeNode;
  AKinds : TTypeKinds;
  List : TStringList;
  FList : TList;
begin
  TreeView.Items.Clear;
  AKinds := GetTypeKinds;
  List := TStringList.Create;
  FList := TList.Create;
  for i := 0 to ClassList.Count - 1 do begin
    GetComponentByClasses(ClassList[i], List);
    trcnode := TreeView.Items.Add(Nil, ClassList[i]);