Código "simular" checkbox en Grid

Orlando
05 de Febrero del 2004
Este código lo bajé de Internet.
Pues eso , simula "algo parecido" a un checkbox
en una columna de un Grid.
Crear un proyecto con un formulario, añadir un Grid (DataGrid ó DBGrid) , poner este codigo en el formulario, ejecutar y cruzar los dedos.
El valor "false" pone el caracter "."
El valor "true" pone el caracter "X". Se puede sustituir
por otro caracter más "gráfico" con su valor ASCII, pero no lo he probado.

Option Explicit
Dim mRS As ADODB.Recordset
Dim CBCharacters(1) As String

Private Sub CreateRS()
Set mRS = New ADODB.Recordset
With mRS
.Fields.Append "ID", adInteger
.Fields.Append "Text", adVarWChar, 32
.Fields.Append "Bool", adBoolean
.LockType = adLockOptimistic
.Open
End With
End Sub
'Este código rellena el recordset con datos "ficticios".
Private Sub FillRS(NumRecords As Long)
Dim RCount As Long

Select Case True
Case mRS Is Nothing
Case mRS.State And adStateOpen = adStateOpen
With mRS
RCount = .RecordCount + NumRecords
Do While .RecordCount < RCount
.AddNew
.Fields(0).Value = .RecordCount
.Fields(1).Value = Chr$(Int(65 * Rnd) + 65)
.Fields(2).Value = (.RecordCount Mod 2 = 0)
.Update
Loop
End With
End Select
End Sub

Private Sub DGrid_HeadClick(ByVal ColIndex As Integer)
mRS.Sort = mRS.Fields(ColIndex).Name
End Sub

Private Sub DGrid_KeyDown(KeyCode As Integer, Shift As Integer)
If DGrid.Col = 2 Then
KeyCode = 0
DGrid.Columns(2).Value = Not DGrid.Columns(2).Value
End If
End Sub

Private Sub DGrid_KeyPress(KeyAscii As Integer)
If DGrid.Col = 2 Then
KeyAscii = 0
End If
End Sub

Private Sub DGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DGrid.RowContaining(Y) > -1 Then
If DGrid.ColContaining(X) > -1 Then
DGrid.Row = DGrid.RowContaining(Y)
End If
End If
End Sub

Private Sub DGrid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DGrid.RowContaining(Y) > -1 Then
If DGrid.ColContaining(X) = 2 Then
DGrid.Columns(2).Value = Not DGrid.Columns(2).Value
End If
End If
End Sub

Private Sub Form_Load()
Dim DF As StdDataFormat
CBCharacters(0) = "."
CBCharacters(1) = "X"

CreateRS
FillRS 100
Set DGrid.DataSource = mRS
Set DF = New StdDataFormat
With DF
.Type = fmtBoolean
.FalseValue = CBCharacters(0)
.TrueValue = CBCharacters(1)
.NullValue = ""
End With
Set DGrid.Columns(2).DataFormat = DF
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set DGrid.DataSource = Nothing
Select Case True
Case mRS Is Nothing
Case mRS.State And adStateOpen = adStateOpen
If mRS.EditMode <> adEditNone Then
mRS.Update
End If
mRS.Close
End Select
Set mRS = Nothing
End Sub

Private Sub Form_Resize()
DGrid.Move 90, 90, Me.ScaleWidth - 180, Me.ScaleHeight - 180
End Sub