Email Sample (VB6)
This sample illustrates using a splitter bar, cell merging, , sorting, column reordering.
The source code is located at C:\Program Files (x86)\Softelvdm\SftTree OCX 8.0\Samples\VB6\Email\Form1.frm or C:\Program Files\Softelvdm\SftTree OCX 8.0\Samples\VB6\Email\Form1.frm (on 32-bit Windows versions).
VERSION 5.00
Object = "{04048830-2BE4-4868-8CDC-B8E6FC7815C5}#7.5#0"; "SftTree_IX86_U_80.ocx"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Softel vdm, Inc. - Email Sample"
ClientHeight = 5655
ClientLeft = 1080
ClientTop = 1245
ClientWidth = 8505
BeginProperty Font
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 5655
ScaleWidth = 8505
Begin SftTreeLib80.SftTree SftTree1
Height = 5412
Left = 120
TabIndex = 0
Top = 120
Width = 7092
PropVer = 75
xcx = 12515
xcy = 9551
PropFile = ""
PropDesignTime = 1
DeletePropFile = 0
IntVal = 55
xBfStyle1 = 64044738
xBfStyle2 = 60245087
xBfStyle3 = 12981661
xBfStyle4 = -281417117
FlatProperties = 0
Appearance = 1
AutoRespond = 0
BackgroundStyle = 0
BackgroundX = 0
BackgroundY = 0
BorderStyle = 0
ButtonStyle = 2
CellEventHandling= 0
CellEditStyle = 0
CellEditLimit = 0
ColumnCount = 4
CopyItemDataString= 0
CustomCode = 0
DragImage = -842150451
DragMethod = 0
DragType = 3
Enabled = 1
HandleReturn = -842150451
MouseIcon = "FORM1.frx":0000
MousePointer = 0
LeftButtonOnly = 0
LeftItemClickOnly= -1
OLEDropMode = 0
RightToLeft = 0
UseThemes = -1 'True
Scrollbars = 3
ScrollbarStyle = 0
ShowTruncated = -1
VAlignStyle = 0
VirtualMode = 0
WebLicense = ""
SmoothScroll = 1
ButtonAppearance= 8
MouseOverTransitionEffect= 0
EdgeVerticalColor= -1
EdgeHorizontalColor= -1
BeginProperty ItemEditFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Columns {9EBAA93E-293D-44FA-9989-08F078763A1F}
InheritBgColor = 1
OpenEnded = 1
OpenEnded2 = 1
EndProperty
BeginProperty Headers {9EBAA936-293D-44FA-9989-08F078763A1F}
Appearance = 1
BackColor = -2147483633
ForeColor = -2147483630
GrayedColor = -2147483631
HilightColor = -2147483628
Multiline = 1
ShadowColor = -2147483632
Reorderable = 1
Resizable = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
SortIndicators = 0
EndProperty
BeginProperty Footers {9EBAA956-293D-44FA-9989-08F078763A1F}
Appearance = 0
BackColor = -2147483633
ForeColor = -2147483630
GrayedColor = -2147483631
HilightColor = -2147483628
Multiline = 1
ShadowColor = -2147483632
Reorderable = 1
Resizable = 1
EndProperty
BeginProperty Items {9EBAA93C-293D-44FA-9989-08F078763A1F}
AutoExpandDragDrop= 1
AutoExpandHover = 0
BackColor = -2147483643
BackColorOdd = -2147483643
CalcLimit = 0
CalcVisibleOnly = 0
Cell3D = 0
CharSearchColumn= 0
CharSearchMode = 1
DropHighlightColor= -2147483635
DropHighlightStyle= 1
EditNoFocusStyle= 2
FlybyHighlight = 1
ForeColor = -2147483640
ForeColorOdd = -2147483640
GrayedColor = -2147483631
GridHorizontalColor= -2147483632
GridStyle = 0
GridVerticalColor= -2147483632
HilightColor = -2147483628
HorizontalExtentPix= 0
HorizontalExtent2Pix= 0
HorizontalOffsetPix= 0
HorizontalOffset2Pix= 0
Indentation = -1
ItemImageAlign = 1
Lines = 3
MaxHeightPix = 0
MinHeightPix = 0
MultiSelect = 0
NoFocusStyle = 0
NoSelection = 1
RubberbandSelection= 1
SelectBackColor = -2147483635
SelectBackColorNoFocus= -2147483633
SelectForeColor = -2147483634
SelectForeColorNoFocus= -2147483630
ShadowColor = -2147483632
Style = 1
ScrollTips = 1
SelectionArea = 1
SelectStyle = 2
ShowFocusRectangle= 1
ToolTipAlways = 0
ToolTipBackColor= -1
ToolTipForeColor= -1
ToolTipsUseEntireCell= 1
TopIndex = 0
TreeLineColor = -2147483630
TreeLineGrayedColor= -2147483631
TreeLineStyle = 3
UpdateCurrentExpandCollapse= 0
OutlineStyle = 1
SelectOutlineBorderColor= -1
SelectInnerBorderColor= -1
SelectInnerFill1= -1
SelectInnerFill2= -1
SelectHotOutlineBorderColor= -1
SelectHotInnerBorderColor= -1
SelectHotInnerFill1= -1
SelectHotInnerFill2= -1
SelectNoFocusOutlineBorderColor= -1
SelectNoFocusInnerBorderColor= -1
SelectNoFocusInnerFill1= -1
SelectNoFocusInnerFill2= -1
HotOutlineBorderColor= -1
HotInnerBorderColor= -1
HotInnerFill1 = -1
HotInnerFill2 = -1
DropTargetOutlineBorderColor= -1
DropTargetInnerBorderColor= -1
DropTargetInnerFill1= -1
DropTargetInnerFill2= -1
DisabledItemsSelectable= 1
AutoExpandDragDropInterval= 1200
AutoExpandHoverInterval= 1200
ToolTipIntervalOn= 200
ToolTipIntervalOff= 100
BeginProperty ItemImageExpandable {980702E2-0AB6-41B1-9B85-F8755A697255}
Object.Height = 0
Object.Width = 0
Picture = "FORM1.frx":001C
Appearance = -1
FrameColor = -1
SampleColor = -1
EndProperty
BeginProperty ItemImageExpanded {980702E2-0AB6-41B1-9B85-F8755A697255}
Object.Height = 0
Object.Width = 0
Picture = "FORM1.frx":0116
Appearance = -1
FrameColor = -1
SampleColor = -1
EndProperty
BeginProperty ItemImageLeaf {980702E2-0AB6-41B1-9B85-F8755A697255}
Object.Height = 0
Object.Width = 0
Picture = "FORM1.frx":0210
Appearance = -1
FrameColor = -1
SampleColor = -1
EndProperty
EndProperty
BeginProperty RowColumnHeader {9EBAA942-293D-44FA-9989-08F078763A1F}
Appearance = 0
ButtonDown = 0
RemainUp = 1
Enabled = 1
ImageHAlign = 0
ImageVAlign = 0
TextHAlign = 0
TextVAlign = 0
Text = ""
ForeColor = -2147483630
BackColor = -2147483633
HilightColor = -2147483628
ShadowColor = -2147483632
GrayedColor = -2147483631
OverrideTheme = 0
EndProperty
BeginProperty RowColumnFooter {9EBAA95A-293D-44FA-9989-08F078763A1F}
Appearance = 1
ButtonDown = 0
RemainUp = 1
Enabled = 1
ImageHAlign = 0
ImageVAlign = 0
TextHAlign = 0
TextVAlign = 0
Text = ""
ForeColor = -2147483630
BackColor = -2147483633
HilightColor = -2147483628
ShadowColor = -2147483632
GrayedColor = -2147483631
OverrideTheme = 0
EndProperty
BeginProperty RowHeaders {9EBAA944-293D-44FA-9989-08F078763A1F}
Appearance = 0
RemainUp = 1
Enabled = 1
Lines = 1
TextHAlign = 0
TextVAlign = 0
Object.Width = 0
BackColor = -2147483633
ForeColor = -2147483630
GrayedColor = -2147483631
HilightColor = -2147483628
ShadowColor = -2147483632
SelectBackColor = -2147483633
SelectForeColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
EndProperty
BeginProperty Splitter {9EBAA94A-293D-44FA-9989-08F078763A1F}
SplitColumn = 1
Object.Visible = 1
OffsetPix = 87
WidthPix = 3
EndProperty
BeginProperty Column(0) {9EBAA938-293D-44FA-9989-08F078763A1F}
BackColor = -1
CellHAlign = 0
CellMultiline = 0
CellVAlign = 0
CellWordWrap = 0
ForeColor = -1
Merge = 1
MergeInto = 1
MinWidth = 17
SelectBackColor = -1
SelectForeColor = -1
ToolTip = 1
Object.Width = 83
RealPos = 0
DispPos = 0
BackColorEnd = -1
SelectBackColorEnd= -1
ProgressColor = -1
ProgressColorEnd= -1
BackColorOrientation= 0
ProgressColor = -1
ProgressColorEnd= -1
ProgressColorOrientation= 0
ProgressStyle = 0
EndProperty
BeginProperty Header(0) {9EBAA93A-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 1
Locked = 0
ImageHAlign = 2
ImageVAlign = 0
RemainUp = 1
Text = "Folder"
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Footer(0) {9EBAA958-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
ImageHAlign = 0
ImageVAlign = 0
RemainUp = 0
Text = ""
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Column(1) {9EBAA938-293D-44FA-9989-08F078763A1F}
BackColor = -1
CellHAlign = 0
CellMultiline = 0
CellVAlign = 0
CellWordWrap = 0
ForeColor = -1
Merge = 1
MergeInto = 1
MinWidth = 17
SelectBackColor = -1
SelectForeColor = -1
ToolTip = 1
Object.Width = 125
RealPos = 1
DispPos = 1
BackColorEnd = -1
SelectBackColorEnd= -1
ProgressColor = -1
ProgressColorEnd= -1
BackColorOrientation= 0
ProgressColor = -1
ProgressColorEnd= -1
ProgressColorOrientation= 0
ProgressStyle = 0
EndProperty
BeginProperty Header(1) {9EBAA93A-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
Locked = 0
ImageHAlign = 2
ImageVAlign = 0
RemainUp = 1
Text = "Description"
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Footer(1) {9EBAA958-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
ImageHAlign = 0
ImageVAlign = 0
RemainUp = 0
Text = ""
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Column(2) {9EBAA938-293D-44FA-9989-08F078763A1F}
BackColor = -1
CellHAlign = 2
CellMultiline = 0
CellVAlign = 0
CellWordWrap = 0
ForeColor = -1
Merge = 1
MergeInto = 1
MinWidth = 17
SelectBackColor = -1
SelectForeColor = -1
ToolTip = 1
Object.Width = 125
RealPos = 2
DispPos = 2
BackColorEnd = -1
SelectBackColorEnd= -1
ProgressColor = -1
ProgressColorEnd= -1
BackColorOrientation= 0
ProgressColor = -1
ProgressColorEnd= -1
ProgressColorOrientation= 0
ProgressStyle = 0
EndProperty
BeginProperty Header(2) {9EBAA93A-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
Locked = 0
ImageHAlign = 2
ImageVAlign = 0
RemainUp = 1
Text = "Received"
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Footer(2) {9EBAA958-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
ImageHAlign = 0
ImageVAlign = 0
RemainUp = 0
Text = ""
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Column(3) {9EBAA938-293D-44FA-9989-08F078763A1F}
BackColor = -1
CellHAlign = 2
CellMultiline = 0
CellVAlign = 0
CellWordWrap = 0
ForeColor = -1
Merge = 1
MergeInto = 1
MinWidth = 17
SelectBackColor = -1
SelectForeColor = -1
ToolTip = 1
Object.Width = 50
RealPos = 3
DispPos = 3
BackColorEnd = -1
SelectBackColorEnd= -1
ProgressColor = -1
ProgressColorEnd= -1
BackColorOrientation= 0
ProgressColor = -1
ProgressColorEnd= -1
ProgressColorOrientation= 0
ProgressStyle = 0
EndProperty
BeginProperty Header(3) {9EBAA93A-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
Locked = 0
ImageHAlign = 2
ImageVAlign = 0
RemainUp = 1
Text = "Size"
TextHAlign = 2
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
BeginProperty Footer(3) {9EBAA958-293D-44FA-9989-08F078763A1F}
Enabled = 1
KeepPosition = 0
ImageHAlign = 0
ImageVAlign = 0
RemainUp = 0
Text = ""
TextHAlign = 0
TextVAlign = 0
BackColor = -1
ForeColor = -1
SelectBackColor = -1
SelectForeColor = -1
BackColorDisabled= -1
ForeColorDisabled= -1
OverrideTheme = 0
Button = 0
EndProperty
SavedItemCount = 0
SavedColumnCount= 4
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox EditControl
Appearance = 0 'Flat
Height = 285
Left = 7320
TabIndex = 2
Text = "Text1"
Top = 1200
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "&Close"
Height = 375
Left = 7320
TabIndex = 1
Top = 120
Width = 1092
End
Begin VB.Label Label5
Caption = "Click on the SftTree/OCX control and hit F1 to access online help for SftTree/OCX 8.0"
BeginProperty Font
Name = "Microsoft Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 7320
TabIndex = 3
Top = 2040
Visible = 0 'False
Width = 1095
End
Begin VB.Image Attach
Height = 240
Left = 7320
Picture = "FORM1.frx":030A
Top = 840
Visible = 0 'False
Width = 150
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim InboxFolder As Long
Dim OutboxFolder As Long
Dim SavedFolder As Long
Dim DeletedFolder As Long
Private Function AddFolder(ByVal Folder As String, ByVal Desc As String, ByVal Count As Integer)
Dim ItemIndex As Long
With SftTree1
ItemIndex = .Items.Add(Folder) ' add folder
.Cell(ItemIndex, 1).Text = Desc ' add description
.Cell(ItemIndex, 3).Text = Count ' add number of messages
.Cell(ItemIndex, 3).Data = Count ' also save number of messages for sorting
' make the folder name bold
.Cell(ItemIndex, 0).Font.Bold = True
' if this folder has no messages (ie. ), we still want the
' folder graphic, not the email (leaf) graphic
If Count = 0 Then
.Item(ItemIndex).Image = .Items.ItemImageExpandable
End If
AddFolder = .Item(ItemIndex).ID
End With
End Function
Private Function AddMessage(ByVal Level As Integer, ByVal Email As String, ByVal Desc As String, ByVal Dt As String, ByVal Size As Integer, ByVal Attachment As Boolean)
Dim ItemIndex As Long
With SftTree1
ItemIndex = .Items.Add(Email) ' add folder
.Item(ItemIndex).Level = Level
.Cell(ItemIndex, 1).Text = Desc ' add description
.Cell(ItemIndex, 2).Text = Dt ' add date
.Cell(ItemIndex, 3).Text = Size & "K"
.Cell(ItemIndex, 3).Data = Size ' also save size for sorting
' if this email has replies (ie. ), we still want the
' email graphic, not the expand folder image
.Item(ItemIndex).Image = .Items.ItemImageLeaf
' if the email has an attachment, show the image
If Attachment Then
Set .Cell(ItemIndex, 1).Image.Picture = Attach.Picture
.Cell(ItemIndex, 1).ImageHAlign = halignSftTreeRight
End If
End With
End Function
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
With SftTree1
InboxFolder = AddFolder("Inbox", "Viewed and unviewed mail", 10)
AddMessage 1, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True
AddMessage 1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
AddMessage 1, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, True
AddMessage 1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False
.Item(.Items.ItemIndex(InboxFolder)).Collapse False
OutboxFolder = AddFolder("Outbox", "Mail about to be sent", 2)
AddMessage 1, "me@mycompany.com", "Re: You're fired", "10/11/05", 5, False
AddMessage 1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
.Item(.Items.ItemIndex(OutboxFolder)).Collapse False
SavedFolder = AddFolder("Saved", "Saved messages", 2)
AddMessage 1, "me@mycompany.com", "A support question", "10/09/05", 3, False
AddMessage 2, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True
AddMessage 3, "me@mycompany.com", "Re: A support question", "10/09/05", 3, False
AddMessage 1, "me@mycompany.com", "Why did you say that", "10/06/05", 5, False
AddMessage 2, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
AddMessage 1, "me@mycompany.com", "You're fired", "10/08/05", 2, False
AddMessage 2, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, False
AddMessage 1, "me@mycompany.com", "You're hired", "10/01/05", 4, False
AddMessage 1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False
.Item(.Items.ItemIndex(SavedFolder)).Collapse False
DeletedFolder = AddFolder("Deleted", "Deleted messages", 0)
.ColumnsObj.MakeOptimal
.Items.RecalcHorizontalExtent
.Splitter.MakeOptimal
' allow sorting
.Headers.SortIndicators = headerSortIndicatorsSftTreeAuto
.Items.Current = 0
SftTree1_CaretChange 0 ' to update column headers
End With
End Sub
Private Sub SftTree1_CaretChange(ByVal ItemIndex As Long)
With SftTree1
' set column headers based on selected item
Select Case .Item(ItemIndex).ID
Case InboxFolder, OutboxFolder, SavedFolder, DeletedFolder
.Header(0).Text = "Folder"
.Header(1).Text = "Description"
.Header(2).Text = "" ' we can use this to merge the adjacent title
.Header(3).Text = "Msgs"
Case Else
.Header(0).Text = "From"
.Header(1).Text = "Subject"
.Header(2).Text = "Received"
.Header(3).Text = "Size"
End Select
End With
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)
Dim Ascending As Boolean
With SftTree1
If AreaType = constSftTreeButton Then
If .Item(ItemIndex).Expanded Then
.Item(ItemIndex).Collapse True
Else
.Item(ItemIndex).Expand True, False
End If
ElseIf AreaType = constSftTreeText Then
' edit description
If ColIndex = 1 Then
.Cell(ItemIndex, ColIndex).Edit 0, 0
End If
ElseIf AreaType = constSftTreeColumn Then
Dim SortedColumn As Integer
SortedColumn = .Headers.SortedColumn
If SortedColumn >= 0 Then
' we have to sort based on current column headers
' we saved a value in Item.Data telling us if it's a folder
Select Case .Item(.Items.Current).ID
Case InboxFolder, OutboxFolder, SavedFolder, DeletedFolder
' we're on a folder, so sort on folder level
If .Header(SortedColumn).SortIndicator = sortIndicatorSftTreeAscending Then
If SortedColumn = 3 Then
' last column is sorted by Cell.Data (numeric values)
.Items.SortDependents -1, SortedColumn, sortSftTreeAscCellItemData
Else
.Items.SortDependents -1, SortedColumn, sortSftTreeAscending
End If
Else
If SortedColumn = 3 Then
.Items.SortDependents -1, SortedColumn, sortSftTreeDscCellItemData
Else
.Items.SortDependents -1, SortedColumn, sortSftTreeDescending
End If
End If
Case Else
' we're on a message, sort inside folders
' now sort the of all folders
ItemIndex = 0
Do
If .Header(SortedColumn).SortIndicator = sortIndicatorSftTreeAscending Then
If SortedColumn = 3 Then
' last column is sorted by Cell.Data (numeric values)
.Items.SortDependents ItemIndex, SortedColumn, sortSftTreeAscCellItemData
Else
.Items.SortDependents ItemIndex, SortedColumn, sortSftTreeAscending
End If
Else
If SortedColumn = 3 Then
.Items.SortDependents ItemIndex, SortedColumn, sortSftTreeDscCellItemData
Else
.Items.SortDependents ItemIndex, SortedColumn, sortSftTreeDescending
End If
End If
ItemIndex = .Item(ItemIndex).NextSibling
Loop Until ItemIndex < 0
End Select
SftTree1_CaretChange .Items.Current
End If
End If
End With
End Sub
Private Sub SftTree1_ItemDblClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
With SftTree1
If AreaType = constSftTreeText Or AreaType = constSftTreeButton Then
' if an item on level 1 or lower is clicked, it's an
' email message, display message box
If .Item(ItemIndex).Level > 0 And AreaType = constSftTreeText Then
MsgBox ("You could be viewing the message from " & .Cell(ItemIndex, 0).Text & _
" with the subject '" & .Cell(ItemIndex, 1).Text & "'.")
Else
' otherwise just expand or collapse the item
If .Item(ItemIndex).Expanded Then
.Item(ItemIndex).Collapse True
Else
.Item(ItemIndex).Expand True, False
End If
End If
ElseIf AreaType = constSftTreeColumnRes Then
If ColIndex >= 0 Then
.Column(ColIndex).MakeOptimal
.Items.RecalcHorizontalExtent
Else
.Splitter.MakeOptimal
End If
End If
End With
End Sub
Private Sub SftTree1_EditAllowed(ByVal ItemIndex As Long, ByVal ColIndex As Integer, Allowed As Boolean)
' Only allow editing in column 1
If ColIndex = 1 Then
Allowed = True
Else
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 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 = EditControl.Height / Screen.TwipsPerPixelX
TopPix = TopPix + (HeightPix - TextHeight) / 2
HeightPix = TextHeight
EditControl.Width = Width * Screen.TwipsPerPixelX
EditControl.Text = SftTree1.Cell(EditIndex, EditCol).Text
EditControl.SelStart = 0
EditControl.SelLength = 999
' Return the control's window handle
Window = EditControl.hWnd
' 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
' VK_UP
SftTree1.CellEditIntercept 38, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
' VK_DOWN
SftTree1.CellEditIntercept 40, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
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
If EditControl.Text = "" Then
MsgBox ("Please enter a description.")
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 SaveInput Then
SftTree1.Cell(EditIndex, EditCol).Text = EditControl.Text
End If
End Sub
On
Off