晒下自己写的比较得意的函数

暂时还没有,有的朋友的贴上来（尽量不要用TPerlReg）

再来一个
//保存和读取结构体
procedure OperOptionData(PathStr:string;OperTag:Integer;var SaveOption:TOptionInfo;SetingSaveNameStr:string='SetInfo.dat');
var
  TempMsm:TMemoryStream;
begin
  TempMsm:=TMemoryStream.Create;
  if Boolean(OperTag) then
  begin
    if FileExists(PathStr+SetingSaveNameStr) then
    begin
      TempMsm.LoadFromFile(PathStr+SetingSaveNameStr);
      TempMsm.Read(PathStr,SizeOf(TOptionInfo));
    end
  end
  else
  begin
    TempMsm.Write(SaveOption,SizeOf(TOptionInfo));
    TempMsm.SaveToFile(PathStr+SetingSaveNameStr);
  end;
  TempMsm.Free;
end;望大家来写玉…………

代码格式
//限制Edit 输入时间格式
procedure TimEditKeyPress(Sender: TObject; var Key: Char);
var
  StartIndex:integer;
  TempInt:integer;
  TempStr:string;
begin
  if Key in ['0'..'9'] then
  begin
    TempStr:=TEdit(Sender).Text;
    StartIndex:=TEdit(Sender).SelStart;
    if StartIndex>7 then
      StartIndex:=0;
    if (StartIndex=2) or (StartIndex=5) then
      inc(StartIndex);
    TEdit(Sender).SelStart:=StartIndex;
    TEdit(Sender).SelLength:=1;
    if (StartIndex=3) or (StartIndex=6)  then
    begin
      TempInt:=StrToInt(key+Copy(TempStr,StartIndex+2,1));
      if TempInt>59 then
      begin
        Key:=#0;
        TEdit(Sender).SelLength:=0;
      end;
    end;
  end
  else
    key:=#0;
end;//遍历文件夹（原型网上的）
//Path-文件夹路径 FileExt-后缀名（.exe）如果是'\\' 则是遍历子文件夹名
function GetFolderList(Path,FileExt:string):TStringList;
var
  sch:TSearchrec;
  isSearchfolder:Boolean;
begin
  if FileExt='\\' then isSearchfolder:=true else isSearchfolder:=false;
  Result:=TStringlist.Create;
  if rightStr(trim(Path), 1) <> '\' then
    Path := trim(Path) + '\'
  else
    Path := trim(Path);
  if not DirectoryExists(Path) then
  begin
    Result.Clear;
    exit;
  end;
  if FindFirst(Path +'*', faAnyfile,sch) = 0 then
  begin
    repeat
      Application.ProcessMessages;
      if ((sch.Name = '.') or (sch.Name = '..')) then  Continue;
      if isSearchfolder and DirectoryExists(Path+sch.Name) then
          Result.Add(sch.Name);
      if (not isSearchfolder) and ((UpperCase(extractfileext(Path+sch.Name))=UpperCase(FileExt)) or (FileExt='.*')) then
          Result.Add(sch.Name);
    until FindNext(sch) <> 0;
    SysUtils.FindClose(sch);
  end;
end;//删除文件夹
procedure DeleteDir(sDirectory:String);
var
  sr:TSearchRec;
  sPath,sFile:String;
begin
  if Copy(sDirectory,Length(sDirectory),1)   <>   '\'   then
      sPath:=sDirectory+'\'
  else
      sPath:=sDirectory;  if  FindFirst(sPath+'*.*',faAnyFile,sr) =0 then
  begin
    repeat
        sFile:=Trim(sr.Name);
        if   sFile='.'   then   Continue;
        if   sFile='..'   then   Continue;        sFile:=sPath+sr.Name;
        if   (sr.Attr   and   faDirectory)<>0   then
            DeleteDir(sFile)
        else   if   (sr.Attr   and   faAnyFile)   =   sr.Attr   then
            DeleteFile(PChar(sFile));
    until FindNext(sr)   <>   0;
    SysUtils.FindClose(sr);
  end;
