unit1.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, DB, MemTableEh, Grids, DBGridEh, ComCtrls, MemTableDataEh,
  PropFilerEh, PropStorageEh, DataDriverEh, Buttons, EhLibMTE, ExtCtrls,
  DBCtrls, ImgList;

type
  TForm1 = class(TForm)
    DBGridEh1: TDBGridEh;
    MemTableEh1: TMemTableEh;
    MemTableEh1FileDirName: TStringField;
    MemTableEh1FileDirPath: TStringField;
    MemTableEh1FileDirAttributes: TIntegerField;
    DataSource1: TDataSource;
    MemTableEh1IsDir: TBooleanField;
    MemTableEh1Id: TAutoIncField;
    MemTableEh1RefParent: TIntegerField;
    DBNavigator1: TDBNavigator;
    TreeImages: TImageList;
    DBGridEh2: TDBGridEh;
    mtFileList: TMemTableEh;
    dsFileList: TDataSource;
    mtFileListId: TAutoIncField;
    mtFileListFileDirName: TStringField;
    mtFileListFileDirPath: TStringField;
    mtFileListFileDirAttributes: TIntegerField;
    mtFileListFileSize: TIntegerField;
    mtFileListBooleanField: TBooleanField;
    procedure FormCreate(Sender: TObject);
    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBGridEh1Columns0GetCellParams(Sender: TObject;
      EditMode: Boolean; Params: TColCellParamsEh);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
    CurPath: String;
    function AddDir(APath: String; RefParent: Variant): Integer;
    function AddFiles(APath: String): Integer;
    procedure MemTableEh1Expanding(Sender: TObject; RecordNumber: Integer; var AllowExpansion: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.AddDir(APath: String; RefParent: Variant): Integer;
var
  i: Integer;
  LSrch: TSearchRec;
begin
  Result := 0;

  i := FindFirst(APath + '\*.*', faDirectory, LSrch);
  try
    while i = 0 do
    begin
      if (LSrch.Name <> '.') and (LSrch.Name <> '..') and ((LSrch.Attr and faDirectory) <> 0) then
      begin
        if (LSrch.Attr and faDirectory) <> 0
          then MemTableEh1.TreeList.DefaultNodeHasChildren := True
          else MemTableEh1.TreeList.DefaultNodeHasChildren := False;
        MemTableEh1.AppendRecord([Null, RefParent, LSrch.Name, APath + '\' + LSrch.Name, LSrch.Attr, (LSrch.Attr and faDirectory) <> 0]);
        Inc(Result);
      end;
      i := FindNext(LSrch);
    end;
  finally
    FindClose(LSrch);
  end;
end;

function TForm1.AddFiles(APath: String): Integer;
var
  i: Integer;
  LSrch: TSearchRec;
begin
  Result := 0;

  i := FindFirst(APath + '\*.*', faAnyFile, LSrch);
  mtFileList.DisableControls;
  try
    while i = 0 do
    begin
      if (LSrch.Name <> '.') and (LSrch.Name <> '..') then
      begin
        mtFileList.AppendRecord([Null, LSrch.Name, APath + '\' + LSrch.Name,
          LSrch.Attr, LSrch.Size, (LSrch.Attr and faDirectory) <> 0]);
        Inc(Result);
      end;
      i := FindNext(LSrch);
    end;
    mtFileList.SortByFields('IsDir Desc, FileDirName');
  finally
    mtFileList.First;
    mtFileList.EnableControls;
    FindClose(LSrch);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
//var
//  i,k: Integer;
begin
  MemTableEh1.Open;
  MemTableEh1.TreeList.KeyFieldName := 'Id';
  MemTableEh1.TreeList.RefParentFieldName := 'RefParent';
  MemTableEh1.TreeList.DefaultNodeExpanded := False;
  MemTableEh1.TreeList.DefaultNodeHasChildren := False;
  MemTableEh1.TreeList.Active := True;

  AddDir('C:', Null);
  MemTableEh1.SortByFields('IsDir Desc, FileDirName');
  MemTableEh1.First;
  MemTableEh1.OnTreeNodeExpanding := MemTableEh1Expanding;
//  AddDir(MemTableEh1['FileDirPath'], MemTableEh1['ID']);
  MemTableEh1.First;


end;

procedure TForm1.DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if not VarIsNull(MemTableEh1['IsDir']) then
    if MemTableEh1['IsDir'] then
      AFont.Style := AFont.Style + [fsBold];
end;

procedure TForm1.MemTableEh1Expanding(Sender: TObject; RecordNumber: Integer; var AllowExpansion: Boolean);
var
  Id, ChildCount: Integer;
  Path: String;
  OldBM, RNBM: TBookmarkStr;
begin
  MemTableEh1.DisableControls;
  try
  OldBM := MemTableEh1.Bookmark;
  MemTableEh1.RecNo := RecordNumber;
  RNBM := MemTableEh1.Bookmark;
  Id := MemTableEh1['ID'];
  Path := MemTableEh1['FileDirPath'];

  if MemTableEh1.TreeNodeHasChildren and (MemTableEh1.TreeNodeChildCount = 0) then
  begin
    ChildCount := AddDir(Path, Id);
    MemTableEh1.Bookmark := RNBM;
    MemTableEh1.TreeNode.SortByFields('IsDir Desc, FileDirName');
    MemTableEh1.TreeNodeHasChildren := (ChildCount > 0);
  end;
  if MemTableEh1.BookmarkValid(Pointer(OldBM)) then
    MemTableEh1.Bookmark := OldBM;
  finally
    MemTableEh1.EnableControls;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  MemTableEh1.DisableControls;
  MemTableEh1.EnableControls;
end;

procedure TForm1.DBGridEh1Columns0GetCellParams(Sender: TObject;
  EditMode: Boolean; Params: TColCellParamsEh);
begin
  if not VarIsNull(MemTableEh1['IsDir']) then
    if MemTableEh1['IsDir'] then
      if MemTableEh1.TreeNodeExpanded
        then Params.ImageIndex := 12
        else Params.ImageIndex := 11;
end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  if CurPath <> VarToStr(MemTableEh1['FileDirPath']) then
  begin
    mtFileList.EmptyTable;
    CurPath := VarToStr(MemTableEh1['FileDirPath']);
    AddFiles(CurPath);
  end;
end;

procedure TForm1.DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if not VarIsNull(mtFileList['IsDir']) then
    if mtFileList['IsDir'] then
      AFont.Style := AFont.Style + [fsBold];
end;

end.