?
Solved

Crossword puzzle creation tool in vb

Posted on 2003-03-26
7
Medium Priority
?
760 Views
Last Modified: 2008-03-06
I have been trying to implement a crossword puzzle creation tool using vb.Having come up with a grid on the picture box how can I write a code that will detect the event of clicking onto a specific number of cell on the picture box
0
Comment
Question by:nw_khaemba
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 1

Expert Comment

by:robertlees
ID: 8216125
The MouseUp event of the picture box will give you the X and Y position that was clicked. You can then work out which square that is by dividing these numbers by the number of squares across and down.

But do you really need to do it with a PictureBox ? Why not create an array of labels or textboxes. That way, each square is an individual entity. You can make the BackColor black or white as required. If you use textboxes, the user can type a letter directly into that square - you would have to ensure that if there is already a letter there it would be replaced by the new letter.

Let me know if you need more help.
0
 
LVL 3

Expert Comment

by:n_narayanan
ID: 8217768
Hi

Just go here

http://www.a1vbcode.com

and in the search box (Located on top right corner) enter crossword and click search.

You will find a code.

Enjoy

Cheers

Narayanan
0
 
LVL 3

Expert Comment

by:VBtom
ID: 8218719
Hi.

I once tried it like you, with a picturebox, and it is possible. But you'll need a lot of code then and the only advantages are that you can easily print it and that you can save it as a BMP file.
Using a control array of textboxes, as robertlees already suggested, produces much shorter and much easier code.

Try this simple but functional example and after, tell me if you're still convinced using a picturebox::
*create a form with a checkbox (for choosing typing direction) and a small square textbox (the upper left cell of the crossword).
For the textbox, set Alignment to center, Appearance to flat, and Index to 0.
*paste this code:
Dim Rows As Integer
Dim Cols As Integer

Private Sub MoveRight(Index As Integer)
If Index < Rows * Cols - 1 Then
    Text1(Index + 1).SetFocus
Else
    Beep
End If
End Sub

Private Sub MoveLeft(Index As Integer)
If Index > 0 Then
    Text1(Index - 1).SetFocus
Else
    Beep
End If
End Sub

Private Sub MoveDown(Index As Integer)
If Index + Cols < Rows * Cols Then
    Text1(Index + Cols).SetFocus
Else
    If Index = Rows * Cols - 1 Then
        Beep
    Else
        Text1(Index + Cols - Rows * Cols + 1).SetFocus
    End If
End If
End Sub

Private Sub MoveUp(Index As Integer)
If Index - Cols >= 0 Then
    Text1(Index - Cols).SetFocus
Else
    If Index = 0 Then
        Beep
    Else
        Text1(Index - Cols + Rows * Cols - 1).SetFocus
    End If
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Rows = 20
Cols = 20
Me.ScaleMode = vbPixels
Check1.Caption = "Move down after typing"
Text1(0).MaxLength = 1
For i = 1 To Rows * Cols - 1
    Load Text1(i)
    Text1(i).Left = Text1(0).Left + (i Mod Cols) * (Text1(0).Width - 1)
    Text1(i).Top = Text1(0).Top + (i \ Cols) * (Text1(0).Height - 1)
    Text1(i).Visible = True
Next i
End Sub

Private Sub Text1_Change(Index As Integer)
'Move right or down after typing a character:
If Len(Text1(Index)) = 1 Then
    If Check1 = 0 Then
        MoveRight Index
    Else
        MoveDown Index
    End If
End If

'Use space to create black cell:
If Text1(Index) = " " Then
    Text1(Index).BackColor = vbBlack
Else
    Text1(Index).BackColor = vbWhite
End If
End Sub

Private Sub Text1_GotFocus(Index As Integer)
'auto-select
Text1(Index).SelStart = 0: Text1(Index).SelLength = 1
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
'"UCase" every character
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'Make arrow keys work:
Select Case KeyCode
    Case vbKeyLeft: MoveLeft Index
    Case vbKeyRight: MoveRight Index
    Case vbKeyUp: MoveUp Index
    Case vbKeyDown: MoveDown Index
