当前位置：首页 » 编程博文

开发技术指南» 文章正文

    引言： --------------------------------

 

 

DELPHI常用函数集及简要范例
------------------------------------------------------------------

abs(x)    绝对值 【程序编程相关:几个C#编程的小技巧 (一)】

【推荐阅读:用ＷＩＮＸＰ２＋ＤＷ＋ＡＣＣＥＳＳ使用本】

arctan(x) 反正切 【扩展信息:asp常 用 代 码】

cos(x)    传回馀弦函数值

exp(x)    e的x次幂

frac(x)   取小数部分

int(x)    取整

ln(x)     自然对数

sin(x)    传回正弦函数值 

sqr(x)    x*x

sqrt(x)   平方根

其它

pred(x)   pred(´d´)=´c´, pred(true)=1;

succ(x)   succ(´y´)=´z´, succ(pred(x))=x

ord(x)    求x在字符集中的序号,如ord(´a´)=65

chr(x)    chr(65)=´a´

round(x)  四舍五入

trunc(x)  trunc(4.8)=4,trunc(´-3.6´)=-3

upcase(x) upcase(´a´)=´a´

hi(i)     hi($2a30)=$2a

lo(i)     lo($2a30)=$30

random(n) 产生[0,n)间的随机整数

sizeof(name)  求出某类型或变量在内存中占用的字节数

swap(num)     swap($3621)=$2136

================================

arithmetic routines  数学运算

================================

abs    绝对值

---------------------------------------------------------

unit  system

函数原型 function abs(x);

说明  x为整数or实数.

范例 

var

  r: real;

  i: integer;

begin

  r := abs(-2.3);  { 2.3 }

  i := abs(-157);  { 157 }

end;

----------------------------------------------------------

arctan   三角函数

----------------------------------------------------------

范例

cos

var r: extended;

begin

  r := cos(pi);

end;

----------------------------------------------------------

sin

----------------------------------------------------------

范例

var

  r: extended;

  s: string;

begin

  r := sin(pi);

  str(r:5:3, s);

  canvas.textout(10, 10, ´the sin of pi is ´ + s);

end;

----------------------------------------------------------

unit  system

函数原型 function arctan(x: extended): extended;

函数原型 function cos(x: extended): extended;

函数原型 function sin(x: extended): extended;

----------------------------------------------------------

说明  x为径度.

   tan(x) === sin(x) / cos(x)

   arcsin(x) = arctan (x/sqrt (1-sqr (x)))

   arccos(x) = arctan (sqrt (1-sqr (x)) /x)

   左边这三个不是函数,而是右边运算求得.

范例

var

  r: extended;

begin

  r := arctan(pi);

end;

范例  var

     r: extended;

     s: string;

   begin

     r := sin(pi);

     str(r:5:3, s);

     canvas.textout(10, 10, ´the sin of pi is ´ + s);

   end;

----------------------------------------------------------

frac    求一个实数的小数部份

----------------------------------------------------------

unit  system

函数原型 function frac(x: real): real;

说明  x为实数.

范例  var

     r: real;

   begin

     r := frac(123.456);  { 0.456 }

     r := frac(-123.456);  { -0.456 }

   end;

------------------------------------------

int     求一个实数的整数部份

------------------------------------------

unit  system

函数原型 function int(x: real): real;

说明  x为实数.

范例  var 

     r: real;

   begin

     r := int(123.456);  { 123.0 }

     r := int(-123.456);  { -123.0 }

   end;

------------------------------------------

pi     就是数学的pi

------------------------------------------

unit  system

函数原型 function pi: extended;

说明  它是一个函数,但我们就把它当作是预设的变数来用吧!

   pi= 3.1415926535897932385

------------------------------------------

sqr     x的平方

-----------------------------------------

范例

var

  s, temp: string;

begin

   str(sqr(5.0):3:1, temp);

   s := ´5 squared is ´ + temp + #13#10;

   str(sqrt(2.0):5:4, temp);

   s := s + ´the square root of 2 is ´ + temp;

   messagedlg(s, mtinformation, [mbok], 0);

end;

-----------------------------------------

sqrt    x的平方根

------------------------------------------

unit  system

函数原型 function sqr(x: extended): extended;

函数原型 function sqrt(x: extended): extended;

范例  var

     s, temp: string;

   begin

     str(sqr(5.0):3:1, temp);

     s := ´5 squared is ´ + temp + #13#10;

     str(sqrt(2.0):5:4, temp);

     s := s + ´the square root of 2 is ´ + temp;

     messagedlg(s, mtinformation, [mbok], 0);

   end;

------------------------------------------

ln     自然对数

------------------------------------------

范例

var

   e : real;

   s : string;

begin

   e := exp(1.0);

   str(ln(e):3:2, s);

   s := ´e = ´ + floattostr(e) + ´; ln(e) = ´ + s;

   canvas.textout(10, 10, s);

end;

----------------------------------------

exp    指数

------------------------------------------

unit  system

函数原型 function ln(x: real): real;

函数原型 function exp(x: real): real;

范例  var

     e : real;

     s : string;

   begin

     e := exp(1.0);

     str(ln(e):3:2, s);

     s := ´ln(e) = ´ + s;

     canvas.textout(10, 10, s);

   end;

------------------------------------------

 date and time routines 日期及时间函数

------------------------------------------

date    传回目前的日期

unit  sysutils

函数原型 function date: tdatetime;

范例  procedure tform1.button1click(sender: tobject);

   begin

     label1.caption := ´today is  ´ + datetostr(date);

   end;

------------------------------------------

datetimetostr 日期时间转换成内定型字串(1996/12/20 09:12:20 pm)

------------------------------------------

unit  sysutils

函数原型 function datetimetostr(datetime: tdatetime): string;

范例  procedure tform1.button1click(sender: tobject);

   begin

     label1.caption := datetimetostr(now);

   end;

--------------------------------------------------------

datetimetostring 日期时间转换成自定型字串

-------------------------------------------------------

unit  sysutils

函数原型 procedure datetimetostring(var result: string; const format: 

    string; datetime: tdatetime);

范例  procedure tform1.formcreate(sender: tobject);

   var

     s:string;

   begin

     datetimetostring(s,´dddd,mmmm d,yyyy  "at" hh:mm 

    am/pm´,now);

     label1.caption :=s;

   end;

结果  星期五,十二月 20,1996 at 09:20 pm

-----------------------------------------------------------------------------

****  format格式叁考下面.formatdatetime.

--------------------------------------------------------

datetostr   日期转换成内定型字串.(1996/12/20)

--------------------------------------------------------

unit  sysutils

函数原型  function datetostr(date: tdatetime): string;

范例

procedure tform1.button1click(sender: tobject);

begin

  label1.caption := ´today is  ´ + datetostr(date);

end;

# date, datetostr example

--------------------------------------------------------

dayofweek  求叁数日期是星期几.

--------------------------------------------------------

unit  sysutils

函数原型 function dayofweek(date: tdatetime): integer;

