Ирония судьбы: запрограммировать игру Супернаборщик оказалось легче, чем простого Наборщика! Однако, начнём.

Как мы и договаривались, заведём пару массивов для подсчёта букв в сло­вах:

Var word, curWord: array[’A’..’Я’] of integer;

Вместо массива array[char] нам вполне хватит массива array^A'./Я'] - других букв в наших словах нет.

В массиве word мы будем хранить число одинаковых букв в заданном сло­ве. Сначала мы этот массив обнуляем, а потом подсчитываем все буквы за­данного слова. Если каких-то букв в слове не окажется, их число будет равно нулю.

Как обычно, загружаем словарь в массив строк spisok и «вытаскиваем на свет божий» по одному слову. Для каждого из них копируем массив word в curWord:

curWord:= word; 

Теперь мы получили в своё распоряжение все буквы (и в эквивалентном количестве) заданного слова. В цикле for уменьшаем на 1 число тех букв, которые в «подопытном» слове стоят на 1, 2 и последующих местах. Если вдруг букв не хватило, значит, слово из списка невозможно составить из букв заданного слова. Если всё нормально, выводим найденное слово в протокол:

//НАЙТИ НУЖНЫЕ СЛОВА
procedure TfrmMain.sbtFindClick(Sender: TObject); var
s : String; i,j: integer; flag: boolean;
word, curWord: array[’A’..^’] of integer; ch: char; begin
//конвертируем буквы в верхний регистр - как в словаре: s:= AnsiUpperCase(txtWord.Text); if length(s) < 2 then
Application.MessageBox('Слишком короткое слово!’, ’Наборщик’, MB OK);

//обнуляем массив - ни одной букзы пока в нём нет:
for ch:='A' to 'Я' do
word[ch]: =0;
//считаем буквы в слове и формируем массив:
for i:=l to length(s) do begin
inc(word[s ] ) ;
end;
IstProtokol.Items.clear;
//отыскиваем подходящие слова и заносим их в протокол:
for i:=l to WordsAll do begin
curWord:= word;
flag:= TRUE;
for j:=l to length(spisok ) do begin
dec(curWord[spisok[i,j] ] ) ;
if curWord[spisok[i,j]] < 0 then begin //- такой буквы нет!
flag:= FALSE;
break;
end;
end;
if flag then
IstProtokol.Items.Add (spisok) ;
end; 
end;