End Select
End Sub

If you need help on how to print the crossword or how to save it, just ask here.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:nw_khaemba
ID: 8223902
VBtom I think thats an excellent answer for extra points what code can set the dark area and prevent the cursor from venturing there instead of doing it at run time say I give indicate the cells to be darkened and it does it
0
 
LVL 3

Accepted Solution

by:
VBtom earned 2000 total points
ID: 8239854
Hi nw_khaemba.

Thank you for liking my example. Btw, it has one little cosmetic bug: the arrow-keys should respond to _KeyDown instead of _KeyUp.

I guess you mentioned that when designing a crossword (the example I posted) you can use a space to create blacks.
Why not keep on doing so in play-mode: a cell containing a space = black.
Then when a game starts and the blacks (spaces) have been set, you could disable all cells containing spaces (see procedure DiasbleBlacks).

Also declare a variable PlayMode in the (general) that should be made True when a game starts, and false when you want to create a new crossword.
Dim PlayMode As Boolean
This is because the player may not be able to create blacks pressing space. So when in playmode, let's neutralize space in _KeyPress, and use it for clearing instead
(when not in playmode, spaces are accepted), see Text1_Keypress below.

Also the arrow movement procedures should be refined for skipping blacks.

With this example, you can either design or play a crossword.
Make a form with:
*A checkbox called chkVertical
*A textbox (Text1) with appearance set to flat, borderstyle none, index 0, no text
*A textbox (Text2) with multiline set to true, this is for typing the descriptions of what should be filled in.
*Create the following menu-items: mnuPlay (= open and play a game), mnuDone (= to press when user finishes agame), mnuNew (to create a new crossword), mnuSave (to save the created crossword), mnuEdit (to open and edit a crossword).
For selecting files, I used simple inputboxes in the example. Off course it's better to use commondialog.
---
Option Explicit

Dim Rows As Integer
Dim Cols As Integer

Dim Playmode As Boolean
Dim Solution As String

Private Sub Clear()
Dim i As Integer
For i = 0 To Text1.UBound
       Text1(i) = ""
Next i
End Sub

Private Sub DrawGrid(ByVal NewRows As Integer, ByVal NewCols As Integer)
Dim i As Integer
Me.MousePointer = vbHourglass
For i = 0 To Text1.UBound
    Text1(i).Visible = False
Next i
Clear
Rows = NewRows
Cols = NewCols
'Adjust number of cells:
For i = Text1.UBound To (Rows * Cols) Step -1
    Unload Text1(i)
Next i
For i = (Text1.UBound + 1) To (Rows * Cols - 1)
   Load Text1(i)
   Text1(i).ToolTipText = "Horizontal:" & (i \ Cols) + 1 & " - Vertical:" & (i Mod Cols) + 1
Next i
'Position and show cells:
Text1(0).Visible = True
For i = 1 To Rows * Cols - 1
     Text1(i).Left = Text1(0).Left + (i Mod Cols) * (Text1(0).Width - 1)
     Text1(i).Top = Text1(0).Top + (i \ Cols) * (Text1(0).Height - 1)
     Text1(i).Visible = True
Next i
Me.MousePointer = vbDefault
End Sub

Private Sub DisableBlacks()
Dim i As Integer
For i = 0 To Text1.UBound
    With Text1(i)
     If .Text = " " Then
        .Enabled = False: .TabStop = False
     End If
    End With
Next i
End Sub

Private Sub EnableAllCells()
Dim i As Integer
For i = 0 To Text1.UBound
    With Text1(i)
        .Enabled = True: .TabStop = True
    End With
Next i
End Sub

