h(ParamStr(0))+laquo;main.wdsraquo;) then.LoadFromFile (extractFilePath (ParamStr (0)) + main.wds ) ;;
ShowShem;
end;
//Відображення схеми на екрані
procedure TFrmMain.ShowShem;i,j:integer;:string[1];:=ini.ReadInteger(laquo;mainraquo;,laquo;widthraquo;,6);.ColCount:= i; .DefaultColWidth:=(sg.Width div i) - 2;:=ini.ReadInteger ( main , height , 6) ;. RowCount:=i; .DefaultRowHeight:=(sg.height div i) - 2;:=ini.ReadInteger ( main , words , 6); i:=0 to matrix.Count - 1 doj:=1 to length (matrix [i]) do:=matrix [i] [j]; s= 1 then s:= raquo ;;. Cells [j - 1, i]:=s;
//завантаження матриці з іні-шника
procedure TFrmMain.LoadMatrix; i: integer; .clear; i:=1 to ini.ReadInteger ( main , height , 6) do.Add(ini.ReadString(laquo;matrixraquo;,IntToStr(i),laquo;111111raquo;));;:=length(matrix[0]);:=matrix.Count;;
//зміна розміру формиTFrmMain.FormResize (Sender: TObject) ;;
//промальовування осередки кроссвордаTFrmMain.sgDrawCell (Sender: TObject; Col, Row: Integer ;: TRect; State: TGridDrawState); s: string;: integer; sg.Cells [col, row]= 0 then.Canvas.brush.Color:=clGray;.Canvas.FillRect(Rect);;;.Canvas.brush.Color:=clWhite;.Canvas.FillRect(Rect);sg.Cells[col,row]=laquo;1raquo; then exit;:=sg.Cells [col, row] ;. Canvas.Font.size:=100; .Canvas.Font.size:=sg.Canvas.Font.size - 1;(sg.Canvas.TextHeight(S)lt;SG.DefaultRowHeight)(sg.Canvas.TextWidth(S)lt;SG.DefaultColWidth);.Canvas.TextOut(rect.left,rect.top,sg.Cells[col,row])
end;
//перевірка списку використовуваних слів на те, що їх можна вписати
//в вибрані позіцііTFrmMain.valid (l: tStringList): boolean; a: array [1..MaxRasmer, 1..MaxRasmer] of char;// матриця у вигляді масиву, j: integer;, s2: string; t, fi, fj, di, dj: integer; insWord (s: string; words: integer);// вставка слова в массівt: integer;:=ini.readstring ( words , IntToStr (words), 1,1, v );// завантаження опису слова
fi:=StrToInt (Split (str, , ));// х, у і напрямок
fj:=StrToInt (Split (str, , ));:=0; dj:=0; str= v then dj:=1 else di:=1; t:=0 to length (s) - 1 do [fi + di * t, fj + dj * t]:=s [t + 1] ;;; i:=0 to matrix.Count - 1 do//копіювання зі списку в масив
for j:=1 to length (matrix [i]) do [i + 1, j]:=matrix [i] [j]; i:=l.Count - 1 downto 1 do
begin (l [i], integer (l.objects [i]));// вставка крім 0-го без перевірки (раніше перевірено)
end;:=false; str:=ini.readstring ( words , IntToStr (integer (l.objects [0])), 1,1, v );// тепер з проверкой:=StrToInt(Split(str,laquo;,raquo;));:=StrToInt(Split(str,laquo;,raquo;));:=0;dj:=0;str=laquo;vraquo; then dj:=1 else di:=1; t:=0 to length (l [0]) - 1 dofi + di * t gt; _H then exit;// вихід за межі кроссвордаfj + dj * t gt; _W then exit;
if a [fi + di * t, fj + dj * t]= 0 then exit;// там взагалі не можна букви ставити
if a [fi + di * t, fj + dj * t]= 1 then continue;// ще не занятоa [fi + di * t, fj + dj * t] lt; gt; l [0] [t + 1] then exit;// зайнято, але збігається
end;:=true;// якщо ми тут значить все Ок;
//Висновок складеного кросворду (схоже на попередн.)
procedure TFrmMain.OutKrossw (used: tStringList); i, j, t, fi, fj, di, dj: integer;: string;: array [1..6,1..6] of char;insWord(s:string;words:integer);t:integer;:=ini.readstring(laquo;wordsraquo;,IntToStr(words),laquo;1,1,vraquo;);:=StrToInt(Split(str,laquo;,raquo;));:=StrToInt(Split(str,laquo;,raquo;));:=0;dj:=0;str=laquo;vraquo; then dj:=1 else di:=1; t:=0 to length (s) - 1 do [fi + di * t, fj + dj * t]:=s [t + 1] ;;; i:= 0 to matrix.Count - 1 do//копіювання в матріцуj:=1 to length (matrix [i]) do [i + 1, j]:=matrix [i] [j]; t:=0 to used.Count- 1 do (used [t], integer (used.objects [t]));// вставка ВСІХ слів без перевірки; i:=0 to matrix.Count - 1 doj:=1 to length (matrix [i]) do
sg.cells [i, j - 1]:=a [i + 1, j];// тепер все на екран
sg.refresh; not assigned (FrmOk) then Application.CreateForm (TFrmOk, FrmOk); FrmOk.ShowModal=MrOk then//чи хоче юзер ще варіанти
endOfFind:=true;// якщо не хоче;
//основна процедура рекурсивного перебору варіантів
//на вході список вже всавленних слів
//і номер вставляемого словаTFrmMain.interior (used: tStringList; CurWord: integer); i: integer; endOfFind then exit;// вихід якщо користувач не хоче більше
if CurWord=MaxWords + 1 then//всі слова вставлені (FindCount); (used);// можна виводити
exit;// Та й нема чого...
