当前位置: 开源爱好者 » 编程教程 » Delphi教程 » 正文

Delphi 学写一个简单的文件夹浏览器

Delphi 学写一个简单的文件夹浏览器的程序代码,并附上了注释,这个是初学者学习Delphi基础文件夹操作的好范例,下边分享出代码:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,ShlObj;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StaticText1: TStaticText;
    Edit1: TEdit;
    Button1: TButton;
    StaticText2: TStaticText;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
function BrowseCallBack ( Hwnd : THandle; uMsg : UINT; lpParam, lpData : LPARAM): integer; stdcall;
var
  Buffer : Array[0..255] of char;
  Buffer2 : Array[0..255] of char;
  TmpStr : String;
begin
  FillChar(Buffer,SizeOf(Buffer),#0);
  FillChar(Buffer2,SizeOf(Buffer2),#0);
  //初始化缓冲区
  TmpStr := '定位文件夹包含文件'+StrPas(PChar(lpData));
  //指定状态行文本
  StrPCopy(Buffer2,TmpStr);
  //复制状态行到缓冲
  SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,Integer(@Buffer2));
  //向BrowseForDlg对话框发送消息:设置状态行文本
  if uMsg = BFFM_SELCHANGED then begin
  //BrowseForDlg对话框的选择目录已经改变
    SHGetPathFromIDList(PItemIDList(lpParam),Buffer);
    //获取新文件夹名
    // 下面检验文件扩展名
    {$IFDEF RX_D3}  //RxLib - extentions
    //如果Delphi安装了RxLib包则调用此包中的函数
    if FileExists(NormalDir(StrPas(Buffer))+StrPas(PChar(lpData)))
       and (StrLen(Buffer) > 0) then
    {$ELSE}
  //Delphi没有安装RxLib包
      if Length(StrPas(Buffer)) <> 0 then
       if Buffer[Length(StrPas(Buffer))-1] = '\' then
         Buffer[Length(StrPas(Buffer))-1] := #0;
      if FileExists(StrPas(Buffer)+'\'+StrPas(PChar(lpData))) and
         (StrLen(Buffer) > 0) then
    {$ENDIF}
      // 找到文件,向BrowseForDlg发送消息,使"确定"按钮使能
      SendMessage(hwnd,BFFM_ENABLEOK,1,1)
    else
      // 没有找到文件,向BrowseForDlg发送消息,使"确定"按钮失效
      SendMessage(Hwnd,BFFM_ENABLEOK,0,0);
  end;
  result := 0
end;
function BrowseforFile(Handle : THandle; Title : String; Filename : String) : String;
var
  BrowseInfo : TBrowseInfo;
  RetBuffer,
  FName,
  ResultBuffer : Array[0..255] of char;
  PIDL : PItemIDList;
begin
  StrPCopy(Fname,FileName);
  FillChar(BrowseInfo,SizeOf(TBrowseInfo),#0);
  Fillchar(RetBuffer,SizeOf(RetBuffer),#0);
  FillChar(ResultBuffer,SizeOf(ResultBuffer),#0);
  //初始化缓冲区
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.pszDisplayName := @Retbuffer;
  BrowseInfo.lpszTitle := @Title[1];
  BrowseInfo.ulFlags := BIF_StatusText;
  //需要状态行
  BrowseInfo.lpfn := @BrowseCallBack;
  //将回调函数设置为上面书写的函数BrowseCallBack
  BrowseInfo.lParam := Integer(@FName);
  PIDL := SHBrowseForFolder(BrowseInfo);
  //显示BrowseForDlg对话框
  if SHGetPathFromIDList(PIDL,ResultBuffer) then
    result := StrPas(ResultBuffer)
    //返回文件的全路径
  else
    Result := '';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  s:string;
begin
  s:=BrowseforFile(handle,'搜索文件'+Edit1.Text,Edit1.Text);
  if length(s)=0 then
  //没有找到指定文件
    Edit2.text:='没有找到该文件夹'
  Else
  //找到
    Edit2.text:=s;
end;
end.

CopyRight 2018© 开源爱好者 All Rights Reserved 豫ICP备16030607号 隐私声明 网站地图