end;//秒转为时间格式字符串
function GetTimeFromS(SecS:integer):string;
var
  TempSecS:integer;
  h,m,s:integer;
function GetStr(TInt:Integer):string;
begin
  Result:=IntToStr(TInt);
  Result:=rightStr('00'+Result,2);
end;
begin
  TempSecS:=SecS;
  h:=TempSecS div 3600;
  Result:=GetStr(h)+':';
  TempSecS:=TempSecS mod 3600;
  m:=TempSecS div 60;
  Result:=Result+GetStr(m)+':';
  S:=TempSecS mod 60;
  Result:=Result+GetStr(s);
end;
//关机（非自己写的）
procedure ShutDownPc;
var
  VerInfo:  TOSVersionInfo;
  hToken:  THANDLE;
  tkp:  TOKEN_PRIVILEGES;
  Nothing:  Cardinal;
begin
  VerInfo.dwOSVersionInfoSize  :=  SizeOf(VerInfo);
  GetVersionEx(VerInfo);
  if  VerInfo.dwPlatformId  = VER_PLATFORM_WIN32_NT  then  begin
    OpenProcessToken(GetCurrentProcess,  TOKEN_ADJUST_PRIVILEGES  or  TOKEN_QUERY,
        hToken);
    LookupPrivilegeValue(nil,  'SeShutdownPrivilege',  tkp.Privileges[0].Luid);
    tkp.PrivilegeCount  :=  1;
    tkp.Privileges[0].Attributes  :=  SE_PRIVILEGE_ENABLED;
    AdjustTokenPrivileges(hToken,  FALSE,  tkp,  0,  nil,  Nothing);
  end;
  ExitWindowsEx(EWX_FORCE  +  EWX_SHUTDOWN  +  EWX_POWEROFF,  0);
end;

//文件夹选取函数
function SelDir(const  Caption:   string;   const   Root:   WideString;
      OwnerWindow:   THandle;   out   Directory:   string):   Boolean;
var
  WindowList:   Pointer;
  BrowseInfo:   TBrowseInfo;
  Buffer:   PChar;
  RootItemIDList,   ItemIDList:   PItemIDList;
  ShellMalloc:   IMalloc;
  IDesktopFolder:   IShellFolder;
  Eaten,   Flags:   LongWord;