说明  传回值是一整数,1~7.

   星期日为1.

范例

procedure tform1.button1click(sender: tobject);

var

  adate: tdatetime;

  days: array[1..7] of string;

begin

  days[1] := ´sunday´;

  days[2] := ´monday´;

  days[3] := ´tuesday´;

  days[4] := ´wednesday´;

  days[5] := ´thursday´;

  days[6] := ´friday´;

  days[7] := ´saturday´;

  adate := strtodate(edit1.text);

  showmessage(edit1.text + ´ is a ´ + days[dayofweek(adate)];

end;

# strtodate, dayofweek example

--------------------------------------------------------

decodedate  将tdatetime型态的日期变数,转为word型态.

--------------------------------------------------------

范例

procedure tform1.button1click(sender: tobject);

var

  present: tdatetime;

  year, month, day, hour, min, sec, msec: word;

 begin

  present:= now;

  decodedate(present, year, month, day);

  label1.caption := ´today is day ´ + inttostr(day) + ´ of month ´

    + inttostr(month) + ´ of year ´ + inttostr(year);

  decodetime(present, hour, min, sec, msec);

  label2.caption := ´the time is minute ´ + inttostr(min) + ´ of hour ´

    + inttostr(hour);

end;

# decodedate, decodetime example

--------------------------------------------------------

decodetime  将tdatetime型态的时间变数,转为word型态.

--------------------------------------------------------

unit  sysutils

函数原型 procedure decodedate(date: tdatetime; var year, month,day: word);

函数原型 procedure decodetime(time: tdatetime; var hour, min, sec,msec: word);

范例  procedure tform1.button1click(sender: tobject);

   var

     present: tdatetime;

     year, month, day, hour, min, sec, msec: word;

   begin

     present:= now;

     decodedate(present, year, month, day);

     label1.caption := ´today is day ´ + inttostr(day) + ´ of 

    month ´ + inttostr(month) + ´ of year ´ + inttostr(year);

     decodetime(present, hour, min, sec, msec);

     label2.caption := ´the time is minute ´ +inttostr(min) + ´ of 

    hour ´ + inttostr(hour);

   end;

--------------------------------------------------------

encodedate  将word型态的日期变数,转为tdatetime型态.

--------------------------------------------------------

范例

procedure tform1.button1click(sender: tobject);

var

  mydate: tdatetime;

begin

  mydate := encodedate(strtoint(edit1.text), strtoint(edit2.text), strtoint(edit3.text));

  label1.caption := datetostr(mydate);

end;

-------------------------------------------------------

encodetime  将word型态的时间变数,转为tdatetime型态.

--------------------------------------------------------

unit  sysutils

函数原型 function encodedate(year, month, day: word): tdatetime;

函数原型 function encodetime(hour, min, sec, msec: word): 

    tdatetime;

范例  procedure tform1.button1click(sender: tobject);

   var

     mydate: tdatetime;

     mytime: tdatetime;

   begin

     mydate := encodedate(83, 12, 31);

     label1.caption := datetostr(mydate);

     mytime := encodetime(0, 45, 45, 7);

     label2.caption := timetostr(mytime);

   end;

范例

procedure tform1.button1click(sender: tobject);

var

  mytime: tdatetime;

begin

  mytime := encodetime(0, 45, 45, 7);

  label1.caption := timetostr(mytime);

end;

--------------------------------------------------------

formatdatetime 将日期时间依format的格式转换给一字串.

--------------------------------------------------------

unit  sysutils

函数原型 function formatdatetime(const format: string; datetime: 

    tdatetime): string;

****  类似datetimetostring.

format格式

c  内定值shortdateformat的格式.(1996/12/20 09:20:15 pm).

d  日期,前面不补0.(1-31)

dd  日期,前面补0.(01-31)

ddd  星期.(星期日).

dddd  中文2.01版,同上.

ddddd 日期.(1996/12/20)

dddddd 日期.(1996年12月20日)

m  月份,前面不补0.(1-12)

mm  月份,前面补0.(01-12)

mmm 中文显示.(十二月)

mmmm 中文2.01版,同上.

yy  年度.(00-99)

yyyy  年度.(0000-9999)

h  小时.(0-23)

hh  小时.(00-23)

n  分钟.(0-59)

nn  分钟.(00-59)

s  秒钟.(0-59)

ss  秒钟.(00-59)

t  时间.(09:20 pm)

tt  时间.(09:20:15 pm)

am/pm 单独显示am or pm.(若大写,则显示大写)

a/p  单独显示a or p.

范例

the following example assigns ´the meeting is on wednesday, february 15, 1995 at 10:30 am´ to the string variable s. 

s := formatdatetime(´"the meeting is on " dddd, mmmm d, yyyy, " at " hh:mm am/pm´,

   strtodatetime(´2/15/95 10:30am´));//???

--------------------------------------------------------

now    传回目前的日期时间.

--------------------------------------------------------

unit  sysutils

函数原型 function now: tdatetime;

范例

procedure tform1.button1click(sender: tobject);

begin

  label1.caption := datetimetostr(now);

end;

# now, datetimetostr example

--------------------------------------------------------

strtodate   将字串转为tdatetime型态的日期.

--------------------------------------------------------

unit  sysutils

函数原型 function strtodate(const s: string): tdatetime;

范例  procedure tform1.button1click(sender: tobject);

   var

     adate: tdatetime;

   begin

     adate := strtodate(edit1.text);

     label1.caption := datetostr(adate);

   end;

范例

procedure tform1.button1click(sender: tobject);

var

  adate: tdatetime;

  days: array[1..7] of string;

begin

  days[1] := ´sunday´;

  days[2] := ´monday´;

  days[3] := ´tuesday´;

  days[4] := ´wednesday´;

  days[5] := ´thursday´;

  days[6] := ´friday´;

  days[7] := ´saturday´;

  adate := strtodate(edit1.text);

  showmessage(edit1.text + ´ is a ´ + days[dayofweek(adate)];

end;

# strtodate, dayofweek example

--------------------------------------------------------

strtodatetime 将字串转为tdatetime型态的日期时间.

--------------------------------------------------------

unit  sysutils

函数原型 function strtodatetime(const s: string): tdatetime;

范例

procedure tform1.button1click(sender: tobject);

var

  adateandtime: tdatetime;

begin

  adateandtime := strtodatetime(edit1.text);

  table1.fieldbyname(´timestamp´).asdatetime := adateandtime;

end;

--------------------------------------------------------

strtotime   将字串转为tdatetime型态的时间.

--------------------------------------------------------

unit  sysutils

函数原型 function strtotime(const s: string): tdatetime;

范例

procedure tform1.button1click(sender: tobject);

var

  atime: tdatetime;

begin

  atime := strtotime(edit1.text);

  if atime < 0.50 then

    showmessage(´good morning´)

  else

    showmessage(´good afternoon´);

end;

--------------------------------------------------------

time    传回目前的时间.

--------------------------------------------------------

unit  sysutils

函数原型 function time: tdatetime;

范例

procedure tform1.timer1timer(sender: tobject);

var

  datetime : tdatetime;

  str : string;

begin

  datetime := time;  // store the current date and time

  str := timetostr(datetime); // convert the time into a string

  caption := str;  // display the time on the form´s caption

  { note this could have been done with the following line of code:

    caption := timetostr(time); }

end;

# time, timetostr example

--------------------------------------------------------

timetostr   时间转换成内定型字串.(09:20:15 pm)

--------------------------------------------------------

unit  sysutils

函数原型 function timetostr(time: tdatetime): string;

 getmem procedure  配置记忆体程序

new    配置指位器p的记忆体空间,

     大小为p所指型态的大小.

--------------------------------------------------------

dispose   释放new所配置的记忆体.

--------------------------------------------------------

unit  system

函数原型 procedure new(var p: pointer);

函数原型 procedure dispose(var p: pointer);

范例  type

     plistentry = ^tlistentry;

     tlistentry = record

     next: plistentry;

     text: string;

     count: integer;

   end;

   var

     list, p: plistentry;

   begin

     ...

     new(p);

     p^.next := list;

     p^.text := ´hello world´;

     p^.count := 1;

     list := p;

     ...

     dispose(p);

     …

   end;

范例

type

  str18 = string[18];

 var

  p: ^str18;

begin

  new(p);

  p^ := ´now you see it...´;

  dispose(p); { now you don´t... }

end;

--------------------------------------------------------

getmem   配置指位器p的记忆体空间,大小可自行设定.

--------------------------------------------------------

范例

var

  f: file;

  size: integer;

  buffer: pchar;

begin

  assignfile(f, ´test.txt´);

  reset(f, 1);

  try

    size := filesize(f);

    getmem(buffer, size);

    try

      blockread(f, buffer^, size);

      processfile(buffer, size);

    finally

      freemem(buffer);

    end;

  finally

    closefile(f);

  end;

end;

--------------------------------------------------------

freemem   释放getmem所配置的记忆体.

--------------------------------------------------------

unit  system

函数原型 procedure getmem(var p: pointer; size: integer);

函数原型 procedure freemem(var p: pointer[; size: integer]);

范例  var

     f: file;

     size: integer;

     buffer: pchar;

   begin

     assignfile(f, ´test.txt´);

     reset(f, 1);

     try

    size := filesize(f);

    getmem(buffer, size);

    try

     blockread(f, buffer^, size);

     processfile(buffer, size);

    finally

     freemem(buffer);

    end;

     finally

    closefile(f);

     end;

   end;

====================================

 file-management routines 档案管理常式

====================================

--------------------------------------------------------

changefileext 变更档案的副档名

--------------------------------------------------------

unit  sysutils

函数原型 function changefileext(const filename, extension: string): 

    string;

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

     p2:string;

   begin

     p1:=´abc.txt´;

     p2:=´.ini´;

     s := changefileext(p1,p2);

     label1.caption:=s;

   end;

结果  s== ´abc.ini´

   p1:=´abc´

   p2:=´.ini´

   s== ´abc.ini´

   p1:=´c:\windows\abc.txt´

   p2:=´.ini´

   s==´c:\windows\abc.ini´

   p1:=´abc.txt´

   p2:=´ini´

   s==´abcini´

   **注意:p2的第一位元必须有一点´.ini´

范例

procedure tform1.converticon2bitmapclick(sender: tobject);

var 

  s : string;

  icon: ticon;

begin

  opendialog1.defaultext := ´.ico´;

  opendialog1.filter := ´icons (*.ico)|*.ico´;

  opendialog1.options := [ofoverwriteprompt, offilemustexist, ofhidereadonly ];

  if opendialog1.execute then

  begin

    icon := ticon.create;

    try

      icon.loadfromfile(opendialog1.filename);

      s:= changefileext(opendialog1.filename,´.bmp´);

      image1.width := icon.width;

      image1.height := icon.height;

      image1.canvas.draw(0,0,icon);

      image1.picture.savetofile(s);

      showmessage(opendialog1.filename + ´ saved to ´ + s);

    finally

      icon.free;

    end;

  end;

end;

#  savetofile, create, height, width, canvas, changefileext example

--------------------------------------------------------

expandfilename 将档案名称加在目前所在之路径全名之後

--------------------------------------------------------

unit  sysutils

函数原型 function expandfilename(const filename: string): string;

说明  设目前目录为 c:\windows   档案名称为  abc.txt

   则结果为  c:\windows\abc.txt

****  此函数并不是求abc.txt的所在路径.

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

   begin

     s:=expandfilename(´abc.txt´);

     label1.caption:=s;

   end;

范例

procedure tform1.button1click(sender: tobject)

begin

  listbox1.items.add(expandfilename(edit1.text));

end;

------------------------------------------------------------------

directoryexists   目录是否存在------------------------------------------------------------------

unit

filectrl

uses filectrl;

procedure tform1.button1click(sender: tobject);

begin

  if not directoryexists(´c:\temp´) then

    if not createdir(´c:\temp´) then

    raise exception.create(´cannot create c:\temp´);

end;

--------------------------------------------------------

forcedirectories    目录

---------------------------------------------------------

unit    filectrl

函数原型     function forcedirectories(dir: string): boolean;

procedure tform1.button1click(sender: tobject);

var

  dir: string;

begin

  dir := ´c:\apps\sales\local´;

  if directoryexists(dir) then

    label1.caption := dir + ´ was created´

end;

--------------------------------------------------------

expanduncfilename 同上(只是得到网路上的路径)

--------------------------------------------------------

unit  sysutils

函数原型 function expanduncfilename(const filename: string):string;

extractfiledir   分析字串中的路径

unit sysutils

函数原型 function extractfiledir(const filename: string): string;

说明  设s字串为 c:\windows\abc.txt

   则结果为 c:\windows

****  功能在於由任何部份传来的叁数,加以分析它的路径

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

   begin

     p1:=´c:\windows\abc.txt´;

     s:=extractfiledir(p1);

     label1.caption:=s;

   end;

   s==´c:\windows´

   p1:=´abc.txt´

   s==´

   p1:=´c:abc.txt´

   s==´c:´

   p1:=´c:\abc.txt´

   s==´c:\´

--------------------------------------------------------

extractfiledrive 分析字串中的磁碟机名称

--------------------------------------------------------

unit  sysutils

函数原型 function extractfiledrive(const filename: string): string;

****  功能同上,只是传回磁碟机名称.

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

   begin

     p1:=´c:\windows\abc.txt´;

     s:=extractfiledrive(p1);

     label1.caption:=s;

   end;

   s:=´c:´

   p1:=´abc.txt´

   s==´

--------------------------------------------------------

extractfileext  分析字串中的档案名称的副档名

--------------------------------------------------------

unit  sysutils

函数原型 function extractfileext(const filename: string): string;

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

   begin

     p1:=´c:\windows\abc.txt´;

     s:=extractfileext(p1);

     label1.caption:=s;

   end;

   s==´.txt´

   p1:=´c:\windows\abc´

   s==´

范例 myfilesextension := extractfileext(myfilename);

--------------------------------------------------------

extractfilename 分析字串中的档案名称(只传回档案名称)

--------------------------------------------------------

unit  sysutils

函数原型 function extractfilename(const filename: string): string;

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

   begin

     p1:=´c:\windows\abc.txt´;

     s:=extractfilename(p1);

     label1.caption:=s;

   end;

   s==´abc.txt´

范例

procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount ? 1 do

    begin

      for y := 0 to stringgrid1.rowcount ? 1 do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);

      end;

    end;

    fileclose(filehandle);

  end;

end;

##fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

--------------------------------------------------------

extractfilepath 分析字串中的路径

--------------------------------------------------------

unit  sysutils

函数原型 function extractfilepath(const filename: string): string;

说明  设s字串为 c:\windows\abc.txt

   则结果为 c:\windows范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     p1:string;

   begin

     p1:=´c:\windows\abc.txt´;

     s:=extractfilepath(p1);

     label1.caption:=s;

   end;

范例

begin

  with session do

  begin

    configmode := cmsession;

  try

    addstandardalias(´tempdb´, extractfilepath(paramstr(0)), ´paradox´);

  finally

      configmode := cmall;

  end;

end;

##configmode, addstandardalias, extractfilepath example

--------------------------------------------------------

filesearch   寻找档案在磁碟机中的正确路径

--------------------------------------------------------

unit  sysutils

函数原型 function filesearch(const name, dirlist: string): string;

范例  var

     s:string;

   begin

     s:= filesearch(´abc.txt´, ´c:\window\´);

     label1.caption:=s;

   end;

说明  找到传回c:\window\abc.txt 找不到传回空字串.

范例

procedure tform1.button1click(sender: tobject);

var

  buffer: array [0..255] of char;

  filetofind: string;

begin

  getwindowsdirectory(buffer, sizeof(buffer));

  filetofind := filesearch(edit1.text, getcurrentdir + ´;´ + buffer);

  if filetofind = ´ then

    showmessage(´couldn´t find ´ + edit1.text + ´.´)

  else

    showmessage(´found ´ + filetofind + ´.´);

end;

##filesearch, showmessage example

--------------------------------------------------------

fileage   传回档案的日期及时间(dos型态).

--------------------------------------------------------

unit  sysutils

函数原型 function fileage(const filename: string): integer;

说明  就是档案总管中档案内容裹面的修改日期.

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

     filedate1:integer;

     datetime1:tdatetime;

   begin

     filedate1 := fileage(´c:\delphi_d\delphi_help1.txt´);

     datetime1 := filedatetodatetime(filedate1);

     s := datetimetostr(datetime1);

     label1.caption:=s;

   end;

--------------------------------------------------------

filedatetodatetime 将dos型态的日期时间转换为tdatetime型态.

--------------------------------------------------------

unit  sysutils

函数原型 function filedatetodatetime(filedate: integer):tdatetime;

-----------------------------------------------------------------------------

datetimetofiledate 将tdatetime型态的日期时间转换为 dos型态.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function datetimetofiledate(datetime: tdatetime):integer;

filegetdate  传回档案的日期及时间(dos型态).

unit  sysutils

函数原型 function filegetdate(handle: integer): integer;

说明  就是档案总管中档案内容裹面的修改日期.

范例  procedure tform1.button1click(sender: tobject);

   var

     filehandle:integer;

     s: string;

     filedate1:integer;

     datetime1:tdatetime;

   begin

     filehandle :=fileopen(´c:\delphi_d\delphi_help2.txt´,

    fmopenreadwrite);

     if filehandle > 0 then

    begin

     filedate1 := filegetdate(filehandle);

     datetime1 := filedatetodatetime(filedate1);

     s := datetimetostr(datetime1);

     fileclose(filehandle);

    end

     else

     s := ´open file error´;

     label1.caption:=s;

   end;

-----------------------------------------------------------------------------

filesetdate  设定档案的日期及时间(dos型态).

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function filesetdate(handle: integer; age: integer): integer;

说明  传回值为0表示成功.

-----------------------------------------------------------------------------

deletefile   删除档案

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function deletefile(const filename: string): boolean;

范例 一 deletefile(´delete.me´);

范例 二           if fileexists(filename) then

                        if messagedlg(´do you really want to delete ´ +  

                           extractfilename(filename) + ´?´), []) = idyes then 

                            deletefile(filename);

