全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1175
推到 Plurk!
推到 Facebook!

如何指定一個函數給程序用??

 
jck1
一般會員


發表:53
回覆:67
積分:24
註冊:2002-05-23

發送簡訊給我
#1 引用回覆 回覆 發表時間:2002-06-14 15:39:09 IP:211.22.xxx.xxx 未訂閱
大概寫了一個可以找到一個目錄下(含子目錄)所有檔案的procedure, 我想讓該procedure由外部提供一個選擇檔案副檔名的function, 但這個函數不是寫在procedure裡面,而是由設記者自訂, 然後希望procedure來使用他, 這樣該怎麼做呢?? 我把FindAllFile放在MyFileU的unit裡 而主要的project要提到function給FindAllFile 我完成了一部份,如下: ==================== MyFileU.pas==================== unit MyFileU; interface uses SysUtils; type TAos= array of string; procedure FindAllFile(aPath: string; var aAos: TAos; var aCount: integer); implementation procedure FindAllFile(aPath: string; var aAos: TAos; var aCount: integer); var sr: TSearchRec; procedure AddToAos(str: string); var index: integer; begin Inc(aCount); SetLength(aAos, aCount); index:= aCount - 1; aAos[index]:= str; end; begin if(FindFirst(aPath '\*.*', faAnyFile, sr) = 0)then begin Repeat if((sr.Attr and faArchive)=faArchive)then begin //在這裡希望有個外部提到的ExtRule //if(ExtRule)then begin // AddToAos(aPath '\' sr.Name); //end; AddToAos(aPath '\' sr.Name); end else if((sr.Attr and faDirectory)=faDirectory)then begin if((sr.Name <> '.')and(sr.Name <> '..'))then begin aPath:= aPath '\' sr.Name; FindAllFile(aPath, aAos, aCount); aPath:= ExtractFileDir(aPath); end; end; Until(FindNext(sr) <> 0); FindClose(sr); end; end; end. ========================unit1.pas================ unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses MyfileU; {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var aAos: TAos; aCount: integer; i: integer; begin memo1.clear; aCount:= 0; SetLength(aAos, aCount); FindAllFile('e:\lear', aAos, aCount); for i:= low(aAos) to high(aAos) do begin memo1.lines.add(aAos[i]); end; end; end. =============================== ExtRule可能像這樣 function ExtRule(const sr: TSearchRec): boolean; var aExt: string; begin result:= false; aExt:= ExtractFileExt(sr.Name); if(aExt = '.jpg')then begin result:= true; exit; end; if(aExt = '.jpeg')then begin result:= true; exit; end; if(aExt = '.gif')then begin result:= true; exit; end; end; Sorry,post有點長 謝謝耐心看完 :)
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#2 引用回覆 回覆 發表時間:2002-06-14 17:31:55 IP:203.217.xxx.xxx 未訂閱
1. 定義Function Type 如下:(參數, Return如你的ExtRule) TExtRule = function (const sr: TSearchRec): boolean; 2. FindAllFile之宣告 procedure FindAllFile(aPath: string; func:TExtRule;var aAos: TAos; var aCount: integer); 3. 在FindAllFilel中 if(func(sr))then begin AddToAos(aPath '\' sr.Name); end; // AddToAos(aPath '\' sr.Name); ... Recurisive 時 FindAllFile(aPath,func, aAos, aCount); 4. Button1 Call時 FindAllFile('e:\lear',ExtRule, aAos, aCount); 其他說明 1.if(aExt = '.gif')then begin 不太好, 檔名若大寫找不到,可改為 if CompareText(aExt,'.gif')=0 then begin 2. Array of string 改為TStrings是否方便多了 發表人 - ccchen 於 2002/06/17 07:50:48
jck1
一般會員


發表:53
回覆:67
積分:24
註冊:2002-05-23

發送簡訊給我
#3 引用回覆 回覆 發表時間:2002-06-18 11:30:31 IP:211.22.xxx.xxx 未訂閱
[quote[ 其他說明 1.if(aExt = '.gif')then begin 不太好, 檔名若大寫找不到,可改為 if CompareText(aExt,'.gif')=0 then begin 2. Array of string 改為TStrings是否方便多了 發表人 - ccchen 於 2002/06/17 07:50:48 [/quote] 謝謝大大的建議 我都比照辦理 程式果然是好多了 ps.我記得上次看這篇的時候是亂碼,怎麼現在又好了??
系統時間:2017-11-24 2:19:40
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!