vbAccelerator - Contents of code file: frmGridEdit.frm

VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Object = "{3D811CB0-6F63-4CA8-BD1E-7858AC6C9A00}#5.6#0"; "vbalSGrid.ocx"
Object = "{436403CD-EDD8-11D2-8040-00C04FA4EE99}#14.0#0"; "vbalCbEx.ocx"
Begin VB.Form frmGridEdit 
   Caption         =   "SGrid Editing Demonstration"
   ClientHeight    =   4170
   ClientLeft      =   2895
   ClientTop       =   4065
   ClientWidth     =   8145
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmGridEdit.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   8145
   Begin GridEdit.tipPopup tipPopup1 
      Height          =   1515
      Left            =   5460
      Top             =   2820
      Width           =   2535
      _ExtentX        =   4471
      _ExtentY        =   2672
      StandardIcon    =   32515
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.TextBox txtEdit 
      Height          =   315
      Left            =   5460
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   2460
      Visible         =   0   'False
      Width           =   2535
   End
   Begin GridEdit.ddnMultiSelect ddnCategories 
      Height          =   1095
      Left            =   5760
      TabIndex        =   1
      Top             =   1200
      Visible         =   0   'False
      Width           =   2235
      _ExtentX        =   3942
      _ExtentY        =   1931
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin GridEdit.ddnMultiSelect selCategories 
      Height          =   495
      Left            =   4740
      TabIndex        =   3
      Top             =   660
      Visible         =   0   'False
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   2990
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin vbalComboEx.vbalCboEx cboIcon 
      Height          =   330
      Left            =   5820
      TabIndex        =   4
      Top             =   240
      Visible         =   0   'False
      Width           =   2115
      _ExtentX        =   3731
      _ExtentY        =   582
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ExtendedUI      =   0   'False
      DropDownWidth   =   0
   End
   Begin vbalIml.vbalImageList ilsIcons 
      Left            =   4200
      Top             =   2160
      _ExtentX        =   953
      _ExtentY        =   953
      ColourDepth     =   24
      Size            =   13776
      Images          =   "frmGridEdit.frx":45A2
      Version         =   131072
      KeyCount        =   12
      Keys            =   "Big DogSmall DogBumMaggieSpace
       MutantRenFelixHomerDraculaPirateNinjaBart"
   End
   Begin vbAcceleratorSGrid.vbalGrid grdEdit 
      Height          =   2595
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   4577
      BackgroundPictureHeight=   0
      BackgroundPictureWidth=   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BorderStyle     =   2
      DisableIcons    =   -1  'True
   End
End
Attribute VB_Name = "frmGridEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub configureCategories()
   With selCategories
      .Height = cboIcon.Height
      .Delimiter = ","
      .AddItem "", -1, ".NET", True
      .AddItem "", -1, "Business", True
      .AddItem "", -1, "Family", False
      .AddItem "", -1, "Friends", False
      .AddItem "", -1, "Hotels", False
      .AddItem "", -1, "Restaurants", False
      .AddItem "", -1, "Personal", False
      .AddItem "", -1, "Web", False
      .AddItem "", -1, "VB", True
   End With
End Sub

Private Sub configureCombo()
Dim i As Long
   
   With cboIcon
      .ImageList = ilsIcons
      For i = 1 To ilsIcons.ImageCount
         .AddItemAndData ilsIcons.ItemKey(i), i - 1, i - 1
      Next i
      .DropDownWidth = 96
   End With
   
End Sub

Private Sub configureGrid()
   
   With grdEdit
      
      .DefaultRowHeight = cboIcon.Height \ Screen.TwipsPerPixelY
      
      .Editable = True
      .ImageList = ilsIcons
      .HighlightSelectedIcons = False
            
      .AddColumn "Icon", "Icon", eSortType:=CCLSortIcon
            
      .AddColumn "DisplayName", "Display Name"
      .AddColumn "FamilyName", "Family Name"
      .AddColumn "GivenName", "Given Name"
      .AddColumn "Email", "Email"
      
      .AddColumn "Phone", "Phone"

      .AddColumn "Categories", "Categories"
      
      .AddColumn "Birthday", "Birthday", eSortType:=CCLSortDateDayAccuracy
      
      .AddColumn "Notes", "Notes", lColumnWIdth:=256, bRowTextColumn:=True
      
   End With
   
End Sub

Private Function AddContact( _
      ByVal lIcon As Long, _
      ByVal sDisplayName As String, _
      ByVal sFamilyName As String, _
      ByVal sGivenName As String, _
      ByVal sEmail As String, _
      ByVal sPhone As String, _
      ByVal sCategories As String, _
      ByVal dBirthday As Variant, _
      ByVal sNotes As String _
   ) As Long
