demo.pas

delphi 7 下的树形控件,扩展了原有功能

unit Demo;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ColorGrd, Buttons, ExtCtrls, Explorer;

type
  TExpTst = class(TForm)
    Exp: TExplorer;
    Bevel1: TBevel;
    BitBtn1: TBitBtn;
    Line: TEdit;
    SetRt: TButton;
    SetPt: TButton;
    Bevel2: TBevel;
    Clr: TColorGrid;
    Label1: TLabel;
    Bevel3: TBevel;
    ShwPth: TCheckBox;
    UseOwn: TCheckBox;
    PlsBmp: TImage;
    MnsBmp: TImage;
    Label2: TLabel;
    procedure SetRtClick(Sender: TObject);
    procedure SetPtClick(Sender: TObject);
    procedure ExpDblClk(Sender: TObject);
    procedure ClrChange(Sender: TObject);
    procedure ShwPthClick(Sender: TObject);
    procedure UseOwnClick(Sender: TObject);
    procedure ExpSelectBitmap(fName: String; var bmp: TBitmap;
      var Transparent: TColor);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ExpTst: TExpTst;

implementation

{$R *.DFM}

procedure TExpTst.SetRtClick(Sender: TObject);
begin
Exp.RootName := Line.Text;
end;

procedure TExpTst.SetPtClick(Sender: TObject);
begin
Exp.FullPath := Line.Text;
end;

procedure TExpTst.ExpDblClk(Sender: TObject);
begin
Line.Text := Exp.FullPath;
end;

procedure TExpTst.ClrChange(Sender: TObject);
begin
Exp.Color := Clr.ForeGroundColor;
end;

procedure TExpTst.ShwPthClick(Sender: TObject);
begin
Exp.ShowFullPath := ShwPth.Checked;
end;

procedure TExpTst.UseOwnClick(Sender: TObject);
begin
Exp.Invalidate;
end;

procedure TExpTst.ExpSelectBitmap(fName: String; var bmp: TBitmap;
  var Transparent: TColor);
begin
if UseOwn.Checked then
  begin
  Transparent := clNavy;
  if fName = ':+' then
    bmp := PlsBmp.Picture.Bitmap
  else if fName = ':-' then
    bmp := MnsBmp.Picture.Bitmap;
  end;

end;

end.