Re: Newbie problem: Long list of user choices


If your questions are yes/no type, try this:

- Add one picturebox to the form and name it "pixcontainer".
- Draw a second picturebox **inside** pixcontainer, and leave its name as
'picture1'. You know you've done this correctly when you can't move picture
1 outside the boundaries of pixcontainer. If you can, you've drawn it on the
form ... select it, cut it, click on pixcontainer, and paste.
- add a verticle scrollbar to the form. Leave the name 'vscroll1'.

Watching for line wraps, past the following into the form's general
declarations area:

'Larry Serflaten <serflaten@xxxxxxxxxxxxxx>
'microsoft.public.vb.general.discussion

' Adjustable
Private Const COLCELLS = 2 'Number of Columns
Private Const ANSWERCOL As Long = 1 'column showing checks for answers
Private Const CheckCellTwips = 240 'Cell size in twips (min ~150) 300=20
pixels
Private TextCellTwips

'UDT's holding row/column array
Private Type DataRow
Rows() As Byte
End Type

Private Type DataCol
Cols() As DataRow
End Type

'form-level variables
Private Data As DataCol 'the array of cells to create
Private CellSize As Long 'working var containing the cell size value
Private ColCount As Long 'working var containing COLCELLS
Private RowCount As Long 'working var containing ROWCELLS
Private MouseCount As Long 'tracks mouse activity
Private Const CELLCHAR As String = "a" 'character selected for cell checks
'if "r" shows an X instead of a check

Private sQuestions() As String


Private Sub Form_DblClick()

Dim dy As Long

For dy = 1 To RowCount
If Data.Cols(ANSWERCOL).Rows(dy) <> 0 Then
Debug.Print "YES", sQuestions(dy - 1)
End If
Next 'dy


End Sub

Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.Value
End Sub


Private Sub VScroll1_Scroll()
Picture1.Top = -VScroll1.Value
End Sub

Private Function GetLongestQLength() As Long

Dim cnt As Long
Dim buff As Long
Dim maxbuff As Long

For cnt = LBound(sQuestions) To UBound(sQuestions)

buff = Picture1.TextWidth(sQuestions(cnt))
If buff > maxbuff Then maxbuff = buff

Next

GetLongestQLength = maxbuff + 250

End Function

Private Sub LoadQuestionsToArray()

Dim hfile As Long
Dim buff As String

hfile = FreeFile

Open "d:\ynquestions.txt" For Input As #hfile
buff = Input$(LOF(hfile), hfile)
Close

sQuestions() = Split(buff, vbNewLine)

End Sub

Private Sub Form_Load()

'because the control width is based on
'the size of the longest question, load
'those first
Call LoadQuestionsToArray

'Set up Picture
With Picture1

.ScaleMode = vbTwips
.Font.Name = "Trebuchet ms"
.Font.Size = 10

'Dynamic adjustments
'this is the longest question
TextCellTwips = GetLongestQLength()
RowCount = (UBound(sQuestions) - LBound(sQuestions)) + 1
ColCount = COLCELLS
CellSize = CheckCellTwips

.BorderStyle = 0
.Move 0, 0, (CellSize + TextCellTwips), CellSize * (RowCount + 2)
.BackColor = vbWhite
.AutoRedraw = True
End With

With pixContainer
.Move 200, 200, Picture1.Width + 60, 4000
End With

With Me
.Move 200, 200, pixContainer.Width + VScroll1.Width + 400,
pixContainer.Height + (pixContainer.Top * 4)
End With

With VScroll1
.Width = 255
.Max = (Picture1.ScaleHeight - pixContainer.ScaleHeight)
.LargeChange = .Max
.SmallChange = .Max \ 10
.Enabled = (pixContainer.ScaleHeight <= Picture1.ScaleHeight)
.ZOrder 0
.Move Me.ScaleWidth - .Width, 200, 255, pixContainer.Height
End With

'Set up data and
'draw new image
Call BuildArray
Call DrawDisplay

End Sub

Private Sub BuildArray()

Dim cnt As Long

ReDim Data.Cols(1 To ColCount)

For cnt = 1 To ColCount
ReDim Data.Cols(cnt).Rows(1 To RowCount)
Next cnt

End Sub


Private Sub DrawDisplay()

