unit1.~pas

罗小平<<delphi精要>>一书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Table1: TTable;
    Table1Struct: TStringField;
    Table1Name: TStringField;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    TreeView1: TTreeView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure LoadNodesFromDataSet(TreeView: TTreeView; DataSet: TDataSet; Field: TField);
  procedure FilterDatasetByNode(TreeView: TTreeView; DataSet: TDataSet; Field: TField);
  function GetDataSetType(DataSet: TDataSet): Word;
  function GetNodeAllText(TreeView: TTreeView): String;
var
  Form1: TForm1;

implementation

uses FundAndProc;

const
  DeltText = '-';

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadNodesFromDataSet(TreeView1, Table1, Table1.FieldByName('Struct'));
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  FilterDatasetByNode(TreeView1, Table1, Table1.FieldByName('Struct'));
end;

procedure LoadNodesFromDataSet(TreeView: TTreeView; DataSet: TDataSet; Field: TField);
var
  Strs1,Strs2: TStrings;
  ItemsText,RItemsText: TStringList;
  SavePlace: TBookmark;
  I,C,J: Integer;
  PreNodeEqual: Boolean;
  Stream: TStream;
  procedure AddItems(Strs: TStrings);
  var
    K: Integer;
  begin
    for K := 0 to Strs.Count-1 do
    if Strs[K] <> '' then
      RItemsText.Add(StringOfChar(#9, 1+K) + Strs[K]);
  end;
begin
  if DataSet = nil then Exit;
  ItemsText := TStringList.Create;

  with DataSet do
  begin
    Open;
    SavePlace := GetBookmark;
    DisableControls;
    ItemsText.BeginUpdate;
    First;
    while not Eof do
    begin
      ItemsText.Add(Field.AsString);
      Next;
    end;
    GotoBookmark(SavePlace);
    FreeBookmark(SavePlace);
    EnableControls;
    ItemsText.EndUpdate;
  end;

  if ItemsText.Count = 0 then Exit;
  RItemsText := TStringList.Create;
  RItemsText.Add('全部');
  Strs1 := StringToStrings(DeltText, ItemsText[0]);
  AddItems(Strs1);
  for I := 1 to ItemsText.Count-1 do
  begin
    Strs2 := StringToStrings(DeltText, ItemsText[I]);
    C := Strs1.Count;
    if C > Strs2.Count then C := Strs2.Count;
    PreNodeEqual := True;
    for J := 0 to C-1 do
    begin
      PreNodeEqual := PreNodeEqual and (Strs1[J] = Strs2[J]);
      if PreNodeEqual then Strs2[J] := '';
    end;
    AddItems(Strs2);
    FreeAndNil(Strs1);
    FreeAndNil(Strs2);
    Strs1 := StringToStrings(DeltText, ItemsText[I]);
  end;
  FreeAndNil(Strs1);
  FreeAndNil(ItemsText);
  Stream := TStringStream.Create(RItemsText.Text);
  TreeView.LoadFromStream(Stream);
  FreeAndNil(Stream);
  FreeAndNil(RItemsText);
  TreeView.FullExpand;   
end;

procedure FilterDatasetByNode(TreeView: TTreeView; DataSet: TDataSet; Field: TField);
var
  S: String;
  Node: TTreeNode;
begin
  Node := TreeView.Selected;
  if (Node <> nil) and (DataSet <> nil) and DataSet.Active and
     (Field <> nil) then
  begin
    S := GetNodeAllText(TreeView);
    if S = '' then
    begin
      DataSet.Filtered := False;
      DataSet.Filter := '';
    end else
    begin
      case GetDataSetType(DataSet) of
        1,2,5:
          S := ' = ' + QuotedStr(S+'*');
        3,4:
          S := ' Like ' + QuotedStr(S+'%');
      end;
      DataSet.Filter := Field.FieldName + S;
      DataSet.Filtered := True;
    end;
  end;
end;

function GetNodeAllText(TreeView: TTreeView): String;
var
  CurrNode: TTreeNode;
begin
  CurrNode := TreeView.Selected;
  while (CurrNode <> nil) and (CurrNode.Level > 0) do
  begin
    Result := CurrNode.Text + DeltText + Result;
    CurrNode := CurrNode.Parent;
  end;
  Result := Copy(Result, 1, Length(Result)-Length(DeltText));
end;

function GetDataSetType(DataSet: TDataSet): Word;
var
  Name: String;
begin
  Name := DataSet.ClassName;
  if Name = 'TTable' then Result := 1
  else if Name = 'TQuery' then Result := 2
  else if Name = 'TADOTable' then Result := 3
  else if Name = 'TADOQuery' then Result := 4
  else if Name = 'TClientDataSet' then Result := 5
  else Result := 0;
end;

end.