CHECKBOX DANS UNE DBGRID

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3570
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8595
   LinkTopic       =   "Form1"
   ScaleHeight     =   3570
   ScaleWidth      =   8595
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Quitter"
      Height          =   495
      Left            =   6120
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.Timer DBGridTimerScrool 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   3840
      Top             =   1200
   End
   Begin VB.CheckBox Check1 
      BackColor       =   &H80000005&
      Caption         =   "   "
      DataField       =   "ok"
      DataSource      =   "Data1"
      Height          =   255
      Left            =   3120
      MaskColor       =   &H8000000F&
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   360
      Width           =   495
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ".\test.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   495
      Left            =   240
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "test"
      Top             =   2880
      Width           =   4815
   End
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "Form1.frx":0000
      Height          =   2775
      Left            =   240
      OleObjectBlob   =   "Form1.frx":0010
      TabIndex        =   0
      Top             =   120
      Width           =   4815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------------------------------
' (C) Patrick MOIRE
' http:\\jeux.cartes.free.fr
'---------------------------------------------------------------------------------------------------------------
'
' Exemple de gestion d'une CheckBox dans une dbGrid !
'
'---------------------------------------------------------------------------------------------------------------

Option Explicit

'- - - - - - Indice de la colonne ayant la CheckBox

Private Const CheckColonne = 2

'- - - - - - Working

Private TimerAction As EnumTimerAcion
Private Enum EnumTimerAcion
  vbNone
  vbScrool
  vbSetFocus
End Enum

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_SHIFT = &H10
Private Const VK_LEFT = &H25
Private Const VK_RIGHT = &H27
Private Const VK_DOWN = &H28
Private Const VK_UP = &H26

'- - - - - - Chargement de la feuille

Private Sub Form_Load()
  Me.DBGrid1.Columns(CheckColonne).Locked = True
  Me.Check1.DataField = Me.DBGrid1.Columns(CheckColonne).DataField
  Me.Check1.BackColor = Me.DBGrid1.BackColor
End Sub

'- - - - - - Fait suivre la combo

Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
  DBGrid1_ColResize -1, False
End Sub

Private Sub DBGrid1_RowResize(Cancel As Integer)
  DBGrid1_ColResize -1, Cancel
End Sub

Private Sub DBGrid1_Scroll(Cancel As Integer) 'RQ: passe par un timer, l'évenement étant généré avant execution du "scrool"
  DBGridTimerScrool.Enabled = False
  DBGridTimerScrool.Enabled = True
  TimerAction = vbScrool
End Sub

Private Sub DBGrid1_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
  Dim Colone As Column
    Me.Check1.Visible = (Me.DBGrid1.Row >= 0)
    If Me.Check1.Visible Then
      Set Colone = Me.DBGrid1.Columns(CheckColonne)
      Me.Check1.Move Me.DBGrid1.Left + Colone.Left + 60, Me.DBGrid1.Top + Me.DBGrid1.RowTop(Me.DBGrid1.Row) + 15, Colone.Width - 75, Me.DBGrid1.RowHeight - 30
      Me.Check1.Caption = Colone.Text
      Me.Check1.Tag = Me.DBGrid1.Row
      If Me.DBGrid1.Col = CheckColonne Then DBGrid1_KeyUp 0, 0
    End If
End Sub

'- - - - - - fait suivre le focus sur la CheckBox

Private Sub DBGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
  If Me.DBGrid1.Col = CheckColonne Then
    DBGridTimerScrool.Enabled = False  'RQ: passe par un timer, sinon fonctionne pas !
    DBGridTimerScrool.Enabled = True
    TimerAction = vbSetFocus
  End If
End Sub

Private Sub DBGridTimerScrool_Timer()
  DBGridTimerScrool.Enabled = False
  Select Case TimerAction
    Case vbSetFocus
      Me.Check1.SetFocus
    Case vbScrool
      DBGrid1_ColResize -1, False
  End Select
  TimerAction = vbNone
End Sub


'- - - - - - fait suivre le focus et modif de la CheckBox sur la dbGrid

Private Sub Check1_LostFocus()
  Debug.Print GetKeyState(VK_DOWN)
  Debug.Print Me.Check1.Tag = Me.DBGrid1.Row
  If Me.Check1.Tag = Me.DBGrid1.Row Then
    If GetKeyState(VK_DOWN) < 0 Then
      On Error Resume Next
       Me.DBGrid1.Row = Me.DBGrid1.Row + 1
      On Error GoTo 0
    ElseIf GetKeyState(VK_UP) < 0 Then
      On Error Resume Next
       Me.DBGrid1.Row = Me.DBGrid1.Row - 1
      On Error GoTo 0
    ElseIf Me.DBGrid1.Col = CheckColonne Then
      Me.DBGrid1.Col = CheckColonne + IIf(GetKeyState(VK_SHIFT) < 0 Or GetKeyState(VK_LEFT) < 0, -1, 1)
    End If
  End If
End Sub

Private Sub Check1_Click()
  Me.Check1.Caption = Format(Me.Check1.Value = vbChecked, Me.DBGrid1.Columns(CheckColonne).NumberFormat)
End Sub