-
Notifications
You must be signed in to change notification settings - Fork 4
/
showArray.vb
188 lines (159 loc) · 9.45 KB
/
showArray.vb
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
'
'
' showArray.vb This code is licenced under "Creative Commons Attribution Non Commercial 4.0 International"
' See: https://creativecommons.org/licenses/by-nc/4.0/legalcode
'
' This file implements showing card arrays for WinInnovation on the showArray winform
' Conditional compile directives
#Const VERBOSE = True ' FK adding debugging Frame work via c compiler like if defs should be DEBUG but not sure about interference
Option Strict Off
Option Explicit On
' Compiler/Build directives
#Disable Warning IDE1006 'Inherited code with variable names this suppresses: These words must begin with upper case characters
#Disable Warning IDE0054 'Inherited code with assignments (60) this suppresses: Use compound assignment x += 5 vs x = x + 5
#Disable Warning BC40000 'VB compatibility
Friend Class showArray
Inherits System.Windows.Forms.Form
Private Sub showArray_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Call initialize_images()
Call Me.SetBounds(VB6.TwipsToPixelsX(12500), VB6.TwipsToPixelsY(4500), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
End Sub
Private Sub initialize_images()
' initialize the hand images
Dim i As Short
Static Dim initialized As Boolean = False
If initialized Then
Return
End If
For i = 0 To 40
If i > imgShowIcon.UBound Then
lblShowTitle.Load(i)
imgShowIcon.Load(i)
imgShowColor.Load(i)
End If
imgShowIcon(i).Visible = False
imgShowColor(i).Visible = False
lblShowTitle(i).Visible = False
imgShowIcon(i).SetBounds(imgShowIcon(0).Left, VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(imgShowIcon(0).Top) + 360 * i), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
imgShowColor(i).SetBounds(imgShowColor(0).Left, VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(imgShowColor(0).Top) + 360 * i), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
lblShowTitle(i).SetBounds(lblShowTitle(0).Left, VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(lblShowTitle(0).Top) + 360 * i), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
If i > 19 Then
imgShowIcon(i).SetBounds(VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(imgShowIcon(0).Left) + 2000), VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(imgShowIcon(0).Top) + 360 * (i - 20)), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
imgShowColor(i).SetBounds(VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(imgShowColor(0).Left) + 2000), VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(imgShowColor(0).Top) + 360 * (i - 20)), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
lblShowTitle(i).SetBounds(VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(lblShowTitle(0).Left) + 2000), VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(lblShowTitle(0).Top) + 360 * (i - 20)), 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
End If
imgShowColor(i).SendToBack()
imgShowColor(i).Tag = -1
imgShowIcon(i).Tag = -1
lblShowTitle(i).Tag = -1
Next i
initialized = True
End Sub
Public Sub load_pictures(ByVal player As Short, ByVal Index As Short, ByVal kind As String)
Dim i, id As Object
Dim max_size As Short
initialize_images()
If kind = "board" Then
'UPGRADE_WARNING: Couldn't resolve default property of object size3(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
max_size = size3(board, player, Index) - 1
Me.Tag = Index
Else
'UPGRADE_WARNING: Couldn't resolve default property of object size2(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
max_size = size2(score_pile, player) - 1
Me.Tag = 1000
#If VERBOSE Then
Call Main_Renamed.append_simple("In load_pictures() Piles")
#End If
End If
For i = 0 To max_size
If kind = "board" Then
id = board(player, Index, i)
Else
id = score_pile(player, i)
End If
lblShowTitle(i).Text = age(id) & "-" & title(id)
lblShowTitle(i).Tag = id
lblShowTitle(i).Visible = True
lblShowTitle(i).BackColor = Main_Renamed.background_colors(color_lookup(color(id)))
Call Main_Renamed.set_icon_image(imgShowIcon(i), id, dogma_icon(id))
Call Main_Renamed.set_color_image(imgShowColor(i), id, color(id))
Next i
Me.Controls.Clear()
For i = 0 To max_size
imgShowIcon(i).Visible = True
'imgShowColor(i).Visible = True
lblShowTitle(i).Visible = True
Me.Controls.Add(imgShowIcon(i))
Me.Controls.Add(imgShowColor(i))
Me.Controls.Add(lblShowTitle(i))
Next i
For i = max_size + 1 To imgShowIcon.UBound
imgShowIcon(i).Visible = False
imgShowColor(i).Visible = False
lblShowTitle(i).Visible = False
Next i
Me.Visible = True
End Sub
Private Sub lblShowTitle_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles lblShowTitle.MouseMove
Dim Button As Short = eventArgs.Button \ &H100000
Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
Dim Index As Short = lblShowTitle.GetIndex(eventSender)
Call Main_Renamed.imgMouseMove(lblShowTitle(Index), Button, Shift, X, Y)
End Sub
Private Sub imgShowColor_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles imgShowColor.MouseMove
Dim Button As Short = eventArgs.Button \ &H100000
Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
Dim Index As Short = imgShowColor.GetIndex(eventSender)
Call Main_Renamed.imgMouseMove(imgShowColor(Index), Button, Shift, X, Y)
End Sub
Private Sub imgShowIcon_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles imgShowIcon.MouseMove
Dim Button As Short = eventArgs.Button \ &H100000
Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
Dim Index As Short = imgShowIcon.GetIndex(eventSender)
Call Main_Renamed.imgMouseMove(imgShowIcon(Index), Button, Shift, X, Y)
End Sub
'
' weird VB problem can't add cancel button or the form being full makes a control array that is invalid
' Private Sub Button1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Button1.Click
'Me.Dispose()
'End Sub
Private Sub lblShowTitle_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lblShowTitle.Click
Dim Index As Short = lblShowTitle.GetIndex(eventSender)
Call process_click(Index)
End Sub
Private Sub imgShowColor_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles imgShowColor.Click
Dim Index As Short = imgShowColor.GetIndex(eventSender)
Call process_click(Index)
End Sub
Private Sub imgShowIcon_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles imgShowIcon.Click
Dim Index As Short = imgShowIcon.GetIndex(eventSender)
Call process_click(Index)
End Sub
Private Sub process_click(ByVal Index As Short)
If phase = "publications" Then
imgShowIcon(Index).Visible = False
imgShowColor(Index).Visible = False
lblShowTitle(Index).Visible = False
human_data = human_data + 1
'MsgBox "Comparing " & human_data & " to " & size3(board, 0, showArray.Tag) & " tag=" & showArray.Tag
'MsgBox "setting " & size3(board, 0, showArray.Tag) - human_data & " to " & title(imgShowIcon(index).Tag)
'UPGRADE_WARNING: Couldn't resolve default property of object size3(board, 0, showArray.Tag). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
board(0, CInt(Me.Tag), size3(board, 0, CShort(Me.Tag)) - human_data) = CShort(imgShowIcon(Index).Tag)
'UPGRADE_WARNING: Couldn't resolve default property of object size3(board, 0, showArray.Tag). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
If human_data = size3(board, 0, CShort(Me.Tag)) Then
'UPGRADE_WARNING: Untranslated statement in process_click. Please check source code.
Call Main_Renamed.update_display()
Me.Close()
End If
ElseIf CDbl(Me.Tag) = 1000 Then
Call Main_Renamed.process_score_pile_click(Index)
Me.Close()
End If
End Sub
End Class