Checkbox dans une dbgrid

Télécharger le projet
Commenter

Description

un peut artisanal pour l'instant, un programme de démo ou j'ai reussi à mettre une case à coché dans une dbgrid !!!

Si quelqu'un fait mieu.. JE SUIS PRENEUR !!!

PS: Le Zip contient le source en VB5, ainsi que la base de test.

A+ Patrick
http://jeux.cartes.free.fr

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_patrick)