-----------------------------------------------------------------------------
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 {logcontent} The variant is Unassigned.
varNull The variant is Null.
varSmallint
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 {logcontent}A Operating system error code.
varBoolean {logcontent}B 16-bit boolean (type WordBool).
varVariant {logcontent}C Variant (used only with variant arrays).
varUnknown {logcontent}D 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 {logcontent}FFF 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 System
函数原型 function VarFromDateTime(DateTime: TDateTime): Variant;
函数原型 function VarToDateTime(const V: Variant): TDateTime;
=============================
函数
==============================
procedure TForm1.Button2Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('G:\33.bmp ');
Form1.Canvas.Brush.Bitmap := Bitmap;
Form1.Canvas.FillRect(Rect(0,0,18,15));
finally
Form1.Canvas.Brush.Bitmap := nil;
Bitmap.Free;
end;
end;
## Canvas, Brush, Bitmap, FillRect Example
=======================================
TextOut
=======================================
procedure TForm1.FormCreate(Sender: TObject);
var
HeaderSection: THeaderSection;
I: Integer;
begin
for I := 0 to 4 do
begin
HeaderSection := HeaderControl1.Sections.Add;
HeaderSection.Text := 'Text Section ' + IntToStr(I);
HeaderSection.MinWidth := length(HeaderSection.Text) * Font.Size;
// Owner draw every other section
if (I mod 2 = 0) then
HeaderSection.Style := hsOwnerDraw
else
HeaderSection.Style := hsText;
end;
end;
procedure TForm1.HeaderControl1DrawSection(HeaderControl: THeaderControl;
Section: THeaderSection; const Rect: TRect; Pressed: Boolean);
begin
with HeaderControl.Canvas do
begin
// highlight pressed sections
if Pressed then
Font.Color := clRed
else
Font.Color := clBlue;
TextOut(Rect.Left + Font.Size, Rect.Top + 2, 'Owner Drawn text');
end;
end;
## HeaderSection, OnDrawSection, Sections, Canvas, TextOut example
----------------------------------------------------------
Trunc Example
-----------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
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;
未归类
--------------------
WrapText
--------------------
SysUtils
type TSysCharSet = set of Char
var
S, R: string;
begin
S:= '123456_123456_123456';
R:= WrapText( S, #13#10, ['1', '4'], 4);
MessageDlg( R, mtInformation, [mbOk], 0);
end;
================================
WideCharToStrVar(Source: PWideChar;var Dest: string );
-------------------------
System
-----------------
=========================
WideCharToString( Source: PWideChar ): string;
-------------------------
System
=============================
WideCharLenToStrVar( Source: PWideChar;SourceLen: Integer;var Dest: string );
------------------------------
System
==============================
WideCharLenToString(Source: PWideChar;SourceLen: Integer ): string
-----------------------
System
============================
AnsiCompareFileName(const S1, S2: string ): Integer; SysUtils
===================================
AnsiExtractQuotedStr (var S: PChar;Quote: Char ): string;
SysUtils
var
S1: PChar;
S2: string;
begin
S1:= '/??. ?????????? /???.56/';
S2:= AnsiExtractQuotedStr(S1,'/'); // S2 := '??. ?????????? '
MessageDlg(S2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiLastChar( const S: string ): PChar;
SysUtils
----------------------------------------------------------
AnsiLowerCaseFileName( const S: string ): string;
SysUtils
----------------------------------------------------------
AnsiPos ( const Substr, S: string ): Integer
SysUtils
var
Substr, S: string;
I: Integer;
begin
S:= '???????? ??????';
Substr:= '???';
I:= AnsiPos(Substr, S); // I:= 3
...
end;
----------------------------------------------------------
AnsiQuotedStr (const S: string;Quote: Char ): string;
SysUtils
var
S: string;
begin
S:= '1997-1998??.';
S:= AnsiQuotedStr(S, '-'); // S := '-1997--1998??.-'
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiSameStr ( const S1, S2: string ): Boolean;
SysUtils
----------------------------------------------------------
AnsiSameText ( const S1, S2: string ): Boolean;
SysUtils
----------------------------------------------------------
AnsiStrComp( S1, S2: PChar ): Integer
SysUtils
----------------------------------------------------------
AnsiStrIComp( S1, S2: PChar ): Integer;
SysUtils
----------------------------------------------------------
AnsiStrLastChar( P: PChar ): PChar;
SysUtils
----------------------------------------------------------
AnsiStrLComp(S1, S2: PChar;MaxLen: Cardinal ): Integer;
SysUtils
var
P1,P2: PChar;
Len : Integer;
begin
P1:= '?????? ?????????? ?? ?????? ????????? ????????.';
P2:= '?????? ?????????? ?? ?????? ????????? ????????!';
Len:= length(p1)-1;
If AnsiStrLIComp(P1, P2, Len)=0 then MessageDlg( P1+ #13+ P2+ #13+ '??????, ? ???????? ?????? '+ IntTostr(Len)+' ????????, ?????', mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrLIComp(S1, S2: PChar;MaxLen: Cardinal ): Integer;
SysUtils
var
P1,P2: PChar;
Len : Integer;
begin
Len:= 7;
P1:= '?????? 1';
P2:= '?????? 2';
If AnsiStrLIComp(P1, P2, Len)=0 then MessageDlg( P1+ #13+ P2+ #13+ '??????, ? ???????? ?????? '+ IntTostr(Len)+' ????????, ?????', mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrLower( S1, S2: PChar ): PChar;
SysUtils
----------------------------------------------------------
AnsiStrPos( S, SubStr: PChar ): PChar
SysUtils
var
S1,S2: Pchar;
begin
S1:= '???? ? ???? - ? ????? ????!';
S2:= AnsiStrPos(S1,'?????'); // S2 :='????? ????!'
MessageDlg( S2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrRScan( S : PChar; Chr: Char ): PChar;
SysUtils
var
P1,P2: PChar;
begin
P1:= 'C:\windows\temp';
P2:= AnsiStrRScan(P1, '\'); { P2 := '\temp' }
MessageDlg( P2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrScan( S : PChar; Chr: Char ): PChar;
SysUtils
var
P1,P2: PChar;
begin
P1:= 'http://www.atrussk.ru/delphi';
P2:= AnsiStrScan(P1, '/'); { P2 := '//www.atrussk.ru/delphi' }
MessageDlg( P2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrUpper( S : PChar ): PChar
SysUtils
----------------------------------------------------------
AnsiUpperCaseFileName( const S: string ): string;
SysUtils
----------------------------------------------------------
ByteToCharIndex(const S: string;Index: Integer ): Integer;
SysUtils
----------------------------------------------------------
ByteToCharLen( const S: string;MaxLen: Integer ): Integer;
SysUtils
----------------------------------------------------------
ByteType(const S: string;Index: Integer ): TMbcsByteType;
SysUtils
mbSingleByte -
mbLeadByte -
mbTrailByte -
----------------------------------------------------------
CharToByteIndex(const S: string;Index: Integer ): Integer;
SysUtils
----------------------------------------------------------
CharToByteLen(const S: string;MaxLen: Integer ): Integer;
SysUtils
----------------------------------------------------------
Chr ( X: Byte ): Char;
SysUtils
MessageDlg('ASCII-???? 77 ????????????? ?????? - ' + Chr(77), mtInformation, [mbOk], 0);
----------------------------------------------------------
FormatMaskText(const EditMask: string;const value: string ): string;
Mask
----------------------------------------------------------
GetFormatSettings;
SysUtils
----------------------------------------------------------
IsDelimiter (const Delimiters, S: string;Index: Integer ): Boolean;
SysUtils
var
S: string;
begin
S:= '???????, ?????? ??????????!';
If IsDelimiter( '!.,-', S, 8) then
MessageDlg( '???????!', mtWarning, [mbOK], 0)
else
MessageDlg( '??????????!', mtWarning, [mbOK], 0);
end;
----------------------------------------------------------
IsPathDelimiter (const S: string;Index: Integer ): Boolean;
SysUtils
If IsPathDelimiter( S, Length(S))
then S:=Copy( S, 1, Length(S)-1);
----------------------------------------------------------
LastDelimiter (const Delimiters, S: string ): Integer;
SysUtils
var
I: Integer;
begin
I:= LastDelimiter('!;.,-', '???????, ??????, ??????????'); // I := 16
end;
----------------------------------------------------------
LineStart( Buffer, BufPos : PChar ): PChar
Classes--
--------------------------------------------------------
QuotedStr ( const S: string ): string;
SysUtils
----------------------------------------------------------
SetLength ( var S; Length: Integer );
System
----------------------------------------------------------
SetString (var S: string;Buffer: PChar;Length: Integer );
System
----------------------------------------------------------
Str ( X [: Width [: Decimals ]]; var S );
System
var
S: string;
I: Real;
begin
I:= -52.123456789;
Str( I:6:2, S); { S := ' -52.12' }
MessageDlg( S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
StrBufSize( S: PChar ): Cardinal;
SysUtils
----------------------------------------------------------
StrByteType(S: PChar;Index: Cardinal ): TMbcsByteType;
SysUtils
----------------------------------------------------------
StringOfChar (Ch: Char;Count: Integer ): string;
System
S:= StringOfChar( '.' , 3); // S:= '...'
----------------------------------------------------------
StringReplace (const S, OldSubstr, NewSubstr: string;Flags: TReplaceFlags ): string;
SysUtils
type TReplaceFlags = set of ( rfReplaceAll, rfIgnoreCase );
var
S: string;
Flags: TReplaceFlags;
begin
Flags:= [ rfReplaceAll, rfIgnoreCase ];
S:= '???? - ????? ?????';
S:= StringReplace( S, '??', '??', Flags); // S :='???? - ????? ?????' }
MessageDlg( S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
StringToWideChar(const Source: string;Dest: PWideChar;DestSize: Integer ): PWideChar
System
----------------------------------------------------------
UniqueString( var S: string );
System
----------------------------------------------------------
==============================
讯息
==============================
---------------------------------------------------------------
ShowMessage 讯息
---------------------------------------------------------------
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
----------------------------------------------------------
FindComponent
范例(1)
type
LogPal = record
lpal : TLogPalette;
dummy:Array[0..255] of TPaletteEntry;
end;
procedure TForm1.SaveAsBmpClick(Sender: TObject);
var
Source: TComponent;
SysPal : LogPal;
tempCanvas: TCanvas;
sourceRect, destRect: TRect;
image2save: TImage;
notUsed: HWND;
begin
Source := FindComponent(Edit1.Text);
if (not Source is TControl) or
((not Source is TWinControl) and ((Source as TControl).Parent = nil)) then
begin
Beep;
ShowMessage(Edit1.Text + ' is not a valid control.');
Exit;
end;
tempCanvas := TCanvas.Create;
try
with Source as TControl do
tempCanvas.Handle := GetDeviceContext(notUsed);
image2save:=TImage.create(self);
try
with image2save do
begin
Height := (Source as TControl).Height;
Width := (Source as TControl).Width;
destRect := Rect(0,0,Width,Height);
if Source is TWinControl then
sourceRect := destRect;
else
sourceRect := (Source as TControl).BoundsRect;
Canvas.CopyRect(destRect,tempCanvas,sourceRect);
SysPal.lPal.palVersion:=$300;
SysPal.lPal.palNumEntries:=256;
GetSystemPaletteEntries(tempCanvas.Handle,0,256,SysPal.lpal.PalpalEntry);
Picture.Bitmap.Palette:= CreatePalette(Syspal.lpal);
end;
if SaveDialog1.Execute then
image2save.Picture.SaveToFile(SaveDialog1.FileName);
finally
image2save.Free;
end;
finally
tempCanvas.Free;
end;
end;
范例(2)
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
const
NamePrefix = 'MyEdit';
begin
for i := 1 to 20 do begin
TEdit.Create(Self).Name := NamePrefix + IntToStr(i);
with TEdit(FindComponent(NamePrefix + IntToStr(i))) do
begin
Left := 10;
Top := i * 20;
Parent := self;
end;
end;
end;
=========================================================
procedure TForm1.Button1Click(Sender: TObject);
var
A: Variant;
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, 1000]);
Edit1.Text :=(A[2]); { Hello world }
Edit2.Text :=(A[4][2]); { 100 }
end;
procedure TForm1.Button2Click(Sender: TObject);
var
s: string;
begin
s := 'Honest Abe Lincoln';
Delete(s,8,4);
Canvas.TextOut(10, 130, s); { 'Honest Lincoln' }
end;
procedure TForm1.Button3Click(Sender: TObject);
var S: string;
begin
S := 'ABCDEF';
S := Copy(S, 2, 3);
Edit1.Text :=s;{ 'BCD' }
end;
procedure TForm1.Button4Click(Sender: TObject);
var
S: string;
begin
S := Concat('ABC', 'DEF');
Edit1.Text :=s; { 'ABCDE' }
end;
procedure TForm1.Button5Click(Sender: TObject);
var
S: string;
begin
S := 'Honest Lincoln';
Insert('Abe ', S, 8);
Edit1.Text :=s; { 'Honest Abe Lincoln' }
end;
procedure TForm1.Button6Click(Sender: TObject);
var
S: string;
begin
S := 'The Black Knight';
Canvas.TextOut(10, 130, 'String Length = ' + IntToStr(Length(S)));{String Length = 16}
Edit1.Text :=s;{The Black Knight}
end;
procedure TForm1.Button7Click(Sender: TObject);
var S: string;
begin
S := ' 123.5';
{ Convert spaces to zeroes }
while Pos(' ', S) > 0 do
S[Pos(' ', S)] := '0';
Edit1.Text :=s; {000123.5}
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 {logcontent} The variant is Unassigned.
varNull The variant is Null.
varSmallint
- {logtitle}
{logsummary}
我要留言To Comment 阅读全文Read All | 回复Comments({commentcount}) 点击Count({viewcount})
{phototitle}
- 点击:Hits:{viewcount}
- 回复:Comments:{commentcount}
- 发表:PostTime:{posttime}
{logsummary}
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 {logcontent}A Operating system error code.
varBoolean {logcontent}B 16-bit boolean (type WordBool).
varVariant {logcontent}C Variant (used only with variant arrays).
varUnknown {logcontent}D 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 {logcontent}FFF 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 System
函数原型 function VarFromDateTime(DateTime: TDateTime): Variant;
函数原型 function VarToDateTime(const V: Variant): TDateTime;
=============================
函数
==============================
procedure TForm1.Button2Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('G:\33.bmp ');
Form1.Canvas.Brush.Bitmap := Bitmap;
Form1.Canvas.FillRect(Rect(0,0,18,15));
finally
Form1.Canvas.Brush.Bitmap := nil;
Bitmap.Free;
end;
end;
## Canvas, Brush, Bitmap, FillRect Example
=======================================
TextOut
=======================================
procedure TForm1.FormCreate(Sender: TObject);
var
HeaderSection: THeaderSection;
I: Integer;
begin
for I := 0 to 4 do
begin
HeaderSection := HeaderControl1.Sections.Add;
HeaderSection.Text := 'Text Section ' + IntToStr(I);
HeaderSection.MinWidth := length(HeaderSection.Text) * Font.Size;
// Owner draw every other section
if (I mod 2 = 0) then
HeaderSection.Style := hsOwnerDraw
else
HeaderSection.Style := hsText;
end;
end;
procedure TForm1.HeaderControl1DrawSection(HeaderControl: THeaderControl;
Section: THeaderSection; const Rect: TRect; Pressed: Boolean);
begin
with HeaderControl.Canvas do
begin
// highlight pressed sections
if Pressed then
Font.Color := clRed
else
Font.Color := clBlue;
TextOut(Rect.Left + Font.Size, Rect.Top + 2, 'Owner Drawn text');
end;
end;
## HeaderSection, OnDrawSection, Sections, Canvas, TextOut example
----------------------------------------------------------
Trunc Example
-----------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
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;
未归类
--------------------
WrapText
--------------------
SysUtils
type TSysCharSet = set of Char
var
S, R: string;
begin
S:= '123456_123456_123456';
R:= WrapText( S, #13#10, ['1', '4'], 4);
MessageDlg( R, mtInformation, [mbOk], 0);
end;
================================
WideCharToStrVar(Source: PWideChar;var Dest: string );
-------------------------
System
-----------------
=========================
WideCharToString( Source: PWideChar ): string;
-------------------------
System
=============================
WideCharLenToStrVar( Source: PWideChar;SourceLen: Integer;var Dest: string );
------------------------------
System
==============================
WideCharLenToString(Source: PWideChar;SourceLen: Integer ): string
-----------------------
System
============================
AnsiCompareFileName(const S1, S2: string ): Integer; SysUtils
===================================
AnsiExtractQuotedStr (var S: PChar;Quote: Char ): string;
SysUtils
var
S1: PChar;
S2: string;
begin
S1:= '/??. ?????????? /???.56/';
S2:= AnsiExtractQuotedStr(S1,'/'); // S2 := '??. ?????????? '
MessageDlg(S2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiLastChar( const S: string ): PChar;
SysUtils
----------------------------------------------------------
AnsiLowerCaseFileName( const S: string ): string;
SysUtils
----------------------------------------------------------
AnsiPos ( const Substr, S: string ): Integer
SysUtils
var
Substr, S: string;
I: Integer;
begin
S:= '???????? ??????';
Substr:= '???';
I:= AnsiPos(Substr, S); // I:= 3
...
end;
----------------------------------------------------------
AnsiQuotedStr (const S: string;Quote: Char ): string;
SysUtils
var
S: string;
begin
S:= '1997-1998??.';
S:= AnsiQuotedStr(S, '-'); // S := '-1997--1998??.-'
MessageDlg(S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiSameStr ( const S1, S2: string ): Boolean;
SysUtils
----------------------------------------------------------
AnsiSameText ( const S1, S2: string ): Boolean;
SysUtils
----------------------------------------------------------
AnsiStrComp( S1, S2: PChar ): Integer
SysUtils
----------------------------------------------------------
AnsiStrIComp( S1, S2: PChar ): Integer;
SysUtils
----------------------------------------------------------
AnsiStrLastChar( P: PChar ): PChar;
SysUtils
----------------------------------------------------------
AnsiStrLComp(S1, S2: PChar;MaxLen: Cardinal ): Integer;
SysUtils
var
P1,P2: PChar;
Len : Integer;
begin
P1:= '?????? ?????????? ?? ?????? ????????? ????????.';
P2:= '?????? ?????????? ?? ?????? ????????? ????????!';
Len:= length(p1)-1;
If AnsiStrLIComp(P1, P2, Len)=0 then MessageDlg( P1+ #13+ P2+ #13+ '??????, ? ???????? ?????? '+ IntTostr(Len)+' ????????, ?????', mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrLIComp(S1, S2: PChar;MaxLen: Cardinal ): Integer;
SysUtils
var
P1,P2: PChar;
Len : Integer;
begin
Len:= 7;
P1:= '?????? 1';
P2:= '?????? 2';
If AnsiStrLIComp(P1, P2, Len)=0 then MessageDlg( P1+ #13+ P2+ #13+ '??????, ? ???????? ?????? '+ IntTostr(Len)+' ????????, ?????', mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrLower( S1, S2: PChar ): PChar;
SysUtils
----------------------------------------------------------
AnsiStrPos( S, SubStr: PChar ): PChar
SysUtils
var
S1,S2: Pchar;
begin
S1:= '???? ? ???? - ? ????? ????!';
S2:= AnsiStrPos(S1,'?????'); // S2 :='????? ????!'
MessageDlg( S2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrRScan( S : PChar; Chr: Char ): PChar;
SysUtils
var
P1,P2: PChar;
begin
P1:= 'C:\windows\temp';
P2:= AnsiStrRScan(P1, '\'); { P2 := '\temp' }
MessageDlg( P2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrScan( S : PChar; Chr: Char ): PChar;
SysUtils
var
P1,P2: PChar;
begin
P1:= 'http://www.atrussk.ru/delphi';
P2:= AnsiStrScan(P1, '/'); { P2 := '//www.atrussk.ru/delphi' }
MessageDlg( P2, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
AnsiStrUpper( S : PChar ): PChar
SysUtils
----------------------------------------------------------
AnsiUpperCaseFileName( const S: string ): string;
SysUtils
----------------------------------------------------------
ByteToCharIndex(const S: string;Index: Integer ): Integer;
SysUtils
----------------------------------------------------------
ByteToCharLen( const S: string;MaxLen: Integer ): Integer;
SysUtils
----------------------------------------------------------
ByteType(const S: string;Index: Integer ): TMbcsByteType;
SysUtils
mbSingleByte -
mbLeadByte -
mbTrailByte -
----------------------------------------------------------
CharToByteIndex(const S: string;Index: Integer ): Integer;
SysUtils
----------------------------------------------------------
CharToByteLen(const S: string;MaxLen: Integer ): Integer;
SysUtils
----------------------------------------------------------
Chr ( X: Byte ): Char;
SysUtils
MessageDlg('ASCII-???? 77 ????????????? ?????? - ' + Chr(77), mtInformation, [mbOk], 0);
----------------------------------------------------------
FormatMaskText(const EditMask: string;const value: string ): string;
Mask
----------------------------------------------------------
GetFormatSettings;
SysUtils
----------------------------------------------------------
IsDelimiter (const Delimiters, S: string;Index: Integer ): Boolean;
SysUtils
var
S: string;
begin
S:= '???????, ?????? ??????????!';
If IsDelimiter( '!.,-', S, 8) then
MessageDlg( '???????!', mtWarning, [mbOK], 0)
else
MessageDlg( '??????????!', mtWarning, [mbOK], 0);
end;
----------------------------------------------------------
IsPathDelimiter (const S: string;Index: Integer ): Boolean;
SysUtils
If IsPathDelimiter( S, Length(S))
then S:=Copy( S, 1, Length(S)-1);
----------------------------------------------------------
LastDelimiter (const Delimiters, S: string ): Integer;
SysUtils
var
I: Integer;
begin
I:= LastDelimiter('!;.,-', '???????, ??????, ??????????'); // I := 16
end;
----------------------------------------------------------
LineStart( Buffer, BufPos : PChar ): PChar
Classes--
--------------------------------------------------------
QuotedStr ( const S: string ): string;
SysUtils
----------------------------------------------------------
SetLength ( var S; Length: Integer );
System
----------------------------------------------------------
SetString (var S: string;Buffer: PChar;Length: Integer );
System
----------------------------------------------------------
Str ( X [: Width [: Decimals ]]; var S );
System
var
S: string;
I: Real;
begin
I:= -52.123456789;
Str( I:6:2, S); { S := ' -52.12' }
MessageDlg( S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
StrBufSize( S: PChar ): Cardinal;
SysUtils
----------------------------------------------------------
StrByteType(S: PChar;Index: Cardinal ): TMbcsByteType;
SysUtils
----------------------------------------------------------
StringOfChar (Ch: Char;Count: Integer ): string;
System
S:= StringOfChar( '.' , 3); // S:= '...'
----------------------------------------------------------
StringReplace (const S, OldSubstr, NewSubstr: string;Flags: TReplaceFlags ): string;
SysUtils
type TReplaceFlags = set of ( rfReplaceAll, rfIgnoreCase );
var
S: string;
Flags: TReplaceFlags;
begin
Flags:= [ rfReplaceAll, rfIgnoreCase ];
S:= '???? - ????? ?????';
S:= StringReplace( S, '??', '??', Flags); // S :='???? - ????? ?????' }
MessageDlg( S, mtInformation, [mbOk], 0);
end;
----------------------------------------------------------
StringToWideChar(const Source: string;Dest: PWideChar;DestSize: Integer ): PWideChar
System
----------------------------------------------------------
UniqueString( var S: string );
System
----------------------------------------------------------
==============================
讯息
==============================
---------------------------------------------------------------
ShowMessage 讯息
---------------------------------------------------------------
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
----------------------------------------------------------
FindComponent
范例(1)
type
LogPal = record
lpal : TLogPalette;
dummy:Array[0..255] of TPaletteEntry;
end;
procedure TForm1.SaveAsBmpClick(Sender: TObject);
var
Source: TComponent;
SysPal : LogPal;
tempCanvas: TCanvas;
sourceRect, destRect: TRect;
image2save: TImage;
notUsed: HWND;
begin
Source := FindComponent(Edit1.Text);
if (not Source is TControl) or
((not Source is TWinControl) and ((Source as TControl).Parent = nil)) then
begin
Beep;
ShowMessage(Edit1.Text + ' is not a valid control.');
Exit;
end;
tempCanvas := TCanvas.Create;
try
with Source as TControl do
tempCanvas.Handle := GetDeviceContext(notUsed);
image2save:=TImage.create(self);
try
with image2save do
begin
Height := (Source as TControl).Height;
Width := (Source as TControl).Width;
destRect := Rect(0,0,Width,Height);
if Source is TWinControl then
sourceRect := destRect;
else
sourceRect := (Source as TControl).BoundsRect;
Canvas.CopyRect(destRect,tempCanvas,sourceRect);
SysPal.lPal.palVersion:=$300;
SysPal.lPal.palNumEntries:=256;
GetSystemPaletteEntries(tempCanvas.Handle,0,256,SysPal.lpal.PalpalEntry);
Picture.Bitmap.Palette:= CreatePalette(Syspal.lpal);
end;
if SaveDialog1.Execute then
image2save.Picture.SaveToFile(SaveDialog1.FileName);
finally
image2save.Free;
end;
finally
tempCanvas.Free;
end;
end;
范例(2)
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
const
NamePrefix = 'MyEdit';
begin
for i := 1 to 20 do begin
TEdit.Create(Self).Name := NamePrefix + IntToStr(i);
with TEdit(FindComponent(NamePrefix + IntToStr(i))) do
begin
Left := 10;
Top := i * 20;
Parent := self;
end;
end;
end;
=========================================================
procedure TForm1.Button1Click(Sender: TObject);
var
A: Variant;
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, 1000]);
Edit1.Text :=(A[2]); { Hello world }
Edit2.Text :=(A[4][2]); { 100 }
end;
procedure TForm1.Button2Click(Sender: TObject);
var
s: string;
begin
s := 'Honest Abe Lincoln';
Delete(s,8,4);
Canvas.TextOut(10, 130, s); { 'Honest Lincoln' }
end;
procedure TForm1.Button3Click(Sender: TObject);
var S: string;
begin
S := 'ABCDEF';
S := Copy(S, 2, 3);
Edit1.Text :=s;{ 'BCD' }
end;
procedure TForm1.Button4Click(Sender: TObject);
var
S: string;
begin
S := Concat('ABC', 'DEF');
Edit1.Text :=s; { 'ABCDE' }
end;
procedure TForm1.Button5Click(Sender: TObject);
var
S: string;
begin
S := 'Honest Lincoln';
Insert('Abe ', S, 8);
Edit1.Text :=s; { 'Honest Abe Lincoln' }
end;
procedure TForm1.Button6Click(Sender: TObject);
var
S: string;
begin
S := 'The Black Knight';
Canvas.TextOut(10, 130, 'String Length = ' + IntToStr(Length(S)));{String Length = 16}
Edit1.Text :=s;{The Black Knight}
end;
procedure TForm1.Button7Click(Sender: TObject);
var S: string;
begin
S := ' 123.5';
{ Convert spaces to zeroes }
while Pos(' ', S) > 0 do
S[Pos(' ', S)] := '0';
Edit1.Text :=s; {000123.5}
end;
回复Comments
作者:
{commentrecontent}