procedure TitelEinfuegen(AList: TStrings;
const ATitel:
string; AAnzahl: Integer);
begin
var pos: Integer := AList.Count + 1 - 2 * AAnzahl;
if pos < 1
then
raise Exception.CreateFmt('
Der Titel "%s" tritt zu häufig auf.', [ATitel]);
pos := Random(pos);
{ungültige Positionen überspringen}
if AAnzahl > 0
then
begin
for var n := 0
to AList.Count - 1
do
begin
if AList[n] = ATitel
then
Inc(pos, 2);
if n = pos
then
Break;
end;
end;
AList.Insert(pos, ATitel);
end;
procedure TitelMischen(AList: TStrings);
begin
var lItemList1 := TStringList.Create;
var lItemList2 := TStringList.Create;
try
lItemList1.Assign(AList);
{mehrfache Titel hintereinander}
lItemList1.Sort;
{mehrfache Titel in jeder Runde nur einmal einfügen, falls z.B. nur 10xTitelA und 10xTitelB in der Liste}
var lAnzahl := 0;
while lItemList1.Count > 0
do
begin
var lTitel := '
';
for var n := lItemList1.Count - 1
downto 0
do
begin
if lTitel <> lItemList1[n]
then
begin
lTitel := lItemList1[n];
TitelEinfuegen(lItemList2, lTitel, lAnzahl);
lItemList1.Delete(n);
end;
end;
Inc(lAnzahl);
end;
AList.Assign(lItemList2);
finally
lItemList1.Free;
lItemList2.Free;
end;
end;
procedure TForm1.BtnMischenClick(Sender: TObject);
begin
TitelMischen(MemoTitel.Lines);
end;