信息来源：邪恶八进制 中国

常量数组的定义和初始化    
   
我要定义一个字符串常量数组，怎么定义并进行初始化？好像下面的代码不行：

复制内容到剪贴板

代码:

const

Error_Msg=array [0..3] of string=('First','Second','Third');

其实很简单，把第一个等于号改成冒号即可：

复制内容到剪贴板

代码:

const

Error_Msg:array [0..3] of string=('First','Second','Third');

下面是多维数组的初始化：

复制内容到剪贴板

代码:

const

WordOptName:array[0..1,0..1,0..1] of string=(

(('',''),('','')),

(('',''),('','')));

记录、集合的初始化

复制内容到剪贴板

代码:

Type TTest = Record

ID: Integer

Item: word;

end;

记录初始化：

复制内容到剪贴板

代码:

const

ATest:TTest=(Id:0;Item:0);

下面是一个复杂的记录的初始化：

复制内容到剪贴板

代码:

TGUID = packed record

D1: LongWord;

D2: Word;

D3: Word;

D4: array[0..7] of Byte;

end;

POLIT_GUID: TGUID = (D1:10;D2:10;D3:10;D4:(1,2,3,4,5,6,7,8));

数组初始化：

复制内容到剪贴板

代码:

TTestA = Record

ItemA: String;

ItemB: String;

ItemC: Integer;

end;

Type Test = Record

ID: Integer

Item: TTestA;

end;

Const

First: Array [0 .. 2] of TTestA = (//该如何写这段初始化);

Secord:array [0..2] of Test=(///初始化代码如何写？);

回答：

集合的初始化必须明确指定每一个字段的名称和值，并且各个字段之间用;分隔。

复制内容到剪贴板

代码:

First: array[0..1] of TTestA = (

(ItemA: '0 ItemA String'; ItemB: 'ItemB String'; ItemC: 10),

(ItemA: '1 ItemA String'; ItemB: '1 ItemB String'; ItemC: 20),

()

);

Secord: array[0..1] of Test = (

(ID: 10; Item: (ItemA: 'Test 0 ItemA'; ItemB: 'Test 0 ItemB'; ItemC: 10)),

(ID: 20; Item: (ItemA: 'Test 1 ItemA'; ItemB: 'Test 1 ItemB'; ItemC: 20)),

()

);

如何进行结构的转换和复制    
   
可以采用下面的方法，但是这是极不安全的。

复制内容到剪贴板

代码:

type

TA=record

i:integer;

b:integer;

end;

type

TB=record

i:integer;

b:byte;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

pa,pb:^byte;

a:ta;

b:tb;

i:integer;

begin

a.i:=100;

a.b:=200;

pa:=@a;

pb:=@b;

for i:=1 to sizeof(b) do

begin

pb^:=pa^;

inc(pb);

inc(pa);

end;

showmessage(inttostr(b.i)+' '+inttostr(b.b));

end;

Packed Record的问题    
   
记录类型的内存分配！

Packed Record和Record的不同之处！

复制内容到剪贴板

代码:

type

MyRec=Record

var1:integer;

var2,var3,var4,var5,var6,var7,var8:shortint;

var9:integer;

var10:shortint;

var11:integer;

var12,var13:shortint;

end;

...

ShowMessage(intTostr(SizeOf(MyRec)));[code]

结果显示为18，而按我想象应为16。请高手讲解一下Delphi5.0中变量内存空间分配机制，因为我有一个数组MyArray:Array[1..1000000] of MyRec;需要考虑节省内存问题，

另外不要说我懒不爱看书，我手头所有关于Delphi的书都没有提到这个问题。

回答：

显示的结果应该为28，而不是18！按道理应该是22。用Packed的结果就是22。

拟定义的数组比较大，应该用packed record！

原因如下：

在Windows中内存的分配一次是4个字节的。而Packed按字节进行内存的申请和分配，这样速度要慢一些，因为需要额外的时间来进行指针的定位。因此如果不用Packed的话，Delphi将按一次4个字节的方式申请内存，因此如果一个变量没有4个字节宽的话也要占4个字节！这样就浪费了。按上面的例子来说：

[code]var1:integer;//integer刚好4个字节！

var2-var5占用4个字节，Var6-Var8占用4个字节，浪费了一个字节。

var9:integer//占用4个字节；

var10:占用4个字节；浪费3个字节

var11:占用4个字节；

var12,var13占用4个字节；浪费2个字节

所以，如果不用packed的话，那么一共浪费6个字节！所以原来22个字节的记录需要28个字节的内存空间！

****************

回复人：eDRIVE(eDRIVE)　(2001-3-2 17:45:00) 得0分

这是因为在32位的环境中，所有变量分配的内存都进行“边界对齐”造成的。这样做可以对速度有优化作用；但是单个定义的变量至少会占用32位，即4个字节。所以会有长度误差，你可以用packed关键字取消这种优化。

深入的分析，内存空间（不是内存地址）在计算机中划分为无数与总线宽度一致的单位，单位之间相接的地方称为“边界”；总线在对内存进行访问时，每次访问周期只能读写一个单位（32bit），如果一个变量横跨“边界”的话，则读或写这个变量就得用两个访问周期，而“边界对齐”时，只需一个访问周期，速度当然会有所优化。

关于数组的一个问题   
   
我们知道，在Delphi中有一个Type的Byte Array!这个有什么用呢？其实这个可以作为动态数组来使用，例如，我们可以Type一个尽可能大的数组：

Type

TMyByteArray=array[0..32767] of integer; ////也可以使用记录！

PMyByteArray=^TMyByteArray;

不用担心内存的问题，是用Type定义数组的时候，是没有分配内存的，需要到变量的时候才会分配内存，因此，我们定义变量的时候，应该使用指针！

复制内容到剪贴板

代码:

var

Demo:PMyByteArray;

使用的时候，可以使用GetMem来申请内存：

复制内容到剪贴板

代码:

GetMem(Demo,500*SizeOf(integer)); ///这样，Demo就有500个数组元素了
以后就可以使用了。：）

下面给出一些编写好的通用的例程：

复制内容到剪贴板

代码:

Procedure AllocArray( Var pArr: Pointer; items, itemsize: Cardinal;

Var maxIndex: Cardinal);

Begin

If items > 0 Then Begin

GetMem( pArr, items * itemsize);

maxIndex := Pred( items );

End

Else Begin

pArr := Nil;

maxIndex := 0; { WARNING! This is still an invalid index here! }

End;

End;

Procedure ReDimArray( Var pArr: Pointer; newItems, itemsize: Cardinal;

Var maxIndex: Cardinal );

Begin

If pArr = Nil Then

AllocArray( pArr, newItems, itemsize, maxIndex )

Else Begin

ReAllocMem( pArr, Succ(maxIndex)*itemsize,

newItems*itemsize);

maxIndex := Pred( newItems );

End;

End;

Procedure DisposeArray( Var pArr: Pointer; itemsize, maxIndex: Cardinal );

Begin

FreeMem( pArr, Succ(maxIndex)*itemsize);

End;

调用示例如下：

复制内容到剪贴板

代码:

type

{we can directly declare a pointer to an array, no need to declare

the array first}

PDoubleArray = ^Array [0..High(Cardinal) div Sizeof(Double) -1] of

Double;

Var

pDbl: PDoubleArray;

maxIndex, i: Cardinal;

deg2arc: Double;

Begin

deg2arc := Pi/180.0;

try

AllocArray( pDbl, 360, Sizeof( Double ), maxIndex );

For i:= 0 To maxIndex Do

pDbl^[i] := Sin( Float(i) * deg2arc );

ReDimArray( pDlb, 720, Sizeof( Double ), maxIndex );

For i:= 360 To maxIndex Do

pDbl^[i] := Cos( Float(i-360) * deg2arc );

finally

DisposeArray( pDbl, Sizeof(Double), maxIndex );

end;

如何传递数组给过程或者函数    
   
问：我用procedure Proc(var A:array[1..10] of integer);怎么都不能编译通过，难道Delphi不能传递数组作为参数吗？

答：必须先用Type定义一下即可：

复制内容到剪贴板

代码:

type

TProcArray=array[1..10] of integer;

procedure Proc(var A:TProcArray);

这样就没有问题了，而且对于动态数组也可以用上面的方法！使用动态数组的时候，有一个问题是如何遍历每一个数据项？采用类似的代码即可：

复制内容到剪贴板

代码:

procedure Proc(var A:TProcArray);

var

i:integer;

begin

....

for i:=Low(A) to High(A) do

/// A[i]就是每一个数据项

....

end;

  动态数组的长度设置    
  多维的动态数组的设置直接使用setlength(a,1,2,3)的就可以了,注意,a必须是一个3维的数组!以次类推.

通用数组操作函数   
   
Notice: This unit makes extensive use of array types that exceed the maximum "safe" size of 65519 bytes. While the compiler "allows" the declaration without error, application program should not ordinarily try to allocate memory to such structures. Segment wraparound problems can otherwise occur. For instance, most of these routines will not work on an array that "straddles" a segment boundary. If you notice carefully in this unit, the large arrays are used only for typecasting purposes, and no memory is allocated to them.

{ General-purpose array manipulation routines by J. W. Rider }

unit asorts; {Last modified: 09APR91}

interface

{ $define MONITOR} { <--- remove space before "$" to enable monitoring various sorting routines }

{$ifdef MONITOR}

var monitor : procedure; { for monitoring results of sort }

procedure nullmonitor; { to turn monitoring off }

{$endif}

　

{ *** Type definitions *** }

{ "comparefunc" -- comparison function argument for "qsort", "bsearch"

"lfind" and "lsearch"

"icomparefunc"-- comparison function argument for "virtual" routines

"swapproc" -- exchange procedure for "virtual" routines

"testfunc" -- test function argument for "scan" }

type comparefunc = function (var a,b):longint;

icomparefunc= function (a,b:longint):longint;

swapproc = procedure(a,b:longint);

testfunc = function (var a):boolean;

{ *** C compatibility routines *** }

{ "qsort", "bsearch", "lfind", "lsearch" and "swab" are analogous to

standard C functions of the same names }

{ quicksort the elements of an array }

procedure qsort(var base; length_base, sizeof_element:word;

f:comparefunc);

{ binary search a sorted array for an element}

function bsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

{ linear search an array for an element }

function lfind(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

{ linear search an array for an element; append if not found }

function lsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

{ move one array of words to another, swapping bytes }

procedure swab(var source, destination; numwords:word);

　

{ *** "riderized" (i.e, generally nonstandard) routines *** }

{ the remaining routines generally have no standard implementation in other

languages }

{ binary search a sorted array for an element. Return the index of

its location, or the negative of the index where it should be inserted }

function bfind(var key,base; length_base, sizeof_element:word;

f:comparefunc):longint;

{ inserts an element into a sorted array. }

function binsert(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

{ fibonacci search a sorted array; marginally faster than "bsearch" }

function fibsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

{ fill an array with an element }

procedure fill(var key,destination; count, sizeof_element:word);

{ order an array by the "heapsort" algorithm }

procedure heapsort(var base; length_base, sizeof_element:word;

f:comparefunc);

{ return the address of variable as a longint value }

function longaddr(var x):longint;

{ a not-so-quick sorting routine, compare with qsort }

procedure naivesort(var base; length_base, sizeof_element:word;

f:comparefunc);

{ scan a subarray for the first element that meets a specific criteria }

function scan(var source; count, sizeof_element:word; f:testfunc):word;

{ order an array by the "selection sort" algorithm }

procedure selsort(var base; length_base, sizeof_element:word;

f:comparefunc);

{ order an array by the "shell sort" algorithm }

procedure shellsort(var base; length_base, sizeof_element:word;

f:comparefunc);

{ randomly permute the elements of an array }

procedure shuffle(var base; length_base, sizeof_element:word);

{ fill a subarray with an element }

procedure subfill(var key,destination;

count, sizeof_key,sizeof_element:word);

{ move subarray to array or array to subarray }

procedure submove(var source,destination;

count, sizeof_source, sizeof_destination:word);

{ swap two elements or variables of the same size }

procedure swap(var var1,var2; sizeof_element:word);

{ sort a "virtual" array by the quicksort algorithm }

procedure vqsort(length_base:longint; f:icomparefunc; s:swapproc);

{ sort a "virtual" array by using a selection sort algorithm }

procedure vselsort(length_base:longint; f:icomparefunc; s:swapproc);

{ randomly permute a "virtual" array }

procedure vshuffle(length_base:longint; s:swapproc);

{ move subarray to subarray }

procedure xsubmove(var source,destination;

count,sizeof_source,sizeof_destination,sizeof_move:word);

implementation

function bfind(var key,base; length_base, sizeof_element:word;

f:comparefunc):longint;

var b:array [0..$fffe] of byte absolute base; l,h,x,c:longint;

begin if length_base>0 then begin

l:=0; h:=pred(length_base);

repeat

x:=(l+h) shr 1; c:=f(key,b[x*sizeof_element]);

if c<0 then h:=pred(x)

else if c>0 then l:=succ(x)

else{if c=0 then}begin bfind:=succ(x); exit; end;

until l>h;

bfind:=-l; end

else bfind:=0; end;

　

function binsert(var key,base;length_base,sizeof_element:word;

f:comparefunc):word;

var b:array [0..$fffe] of byte absolute base; x:longint;

begin

x:=bfind(key,base,length_base,sizeof_element,f);

if x<=0 then x:=-x else dec(x);

move(b[x*sizeof_element],b[succ(x)*sizeof_element],

(length_base-x)*sizeof_element);

move(key,b[x*sizeof_element],sizeof_element);

binsert:=succ(x); end;

　

function bsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

var c:longint;

begin

c:=bfind(key,base,length_base,sizeof_element,f);

if c>0 then bsearch:=c

else bsearch:=0; end;

　

function fibsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

var b:array [0..$fffe] of byte absolute base; i,p,q,imax:word; t:longint;

begin

imax:=length_base*sizeof_element;

q:=0; p:=sizeof_element; i:=p+q; { set up for fibonacci sequencing }

while imax>(i+p) do begin q:=p; p:=i; inc(i,q); end;

dec(i,sizeof_element); {zero-base adjustment}

while true do begin

if i<imax then t:=f(key,b)

else t:=-1; { simulate "too big" for "out of range" }

if t=0 then begin fibsearch:=succ(i div sizeof_element); exit end

else if t<0 then

if q=0 then begin fibsearch:=0; exit end

else begin dec(i,q); q:=p-q; dec(p,q) end

else { if t>0 then }

if p=sizeof_element then begin fibsearch:=0; exit end

else begin inc(i,q); dec(p,q); dec(q,p) end end end;

　

procedure fill(var key,destination; count, sizeof_element:word);

var b:array [0..$fffe] of byte absolute destination;

x,moved:word;

begin if count>0 then begin

move(key,destination,sizeof_element);

moved:=1; dec(count); x:=sizeof_element;

while count>moved do begin

move(destination,b[x],x);

dec(count,moved); moved:=moved shl 1; x:=x shl 1; end;

move(destination,b[x],count*sizeof_element); end; end;

　

procedure heapsort(var base; length_base, sizeof_element:word;

f:comparefunc);

var b: array[0..$fffe] of byte absolute base;

p:pointer; nx:longint; k,kx:word;

procedure aux1(kx:word);

procedure aux2; var jx:word;

begin

while kx<=(nx shr 1) do begin

jx:=kx shl 1;

if (jx<nx) and (f(b[jx],b[jx+sizeof_element])<0) then

inc(jx,sizeof_element);

if f(p^,b[jx])>=0 then exit;

move(b[jx],b[kx],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

kx:=jx end end;

begin {aux1}

move(b[kx],p^,sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

aux2;

move(p^,b[kx],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

end;

begin {heapsort}

getmem(p,sizeof_element);

nx:=pred(length_base)*sizeof_element;

for k:=(length_base shr 1) downto 1 do aux1(pred(k)*sizeof_element);

repeat

swap(b[0],b[nx],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then begin monitor; monitor; monitor end;

{$endif}

dec(nx,sizeof_element);

aux1(0);

until nx<=0;

freemem(p,sizeof_element) end;

function lfind(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

var b:array [0..$fffe] of byte absolute base; i,j:word;

begin

j:=0;

for i:=1 to length_base do begin

if f(key,b[j])=0 then begin lfind:=i; exit end;

inc(j,sizeof_element); end;

lfind:=0; end;

　

function longaddr(var x):longint;

begin longaddr:=(longint(seg(x)) shl 4) + ofs(x); end;

　

function lsearch(var key,base; length_base, sizeof_element:word;

f:comparefunc):word;

var b:array [0..$fffe] of byte absolute base; i:word;

begin

i:=lfind(key,base,length_base,sizeof_element,f);

if i=0 then begin

move(key,b[length_base*sizeof_element],sizeof_element);

lsearch:=succ(length_base); end

else lsearch:=i; end;

procedure naivesort(var base; length_base, sizeof_element:word;

f:comparefunc);

var b: array[0..$fffe] of byte absolute base;

i,j,l,r:word;

begin

i:=0;

for l:=1 to pred(length_base) do begin

j:=i+sizeof_element;

for r:=succ(l) to length_base do begin

if f(b,b[j])>0 then begin

swap(b,b[j],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

end;

inc(j,sizeof_element); end;

inc(i,sizeof_element); end; end;

{$ifdef MONITOR}

{ dummy "monitor" }

procedure nullmonitor; begin pointer((@@monitor)^):=NIL end;

{$endif}

procedure qsort(var base; length_base, sizeof_element:word;

f:comparefunc);

var b: array[0..$fffe] of byte absolute base;

j:longint; x:word; { not preserved during recursion }

procedure sort(l,r: word);

var i:longint;

begin

i:=l*sizeof_element;

while l<r do begin

j:=r*sizeof_element;

x:=((longint(l)+r) SHR 1)*sizeof_element;

while i<j do begin

while f(b,b[x])<0 do inc(i,sizeof_element);

while f(b[x],b[j])<0 do dec(j,sizeof_element);

if i<j then begin

swap(b,b[j],sizeof_element);

if i=x then x:=j else if j=x then x:=i;

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

end;

if i<=j then begin

inc(i,sizeof_element); dec(j,sizeof_element) end; end;

if (l*sizeof_element)<j then sort(l,j div sizeof_element);

l:=i div sizeof_element; end; end;

begin sort(0,pred(length_base)); end; {procedure qsort}

　

function scan(var source; count, sizeof_element:word; f:testfunc):word;

var b:array[0..$fffe] of byte absolute source;

i,j:word;

begin

j:=0;

for i:=1 to count do begin

if f(b[j]) then begin scan:=i; exit; end;

inc(j,sizeof_element); end;

scan:=0; end;

　

procedure selsort(var base; length_base, sizeof_element:word;

f:comparefunc);

var b:array[0..$fffe] of byte absolute base;

i,ix,j,jx,k,kx:word;

begin

ix:=0;

for i:=1 to pred(length_base) do begin

kx:=ix; jx:=ix;

for j:=succ(i) to length_base do begin

inc(jx,sizeof_element);

if f(b[jx],b[kx])<0 then kx:=jx end;

if kx<>ix then begin

swap(b[kx],b[ix],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

end; inc(ix,sizeof_element) end; end;

procedure shellsort(var base; length_base, sizeof_element:word;

f:comparefunc);

var b:array[0..$fffe] of byte absolute base;

p:pointer; h,jx:longint; i,hx,ix:word;

procedure aux; begin

while f(b[jx-hx],p^)>0 do begin

move(b[jx-hx],b[jx],length_base); dec(jx,hx);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

if jx<hx then exit end end;

begin if length_base>0 then begin

getmem(p,length_base);

if p<>nil then begin

h:=1; repeat h:=3*h+1 until h>length_base;

repeat

h:=h div 3; hx:=h*sizeof_element; ix:=hx;

for i:=succ(h) to length_base do begin

move(b[ix],p^,sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

jx:=ix; aux;

if jx<>ix then move(p^,b[jx],sizeof_element);

{$ifdef MONITOR}

if @monitor<>nil then monitor;

{$endif}

inc(ix,sizeof_element) end;

until h=1;

freemem(p,length_base) end end end;

　

procedure shuffle(var base; length_base, sizeof_element:word);

var b: array[0..$fffe] of byte absolute base;

i,ix,j,jx:word;

begin if length_base>0 then

for i:=pred(length_base) downto 1 do begin

ix:=i*sizeof_element;

j:=random(succ(i));

if i<>j then begin

jx:=j*sizeof_element;

swap(b[ix],b[jx],sizeof_element); end; end; end;

　

procedure subfill(var key,destination;

count, sizeof_key,sizeof_element:word);

var b:array [0..$fffe] of byte absolute destination; i,j:word;

begin

j:=0;

for i:=1 to count do begin

move(key,b[j],sizeof_key);

inc(j,sizeof_element); end; end;

　

procedure submove(var source, destination;

count, sizeof_source,sizeof_destination:word);

var sm:word;

begin if sizeof_source=sizeof_destination then

move(source,destination,count*sizeof_source)

else begin

if sizeof_source>sizeof_destination then sm:=sizeof_destination

else sm:=sizeof_source;

xsubmove(source,destination,

count,sizeof_source,sizeof_destination,sm); end; end;

　

procedure swab(var source, destination; numwords:word);

var a: array [1..$7fff] of word absolute source;

b: array [1..$7fff] of word absolute destination;

i:word;

begin if longaddr(source)>=longaddr(destination) then

for i:=1 to numwords do b:=system.swap(a)

else

for i:=numwords downto 1 do b:=system.swap(a) end;

　

procedure swap(var var1,var2; sizeof_element:word);

type chunk = array [0..$f] of byte;

var a:array [0..$fffe] of byte absolute var1;

b:array [0..$fffe] of byte absolute var2;

ac: array [1..$fff] of chunk absolute var1;

bc: array [1..$fff] of chunk absolute var2;

c:chunk; { swap buffer }

k:byte; x:word;

procedure swapchunk(var e,f:chunk);

begin c:=e; e:=f; f:=c; end;

procedure swapbytes(var e,f; len:byte);

begin move(e,c,len); move(f,e,len); move(c,f,len); end;

begin

for k:=1 to (sizeof_element shr 4) do swapchunk(ac[k],bc[k]);

k:=(sizeof_element and $f);

if k>0 then begin

x:=(sizeof_element and $fff0); swapbytes(a[x],b[x],k); end; end;

　

procedure vqsort(length_base:longint; f:icomparefunc; s:swapproc);

var j,x:longint; { not preserved during recursion }

procedure sort(l,r:longint);

var i:longint;

begin

i:=l; j:=r;

x:=(i+j) SHR 1;

while i<j do begin

while f(i,x)<0 do inc(i);

while f(x,j)<0 do dec(j);

if i<j then begin

s(i,j);

if i=x then x:=j else if j=x then x:=i; end;

if i<=j then begin inc(i); dec(j) end; end;

if l<j then sort(l,j);

if i<r then sort(i,r); end;

begin sort(1,length_base); end; {procedure vqsort}

　

procedure vselsort(length_base:longint; f:icomparefunc; s:swapproc);

var i,j,k:longint;

begin for i:=1 to pred(length_base) do begin

k:=i;

for j:=succ(i) to length_base do if f(j,k)<0 then k:=j;

if k<>i then s(k,i) end end;

　

procedure vshuffle(length_base:longint; s:swapproc);

var i,j:longint;

begin for i:=length_base downto 2 do begin

j:=succ(random(i));

if i<>j then begin s(i,j); end; end; end;

procedure xsubmove(var source,destination;

count,sizeof_source,sizeof_destination,sizeof_move:word);

var a:array [0..$fffe] of byte absolute destination;

b:array [0..$fffe] of byte absolute source;

i,j,k:word; r:boolean;

begin

r:=longaddr(source)>=longaddr(destination);

if r then begin j:=0; k:=0; end

else begin

j:=pred(count)*sizeof_destination; k:=pred(count)*sizeof_source; end;

for i:=1 to count do begin

move(b[k],a[j],sizeof_move);

if r then begin

inc(j,sizeof_destination); inc(k,sizeof_source) end

else begin

dec(j,sizeof_destination); dec(k,sizeof_source) end; end; end;

　

{$ifdef MONITOR}

begin {initialization}

nullmonitor;

{$endif}

end.

　

Notes on using the above unit:

ASORTS

General-purpose routines for sorting, searching and moving arrays of arbitrary elements.

by J. W. Rider

　

ASORTS provides the Turbo Pascal programmer with type definitions, functions and procedures to handle a variety of array sorting and searching tasks. Several of these are analogous to functions of the same name in the C programming language:

qsort -- sort an array

bsearch -- do a binary search of a sorted array for an element that satisfies some key

lfind -- do a sequential ("linear") search of an unsorted (or sorted) array for an element that satisfies some key

lsearch -- do a sequential search of an unsorted (or sorted) array for an element that satisfies some key. If

the element is not found, then it is appended to the end of the array.

(Non-C programmers: please note that "bsearch" and "lfind" -- not "lsearch"! -- do the equivalent task for sorted and unsorted arrays, respectively. It would make more sense to have "bfind" to search through a sorted array, and make "bsearch" insert a missing element into the array at the right location. However, these routines are provided for compatibility in converting C programs.)

swab -- move one portion of memory to another, swapping high and low order bytes in the process

There are some routines that are provided for utility above and beyond what is available in standard C libraries:

bfind -- do a binary search of a sorted array for an element that satisfies some key. (This differs from "bsearch" in that is "bfind" reports the "insertion index" if the key element is not found.)

binsert -- do a binary search of a sorted array for an element that satisfies some key. If the element is not found, then the key element is inserted in the proper location in the array to maintain the sorted order.

fibsearch-- searches an ordered array using a "fibonacci" search algorithm.

fill -- moves a single item into all of the elements of an array

heapsort -- order an array by the "heapsort" algorithm.

longaddr -- returns the address of a variable expressed as a longint value

naivesort-- a particularly inefficient sorting algorithm that the author has been known to use when "qsort" was not available. (The use of "naivesort" in applications is NOT recommended!)

scan -- returns the index of the first element in an array that meets a specific criterion.

selsort -- "selection" sorting, another sorting routine.

shellsort-- yet another sorting routine, different from the rest.

shuffle -- randomly permutes ("unsorts") the elements of an array

subfill -- moves a single item into all of the elements of a subarray of the base array

submove -- moves the elements of the source array into a subarray of the destination array (or, the elements of a subarray of the source to the destination array)

swap -- Exchanges two array elements or variables.

(NOTE! The "Asorts.Swap" procedure replaces the default "System.Swap" which simply exchanges the high and low-order bytes of a two byte expression.)

vqsort -- a quicksort algorithm for "virtual" arrays. "VQSort" does not presume any kind of structure inherent within the "thing" being sorted. Instead, "VQSort" provides the sorting logic to other routines that will perform the actual comparisons and exchanges.

vselsort -- a "virtual" selection sort.

vshuffle -- a "virtual" shuffler.

xsubmove -- moves the elements of a subarray of the source array into the elements of a subarray of the destination.

　

While these routines are provided to be of assistance to the programmer, the number of different searching and sorting algorithms does raise the issue of how to select any one algorithm for the programmer to employ.

Unfortunately, that is very application dependent. For general purpose array sorting, you would do well to compare the "qsort" and "shellsort" routines on your actual data. For sorting of typed files, I&#39;d suggest a

variant of "VSelSort".

　

CONCEPTS

The ARRAYs to be manipulated are passed as "untyped vars" to these routines. (In the "Interface" section, these arrays are called "base", "source" or "destination".) These routines will treat the ARRAYs as if they were declared to be of type:

ArrayType = ARRAY [1..MaxArray] OF ElementType

WARNING! It is *very* important to avoid defining an array so that the last byte is in a memory segment different from the first byte. As long as you never declare an array larger than 65519, or $10000-15, bytes, it should not be a problem.

Each ELEMENT of the ARRAY is presumed to be fixed size, and this size must be passed to the routines. (In the "Interface" section, if an ELEMENT needs to passed directly to a routine as an argument, it is passed as an untyped var called "key".) Also, the number of elements in the ARRAY must also be passed. For

instance, to fill an array of real numbers with 0:

var RealArray : array [1..10] of Real;

x : real;

x:=0;

fill(RealArray,10,sizeof(real),x);

A SUBARRAY is a "byte-slice" of an array. For instance, if "ElementType" is an "array [1..8] of byte", then a "subelement" would be any contiguous collection of bytes within the element, like 3,4 and 5. The SUBARRAY would be the collection of all of the subelements stored in an ARRAY. If "ElementType" is a record of fields, then a "subelement" would be any contiguous group of fields.

For sorting and searching, a COMPARISON FUNCTION must be passed to the routines. COMPARISON FUNCTIONs take two untyped vars, return a longint value, and must be declared "far" at compilation. (DIFFERENT! In C, only an integer-sized value is returned.) For instance, to sort the array of real numbers

declared earlier:

function RealCompare(var a,b):longint; far;

begin

if real(a)>real(b) then realcompare:=1

else if real(a)<real(b) then realcompare:=-1

else realcompare:=0;

end;

qsort(realarray,10,sizeof(real),realcompare);

　

"Virtual" arrays are data structures whose elements can be accessed indirectly by an index. For instance, information that is physically stored in multiple arrays might be sorted by a key in just one of the arrays. ASORTS provides a few routines for handling such "virtual" arrays. "VQSort" and "VSelSort" will provide the sorting logic for ordering the arrays. "VShuffle" will similarly "unorder" the array. To sort an array of "DBRec" with respect to an array of integer priorities, declare:

var Array1 : array [1..MaxDBRec] of DBRec;

Priority: array [1..MaxDBRec] of integer;

function ComparePriority(a,b:longint):longint; far;

begin ComparePriority:=longint(Priority[a])-Priority end;

procedure SwapPriDBRec(a,b:longint); far;

begin asorts.swap(Priority[a],Priority,sizeof(integer));

asorts.swap(Array1[a],Array1,sizeof(DBRec)); end;

and sort the two arrays with:

vqsort(MaxDBRec,ComparePriority,SwapPriDBRec);

INTERFACE

function bfind(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):longint;

Searches a sorted array for a "key" element. Return the index of its location, or the negative of the index of the largest element in the array that is smaller than the key (i.e., the element that you want to insert the new element after).

　

function binsert(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):longint;

WARNING: This routine overwrites memory if used incorrectly.

Inserts the key element into the correct position of an ordered array. Unlike "lsearch", which only adds the key if it&#39;s not already present, "binsert" ALWAYS inserts a new element into the array. "Binsert" returns the index where the element is inserted.

　

function bsearch(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):word;

"Bsearch" attempts to locate the "key" element within the previously SORTED array "base". If successful, the index of the found element is returned; otherwise, 0 is returned to indicate that the element is not present.

　

type comparefunc = function (var a,b{:element}):longint; {far;}

Declares the type of the comparison function to be passed to sorting and searching routines. CompareFunc&#39;s are user-defined functions that takes two arguments a and b. A and B must be typeless in the declaration, but otherwise are of the same type as the elements of the "base" array. For "qsort" and "bsearch", the function needs to return a negative integer if "A<B"; a positive integer if "A>B"; and 0 if "A=B". For "lfind" and "lsearch", the function needs to return 0 if "A=B", and some non-zero integer if "A<>B".

function fibsearch(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):word;

"Fibsearch" attempts to locate the "key" element within the previously SORTED array "base". If successful, the index of the found element is returned; otherwise, 0 is returned to indicate that the element is not present. (This procedure is included because a user asked about the algorithm on one of Borland&#39;s CompuServe Forums. It looks like an interesting alternative to "bsearch", but I have not run extensive comparisons.)

procedure fill(var key{:element}, destination{:array};

count, sizeof_element:word);

WARNING: This routine overwrites memory if used incorrectly.

Moves the "key" element to the first "count" indices in the "destination" array.

　

procedure heapsort(var base {:array};

length_base, sizeof_element:word;

f:comparefunc);

WARNING: This routine overwrites memory if used incorrectly.

"HeapSort" reorders the elements of the "base" array using a heapsort algorithm (like, you expected something else?). The function "f" is used to compare two elements of the array, and must return a negative number if the first argument is "less than" the second, a postive number if the first argument is "greater than" the second, and zero if the two arguments are "equal".

　

type icomparefunc = function (a,b:longint):longint;

Declares the type of the comparison function to be passed as an argument for sorting "virtual" arrays. Instead of passing the elements to be compared as is done for "comparefunc", ICompareFunc&#39;s use the location of the elements.

function lfind(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):word;

"Lfind" attempts to locate the "key" element within the array "base". If successful, the index of the found element is returned; otherwise, 0 is returnd to indicate the element is not present.

　

function longaddr (var x): longint;

Returns the address of a variable expressed as a longint value so that address can be used for comparisons, etc.

function lsearch(var key{:element}, base{:array};

length_base, sizeof_element:word;

f:comparefunc):word;

WARNING: This routine overwrites memory if used incorrectly.

　

Does a linear search of the "base" array, looking for the "key" element. If the key element is found, "lsearch" returns the index of the array. *** NOTE! *** Otherwise, the key element is appended to the end of the array. It is the programmer&#39;s responsibility to ensure that "sizeof_element" bytes are available at the end of the array and that the count of contained elements is adjusted. To avoid the append, use "lfind" instead.

var monitor : procedure;

procedure nullmonitor;

"Monitor" and "NullMonitor" were debugging devices developed in the process of putting together the ASORTS unit. They can be optionally declared by defining a compilation variable "MONITOR". Every time that the "Qsort" algorithm swaps a pair of array elements, the "monitor" procedure is called. This will allow the user to watch the progress of the sort. This is of marginal practical value, and by default, these two identifiers are not defined. Calling "NullMonitor" will turn off monitoring even if the "monitor" procedure variable is defined.

procedure naivesort(var base {:array};

length_base, sizeof_element:word;

f:comparefunc);

WARNING: This routine slowly overwrites memory if used incorrectly.

"NaiveSort" also reorders the elements or an array. However, it does it more slowly than "QSort". The use of the procedure is not recommended. It is provided for comparison only. (i.e., don&#39;t waste your time trying to improve upon it. It&#39;s only here for comic relief.)

procedure qsort(var base {:array};

length_base, sizeof_element:word;

f:comparefunc);

WARNING: This routine overwrites memory if used incorrectly.

"Qsort" reorders the elements of the "base" array using a quicksort algorithm. The function "f" is used to compare two elements of the array, and must return a negative number if the first argument is "less than" the second, a postive number if the first argument is "greater than" the second, and zero if the two arguments are "equal".

function scan(var source; count, sizeof_element:word;

f:testfunc):word;

"Scan" does a linear search of the "source" array and returns the index of the first element that satisfies the test function "f". If no element is found, "scan" returns 0.

　

procedure selsort(var base{:array};

length_base, sizeof_element:word;

f:comparefunc);

WARNING: This routine overwrites memory if used incorrectly.

"SelSort" reorders the elements of the "base" array using a selection sort algorithm. This algorithm minimizes the number of times that each element is moved, but will maximize the of comparisons. For most applications, the comparisons take more time than the exchanges, so you are not likely to want to use this algorithm for ordinary array sorting. See also, "VSelSort".

　

procedure shellsort(var base{:array};

length_base, sizeof_element:word;

f:comparefunc);

WARNING: This routine overwrites memory if used incorrectly.

"ShellSort" reorders the elements of the "base" array using a sort routine first defined by an individual whose last name was Shell. In concept, the algorithm is an insertion-type sort (as opposed to exchange-type sort (of which "qsort" and "selsort" are examples). This turns out to be a very efficient sorting routine for in-memory sorting.

　

procedure shuffle(var base{:array}; length_base, sizeof_element:word);

WARNING: This routine overwrites memory if used incorrectly.

Randomly permutes ("unsorts") the elements of an array. The SYSTEM "Randomize" procedure should be called at least once in a program that shuffles an array.

　

procedure subfill(var key{:subelement}, destination{:subarray};

count, sizeof_key, sizeof_element:word);

WARNING: This routine overwrites memory if used incorrectly.

Partially fills an array with the "key". The address of "Destination" should be the address of the first byte in the

subarray. The portion of the array outside of the subarray is left unchanged.

procedure submove(var source{:[sub]array},

destination{:[sub]array};

count,

sizeof_source_element,

sizeof_destination_element:word);

WARNING: This routine overwrites memory if used incorrectly.

If the size of the source elements are smaller than that of the destination elements, moves the first "count" elements of the source into a subarray of the same size in destination. If larger, only moves that portion of the source that will fill the first "count" elements of the destination. If equal in size, does a simple "move" of the bytes.

procedure swab(var source, destination; numwords:word);

WARNING: This routine overwrites memory if used incorrectly.

Moves the contents of source to the destination, swapping high and low order bytes in the process. (Note: while this is provided for C compatibility, the third argument is used differently. In C, the third argument is the number of bytes to move and is expected to be even. Here, the third argument is the number of byte-pairs to move.)

procedure swap(var var1,var2; sizeof_element:word);

WARNING: This routine overwrites memory if used incorrectly.

"Swap" exchanges the contents of the variable "var1" with the contents of the variable "var2". (Note: this is a redefinition of the "swap" function defined in the System unit.)

　

type swapproc = procedure (a,b:longint); {far;}

Declares the type of the exchange procedure that is passed as an argument to "selsort" and other virtual exchange sort algorithms.

type testfunc = function (var a):boolean; {far;}

Declares the type of the criterion function to be passed to the "scan" function. The actual TestFunc should expect an array element to be passed through "a" and return true if the element satisfies the criteria. Otherwise, it should return false.

　

procedure vqsort(length_base:longint; f:icomparefunc; s:swapproc);

"VQSort" provides the logic to do a quicksort of an indexed entity (a "virtual" array), but depends upon the user-defined routines "f" and "s" to do the actual work of accessing specific elements in the array, comparing and exchanging them. This makes VQSort useful for sorting elements when they are stored in something other than a single contiguous array.

procedure vselsort(length_base:longint; f:icomparefunc; s:swapproc);

"VSelSort" provides the logic to do a selection sort of an indexed entity (a "virtual" array), but depends upon the user-defined routines "f" and "s" to do the actual work of accessing specific elements in the array, comparing and exchanging them. As mentioned in the description for "SelSort", the algorithm minimizes the number of exchanges of elements required to put something into sorted order, but makes a large number of comparisons to do so. This would make "VSelSort" useful for something like sorting an external file of larger records based upon integer keys stored in an array in memory.

procedure vshuffle(length_base:longint; s:swapproc);

Of course, what fun is there in being able to order virtual arrays if we can&#39;t mix all the elements up again?

procedure xsubmove(var source{:subarray}, destination{:subarray};

count, sizeof_source_element,

sizeof_destination_element,

sizeof_subelement:word);

WARNING: This routine overwrites memory if used incorrectly.

Moves a subarray from the source to the destination. The size of the subelements is presumed to be the same in both subarrays. "XsubMove" does not check to make sure that the sizes are consistent.

　

REFERENCES

Knuth, The Art of Computer Programming, Sorting and Searching.

Press, et al., Numerical Recipes.

Sedgewick, Algorithms.

一个操作矩阵的类    
   
Q: How can I use huge arrays? (i.e. > 64K)

A: Unit provides support for arrays and huge (>64K) arrays of data. Each item size stored in the array must be a multiple of 2 (2,4,8,16,32..) in order to work using the huge arrays and matrices. This is needed so that you don&#39;t straddle the segment boundaries.

To use these objects merely create the object using the appropriate constructor. The object will be created with it&#39;s data initialized to zeros (GMEM_ZEROINIT). to access an element of the object use the AT() method. This will return you a pointer to the element you specified. for huge objects it will do the segment math correctly. Then you can dereference the pointer and work with the data.

This unit merely simplifies the use of huge type arrays and matrices. It does not do much more.

复制内容到剪贴板

代码:

Unit Arrays;

{Author ROBERT WARREN CIS ID 70303,537}

interface

uses WObjects,WinTypes,WinProcs;

type

PArray = ^TArray;

TArray = object(TObject)

Handle: THandle;

ItemSize: Word;

Limit: LongInt;

Address: Pointer;

constructor Init(aItemSize: Word; aLimit: LongInt);

destructor done; virtual;

function At(index: LongInt): Pointer; virtual;

end;

PMatrix = ^TMatrix;

TMatrix = object(TObject)

Handle: THandle;

ItemSize: Word;

Rows,Cols: LongInt;

Address: Pointer;

constructor Init(aItemSize: Word; aRows,aCols: LongInt);

destructor done; virtual;

function At(aRow,aCol: LongInt): Pointer; virtual;

end;

PHugeMatrix = ^THugeMatrix;

THugeMatrix = object(TMatrix)

SegIncr : Word;

constructor Init(aItemSize: Word; aRows,aCols: LongInt);

function At(aRow,aCol: LongInt): Pointer; virtual;

end;

PHugeArray = ^THugeArray;

THugeArray = object(TArray)

SegIncr: Word;

constructor Init(aItemSize: Word; aLimit: LongInt);

function At(index: LongInt): Pointer; virtual;

end;

function NewArray(aItemSize: Word; aLimit: LongInt): PArray;

function NewMatrix(aItemSize: Word; aRows,aCols: LongInt): PMatrix;

implementation

{

returns a pointer to an Array if small enough otherwise a HugeArray

}

function NewArray(aItemSize: Word; aLimit: LongInt): PArray;

var

TempArrayPtr: PArray;

begin

TempArrayPtr:=New(PArray,Init(aItemSize,aLimit));

if TempArrayPtr = nil then

TempArrayPtr:=New(PHugeArray,Init(aItemSize,aLimit));

NewArray:=TempArrayPtr;

end;

{

returns a pointer to an Matrix if small enough otherwise a HugeMatrix

}

function NewMatrix(aItemSize: Word; aRows,aCols: LongInt): PMatrix;

var

TempMatrixPtr: PMatrix;

begin

TempMatrixPtr:=New(PMatrix,Init(aItemSize,aRows,aCols));

if TempMatrixPtr = nil then

TempMatrixPtr:=New(PHugeMatrix,Init(aItemSize,aRows,aCols));

NewMatrix:=TempMatrixPtr;

end;

procedure AHIncr; far; external 'KERNEL' index 114;

{ ----------------------------------------------

TMatrix

---------------------------------------------- }

constructor TMatrix.Init(aItemSize: Word; aRows,aCols: LongInt);

var

InitSize: LongInt;

begin

TObject.Init;

Rows:=aRows;

Cols:=aCols;

ItemSize:=aItemSize;

InitSize:=LongInt(ItemSize * Rows * Cols);

if InitSize > $FFFF then fail;

Handle:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,ItemSize * Rows * Cols);

if handle = 0 then fail;

Address:=GlobalLock(Handle);

end;

destructor TMatrix.done;

begin

GlobalUnlock(Handle);

GlobalFree(Handle);

end;

function TMatrix.At(aRow,aCol: LongInt): Pointer;

var

pos: Word;

begin

pos:=(aRow * Cols * ItemSize) + (ACol * ItemSize);

At:=Pointer(MakeLong(pos,HiWord(LongInt(Address))));

end;

{ ----------------------------------------------

THugeMatrix

---------------------------------------------- }

constructor THugeMatrix.Init(aItemSize: Word; aRows,aCols: LongInt);

begin

TObject.Init;

Rows:=aRows;

Cols:=aCols;

ItemSize:=aItemSize;

Handle:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,LongInt(ItemSize * Rows * Cols));

if handle = 0 then fail;

Address:=GlobalLock(Handle);

SegIncr:=Ofs(AHIncr);

end;

function THugeMatrix.At(aRow,aCol: LongInt): Pointer;

var

Segs,Offs: Word;

Pos: LongInt;

begin

pos:=(aRow * Cols * ItemSize) + (ACol * ItemSize);

Segs:=Pos div $FFFF;

Offs:=Pos mod $FFFF;

At:=Pointer(MakeLong(Offs,((Segs*SegIncr)+(HiWord(LongInt(Address))))));

end;

　

{ ----------------------------------------------

TArray

---------------------------------------------- }

constructor TArray.Init(aItemSize: Word; aLimit: LongInt);

var

InitSize: LongInt;

begin

TObject.Init;

ItemSize:=aItemSize;

Limit:=aLimit;

InitSize:=ItemSize * Limit;

if InitSize > $FFFF then fail;

Handle:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,InitSize);

if handle = 0 then fail;

Address:=GlobalLock(Handle);

end;

destructor TArray.Done;

begin

TObject.Done;

GlobalUnlock(Handle);

GlobalFree(Handle);

end;

function TArray.At(index: LongInt): Pointer;

begin

At:=Pointer(LongInt(ItemSize * index) + LongInt(Address));

end;

{ ----------------------------------------------

THugeArray

---------------------------------------------- }

constructor THugeArray.Init(aItemSize: Word; aLimit: LongInt);

begin

TObject.Init;

ItemSize:=aItemSize;

Limit:=aLimit;

Handle:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,ItemSize * Limit);

if handle = 0 then fail;

Address:=GlobalLock(Handle);

SegIncr:=Ofs(AHIncr);

end;

function THugeArray.At(index: LongInt): Pointer;

var

Segs,Offs: Word;

Pos: LongInt;

begin

Pos:=Index * ItemSize;

Segs:=Pos div $FFFF;

Offs:=Pos mod $FFFF;

At:=Pointer(MakeLong(Offs,((Segs*SegIncr)+(HiWord(LongInt(Address))))));

end;

begin

end.

　

枚举类型变量和字符串的转换   
   
列出枚举类型的名字？

get names of enumerated values?

复制内容到剪贴板

代码:

// For example, if you have some enum type

{....}

type

TYourEnumType = (One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten);

{....}

{

And you want in run-time to get a string with same value for each of

them (for example, fill the Listbox items with enum values), then you

can use the next procedure:

}

uses TypInfo;

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

begin

for i := Ord(Low(TYourEnumType)) to Ord(High(TYourEnumType)) do

ListBox1.Items.Add(GetEnumName(TypeInfo(TYourEnumType), i));

end;

---------------------------------------

字符串转换枚举变量：

复制内容到剪贴板

代码:

uses typinfo;

type

TServerVariables = (svAUTH_PASSWORD, svAUTH_TYPE, svAUTH_USER);

function StrToServerVariable(const Value:String):TServerVariables;

begin

result := TServerVariables(GetEnumValue(TypeInfo(TServerVariables),

Value));

end;

function ServerVariableToStr(const Value:TServerVariables):String;

begin

result := GetEnumName(TypeInfo(TServerVariables), Ord(Value));

end;

---------------------------------------

qsl <qiusonglin@163.net>

上次ePing问过我，我那时也不太清楚，这段也不知他做什么了，先给你一份，:)

　

　

转换set类型到字符串，和字符串转到set类型。

　

一会我再给他发过去，不过不知他还要不要倒是真的。

　

复制内容到剪贴板

代码:

uses TypInfo;

　

function GetSetString(P: PTypeInfo; const Value): string;

var

I: Integer;

BaseType: PTypeInfo;

begin

Result := '';

BaseType := GetTypeData(P)^.CompType^;

for I := 0 to High(Byte) - 1 do

if I in TIntegerSet(Value) then

Result := Result + GetEnumName(BaseType, I) + ',';

if Result <> &#39;&#39; then

Delete(Result, Length(Result), 2);

Result := Format(&#39;[%s]&#39;, [Result]);

end;

　

procedure GetSetValue(SetType: PTypeInfo; const Value: string; var Result);

var

P, S: PChar;

Len: Integer;

EnumName: string;

EnumType: PTypeInfo;

　

procedure IncludeResult;

begin

Len := P - S;

SetLength(EnumName, Len);

Move(S^, EnumName[1], Len);

EnumName := Trim(EnumName);

Include(TIntegerSet(Result), GetEnumValue(EnumType, EnumName));

end;

　

begin

TIntegerSet(Result) := [];

EnumType := GetTypeData(SetType)^.CompType^;

P := PChar(Value);

S := P;

while True do

case P^ of

&#39;[&#39;:

begin

Inc(P);

S := P;

end;

&#39;,&#39;:

begin

IncludeResult;

Inc(P);

S := P;

end;

#0, &#39;]&#39;:

begin

IncludeResult;

break;

end;

else

Inc(P);

end;

end;

　

type

TTest = (test1, test2, test3);

TTests = set of TTest;

　

procedure TForm1.Button1Click(Sender: TObject);

begin

Caption := GetSetString(TypeInfo(TTests), [test1, test2]);

end;

　

procedure TForm1.Button2Click(Sender: TObject);

var

V: TTests;

begin

GetSetValue(TypeInfo(TTests), &#39;[test1, test2, test3]&#39;, V);

if test1 in V then

ShowMessage(&#39;test1 in V&#39;);

if test2 in V then

ShowMessage(&#39;test2 in V&#39;);

if test3 in V then

ShowMessage(&#39;test3 in V&#39;);

end;

关于枚举类型   
   
定义的枚举类型我只能取出他的顺序值，就是1，2，3，4什么的，我怎么才能取出他的

字符值，就是定义时写的，请指教

复制内容到剪贴板

代码:

procedure TMainForm.lbSampsClick(Sender: TObject);

var

OrdTypeInfo: PTypeInfo;

OrdTypeData: PTypeData;

TypeNameStr: String;

TypeKindStr: String;

MinVal, MaxVal: Integer;

i: integer;

begin

memInfo.Lines.Clear;

with lbSamps do

begin

// Get the TTypeInfo pointer

OrdTypeInfo := PTypeInfo(Items.Objects[ItemIndex]);

// Get the TTypeData pointer

OrdTypeData := GetTypeData(OrdTypeInfo);

// Get the type name string

TypeNameStr := OrdTypeInfo.Name;

// Get the type kind string

TypeKindStr := GetEnumName(TypeInfo(TTypeKind),

Integer(OrdTypeInfo^.Kind));

// Get the minimum and maximum values for the type

MinVal := OrdTypeData^.MinValue;

MaxVal := OrdTypeData^.MaxValue;

　

// Add the information to the memo

with memInfo.Lines do

begin

Add('Type Name: '+TypeNameStr);

Add('Type Kind: '+TypeKindStr);

Add('Min Val: '+IntToStr(MinVal));

Add('Max Val: '+IntToStr(MaxVal));

// Show the values and names of the enumerated types

if OrdTypeInfo^.Kind = tkEnumeration then

for i := MinVal to MaxVal do

Add(Format(' Value: %d Name: %s', [i, GetEnumName(OrdTypeInfo,

i)]));

end;

end;

end;

直接定义记录和变量

复制内容到剪贴板

代码:

var

TimeStamp : record

case byte of

1: (Whole: comp);

2: (Lo, Hi: LongInt);

end;