Dim lRow As Long
   
   With grdEdit
      .AddRow
      lRow = .Rows
      
      .CellIcon(lRow, 1) = lIcon
      .CellText(lRow, 2) = sDisplayName
      .CellTextAlign(lRow, 2) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 3) = sFamilyName
      .CellTextAlign(lRow, 3) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 4) = sGivenName
      .CellTextAlign(lRow, 4) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 5) = sEmail
      .CellTextAlign(lRow, 5) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 6) = sPhone
      .CellTextAlign(lRow, 6) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 7) = sCategories
      .CellTextAlign(lRow, 7) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 8) = dBirthday
      .CellTextAlign(lRow, 8) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      .CellText(lRow, 9) = sNotes
      .CellTextAlign(lRow, 9) = DT_SINGLELINE Or DT_VCENTER Or DT_END_ELLIPSIS
      
      lRow = .ShiftLastRowToSortLocation()
      AddContact = lRow
      
   End With
   
End Function

Private Sub addSampleData()
   
   AddContact Rnd * ilsIcons.ImageCount, _
      "Steve McMahon", "McMahon", "Stephen", "steve@vbaccelerator.com", _
      "(1)-888-NOPHONE", ".NET, VB, Web", DateSerial(1968, 12, 7), _
      "Sometime close to ten years ago, a butterfly flapped its wings whilst
       passing a " & _
      "a cocktail bar in Chicago.  Nothing came of it: and it wasn't the first
       time. Ever " & _
      "since reading James Gleick's 'Chaos' the butterfly had been trying to
       achieve the tornado " & _
      "on the other side of the world that was apparently so easily possible
       through chaos, " & _
      "but maybe it was only possible for the other butterflies.  Perhaps some
       butterflies are " & _
      "just underachievers, it though."
   AddContact Rnd * ilsIcons.ImageCount, _
      "Uma Thurman", "Thurman", "Uma", "not sure yet", _
      "not sure yet", "Friends", Empty, ""
   AddContact Rnd * ilsIcons.ImageCount, _
      "The Fat Duck", "", "", "bookings@thefatduck.co.uk", _
      "", "Restaurants", Empty, ""
   
End Sub

Private Function validEditDate(ByVal bHideOnly As Boolean, ByRef vValue As
 Variant) As Boolean
Dim sText As String
Dim bR As Boolean
   sText = Trim(txtEdit.Text)
   If (Len(sText) = 0) Then
      vValue = Empty
      bR = True
   Else
      If (IsDate(sText)) Then
         vValue = CDate(sText)
         bR = True
      End If
   End If
   If Not (bR) Then
      If Not (bHideOnly) Then
         If Not (tipPopup1.Showing) Then
            tipPopup1.Title = "Invalid Date Format"
            tipPopup1.Text = "Enter a valid date (e.g." & Format(Now, "short
             date") & "), or blank the text in the cell to remove the date."
            tipPopup1.Show Me.hWnd, txtEdit.left \ Screen.TwipsPerPixelY,
             (txtEdit.top + txtEdit.Height) \ Screen.TwipsPerPixelY - 4
         End If
      End If
   Else
      If (tipPopup1.Showing) Then
         tipPopup1.Hide
      End If
   End If
   validEditDate = bR
End Function

Private Sub cboIcon_Click()
   If (cboIcon.Tag = "DROPPED") Then
      Debug.Print "Click whilst dropped"
   Else
      Debug.Print "Click whilst not dropped"
   End If
End Sub

Private Sub cboIcon_CloseUp()
   cboIcon.Tag = ""
End Sub

Private Sub cboIcon_DropDown()
   cboIcon.Tag = "DROPPED"
End Sub

Private Sub cboIcon_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
   Case 9   ' tab
      grdEdit.EndEdit
      KeyCode = 0
   Case 13  ' return
      grdEdit.EndEdit
      KeyCode = 0
   Case 27  ' escape
      grdEdit.CancelEdit
      KeyCode = 0
   End Select
End Sub

Private Sub cboIcon_KeyPress(KeyAscii As Integer)
   Select Case KeyAscii
   Case 9
      KeyAscii = 0
   Case 13
      KeyAscii = 0
   Case 27
      KeyAscii = 0
   End Select
End Sub

Private Sub grdEdit_KeyDown(KeyCode As Integer, Shift As Integer, bDoDefault As
 Boolean)
   If (KeyCode = vbKeyDelete) Then
      Dim lCol As Long
      Dim lRow As Long
      lCol = grdEdit.SelectedCol
      lRow = grdEdit.SelectedRow
      If (lCol > 0) And (lRow > 0) Then
         Select Case grdEdit.ColumnKey(lCol)
         Case "Icon"
            Beep
         Case "DisplayName"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "FamilyName"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "GivenName"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "Email"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "Phone"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "Categories"
            grdEdit.CellText(lRow, lCol) = Empty
         Case "Birthday"
            grdEdit.CellText(lRow, lCol) = Empty
         End Select
      End If
   End If
End Sub

