-----------------------------------------------------------------------------
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;