##fileexists, deletefile example

-----------------------------------------------------------------------------

renamefile  更改档名

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function renamefile(const oldname, newname: string):boolean;

范例               

 procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount ? 1 do

    begin

      for y := 0 to stringgrid1.rowcount ? 1 do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);

      end;

    end;

    fileclose(filehandle);

  end;

end;

-----------------------------------------------------------------------------

diskfree   磁碟机剩馀空间(bytes)

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function diskfree(drive: byte): integer;

范例  var

     s: string;

   begin

     s := inttostr(diskfree(0) div 1024) + ´ kbytes free.´;

     label1.caption:=s;

   end;

说明  drive 

   0=目前磁碟机,1=a磁碟机,2=b磁碟机...传回值若为-1,表示磁碟机侦测错误.

范例

var

  s: string;

  amtfree: int64;

  total:   int64;

begin

  amtfree := diskfree(0);

  total := disksize(0);

  s := inttostr(amtfree div total) + ´percent of the space on drive 0 is free: ´ (amtfree div 1024) + ´ kbytes free. ´;

  canvas.textout(10, 10, s);

end;

##diskfree, disksize example

-----------------------------------------------------------------------------

disksize   磁碟机空间大小(bytes)

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function disksize(drive: byte): integer;

范例  var

     s: string;

   begin

     s := inttostr(disksize(0) div 1024) + ´ kbytes free.´;

     label1.caption:=s;

   end;

