⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit_listpic.pas

📁 至于这小软件的用途
💻 PAS
字号:
unit Unit_ListPic;
//从文件夹里读取指定文件

interface

uses Windows, SysUtils, Classes,Variants,Controls;


type TPicList=class
     private
        PicString:TStringList;
        procedure listFill(folderstr:string);
     public
        procedure ListFolder(folderstr:string); // 指定文件夹
        function GetFirstPicFile:string;//取出第一个图像
        function GetRandomPicFile:string; //随机取一张图像
        procedure ClearList;//清除列表内图像
        function HavPic:Boolean;//列表内是否有图像
        //procedure Picfilter;//过滤是否包括动画,是否包括PNG什么之类
        constructor create;
        destructor Destroy; override;
     protected
end;

function isPicture(infile:string):Boolean;

implementation


procedure TPicList.ListFolder(folderstr:string); // 列指定文件夹
//那选到了桌面怎么办呢?

begin
  if Length(folderstr)=0 then  Exit;
  if not DirectoryExists(folderstr) then Exit;
  listFill(folderstr);
end;

function TPicList.GetFirstPicFile:string;//取出第一个图像
var lastNum:integer;
begin
    if PicString.Count>0 then
    begin
      lastNum:= PicString.Count;
       result:=PicString.Strings[0];
       PicString.Move(0,lastNum-1);
    end;
end;

function TPicList.GetRandomPicFile:string; //随机取一张图像
var lastNum:integer;
    GainNum:Integer;
begin
    if PicString.Count>0 then
    begin
      lastNum:= PicString.Count;
      GainNum:=Random(lastNum);
      result:=PicString.Strings[GainNum];
      if GainNum<lastNum then PicString.Move(GainNum,lastNum-1);
    end;
end;

procedure TPicList.ClearList;//清除列表内图像
begin
  if PicString.Count>0 then PicString.Clear;
end;

procedure TPicList.listFill(folderstr:string);
var searchRec:TSearchRec;
foundNum:integer;
begin
  ClearList;
  foundNum:=FindFirst(folderstr+'\*.*',faAnyFile,searchRec);
     while foundNum=0 do
        //找到了一个文件或目录后
        begin
            //如果找到的是个目录
            if (searchRec.Attr and faDirectory)<>0 then
            begin
            end
            //如果找到的是个文件
            else
            begin
                //如果是图像就添加进列表
                if isPicture(folderstr+'\'+searchRec.Name) then
                 PicString.Add(folderstr+'\'+searchRec.Name);
            end;
            //查找下一个文件或目录
            foundNum:=FindNext(searchRec);
        end;
     FindClose(searchRec);
end;

function TPicList.HavPic:Boolean;
begin
  result:=False;
  if PicString.Count>0 then  result:=true;
end;

constructor TPicList.create;
begin
    Randomize;
    PicString:=TStringList.Create;
end;

destructor TPicList.Destroy;
begin
    PicString.Free;
end;


function isPicture(infile:string):Boolean;
var
    tmpext:string;
begin
    result:=false;
    if not FileExists(infile) then  Exit;
    tmpext:=ExtractFileExt(infile);
    if tmpext='.bmp' then
    begin
      result:=True;
      Exit;
    end;
    if tmpext='.jpg' then
    begin
      result:=True;
      Exit;
    end;
    if tmpext='.png' then
    begin
      result:=True;
      Exit;
    end;
    if tmpext='.gif' then
    begin
      result:=True;
      Exit;
    end;
    if tmpext='.jpeg' then
    begin
      result:=True;
      Exit;
    end;
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -