function Collocate( //全排列
mStrings: TStrings
//做输出用的字符列表
mArrayString: array of string //源字符串
): Boolean
//返回处理是否成功
procedure pCollocate( //全排列子过程
mLeft: array of string
//排列到左边的字符
mRight: array of string //排列到右边的字符
);
var
I, J, L: Integer;
S: string;
vLeft, vRight: array of string;
begin
if Length(mLeft) = 0 then
begin
S := '';
for I := Low(mRight) to High(mRight) do
S := S + ' ' + mRight;
Delete(S, 1, 1);
mStrings.Add(S);
end else
begin
SetLength(vLeft, Length(mLeft) - 1);
SetLength(vRight, Length(mRight) + 1);
for I := Low(mLeft) to High(mLeft) do
begin
for J := Low(mLeft) to I - 1 do vLeft[J] := mLeft[J];
for J := I + 1 to High(mLeft) do vLeft[J - 1] := mLeft[J];
for J := Low(mRight) to High(mRight) do
vRight[J] := mRight[J];
vRight[High(vRight)] := mLeft;
pCollocate(vLeft, vRight);
end;
end;
end;
begin
Result := False;
if not Assigned(mStrings) then Exit;
mStrings.BeginUpdate;
try
mStrings.Clear;
pCollocate(mArrayString, []);
finally
mStrings.EndUpdate;
end;
Result := True;
end
{ Collocate }
procedure TForm1.FormCreate(Sender: TObject);
begin
Collocate(Memo1.Lines, ['AA', 'BB', 'CC'])
end;
