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
|
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Windows.Forms.Control
Public Structure Carte
Public Const X As Integer = 14 'nbre de colonnes de la carte (A-N)
Public Const Y As Integer = 12 'nbre de lignes de la carte (1-12)
End Structure
Public Structure Tuile 'des carrés
Public Shared ref As String 'de la forme A1,B2,...
Public Shared num As Integer 'no de la tuile sur la carte (1=A1, 2=A2,...13=B1,...168=N12)
Public Const taille As Integer = 30 'cote de la tuile
End Structure
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
drawMap()
End Sub
Sub drawMap()
Dim chgMap As Point = New Point(30, 30) 'position de la Picturebox de la carte dans la form
Dim sizemap As Size = New Size(Carte.X * Tuile.taille, Carte.Y * Tuile.taille) 'taille de la Picturebox de la carte
With pbMap
.Size = sizemap
.Location = chgMap
.BorderStyle = BorderStyle.Fixed3D
.BackColor = Color.LightCyan
End With
For c = 0 To Carte.X - 1 'balayage horizontal
For r = 0 To Carte.Y - 1 'balayage vertical
Tuile.ref = ChrW(c + 65) & Trim((r + 1).ToString) 'ref de la case
Dim chgTile As Point = New Point(c * Tuile.taille, r * Tuile.taille) 'position de la case dans la Picturebox
drawTile(chgTile)
Next
Next
End Sub
Sub drawTile(ByVal chg As Point)
Dim tile As New Label 'çà peut être n'importe quel controle ou objet cliquable
With tile
.Size = New Size(Tuile.taille, Tuile.taille) 'taille de la case
.Location = chg 'position de la case
.FlatStyle = FlatStyle.Standard
.BorderStyle = BorderStyle.Fixed3D
.BackColor = Color.Transparent
.Tag = RefToNum(Tuile.ref) 'transformation de la ref en numéro (sert à calculer les cases adjacentes)
.Enabled = True
.Cursor = IIf(.Enabled, Cursors.Hand, Cursors.Default)
Me.ToolTip1.SetToolTip(tile, Tuile.ref)
AddHandler .Click, AddressOf tile_Click
End With
pbMap.Controls.Add(tile)
End Sub
Function RefToNum(ByVal refTile As String) As Integer
Dim noColonne As Integer = Asc(refTile.Substring(0, 1)) - 64 'la lettre
Dim noLigne As Integer = Val(refTile.Substring(refTile.Length - 1)) 'le chiffre
Return (noColonne - 1) * Carte.Y + noLigne
End Function
Function surroundTiles(ByVal NoCenterTile As Integer) As Integer()
Dim tileN As Integer = NoCenterTile - 1
Dim tileNE As Integer = NoCenterTile + Carte.Y - 1
Dim tileE As Integer = NoCenterTile + Carte.Y
Dim tileSE As Integer = NoCenterTile + Carte.Y + 1
Dim tileS As Integer = NoCenterTile + 1
Dim tileSW As Integer = NoCenterTile - Carte.Y + 1
Dim tileW As Integer = NoCenterTile - Carte.Y
Dim tileNW As Integer = NoCenterTile - Carte.Y - 1
Dim myarray() As Integer
Select Case NoCenterTile
Case 1 'coin haut gauche
myarray = {NoCenterTile, tileE, tileSE, tileS}
Case Carte.Y 'coin bas gauche
myarray = {NoCenterTile, tileN, tileNE, tileE}
Case Carte.X * Carte.Y 'coin bas droite
myarray = {NoCenterTile, tileW, tileNW, tileN}
Case (Carte.X - 1) * Carte.Y + 1 'coin haut droite
myarray = {NoCenterTile, tileS, tileSW, tileW}
Case 2 To Carte.Y - 1 'bord gauche
myarray = {NoCenterTile, tileN, tileNE, tileE, tileSE, tileS}
Case (Carte.X - 1) * Carte.Y + 2 To Carte.X * Carte.Y - 1 'bord droit
myarray = {NoCenterTile, tileS, tileSW, tileW, tileNW, tileN}
Case Else 'autres cas
Select Case NoCenterTile Mod Carte.Y
Case 0 'bord bas
myarray = {NoCenterTile, tileW, tileNW, tileN, tileNE, tileE}
Case 1 'bord haut
myarray = {NoCenterTile, tileE, tileSE, tileS, tileSW, tileW}
Case Else 'cas général
myarray = {NoCenterTile, tileN, tileNE, tileE, tileSE, tileS, tileSW, tileW, tileNW}
End Select
End Select
Return myarray
End Function
Private Sub bEXIT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bEXIT.Click
Application.Exit()
End Sub
Private Sub tile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
For Each carre In pbMap.Controls
If surroundTiles(sender.tag).Contains(carre.tag) Then
If carre.tag <> sender.tag Then
carre.Backcolor = Color.DarkCyan
End If
End If
Next
End Sub
End Class |
Partager