Private Function GetBlacks(strCrossword As String) As String
Dim blanked As String, i As Integer
blanked = String(Rows * Cols, Chr$(0))
For i = 1 To Len(strCrossword)
    If Mid$(strCrossword, i, 1) = " " Then
        Mid$(blanked, i, 1) = " "
    End If
Next i
GetBlacks = blanked
End Function

Private Function GetCrossWord() As String
Dim strCrossword As String
Dim i As Integer
For i = 0 To Text1.UBound
    If Text1(i) = "" Then
        strCrossword = strCrossword & Chr$(0)
    Else
        strCrossword = strCrossword & Text1(i)
    End If
Next i
GetCrossWord = strCrossword
End Function

Private Sub SetCrossWord(strCrossword As String)
Dim i As Integer
If Len(strCrossword) <> Text1.UBound + 1 Then
    MsgBox "The grid has an incorrect size!" & vbCrLf & _
           "The crossword cannot be loaded", vbCritical
    Exit Sub
End If
   
For i = 0 To Text1.UBound
'    If i = Len(strCrossword) Then Exit For
    Text1(i) = Mid$(strCrossword, i + 1, 1)
Next i
'For i = Len(strCrossword) To Text1.UBound
'    Text1(i) = ""
'Next i
End Sub

Private Sub SetBlacks(strCrossword As String)
SetCrossWord GetBlacks(strCrossword)
End Sub

Private Sub MoveRight(Index As Integer)
Dim NextIndex As Integer
If Index < Text1.UBound Then
    NextIndex = Index + 1
    Do While Text1(NextIndex).Enabled = False
        If NextIndex = Text1.UBound Then 'abort if last cell
            If Text1(NextIndex).Enabled Then Exit Do Else Exit Sub
        End If
        NextIndex = NextIndex + 1
    Loop
    Text1(NextIndex).SetFocus
End If
End Sub

Private Sub MoveLeft(Index As Integer)
Dim NextIndex As Integer
If Index > 0 Then
    NextIndex = Index - 1
    Do While Text1(NextIndex).Enabled = False
        If NextIndex = 0 Then 'abort if first cell
            If Text1(0).Enabled Then Exit Do Else Exit Sub
        End If
        NextIndex = NextIndex - 1
    Loop
    Text1(NextIndex).SetFocus
End If
End Sub

Private Sub MoveDown(Index As Integer)
Dim NextIndex As Integer
If Index \ Cols < Rows - 1 Then 'if cell down is not in last row
    NextIndex = Index + Cols
    Do While Text1(NextIndex).Enabled = False 'skip disabled black cells
        If NextIndex \ Cols = Rows - 1 Then 'abort if cell down is in last row
            If Text1(NextIndex).Enabled Then Exit Do Else Exit Sub
        End If
        NextIndex = NextIndex + Cols '1 row down
    Loop
    Text1(NextIndex).SetFocus
End If
End Sub

Private Sub MoveUp(Index As Integer)
Dim NextIndex As Integer
If Index >= Cols Then 'if cell up is not in first row
    NextIndex = Index - Cols
    Do While Text1(NextIndex).Enabled = False 'skip disabled black cells
        If NextIndex < Cols Then 'abort if cell up in first row
            If Text1(NextIndex).Enabled Then Exit Do Else Exit Sub
        End If
        NextIndex = NextIndex - Cols '1 row up
    Loop
    Text1(NextIndex).SetFocus
End If
End Sub

Private Sub OpenCrossword(FName As String, Optional EditMode As Boolean = False)
Dim i As Integer
Dim NewRows As Integer, NewCols As Integer
Dim strLine As String
On Error GoTo InvalidFile
Open FName For Input As #1
Input #1, NewCols, NewRows
Line Input #1, Solution
Text2 = ""
Do While Not EOF(1)
    Line Input #1, strLine
    Text2 = Text2 & IIf(Text2 <> "", vbCrLf, "") & strLine
Loop
Close #1
On Error GoTo 0
DrawGrid NewCols, NewRows
If Playmode Then
    SetBlacks Solution
    DisableBlacks
    Text2.Locked = True
