Unit 'lpinternalmethods_algorithm' Package
[Overview][Constants][Classes][Index] [#pl_lape]

_LapeArrayUnique

Declaration

Source position: lpinternalmethods_algorithm.pas line 132

const _LapeArrayUnique: lpString = 'procedure _Unique(var p: Pointer; ElSize: SizeInt; Equals: _LapeEqualsFunc;' + LineEnding + ' Dispose: private procedure(p: Pointer);' + LineEnding + ' Copy: private procedure(Src: ConstPointer; Dst: Pointer)); overload;' + LineEnding + 'type' + LineEnding + ' PSizeInt = ^SizeInt;' + LineEnding + 'var' + LineEnding + ' i, j, Len: SizeInt;' + LineEnding + ' Src: Pointer;' + LineEnding + 'begin' + LineEnding + ' if (p = nil) then' + LineEnding + ' Exit;' + LineEnding + '' + LineEnding + ' Len := PSizeInt(p)[-1]^' + '+1' + ';' + LineEnding + ' while (i < Len) do' + LineEnding + ' begin' + LineEnding + ' Src := p[i * ElSize];' + LineEnding + '' + LineEnding + ' j := i + 1;' + LineEnding + ' while (j < Len) do' + LineEnding + ' begin' + LineEnding + ' if Equals(p[i * ElSize]^, p[j * ElSize]^) then' + LineEnding + ' begin' + LineEnding + ' if (Pointer(Copy) = nil) then' + LineEnding + ' Move(Src^, p[j * ElSize]^, ElSize)' + LineEnding + ' else' + LineEnding + ' Copy(Src^, p[j * ElSize]^);' + LineEnding + '' + LineEnding + ' Dec(Len);' + LineEnding + ' Dec(j);' + LineEnding + ' end;' + LineEnding + '' + LineEnding + ' Inc(j);' + LineEnding + ' end;' + LineEnding + '' + LineEnding + ' Inc(i);' + LineEnding + ' end;' + LineEnding + '' + LineEnding + ' _ArraySetLength(p, Len, ElSize, Dispose, nil);' + LineEnding + 'end;';



CT Web help

CodeTyphon Studio