Dim r As Long
Dim c As Long

'note: VB's Line method does not work
'when used with a With statement, so
'specific reference to Picture1 are
'required on all Line method calls
With Picture1

'set font for row/col headings
.Font.Name = "Trebuchet MS"
.Font.Size = 1 + ((CellSize \ 120) * 4)

'draw Col lines
r = RowCount * CellSize
For c = 1 To ColCount
Picture1.Line (c * CellSize, CellSize)-Step(0, r), &HC0C0C0
Next

'draw Row lines
c = (CellSize + TextCellTwips)
For r = 1 To RowCount
Picture1.Line (CellSize, r * CellSize)-Step(c, 0), &HDDDDDD
CenterCellText CStr(r), CellSize \ 2, r
DrawQuestionCellText sQuestions(r - 1), 0, r
Next

'line below last question
Picture1.Line (CellSize, r * CellSize)-Step(c, 0), &HDDDDDD

'black border around answer box
Picture1.Line (CellSize, CellSize)-Step(CellSize, RowCount *
CellSize), vbBlack, B

'set font for to display checkmarks
.Font.Name = "Marlett"
.Font.Size = 1 + ((CellSize \ 120) * 5)
.Font.Bold = False

End With

End Sub



Private Sub DrawCellColor(ByVal X As Long, ByVal Y As Long, K As Long)

Picture1.Line (X * CellSize + Screen.TwipsPerPixelX, _
Y * CellSize + Screen.TwipsPerPixelY)-Step(CellSize -
Screen.TwipsPerPixelX * 3, _
CellSize - Screen.TwipsPerPixelY * 3), K, BF

End Sub


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)

Dim dx As Long
Dim dy As Long

dx = X \ CheckCellTwips
dy = Y \ CheckCellTwips

'bail if out of bounds
If (MouseCount > 2) Or _
(dx < 0) Or (dx > ANSWERCOL + 1) Or (dy < 0) Or (dy > RowCount) Then
Exit Sub
Else
'ensure next MouseMove will be out of bounds
MouseCount = 3
End If

If (dx = ANSWERCOL) Then

FillCell ANSWERCOL, dy, True

End If

MouseCount = 0

End Sub


Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)

' Static px As Long, py As Long
' Dim dx As Long, dy As Long 'Dynamic X & Y
'
' MouseCount = MouseCount + 1
'
' If Button = vbLeftButton Then
'
' 'Limit to one change per cell while dragging
' dx = X \ CellSize
' dy = Y \ CellSize
' If (px <> dx) Or (py <> dy) Then
'
' px = dx
' py = dy
' MouseCount = 0
' Picture1_MouseUp Button, Shift, X, Y
'
' End If 'If px <> dx
' End If 'If Button

End Sub


Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)

' Dim dx As Long
' Dim dy As Long
' Dim answercol As Long
'
' answercol = 1
'
' dx = X \ CellSize
' dy = Y \ CellSize
'
' 'bail if out of bounds
' If (MouseCount > 2) Or _
' (dx < 0) Or (dx > answercol) Or (dy < 0) Or (dy > RowCount) Then
' Exit Sub
' Else
' 'ensure next MouseMove will be out of bounds
' MouseCount = 3
' End If
'
' If (dx = 0 And dy > 0) Then
'
' 'toggle Row dy (based on nearest cell)
' FillCell 1, dy, True
' For dx = 2 To answercol
' Data.Cols(dx).Rows(dy) = Data.Cols(1).Rows(dy)
' FillCell dx, dy
' Next
'
' ElseIf (dy = 0 And dx > 0) Then
'
' 'toggle Col dx (based on nearest cell)
' FillCell dx, 1, True
' For dy = 2 To RowCount
' Data.Cols(dx).Rows(dy) = Data.Cols(dx).Rows(1)
' FillCell dx, dy
' Next
'
' ElseIf dx Or dy Then
'
' 'toggle Cell
' FillCell dx, dy, True
'
' End If

End Sub


Private Sub FillCell(ByVal X As Long, ByVal Y As Long, Optional Toggle As
Boolean = False)

Dim tgl As Byte

tgl = Data.Cols(X).Rows(Y)

If Toggle Then
tgl = tgl Xor 255
Data.Cols(X).Rows(Y) = tgl
End If

