Private Sub BoNextTile_Click()
If TileView = NbOfTile Then TileView = 0
TileView = TileView + 1
TileSelectionSub
End Sub
Private Sub BoPrevTile_Click()
If TileView = 1 Then TileView = (NbOfTile + 1)
TileView = TileView - 1
TileSelectionSub
End Sub
Private Sub TileSelectionSub()
SelectionTile.Picture = LoadPicture(App.Path & "/tiles/" & TypeOfTerrain & "/" & TileView & ".bmp")
LaTileInfo.Caption = "Type :" & TypeOfTerrain & " Tile #: " & TileView
SelectionTile.Left = (PicSelectTile.Width - SelectionTile.Width) / 2
SelectionTile.Top = (PicSelectTile.Height - SelectionTile.Height) / 2
SelectiontileCase.Width = SelectionTile.Width
SelectiontileCase.Height = SelectionTile.Height
SelectiontileCase.Top = SelectionTile.Top
SelectiontileCase.Left = SelectionTile.Left
End Sub
Private Sub Form_Activate()
If LoadingNew = True Then
Largeur = Int(Map.Width / ImMapTile(0).Width)
Hauteur = Int(Map.Height / ImMapTile(0).Height)
RadarTile(0).Width = Int((ImMapTile(0).Width / Map.Width) * Radar.Width)
RadarTile(0).Height = Int((ImMapTile(0).Height / Map.Height) * Radar.Height)
LoadingTest = Largeur * Hauteur
NbTile = 0
For l = 0 To Largeur
For h = 0 To Hauteur
Randomize
GrassTile = Int((16 * Rnd) + 1)
NbTile = NbTile + 1
Load ImMapTile(NbTile)
Load RadarTile(NbTile)
RadarTile(NbTile).Visible = True
RadarTile(NbTile).Left = RadarTile(0).Width * l
RadarTile(NbTile).Top = RadarTile(0).Height * h
RadarTile(NbTile).BackColor = &H8000&
RadarTile(NbTile).BorderColor = RadarTile(NbTile).BackColor
'ImMapTile(NbTile).Picture = LoadPicture(App.Path & "/tiles/grass/" & GrassTile & ".bmp")
ImMapTile(NbTile).Visible = True
ImMapTile(NbTile).Left = ImMapTile(0).Width * l
ImMapTile(NbTile).Top = ImMapTile(0).Height * h
ImMapTile(NbTile).ZOrder 1
If loadingbar.Value > 99 Then GoTo Suite
loadingbar.Value = (NbTile / LoadingTest) * 100
Suite:
Debug.Print NbTile
Next h
Next l
Radar.Visible = True
Map.Visible = True
TypeOfTerrain = "Grass"
TileView = 1
NbOfTile = 16
SelectionTile.Picture = LoadPicture(App.Path & "/tiles/" & TypeOfTerrain & "/" & TileView & ".bmp")
RectRadar.Height = (MapView.Height * Radar.Height) / Map.Height
RectRadar.Width = (MapView.Width * Radar.Width) / Map.Width
LoadingNew = False
loadingbar.Value = 0
End If
End Sub
Private Sub Form_Load()
CellLoad = 0
LoadingNew = False
ImMapTile(0).Picture = LoadPicture(App.Path & "/tiles/" & "grass" & "/" & "1.bmp")
SelectTile.Width = ImMapTile(0).Width
SelectTile.Height = ImMapTile(0).Height
RectRadar.Top = 0
RectRadar.Left = 0
For f = 0 To 3
Select Case f
Case 0
Frame(0).Top = 1920
Case 1
Frame(1).Top = 2170
Case 2
Frame(2).Top = 2425
Case 3
Frame(3).Top = 2680
End Select
Frame(f).Height = 255
Next f
End Sub
Private Sub Form_Unload(Cancel As Integer)
For u = 1 To NbTile
Unload ImMapTile(u)
Next u
End Sub
Private Sub Frame_Click(Index As Integer)
If Frame(Index).Height = 1815 Then
Frame(Index).Height = 255
For f = 0 To 3
Frame(f).Visible = True
Next f
Select Case Index
Case 0
Frame(0).Top = 1920
Case 1
Frame(1).Top = 2170
Case 2
Frame(2).Top = 2425
Case 3
Frame(3).Top = 2680
End Select
PicMenu(Index).Visible = False
Exit Sub
End If
If Frame(Index).Height = 255 And Frame(Index).Width = 2295 Then
Frame(Index).Height = 1815
Frame(Index).Top = 1920
PicMenu(Index).Visible = True
Select Case Index
Case 0
MenuSelect = "Terrain"
Case 1
MenuSelect = "Units"
Case 2
MenuSelect = "Buildings"
Case 3
MenuSelect = "Cell"
End Select
For f = 0 To 3
Frame(f).Visible = False
Next f
Frame(Index).Visible = True
End If
Debug.Print MenuSelect
End Sub
Private Sub Frame_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0
Frame(1).ForeColor = &H80000012
Frame(2).ForeColor = &H80000012
Frame(3).ForeColor = &H80000012
Frame(0).ForeColor = &H404040
Case 1
Frame(0).ForeColor = &H80000012
Frame(2).ForeColor = &H80000012
Frame(3).ForeColor = &H80000012
Frame(1).ForeColor = &H404040
Case 2
Frame(1).ForeColor = &H80000012
Frame(0).ForeColor = &H80000012
Frame(3).ForeColor = &H80000012
Frame(2).ForeColor = &H404040
Case 3
Frame(1).ForeColor = &H80000012
Frame(2).ForeColor = &H80000012
Frame(0).ForeColor = &H80000012
Frame(3).ForeColor = &H404040
End Select
End Sub
Private Sub ImMapTile_Click(Index As Integer)
If MenuSelect = "Terrain" Then
ImMapTile(Index).Picture = ImSelectedTile.Picture
If LaSelectedTileType.Caption = "Grass" Then
RadarTile(Index).BackColor = &H8000&
RadarTile(Index).BorderColor = &H8000&
ElseIf LaSelectedTileType.Caption = "Water" Then
RadarTile(Index).BackColor = &HC0C000
RadarTile(Index).BorderColor = &HC0C000
End If
End If
If MenuSelect = "Cell" Then
If CellWay(1).Value = True Then
CellLoad = CellLoad + 1
Load ImMapCelltag(CellLoad)
ImMapCelltag(CellLoad).Visible = True
ImMapCelltag(CellLoad).Top = ImMapTile(Index).Top
ImMapCelltag(CellLoad).Left = ImMapTile(Index).Left
ImMapCelltag(CellLoad).ZOrder 0
ImMapCelltag(CellLoad).Enabled = False
End If
If CellWay(0).Value = True Then
WayLoad = WayLoad + 1
Load ImMapWaypoint(WayLoad)
ImMapWaypoint(WayLoad).Visible = True
ImMapWaypoint(WayLoad).Top = ImMapTile(Index).Top
ImMapWaypoint(WayLoad).Left = ImMapTile(Index).Left
ImMapWaypoint(WayLoad).ZOrder 0
ImMapWaypoint(WayLoad).Enabled = False
End If
End If
End Sub
Private Sub ImMapTile_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SelectTile.Top = ImMapTile(Index).Top
SelectTile.Left = ImMapTile(Index).Left
End Sub
Private Sub MeFiExit_Click()
End
End Sub
Private Sub MeFiNew_Click()
Load FoNew
FoNew.Visible = True
End Sub
Private Sub Option1_Click(Index As Integer)
Debug.Print Index
Select Case Index
Case 0
TypeOfTerrain = "Grass"
NbOfTile = 16
Case 1
Case 2
TypeOfTerrain = "Rock"
NbOfTile = 1
Case 3
Case 4
Case 5
TypeOfTerrain = "Water"
NbOfTile = 1
End Select
TileView = 1
LaTileInfo.Caption = "Type :" & TypeOfTerrain & " Tile #: " & TileView
SelectionTile.Picture = LoadPicture(App.Path & "/tiles/" & TypeOfTerrain & "/" & TileView & ".bmp")
SelectionTile.Left = (PicSelectTile.Width - SelectionTile.Width) / 2
SelectionTile.Top = (PicSelectTile.Height - SelectionTile.Height) / 2
SelectiontileCase.Width = SelectionTile.Width
SelectiontileCase.Height = SelectionTile.Height
SelectiontileCase.Top = SelectionTile.Top
SelectiontileCase.Left = SelectionTile.Left
End Sub
Private Sub Radar_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Select Case Button
Case 1
RectRadar.Top = Y - (RectRadar.Height / 2)
RectRadar.Left = X - (RectRadar.Width / 2)
If (RectRadar.Left + RectRadar.Width) > Radar.Width Then
RectRadar.Left = Radar.Width - RectRadar.Width
End If
If RectRadar.Left < 0 Then
RectRadar.Left = 0
End If
If (RectRadar.Top + RectRadar.Height) > Radar.Height Then
RectRadar.Top = Radar.Height - RectRadar.Height
End If
If RectRadar.Top < 0 Then
RectRadar.Top = 0
End If
Map.Left = -((RectRadar.Left * Map.Width) / Radar.Width)
Map.Top = -((RectRadar.Top * Map.Height) / Radar.Height)
End Select
Map.SetFocus
End Sub
Private Sub SelectionTile_Click()
LaSelectedTileType.Caption = TypeOfTerrain
LaSelectedTileNb.Caption = TileView
ImSelectedTile.Picture = SelectionTile.Picture
'LaTileSelect.Caption = "Type :" & TypeOfTerrain & " Tile #: " & TileView
End Sub