Else
    SetCrossWord Solution
    EnableAllCells
    Text2.Locked = False
End If
Exit Sub
InvalidFile:
    Close #1
    MsgBox FName & " is no valid crossword file, or does not exist!", vbCritical
    Solution = ""
End Sub

Private Sub Form_Load()
Dim i As Integer
Me.ScaleMode = vbPixels
chkVertical.Caption = "Type vertical"
Text1(0).MaxLength = 1
DrawGrid 20, 20
End Sub

Private Sub mnuDone_Click()
Dim i As Integer
If GetCrossWord = Solution Then
    MsgBox "Congratulations! Everything's correct!", vbExclamation
Else
    If MsgBox("Try Again! Do you wanna clear the mistakes?", vbQuestion + vbYesNo) = vbYes Then
        For i = 1 To Len(Solution)
            If Text1(i - 1) <> Mid$(Solution, i, 1) Then
                Text1(i - 1) = ""
            End If
        Next i
    End If
End If
End Sub

Private Sub mnuEdit_Click()
Dim FName As String
FName = InputBox("Enter filename to open:")
If FName = "" Then Exit Sub
Playmode = False
OpenCrossword FName
End Sub

Private Sub mnuNew_Click()
Dim NewRows As Integer, NewCols As Integer
NewRows = Val(InputBox("Enter number of rows (horizontal):", , 20))
If NewRows = 0 Then Exit Sub
NewCols = Val(InputBox("Enter number of columns (vertical):", , 20))
If NewCols = 0 Then Exit Sub
DrawGrid NewRows, NewCols
EnableAllCells
Playmode = False
Text2.Locked = False
End Sub

Private Sub mnuPlay_Click()
Dim FName As String
FName = InputBox("Enter filename to open:")
If FName = "" Then Exit Sub
Playmode = True
OpenCrossword FName
End Sub

Private Sub mnuSave_Click()
Dim FName As String, i As Integer
FName = InputBox("Enter filename to save solved crossword:")
If FName = "" Then Exit Sub
Open FName For Output As #1
Write #1, Cols, Rows
Print #1, GetCrossWord
Print #1, Text2.Text
Close #1
End Sub

Private Sub Text1_Change(Index As Integer)
'Move right or down after typing a character:
If Len(Text1(Index)) = 1 Then
    If chkVertical = 0 Then
        MoveRight Index
    Else
        MoveDown Index
    End If
End If
'Use space to create black when designing a crossword
'(when in Play mode, space is neutralized in Text1_KeyPress):
If Text1(Index) = " " Then
    Text1(Index).BackColor = vbBlack
Else
    Text1(Index).BackColor = vbWhite
End If
End Sub

Private Sub Text1_GotFocus(Index As Integer)
Text1(Index).SelStart = 0: Text1(Index).SelLength = 1
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
'"UCase" every character
KeyAscii = Asc(UCase(Chr(KeyAscii)))
'when in play mode, use space for clearing
If Playmode And KeyAscii = Asc(" ") Then
    KeyAscii = 0 'neutralize to avoid blackening
    If Text1(Index) <> " " Then Text1(Index) = ""
    If chkVertical = 0 Then
        MoveRight Index
    Else
        MoveDown Index
    End If
End If
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case vbKeyLeft: MoveLeft Index
    Case vbKeyRight: MoveRight Index
    Case vbKeyUp: MoveUp Index
    Case vbKeyDown: MoveDown Index
End Select
End Sub
---
Have fun!
0
 

Author Comment

by:nw_khaemba
ID: 8245199
Vb tom thank you very much and may God bless you. This is a sure thing and I don't know what to say
0
 
LVL 3

Expert Comment

by:VBtom
ID: 8248697
Thanks.
This was funstuff, I liked it.
Glad I could help you.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month10 days, 18 hours left to enroll

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question