Option Explicit Private Sub Command1_Click() End End Sub Private Sub Form_Load() Dim ItemIndex As Integer Dim Dt As Date Dim S As String Text1.Text = "In this example, the first column uses a SftMask/OCX Masked Edit control " & _ "to enter an amount. Try entering a new amount, then type + or - to access the built-in " & _ "popup calculator." & vbCr & vbLf & vbCr & vbLf & _ "The second column uses a SftBox/OCX Combo Box control." & vbCr & vbLf & vbCr & vbLf & _ "The last column again uses a SftMask/OCX Masked Edit control to enter a date. Click on the " & _ "drop down button to access the popup calendar." ItemIndex = SftTree1.Items.Add("Edit cells" & vbCr & vbLf & "using SftMask/OCX:") SftTree1.Item(ItemIndex).EditIgnore = True SftTree1.Cell(ItemIndex, 1).Text = vbCr & vbLf & "using SftBox/OCX:" SftTree1.Cell(ItemIndex, 2).Text = "and again" & vbCr & vbLf & "using SftMask/OCX:" ItemIndex = SftTree1.Items.Add("5.33") SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight SftTree1.Cell(ItemIndex, 1).Text = "Option 1" Dt = Date - 1 S = "short" SftMaskDateTime.Calendar.FormatDate Dt, S SftTree1.Cell(ItemIndex, 2).Text = S SftTree1.Cell(ItemIndex, 2).DataTag = Dt ItemIndex = SftTree1.Items.Add("122.33") SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight SftTree1.Cell(ItemIndex, 1).Text = "Option 3" Dt = Date S = "short" SftMaskDateTime.Calendar.FormatDate Dt, S SftTree1.Cell(ItemIndex, 2).Text = S SftTree1.Cell(ItemIndex, 2).DataTag = Dt ItemIndex = SftTree1.Items.Add("66.05") SftTree1.Cell(ItemIndex, 0).TextHAlign = halignSftTreeDefaultRight SftTree1.Cell(ItemIndex, 1).Text = "Option 2" Dt = Date + 1 S = "short" SftMaskDateTime.Calendar.FormatDate Dt, S SftTree1.Cell(ItemIndex, 2).Text = S SftTree1.Cell(ItemIndex, 2).DataTag = Dt SftTree1.ColumnsObj.MakeOptimal SftTree1.RowHeaders.MakeOptimal SftTree1.Items.RecalcHorizontalExtent SftTree1.Item(0).Selected = True End Sub Private Sub SftTree1_ItemClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer) ' User clicked on a cell If AreaType = constSftTreeCellText Then SftTree1.Cell(ItemIndex, ColIndex).Edit 0, 0 End If End Sub Private Sub SftTree1_EditAllowed(ByVal ItemIndex As Long, ByVal ColIndex As Integer, Allowed As Boolean) ' Last chance to suppress cell editing for a cell 'If ItemIndex = 1 And ColIndex = 1 Then ' Allowed = False 'End If End Sub Private Sub SftTree1_EditInitializing(Window As stdole.OLE_HANDLE, vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, LeftPix As stdole.OLE_XPOS_PIXELS, TopPix As stdole.OLE_YPOS_PIXELS, WidthPix As stdole.OLE_XSIZE_PIXELS, HeightPix As stdole.OLE_YSIZE_PIXELS) Dim ctrl As Control ' Choose a control based on current column being edited If EditCol = 0 Then Set ctrl = SftMaskAmount ElseIf EditCol = 1 Then Set ctrl = SftBox1 Else Set ctrl = SftMaskDateTime End If Dim TextHeight As Integer ' LeftPix/TopPix/WidthPix/HeightPix describes the current cell area ' we need to return the position and size needed for editing. ' In this example, we use the height of the control on the form ' and center it over the cell. TextHeight = ctrl.Height / Screen.TwipsPerPixelX TopPix = TopPix + (HeightPix - TextHeight) / 2 HeightPix = TextHeight ' Set the text in the control used for cell editing and ' set other control-specific properties If ctrl Is SftMaskAmount Then SftMaskAmount.Text = SftTree1.Cell(EditIndex, EditCol).Text SftMaskAmount.SelStart = 0 SftMaskAmount.SelLength = 999 ElseIf ctrl Is SftMaskDateTime Then SftMaskDateTime.Contents.DateTime = SftTree1.Cell(EditIndex, EditCol).DataTag Else SftBox1.Items.Clear Dim ItemIndex As Long ItemIndex = SftBox1.Items.Add("Option 1") SftBox1.Cell(ItemIndex, 1).Text = "Description for option 1" ItemIndex = SftBox1.Items.Add("Option 2") SftBox1.Cell(ItemIndex, 1).Text = "Description for option 2" ItemIndex = SftBox1.Items.Add("Option 3") SftBox1.Cell(ItemIndex, 1).Text = "Description for option 3" Dim S As String S = SftTree1.Cell(EditIndex, EditCol).Text If SftBox1.Items.Find(S, 0, 0, False, True, True) < 0 Then ItemIndex = SftBox1.Items.Add(S) SftBox1.Cell(ItemIndex, 1).Text = "Description for " & S End If SftBox1.Columns.MakeOptimal 0 SftBox1.RecalcHorizontalExtent 0 SftBox1.Edit.Text = SftTree1.Cell(EditIndex, EditCol).Text End If ' Return the control's window handle Window = ctrl.Window ' Define navigation keys ' VK_TAB SftTree1.CellEditIntercept Asc(vbTab), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar ' VK_RETURN SftTree1.CellEditIntercept Asc(vbCr), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar ' VK_HOME SftTree1.CellEditIntercept 36, cellEditInterceptSftTreeControlChar ' VK_END SftTree1.CellEditIntercept 35, cellEditInterceptSftTreeControlChar If ctrl Is SftMaskAmount Then ' We want these keys just for the amount edit control. ' VK_UP SftTree1.CellEditIntercept 38, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar ' VK_DOWN SftTree1.CellEditIntercept 40, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar End If End Sub Private Sub SftTree1_EditInitialized(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, ByVal ParentWindow As stdole.OLE_HANDLE, ByVal LeftPix As Long, ByVal TopPix As Long, ByVal WidthPix As Long, ByVal HeightPix As Long, Positioned As Boolean) ' We position the control (ActiveX controls must be positioned using the EditInitialized event) Positioned = True If Window = SftMaskAmount.hWnd Then SftMaskAmount.Left = LeftPix * Screen.TwipsPerPixelX SftMaskAmount.Top = TopPix * Screen.TwipsPerPixelY SftMaskAmounZen.TwipsPerPixelX SftMaskAmount.Height = HeightPix * Screen.TwipsPerPixelY SftMaskAmount.Enabled = True SftMaskAmount.Visible = True SftMaskAmount.SetFocus ElseIf Window = SftMaskDateTime.hWnd Then SftMaskDateTime.Left = LeftPix * Screen.TwipsPerPixelX SftMaskDateTime.Top = TopPix * Screen.TwipsPerPixelY SftMaskDateTime.Width = WidthPix * Screen.TwipsPerPixelX SftMaskDateTime.Height = HeightPix * Screen.TwipsPerPixelY SftMaskDateTime.Enabled = True SftMaskDateTime.Visible = True SftMaskDateTime.SetFocus Else SftBox1.Left = LeftPix * Screen.TwipsPerPixelX SftBox1.Zeen.TwipsPerPixelY SftBox1.Width = WidthPix * Screen.TwipsPerPixelX SftBox1.Height = HeightPix * Screen.TwipsPerPixelY SftBox1.Enabled = True SftBox1.Visible = True SftBox1.SetFocus SftBox1.Edit.SetSelection 0, -1 SftBox1.DropDown.Dropped = True End If End Sub Private Sub SftTree1_EditNavigating(ByVal Key As Long, ByVal Shift As Integer, ByVal ItemIndex As Long, ByVal ColIndex As Integer) ' Process key pressed SftTree1.EditNavigate Key, Shift End Sub Private Sub SftTree1_EditValidate(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, InputValid As Boolean) ' Validate the new cell contents Dim S As String If Window = SftMaskAmount.hWnd Then If Not SftMaskAmount.Contents.Valid Then ' could validate End If S = SftMaskAmount.TextDisplay ElseIf Window = SftMaskDateTime.hWnd Then If Not SftMaskDateTime.Contents.Valid Then MsgBox ("Please enter a valid date.") InputValid = False Exit Sub End If S = SftMaskDateTime.TextDisplay Else S = SftBox1.Edit.Text End If S = Trim(S) If Len(S) <= 0 Then MsgBox ("Just to demonstrate data input validation, this example rejects empty cells. Please enter some data.") InputValid = False End If End Sub Private Sub SftTree1_EditEnding(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, ByVal SaveInput As Boolean) ' Save the new cell contents If Window = SftMaskAmount.hWnd Then SftMaskAmount.Visible = False SftMaskAmount.Enabled = False If SaveInput Then SftTree1.Cell(EditIndex, EditCol).Text = SftMaskAmount.TextDisplay End If ElseIf Window = SftMaskDateTime.hWnd Then SftMaskDateTime.Visible = False SftMaskDateTime.Enabled = False If SaveInput Then SftTree1.Cell(EditIndex, EditCol).Text = SftMaskDateTime.TextDisplay SftTree1.Cell(EditIndex, EditCol).DataTag = SftMaskDateTime.Contents.DateTime End If Else SftBox1.Visible = False SftBox1.Enabled = False If SaveInput Then SftTree1.Cell(EditIndex, EditCol).Text = SftBox1.Edit.Text End If End If End Sub Private Sub SftTree1_ToolTipVScroll(Text As String, ByVal ItemIndex As Long, ByVal ColIndex As Integer) Text = "Item " & ItemIndex & " - " & Text End Sub Private Sub SftMaskAmount_UpDownPress(ByVal Up As Boolean, ByVal FieldStart As Long, ByVal FieldEnd As Long, ByVal Counter As Long, Field As String) Dim Increment As Single If Counter = 0 Or Counter > 5 Then If Val(Field) = 0 Then Field = 0 End If Increment = 0.01 If Counter > 14 Then Increment = 0.1 If Counter > 23 Then Increment = 1 If Counter > 52 Then Increment = 10 If Up Then Field = Field + Increment Else Field = Field - Increment End If ' If Field > yourMaximum Then Field = yourMaximum ' If Field < -yourMaximum Then Field = -yourMaximum Field = Format(Field, "###0.00") End If End Sub