Тест "Струпа" (Делфи7)

[xJIEXAx]

Появилась необходимость написать сей тест, вот с реализацией затык. Не могу понять как сделать проверку соответствия цвета и его названия. И еще, где-то на форуме нашел код рендомного заполнения массива без повторов. Подогнал под свои нужды, но работает глючно.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  color : array[1..2,1..8] of string;
  colorname, cl : string;
  L1,L2,L3,L4,L5,L6,L7,L8  : string;
  L11,L12,L13,L14,L15,L16,L17,L18 : string;
  //////////////////////////////////////////////////////

procedure rcolor;
  var
  x: integer;
   m, i, max : Byte;
   No : Boolean;
   namecolor : array [1..8] of Integer;

    begin
      max := 2;

        For m := 1 To 8 Do
          Begin
            Repeat
              No := False;
              x := Random(8)+1;
               For i := 1 To max Do
                if namecolor[i] = x Then No := True;
            Until No = False;
          namecolor[m] := x;
          max := max + 1;

          end;

         L1:=color[2,namecolor[1]];
         L2:=color[2,namecolor[2]];
         L3:=color[2,namecolor[3]];
         L4:=color[2,namecolor[4]];
         L5:=color[2,namecolor[5]];
         L6:=color[2,namecolor[6]];
         L7:=color[2,namecolor[7]];
         L8:=color[2,namecolor[8]];
      end;

/////////////////////////////////////////////////////////

procedure ncolor;
  var
  x1: integer;
   m1, j, max1 : Byte;
   NO : Boolean;
   namecolor1 : array [1..8] of Integer;

    begin
      max1 := 2;

        For m1 := 1 To 8 Do
          Begin
           Repeat // в этом месте бесконечный цикл, что не так?
              NO := False;
              x1 := Random(8)+1;
              For j := 1 To max1 Do
              if namecolor1[j] = x1 Then NO := True;
            Until NO = False;
              namecolor1[m1] := x1;
              max1 := max1 + 1;

          end;

         L11:=color[1,namecolor1[1]];
         L12:=color[1,namecolor1[2]];
         L13:=color[1,namecolor1[3]];
         L14:=color[1,namecolor1[4]];
         L15:=color[1,namecolor1[5]];
         L16:=color[1,namecolor1[6]];
         L17:=color[1,namecolor1[7]];
         L18:=color[1,namecolor1[8]];
      end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 Randomize;
rcolor;
ncolor;
   label1.Caption:=L11;
   label2.Caption:=L12;
   label3.Caption:=L13;
   label4.Caption:=L14;
   label5.Caption:=L15;
   label6.Caption:=L16;
   label7.Caption:=L17;
   label8.Caption:=L18;

   Label1.Font.Color:=stringtocolor(L1);
   Label2.Font.Color:=stringtocolor(L2);
   Label3.Font.Color:=stringtocolor(L3);
   Label4.Font.Color:=stringtocolor(L4);
   Label5.Font.Color:=stringtocolor(L5);
   Label6.Font.Color:=stringtocolor(L6);
   Label7.Font.Color:=stringtocolor(L7);
   Label8.Font.Color:=stringtocolor(L8);

end;

  begin


color[1,1] := 'Красный';
color[1,2] := 'Синий';
color[1,3] := 'Зеленый';
color[1,4] := 'Коричневый';
color[1,5] := 'Серый';
color[1,6] := 'Черный';
color[1,7] := 'Желтый';
color[1,8] := 'Фиолетовый';
color[2,5] := 'ClSilver';
color[2,3] := 'ClGreen';
color[2,6] := 'ClBlack';
color[2,2] := 'ClBlue';
color[2,4] := 'ClMaroon';
color[2,7] := 'ClYellow';
color[2,8] := 'ClFuchsia';
color[2,1] := 'ClRed';



end.

[xJIEXAx]

Так, добавил строчку перед

max1:=2;

fillchar(namecolor1,sizeof(namecolor1),0);

заработало стабильно, но открыт вопрос по реализации совпадения цвета с его названием. Есть идеи?

[xJIEXAx]

прогу дописал, кому интересно стучитесь.

[Sasha_Smirnov]

Текст Струпа отличит вас от трупа! Зомби не пройдут.

Спасибо! Очень занимательно. Вникал минут пять.

Со 2-й попытки прошёл за 2:42. 4 ошибки в тесте-1. Плюс переутомление.

Арифметический хотите? Там всего на 5—15 секунд.