Delphi 列出一个目录所有.txt后缀的文件到List控件里

Question

下面是代码谁能帮我修改下先把一个目录.txt后缀的文件列到List里,然后点击List里面的文件文直接读取该文件内容到Memo1控件里~
//获得文件列表
function GetAllTextFile(Path,fext: string): TStringList;
var
f: TSearchRec;
r: Integer;
begin
Result:=TStringList.Create;
if Path[Length(Path)]<>'\' then Path:=Path+'\';
r:=FindFirst(Path+fext, faAnyFile, f);
while r=0 do
begin
Result.Append(f.Name);
r:=FindNext(f)
end;
FindClose(f);
end;
//添加列表
procedure setlstbook(lst1:TListBox);
var
dir:string;
i,posx:integer;
filelst:TStringList;
begin
filelst:=TStringList.Create;
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],1000) then
begin
filelst.Text:=GetAllTextFile(Dir,'*.txt').Text;
lst1.clear;
for i :=0 to filelst.Count-1 do
begin
posx:=Pos('.',filelstt.Strings[i]);
lst1.Items.Add(copy(filelst.Strings[i],1,posx-1));
end;
end;

/// 包含单元 uses FileCtrl

Answer 1

//**************以下回答内容,申请优质答案!请管理员考虑!
//******以下内容以简单清晰为主,从而解决你的问题!查找函数是直接在我API单元中复制出来的,用详细的代码加上详细的注释,就算是新新手,也能看懂98%,何况是你呢!
//这个函数是经过多次使用,正常运作的!
//先给你一个查找指定文件夹路径中特定文件的函数
//第三个参数是指定文件属性的,这个你可以不指定,或查阅相关API说明,
procedure FindFileS( RetList:TStrings; const PathAndFindName:string; Attr:Integer=faAnyFile );
var
  sr: TSearchRec;     //定义 TSearchRec 结构变量
begin  //uses   SysUtils,Classes
  try
    if SysUtils.FindFirst(PathAndFindName,Attr,sr)=0 then  
    //开始搜索,并给 sr 赋予信息, 返回0表示找到第一个
    begin
      repeat                        //如果有第一个就继续找
        //RetList.Add(sr.Name);     //用List记下结果
       //上面注释的这行是原代码,没有滤除后缀名,因简单地完成需求,将这个函数稍微改改
        RetList.Add(copy(sr.Name,1,Pos('.',sr.Name)-1));
        //因为sr已经有了搜索信息, FindNext只要这一个参数, 返回0表示找到
      until(SysUtils.FindNext(sr)<>0);//repeat .. until(boolean)当逻辑为False时循环
    end;
  finally
    FindClose(sr);                  //需要结束搜索, 搜索是内含句柄的
  end;
end;
//然后通过上面的查找函数,将你原有代码加以修改,完成第一步加载列表的需求
//先放个这个函数调用的例子:
//可以直接提供lst1.Items让函数查找到结果后就添加进去
FindFileS(lst1.Items,'E:\*.txt'); 
//然而,我还要考虑到你要滤除文件后缀
//同时观察到你的代码中有 lst1.clear; 则不需要考虑之前的任何信息了!
//于是,我直接在查找函数中加一点代码,用于滤除文件后缀!
//那么,现在的setlstbook 可以简化到这样了,看代码
//********************************
var lstFileAsDir:string='';//定义这个全局变量,用于记录当前处理的文件归属路径
//并且对这个变量初始化
//********************************
procedure setlstbook(lst1:TListBox);
var
dir:string;
begin
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],1000) then
 begin
     //如果能确保有斜杠符号,这句代码可以不要
    if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\'; 
    lstFileAsDir := Dir; //记住归属路径,以便加载文件到Memo
    lst1.clear;//其实这个清楚,可以放在IF的前面,可以达到,找不到时显示一个空列表
    FindFileS(lst1.Items,Dir+'*.txt');
   end;
end;
//到此,加载txt文件列表完工了!
//接下就到了TListBox被点击现在到对应文件名称后,加载文件到Memo中
//先在IDE中选择TListBox控件,然后到对象属性中切换的事件设置,然后
//双击OnClick,此时IDE自动添加关联的事件函数
//现在我方IDE中假设当前TListBox控件所属类的名称为TForm1
//那么IDE为我添加了这个单击事件的名称为lst1Click
//现在放上最后的的关键代码
procedure TForm1.lst1Click(Sender: TObject);
begin //注意,使用到 lstFileAsDir,前面也已经做出了相关解释了!
    //lst1.Tag := -1; //将这句放在窗口初始化的地方,或者在IDE中设置
    //这个-1的作用是由于TAG初始值都是0,如果选择第一项时,会被IF以为是位置没变
  if (lst1.ItemIndex = -1) //未选择
    or (lst1.ItemIndex=lst1.Tag) //或 选择位置没有改变
  then Exit;  //退出函数
  lst1.Tag := lst1.ItemIndex; //记住当前的选择位置
  //直接使用Memo的Lines提供的LoadFromFile函数完成载入
  try //开始监控异常
    mmo1.Lines.LoadFromFile(lstFileAsDir+lst1.Items[lst1.ItemIndex]+'.txt');
  except //如果出现异常
    on e: Exception do begin
      lst1.Items.Delete(lst1.ItemIndex); //删除这个项
      lst1.Tag := -1; //恢复标记 为未选择过!
      Dialogs.ShowMessage('载入失败,原因如下:'+e.Message);
    end;
  end;//结束监控异常
end;//事件函数退出
//**************够详细吗?我还开了IDE做了一次模拟!然后再复制上来!
//然后再补上详细注释,目标就是要拿下你的满意,不用感谢我,只要采纳答案,并点一下赞同!
//如果关于这个问题,还有疑问,可以继续追问我,我看到都会解答的!祝你成功.

追问

能把此代码打包成工程文件发到我求求里

追答

邮箱地址?

Answer 2

list中选择文件名打开文件到memo中

var
str:string;
txtfield: TextFile;
fieldname:string;
begin
mmo1.Clear;
fieldname:=(pDir+'\'+lst1.Items[lst1.ItemIndex]);//pDir是你选择的目录路径
AssignFile(txtfield, fieldname);
Reset(txtfield);
while not eof(txtfield) do
begin
Readln(txtfield, str);
mmo1.Lines.Add(str);
end;
CloseFile(txtfield);
end;本回答被网友采纳