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 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389
| Imports System.Data.Sql
Imports System.Data.SqlClient
Public Class FGestionStock
Dim CR As Char = Char.ConvertFromUtf32(13) ' Juste pour l'esthétique des messages :D)))
Friend NomDBComplet As String ' Friend était une première option, finalement le NomComplet est lu à partor de ce form dans la TextBox de FBase
Dim NomDuServeurSQL As String = "SCX_2018\SQLEXPRESS" ' La variable est utilisée dans la chaine de connexion, procédure OuvreDB()
Dim TemoinDBOuverte As Boolean = False ' si la DB est ouverte, il faut la fermer en partant. La sortie est un peu différentes,
' cf. BRetourBase_Click et FGestionStock_FormClosing
Dim TemoinNouvelId As Boolean = False ' Devient True quand un Id est créé (cela se produit lors de l'Ajout de données) et il redevient False
' quand l'Ajout n'est pas finalisé ou abandonné. A noter que l'Ajout des données nécessite de cliquer à 2 reprises sur BAjout,
' une 1ère fois pour fournir un enregistrement vide à remplir, et une 2ème fois pour provoquer l'enregistrment physique ou l'abandon.
Dim BalayageAutorise As Boolean = True ' Quand on entre dans la procédure de traitement des données, il doit être impossible
' d'encore balayer les enregistrements car BTraitements_Click traite l'enregistremnt en cours. Il faut donc finaliser l'opération commencée ou
' l'abandonner pour pouvoir consulter à nouveau.
Dim MaConnexion As SqlConnection ' ...
Dim MaCommande As New SqlCommand ' ...
Dim ChaineConnexion As String ' ...
Dim MonStock As New DataSet ' Le jeux d'enregistrements en mémoire. Il alimente les composants visuels d'affichage et subit instanément toutes
' les modifications faites sur les textes de l'affichage. Cependant, ces modifs sont en mémoire et elles n'affectent pas la DB réelle.
' C'est pourquoi, l'algorithmique implémentée dans ce programme provoque l'action sur la DB réelle losqu'il le faut, c'est-à-dire par les procédures
' SauveAjout(Idx), SauveModif(Idx), SauveModif(Idx) pilotées par BTraitements_Click(). La consultation à partir du DataSet utilise le mode "Déconnecté"
' tandis que les modifs en temps réel utilise le mode "Connecté".
Private Sub BRetourBase_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BRetourBase.Click
FermeDB() ' ...
Me.Close() ' ...
End Sub
Private Sub FGestionStock_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
FBase.Show()
If TemoinDBOuverte Then ' alors, il faut la fermer : BRetourBase_Click fait cela.
BRetourBase_Click(Me, Nothing)
End If
End Sub
Private Sub FGestionStock_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
OuvreDB() ' ...
End Sub
Private Sub FermeDB()
TemoinDBOuverte = False ' puisqu'on la ferme ...
'
MaCommande.Dispose() ' Chque instance intialisée avec l'opérateur New doit être fermée avec Dispose ou Close,
MaConnexion.Close() ' ou les deux quand c'est possible. Le but des ces petites tâches est de permettre au
MaConnexion.Dispose() ' système de libérer la mémoire occupée par ces objets.
MonStock.Dispose()
End Sub
Private Sub OuvreDB()
NomDBComplet = FBase.TNomDB.Text 'Voici pourquoi la variable NomDBComplet pouvait être déclarée Private au lieu de Friend
' Le nom complet de la DB est directement lu dans le TextBox TNomDB du form FBase
' La fameuse chaine de connexion ...
' C'est grâce à elle, et moyennant la modification de quelques déclarations, qu'il est possible de transformer ce programme
' en une application SGDB_polyvalente : Access, SQL Serveur, MySql, Oracle, ... .
'ChaineConnexion = "Data Source=" & NomDuServeurSQL & "; Initial Catalog=" & NomDBComplet & ";Integrated Security=True;"
ChaineConnexion = "Data Source=" & NomDuServeurSQL & "; AttachDbFilename=" & NomDBComplet & ";Integrated Security=True"
MaConnexion = OuvreSQLConnexion(ChaineConnexion) ' Des codes, mêmes exploités une seule fois (dans ce programme) sont mis
' sous procédure.
' La principale raison est que dans une application un peu plus complexe, ils sont réutilisés plusieurs fois. Par ailleurs,
' l'isolation de ces codes permet de les ignorer (provisoirement) lorsqu'on élabore de nouvelles procédures et d'alléger leur code.
' OuvreDB() contient 6 lignes de codes, parfaitement compréhensibles. Si tous les codes des procédures appellées était reproduit
' ici, OuvreDB() contiendrait plus de 15 lignes de codes, bien moins lisibles.
ChargeDonnees() ' ...
AfficheDonnees() ' ...
TemoinDBOuverte = True ' puisqu'elle est ouverte ...
End Sub
' Avoir accès effectif aux données. Dans le mode connecté utilisé dans les mises à jour en temps réel, la connexion dit être ouverte,
' dans d'autres cas, il suffit qu'elle soit définie, un DataApter procéde lui-même ) l'ouverure effective.
Private Function OuvreSQLConnexion(ByVal ChaineConnexionComplete As String, Optional ByVal Ouvrir As Boolean = True) As SQLConnection
Dim UneConnexion As New SQLConnection
UneConnexion.ConnectionString = ChaineConnexionComplete
If Ouvrir Then UneConnexion.Open() ' Ouverture effective non nécessaire pour l'utilisation d'un DataAdapter
Return UneConnexion
End Function
' Utiliser la connexion pour lire les données de la DB selon la requête (SQL) passée par paramètre et renvoyer une DataTable pour le DataSet en mémoire
Private Function CreeUneTable(ByRef UneConnexion As SQLConnection, ByVal Selection As String) As DataTable
Dim UneTable As New DataTable
Dim UneConnexionTmp As New SQLDataAdapter(Selection, UneConnexion)
UneConnexionTmp.FillSchema(UneTable, SchemaType.Source)
UneConnexionTmp.Fill(UneTable)
Return UneTable
End Function
' Notamment pour le mode connecté utilisé dans les mises à jour en temps réel, il faut obtenir l'objet "Command" approprié
Private Function CreeSQLCommande(ByRef UneConnexion As SQLConnection, ByVal Commande As String) As SQLCommand
Dim UneCommande As New SQLCommand
UneCommande = UneConnexion.CreateCommand
UneCommande.CommandType = CommandType.Text
UneCommande.CommandText = Commande
Return UneCommande
End Function
' La connexion établie à l'ouveryure de la DB est utilisée pour rechercher les tables pour le DataSet en mémoire
Private Sub ChargeDonnees()
' Chargement des tables dans le DataSet
MonStock.Tables.Add(CreeUneTable(MaConnexion, "SELECT * FROM TProduit"))
' MonStock.Tables.Add(CreeUneTable(MaConnexion, "SELECT * FROM ..............."))
' .............
End Sub
' La gestion des Id par le programmeur (plutôt qu'un AutoIncrement du SGBD) permet bien plus que ci-dessous
' Il est notamment possible de récupérer les trous laissés par les suppressions. Ici, on se contente de trouver
' le plus grand Id et de l'incrémenter pour obtenir le nouveau.
Private Function CreeId() As Integer
Dim NouvelId As Integer = 0
If MonStock.Tables("TProduit").Rows.Count > 0 Then
For Each R As DataRow In MonStock.Tables("TProduit").Rows
If R.RowState <> DataRowState.Deleted Then
If R.Item("Id") > NouvelId Then NouvelId = R.Item("Id")
End If
Next
End If
Return NouvelId + 1
End Function
' Il suffit ici de lier les composants visuels aux données qu'ils doivent afficher. La prgrammation "manuelle" de ces liaisons
' permet d'en rompre lorsque cela est souhaitable selon les nécessité du moment et de les reconstruire ensuite.
' Dans ce programme, AfficheDonnees définit les liaisons et LibereBindings() les rompt.
Private Sub AfficheDonnees()
' Liaison du ListBox au DataSet par la propriété DataSource et désignation du champ à
' présenter par la propriété DisplayMember.
If MonStock.Tables("TProduit").Rows.Count < 1 Then ' Pas la peine si pas d'enregistrement.
Exit Sub
End If
' Certains composants dispose d'un DataSource est ceux qui ne peuvent présenter qu'un seul champs d'nu enregistrement ont
' un DataMember. C'est le cas d'une ListBox, alors on a :
' LaListBox.DataSource = MonStock.Tables("TProduit") ' par exemple
' LaListBox.DataMember = "Article" ' par exemple
DGVStock.DataSource = MonStock.Tables("TProduit") ' Certains composants dispose d'un DataSource
DGVStock.Columns("Id").ReadOnly = True ' On ne touche pas manuellement aux Id
' Certains composants ne dispose pas de DataSource mais il possède une collection de Bindings dans laquelle
' on ajoute le nom de la propriété affectée, le DataSet qui produit les données, et le champ à affecter à la propriété
' Exemple : TArticle.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Article")
' On affecte le champ "Aricle" des enregistrements de "TProduit" à la propriété "Text" de la Textbox "TArticle"
TId.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Id") ' Certains composants ne dispose pas de DataSource
TId.ReadOnly = True ' On ne touche pas manuellement aux Id
TArticle.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Article")
TType.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Type")
TReference.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Reference")
TImage.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Image")
TMiseAJour.DataBindings.Add("Text", MonStock.Tables("TProduit"), "MiseAJour")
TQuantite.DataBindings.Add("Text", MonStock.Tables("TProduit"), "Stock")
Coloriages() ' Vu l'algorithmique employée, c'est le seul endroit où on appelle Coloriages()
End Sub
' Le bloc de gestion des traitements. Une seule procédure événementielle répond à 3 source de Click : BAjouter,BModifier et BEffacer
Private Sub BTraitements_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BAjouter.Click, BModifier.Click, BEffacer.Click
Static Idx As Integer
BalayageAutorise = False ' On est dans la gestion des traitements, on ne flâne pas ailleurs !
Select Case sender.Name
Case "BAjouter"
If TemoinNouvelId Then ' Il est False au 1er passage par ici
If MessageBox.Show("Confirmation de l'ajout de : " & CR & CR & TId.Text & ", " & _
TArticle.Text & ", " & TType.Text & ", " & TReference.Text & ", " & _
TImage.Text & ", " & TMiseAJour.Text & ", " & TQuantite.Text & " ?", _
"Confirmation", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
SauveAjout(Idx) ' Si et seulement si on confirme ! Sinon, on ignore, c'est l'andondon de la tâche commencée
TemoinNouvelId = False
Else
MonStock.Tables("TProduit").Rows(MonStock.Tables("TProduit").Rows.Count - 1).Delete()
TemoinNouvelId = False
Exit Sub
End If
Else
LibereBindings() ' Rompre les liaisons pour permettre les modifications manuelles des données
Idx = CreeId() ' L'Id est créé au premier passage par ici
TemoinNouvelId = True ' Puisque l'Id est créé ...
TId.Text = Idx ' Mettre à jour TId
TMiseAJour.Text = Now().ToShortDateString ' Mettre à jour TMiseAJour
MonStock.Tables("TProduit").Rows.Add(TId.Text, "", "", "", "", TMiseAJour.Text, 0) 'Ajouter une enregistrment vide dans le DatSet
AfficheDonnees() ' Refaire les liaisons des données aux composants visuels et l'enregistrement vide apparaît
With Me.BindingContext(MonStock.Tables("TProduit"))
.Position = .Count ' Pousser le balayage des enregistrement sur ce dernier, l'enregistrement vide.
End With ' Ceci provoque la mise à jour de tout l'affichage puisque tout les composant sont liés à la mêm source
TArticle.Select() ' Le focus sur TArticle pour incityer l'utilsateur à commencer son encodage
Exit Sub ' Et on sort par la porte dérobée pour ne surtout pas exécuter le Reset du DataSet
End If ' Ce Reset du DataSet sera exécuté après confimration de l'ajout
Case "BModifier"
If TemoinNouvelId Then Exit Sub ' On est en Ajout, on achève ou on abandonne, et rien d'autres !
Idx = TId.Text ' C'est par l'Id qu'on désigne l'enregistrement à traiter par SQL en mode connecté
If MessageBox.Show("Confirmation de modification en : " & CR & CR & TId.Text & ", " & _
TArticle.Text & ", " & TType.Text & ", " & TReference.Text & ", " & _
TImage.Text & ", " & TMiseAJour.Text & ", " & TQuantite.Text & " ?", _
"Confirmation", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
SauveModif(Idx) ' Si et seulement si on confirme ! Sinon, on ignore, c'est l'andondon de la tâche commencée
End If
Case "BEffacer"
If TemoinNouvelId Then Exit Sub ' On est en Ajout, on achève ou on abandonne, et rien d'autres !
Idx = TId.Text ' C'est par l'Id qu'on désigne l'enregistrement à traiter par SQL en mode connecté
If MessageBox.Show("Confirmation de suppression de : " & CR & CR & TId.Text & ", " & _
TArticle.Text & " ?", "Confirmation", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
SauveSuppress(Idx) ' Si et seulement si on confirme ! Sinon, on ignore, c'est l'andondon de la tâche commencée
End If
End Select
BalayageAutorise = True ' Si on arrive ici, c'est qu'on a fini ou abondonné la tâche commencée, on peut donc de nouveau flâner
LibereBindings() ' Rompre les liaisons pour permettre le renouvellement des données
MonStock.Reset() ' Vider la DB en mémoire
ChargeDonnees() ' Remplir la DB en mémoire
AfficheDonnees() ' Refaire les liaisons des données aux composants visuels
End Sub
Private Sub LibereBindings()
For Each C As Control In Me.Controls() ' Balayage de tous les contrôles pour trouver
Try ' et rompre leurs liaisons dans un Try car
C.DataBindings.Clear() ' tous, tels les boutons, nen possèdent pas.
Catch
End Try
Next
End Sub
Private Sub SauveSuppress(ByVal IdArticle As Integer) ' Mode connecté : exécution d'un ordre SQL
Dim ConnexionTMP As SqlConnection = Nothing
Dim MaCommande As SqlCommand = Nothing
ConnexionTMP = OuvreSQLConnexion(ChaineConnexion, True)
MaCommande = CreeSQLCommande(MaConnexion, "DELETE FROM TProduit" & " WHERE (Id = " & IdArticle.ToString & ")")
' Il peut y avoir rejet
Try
If MaCommande.ExecuteNonQuery() < 1 Then
Throw New Exception("Identifiant non trouvé")
End If
Catch Ex As Exception
MessageBox.Show(Ex.Message & CR & "Suppression refusée" & CR & "Tables en mémoire rechargées")
Finally
MonStock.AcceptChanges()
End Try
ConnexionTMP.Close()
End Sub
Private Sub SauveModif(ByVal IdArticle As Integer) ' Mode connecté : exécution d'un ordre SQL
Dim ConnexionTMP As SqlConnection = Nothing
Dim MaCommande As SqlCommand = Nothing
Dim ChaineSQL As String
ChaineSQL = "UPDATE TProduit SET Article = '" _
& TArticle.Text & "', Type = '" & TType.Text & "', Reference = '" _
& TReference.Text & "', Image = '" & TImage.Text & "', MiseAjour = '" & TMiseAJour.Text & "', Stock = '" _
& TQuantite.Text & "' WHERE (Id = '" & IdArticle & "')"
ConnexionTMP = OuvreSQLConnexion(ChaineConnexion, True)
MaCommande = CreeSQLCommande(ConnexionTMP, ChaineSQL)
' Il peut y avoir rejet
Try
If MaCommande.ExecuteNonQuery() < 1 Then
Throw New Exception("Identifiant non trouvé")
End If
Catch Ex As Exception
MessageBox.Show(Ex.Message & CR & "Modification refusée" & CR & "Tables en mémoire rechargées")
Finally
MonStock.AcceptChanges()
End Try
ConnexionTMP.Close()
End Sub
Private Sub SauveAjout(ByVal IdArticle As Integer) ' Mode connecté : exécution d'un ordre SQL
Dim ConnexionTMP As SqlConnection = Nothing
Dim MaCommande As SqlCommand = Nothing
Dim ChaineSQL As String
ChaineSQL = "INSERT INTO TProduit (Id, Article, Type, Reference, Image, MiseAJour, Stock) " &
"VALUES ('" & IdArticle & "', '" & TArticle.Text & "', '" & TType.Text & "', '" &
TReference.Text & "', '" & TImage.Text & "', '" & TMiseAJour.Text & "', '" & TQuantite.Text & "' )"
ConnexionTMP = OuvreSQLConnexion(ChaineConnexion, True)
MaCommande = CreeSQLCommande(ConnexionTMP, ChaineSQL)
' Il peut y avoir rejet
Try
If MaCommande.ExecuteNonQuery() < 1 Then
Throw New Exception("Identifiant non admis")
End If
Catch Ex As Exception
MessageBox.Show(Ex.Message & CR & "Ajout refusé" & CR & "Tables en mémoire rechargées")
Finally
MonStock.AcceptChanges()
End Try
ConnexionTMP.Close()
End Sub
' Le bloc de gestion du balayge. Une seule procédure événementielle répond à 4 source de Click : BDernier, BPrecedent, BSuivant et BDernier
Private Sub Deplacement_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BDernier.Click, BPrecedent.Click, BSuivant.Click, BPremier.Click
' Inutile de tenter un déplacement si le DataSet ne contient aucune table.
If MonStock.Tables.Count > 0 And BalayageAutorise Then
' Le BindingContext appartient à un conteneur, le formulaire dans ce cas.
With Me.BindingContext(MonStock.Tables("TProduit"))
' Modification de sa propriété Position en fonction du bouton.
Select Case sender.Name
Case "BPremier"
.Position = 0
Case "BPrecedent"
If .Position = 0 Then
.Position = .Count - 1 ' Balayage circulaire
Else
.Position -= 1
End If
Case "BSuivant"
If .Position = .Count - 1 Then
.Position = 0 ' Balayage circulaire
Else
.Position += 1
End If
Case "BDernier"
.Position = .Count - 1
End Select
End With
End If
End Sub
Private Sub BChargeImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BChargeImage.Click
Dim ChercheImage As New OpenFileDialog
Dim Resultat As DialogResult ' Valeur renvoyée par la méthode Showdialog
ChercheImage.Title = "Désignez l'image à charger"
ChercheImage.Filter = "Tous|*.*|JPEG|*.jpg|BMP|*.bmp|PNG|*.png"
ChercheImage.CheckFileExists = False
Resultat = ChercheImage.ShowDialog()
If Resultat = Windows.Forms.DialogResult.OK Then ' OK est le gage dune saisie plausible
TImage.Text = ChercheImage.FileName
End If
ChercheImage.Dispose()
End Sub
' Charger l'image appropriée à chaque enregistrement
Private Sub TImage_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TImage.TextChanged
If TImage.Text <> String.Empty Then
PBImage.Image = System.Drawing.Image.FromFile(TImage.Text)
PBImage.SizeMode = PictureBoxSizeMode.StretchImage
Else
PBImage.Image = Nothing
End If
End Sub
Private Sub Coloriages() ' La question initiale............. :D)))
Dim CpteRouge As Integer = 0
Dim Valeur As Integer
Dim I As Integer
Dim Colonne As Integer
Dim Ligne As Integer
If DGVStock.Rows.Count < 1 Then
Exit Sub
End If
Colonne = DGVStock.Columns("Stock").Index
For I = 0 To DGVStock.Rows.Count - 2
Ligne = DGVStock.Rows(I).Index
Valeur = DGVStock.Item(Colonne, Ligne).Value
If Valeur < 5 Then ' Test de la valeur de la cellule
CpteRouge += 1
If DGVStock.Item(Colonne, Ligne).Style.ForeColor <> Color.Red Then
DGVStock.Item(Colonne, Ligne).Style.ForeColor = Color.Red ' Ici Texte en Rouge
DGVStock.Rows(Ligne).DefaultCellStyle.BackColor = Color.Yellow ' Couleur de fond en jaune pour toute la ligne
FBase.LAttention.BackColor = Color.Red ' ' Couleur de fond en rouge
End If
Else
If DGVStock.Item(Colonne, Ligne).Style.ForeColor = Color.Red Then
CpteRouge -= 1
DGVStock.Item(Colonne, Ligne).Style.ForeColor = Color.Black
End If
If CpteRouge = 0 Then
FBase.LAttention.BackColor = Color.White
End If
End If
Next
End Sub
End Class |
Partager