Private Sub selCategories_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
   Case 9   ' tab
      grdEdit.EndEdit
      KeyCode = 0
   Case 13  ' return
      grdEdit.EndEdit
      KeyCode = 0
   Case 27  ' escape
      grdEdit.CancelEdit
      KeyCode = 0
   End Select
End Sub

Private Sub grdEdit_CancelEdit()
   '
   selCategories.EndEdit
   selCategories.Visible = False
   cboIcon.Visible = False
   txtEdit.Visible = False
   tipPopup1.Hide
   '
End Sub

Private Sub grdEdit_PreCancelEdit(ByVal lRow As Long, ByVal lCol As Long,
 newValue As Variant, bStayInEditMode As Boolean)
Dim sText As String
   '
   Select Case grdEdit.ColumnKey(lCol)
   Case "Icon"
      grdEdit.CellIcon(lRow, lCol) = cboIcon.ItemIcon(cboIcon.ListIndex)
   Case "DisplayName"
      grdEdit.CellText(lRow, lCol) = txtEdit.Text
   Case "FamilyName"
      grdEdit.CellText(lRow, lCol) = txtEdit.Text
   Case "GivenName"
      grdEdit.CellText(lRow, lCol) = txtEdit.Text
   Case "Email"
      grdEdit.CellText(lRow, lCol) = txtEdit.Text
   Case "Phone"
      grdEdit.CellText(lRow, lCol) = txtEdit.Text
   Case "Categories"
      grdEdit.CellText(lRow, lCol) = selCategories.Selection
   Case "Birthday"
      Dim vVal As Variant
      If (validEditDate(False, vVal)) Then
         grdEdit.CellText(lRow, lCol) = vVal
      Else
         bStayInEditMode = True
      End If
   End Select
   '
End Sub

Private Sub selCategories_RequestDropDownInstance(ctl As ddnMultiSelect)
   Set ctl = ddnCategories
End Sub

Private Sub Form_Load()
   
   configureCombo
   configureCategories
   configureGrid
   
   addSampleData
   grdEdit.CellSelected(1, 1) = True
   
End Sub

Private Sub Form_Resize()
On Error Resume Next
   grdEdit.Move grdEdit.left, grdEdit.top, Me.ScaleWidth - grdEdit.left * 2,
    Me.ScaleHeight - grdEdit.top * 2
End Sub

Private Sub grdEdit_RequestEdit(ByVal lRow As Long, ByVal lCol As Long, ByVal
 iKeyAscii As Integer, bCancel As Boolean)
Dim lLeft As Long
Dim lTop As Long
Dim lWidth As Long
Dim lHeight As Long
   If (lRow > 0) And (lCol > 0) Then
      grdEdit.CellBoundary lRow, lCol, lLeft, lTop, lWidth, lHeight
      lLeft = lLeft + grdEdit.left
      lTop = lTop + grdEdit.top + Screen.TwipsPerPixelY
      'If (lWidth < 32 * Screen.TwipsPerPixelX) Then
      '   lWidth = 32 * Screen.TwipsPerPixelX
      'End If
      Select Case lCol
      Case 1
         ' Icon
         cboIcon.ListIndex = grdEdit.CellIcon(lRow, lCol)
         cboIcon.Move lLeft - 16 * Screen.TwipsPerPixelX, lTop, lWidth + 16 *
          Screen.TwipsPerPixelX, lHeight
         cboIcon.Visible = True
         cboIcon.SetFocus
      Case 7
         ' Categories
         selCategories.Selection = grdEdit.CellText(lRow, lCol)
         selCategories.Move lLeft, lTop, lWidth, lHeight
         selCategories.Visible = True
         selCategories.SetFocus
      Case Else
         txtEdit.Text = grdEdit.CellText(lRow, lCol)
         txtEdit.Move lLeft, lTop, lWidth, lHeight
         txtEdit.Visible = True
         txtEdit.SetFocus
         
      End Select
   End If
End Sub

Private Sub txtEdit_Change()
Dim lCol As Long
   If (grdEdit.InEditMode) Then
      lCol = grdEdit.EditCol
      Select Case grdEdit.ColumnKey(lCol)
      Case "DisplayName"
      Case "FamilyName"
      Case "GivenName"
      Case "Email"
      Case "Phone"
      Case "Birthday"
         Dim vJunk As Variant
         validEditDate True, vJunk
      End Select
   End If
End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
   Select Case KeyCode
   Case 9   ' tab
      grdEdit.EndEdit
      KeyCode = 0
   Case 13  ' return
      grdEdit.EndEdit
      KeyCode = 0
   Case 27  ' escape
      grdEdit.CancelEdit
      KeyCode = 0
   End Select
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
   Select Case KeyAscii
   Case 9
      KeyAscii = 0
   Case 13
      KeyAscii = 0
   Case 27
      KeyAscii = 0
   End Select
End Sub