⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 propstorageediteh.pas

📁 最新的 DBGRIDEH4.0
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{*******************************************************}
{                                                       }
{                       EhLib v3.6c1                    }
{                                                       }
{                   PropStorage editor                  }
{                                                       }
{       Copyright (c) 2002-2004 by Dmitry V. Bolshakov  }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}
//{$I EhLibClx.Inc}

{$IFDEF EH_LIB_CLX}
unit QPropStorageEditEh;
{$ELSE}
unit PropStorageEditEh {$IFDEF CIL} platform {$ENDIF};
{$ENDIF}

interface

uses
{$IFDEF EH_LIB_CLX}
  QPropStorageEh, QPropFilerEh, QStdCtrls, QComCtrls, QButtons,
  QControls, QForms, QImgList, QCheckLst, QExtCtrls,
{$ELSE}
  PropStorageEh, PropFilerEh, StdCtrls, ComCtrls, Buttons,
  Controls, Forms, ImgList, CheckLst, ExtCtrls, Windows,

{$IFDEF CIL}
  EhLibVCLNET,
{$ELSE}
  EhLibVCL,
{$ENDIF}

{$ENDIF}
  SysUtils, TypInfo, Classes;

type
  TNodeTypeEh = (nthProperty, nthControl, nthPropNode);

  TNodeInfoEh = class
    Checked: Integer; //0 - No or 1 - Yes or 2 - Partially yes
    Instance: TObject;
    NodeType: TNodeTypeEh;
    IsVoidProperty: Boolean;
    Name: String;
    Path: String;
  end;

