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