说明  drive 

   0=目前磁碟机,1=a磁碟机,2=b磁碟机....传回值若为-1,表示磁碟机侦测错误.

##diskfree, disksize example

-----------------------------------------------------------------------------

fileexists   判断档案是否存在.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function fileexists(const filename: string): boolean;

类似                fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

范例

procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount ? 1 do

    begin

      for y := 0 to stringgrid1.rowcount ? 1 do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);

      end;

    end;

    fileclose(filehandle);

  end;

end;

##fileexists, deletefile example

##fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

-----------------------------------------------------------------------------

fileopen   开档.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function fileopen(const filename: string; mode: 

    integer):integer;

****  开档失败传回-1.

说明  以下有关档案读取都属低阶,如dos int 21h中有关档案的部

   分.

   fmopenread   = $0000;

   fmopenwrite   = $0001;

   fmopenreadwrite  = $0002;

   fmsharecompat  = $0000;

   fmshareexclusive  = $0010;

   fmsharedenywrite  = $0020;

   fmsharedenyread  = $0030;

   fmsharedenynone  = $0040;

   fmopenread   open for read access only.

   fmopenwrite   open for write access only.

   fmopenreadwrite  open for read and write access.

   fmsharecompat  compatible with the way fcbs are 

        opened.

   fmshareexclusive  read and write access is denied.

   fmsharedenywrite  write access is denied.

   fmsharedenyread  read access is denied.

   fmsharedenynone  allows full access for others.

范例

procedure openforshare(const filename: string);

var

  filehandle : integer;

begin

  filehandle := fileopen(filename, fmopenwrite or fmsharedenynone);

  if filehandle > 0 then

    {valid file handle}

  else

    {open error: filehandle = negative dos error code}

end;

范例

procedure tform1.button1click(sender: tobject);

var

  ifilehandle: integer;

  ifilelength: integer;

  ibytesread: integer;

  buffer: pchar;

  i: integer

begin

  if opendialog1.execute then

  begin

    try

      ifilehandle := fileopen(opendialog1.filename, fmopenread);

      ifilelength := fileseek(ifilehandle,0,2);

      fileseek(ifilehandle,0,0);

      buffer := pchar(allocmem(ifilelength + 1));

      ibytesread = fileread(ifilehandle, buffer, ifilelength);

      fileclose(ifilehandle);

      for i := 0 to ibytesread-1 do

      begin

        stringgrid1.rowcount := stringgrid1.rowcount + 1;

        stringgrid1.cells[1,i+1] := buffer[i];

        stringgrid1.cells[2,i+1] := inttostr(integer(buffer[i]));

      end;

    finally

      freemem(buffer);

    end;

  end;

end;

##fileopen, fileseek, fileread example

-----------------------------------------------------------------------------

filecreate   建档

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function filecreate(const filename: string): integer;

范例

procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount ? 1 do

    begin

      for y := 0 to stringgrid1.rowcount ? 1 do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);

      end;

    end;

    fileclose(filehandle);

  end;

end;

##fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

-----------------------------------------------------------------------------

fileclose   关档

-----------------------------------------------------------------------------

unit  sysutils

函数原型 procedure fileclose(handle: integer);

范例

procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount ? 1 do

    begin

      for y := 0 to stringgrid1.rowcount ? 1 do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);

      end;

    end;

    fileclose(filehandle);

  end;

end;

##fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

============================================

****  它是以handle为叁数.

============================================

fileread   读取档案

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function fileread(handle: integer; var buffer; count: integer):integer;

范例

procedure tform1.button1click(sender: tobject);

var

  ifilehandle: integer;

  ifilelength: integer;

  ibytesread: integer;

  buffer: pchar;

  i: integer

begin

  if opendialog1.execute then

  begin

    try

      ifilehandle := fileopen(opendialog1.filename, fmopenread);

      ifilelength := fileseek(ifilehandle,0,2);

      fileseek(ifilehandle,0,0);

      buffer := pchar(allocmem(ifilelength + 1));

      ibytesread = fileread(ifilehandle, buffer, ifilelength);

      fileclose(ifilehandle);

      for i := 0 to ibytesread-1 do

      begin

        stringgrid1.rowcount := stringgrid1.rowcount + 1;

        stringgrid1.cells[1,i+1] := buffer[i];

        stringgrid1.cells[2,i+1] := inttostr(integer(buffer[i]));

      end;

    finally

      freemem(buffer);

    end;

  end;

end;

##fileopen, fileseek, fileread example

-----------------------------------------------------------------------------

filewrite   写入档案

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function filewrite(handle: integer; const buffer; count: integer): integer;

范例

procedure tform1.button1click(sender: tobject);

var

  backupname: string;

  filehandle: integer;

  stringlen: integer;

  x: integer;

  y: integer;

begin

  if savedialog1.execute then

  begin

    if fileexists(savedialog1.filename) then

    begin

      backupname := extractfilename(savedialog1.filename);

      backupname := changefileext(backupname, ´.bak´);

      if not renamefile(savedialog1.filename, backupname) then

        raise exception.create(´unable to create backup file.´);

    end;

    filehandle := filecreate(savedialog1.filename);

    { write out the number of rows and columns in the grid. }

    filewrite(filehandle, 

      stringgrid1.colcount, sizeof(stringgrid1.colcount));

    filewrite(filehandle, 

      stringgrid1.rowcount, sizeof(stringgrid1.rowcount));

    for x := 0 to stringgrid1.colcount  do

    begin

      for y := 0 to stringgrid1.rowcount do

      begin

        { write out the length of each string, followed by the string itself. }

        stringlen := length(stringgrid1.cells[x,y]);

        filewrite(filehandle, stringlen, sizeof(stringlen));

        filewrite(filehandle,

          stringgrid1.cells[x,y], length(stringgrid1.cells[x,y]);//?????????/

      end;

    end;

    fileclose(filehandle);

  end;

end;

##fileexists, renamefile, filecreate, filewrite, fileclose, extractfilename example

-----------------------------------------------------------------------------

fileseek   移动档案指标位置

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function fileseek(handle, offset, origin: integer): integer;

说明  origin=0读/写指标由档案开头算起.

   origin=1读/写指标由目前位置算起.

   origin=2读/写指标移动到档案结束处.

****  功能与dos int 21h 插断 42h 的功能相同.

   失败传回-1.

范例  procedure tform1.button1click(sender: tobject);

   var

     filehandle : integer;

     filename : string;

     buffer  : pchar;

     s   : string;

     readbytes : integer;

   begin

     filename:=´c:\delphi_test\abc.ttt´;

     s:=´1234567890´;

     if fileexists(filename) then

    filehandle := fileopen(filename, fmopenreadwrite)

     else

    filehandle := filecreate(filename);

     if filehandle < 0 then

    begin

     messagedlg(´开档失败´, mtinformation, [mbok], 0);

     exit;

    end;

     getmem(buffer, 100);

     try

    strpcopy(buffer, s);

    filewrite(filehandle,buffer^,10);

    fileseek(filehandle,4,0);

    readbytes:=fileread(filehandle, buffer^, 100);

    buffer[readbytes]:=#0;

    label1.caption:=inttostr(readbytes)+´   ´+

     strpas(buffer);

     finally

    freemem(buffer);

     end;

     fileclose(filehandle);

   end;

结果  存档後abc.ttt共有1234567890等十个bytes.

   从第五位元开始读取,共读取六个位元.

   567890

   (位移是从0开始算起)

procedure tform1.button1click(sender: tobject);

var

  ifilehandle: integer;

  ifilelength: integer;

  ibytesread: integer;

  buffer: pchar;

  i: integer

begin

  if opendialog1.execute then

  begin

    try

      ifilehandle := fileopen(opendialog1.filename, fmopenread);

      ifilelength := fileseek(ifilehandle,0,2);

      fileseek(ifilehandle,0,0);

      buffer := pchar(allocmem(ifilelength + 1));

      ibytesread = fileread(ifilehandle, buffer, ifilelength);

      fileclose(ifilehandle);

      for i := 0 to ibytesread-1 do

      begin

        stringgrid1.rowcount := stringgrid1.rowcount + 1;

        stringgrid1.cells[1,i+1] := buffer[i];

        stringgrid1.cells[2,i+1] := inttostr(integer(buffer[i]));

      end;

    finally

      freemem(buffer);

    end;

  end;

end;

##fileopen, fileseek, fileread example

-----------------------------------------------------------------------------

filegetattr  档案属性

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function filegetattr(const filename: string): integer;

说明  fareadonly = $00000001;

   fahidden  = $00000002;

   fasysfile  = $00000004;

   favolumeid = $00000008;

   fadirectory = $00000010;

   faarchive = $00000020;

   faanyfile = $0000003f;

范例  procedure tform1.button1click(sender: tobject);

   var

     s: string;

   begin

     s:=inttostr(filegetattr(´c:\delphi_d\delphi_help1.txt´));

     label1.caption := s;

   end;

-----------------------------------------------------------------------------

filesetattr   设定档案属性

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function filesetattr(const filename: string; attr: integer): 

    integer;

说明  设定成功传回0

-----------------------------------------------------------------------------

findclose   结束findfirst/findnext

-----------------------------------------------------------------------------

procedure tform1.button1click(sender: tobject);

var

  sr: tsearchrec;

  fileattrs: integer;

begin

  stringgrid1.rowcount := 1;

  if checkbox1.checked then

    fileattrs := fareadonly

  else

    fileattrs := 0;

  if checkbox2.checked then

    fileattrs := fileattrs + fahidden;

  if checkbox3.checked then

    fileattrs := fileattrs + fasysfile;

  if checkbox4.checked then

    fileattrs := fileattrs + favolumeid;

  if checkbox5.checked then

    fileattrs := fileattrs + fadirectory;

  if checkbox6.checked then

    fileattrs := fileattrs + faarchive;

  if checkbox7.checked then

    fileattrs := fileattrs + faanyfile;

  if findfirst(edit1.text, fileattrs, sr) = 0 then

  begin

    with stringgrid1 do

    begin

      if (sr.attr and fileattrs) = sr.attr then

      begin

        cells[1,rowcount-1] := sr.name;

        cells[2,rowcount-1] := inttostr(sr.size);

      end;

      while findnext(sr) = 0 do

      begin

        if (sr.attr and fileattrs) = sr.attr then

        begin

        rowcount := rowcount + 1;

        cells[1, rowcount-1] := sr.name;

        cells[2, rowcount-1] := inttostr(sr.size);

        end;

      end;

      findclose(sr);

    end;

  end;

end;

##findfirst, findnext, findclose example

-----------------------------------------------------------------------------

findfirst   寻找第一个符合的档案.

-----------------------------------------------------------------------------

procedure tform1.button1click(sender: tobject);

var

  sr: tsearchrec;

  fileattrs: integer;

begin

  stringgrid1.rowcount := 1;

  if checkbox1.checked then

    fileattrs := fareadonly

  else

    fileattrs := 0;

  if checkbox2.checked then

    fileattrs := fileattrs + fahidden;

  if checkbox3.checked then

    fileattrs := fileattrs + fasysfile;

  if checkbox4.checked then

    fileattrs := fileattrs + favolumeid;

  if checkbox5.checked then

    fileattrs := fileattrs + fadirectory;

  if checkbox6.checked then

    fileattrs := fileattrs + faarchive;

  if checkbox7.checked then

    fileattrs := fileattrs + faanyfile;

  if findfirst(edit1.text, fileattrs, sr) = 0 then

  begin

    with stringgrid1 do

    begin

      if (sr.attr and fileattrs) = sr.attr then

      begin

        cells[1,rowcount-1] := sr.name;

        cells[2,rowcount-1] := inttostr(sr.size);

      end;

      while findnext(sr) = 0 do

      begin

        if (sr.attr and fileattrs) = sr.attr then

        begin

        rowcount := rowcount + 1;

        cells[1, rowcount-1] := sr.name;

        cells[2, rowcount-1] := inttostr(sr.size);

        end;

      end;

      findclose(sr);

    end;

  end;

end;

##findfirst, findnext, findclose example

-----------------------------------------------------------------------------

findnext   寻找下一个符合的档案.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 procedure findclose(var f: tsearchrec);

函数原型 function findfirst(const path: string; attr: integer;

    var f: tsearchrec): integer;

函数原型 function findnext(var f: tsearchrec): integer;

说明  成功传回0

范例  var

     srec: tsearchrec;

   procedure tform1.searchclick(sender: tobject);

   begin

     findfirst(´c:\delphi\bin\*.*´, faanyfile, srec);

     label1.caption := srec.name + ´ is ´ + inttostr(srec.size) + 

    ´ bytes in size´;

   end;

   procedure tform1.againclick(sender: tobject);

   begin

     findnext(srec);

     label1.caption := srec.name + ´ is ´ + inttostr(srec.size) + 

    ´ bytes in size´;

   end;

   procedure tform1.formclose(sender: tobject);

   begin

     findclose(srec);

   end

   tsearchrec = record

    time: integer;

    size: integer;

    attr: integer;

    name: tfilename;

    xcludeattr: integer;

    findhandle: thandle;

    finddata: twin32finddata;

   end;

============================================

floating-point conversion routines 浮点数转换函式

============================================

floattodecimal 将浮点数转换为十进位数.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 procedure floattodecimal(var result: tfloatrec; const value;

    valuetype: tfloatvalue; precision, decimals: integer);

-----------------------------------------------------------------------------

floattostrf  将浮点数转换为格式化字串.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function floattostrf(value: extended; format: tfloatformat; 

    precision,digits: integer): string;

-----------------------------------------------------------------------------

floattostr   将浮点数转换为字串.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function floattostr(value: extended): string;

-----------------------------------------------------------------------------

floattotext  将浮点数转换为格式化十进位.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function floattotext(buffer: pchar; const value; valuetype: 

    tfloatvalue;format: tfloatformat; precision, digits: 

    integer): integer;

-----------------------------------------------------------------------------

floattotextfmt 将浮点数转换为格式化十进位.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function floattotextfmt(buffer: pchar; const value; 

    valuetype: tfloatvalue; format: pchar): integer;

-----------------------------------------------------------------------------

formatfloat  将浮点数转换为格式化字串.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function formatfloat(const format: string; value: extended): 

    string;

-----------------------------------------------------------------------------

strtofloat   将字串转换为浮点数.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function strtofloat(const s: string): extended;

范例  procedure tform1.button1click(sender: tobject);

   var

     value:double;

     s:string;

   begin

     s:=´ 1234.56  ´;

     value:=strtofloat(s);

     label1.caption:=format(´转换为 [%9.3f]´,[value]);

   end;

注意  若s字串含有非数字字元,会产生错误讯号.

-----------------------------------------------------------------------------

texttofloat  将 null-terminated 字串转换为浮点数.

-----------------------------------------------------------------------------

unit  sysutils

函数原型 function texttofloat(buffer: pchar; var value; valuetype: 

    tfloatvalue): boolean;

===========================================

 flow-control routines 流程控制常式

===========================================

break    从 for, while, or repeat 终止跳出.

-----------------------------------------------------------------------------

unit  system

函数原型  procedure break;

范例  var

     s: string;

   begin

     while true do

    begin

     readln(s);

     try

      if s = ´ then break;

      writeln(s);

     finally

      { do something for all cases }

     end;

    end;

   end;

-----------------------------------------------------------------------------

continue   从 for, while, or repeat 继续执行.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure continue;

范例  var

     f: file;

     i: integer;

   begin

     for i := 0 to (filelistbox1.items.count - 1) do

    begin

     try

      if filelistbox1.selected[i] then

       begin

     if not fileexists(filelistbox1.items.strings[i]) then

      begin

      messagedlg(´file: ´ +filelistbox1.items.strings[i] 

      + ´ not found´, mterror, [mbok], 0);

      continue;

      end;

       assignfile(f, filelistbox1.items.strings[i]);

       reset(f, 1);

       listbox1.items.add(inttostr(filesize(f)));

       closefile(f);

       end;

     finally

       { do something here }

     end;

    end;

   end;

范例

var

  f: file;

  i: integer;

begin

  for i := 0 to (filelistbox1.items.count - 1) do begin

  try

    if filelistbox1.selected[i] then 

    begin

      if not fileexists(filelistbox1.items.strings[i]) then begin

        messagedlg(´file: ´ + filelistbox1.items.strings[i] + 

                   ´ not found´, mterror, [mbok], 0);

        continue;

      end;

      assignfile(f, filelistbox1.items.strings[i]);

      reset(f, 1);

      listbox1.items.add(inttostr(filesize(f)));

      closefile(f);

    end;

   finally

   { do something here }

   end;

  end;

end;

## continue, items, selected example

-----------------------------------------------------------------------------

exit    直接离开一个程序.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure exit;

-----------------------------------------------------------------------------

halt    结束程式返回作业系统.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure halt [ ( exitcode: integer) ];

范例  begin

     if 1 = 1 then

    begin

     if 2 = 2 then

       begin

      if 3 = 3 then

        begin

       halt(1); { halt right here! }

        end;

       end;

    end;

     canvas.textout(10, 10, ´this will not be executed´);

    end;

-----------------------------------------------------------------------------

runerror   停止程式执行且执行run-time error.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure runerror [ ( errorcode: byte ) ];

范例  begin

     {$ifdef debug}

     if p = nil then

    runerror(204);

     {$endif}

   end;

=====================================

 i/o routines    i/o常式

=====================================

assignfile   指定档案给一个档案变数.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure assignfile(var f; filename: string);

说明  **一个档案不可重复执行assignfile两次以上.

example

var 

  f: textfile;

  s: string;

begin

  if opendialog1.execute then          { display open dialog box }

  begin

    assignfile(f, opendialog1.filename);   { file selected in dialog box }

    reset(f);

    readln(f, s);                          { read the first line out of the file }

    edit1.text := s;                       { put string in a tedit control }

    closefile(f);

  end;

end;

## assignfile, opendialog, readln, closefile example

-----------------------------------------------------------------------------

closefile   关闭档案.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure closefile(var f);

#### assignfile, opendialog, readln, closefile example

-----------------------------------------------------------------------------

ioresult 传回最近一次执行i/o函数,是否有错误.

-----------------------------------------------------------------------------

unit  system

函数原型 function ioresult: integer;

范例  var

     f: file of byte;

     s: string;

   begin

     s:= ´c:\ka\aaa.txt´;

     assignfile(f, s);

     {$i-}

     reset(f);

     {$i+}

     if ioresult = 0 then

    label1.caption:=´file size in bytes: ´ +

     inttostr(filesize(f);

     else

    label1.caption:=´开档失败´;

   end;

说明  传回0表示没有错误.

example

var 

  f: file of byte;

begin

  if opendialog1.execute then begin

    assignfile(f, opendialog1.filename);

    {$i-}

    reset(f);

    {$i+}

    if ioresult = 0 then

      messagedlg(´file size in bytes: ´ + inttostr(filesize(f)),

        mtinformation, [mbok], 0)

    else

      messagedlg(´file access error´, mtwarning, [mbok], 0);

  end;

end;

-----------------------------------------------------------------------------

reset    开起一个可供读取的档案.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure reset(var f [: file; recsize: word ] );

-----------------------------------------------------------------------------

rewrite   建立一个可供写入的新档案.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure rewrite(var f: file [; recsize: word ] );

范例  procedure tform1.button1click(sender: tobject);

   var

     f: textfile;

     i1,i2,i3:integer;

     s1,s2,s3:string;

   begin

     i1:=1234;

     i2:=5678;

     i3:=90;

     s1:=´abcd´;

     s2:=´efgh´;

     s3:=´ij´;

     assignfile(f,´c:\ka\aaa.txt´);

     rewrite(f);

     write(f,i1);

     write(f,i2);

     write(f,i3);

     write(f,s1);

     write(f,s2);

     write(f,s3);

     write(f,i1,i2,i3);

     write(f,s1,s2,s3);

     writeln(f,i1);

     writeln(f,i2);

     writeln(f,i3);

     writeln(f,s1);

     writeln(f,s2);

     writeln(f,s3);

     writeln(f,i1,i2,i3);

     writeln(f,s1,s2,s3);

     reset(f);

     readln(f, s1);

     readln(f, i1);

     label1.caption:=s1+´   ´+inttostr(i1);

     closefile(f);

   end;

结果  1234567890abcdefghij1234567890abcdefghij1234..

   5678..

   90..

   abcd..

   efgh..

   ij..

   1234567890..

   abcdefghij..

   abcdefghij..

   以上是存档结果,两点代表#13#10,两个位元.

   以writeln存档者,多出换行符号#13#10.

   且如果以writeln(f,i1,i2,i3)会当成同一串列,

   变数间没有间隔符号,造成read时得不到预期的效果.

   读取结果

   s1=1234567890abcdefghij1234567890abcdefghij1234

   长度44且不含#13#10两个位元.

   i1=5678

**  write(f,i1:10:2,i2:8:2);

   具有格式化的功能,如同str.

范例  procedure tform1.button1click(sender: tobject);

   var

     f: file of byte;

     i1,i2,i3:byte;

   begin

     i1:=16;

     i2:=32;

     i3:=48;

     assignfile(f,´c:\ka\aaa.txt´);

     rewrite(f);

     write(f,i1);

     write(f,i2);

     write(f,i3);

     write(f,i1,i2,i3);

     i1:=0;

     reset(f);

     read(f, i1);

     label1.caption:=inttostr(i1);

     closefile(f);

   end;

结果  file of byte 及 file of record

   只能以write及read,来写入及读取,

   不可以writeln及readln.

范例  procedure tform1.button1click(sender: tobject);

   type

     pprec = record

    pp_no:string[5];

    pp_name:string[10];

    pp_age:integer;

    pp_sum:double;

     end;

   var

     rec : pprec;

     rec2: pprec;

     f: file of pprec;

   begin

     with rec do

    begin

     pp_no:=´0001´;

     pp_name:=´abc´;

     pp_age:=12;

     pp_sum:=600;

     end;

     assignfile(f,´c:\ka\aaa.txt´);

     rewrite(f);

     write(f,rec);

     rec.pp_no:=´0002´;

     rec.pp_sum:=58.2;

     write(f,rec);

     rec.pp_no:=´0003´;

     rec.pp_sum:=258.242;

     write(f,rec);

     seek(f,1);

     read(f,rec2);

     seek(f,1);

     truncate(f);  {删除,只剩第0笔}

     canvas.textout(5,10,rec2.pp_no);

     canvas.textout(5,30,rec2.pp_name);

     canvas.textout(5,50,format(´%d´,[rec2.pp_age]));

     canvas.textout(5,70,format(´%f´,[rec2.pp_sum]));

     closefile(f);

   end;

结果  pp_no存入6 bytes

   pp_name存入11 bytes

   pp_age存入4 bytes(integer 4 bytes)

   pp_sum存入8 bytes(double 8 bytes)

   整个record以16的倍数存档.

example

var f: textfile;

begin

  assignfile(f, ´newfile.$$$´);

  rewrite(f);

  writeln(f, ´just created file with this text in it...´);

  closefile(f);

end;

-----------------------------------------------------------------------------

seek    移动档案指标.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure seek(var f; n: longint);

说明  seek从0开始.

example

var

   f: file of byte;

   size : longint;

   s: string;

   y: integer;

 begin

   if opendialog1.execute then

   begin

     assignfile(f, opendialog1.filename);

     reset(f);

     size := filesize(f);

     s := ´file size in bytes: ´ + inttostr(size);

     y := 10;

     canvas.textout(5, y, s);

     y := y + canvas.textheight(s) + 5;

     s := ´seeking halfway into file...´;

     canvas.textout(5, y, s);

     y := y + canvas.textheight(s) + 5;

     seek(f,size div 2);

     s := ´position is now ´ + inttostr(filepos(f));

     canvas.textout(5, y, s);

     closefile(f);

   end;

 end;

## filesize, seek, filepos example

-----------------------------------------------------------------------------

truncate   将目前档案指标位置之後的档案内容全部删除.

-----------------------------------------------------------------------------

unit  system

函数原型 procedure truncate(var f);

范例  

var

   f: file of integer;

   i,j: integer;

 begin

   assignfile(f,´test.int´);

   rewrite(f);

   for i := 1 to 6 do

     write(f,i);

   writeln(´file before truncation:´);

   reset(f);

   while not eof(f) do

   begin

     read(f,i);

     writeln(i);

   end;

   reset(f);

   for i := 1 to 3 do

     read(f,j); { read ahead 3 records }

   truncate(f); { cut file off here }

   writeln;

   writeln(´file after truncation:´);

   reset(f);

   while not eof(f) do

   begin

     read(f,i);

     writeln(i);

   end;

   closefile(f);

   erase(f);

 end;

-----------------------------------------------------------------------------

filepos   传回目前档案的位置.

-----------------------------------------------------------------------------

unit  system

函数原型 function filepos(var f): longint

说明  f 不可为 text file

   档头 :filepos(f):=0;

   档尾 :eof(f):=true;

范例  var

     f: file of byte;

     s: string;

   begin

     s:= ´c:\ka\abc.txt´;

     assignfile(f, s);

     reset(f);

     seek(f,1);

     label1.caption := ´现在位置 : ´ + inttostr(filepos(f));

   end;

example

var

   f: file of byte;

   size : longint;

   s: string;

   y: integer;

 begin

   if opendialog1.execute then

   begin

     assignfile(f, opendialog1.filename);

     reset(f);

     size := filesize(f);

     s := ´file size in bytes: ´ + inttostr(size);

     y := 10;

     canvas.textout(5, y, s);

     y := y + canvas.textheight(s) + 5;

     s := ´seeking halfway into file...´;

     canvas.textout(5, y, s);

     y := y + canvas.textheight(s) + 5;

     seek(f,size div 2);

     s := ´position is now ´ + inttostr(filepos(f));

     canvas.textout(5, y, s);

     closefile(f);

   end;

 end;

##filesize, seek, filepos example

-----------------------------------------------------------------------------

filesize   档案长度.

-----------------------------------------------------------------------------

unit  system

函数原型 function filesize(var f): integer;

说明  f 不可为 text file

   如果f为record file,则传回record数,

   否则传回byte数.

## filesize, seek, filepos example

-----------------------------------------------------------------------------

eof     测试档案是否结束.

-----------------------------------------------------------------------------

unit  system

函数原型 function eof(var f): boolean;

函数原型 function eof [ (var f: text) ]: boolean;

范例  var

     f1, f2: textfile;

     ch: char;

   begin

     if opendialog1.execute then

    begin

      assignfile(f1, opendialog1.filename);

      reset(f1);

      if savedialog1.execute then

     begin

       assignfile(f2, opendialog1.filename);

       rewrite(f2);

       while not eof(f1) do

      begin

       read(f1, ch);

       write(f2, ch);

      end;

       closefile(f2);

     end;

      closefile(f1);

    end;

   end;

example

var

  f1, f2: textfile;

  ch: char;

begin

  if opendialog1.execute then begin

    assignfile(f1, opendialog1.filename);

    reset(f1);

    if savedialog1.execute then begin

      assignfile(f2, savedialog1.filename);

      rewrite(f2);

      while not eof(f1) do

      begin

        read(f1, ch);

        write(f2, ch);

      end;

      closefile(f2);

    end;

    closefile(f1);

  end;

end;

-----------------------------------------------------------------------------

openpicturedialog  opendialog  开启档案.

-----------------------------------------------------------------------------

//savepicturedialog1.defaultext := graphicextension(tbitmap);

//savepicturedialog1.filter := graphicfilter(tbitmap);

procedure tform1.button1click(sender: tobject);

var 

done: boolean;

begin

  openpicturedialog1.defaultext := graphicextension(ticon);

  openpicturedialog1.filename := graphicfilemask(ticon);

  openpicturedialog1.filter := graphicfilter(ticon);

  openpicturedialog1.options := [offilemustexist, ofhidereadonly, ofnochangedir ];

  while not done do

  begin

  if openpicturedialog1.execute then

    begin

    if not (ofextensiondifferent in openpicturedialog1.options) then

      begin

      application.icon.loadfromfile(openpicturedialog1.filename);

      done := true;

      end

    else

      openpicturedialog1.options := openpicturedialog1.options - ofextensiondifferent;

    end

  else { user cancelled }

    done := true;<