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
| Option Explicit
'variables d'usage generales
Dim T As Long
Dim Ldeb As Long, LFin As Long
Dim NbrRowVisibl As Long
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* Partie utile pour utilisation de la roulette souris *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Private Sub Form_Initialize()
OkRoulette = False
VScroll1.Visible = False
If GetSystemMetrics(SM_MOUSEWHEELPRESENT) Then
OkRoulette = True
'Crée/enclenche, en tache de fond, la surveillance de la souris
SetProp MSHFlexGrid1.hwnd, "PrevWndProc", SetWindowLong(MSHFlexGrid1.hwnd, GWL_WNDPROC, AddressOf WndProc)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If OkRoulette = True Then
'pour mettre fin proprement à la routine utilisation de la roulette souris
SetWindowLong MSHFlexGrid1.hwnd, GWL_WNDPROC, GetProp(MSHFlexGrid1.hwnd, "PrevWndProc")
RemoveProp MSHFlexGrid1.hwnd, "PrevWndProc"
Set Form1 = Nothing
End If
End Sub
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'-----------------------------------------Routine ordinaire----------------------------------------
Private Sub Form_Load()
'placement des différents composants
MSHFlexGrid1.Move 540, 120, 2235, 3015
Command1.Left = MSHFlexGrid1.Left
Command1.Height = 555
Command1.Width = (MSHFlexGrid1.Width - 30) / 2
Command1.Caption = "...."
Command1.ToolTipText = "Cliquez moi pour faire perdre le focus de MSHFlexGrid1"
Command2.Left = Command1.Left + Command1.Width + 15
Command2.Height = Command1.Height
Command2.Width = Command1.Width
Command2.Caption = "Remplis le grid"
'Histoire de remplir une première fois le MSHFlexGrid
Ldeb = 47: LFin = 122
MSHFlexGrid1.Rows = (LFin - Ldeb) + 1: MSHFlexGrid1.Cols = 2
For T = Ldeb To LFin
If T = Ldeb Then
MSHFlexGrid1.TextMatrix(T - Ldeb, 0) = "Col1"
MSHFlexGrid1.TextMatrix(T - Ldeb, 1) = "Col2"
Else
MSHFlexGrid1.TextMatrix(T - Ldeb, 0) = T - Ldeb
MSHFlexGrid1.TextMatrix(T - Ldeb, 1) = Chr(T)
End If
Next T
Me.Height = 4470: Me.Width = 3390
'rend le Form visible de façon a donner le focus au grid
Me.Visible = True
MSHFlexGrid1.SetFocus
End Sub
Private Sub Form_Resize()
'pour le cas ou vous désirez redimensionner le MSHFlexGrid
If Me.WindowState <> vbMinimized And Me.Visible = True Then
'redimensionnement du MSHFlexGrid1 et repositionnement des 2 CommandButton
If Me.Height >= 1980 Then
Command1.Top = Me.ScaleHeight - Command1.Height - 90
Command2.Top = Command1.Top
MSHFlexGrid1.Height = Command1.Top - (MSHFlexGrid1.Top + 45)
'il faut donc reparamétrer
ParamScroolFlexGrid MSHFlexGrid1, VScroll1
End If
End If
End Sub
Private Sub ParamScroolFlexGrid(HFlexGridMS As MSHFlexGrid, Vscrol As VScrollBar)
'Comptage du nombre de lignes visibles dans la fenêtre du MSHFlexGrid
Dim Cpt As Long
NbrRowVisibl = -1
For Cpt = 0 To HFlexGridMS.Rows - 1
If NbrRowVisibl = -1 Then
If HFlexGridMS.RowIsVisible(Cpt) = False Then
NbrRowVisibl = Cpt
End If
End If
Next Cpt
'Paramétrage du VScroll
Vscrol.Max = HFlexGridMS.Rows + 1
Vscrol.Min = NbrRowVisibl
Vscrol.Value = (MSHFlexGrid1.TopRow + NbrRowVisibl) - 1
End Sub
Private Sub MSHFlexGrid1_Scroll()
'si NbrRowVisibl = -1 c'est que la fenêtre MSHFlexGrid affiche toutes les lignes,
'donc pas besoin d'actualiser VScroll1.
If NbrRowVisibl = -1 Then Exit Sub
'pour calage/actualisation de VScroll1
VScroll1.Value = (MSHFlexGrid1.TopRow + NbrRowVisibl) - 1
If Me.ActiveControl.Name <> "MSHFlexGrid1" Then
MSHFlexGrid1.SetFocus
End If
End Sub
'Ce qu'il doit se passer quand il y a modification de la valeur du VScrollBar déclenché par la
'la fonction WndProc du module.bas
Private Sub VScroll1_Scroll()
VScroll1_Change
End Sub
Private Sub VScroll1_Change()
'si NbrRowVisibl = -1 c'est que la fenêtre MSHFlexGrid affiche toutes les lignes,
'donc pas besoin d'actualiser VScroll1.
If NbrRowVisibl = -1 Then Exit Sub
'petite assurence, des fois ....
'On Error Resume Next
MSHFlexGrid1.TopRow = (VScroll1.Value - NbrRowVisibl) + 1
End Sub
Private Sub Command2_Click()
'Histoire de remplir le MSHFlexGrid (BIS)
'pour illustrer le reparametrage de VScroll1
Ldeb = 65: LFin = 90
MSHFlexGrid1.Rows = (LFin - Ldeb) + 1
For T = Ldeb To LFin
If T = Ldeb Then
MSHFlexGrid1.TextMatrix(T - Ldeb, 0) = "Col1"
MSHFlexGrid1.TextMatrix(T - Ldeb, 1) = "Col2"
Else
MSHFlexGrid1.TextMatrix(T - Ldeb, 0) = T - Ldeb
MSHFlexGrid1.TextMatrix(T - Ldeb, 1) = Chr(T)
End If
Next T
MSHFlexGrid1.Row = 1: MSHFlexGrid1.TopRow = 1
ParamScroolFlexGrid MSHFlexGrid1, VScroll1
End Sub
'------------------------------------------------------------------------------------------------- |
Partager