1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
| Private Size As Double 'Holds current matrix size
Private theMagic As magicdemo.magic 'magic object instance
Private Sub Form_Load()
'This function is called when the form is loaded.
'Creates a new magic class instance.
On Error GoTo Handle_Error
Set theMagic = New magicdemo.magic
Size = 0
Exit Sub
Handle_Error:
MsgBox (Err.Description)
End Sub
Private Sub btnCreate_Click()
'This function is called when the Create button is pressed.
'Calls the mymagic method, and displays the magic square.
Dim y As Variant
If Size <= 0 Or theMagic Is Nothing Then Exit Sub
On Error GoTo Handle_Error
Call theMagic.mymagic(1, y, Size)
Call ShowMatrix(y)
Exit Sub
Handle_Error:
MsgBox (Err.Description)
End Sub
Private Sub edtSize_Change()
'This function is called when ever the contents of the
'Text box change. Sets the current value of Size.
On Error Resume Next
Size = CDbl(edtSize.Text)
If Err <> 0 Then
Size = 0
End If
End Sub
Private Sub ShowMatrix(y As Variant)
'This function populates the ListView with the contents of
'y. y is assumed to contain a 2D array.
Dim n As Long
Dim i As Long
Dim j As Long
Dim nLen As Long
Dim Item As ListItem
On Error GoTo Handle_Error
'Get array size
If IsArray(y) Then
n = UBound(y, 1)
Else
n = 1
End If
'Set up Column headers
nLen = lstMagic.Width / 5
Call lstMagic.ListItems.Clear
Call lstMagic.ColumnHeaders.Clear
Call lstMagic.ColumnHeaders.Add(, , "", nLen, lvwColumnLeft)
For i = 1 To n
Call lstMagic.ColumnHeaders.Add(, , _
"Column " & Format(i), nLen, lvwColumnLeft)
Next
'Add array contents
If IsArray(y) Then
For i = 1 To n
Set Item = lstMagic.ListItems.Add(, , "Row " & Format(i))
For j = 1 To n
Call Item.ListSubItems.Add(, , Format(y(i, j)))
Next
Next
Else
Set Item = lstMagic.ListItems.Add(, , "Row 1")
Call Item.ListSubItems.Add(, , Format(y))
End If
Exit Sub
Handle_Error:
MsgBox (Err.Description)
End Sub |
Partager