' Reads data Base, Essential Different Only, V ZigZag Two Way
' Tested with Office 2007 under Windows 7
' Reads Data Base, Check Properties of Transformations (192 ea)
' V ZigZag Four Way
' Tested with Office 2007 under Windows Vista
Sub ReadDb8z4(fl8)
Dim MyDB As Database, MyWorkSpace As Workspace
Dim Td1 As Recordset
Dim a(64), b8(64), s(100)
' b8() Record BiMagic Essential Different
' a() Corresponding Transformations (192)
' fl8 Format Flag fl8 = 1 Line Format
' fl8 = 0 Square Format
' s() Scratch Area Magic Sum: Pan Diagonals, Pairs, etc
If fl8 = 1 Then
Cells(n9 + 1, 65).Select
Else
Cells(k1 + 1, 1).Select
End If
n2 = 0: n9 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
f1 = "C:\Users\Jos\Devellopments\Vierkanten\Bimagic\Trump8\Bimagic8.mdb"
f2 = "Bimagic8": f3 = "TrInd8"
k1 = 1: k2 = 1
' Open the database and input table
Set MyWorkSpace = DBEngine.Workspaces(0)
Set MyDB = MyWorkSpace.OpenDatabase(f1)
Set Td1 = MyDB.OpenRecordset(f2, dbOpenTable)
Set Td2 = MyDB.OpenRecordset(f3, dbOpenTable)
Td1.MoveFirst
Do Until Td1.EOF
n10 = n10 + 1
If fl8 = 1 Then
Cells(n9 + 1, 65).Value = n10
Else
Cells(k1 + 1, 1).Value = n10
End If
' Read Record (BiMagic Square)
For j1 = 1 To 64
FldName = "Veld" + CStr(j1)
t1 = Td1.Fields(FldName)
b8(j1) = t1
Next j1
Td2.MoveFirst
Do Until Td2.EOF
' Read Record (Index Transformations)
For j2 = 1 To 64
FldName = "Veld" + CStr(j2)
t1 = Td2.Fields(FldName)
a(j2) = b8(CInt(t1))
Next j2
Td2.MoveNext
' Check Criteria a()
GoSub 300: GoSub 500 'V Zig Zag Four Way
If fl1 = 0 Then GoTo 200
' Meets Criterium: Print Results
n9 = n9 + 1
If fl8 = 1 Then
GoSub 645 'Print results (selected numbers)
Else
GoSub 650 'Print results (squares)
End If
200
Loop
100 Td1.MoveNext
Loop
y = MsgBox("Records: " + CStr(n9), vbInformation, "ReadDb8h")
MyDB.Close
End
' Print results (selected numbers)
645 For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 65).Select
Cells(n9, 65).Value = n9
Return
' Print results (squares)
650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 9: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 9
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
Cells(k1, k2 + 2).Font.Color = -4165632
Cells(k1, k2 + 2).Value = "R" + CStr(n10)
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Collect Criteria
' V Zig Zag Four Way
300 n4 = 16: s2 = 260
s(1) = a(1) + a(10) + a(3) + a(12) + a(5) + a(14) + a(7) + a(16)
s(2) = a(9) + a(18) + a(11) + a(20) + a(13) + a(22) + a(15) + a(24)
s(3) = a(17) + a(26) + a(19) + a(28) + a(21) + a(30) + a(23) + a(32)
s(4) = a(25) + a(34) + a(27) + a(36) + a(29) + a(38) + a(31) + a(40)
s(5) = a(33) + a(42) + a(35) + a(44) + a(37) + a(46) + a(39) + a(48)
s(6) = a(41) + a(50) + a(43) + a(52) + a(45) + a(54) + a(47) + a(56)
s(7) = a(49) + a(58) + a(51) + a(60) + a(53) + a(62) + a(55) + a(64)
s(8) = a(57) + a(2) + a(59) + a(4) + a(61) + a(6) + a(63) + a(8)
s(9) = a(1) + a(10) + a(17) + a(26) + a(33) + a(42) + a(49) + a(58)
s(10) = a(2) + a(11) + a(18) + a(27) + a(34) + a(43) + a(50) + a(59)
s(11) = a(3) + a(12) + a(19) + a(28) + a(35) + a(44) + a(51) + a(60)
s(12) = a(4) + a(13) + a(20) + a(29) + a(36) + a(45) + a(52) + a(61)
s(13) = a(5) + a(14) + a(21) + a(30) + a(37) + a(46) + a(53) + a(62)
s(14) = a(6) + a(15) + a(22) + a(31) + a(38) + a(47) + a(54) + a(63)
s(15) = a(7) + a(16) + a(23) + a(32) + a(39) + a(48) + a(55) + a(64)
s(16) = a(8) + a(9) + a(24) + a(25) + a(40) + a(41) + a(56) + a(57)
Return
' Check V Zig Zag Four Way
500 fl1 = 1
For i1 = 1 To n4
If s(i1) <> s2 Then fl1 = 0: Return
Next i1
Return
End Sub