begin
  Result   :=   False;
  Directory   :=   '';
  FillChar(BrowseInfo,   SizeOf(BrowseInfo),   0);
  if   (ShGetMalloc(ShellMalloc)   =   S_OK)   and   (ShellMalloc   <>   nil)   then
  begin
    Buffer   :=   ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList   :=   nil;
      if   Root   <>   ''   then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle,   nil,
            POleStr(Root),   Eaten,   RootItemIDList,   Flags);
      end;
      with   BrowseInfo   do
      begin
        hwndOwner   :=   OwnerWindow;
        pidlRoot   :=   RootItemIDList;
        pszDisplayName   :=   Buffer;
        lpszTitle   :=   PChar(Caption);
        ulFlags   :=   BIF_RETURNONLYFSDIRS;
      end;
      WindowList   :=   DisableTaskWindows(0);
      try
          ItemIDList   :=   ShBrowseForFolder(BrowseInfo);
      finally
          EnableTaskWindows(WindowList);
      end;
      Result   :=     ItemIDList   <>   nil;
      if   Result   then
      begin
        ShGetPathFromIDList(ItemIDList,   Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory   :=   Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

先不要得意太早，其实问题不少function GetFolderList(Path, FileExt: string): TStringList;这样的数据传递方式不是很好，记住一个原则：对象，谁创建，谁销毁。
你这里的TStringList由函数内创建，却需要外围去处理销毁，就破坏了这个原则。
这会造成两种问题，一是消耗大量的运算去做对象复制，二是会造成内存泄漏。Find的时候，可以去除不想要的文件类型
如，不要目录，可以用(faAnyFile not faDirectory)作参数传进去。同样，返回的文件信息，也可以通过判断sch.Attr来判断是目录、文件、链接、卷标...
那个DirectoryExists完全是多此一举加浪费运算量Application.ProcessMessages;
也不可取，会使遍历目录的时间浪费N多，建个线程多好。....小伙子，多多研究

呵呵，总体还是不错啊，会分享，只是希望分享更多更好的
也给点意见文件夹的删除可以利扩展的API来实现，不需要递归来删除。

在基于引用的对象模型的语言中，一般不会出现你说的这两个问题。
比如：
var
FolderList: TStringList;FolderList := GetFolderList('c:\', '*');
// ...
FolderList.Free;

CaesarDM 的意思大概是
返回值在函数体里创建,需要在调用的地方释放,这种方式不和谐这里 CaesarDm 说的第一个问题并没有（一是消耗大量的运算去做对象复制）
因为在函数体内我并没有创建临时 TStringList

他说的可能“一是消耗大量的运算去做对象复制”这种情况应该是这样，比如你想把一个目录下的文件放到界面的一个TListBox里会怎样？按你这样的方法只能这样写：
ListBox1.Items.Assign(GetFolderList('xx','xx'));//复制对象，而且GetFolderList里创建的TStringList还没释放会造成内存泄漏。所以，改成这样是最好的：
function GetFolderList(Path, FileExt: string;outList:TStrings):Boolean;//把输入列表改成TStrings更加通用，这样输出到TStringList,THashedStringList,TMemo,TListBox等等中都没问题比如：GetFolderList('xx','xx',Memo1.Lines);//输入到TMemo中

你那
if key in ['0'..'9'] then
begin
end else
  key := #0;请问您考虑了如果客户数字输入错误怎么改了么
你那就根本不支持删除数据。
是不是该改成
case key of
  #8: inherited;
  .
  .
else
  if Key in['0'..'9'] then
  begin
  .
  .
  end else
      key := #0;
  end;

不好意思最后少了个END；

这里没有处理删除
如果要处理删除的话  并不能直接  inherited   还需要处理
需要判断是第几位   是不是':'符号  如果不是  则需要赋值为 0   注意  这里的是 Edit
因为输入的时间格式   其它数字肯定是不能响应的了
你拿这个  函数试下就知道了
Edit  赋初值为  00:00:00

最好是把TStringList通过参数传入procedure GetFolderList(Path, FileExt: string, AList: TStrings);
注意最后一个参数，尽量使用公共基类，这样可以增加函数的通用性。调用时，调用方负责创建列表对象
TempList := TStringList.Create;
try
  GetFolderList(Path, FileEx, TempList);
  ....
finally
  TempList.Free;
end;养成良好的变成喜欢，会减小Bug出现的机会。

我自己写了一个
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  I : Integer;
begin
  I := Length(TEdit(Sender).Text);
  case Key of
    #8 : Inherited;
  else
    begin
      if Key in ['0'..'9'] then
      begin
        if I = 8 then Key := #0;        case I of
          0 : if not (Key in ['0'..'2']) then Key := #0;
          1 :
            begin
              if Key in ['0'..'4'] then
              begin
                TEdit(Sender).Text := TEdit(Sender).Text + Key + ':';
                Key := #0;
                TEdit(Sender).SelStart := 3;
              end  else
                Key := #0;
            end;
          3 : if not(Key in ['0'..'5'])  then Key := #0;
          4 :
            begin
              TEdit(Sender).Text := TEdit(Sender).Text + Key + ':';
              Key := #0;
              TEdit(Sender).SelStart := 6;
            end;
          6 : if not(Key in ['0'..'5'])  then Key := #0;
        end;
      end else
        Key := #0;
    end;
  end;
end;

不过最好要根据光标位置来判断
我现在写的是有BUG的因为不支持光标移动

调试易

晒下自己写的比较得意的函数

解决方案 »