DrawCellColor 1, Y, vbWhite

If tgl Then CenterCellText CELLCHAR, X, Y

End Sub

Private Sub CenterCellText(sText As String, X As Long, Y As Long)

'Determine the x and y print position
'for the character. Because TextWidth()
'uses an actual character ("a", "b", "c" etc.)
'to determine x/y, but the Marlett font writes
'a different character, adding 4 to the
'calculations more closely centres the
'text within each cell.

'Determine the x and y print position for the character.
With Picture1
.CurrentX = (X * CellSize) + ((CellSize - .TextWidth(sText)) \ 2) +
Screen.TwipsPerPixelX
.CurrentY = (Y * CellSize) + ((CellSize - .TextHeight(sText)) \ 2) +
Screen.TwipsPerPixelY
End With
Picture1.Print sText

End Sub


Private Sub DrawQuestionCellText(sText As String, X As Long, Y As Long)

With Picture1
.CurrentX = 600
.CurrentY = (Y * CellSize) + ((CellSize - .TextHeight(sText)) \ 2) +
Screen.TwipsPerPixelY
End With

Picture1.Print sText

End Sub



Once selections have been made, double-click any area of the form to see the
selected items printed out in the immediate window. The values of the
selected items are represented by the dy parameter in the click routine
code.


Here are the strings (questions) I used for testing, saved to the file
"d:\ynquestions.txt". Change this path in the LoadQuestionsToArray routine
as appropriate (again, watch for line wrapping - only one question per
line!):

FIRST: Have you worked a compressed schedule previously?
Do you anticipate any difficulty in adjusting to a compressed work schedule?
Did you take up to time to read through the facts more than once?
Did you use a checklist or outline to help spot issues?
Did you make an event line, note the parties, list the issues?
Did you develop a plan or organization for the way you would write the
answer?
Did you use headings to help yourself stay focused on the issues and
parties?
Does the answer follow the form or role called for in the question?
Is this answer responsive to the question your professor asked?
Does the answer respond to all parts of the question?
Does the answer link legal principles to the facts that call for these
theories?
Does the analysis include all logical steps to a conclusion?
Does the answer explore more than one possible way to think of this
situation?
Are the facts examined from the perspectives of all parties?
The answer to the question has a logical sequence of analysis.
The answer follows the chronology of the hypothetical, or another sequence
suggested by the question.
The organization of the analysis of each issue follows IRAC or another
organizing pattern taught by your professor.
The answer applies the course content accurately.
Choice of legal principle is relevant to the professor's question?
Legal terminology is used appropriately?
Policy issues are discussed as needed?
LAST: My outline helps me analyze problems?


You will get a scrollable form that looks something like the attached image
that will display all your questions with only the overhead of one
picturebox control. This code is based on a demo on my site, if you want
further info see http://vbnet.mvps.org/code/intrinsic/matrixcheck.htm.


--

Randy Birch
MS MVP Visual Basic
http://vbnet.mvps.org/
----------------------------------------------------------------------------
Read. Decide. Sign the petition to Microsoft.
http://classicvb.org/petition/
----------------------------------------------------------------------------



"SmilingPolitely" <treatmentplant@xxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:438040d4$0$30804$5a62ac22@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
:I would like to write an application where I can prompt the user to
: complete a form, that has potentially hundreds of questions. The
: questions are stored in a flat-file with a specific format:
:
: xxx|Text Question 1
: xxx|Text Question 2
: xxx|Text Question 3
:
: where the xxx is a special identifier for the question. The user is
: presented with a checkbox next to the text question and simply has to
: check the box or leave it blank.
:
: I could create a series of forms with say, 10 questions on each form,
: then have the user answer the 10 questions, then click a button to move
: onto the next page of questions.
:
: BUT
:
: I the list of questions is dynamic in length, so I would prefer the user
: to be presented with a single form containing a scrollable control on
: the form, that would contain the checkboxes and questions retrieved from
: the flat-file.
:
: In MS Access I could have a subform in a mainform, but I want this
: application to standalone from MS Office. I started writing this idea as
: a web-page (html) with javascript, but thought there must be a better
: way in VB6?
:
: My question: What control do I use?
:
: Any help is greatly appreciated.

.

Loading