//  PNodeInfoEh = ^TNodeInfoEh;

  TPropStorageEditEhForm = class(TForm)
    spAddProp: TSpeedButton;
    sbRemoveAllProps: TSpeedButton;
    sbRemoveProp: TSpeedButton;
    TreeView1: TTreeView;
    TreeView2: TTreeView;
    bOk: TButton;
    bCancel: TButton;
    Bevel1: TBevel;
    ImageList1: TImageList;
    cbPredifinedProps: TCheckListBox;
    lCompsAndProps: TLabel;
    lStoredProps: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    spSynchTrees: TSpeedButton;
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TreeView1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView1GetSelectedIndex(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure spAddPropClick(Sender: TObject);
    procedure sbRemovePropClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sbRemoveAllPropsClick(Sender: TObject);
    procedure cbPredifinedPropsClickCheck(Sender: TObject);
    procedure TreeView1Compare(Sender: TObject; Node1, Node2: TTreeNode;
      Data: Integer; var Compare: Integer);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure spSynchTreesClick(Sender: TObject);
  protected
    function AddSortedChildObject(Parent: TTreeNode; const S: string; Data: TNodeInfoEh): TTreeNode;
    function CompareNode(Node1, Node2: TTreeNode): Integer;
    function CompareNodeData(Data1, Data2: TNodeInfoEh): Integer;
    function CreateNodeInfo(Component: TComponent; Name, Path: String;
      NodeType: TNodeTypeEh; IsVoidProperty: Boolean): TNodeInfoEh;
    function FindChildNodeInfo(N2, N1: TTreeNode): TTreeNode;
    function GetChildNodeByText(ParentNode: TTreeNode; Text: String): TTreeNode;
    function GetObjectPropList(AObject: TObject; var ObjPropCount: Integer): TPropListArray;//PPropList;
    function HaveCheckedChilds(N: TTreeNode): Boolean;
    procedure AddCollectionProperties(N: TTreeNode; O: TCollection; Path: String);
    procedure AddComponents(N: TTreeNode; O: TComponent; Path: String);
    procedure AddParentChecked(N: TTreeNode);
    procedure AddProperties(N: TTreeNode; O: TObject; Path: String; IsAddPropNode: Boolean);
    procedure AddPropertyNode(N: TTreeNode);
    procedure AddVoidProperty(N: TTreeNode);
    procedure ExchangeNode(Parent: TTreeNode; L, R: Integer);
    procedure MainAddPropertyNode(N: TTreeNode); overload;
    procedure MainAddPropertyNode(Path: String); overload;
    procedure MainDeletePropertyNode(N: TTreeNode); overload;
    procedure MainDeletePropertyNode(Path: String); overload;
    procedure MainToggle(N: TTreeNode);
    procedure QuickSort(Parent: TTreeNode; L, R: Integer);
    procedure RemovePropertyNode(N: TTreeNode);
    procedure ResetChildNodes(N: TTreeNode);
    procedure ResetParentNodes(N: TTreeNode);
    procedure SlaveDeleteNode(SN: TTreeNode);
  public
    LeftBorderWidth, RightBorderWidth, ButtonSize, VBottomMargin: Integer;
    OnIconDownNode: TTreeNode;
    PropStorage: TPropStorageEh;
    RootNode: TTreeNode;
    StartBuildTicks: LongWord;


    procedure BuildPredifinedProps;
    procedure BuildPropertyList;
    procedure BuildStoringPropertyList(PropList: TStrings);
    procedure GetStoringPorps(PropList: TStrings);
    procedure PropertyAdded(DN: TTreeNode);
    procedure PropertyDeleting(DN: TTreeNode);
    procedure UpdateButtonState;
  end;

{ TPredifinedPropsEh }

  TPredifinedPropsEh = class
  protected
    FCkecked: Boolean;
    FEditForm: TPropStorageEditEhForm;
    function Caption: String; virtual;
    function PropertyAdded(Component: TComponent; PropPath: String): Boolean; virtual;
    function PropertyDeleted(Component: TComponent; PropPath: String): Boolean; virtual;
    procedure SetCkecked(AChecked: Boolean); virtual;
    constructor Create(EditForm: TPropStorageEditEhForm); virtual;
  end;

  TPredifinedPropsEhClass = class of TPredifinedPropsEh;

{ TPredifinedActiveControlEh }

  TPredifinedActiveControlEh = class(TPredifinedPropsEh)
  protected
    FActiveControlAdded: Boolean;
    function Caption: String; override;
    function PropertyAdded(Component: TComponent; PropPath: String): Boolean; override;
    function PropertyDeleted(Component: TComponent; PropPath: String): Boolean; override;
    procedure SetCkecked(AChecked: Boolean); override;
  end;

{ TPredifinedPosPropertiesEh }

  TPredifinedPosPropertiesEh = class(TPredifinedPropsEh)
  protected
    FLeftAdded: Boolean;
    FTopAdded: Boolean;
    function Caption: String; override;
    function PropertyAdded(Component: TComponent; PropPath: String): Boolean; override;
    function PropertyDeleted(Component: TComponent; PropPath: String): Boolean; override;
    procedure SetCkecked(AChecked: Boolean); override;
  end;

{ TPredifinedSizePropertiesEh }

  TPredifinedSizePropertiesEh = class(TPredifinedPropsEh)
  protected
    FHeightAdded: Boolean;
    FPixelsPerInchAdded: Boolean;
    FWidthAdded: Boolean;
    function Caption: String; override;
    function PropertyAdded(Component: TComponent; PropPath: String): Boolean; override;
    function PropertyDeleted(Component: TComponent; PropPath: String): Boolean; override;
    procedure SetCkecked(AChecked: Boolean); override;
  end;

{ TPredifinedSizePropertiesEh }

  TPredifinedStatePropertiesEh = class(TPredifinedPropsEh)
  protected
    FStateAdded: Boolean;
    function Caption: String; override;
    function PropertyAdded(Component: TComponent; PropPath: String): Boolean; override;
    function PropertyDeleted(Component: TComponent; PropPath: String): Boolean; override;
    procedure SetCkecked(AChecked: Boolean); override;
  end;

procedure RegisterPredifinedPropsClass(PropsClass: TPredifinedPropsEhClass);

function EditPropStorage(PropStorage: TPropStorageEh): Boolean;

implementation

{$IFNDEF EH_LIB_CLX}
{$R *.dfm}
{$ELSE}
{$R *.xfm}
{$ENDIF}

var
  PredifinedPropsClassList: TList;

function EditPropStorage(PropStorage: TPropStorageEh): Boolean;
var
  PropStorageEditor: TPropStorageEditEhForm;
  OldCursor: TCursor;
{$IFNDEF EH_LIB_CLX}
  ticks: LongWord;
{$ENDIF}
begin
{$IFNDEF EH_LIB_CLX}
  ticks := GetTickCount;
{$ENDIF}
  Result := False;
  PropStorageEditor := TPropStorageEditEhForm.Create(Application);
  PropStorageEditor.PropStorage := PropStorage;
  OldCursor := Screen.Cursor;
  try
{$IFNDEF EH_LIB_CLX}
    PropStorageEditor.StartBuildTicks := GetTickCount;
{$ENDIF}
    PropStorageEditor.BuildPropertyList;
    PropStorageEditor.BuildPredifinedProps;
    PropStorageEditor.BuildStoringPropertyList(PropStorage.StoredProps);
  finally
    Screen.Cursor := OldCursor;
  end;
{$IFNDEF EH_LIB_CLX}
  PropStorageEditor.Edit1.Text := IntToStr(GetTickCount-ticks);
{$ENDIF}
  try
    if PropStorageEditor.ShowModal = mrOk then
    begin
      PropStorageEditor.GetStoringPorps(PropStorage.StoredProps);
      Result := True;
    end;
  finally
    PropStorageEditor.Free;
  end;
end;

procedure RegisterPredifinedPropsClass(PropsClass: TPredifinedPropsEhClass);
begin
  PredifinedPropsClassList.Add(TObject(PropsClass));
end;

function CompareNodeInfo(Pni1, Pni2: TNodeInfoEh): Boolean;
begin
  Result := (Pni1.Name = Pni2.Name) and (Pni1.NodeType = Pni2.NodeType)
end;

procedure TPropStorageEditEhForm.TreeView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{$IFNDEF EH_LIB_CLX}
 if (htOnIcon in TreeView1.GetHitTestInfoAt(X, Y)) {and not (ssDouble in Shift)} then
 begin
  OnIconDownNode := TreeView1.GetNodeAt(X, Y);
  if OnIconDownNode.ImageIndex < 8 then
  begin
    OnIconDownNode.ImageIndex := TNodeInfoEh(OnIconDownNode.Data).Checked + 4;
    OnIconDownNode.SelectedIndex := TNodeInfoEh(OnIconDownNode.Data).Checked + 4;
  end else
    OnIconDownNode := nil;
//  TreeView1.Invalidate;
 end else
  OnIconDownNode := nil;
{$ENDIF}
end;

procedure TPropStorageEditEhForm.TreeView1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
{$IFNDEF EH_LIB_CLX}
  if (OnIconDownNode <> nil) then
    if (htOnIcon in TreeView1.GetHitTestInfoAt(X, Y)) and
      (TreeView1.GetNodeAt(X, Y) = OnIconDownNode) then
    begin
      OnIconDownNode.ImageIndex := TNodeInfoEh(OnIconDownNode.Data).Checked + 4;
      OnIconDownNode.SelectedIndex := TNodeInfoEh(OnIconDownNode.Data).Checked + 4;
    end else
    begin
      OnIconDownNode.ImageIndex := TNodeInfoEh(OnIconDownNode.Data).Checked;
      OnIconDownNode.SelectedIndex := TNodeInfoEh(OnIconDownNode.Data).Checked;
    end;
{$ENDIF}
end;

procedure TPropStorageEditEhForm.TreeView1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (OnIconDownNode <> nil) then
{$IFNDEF EH_LIB_CLX}
    if (htOnIcon in TreeView1.GetHitTestInfoAt(X, Y)) and
      (TreeView1.GetNodeAt(X, Y) = OnIconDownNode) then
{$ENDIF}
    begin
      MainToggle(OnIconDownNode);
      TreeView1.Invalidate;
      OnIconDownNode := nil;
    end;
end;

procedure TPropStorageEditEhForm.MainToggle(N: TTreeNode);
begin
  if not (TNodeInfoEh(N.Data).NodeType = nthProperty) then Exit;
  if TNodeInfoEh(N.Data).Checked <> 1
    then MainAddPropertyNode(N)
    else MainDeletePropertyNode(N);
end;

procedure TPropStorageEditEhForm.MainAddPropertyNode(N: TTreeNode);
begin
  if not (TNodeInfoEh(N.Data).NodeType = nthProperty) or
    (TNodeInfoEh(N.Data).Checked = 1) then Exit;
//  TreeView1.Items.BeginUpdate;
//  TreeView2.Items.BeginUpdate;
  try
    N.ImageIndex := 1;
    N.SelectedIndex := 1;
    TNodeInfoEh(N.Data).Checked := 1;
    AddPropertyNode(N);
    AddParentChecked(N);
//    ResetParentNodes(N);
    ResetChildNodes(N);
  finally
//    TreeView1.Items.EndUpdate;
//    TreeView2.Items.EndUpdate;
  end;
  UpdateButtonState;
end;

procedure TPropStorageEditEhForm.MainAddPropertyNode(Path: String);
var
  Token, PTerm: String;
  Node: TTreeNode;
  NodeType: TNodeTypeEh;
begin
  Token := GetNextPointSeparatedToken(Path);
  Node := TreeView1.Items.GetFirstNode;
  NodeType := nthControl;
  if NlsUpperCase(Token) = '<P>' then
    Token := '<Form>'
  else
  begin
    Delete(Path, 1, Length(Token)+1);
    if (Node.Count > 0)
      then Node := Node.Item[0]
      else raise Exception.Create('Can not expand path - "' + Path + '"');
  end;
  while Token <> '' do
  begin
    while True do
    begin
      if Node = nil then Exit;
      if (NlsCompareText(TNodeInfoEh(Node.Data).Name, Token) = 0) and
         (TNodeInfoEh(Node.Data).NodeType = NodeType) then
      begin
        if Path <> '' then
        begin
          if (Node.Count > 0) and TNodeInfoEh(Node.Item[0].Data).IsVoidProperty then
          begin
            Node.Item[0].Free;
            PTerm := '';

            AddProperties(Node, TNodeInfoEh(Node.Data).Instance,
              TNodeInfoEh(Node.Data).Path + PTerm,
              not (TNodeInfoEh(Node.Data).NodeType = nthProperty));
            if not (TNodeInfoEh(Node.Data).NodeType = nthProperty) then
              AddComponents(Node, TComponent(TNodeInfoEh(Node.Data).Instance),
                TNodeInfoEh(Node.Data).Path + PTerm);
          end;
          if (Node.Count > 0)
            then Node := Node.Item[0]
            else raise Exception.Create('Can not expand path - "' + Path + '"');
        end;
        Break;
      end;
      Node := Node.GetNextSibling();
      if Node = nil then
        Exit;
    end;
    Token := GetNextPointSeparatedToken(Path);
    Delete(Path, 1, Length(Token)+1);
    if NlsUpperCase(Token) = '<P>' then
    begin
      if TNodeInfoEh(Node.Data).NodeType = nthPropNode then
        if (Node.Count > 0)
          then Node := Node.Item[0]
          else raise Exception.Create('Can not expand path - "' + Path + '"');
      NodeType := nthProperty;
      Token := GetNextPointSeparatedToken(Path);
      Delete(Path, 1, Length(Token)+1);
    end;
  end;
  MainAddPropertyNode(Node);
end;

procedure TPropStorageEditEhForm.MainDeletePropertyNode(N: TTreeNode);
begin
  if not (TNodeInfoEh(N.Data).NodeType = nthProperty) or
    (TNodeInfoEh(N.Data).Checked = 0) then Exit;
//  TreeView1.Items.BeginUpdate;
  try
    N.ImageIndex := 0;
    N.SelectedIndex := 0;
    TNodeInfoEh(N.Data).Checked := 0;
    RemovePropertyNode(N);
    ResetParentNodes(N);
    ResetChildNodes(N);
  finally
//    TreeView1.Items.EndUpdate;
  end;
  UpdateButtonState;
end;

procedure TPropStorageEditEhForm.MainDeletePropertyNode(Path: String);
var
  i: Integer;
begin
  for i := 0 to TreeView2.Items.Count-1 do
    if AnsiCompareText(Path,
      TNodeInfoEh(TTreeNode(TreeView2.Items[i].Data).Data).Path) = 0 then
    begin
      MainDeletePropertyNode(TTreeNode(TreeView2.Items[i].Data));
      Exit;
    end;
end;

procedure TPropStorageEditEhForm.AddPropertyNode(N: TTreeNode);
var
  i,j: Integer;
  NC: TTreeNode;
  NList: TList;
begin
  if Assigned(N) then
  begin
    NList := TList.Create;
    while N <> nil do
    begin
      NList.Add(N);
      N := N.Parent;
    end;

    N := nil;

    for i := 0 to TreeView2.Items.Count-1 do
      if (TreeView2.Items[i].Parent = nil) and
          CompareNodeInfo(TNodeInfoEh(TTreeNode(TreeView2.Items[i].Data).Data),
                          TNodeInfoEh((TTreeNode(NList[NList.Count-1]).Data))) then
      begin
        N := TreeView2.Items[i];
        Break;
      end;

    try
      if N = nil then
      begin
        for i := 0 to TreeView2.Items.Count-1 do
          if (TreeView2.Items[i].Parent = nil) and
             (TTreeNode(TreeView2.Items[i].Data).Index > TTreeNode(NList[NList.Count-1]).Index) then
          begin
{$IFDEF EH_LIB_CLX} // Clx BUG of InsertObject
            N := TreeView2.Items.Insert(TreeView2.Items[i], TTreeNode(NList[NList.Count-1]).Text);
            N.Data := NList[NList.Count-1];
{$ELSE}
            N := TreeView2.Items.InsertObject(TreeView2.Items[i], TTreeNode(NList[NList.Count-1]).Text, NList[NList.Count-1]);
{$ENDIF}
            PropertyAdded(N);
            Abort;
          end;
        N := TreeView2.Items.AddObject(nil, TTreeNode(NList[NList.Count-1]).Text, NList[NList.Count-1]);
        PropertyAdded(N);
      end;
    except
     on EAbort do
     else raise;
    end;

    for i := NList.Count - 2 downto 0 do
    begin
      NC := FindChildNodeInfo(N, TTreeNode(NList[i]));
      if NC <> nil then
        N := NC
      else
      begin
        try
          for j := 0 to N.Count-1 do
            if (TTreeNode(N.Item[j].Data).Index > TTreeNode(NList[i]).Index) then
            begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -