I dug out the disc in its archives crossword generation program, which I did a few years ago on an order for 11 student class. For this reason, many deliberately places in the program simplified and amateurishly writtenthat the student could give the code of his own.For this reason, the number of hard-coded words and placed the cells to enter answers – 12 pieces. But I think if someone wants to modify it it will not be difficult.
Source code is provided with a large number of detailed comments, so to understand the details will not be difficult. The very base of all the questions and answers contained in the file 1.txt, if anyone ever decides to fill that database must not forget to edit the line Cnt = 56 in the beginning.
Download the generation of crossword puzzles (Delphi 7)
I draw your attention that this is not a finished product, for lovers of crosswords, the program is very small base of questions – only 56, and there is no easy adjustment of the size of the crossword and the number of placed issues.
Algorithm generation of crossword
I have developed an algorithm selection and placement of words on the board, whose task is to get the maximum number of intersections with other words. An algorithm, choosing another word for random placement, consistently trying to place it horizontally and vertically, gradually moving from the top left corner to the bottom right of the board.At the same time if you do not give any crossing or word superimposed on the already placed the word is not correct that such options are discarded, and if deemed successful placement of the stored number of intersections obtained to then choose the option with the highest number.
When placing the words, the algorithm takes into account some limitations. For example you can not place the two words one after the other back to back, otherwise it will be clear where one ends and another begins.
Procedures and MapWord MapWordCheck – contain the bulk of the algorithm for placing the words on the board.
procedure TMainForm.MapWord(WUindex: integer);
var
Len : integer;
x,y,n : integer;
i : integer;
cnt : integer; // Number of found accommodation options
POst : integer; // The remaining number of attempts to pick a word from the dictionary
// array to store the options for placement of the words on the board
MX : array[1..Tmax*Tmax] of integer; // X coordinate on the board
MY : array[1..Tmax*Tmax] of integer; // Y coordinate on the board
MN : array[1..Tmax*Tmax] of integer; // Direction of the word - 1 horizontal 2 - vertical
begin // Select from the dictionary and place the word on the board
// WUindex - serial number of the placed word
POst := Pmax; // Grab the variable specified in the number of attempts to select a word
cnt := 0; // Initially the number of variants that can be placed on the board the word
while cnt=0 do begin // twist loop until we find a word that can accommodate even be one way
POst := POst-1; // decrease number of attempts
if POst1)and(T[x-1,y]<>' ')and(T[x-1,y]<>'#') then begin // the word should not be molded to close another word
Result := false; // Placement impossible
Exit;
end;
if (x<Tmax)and(T[x+Len,y]<>' ')and(T[x+Len,y]<>'#') then begin // the word should not be molded to close another word
Result := false; // Placement impossible
Exit;
end;
for i := 1 to Len do begin // check character by character
if T[x+i-1,y]<>' ' then begin // cell is busy
if T[x+i-1,y]<>S[i] then begin // symbol in the cell is not the same as the character in the word - placing impossible
Result := false;
Exit;
end else begin
if (TS[x+i-1,y]=3)or(TS[x+i-1,y]=1) then begin // symbol coincide, but there is the intersection of words, or there is word, located in the same direction
Result := false; // Placement impossible
Exit;
end else begin
p := p + 1; // Register the successful crossing of the audited words already placed
end;
end;
end;
end;
end else begin // VERTICAL
if (y>1)and(T[x,y-1]<>' ')and(T[x,y-1]<>'#') then begin // the word should not clings close to another word
Result := false; // Placement impossible
Exit;
end;
if (y<Tmax)and(T[x,y+Len]<>' ')and(T[x,y+Len]<>'#') then begin // the word should not clings close to another word
Result := false; // Placement impossible
Exit;
end;
for i := 1 to Len do begin // check character by character
if T[x,y+i-1]<>' ' then begin // the cell is busy
if T[x,y+i-1]<>S[i] then begin // symbol in the cell is not the same as the character in the word - placing impossible
Result := false;
Exit;
end else begin
if (TS[x,y+i-1]=3)or(TS[x,y+i-1]=2) then begin // symbol coincide, but there is the intersection of words, or there is word, located in the same direction
Result := false; // Placement impossible
Exit;
end else begin
p := p + 1; // Register the successful crossing of the audited words already placed
end;
end;
end;
end;
end;
if p>0 then begin
Result := true; // Placement with such parameters
end else begin
Result := false; // Placement impossible - nchego not interfere, but no intersections
end;
end;
function TMainForm.RandWord: integer;
var
r : integer;
i : integer;
begin // select words from the dictionary, which is not yet used
r := 0;
while r=0 do begin
r := 1 + Random(wCnt-1);
for i := 1 to WUmax do begin
if WU[i]=r then r := 0; // If the selected word is already used, reset the option to take another
end;
end;
Result := r;
end;
procedure TMainForm.SetWord(WUindex: integer);
var
Len : integer;
S : string;
i : integer;
x,y : integer;
begin // word fits into the net, with (in table T and TS)
// WUindex - sequence number in the tables WU, WX, WY, WN (ablitsy these should be filled previously)
S := W[WU[WUindex]]; // get the word
Len := Length(S); // get the length
x := WX[WUindex];
y := WY[WUindex];
// Mark the cells before and after the word as employed (that his word does not start or end clung closely to the words already placed)
if WN[WUindex]=1 then begin // HORIZONTAL
if (x-1)>0 then begin // Put restrictive sign before the word
TS[x-1,y] := 3;
T[x-1,y] := '#';
end;
if x+Len<=Tmax then begin // Put restrictive sign after the word
TS[x+Len, y] :=3;
T[x+Len, y] := '#';
end;
end else begin // ВЕРТИКАЛЬНО
if (y-1)>0 then begin // Put restrictive sign before the word
TS[x,y-1] := 3;
T[x,y-1] := '#';
end;
if y+Len<=Tmax then begin // Put restrictive sign after the word
TS[x, y + Len] :=3;
T[x,y+Len] := '#';
end;
end;
for i := 1 to Len do begin
if WN[WUindex]=1 then begin // HORIZONTAL
T[x+i-1,y] := S[i]; // Put the symbol
TS[x+i-1,y] := TS[x+i-1,y] + 1; // Code word fits how it is positioned
// if (i=1) then TS[x-1,y] := 3; // Mark the cage before the term of employment
end else begin // VERTICAL
T[x,y+i-1] := S[i]; // Put the symbol
TS[x,y+i-1] := TS[x,y+i-1] + 2; // Code word fits how it is positioned
end;
end;
end;