Friday, 29 April 2011

Building a Crossword Control

If you decide to build a Crossword Control, remember to keep it concise as you get bogged down by too many ideas. Create a control array for the text boxes and labels. The below code shows how an auto increment is used for the across and down options. Loops are used to extract characters from answer arrays to be placed in the result grid.
Private Sub UserControl_Initialize()
Dim i, j, k As Integer
Dim l, m, n As Integer
Dim o As Integer
Dim across_increment(25) As Integer
Dim down_increment(25) As Integer
'i = j = 0
i = 1
j = 0
k = 0
o = 0
across_increment(0) = 3
across_increment(1) = 1
across_increment(2) = 3
across_increment(3) = 1
Dim across_ques_arr(25) As String
Dim across_ans_arr(25) As String
Dim down_ques_arr(25) As String
Dim down_ans_arr(25) As String
across_ques_arr(0) = "Termite Eating Nocturnal African Mammal"
across_ans_arr(0) = "Aardvark"
across_ques_arr(1) = "Nautical Term Used for Hailing A Person"
across_ans_arr(1) = "Ahoy"
across_ques_arr(2) = "Fine Smooth Cotton Thread Used for Stockings in Northern France"
across_ans_arr(2) = "Lisle"
across_ques_arr(3) = "Native Or Inhabitant Of Denmark"
across_ans_arr(3) = "Dane"
down_ques_arr(0) = "Horse Drawn Vehicle Used in Ancient Fighting and Racing"
down_ans_arr(0) = "Chariot"
down_ques_arr(1) = "Doctor Of Letters"
down_ans_arr(1) = "DLitt"
k = k + across_increment(0)
Do While (j <= 3)
Do While (i <= Len(across_ans_arr(j)))
Text1(k).Text = "" & Mid(across_ans_arr(j), i, 1)
i = i + 1
k = k + 1
Loop
i = 1
j = j + 1
k = k + across_increment(j)
Loop
l = 1
m = 0
n = 0
down_increment(0) = 6
'down_increment(1) = 2
Do While (m <= 1)
o = n
Do While (l <= Len(down_ans_arr(m)))
Text1(n).Text = "" & Mid(down_ans_arr(m), l, 1)
l = l + 1
n = n + 13
Loop
n = o + down_increment(m)
l = 1
m = m + 1
Loop
Dim x As Integer
Dim y As Integer
Dim str As String
x = 0
y = 0
Do While (x < 25)
If (Len(across_ques_arr(x)) > 40) Then
str = Left(across_ques_arr(x), 40) & vbCrLf & Right(across_ques_arr(x), Len(across_ques_arr(x)) - 40)
Label2(x).Caption = "" & (x + 1) & ") " & str
Else
Label2(x).Caption = "" & (x + 1) & ") " & across_ques_arr(x)
End If
x = x + 1
Loop
Do While (y < 25)
If (Len(across_ques_arr(y)) > 40) Then
Label3(y).Caption = "" & (y + 1) & ") " & down_ques_arr(y) & vbCrLf
Else
Label3(y).Caption = "" & (y + 1) & ") " & down_ques_arr(y)
End If
y = y + 1
Loop
End Sub

No comments:

Post a Comment