长理的太阳－－sun

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