如何指定一個函數給程序用?? |
|
|
|
jck1
一般會員   發表：53 回覆：67 積分：24 註冊：2002-05-23 發送簡訊給我 |
大概寫了一個可以找到一個目錄下(含子目錄)所有檔案的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 發送簡訊給我 |
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 發送簡訊給我 |
發表時間：2002-06-14 15:39:09
IP:211.22.xxx.xxx 未訂閱
系統時間：2024-04-20 4:40:05
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |