DELPHI常用函数集及简要范例
来源：互联网 发布：激光器的软件 编辑：程序博客网 时间：2024/06/07 02:49
----------
abs(x) 绝对值
arctan(x) 反正切
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;
end;
end;
## Eof, Read, Write Example
----------
Erase 删除档案.
----------
Unit System
函数原型 procedure Erase(var F);
说明 要先关档后才可以执行.
范例 procedure TForm1.Button1Click(Sender: TObject);
var
F: Textfile;
begin
OpenDialog1.Title := 'Delete File';
if OpenDialog1.Execute then
begin
AssignFile(F, OpenDialog1.FileName);
try
Reset(F);
if MessageDlg('Erase ' + OpenDialog1.FileName +
'?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
CloseFile(F);
Erase(F);
end;
except
on EInOutError do
MessageDlg('File I/O error.', mtError, [mbOk], 0);
end;
end;
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
F: Textfile;
begin
OpenDialog1.Title := 'Delete File';
if OpenDialog1.Execute then begin
AssignFile(F, OpenDialog1.FileName);
try
Reset(F);
if MessageDlg('Erase ' + OpenDialog1.FileName + '?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
CloseFile(F);
Erase(F);
end;
except
on EInOutError do
MessageDlg('File I/O error.', mtError, [mbOk], 0);
end;
end;
end;
##Erase, OpenDialog.Title, OpenDialog.FileName Example
----------
Rename 更改档名.
----------
Unit System
函数原型 procedure Rename(var F; Newname);
范例 uses Dialogs;
var
f : file;
begin
OpenDialog1.Title := 'Choose a file... ';
if OpenDialog1.Execute then
begin
SaveDialog1.Title := 'Rename to...';
if SaveDialog1.Execute then
begin
AssignFile(f, OpenDialog1.FileName);
Canvas.TextOut(5, 10, 'Renaming ' +
OpenDialog1.FileName +' to ' +
SaveDialog1.FileName);
Rename(f, SaveDialog1.FileName);
end;
end;
end;
Example
uses Dialogs;
var
f : file;
begin
OpenDialog1.Title := 'Choose a file... ';
if OpenDialog1.Execute then begin
SaveDialog1.Title := 'Rename to...';
if SaveDialog1.Execute then begin
AssignFile(f, OpenDialog1.FileName);
Canvas.TextOut(5, 10, 'Renaming ' + OpenDialog1.FileName + ' to ' +
SaveDialog1.FileName);
Rename(f, SaveDialog1.FileName);
end;
end;
end;
----------
GetDir 传回指定磁碟机的目录.
----------
Unit System
函数原型 procedure GetDir(D: Byte; var S: string);
说明 D
0=目前磁碟机,1=A磁碟机,2=B磁碟机....
**此函式不检查磁碟机错误.
范例 var
s : string;
begin
GetDir(0,s); { 0 = Current drive }
MessageDlg('Current drive and directory: ' + s,
mtInformation, [mbOk] , 0);
end;
----------
MkDir 建立子目录.
----------
Unit System
函数原型 procedure MkDir(S: string);
范例 uses Dialogs;
begin
{$I-}
{ Get directory name from TEdit control }
MkDir(Edit1.Text);
if IOResult <> 0 then
MessageDlg('Cannot create directory', mtWarning,
[mbOk], 0)
else
MessageDlg('New directory created', mtInformation,
[mbOk], 0);
end;
----------
RmDir 删除一个空的子目录.
----------
Unit System
函数原型 procedure RmDir(S: string);
范例 uses Dialogs;
begin
{$I-}
{ Get directory name from TEdit control }
RmDir(Edit1.Text);
if IOResult <> 0 then
MessageDlg('Cannot remove directory', mtWarning,
[mbOk], 0)
else
MessageDlg('Directory removed', mtInformation, [mbOk],
0);
end;
----------
ChDir 改变目前目录.
----------
Unit System
函数原型 procedure ChDir(S: string);
范例 begin
{$I-}
{ Change to directory specified in Edit1 }
ChDir(Edit1.Text);
if IOResult <> 0 then
MessageDlg('Cannot find directory', mtWarning,[mbOk],
0);
end;
==========
Memory-management routines 记忆体管理常式
==========
AllocMem 配置记忆体.
----------
Unit SysUtils
函数原型 function AllocMem(Size: Cardinal): Pointer;
说明 FreeMem释放记忆体.
----------
GetHeapStatus 传回目前Heap区的记忆体配置状态.
----------
Unit System
函数原型 function GetHeapStatus: THeapStatus;
----------
GetMemoryManager 传回目前Heap区的记忆体配置 的进入点.
----------
Unit System
函数原型 procedure GetMemoryManager(var MemMgr:
TMemoryManager);
EXample
var
GetMemCount: Integer;
FreeMemCount: Integer;
ReallocMemCount: Integer;
OldMemMgr: TMemoryManager;
function NewGetMem(Size: Integer): Pointer;
begin
Inc(GetMemCount);
Result := OldMemMgr.GetMem(Size);
end;
function NewFreeMem(P: Pointer): Integer;
begin
Inc(FreeMemCount);
Result := OldMemMgr.FreeMem(P);
end;
function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Inc(ReallocMemCount);
Result := OldMemMgr.ReallocMem(P, Size);
end;
const
NewMemMgr: TMemoryManager = (
GetMem: NewGetMem;
FreeMem: NewFreeMem;
ReallocMem: NewReallocMem);
procedure SetNewMemMgr;
begin
GetMemoryManager(OldMemMgr);
SetMemoryManager(NewMemMgr);
end;
## GetMemoryManager, SetMemoryManager Example
----------
ReAllocMem 重新配置记忆体.
----------
Unit Systems
函数原型 procedure ReallocMem(var P: Pointer; Size: Integer);
----------
SetMemoryManager 设定目前Heap区的记忆体配置 的进入点.
----------
Unit System
函数原型 procedure SetMemoryManager(const MemMgr:
TMemoryManager);
type
THeapStatus = record
TotalAddrSpace: Cardinal;s
TotalUncommitted: Cardinal;
TotalCommitted: Cardinal;
TotalAllocated: Cardinal;
TotalFree: Cardinal;
FreeSmall: Cardinal;
FreeBig: Cardinal;
Unused: Cardinal;
Overhead: Cardinal;
HeapErrorCode: Cardinal;
end;
type
PMemoryManager = ^TMemoryManager;
TMemoryManager = record
GetMem: function(Size: Integer): Pointer;
FreeMem: function(P: Pointer): Integer;
ReallocMem: function(P: Pointer; Size: Integer): Pointer;
end;
Example
var
GetMemCount: Integer;
FreeMemCount: Integer;
ReallocMemCount: Integer;
OldMemMgr: TMemoryManager;
function NewGetMem(Size: Integer): Pointer;
begin
Inc(GetMemCount);
Result := OldMemMgr.GetMem(Size);
end;
function NewFreeMem(P: Pointer): Integer;
begin
Inc(FreeMemCount);
Result := OldMemMgr.FreeMem(P);
end;
function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Inc(ReallocMemCount);
Result := OldMemMgr.ReallocMem(P, Size);
end;
const
NewMemMgr: TMemoryManager = (
GetMem: NewGetMem;
FreeMem: NewFreeMem;
ReallocMem: NewReallocMem);
procedure SetNewMemMgr;
begin
GetMemoryManager(OldMemMgr);
SetMemoryManager(NewMemMgr);
end;
##GetMemoryManager, SetMemoryManager Example
==========
Miscellaneous routines 其他常式
==========
Exclude 删除一组元素中的一个元素.
----------
Unit System
函数原型 procedure Exclude(var S: set of T;I:T);
说明 删除S中的I元素.
----------
FillChar 填入元素.
----------
Unit System
函数原型 procedure FillChar(var X; Count: Integer; value);
说明 以value填入X中Count个.
范例 Example
var
S: array[0..79] of char;
begin
{ Set to all spaces }
FillChar(S, SizeOf(S), Ord(' '));
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------
Hi 传回高位元数字.
----------
Unit System
函数原型 function Hi(X): Byte;
范例 var B: Byte;
begin
B := Hi($1234); { $12 }
end;
----------
Include 加入一个元素到一组元素.
----------
Unit System
函数原型 procedure Include(var S: set of T; I:T);
说明 加入I元素到S中.
----------
Lo 传回高位元数字.
----------
Unit System
函数原型 function Lo(X): Byte;
范例 var B: Byte;
begin
B := Lo($1234); { $34 }
end;
----------
Move 从来源变数拷贝n个Bytes到目的变数.
----------
Unit System
函数原型 procedure Move(var Source, Dest; Count: Integer);
范例 var
A: array[1..4] of Char;
B: Integer;
begin
Move(A, B, SizeOf(B));
{ SizeOf = safety! }
end;
----------
ParamCount 直接由执行档后加上传入变数的个数.(arj.exe a dr.arj d:*.*)
----------
Unit System
函数原型 function ParamCount: Integer;
说明 如上例则传回3
Example
var
I: Integer;
ListItem: string;
begin
for I := 0 to IBQuery1.ParamCount - 1 do
begin
ListItem := ListBox1.Items[I];
case IBQuery1.Params[I].DataType of
ftString:
IBQuery1.Params[I].AsString := ListItem;
ftSmallInt:
IBQuery1.Params[I].AsSmallInt := StrToIntDef(ListItem, 0);
ftInteger:
IBQuery1.Params[I].AsInteger := StrToIntDef(ListItem, 0);
ftWord:
IBQuery1.Params[I].AsWord := StrToIntDef(ListItem, 0);
ftBoolean:
begin
if ListItem = 'True' then
IBQuery1.Params[I].AsBoolean := True
else
IBQuery1.Params[I].AsBoolean := False;
end;
ftFloat:
IBQuery1.Params[I].AsFloat := StrToFloat(ListItem);
ftCurrency:
IBQuery1.Params[I].AsCurrency := StrToFloat(ListItem);
ftBCD:
IBQuery1.Params[I].AsBCD := StrToCurr(ListItem);
ftDate:
IBQuery1.Params[I].AsDate := StrToDate(ListItem);
ftTime:
IBQuery1.Params[I].AsTime := StrToTime(ListItem);
ftDateTime:
IBQuery1.Params[I].AsDateTime := StrToDateTime(ListItem);
end;
end;
end;
##ParamCount, DataType, StrToIntDef, AsXXX Example
----------
ParamStr
----------
Unit System
函数原型 function ParamStr(Index: Integer): string;
说明 ParamStr(0);传回执行档的名称及完整目录.
(C:/ZIP/ARJ.EXE)
范例
var
I: Word;
Y: Integer;
begin
Y := 10;
for I := 1 to ParamCount do
begin
Canvas.TextOut(5, Y, ParamStr(I));
Y := Y + Canvas.TextHeight(ParamStr(I)) + 5;
end;
end;
Example
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
for i := 0 to ParamCount -1 do
begin
if LowerCase(ParamStr(i)) = 'beep' then
Windows.Beep(10000,1000)
else
if (LowerCase(ParamStr(i)) = 'exit' then
Application.Terminate;
end;
end;
##ParamCount, ParamStr Example
----------
Random 乱数
----------
Unit System
函数原型 function Random [ ( Range: Integer) ];
说明 0<=X<Range
范例 var
I: Integer;
begin
Randomize;
for I := 1 to 50 do
begin
{ Write to window at random locations }
Canvas.TextOut(Random(Width), Random(Height),
'Boo!');
end;
end;
----------
Randomize 乱数种子.
----------
Unit System
函数原型 procedure Randomize;
Example
var
I: Integer;
begin
Randomize;
for I := 1 to 50 do begin
{ Write to window at random locations }
Canvas.TextOut(Random(Width), Random(Height), 'Boo!');
end;
end;
##Randomize, Random Example
----------
SizeOf 传回X变数的位元数.
----------
Unit System
函数原型 function SizeOf(X): Integer;
范例 type
CustRec = record
Name: string[30];
Phone: string[14];
end;
var
P: ^CustRec;
begin
GetMem(P, SizeOf(CustRec));
Canvas.TextOut(10, 10, 'The size of the record is ' +
IntToStr(SizeOf(CustRec)));
FreeMem (P, SizeOf(CustRec));
Readln;
end;
----------
Swap 将一组变数的高低位元交换.
----------
Unit System
函数原型 function Swap(X);
范例 var
X: Word;
begin
X := Swap($1234); { $3412 }
end;
----------
UpCase 将一字元转为大写字母.
----------
Unit System
函数原型 function UpCase(Ch: Char): Char;
范例 uses Dialogs;
var
s : string;
i : Integer;
begin
{ Get string from TEdit control }
s := Edit1.Text;
for i := 1 to Length(s) do
s[i] := UpCase(s[i]);
MessageDlg('Here it is in all uppercase: ' + s, mtInformation,
[mbOk], 0);
end;
Example
var
s : string;
i : Integer;
begin
{ Get string from TEdit control }
s := Edit1.Text;
for i := 1 to Length(s) do
if i mod 2 = 0 then s[i] := UpCase(s[i]);
Edit1.Text := s;
end;
==========
Ordinal routines 序列常式
==========
Dec 使变数递减.
----------
Unit System
函数原型 procedure Dec(var X[ ; N: Longint]);
说明 Dec(X) ==> X:=X-1;
Dec(X,N) ==> X:=X-N;
范例 var
IntVar: Integer;
LongintVar: Longint;
begin
Intvar := 10;
LongintVar := 10;
Dec(IntVar); { IntVar := IntVar - 1 }
Dec(LongintVar, 5); { LongintVar := LongintVar - 5 }
end;
----------
Inc 使变数递增.
----------
Unit System
函数原型 procedure Inc(var X [ ; N: Longint ] );
说明 Inc(X) ==> X:=X-1;
Inc(X,N) ==> X:=X-N;
范例 var
IntVar: Integer;
LongintVar: Longint;
begin
Inc(IntVar); { IntVar := IntVar + 1 }
Inc(LongintVar, 5); { LongintVar := LongintVar + 5 }
end;
----------
Odd 检查是否为奇数.
----------
Unit System
函数原型 function Odd(X: Longint): Boolean;
Example
begin
if Odd(5) then
Canvas.TextOut(10, 10, '5 is odd.')
else
Canvas.TextOut(10, 10, 'Something is odd!');
end;
==========
Pointer and address routines 位址常式
==========
Addr 传回一个物件的位址.
----------
Unit System
函数原型 function Addr(X): Pointer;
Example
var
I : Integer;
NodeNumbers: array [0 .. 100] of Integer;
begin
with TreeView1 do
begin
for I := 0 to Items.Count - 1 do
begin
NodeNumbers[I] := CalculateValue(Items[I]);
Items[I].Data := Addr(NodeNumber[I]);
end;
end;
end;
----------
Assigned 测试指标变数是否为nil.
----------
Unit System
函数原型 function Assigned(var P): Boolean;
说明 当@P=nil ==> 传回FALSE
范例 var P: Pointer;
begin
P := nil;
if Assigned (P) then
Writeln ('You won't see this');
GetMem(P, 1024); {P valid}
FreeMem(P, 1024); {P no longer valid and still not nil}
if Assigned (P) then
Writeln ('You'll see this');
end
==========
String-formatting routines 字串格式化
==========
FmtStr 格式化.
----------
FmtStr(var StrResult: string;const Format: string;const Args: array of string );
----------
Format
Format(const Format: string;const Args: array of string ): string;
----------
Unit SysUtils
函数原型 procedure FmtStr(var Result: string; const Format: string;
const Args: array of const);
function Format(const Format: string; const Args: array of
const): string;
说明 %d : 整数
%e : 科学式
%f : 定点实数
%g : 实数
%n : 实数(-d,ddd,ddd.dd ...)
%m: 金钱格式
%p : point
%s : 字串
%x : Hex
范例 var
i: Integer;
j: Double;
s: String;
t: String;
begin
t:=Format('%d %8.2f %s',[i,j,s]);
ListBox1.Item.Add(t);
end;
BubbleSeries1.PercentFormat := '##0.0# %';
Example
procedure TForm1.Table1AfterDelete(DataSet: TDataSet);
begin
StatusBar1.SimpleText := Format('There are now %d records in the table', [DataSet.RecordCount]);
end;
S:= Format( '1-? ??????? ??????? - %d, 2-? - %d, 3-? - %d', [10,20,30] );
Format( '%*.*f', [ 9, 2, 12345.6789 ] );
Format( '%9.2f', [ 12345.6789 ] );
Format( '%3d, %d, %0:d, %2:-4d, %d', [ 1, 2, 3, 4 ] );
' 1,2,1,3 ,4'
## AfterDelete, Format Example
==========
String-handling routines (Pascal-style) 字串函式
==========
AnsiCompareStr 比较两个字串的大小.依安装的 language driver.
----------
AnsiCompareText ( AnsiCompareText 此项不分大小写 ).
----------
Unit SysUtils
var
S1,S2: string;
I: Integer;
begin
S1:= 'A????';
S2:= '?????';
I:= CompareStr(S1, S2); { I = 0, ?.?. S1 = S2 }
if I=0 then
MessageDlg(S1, '=', S2, mtWarning, [mbOK], 0);
end;
函数原型 function AnsiCompareStr(const S1, S2: string):Integer;
函数原型 function AnsiCompareText(const S1, S2: string):Integer;
----------
AnsiLowerCase 将字串全部转为小写字母.依安装的 language driver.
----------
AnsiUpperCase 将字串全部转为大写字母.依安装的 language drive
----------
Unit SysUtils
函数原型 function AnsiLowerCase(const S: string): string;
函数原型 function AnsiUpperCase(const S: string): string;
----------
CompareStr 比较两个字串的大小.
----------
CompareText ( CompareText 此项不分大小写 ).
----------
Unit SysUtils
函数原型 function CompareStr(const S1, S2: string): Integer;
函数原型 function CompareText(const S1, S2: string): Integer;
范例 var
String1, String2 : string;
I : integer;
begin
String1 := 'STEVE';
String2 := 'STEVe';
I := CompareStr(String1, String2); { I < 0 }
if I < 0 then
MessageDlg('String1 < String2', mtWarning, [mbOK], 0);
end;
var
String1, String2 : string;
I : integer;
begin
String1 := 'ABC';
String2 := 'aaa';
I := CompareStr(String1, String2); { I < 0 }
if I < 0 then
MessageDlg(' String1 < String2', mtWarning, [mbOK], 0);
end;
Examlpe
var ColumnToSort: Integer;
The OnColumnClick event handler sets the global variable to indicate the column to sort and calls AlphaSort:
procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
ColumnToSort := Column.Index;
(Sender as TCustomListView).AlphaSort;
end;
The OnCompare event handler causes the list view to sort on the selected column:
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
var
ix: Integer;
begin
if ColumnToSort = 0 then
Compare := CompareText(Item1.Caption,Item2.Caption)
else begin
ix := ColumnToSort - 1;
Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
end;
end;
## OnColumnClick, AlphaSort, OnCompare, CompareText example
----------
Concat 将字串相加.
----------
Unit System
函数原型 function Concat(s1 [, s2,..., sn]: string): string;
说明 与 S := S1 + S2 + S3 ...; 相同.
范例 var
S: string;
begin
S := Concat('ABC', 'DEF'); { 'ABCDE' }
end;
var
S: string;
begin
S:= '? '+ '???? '+ '???????? ??????';
S:= Concat('? ', '???? ', '???????? ??????');
// ? ????? ??????? S := '? ???? ???????? ??????'
end;
----------
Copy 从母字串拷贝至另一个字串.
----------
Unit System
函数原型 function Copy(S: string; Index, Count: Integer): string;
说明 S : 字串.
Indexd : 从第几位开始拷贝.
Count : 总共要拷贝几位.
范例 var S: string;
begin
S := 'ABCDEF';
S := Copy(S, 2, 3); { 'BCD' }
end;
----------
var
S: string;
begin
S:= '??????';
S:= Copy( S, 3, 4); // S := '????'
end;
----------
Example
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
var
Found: boolean;
i,SelSt: Integer;
TmpStr: string;
begin
{ first, process the keystroke to obtain the current string }
{ This code requires all items in list to be uppercase}
if Key in ['a'..'z'] then Dec(Key,32); {Force Uppercase only!}
with (Sender as TComboBox) do
begin
SelSt := SelStart;
if (Key = Chr(vk_Back)) and (SelLength <> 0) then
TmpStr := Copy(Text,1,SelStart)+Copy(Text,SelLength+SelStart+1,255)
else if Key = Chr(vk_Back) then {SelLength = 0}
TmpStr := Copy(Text,1,SelStart-1)+Copy(Text,SelStart+1,255)
else {Key in ['A'..'Z', etc]}
TmpStr := Copy(Text,1,SelStart)+Key+Copy(Text,SelLength+SelStart+1,255);
if TmpStr = ' then Exit;
{ update SelSt to the current insertion point }
if (Key = Chr(vk_Back)) and (SelSt > 0) then Dec(SelSt)
else if Key <> Chr(vk_Back) then Inc(SelSt);
Key := #0; { indicate that key was handled }
if SelSt = 0 then
begin
Text:= ';
Exit;
end;
{Now that TmpStr is the currently typed string, see if we can locate a match }
Found := False;
for i := 1 to Items.Count do
if Copy(Items[i-1],1,Length(TmpStr)) = TmpStr then
begin
Text := Items[i-1]; { update to the match that was found }
ItemIndex := i-1;
Found := True;
Break;
end;
if Found then { select the untyped end of the string }
begin
SelStart := SelSt;
SelLength := Length(Text)-SelSt;
end
else Beep;
end;
end;
----------
procedure TComponentEditor.Copy;
var
AFormat : Word;
AData,APalette : THandle;
begin
with Component as TImage do
begin
Picture.SaveToClipBoardFormat(AFormat,AData,APalette);
ClipBoard.SetAsHandle(AFormat,AData);
end;
end;
## Copy, Chr, SelStart, SelLength example
----------
Delete 删除字串中的数个字元.
----------
Unit System
函数原型 procedure Delete(var S: string; Index, Count:Integer);
说明 S : 字串.
Indexd : 从第几位开始删.
Count : 总共要删几位.
范例 var
s: string;
begin
s := 'Honest Abe Lincoln';
Delete(s,8,4);
Canvas.TextOut(10, 10, s); { 'Honest Lincoln' }
end;
var
S: string;
begin
S:= '???????, ??????, ??????????!';
Delete(S, 8, 1); // S := '??????? ??????, ??????????!'
MessageDlg(S, mtWarning, [mbOK],0);
end;
----------
NewStr 在 heap 中配置一个新的字串空间给PString 指标.
----------
DisposeStr 在 heap 中释放一个字串空间 PString指标.
----------
Unit SysUtils
函数原型 function NewStr(const S: string): PString;
函数原型 procedure DisposeStr(P: PString);
说明 S : 字串.
Pstring : 新的字串指标.
范例 var
P: PString;
S: string;
begin
S := 'Ask me about Blaise';
P := NewStr(S);
DisposeStr(P):
end;
----------
Insert 将一个子字串插入另一个字串中.
----------
Unit System
函数原型 procedure Insert(Source: string; var S: string; Index: Integer);
说明 Source : 子字串.
S : 被插入的母字串.
Indexd : 从第几位开始插入.
范例 var
S: string;
begin
S := 'Honest Lincoln';
Insert('Abe ', S, 8); { 'Honest Abe Lincoln' }
end;
var
S: string;
begin
S:= '??????? ?????? ??????????.';
Insert( '!', S, 8); { S := '???????! ?????? ??????????.'}
MessageDlg( S, mtWarning, [mbOK],0);
end;
----------
IntToHex 将 Int 转为 Hex.
----------
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
Label1.Caption := ';
for i := 1 to Length(Edit1.Text) do
begin
try
Label1.Caption := Label1.Caption + IntToHex(Edit1.Text[i],4) + ' ';
except
Beep;
end;
end;
end;
Exam:
Edit2.text:=(strtoint(Edit1.text),6);
----------
IntToStr 将 Int 转为 Str.
----------
procedure TForm1.Button1Click(Sender: TObject);
begin
try
Label1.Caption := IntToStr(StrToInt(Edit1.Text) * StrToInt(Edit2.Text));
except
ShowMessage('You must specify integer values. Please try again.');
end;
end;
----------
StrToInt 将 Str 转为 Int.
----------
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
J: Integer;
begin
I := StrToInt(Edit1.Text);
J := StrToInt(Edit2.Text);
ShowMessage(IntToStr(I + J));
end;
----------
StrToIntDef 将 Str 转为 Int.当转换有误时,则传回 Default 的值.
----------
Unit SysUtils
函数原型 function IntToHex(Value: Integer; Digits: Integer): string;
函数原型 function IntToStr(Value: Integer): string;
函数原型 function StrToInt(const S: string): Integer;
函数原型 function StrToIntDef(const S: string; Default: Integer): Integer;
说明 Value : 欲转换的整数.
Digits : 欲转换为几位数的 Hex.
范例 procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text := IntToHex(StrToInt(Edit1.Text), 6);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Value: Integer;
begin
Value := 1234;
Edit1.Text := IntToStr(Value);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
I: Integer;
begin
S := '22467';
I := StrToInt(S);
Inc(I);
Edit1.Text := IntToStr(I);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
NumberString: string;
Number: Integer;
begin
NumberString := Edit1.Text;
Number := StrToIntDef(NumberString, 1000);
Edit2.Text := IntToStr(Number);
end;
Example
var
I: Integer;
ListItem: string;
begin
for I := 0 to Query1.ParamCount - 1 do
begin
ListItem := ListBox1.Items[I];
case Query1.Params[I].DataType of
ftString:
Query1.Params[I].AsString := ListItem;
ftSmallInt:
Query1.Params[I].AsSmallInt := StrToIntDef(ListItem, 0);
ftInteger:
Query1.Params[I].AsInteger := StrToIntDef(ListItem, 0);
ftWord:
Query1.Params[I].AsWord := StrToIntDef(ListItem, 0);
ftBoolean:
begin
if ListItem = 'True' then
Query1.Params[I].AsBoolean := True
else
Query1.Params[I].AsBoolean := False;
end;
ftFloat:
Query1.Params[I].AsFloat := StrToFloat(ListItem);
ftCurrency:
Query1.Params[I].AsCurrency := StrToFloat(ListItem);
ftBCD:
Query1.Params[I].AsBCD := StrToCurr(ListItem);
ftDate:
Query1.Params[I].AsDate := StrToDate(ListItem);
ftTime:
Query1.Params[I].AsTime := StrToTime(ListItem);
ftDateTime:
Query1.Params[I].AsDateTime := StrToDateTime(ListItem);
end;
end;
end;
----------
procedure TForm1.Button1Click(Sender: TObject);
var
Number: Integer;
begin
Number := StrToIntDef(Edit1.Text, 1000);
Edit2.Text := IntToStr(Number);
end;
----------
## ParamCount, DataType, StrToIntDef, AsXXX Example
----------
Str 将数值转换为格式化的字串.
----------
Unit System
函数原型 procedure Str(X [: Width [: Decimals ]]; var S);
说明 X : 欲转换的整数 or 实数.
Width : 格式化长度.(Integer)
Decimals : 小数点位数.(Integer)
范例 function MakeItAString(I: Longint): string;
{ Convert any integer type to a string }
var
S: string[11];
begin
Str(I, S);
MakeItAString:= S;
end;
begin
Canvas.TextOut(10, 10, MakeItAString(-5322));
end;
----------
Val 将字串转为数字.
----------
Unit System
函数原型 procedure Val(S; var V; var Code: Integer);
说明 S : 欲转换的字串.
V : 转换后的整数 or 实数.
Code : Code = 0 表示转换成功.
范例 uses Dialogs;
var
I, Code: Integer;
begin
{ Get text from TEdit control }
Val(Edit1.Text, I, Code);
{ Error during conversion to integer? }
if code <> 0 then
MessageDlg('Error at position: ' + IntToStr(Code),
mtWarning, [mbOk], 0);
else
Canvas.TextOut(10, 10, 'Value = ' + IntToStr(I));
Readln;
end;
----------
Length 字串长度.
----------
Unit System
函数原型 function Length(S: string): Integer;
说明 S : 欲转换的字串.
范例 var
S: string;
begin
S := 'The Black Knight';
Canvas.TextOut(10, 10, 'String Length = ' +
IntToStr(Length(S)));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
Label1.Caption := ';
for i := 1 to Length(Edit1.Text) do
begin
try
Label1.Caption := Label1.Caption + IntToHex(Edit1.Text[i],4) + ' ';
except
Beep;
end;
end;
end;
范例
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
S := memo1.text;
Label1.caption :=' ' + IntToStr(Length(S));
end;
var
S: string;
I: Integer;
begin
S:= '? ???? ???????? ??????';
I:= Length(S); // I:= 22
MessageDlg( '????? ??????='+ IntToStr(I), mtWarning, [mbOK], 0);
end;
## Length, IntToHex Example
----------
Pos 寻找子字串在母字串中的位置.
----------
Unit System
函数原型 function Pos(Substr: string; S: string): Integer;
说明 Substr : 子字串.
S : 母字串.
范例
procedure TForm1.Button1Click(Sender: TObject);
var S: string;
begin
S := ' 1234.5 ';
{ Convert spaces to zeroes }
while Pos(' ', S) > 0 do
S[Pos(' ', S)] := '0';
Label1.Caption := S;
Label1.Font.Size := 16;
end;
var
S: string;
I: Integer;
begin
S:= '? ???? ???????? ??????';
I:= Pos( '???', S); // I:= 3
end;
//DEMO 001234.50 //空白字串补零
----------
LowerCase 将字串全部转为小写字母.
----------
Unit System
函数原型 function LowerCase(const S: string): string;
范例 procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text := LowerCase(Edit1.Text);
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := LowerCase(Edit1.Text);
end;
var
S: string;
begin
S:= LowerCase( '????????.TXT') ; // S := '????????.txt'
end;
----------
UpperCase 将字串全部转为大写字母.
----------
Unit SysUtils
函数原型 function UpperCase(const S: string): string;
范例 procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to ListBox1.Items.Count -1 do
ListBox1.Items[I] := UpperCase(ListBox1.Items[I]);
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to ListBox1.Items.Count -1 do
ListBox1.Items[I] := UpperCase(ListBox1.Items[I]);
end;
----------
Trim 将字串前后的空白及控制字元清掉.
Trim ( const S: string ): string;
SysUtils
var
S: string;
L: Integer;
begin
S:= #13' ???! '#13;
L:= length( S); // L := 10
S:= Trim( S); // S := '???!'
L:= L-length( S); // L := 5
MessageDlg( '??????? ???????? - '+ IntToStr(L), mtInformation, [mbOk], 0);
end;
----------
TrimLeft 将字串左边的空白及控制字元清掉.
SysUtils
var
S: string;
L: Integer;
begin
S:= #13' ???! '#13;
L:= length( S); // L := 10
S:= TrimLeft( S); // S := '???! '#13
L:= L-length( S); // L := 3
MessageDlg( '??????? ???????? - '+IntToStr(L), mtInformation, [mbOk], 0);
end;
----------
TrimRight 将字串右边的空白及控制字元清掉.
----------
Unit SysUtils
函数原型 function Trim(const S: string): string;
函数原型 function TrimLeft(const S: string): string;
函数原型 function TrimRight(const S: string): string;
var
S: string;
L: Integer;
begin
S:= #13' ???! '#13;
L:= length( S); // L := 10
S:= TrimRight( S); // S := #13' ???!'
L:= L-length( S); // L := 2
MessageDlg( '??????? ???????? - '+IntToStr(L), mtInformation, [mbOk], 0);
end;
----------
AdjustLineBreaks 将字串的换行符号全部改为#13#10
----------
Unit SysUtils
函数原型 function AdjustLineBreaks(const S: string): string;
==========
String-handling routines (null-terminated)字串函式
==========
StrAlloc 配置字串空间.
----------
Unit SysUtils
函数原型 function StrAlloc(Size: Cardinal): PChar;
说明 Size=字串最大空间+1
----------
StrBufSize 传回由 StrAlloc 配置空间的大小
----------
Unit SysUtils
函数原型 function StrBufSize(Str: PChar): Cardinal;
----------
StrCat 字串相加.
----------
Unit SysUtils
函数原型 function StrCat(Dest, Source: PChar): PChar;
范例 uses SysUtils;
const
Obj: PChar = 'Object';
Pascal: PChar = 'Pascal';
var
S: array[0..15] of Char;
begin
StrCopy(S, Obj);
StrCat(S, ' ');
StrCat(S, Pascal);
Canvas.TextOut(10, 10, StrPas(S));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
Buffer: PChar;
begin
GetMem(Buffer,Length(Label1.Caption) + Length(Edit1.Text) + 1);
StrCopy(Buffer, PChar(Label1.Caption));
StrCat(Buffer, PChar(Edit1.Text));
Label1.Caption := Buffer;
Edit1.Clear;
FreeMem(Buffer);
end;
const
P0: PChar = '??????-';
P1: PChar = '??????????';
P2: PChar = '????????';
var
S1, S2: array[0..20] of Char;
begin
StrCopy(S1, P0);
StrCopy(S2, P0);
StrCat(S1, P1); { S1 := '??????-??????????' }
StrCat(S2, P2); { S2 := '??????-????????' }
MessageDlg( S1+ #13+ S2, mtInformation, [mbOk], 0);
end;
##StrCopy, StrCat Example
----------
StrComp 比较两字串大小.
----------
Unit SysUtils
函数原型 function StrComp(Str1, Str2 : PChar): Integer;
范例 uses SysUtils;
const
S1: PChar = 'Wacky';
S2: PChar = 'Code';
var
C: Integer;
Result: string;
begin
C := StrComp(S1, S2);
if C < 0 then Result := ' is less than ' else
if C > 0 then Result := ' is greater than ' else
Result := ' is equal to ';
Canvas.TextOut(10, 10, StrPas(S1) + Result +
StrPas(S2));
end;
Example
uses SysUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
Msg: string;
CompResult: Integer;
begin
Msg := Edit1.Text;
CompResult := StrComp(PChar(Edit1.Text), PChar(Edit2.Text));
if CompResult < 0 then
Msg := Msg + ' is less than '
else if CompResult > 0 then
Msg := Msg + ' is greater than '
else
Msg := Msg + ' is equal to '
Msg := Msg + Edit2.Text;
ShowMessage(Msg);
end;
var
S1,S2: PChar;
I: Integer;
Res: string;
begin
S1:= 'Company';
S2:= 'COMPANY';
I:= StrComp(S1, S2);
if I>0 then Res:= '>' else
if I<0 then Res:= '<' else Res:= '=';
MessageDlg(S1+ Res+ S2, mtInformation, [mbOk], 0);
end;
----------
StrCopy 拷贝字串.
----------
Unit SysUtils
函数原型 function StrCopy(Dest, Source: PChar): PChar;
范例 uses SysUtils;
var
S: array[0..12] of Char;
begin
StrCopy(S, 'ObjectPascal');
Canvas.TextOut(10, 10, StrPas(S));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
Buffer: PChar;
begin
GetMem(Buffer,Length(Label1.Caption) + Length(Edit1.Text) + 1);
StrCopy(Buffer, PChar(Label1.Caption));
StrCat(Buffer, PChar(Edit1.Text));
Label1.Caption := Buffer;
Edit1.Clear;
FreeMem(Buffer);
end;
## StrCopy, StrCat Example
----------
StrDispose 释放StrAlloc or StrNew所配置的空间.
----------
Unit SysUtils
函数原型 procedure StrDispose(Str: PChar);
范例 uses SysUtils;
const
S: PChar = 'Nevermore';
var
P: PChar;
begin
P := StrNew(S);
Canvas.TextOut(10, 10, StrPas(P));
StrDispose(P);
end;
----------
StrECopy 拷贝字串并传回字串结束位址.
----------
Unit SysUtils
函数原型 function StrECopy(Dest, Source: PChar): PChar;
范例 uses SysUtils;
const
Turbo: PChar = 'Object';
Pascal: PChar = 'Pascal';
var
S: array[0..15] of Char;
begin
StrECopy(StrECopy(StrECopy(S, Turbo), ' '), Pascal);
Canvas.TextOut(10, 10, StrPas(S));
end;
Example
uses SysUtils;
const
Turbo: PChar = 'Object';
Pascal: PChar = 'Pascal';
var
S: array[0..15] of Char;
begin
StrECopy(StrECopy(StrECopy(S, Turbo), ' '), Pascal);
Canvas.TextOut(10, 10, string(S));
end;
----------
StrEnd 传回字串结束位址.
----------
Unit SysUtils
函数原型 function StrEnd(Str: PChar): PChar;
范例 uses SysUtils;
const
S: PChar = 'Yankee Doodle';
begin
Canvas.TextOut(5, 10, 'The string length of "' + StrPas(S)
+ '" is ' +IntToStr(StrEnd(S) - S));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
TextBuffer: PChar;
Ptr: PChar;
begin
GetMem(TextBuffer, Length(Edit1.Text)+1);
StrCopy(TextBuffer, PChar(Edit1.Text));
Ptr := StrEnd(TextBuffer);
Label1.Caption := ';
while Ptr >= TextBuffer do
begin
Ptr := Ptr ? 1;
Label1.Caption := Label1.Caption + Ptr^;
end;
FreeMem(TextBuffer);
end;
var
Str: PChar;
L: Word;
begin
...
L:= StrEnd(Str) - Str;
...
end;
----------
StrIComp 比较两字串大小.(不分大小写)
----------
Unit SysUtils
函数原型 function StrIComp(Str1, Str2:PChar): Integer;
范例 uses SysUtils;
const
S1: PChar = 'Wacky';
S2: PChar = 'Code';
var
C: Integer;
Result: string;
begin
C := StrIComp(S1, S2);
if C < 0 then Result := ' is less than ' else
if C > 0 then Result := ' is greater than ' else
Result := ' is equal to ';
Canvas.TextOut(10, 10, StrPas(S1) + Result +
StrPas(S2));
end;
xample
uses SysUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
Msg: string;
CompResult: Integer;
begin
Msg := Edit1.Text;
CompResult := StrIComp(PChar(Edit1.Text), PChar(Edit2.Text));
if CompResult < 0 then
Msg := Msg + ' is less than '
else if CompResult > 0 then
Msg := Msg + ' is greater than '
else
Msg := Msg + ' is equal to '
Msg := Msg + Edit2.Text;
ShowMessage(Msg);
end;
var
S1,S2: PChar;
I: Integer;
Res: string;
begin
S1:= 'ABC';
S2:= 'abc';
I:= StrIComp(S1, S2); { I := 0, ?.?. S1 = S2 }
if I>0 then Res:= '>' else
if I<0 then Res:= '<' else Res:= '=';
MessageDlg( S1 + Res + S2, mtInformation, [mbOk], 0);
end;
----------
StrLCat 字串相加.(指定长)
----------
Unit SysUtils
函数原型 function StrLCat(Dest, Source: PChar; MaxLen: Cardinal):
PChar;
范例 uses SysUtils;
var
S: array[0..13] of Char;
begin
StrLCopy(S, 'Object', SizeOf(S) - 1);
StrLCat(S, ' ', SizeOf(S) - 1);
StrLCat(S, 'Pascal', SizeOf(S) - 1);
Canvas.TextOut(10, 10, StrPas(S));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
FirstHalf: PChar;
SecondHalf: PChar;
HalfLen: Integer;
begin
HalfLen := StrLen(PChar(Edit1.Text)) div 2;
GetMem(FirstHalf,HalfLen+2);
GetMem(SecondHalf,HalfLen+2);
FirstHalf^ := Chr(0);
SecondHalf^ := Chr(0);
StrLCat(FirstHalf, PChar(Edit1.Text), HalfLen);
StrCat(SecondHalf, PChar(Edit1.Text) + HalfLen);
Application.MessageBox(FirstHalf, 'First Half', MB_OK);
Application.MessageBox(SecondHalf, 'Second Half', MB_OK);
FreeMem(FirstHalf);
FreeMem(SecondHalf);
end;
const
S1: PChar = '???';
S2: PChar = '?????????';
var
S: array[0..13] of Char;
begin
StrLCopy(S, S1, StrLen(S1));
StrLCat(S, S2, 6); { S :='??????' }
MessageDlg(S, mtInformation, [mbOk], 0);
end;
## StrLen, StrLCat Example
----------
StrLComp 比较两字串大小.(指定长)
----------
Unit SysUtils
函数原型 function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal):
Integer;
范例 uses SysUtils;
const
S1: PChar = 'Enterprise'
S2: PChar = 'Enter'
var
Result: string;
begin
if StrLComp(S1, S2, 5) = 0 then
Result := 'equal'
else
Result := 'different';
Canvas.TextOut(10, 10, 'The first five characters are ' +
Result);
end;
example
uses SysUtils;
const
S1: PChar = 'Enterprise'
S2: PChar = 'Enter'
var
ComStr: string;
begin
if StrLComp(S1, S2, 5) = 0 then
ComStr := 'equal'
else
ComStr := 'different';
Canvas.TextOut(10, 10, 'The first five characters are ' + ComStr);
end;
const
S1: PChar = '?????????';
S2: PChar = '????????';
var
I: Integer;
S: string;
begin
I:= 5;
if StrLComp( S1, S2, I) = 0 then S:= '?????' else S:= '????????';
MessageDlg( '?????? '+ IntToStr(I)+ ' ???????? ????? '+ S, mtInformation,[mbOk], 0);
end;
----------
StrLCopy 拷贝字串.(指定长)
----------
Unit SysUtils
函数原型 function StrLCopy(Dest, Source: PChar; MaxLen:
Cardinal): PChar;
范例 uses SysUtils;
var
S: array[0..11] of Char;
begin
StrLCopy(S, 'ObjectPascal', SizeOf(S) - 1);
Canvas.TextOut(10, 10, StrPas(S));
end;
Example
uses SysUtils;
const MAX_BUFFER = 10;
procedure TForm1.Button1Click(Sender TObject);
var
Buffer: array [0..MAX_BUFFER] of char;
begin
StrLCopy(Buffer, PChar(Edit1.Text), MAX_BUFFER);
Application.MessageBox(Buffer, 'StrLCopy Example', MB_OK);
end;
var
S: PChar;
begin
StrLCopy( S, '?????????', 5); { S := '?????' }
...
end;
----------
StrLen 传回字串长度.(不含终止位元)
----------
Unit SysUtils
函数原型 function StrLen(Str: PChar): Cardinal;
范例 uses SysUtils;
const
S: PChar = 'E Pluribus Unum';
begin
Canvas.TextOut(5, 10, 'The string length of "' + StrPas(S)
+ '" is ' + IntToStr(StrLen(S)));
end;
Example
procedure TForm1.Button1Click(Sender: TObject);
var
FirstHalf: PChar;
SecondHalf: PChar;
HalfLen: Integer;
begin
HalfLen := StrLen(PChar(Edit1.Text)) div 2;
GetMem(FirstHalf,HalfLen+2);
GetMem(SecondHalf,HalfLen+2);
FirstHalf^ := Chr(0);
SecondHalf^ := Chr(0);
StrLCat(FirstHalf, PChar(Edit1.Text), HalfLen);
StrCat(SecondHalf, PChar(Edit1.Text) + HalfLen);
Application.MessageBox(FirstHalf, 'First Half', MB_OK);
Application.MessageBox(SecondHalf, 'Second Half', MB_OK);
FreeMem(FirstHalf);
FreeMem(SecondHalf);
end;
const
S: PChar = '????? ????? ????? ????????!';
begin
MessageDlg( S+ #13#10 + '?????????? ???????? = ' + IntToStr( StrLen( S)), mtInformation, [mbOk], 0);
end;
## StrLen, StrLCat Example
----------
StrLIComp 比较两字串大小.(指定长,不分大小写)
----------
Unit SysUtils
函数原型 function StrLIComp(Str1, Str2: PChar; MaxLen:
Cardinals): Integer;
范例 uses SysUtils;
const
S1: PChar = 'Enterprise'
S2: PChar = 'Enter'
var
Result: string;
begin
if StrLIComp(S1, S2, 5) = 0 then
Result := 'equal'
else
Result := 'different';
Canvas.TextOut(10, 10, 'The first five characters are ' +
Result);
end;
Examply
uses SysUtils;
const
S1: PChar = 'Enterprise'
S2: PChar = 'Enter'
var
ComStr: string;
begin
if StrLIComp(S1, S2, 5) = 0 then
ComStr := 'equal'
else
ComStr := 'different';
Canvas.TextOut(10, 10, 'The first five characters are ' + ComStr);
end;
const
S1: PChar = '?????????';
S2: PChar = '????????';
var
S: string;
begin
if StrLIComp( S1, S2, 5) = 0 then S:= '?????' else S:= '????????';
MessageDlg( S1 + #13 + S2 + #13 + '?????? ' + IntToStr( I) + ' ???????? ????? ' + S, mtInformation, [mbOk], 0);
end;
----------
StrLower 将字串全部转为小写字母.
----------
Unit SysUtils
函数原型 function StrLower(Str: PChar): PChar;
范例 uses SysUtils;
const
S: PChar = 'A fUnNy StRiNg'
begin
Canvas.TextOut(5, 10, StrPas(StrLower(S)) + ' ' +
StrPas(StrUpper(S)));
end;
----------
StrMove 从来源字串拷贝n个Bytes到目爬r串.(不含终止位元)
----------
Unit SysUtils
函数原型 function StrMove(Dest, Source: PChar; Count:
Cardinal): PChar;
范例 uses SysUtils;
function AHeapaString(S: PChar): PChar;
{ Allocate string on heap }
var
L: Cardinal;
P: PChar;
begin
StrNew := nil;
if (S <> nil) and (S[0] <> #0) then
begin
L := StrLen(S) + 1;
GetMem(P, L);
StrNew := StrMove(P, S, L);
end;
end;
procedure DisposeDaString(S: PChar);
{ Dispose string on heap }
begin
if S <> nil then FreeMem(S, StrLen(S) + 1);
end;
var
S: PChar;
begin
AHeapaString(S);
DisposeDaString(S);
end;
var
S1, S2: PChar;
begin
S1:= 'ABcdEFgh';
StrMove( S2, S1, StrLen( S1) + 1 );
StrLower( S1); { S1:= 'abcdefgh' }
StrUpper( S2); { S2:= 'ABCDEFGH' }
MessageDlg( S1 + #13#10 + S2, mtInformation, [mbOk], 0);
end;
----------
StrNew 配置字串空间.
----------
Unit SysUtils
函数原型 function StrNew(Str: PChar): PChar;
Example
uses Sysutils;
procedure TForm1.Button1Click(Sender: TObject);
var
Temp: PChar;
begin
// Allocate memory.
Temp := StrNew(PChar(Edit1.Text));
Application.MessageBox(Temp, 'StrNew, StrDispose Example', MB_OK);
// Deallocate memory.
StrDispose(Temp);
end;
const
S: PChar = '?????????? ??????';
var
SNew: PChar;
begin
SNew:= StrNew( S);
MessageDlg( 'S: ' + S + #13 + 'SNew: ' + SNew, mtInformation, [mbOk], 0);
StrDispose(SNew);
end;
## StrNew, StrDispose Example
----------
StrPas 将 null-terminated 字串转为Pascal-style 字串.
----------
Unit SysUtils
函数原型 function StrPas(Str: PChar): string;
范例 uses SysUtils;
const
A: PChar = 'I love the smell of Object Pascal in the
morning.';
var
S: string[79];
begin
S := StrPas(A);
Canvas.TextOut(10, 10, S);
{ note that the following also works }
Canvas.TextOut(10, 10, A);
end;
----------
StrPCopy 拷贝 Pascal-style 字串到null-terminated 字串.
----------
Unit SysUtils
函数原型 function StrPCopy(Dest: PChar; Source: string): PChar;
范例 uses SysUtils;
var
A: array[0..79] of Char;
S: String;
begin
S := 'Honk if you know Blaise.';
StrPCopy(A, S);
Canvas.TextOut(10, 10, StrPas(A));
end;
var
Source: string;
Dest: array[0..20] of Char;
begin
Source:= '???????? ??????';
StrPCopy( Dest, Source);
MessageDlg( Dest, mtInformation, [mbOk], 0);
end;
----------
StrPLCopy 拷贝 Pascal-style 字串到null-terminated 字串.(指定长)
----------
Unit SysUtils
函数原型 function StrPLCopy(Dest: PChar; const Source: string;
MaxLen: Cardinal): PChar;
----------
StrPos 子字串在母字串中的位置.(第一个位置)
----------
Unit SysUtils
函数原型 function StrPos(Str1, Str2: PChar): PChar;
说明 Str1 母字串
Str2 子字串
Example
uses SysUtils;
procedure TForm1.Button1Click(Sender TObject);
var
Location: PChar;
begin
if StrPos(PChar(Edit1.Text), PChar(Edit2.Text)) <> nil
then
ShowMessage('Substring found')
else
ShowMessage('Substring not found');
end;
----------
const
SubStr: PChar = 'www';
var
S, R: PChar;
begin
S:= 'http://www.atrussk.ru/delphi/';
R:= StrPos(S, SubStr);
if R<>nil then MessageDlg( R, mtInformation, [mbOk], 0) else
MessageDlg( '?? ????????? ?????? URL!', mtError, [mbOk], 0);
end;
----------
StrRScan 子字元在母字串中的位置的下一个位址.
----------
Unit SysUtils
函数原型 function StrRScan(Str: PChar; Chr: Char): PChar;
范例 { Return pointer to name part of a full path name }
uses SysUtils;
function NamePart(FileName: PChar): PChar;
var
P: PChar;
begin
P := StrRScan(FileName, '/');
if P = nil then
begin
P := StrRScan(FileName, ':');
if P = nil then P := FileName;
end;
NamePart := P;
end;
var
S : string;
begin
S := StrPas(NamePart('C:/Test.fil'));
Canvas.TextOut(10, 10, S);
end;
const
S: PChar = 'MyFile.zzz';
var
R: PChar;
begin
R:= StrRScan( S, '.'); { R := '.zzz' }
MessageDlg( R, mtInformation, [mbOk], 0);
end;
----------
StrScan 子字元在母字串中的位置.
----------
Unit SysUtils
函数原型 function StrScan(Str: PChar; Chr: Char): PChar;
范例 uses SysUtils;
function HasWildcards(FileName: PChar): Boolean;
{ Return true if file name has wildcards in it }
begin
HasWildcards := (StrScan(FileName, '*') <> nil) or
(StrScan(FileName, '?') <> nil);
end;
const
P: PChar = 'C:/Test.* ';
begin
if HasWildcards(P) then
Canvas.TextOut(20, 20, 'The string has wildcards')
else
Canvas.TextOut(20, 20, 'The string doesn't have
wildcards')
end;
const
S: PChar = 'http://www.atrussk.ru';
var
R: PChar;
begin
R:= StrScan( S, 'w'); { R := 'www.atrussk.ru' }
MessageDlg( R, mtInformation, [mbOk], 0);
end;
----------
StrUpper 将字串全部转为大写字母.
----------
Unit SysUtils
函数原型 function StrUpper(Str: PChar): PChar;
范例 uses SysUtils;
const
S: PChar = 'A fUnNy StRiNg'
begin
Canvas.TextOut(5, 10, StrPas(StrLower(S)) + ' ' +
StrPas(StrUpper(S)));
end;
==========
Text-file routines Text-file常式
==========
Append 开起一个可供Append的档案.
----------
Unit System
函数原型 procedure Append(var f: Text);
范例 var F: TextFile;
begin
if OpenDialog1.Execute then
{ Bring up open file dialog }
begin
AssignFile(F, OpenDialog1.FileName);
{ Open file selected in dialog }
Append(F); { Add more text onto end }
Writeln(F, 'appended text');
CloseFile(F); { Close file, save changes }
end;
end;
Example
var
f: TextFile;
begin
if OpenDialog1.Execute then
begin { open a text file }
AssignFile(f, OpenDialog1.FileName);
Append(f);
Writeln(f, 'I am appending some stuff to the end of the file.');
{ insert code here that would require a Flush before closing the file }
Flush(f); { ensures that the text was actually written to file }
CloseFile(f);
end;
end;
## Append, Flush Example
----------
Eoln 测试档案是否结束.(For text file.)
----------
Unit System
函数原型 function Eoln [(var F: Text) ]: Boolean;
Flush 将Buffer中的资料存入磁碟.
(For text file)
Unit System
函数原型 procedure Flush(var F: Text);
范例 var
f: TextFile;
begin
if OpenDialog1.Execute then
begin { open a text file }
AssignFile(f, OpenDialog1.FileName);
Append(f);
Writeln(f, 'I am appending some stuff to the end of the
file.');
Flush(f);
{ ensures that the text was actually written to file }
{ insert code here that would require a Flush before
closing the file }
CloseFile(f);
end;
end;
Example
begin
{ Tells program to wait for keyboard input }
WriteLn(Eoln);
end;
----------
Read 读档.
----------
Unit System
函数原型 procedure Read(F , V1 [, V2,...,Vn ] );
procedure Read( [ var F: Text; ] V1 [, V2,...,Vn ] );
范例 uses Dialogs;
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.
----------
Readln 读档.
----------
Unit System
函数原型 procedure Readln([ var F: Text; ] V1 [, V2, ...,Vn ]);
范例 var
s : string;
begin
Write('Enter a line of text: ');
Readln(s);
Writeln('You typed: ',s);
Writeln('Hit <Enter> to exit');
Readln;
end;
----------
SeekEof 测试档案是否结束.
----------
Unit System
函数原型 function SeekEof [ (var F: Text) ]: Boolean;
范例 var
f : System.TextFile;
i, j, Y : Integer;
begin
AssignFile(f,'TEST.TXT');
Rewrite(f);
{ Create a file with 8 numbers and some whitespace at the
ends of the lines }
Writeln(f,'1 2 3 4 ');
Writeln(f,'5 6 7 8 ');
Reset(f);
{ Read the numbers back. SeekEoln returns TRUE if there are
no more numbers on the current line; SeekEof returns
TRUE if there is no more text (other than whitespace) in
the file. }
Y := 5;
while not SeekEof(f) do
begin
if SeekEoln(f) then
Readln; { Go to next line }
Read(f,j);
Canvas.TextOut(5, Y, IntToStr(j));
Y := Y + Canvas.TextHeight(IntToStr(j)) + 5;
end;
end;
----------
SeekEoln 测试档案中行是否结束.
----------
Unit System
函数原型 function SeekEoln [ (var F: Text) ]: Boolean;
Example
var
f : System.TextFile;
i, j, Y : Integer;
begin
AssignFile(f,'TEST.TXT');
Rewrite(f);
{ Create a file with 8 numbers and some
whitespace at the ends of the lines }
Writeln(f,'1 2 3 4 ');
Writeln(f,'5 6 7 8 ');
Reset(f);
{ Read the numbers back. SeekEoln returns TRUE if there are no more
numbers on the current line; SeekEof returns TRUE if there is no
more text (other than whitespace) in the file. }
Y := 5;
while not SeekEof(f) do
begin
if SeekEoln(f) then
Readln; { Go to next line }
Read(f,j);
Canvas.TextOut(5, Y, IntToStr(j));
Y := Y + Canvas.TextHeight(IntToStr(j)) + 5;
end;
end;
## SeekEoln, SeekEof Example
----------
SetTextBuf 指定 I/O buffer 给 text file.
----------
Unit System
函数原型 procedure SetTextBuf(var F: Text; var Buf [ ; Size: Integer] );
范例 uses Dialogs;
var
F, FTwo: System.TextFile;
Ch: Char;
Buf: array[1..4095] of Char; { 4K buffer }
begin
if OpenDialog1.Execute then
begin
AssignFile(F, ParamStr(1));
{ Bigger buffer for faster reads }
SetTextBuf(F, Buf);
Reset(F);
{ Dump text file into another file }
AssignFile(FTwo, 'WOOF.DOG');
Rewrite(FTwo);
while not Eof(f) do
begin
Read(F, Ch);
Write(FTwoCh);
end;
System.CloseFile(F);
System.CloseFile(FTwo);
end;
end;
----------
Write 写入档案.
----------
Unit System
函数原型 Write(F, V1,...,Vn);
Write( [var F: Text; ] P1 [ , P2,..., Pn] );
procedure TForm1.Button3Click(Sender: TObject);
var
Stream: TBlobStream;
S: string;
begin
with Table1 do
begin
Edit;
Stream := CreateBlobStream(FieldByName('Notes'), bmReadWrite);
try
Stream.Seek(0, 2); {Seek 0 bytes from the stream's end point}
S := ' This line will be added to the end.';
Stream.Write(PChar(S), Length(S));
finally
Stream.Free;
end;
Post;
end;
end;
----------
Writeln 写入档案.
----------
Unit System
函数原型 procedure Writeln([ var F: Text; ] P1 [, P2, ...,Pn ] );
范例 var
s : string;
begin
Write('Enter a line of text: ');
Readln(s);
Writeln('You typed: ',s);
Writeln('Hit <Enter> to exit');
Readln;
end;
==========
Transfer routines 转换函式
==========
Chr 将 Byte 转为字元.
----------
Unit System
函数原型 function Chr(X: Byte): Char;
范例 begin
Canvas.TextOut(10, 10, Chr(65)); { The letter 'A'}
end;
Example
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
var
Found: boolean;
i,SelSt: Integer;
TmpStr: string;
begin
{ first, process the keystroke to obtain the current string }
{ This code requires all items in list to be uppercase}
if Key in ['a'..'z'] then Dec(Key,32); {Force Uppercase only!}
with (Sender as TComboBox) do
begin
SelSt := SelStart;
if (Key = Chr(vk_Back)) and (SelLength <> 0) then
TmpStr := Copy(Text,1,SelStart)+Copy(Text,SelLength+SelStart+1,255)
else if Key = Chr(vk_Back) then {SelLength = 0}
TmpStr := Copy(Text,1,SelStart-1)+Copy(Text,SelStart+1,255)
else {Key in ['A'..'Z', etc]}
TmpStr := Copy(Text,1,SelStart)+Key+Copy(Text,SelLength+SelStart+1,255);
if TmpStr = ' then Exit;
{ update SelSt to the current insertion point }
if (Key = Chr(vk_Back)) and (SelSt > 0) then Dec(SelSt)
else if Key <> Chr(vk_Back) then Inc(SelSt);
Key := #0; { indicate that key was handled }
if SelSt = 0 then
begin
Text:= ';
Exit;
end;
{Now that TmpStr is the currently typed string, see if we can locate a match }
Found := False;
for i := 1 to Items.Count do
if Copy(Items[i-1],1,Length(TmpStr)) = TmpStr then
begin
Text := Items[i-1]; { update to the match that was found }
ItemIndex := i-1;
Found := True;
Break;
end;
if Found then { select the untyped end of the string }
begin
SelStart := SelSt;
SelLength := Length(Text)-SelSt;
end
else Beep;
end;
end;
## Copy, Chr, SelStart, SelLength example
----------
High 传回注脚的最大值.
----------
Unit System
函数原型 function High(X);
范例 [Ordinal type]
procedure TForm1.Button1Click(Sender: TObject);
var
Low_S:String;
High_S:string;
S:String;
begin
High_S:=' High='+IntToStr(High(Word));
Low_S:='Low='+IntToStr(Low(Word));
S:=Low_S+High_S;
Label1.Caption:=S;
end;
S:=Low=0 High=65535
[Array type]
procedure TForm1.Button1Click(Sender: TObject);
var
P : Array[5..21] of Double;
Low_S:String;
High_S:string;
S:String;
begin
High_S:=' High='+IntToStr(High(P));
Low_S:='Low='+IntToStr(Low(P));
S:=Low_S+High_S;
Label1.Caption:=S;
end;
S:=Low=5 High=21
[String type]
procedure TForm1.Button1Click(Sender: TObject);
var
P : String[23];
Low_S:String;
High_S:string;
S:String;
begin
High_S:=' High='+IntToStr(High(P));
Low_S:='Low='+IntToStr(Low(P));
S:=Low_S+High_S;
Label1.Caption:=S;
end;
S:=Low=0 Hight=23
P:ShortString;
S:=Low=0 Hight=255
P:String;
长字串不可,会有错误讯号.
[Open array]
function Sum( var X: array of Double): Double;
var
I: Word;
S: Double;
begin
S := 0;
{ Note that open array index range is always zero-based. }
for I := 0 to High(X) do S := S + X[I];
Sum := S;
end;
Example
function Sum( var X: array of Double): Double;
var
I: Word;
S: Real;
begin
S := 0; { Note that open array index range is always zero-based. }
for I := 0 to High(X) do S := S + X[I];
Sum := S;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
List1: array[0..3] of Double;
List2: array[5..17] of Double;
X: Word;
S, TempStr: string;
begin
for X := Low(List1) to High(List1) do
List1[X] := X * 3.4;
for X := Low(List2) to High(List2) do
List2[X] := X * 0.0123;
Str(Sum(List1):4:2, S);
S := 'Sum of List1: ' + S + #13#10;
S := S + 'Sum of List2: ';
Str(Sum(List2):4:2, TempStr);
S := S + TempStr;
MessageDlg(S, mtInformation, [mbOk], 0);
end;
## Low, High Example
----------
Low 传回注脚的最小值.
----------
Unit System
函数原型 function Low(X);
说明 Ordinal type The lowest value in the range of the type
Array type The lowest value within the range of the
index type of the array
String type Returns 0
Open array Returns 0
String parameter Returns 0
----------
Ord 传回列举型态的数值.
----------
Unit System
函数原型 function Ord(X): Longint;
范例 procedure TForm1.Button1Click(Sender: TObject);
type
Colors = (RED,BLUE,GREEN);
var
S: string;
begin
S := 'BLUE has an ordinal value of ' + IntToStr(Ord(RED)) +
#13#10;
S := S+'The ASCII code for "c" is ' + IntToStr(Ord('c')) + '
decimal';
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------
Round 将实数转为整数.(有四舍五入)
----------
Unit System
函数原型 function Round(X: Extended): Longint;
范例 var
S, T: string;
begin
Str(1.4:2:1, T);
S := T + ' rounds to ' + IntToStr(Round(1.4)) + #13#10;
Str(1.5:2:1, T);
S := S + T + ' rounds to ' + IntToStr(Round(1.5)) + #13#10;
Str(-1.4:2:1, T);
S := S + T + ' rounds to ' + IntToStr(Round(-1.4)) + #13#10;
Str(-1.5:2:1, T);
S := S + T + ' rounds to ' + IntToStr(Round(-1.5));
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------
Trunc 将实数转为整数.(小数直接舍弃)
----------
Unit System
函数原型 function Trunc(X: Extended): Longint;
Untyped file routines
var
S, T: string;
begin
Str(1.4:2:1, T);
S := T + ' Truncs to ' + IntToStr(Trunc(1.4)) + #13#10;
Str(1.5:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(1.5)) + #13#10;
Str(-1.4:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(-1.4)) + #13#10;
Str(-1.5:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(-1.5));
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------
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;
----------
BlockRead 读取档案至记忆体区块.
----------
procedure TForm1.Button1Click(Sender: TObject);
var
FromF, ToF: file;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
begin
if OpenDialog1.Execute then { 开档对话盒}
begin
AssignFile(FromF, OpenDialog1.FileName);{}
Reset(FromF, 1); { Record size = 1 }
if SaveDialog1.Execute then { Display Save dialog box}
begin
AssignFile(ToF, SaveDialog1.FileName);{ Open output file }
Rewrite(ToF, 1); { Record size = 1 }
Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))+'bytes...');
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
end;
end;
## BlockRead, BlockWrite, SaveDialog Example
----------
BlockWrite 将记忆体区块写入档案.
----------
Unit System
函数原型 procedure BlockRead(var F: File; var Buf; Count: Integer
[; var Result: Integer]);
函数原型 procedure BlockWrite(var f: File; var Buf; Count: Integer
[; var Result: Integer]);
范例 var
FromF, ToF: file;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
begin
if OpenDialog1.Execute then
{ Display Open dialog box }
begin
AssignFile(FromF, OpenDialog1.FileName);
Reset(FromF, 1); { Record size = 1 }
if SaveDialog1.Execute then
{ Display Save dialog box }
begin
AssignFile(ToF, SaveDialog1.FileName);
{ Open output file }
Rewrite(ToF, 1); { Record size = 1 }
Canvas.TextOut(10, 10,'Copying '+
IntToStr(FileSize(FromF))+ ' bytes...');
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <>
NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
end;
end;
==========
Variant support routines 鬼牌变数函式
==========
VarArrayCreate 建立一个variant array.
----------
Unit System
函数原型 function VarArrayCreate(const Bounds: array of Integer;
VarType: Integer): Variant;
范例 procedure TForm1.Button1Click(Sender: TObject);
var
A:Variant;
S:String;
begin
A:=VarArrayCreate([0,4],varVariant);
A[0]:=1;
A[1]:=1234.5678;
A[2]:='Hello world';
A[3]:=TRUE;
A[4]:=VarArrayOf([1 ,10 ,100 ,10000]);
S:=A[4][2];
S:=A[2]+' '+S;
Label1.Caption:=S;
end;
说明 S:=A[4][2]; Variant可以不用函数来做转换.
只能单独使用,如为下列则有误.
S:=A[2]+' '+A[4][2];
VarType
varEmpty $0000 The variant is Unassigned.
varNull $0001 The variant is Null.
varSmallint $0002 16-bit signed integer (type Smallint).
varInteger $0003 32-bit signed integer (type Integer).
varSingle $0004 Single-precision floating-point value
(type Single).
varDouble $0005 Double-precision floating-point value
(type Double).
varCurrency $0006 Currency floating-point value (type Currency).
VarDate $0007 Date and time value (type TDateTime).
VarOleStr $0008 Reference to a dynamically allocated
UNICODE string.
varDispatch $0009 Reference to an OLE automation object
(an IDispatch interface pointer).
VarError $000A Operating system error code.
varBoolean $000B 16-bit boolean (type WordBool).
varVariant $000C Variant (used only with variant arrays).
varUnknown $000D Reference to an unknown OLE object
(an IUnknown interface pointer).
varByte $0011 8-bit unsigned integer (type Byte).
VarString $0100 Reference to a dynamically-allocated long string
(type AnsiString).
varTypeMask $0FFF Bit mask for extracting type code. This constant
is a mask that can be combined with the VType
field using a bit-wise AND..
varArray $2000 Bit indicating variant array. This constant is a
mask that can be combined with the VType field
using a bit-wise AND to determine if the variant
contains a single value or an array of values.
VarByRef $4000 This constant can be AND'd with Variant.VType
to determine if the variant contains a pointer to
the indicated data instead of containing the data
itself.
范例 var
V1, V2, V3, V4, V5: Variant;
I: Integer;
D: Double;
S: string;
begin
V1 := 1; { Integer value }
V2 := 1234.5678; { Real value }
V3 := 'Hello world'; { String value }
V4 := '1000'; { String value }
V5 := V1 +V2 +V4; { Real value 2235.5678 }
I := V1; { I = 1 }
D := V2; { D = 1234.5678 }
S := V3; { S = 'Hello world' }
I := V4; { I = 1000 }
S := V5; { S = '2235.5678' }
end;
----------
VarArrayOf 建立一个简单的一维variant array
----------
Unit System
函数原型 function VarArrayOf(const Values: array of Variant): Variant;
范例 var
A:Variant;
begin
A:=VarArrayOf([1 ,10 ,'Hello ,10000]);
S:=A[1]+' '+IntToStr(A[2]);
Label1.Caption:=S;
end;
----------
VarArrayRedim 重定variant阵列中高维部分的高注脚.
----------
Unit System
----------
函数原型 procedure VarArrayRedim(var A: Variant; HighBound:Integer);
----------
VarArrayDimCount 传回Variant阵列的维数.
----------
Unit System
函数原型 function VarArrayDimCount(const A: Variant): Integer;
----------
VarArrayHighBound 传回Variant阵列中一维的高注脚.
----------
Unit System
函数原型 function VarArrayHighBound(const A: Variant; Dim: Integer):Integer;
----------
VarArrayLowBound 传回Variant阵列中一维的低注脚.
----------
Unit System
函数原型 function VarArrayLowBound(const A: Variant; Dim: Integer):
Integer;
范例 procedure TForm1.Button1Click(Sender: TObject);
var
A:Variant;
Count:Integer;
HighBound:Integer;
LowBound:Integer;
i:Integer;
S:String;
begin
A:=VarArrayCreate([0,5, 1,3],varVariant);
Count:=VarArrayDimCount(A);
S:=#13+'维数:'+IntToStr(Count)+#13;
for i:=1 To Count do
Begin
HighBound:=VarArrayHighBound(A,i);
LowBound:=VarArrayLowBound(A,i);
S:=S+'HighBound: '+IntToStr(HighBound)+#13;
S:=S+'LowBound : '+IntToStr(LowBound)+#13;
End;
ShowMessage(S);
end;
----------
VarArrayLock 将variant阵列==>指定给一阵列变数.
----------
VarArrayUnLock 解除上述的指定.
----------
Unit System
函数原型 function VarArrayLock(var A: Variant): Pointer;
函数原型 procedure VarArrayUnlock(var A: Variant);
范例 procedure TForm1.Button1Click(Sender: TObject);
Const
HighVal=12;
type
TData=array[0..HighVal, 0..HighVal] of Integer;
var
A:Variant;
i,j:Integer;
Data:^TData;
begin
A:=VarArrayCreate([0,HighVal, 0,HighVal],varInteger);
for i:=0 to HighVal do
for j:=0 to HighVal do
A[i,j]:=i*j;
Data:=VarArrayLock(A);
for i:=0 to HighVal do
for j:=0 to HighVal do
Grid1.Cells[i+1,j+1]:=IntToStr(Data^[i,j]);
VarArrayUnLock(A);
end;
----------
VarIsArray 传回Variant是否为一个阵列.
----------
Unit System
函数原型 function VarIsArray(const V: Variant): Boolean;
VarIsEmpty 传回Variant是否尚未注册.(空的)
Unit System
函数原型 function VarIsEmpty(const V: Variant): Boolean;
范例 procedure TForm1.Button1Click(Sender: TObject);
var
A:Variant;
S:String;
begin
A:=VarArrayCreate([0,5, 0,7],varVariant);
if VarIsEmpty(A) Then
S:='True'
else
S:='False';
Label1.Caption:=S;
end;
----------
** S:=False,A以经建立了.
----------
VarIsNull 传回Variant是否为NULL.
----------
Unit System
函数原型 function VarIsNull(const V: Variant): Boolean;
----------
VarAsType 将Variant转为另外一个型态的Variant.
----------
VarCast
----------
Unit System
函数原型 function VarAsType(const V: Variant; VarType: Integer):
Variant;
函数原型 procedure VarCast(var Dest: Variant; const Source: Variant;
VarType: Integer);
说明 VarType不可为varArray or varByRef.
----------
VarType 传回Variant的型态.
----------
Unit System
函数原型 function VarType(const V: Variant): Integer;
----------
VarClear 将variant清除,成为Unassigned状态.
----------
Unit System
函数原型 procedure VarClear(var V: Variant);
----------
VarCopy 拷贝一个variant.
----------
Unit System
函数原型 procedure VarCopy(var Dest: Variant; const Source: Variant);
说明 与Dest:=Source;效果一样.
----------
VarFromDateTime 将DateTime转为Variant.
----------
VarToDateTime 将Variant转为DateTime.
----------
Unit
- DELPHI常用函数集及简要范例
- DELPHI常用函数集及简要范例
- DELPHI常用函数集及简要范例
- DELPHI常用函数集及简要范例
- DELPHI常用函数集及简要范例 (转)
- DELPHI常用函数集及简要范例 3
- DELPHI常用函数集及简要范例(转载大富翁)
- DELPHI常用函数集及简要范例 选择自 FlyHope2005 的 Blog
- delphi 常用函数及方法
- 递归函数及Java范例
- delphi 常用函数
- Delphi常用函数
- Delphi常用函数应用
- Delphi 常用函数
- Delphi常用函数
- Delphi常用日期函数
- Delphi常用函数参考
- Delphi 常用函数
- 五一报警记
- 【java】java的String有时候可以用==比较的本质
- ubuntu 配置samba ， 与xp共享文件
- static_cast、dynamic_cast等
- oracle 数据字典表之:DBA_TABLES
- DELPHI常用函数集及简要范例
- 关于堆和栈
- C++运算符前置后置
- 指针与引用
- 10种用户友好的验证码
- adobe reader的英文字体很难看的解决方法
- Android2.2的camera应用程序中支持双camera切换(一)
- Louis Vuitton wallet M93561 Shenyang lack of high-rise fire caused by a high majority of gun fire useless field
- 回答朋友的问题(关于 RTEMS 的知识储备)
