VERSION 2.00
Begin Form frmMapMain
BackColor = &H00000000&
BorderStyle = 3 'Fixed Double
Caption = "State Selection"
ClientHeight = 5130
ClientLeft = 60
ClientTop = 345
ClientWidth = 9495
ControlBox = 0 'False
Height = 5535
Icon = MAPMAIN.FRX:0000
Left = 0
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5130
ScaleWidth = 9495
Top = 0
Width = 9615
Begin PictureBox picBackup
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ClipControls = 0 'False
FillColor = &H00808080&
FillStyle = 0 'Solid
ForeColor = &H00C0C0C0&
Height = 4470
Left = 1830
Picture = MAPMAIN.FRX:0302
ScaleHeight = 298
ScaleMode = 3 'Pixel
ScaleWidth = 516
TabIndex = 10
TabStop = 0 'False
Top = 5505
Width = 7740
End
Begin PictureBox picHidden
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ClipControls = 0 'False
FillColor = &H00808080&
FillStyle = 0 'Solid
ForeColor = &H00C0C0C0&
Height = 4470
Left = 90
Picture = MAPMAIN.FRX:13224
ScaleHeight = 298
ScaleMode = 3 'Pixel
ScaleWidth = 516
TabIndex = 8
TabStop = 0 'False
Top = 5475
Width = 7740
End
Begin SSPanel pnlMisc
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
Font3D = 0 'None
Height = 5100
Index = 1
Left = 7635
Outline = -1 'True
RoundedCorners = 0 'False
TabIndex = 2
Top = 15
Width = 1845
Begin ListBox lstStates
BackColor = &H00C0C0C0&
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 4905
Left = 90
MultiSelect = 1 'Simple
TabIndex = 0
Top = 90
Width = 1650
End
End
Begin SSPanel pnlMisc
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
Font3D = 0 'None
Height = 5100
Index = 0
Left = 15
Outline = -1 'True
RoundedCorners = 0 'False
TabIndex = 1
Top = 15
Width = 7635
Begin SSCommand cmdTagAll
BevelWidth = 1
Caption = "&Tag All"
Font3D = 3 'Inset w/light shading
Height = 570
Left = 90
RoundedCorners = 0 'False
TabIndex = 7
Top = 4440
Width = 1875
End
Begin SSCommand cmdUnTagAll
BevelWidth = 1
Caption = "&UnTag All"
Font3D = 3 'Inset w/light shading
Height = 570
Left = 1950
RoundedCorners = 0 'False
TabIndex = 6
Top = 4440
Width = 1875
End
Begin SSCommand cmdCancel
BevelWidth = 1
Caption = "&Cancel"
Font3D = 3 'Inset w/light shading
Height = 570
Left = 5655
RoundedCorners = 0 'False
TabIndex = 5
Top = 4440
Width = 1875
End
Begin SSCommand cmdOK
BevelWidth = 1
Caption = "&OK"
Font3D = 3 'Inset w/light shading
Height = 570
Left = 3810
RoundedCorners = 0 'False
TabIndex = 4
Top = 4440
Width = 1860
End
Begin PictureBox picUSAOuter
Height = 4365
Left = 90
ScaleHeight = 289
ScaleMode = 3 'Pixel
ScaleWidth = 494
TabIndex = 3
TabStop = 0 'False
Top = 90
Width = 7440
Begin PictureBox picShown
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ClipControls = 0 'False
FillColor = &H00808080&
FillStyle = 0 'Solid
ForeColor = &H00C0C0C0&
Height = 4470
Left = -195
Picture = MAPMAIN.FRX:26146
ScaleHeight = 298
ScaleMode = 3 'Pixel
ScaleWidth = 516
TabIndex = 9
TabStop = 0 'False
Top = -135
Width = 7740
End
End
End
End
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
Option Explicit
Sub ClearState ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine clear the state that was clicked by the mouse.
'===========================================================================
Dim i%
UpdateThe HIDDEN_MAP, BACKUP_MAP
PaintSpot
lstStates.Selected((MapStateClicked())) = False
PaintShownMapFromList
End Sub
Sub cmdCancel_Click ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
Unload Me
End Sub
Sub cmdTagAll_Click ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine tags all states as if all of them were clicked.
'===========================================================================
Dim i%
lstStates.Visible = False
gbMassUpdate = True
For i% = 0 To lstStates.ListCount - 1
lstStates.Selected(i) = True
Next i
gbMassUpdate = False
lstStates.Visible = True
PaintShownMapFromList
End Sub
Sub cmdUnTagAll_Click ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine UnTags all states as if all states were clicked.
'===========================================================================
Dim i%
lstStates.Visible = False
gbMassUpdate = True
For i% = 0 To lstStates.ListCount - 1
lstStates.Selected(i) = False
Next i
gbMassUpdate = False
lstStates.Visible = True
UpdateThe SHOWN_MAP, BACKUP_MAP
picShown.Refresh
End Sub
Sub Form_Load ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine loads the listbox with the array data from Sub Main().
'===========================================================================
Dim i%
For i = 0 To 50
lstStates.AddItem gsStateName(i)
Next i
End Sub
Sub lstStates_Click ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'Besides clicking a state on the picture box, the listbox is also a way to
'select a state. This routine handles painting a state from the listbox.
'===========================================================================
If gbMassUpdate Then Exit Sub
UpdateThe HIDDEN_MAP, BACKUP_MAP
PaintShownMapFromList
End Sub
Function MapStateClicked% ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine determines the array location of the selected state.
'===========================================================================
Dim i%
For i = 0 To 60
If GetPixel(picHidden.hDC, giaX(i), giaY(i)) = DARK_GRAY Then Exit For
Next i
Select Case i
Case 1, 51 To 54 'Alaska and Aleutians
i = 1
Case 7, 55 'Washington, D.C.
i = 7
Case 11, 56 To 59 'Hawaii and Islands
i = 11
Case 22, 60 'Michigan
i = 22
End Select
MapStateClicked = i
End Function
Sub PaintShownMapFromList ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine paints the shown map according to the selected item(s) in the
'listbox.
'===========================================================================
Dim i%
UpdateThe HIDDEN_MAP, BACKUP_MAP 'BitBlt from picBackup to picHidden
For i = 0 To lstStates.ListCount - 1
If lstStates.Selected(i) Then
Select Case i
Case 1, 51 To 54 'Alaska and Aleutians
giX = 79: giY = 247: PaintSpot
giX = 47: giY = 273: PaintSpot
giX = 41: giY = 273: PaintSpot
giX = 35: giY = 270: PaintSpot
giX = 29: giY = 268: PaintSpot
Case 7, 55 'Washington, D.C.
giX = 484: giY = 143: PaintSpot
giX = 479: giY = 146: PaintSpot
Case 11, 56 To 59 'Hawaii and Islands
giX = 146: giY = 280: PaintSpot
giX = 139: giY = 274: PaintSpot
giX = 132: giY = 270: PaintSpot
giX = 124: giY = 266: PaintSpot
giX = 115: giY = 268: PaintSpot
Case 22, 60 'Michigan
giX = 361: giY = 86: PaintSpot
giX = 339: giY = 59: PaintSpot
Case Else 'All other states
giX = giaX(i): giY = giaY(i): PaintSpot
End Select
End If
Next i
UpdateThe SHOWN_MAP, HIDDEN_MAP 'BitBlt from picHidden to picShown
picShown.Refresh
End Sub
Sub PaintSpot ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine paints the clicked spot - but on the hidden map - dark gray
'allowing detection by the MapStateClicked() function later.
'===========================================================================
Dim iRet%, lStopColor&, iFillType%
lStopColor = RGB(0, 0, 0)
iFillType = 0
picHidden.FillColor = &H808080
iRet = ExtFloodFill(picHidden.hDC, giX, giY, lStopColor, iFillType)
End Sub
Sub PaintState ()
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine ensures that all separated pieces of a state (ie Hawaii, etc.)
'are painted when the state is painted.
'===========================================================================
Dim i%
gbMassUpdate = True
UpdateThe HIDDEN_MAP, BACKUP_MAP
PaintSpot
i = MapStateClicked()
If lstStates.MultiSelect > 0 Then
UpdateThe HIDDEN_MAP, SHOWN_MAP
End If
Select Case i
Case 1, 51 To 54 'Alaska and Aleutians
giX = 79: giY = 247: PaintSpot
giX = 47: giY = 273: PaintSpot
giX = 41: giY = 273: PaintSpot
giX = 35: giY = 270: PaintSpot
giX = 29: giY = 268: PaintSpot
Case 7, 55 'Washington, D.C.
giX = 484: giY = 143: PaintSpot
giX = 479: giY = 146: PaintSpot
Case 11, 56 To 59 'Hawaii and Islands
giX = 146: giY = 280: PaintSpot
giX = 139: giY = 274: PaintSpot
giX = 132: giY = 270: PaintSpot
giX = 124: giY = 266: PaintSpot
giX = 115: giY = 268: PaintSpot
Case 22, 60 'Michigan
giX = 361: giY = 86: PaintSpot
giX = 339: giY = 59: PaintSpot
Case Else 'All other states
giX = giaX(i): giY = giaY(i): PaintSpot
End Select
lstStates.Selected(i) = True
gbMassUpdate = False
UpdateThe SHOWN_MAP, HIDDEN_MAP 'BitBlt from picHidden to picShown
picShown.Refresh
End Sub
Sub picHidden_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine receives the mouse click on the SHOWN picture box and then
'processes it accordingly.
'===========================================================================
Dim i%, lStopColor&, iFillType%, iRet%, iLi%, iX%, iY%
iX = CInt(X)
iY = CInt(Y)
giX = iX
giY = iY
Select Case GetPixel(picHidden.hDC, iX, iY)
Case LITE_GRAY
PaintState
Case DARK_GRAY
ClearState
End Select
End Sub
Sub picShown_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine passes the mouse click to the HIDDEN picture MouseDown event.
'===========================================================================
picHidden_MouseDown Button, Shift, X, Y
End Sub
Sub UpdateThe (iDest%, iSrc%)
'===========================================================================
'3DMAP 1.0
'Copyright (C) 1994 by Kerry B. Rogers
'All Rights Reserved
'===========================================================================
'This routine dynamically copies the bitmaps of the 3 picture boxes around
'as needed based on the incoming destination and source integers.
'===========================================================================
Dim hDestDC%, iDestX%, iDestY%, iWidth%, iHeight%
Dim hSrcDC%, iXSrc%, iYSrc%, lRasterOp&, iRet%
Select Case iDest
Case 0: hDestDC = picShown.hDC
Case 1: hDestDC = picHidden.hDC
Case 2: hDestDC = picBackup.hDC
End Select
iDestX = 0
iDestY = 0
iWidth = picShown.ScaleWidth
iHeight = picShown.ScaleHeight
' Assign information of the source bitmap.
Select Case iSrc
Case 0: hSrcDC = picShown.hDC
Case 1: hSrcDC = picHidden.hDC
Case 2: hSrcDC = picBackup.hDC
End Select
iXSrc = 0
iYSrc = 0
' Assign the SRCCOPY constant to the Raster operation.
lRasterOp = &HCC0020
iRet = BitBlt(hDestDC, iDestX, iDestY, iWidth, iHeight, hSrcDC, iXSrc, iYSrc, lRasterOp)
End Sub
