Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/axtree/axtree.old

Text File | 1998-08-26 | 40.1 KB | 1,077 lines

Attribute VB_Name = "otlcb95bas"
Option Explicit
Option Base 1

'OTL variables
Public Type OtlSetup 'one per outline
    Levels As Integer
    VariableNames(5) As String 'Max 5 levels
    BmpField As String 'field holding bitmap to use for leafs if not use default
    CheckmarkField As String 'field to examine to determine if record is selected
    BmpFlag As Integer
    LineFlag As Integer
    PlusFlag As Integer
    CheckmarkFlag As Integer
    AutoCheckParents As Integer
    DisplayLines As Integer
    DisplayIdx(100) As Integer 'Max 100 lines visible
    DisplayCount As Integer 'virtual Ubound of displayidx
    VisibleItems As Integer
    VisChangeFlag As Integer
    LineHeight As Integer 'Twips
    ColWidth As Integer 'twips
    ElementClicked As Integer
    SelectColor As Long 'RGB
    SelectTextColor As Long
    FontName As String
    FontColor As Long
    Fontsize As Single
    TopIdx As Integer
    SelectIdx As Integer
    CurrentLine As Integer
    PrevTop As Integer
    PrevSel As Integer
    LastType As Integer     ' 0=None, 1=Parent, 2=Collapse, 3=Expand, 4=Child, Last clicked or keypress
End Type

Public Type OtlData  'Use in array
    Caption As String
    Level As Integer
    Visible As Integer
    Expanded As Integer
    VisibleIdx As Long
    Bookmark As String
    Bitmap As Picture 'if not use default
    Selected As Integer '0-none, 1-all, 2-some
    SyncIdx As Integer 'Optional, sync to another array
    Itemdata As Long
    IsParent As Boolean 'is this a parent
End Type

'standard images
Global gBranchOpenPic As Control
Global gBranchClosedPic As Control
Global gLeafPic As Control
Global gCustomPic As Control
Global gPlusPic As Control
Global gMinusPic As Control
'checked images
Global gBranchOpenAllPic As Control 'checked
Global gBranchClosedAllPic As Control
Global gBranchOpenSomePic As Control
Global gBranchClosedSomePic As Control
Global gLeafCheckedPic As Control
Dim ChangingScroll As Integer

'KeyCodes Constants
Const KEY_PRIOR = &H21
Const KEY_NEXT = &H22
Const KEY_END = &H23
Const KEY_HOME = &H24
Const KEY_LEFT = &H25
Const KEY_UP = &H26
Const KEY_RIGHT = &H27
Const KEY_DOWN = &H28
Const KEY_ADD = &H6B
Const KEY_SUBTRACT = &H6D

#If Win32 Then
    Declare Function BitBlt Lib "gdi32" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal dwRop&) As Integer
    Declare Function StretchBlt Lib "gdi32" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal nsrcWidth%, ByVal nsrcHeight%, ByVal dwRop&) As Integer
    Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
#Else
    Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal dwRop&) As Integer
    Declare Function StretchBlt Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal nsrcWidth%, ByVal nsrcHeight%, ByVal dwRop&) As Integer
    Declare Function SetPixel Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Long) As Long
#End If

'Establishes the Bitmap objects for an outline control
'Sub OutlineBmpSetup(BranchOpen As Control, BoFile As String, BranchClosed As Control, BcFile As String, Leaf As Control, LFile As String, CustomPic As Control)
'On Error Resume Next
'
'Set gBranchOpenPic = IIf(m_PictureOpen = Nothing, BranchOpen, m_PictureOpen)
'Set gBranchClosedPic = IIf(m_PictureClosed = Nothing, BranchClosed, m_PictureClosed)
'Set gLeafPic = IIf(m_PictureItemNotSelected = Nothing, Leaf, m_PictureItemNotSelected)
'Set gCustomPic = IIf(m_PictureItemNotSelected = Nothing, CustomPic, m_PictureItemNotSelected)
'
'If BoFile > "" Then gBranchOpenPic.Picture = LoadPicture(BoFile)
'If BcFile > "" Then gBranchClosedPic.Picture = LoadPicture(BcFile)
'If LFile > "" Then gLeafPic.Picture = LoadPicture(LFile)
'
'End Sub
Sub OutlineBmpSetup(BranchOpen As Control, BoPic As Picture, BranchClosed As Control, BcPic As Picture, Leaf As Control, LPic As Picture, CustomPic As Control, CPic As Picture)
On Error Resume Next

Set gBranchOpenPic = BranchOpen
Set gBranchClosedPic = BranchClosed
Set gLeafPic = Leaf
Set gCustomPic = CustomPic

If Not BoPic Is Nothing Then gBranchOpenPic.Picture = BoPic
If Not BcPic Is Nothing Then gBranchClosedPic.Picture = BcPic
If Not LPic Is Nothing Then gLeafPic.Picture = LPic
If Not CPic Is Nothing Then gCustomPic.Picture = CPic

End Sub

Sub OutlineBmpCheckedSetup(BranchOpenAll As Control, BoaPic As Picture, BranchClosedAll As Control, BcaPic As Picture, BranchOpenSome As Control, BosPic As Picture, BranchClosedSome As Control, BcsPic As Picture, LeafChecked As Control, LcPic As Picture)
'On Error Resume Next

Set gBranchOpenAllPic = BranchOpenAll
Set gBranchClosedAllPic = BranchClosedAll
Set gBranchOpenSomePic = BranchOpenSome
Set gBranchClosedSomePic = BranchClosedSome
Set gLeafCheckedPic = LeafChecked

If Not BoaPic Is Nothing Then gBranchOpenAllPic.Picture = BoaPic
If Not BcaPic Is Nothing Then gBranchClosedAllPic.Picture = BcaPic
If Not BosPic Is Nothing Then gBranchOpenSomePic.Picture = BosPic
If Not BcsPic Is Nothing Then gBranchClosedSomePic.Picture = BcsPic
If Not LcPic Is Nothing Then gLeafCheckedPic.Picture = LcPic


End Sub


'Processes a mouse click.
Sub OutlineClick(OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer
Dim Children As Integer

'set select
OtlSet.LastType = 0
If OtlSet.CurrentLine > OtlSet.DisplayCount Then Exit Sub

'default as child click, but change later if parent
OtlSet.LastType = IIf(OtlSet.ElementClicked > 0, 4, 0)

'If OtlSet.ElementClicked > 0 Then OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)

'if pictureclick then select all or deselect all, don't expand
If OtlSet.ElementClicked = 1 And OtlSet.CheckmarkFlag Then
  If Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).IsParent Then
    OtlSet.LastType = 1
  Else
    OtlSet.LastType = 4
  End If
  OtlSet.VisChangeFlag = True
  If Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Selected = 1 Then
    Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Selected = 0
  Else
    Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Selected = 1
  End If

  If OtlSet.AutoCheckParents Then
    'set child select
    For foo = OtlSet.DisplayIdx(OtlSet.CurrentLine) + 1 To Otldat.Count
      If Otldat(foo).Level <= Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level Then Exit For
      Otldat(foo).Selected = Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Selected
    Next foo
    'set parent selects
    CheckMarkParents OtlSet, Otldat
  End If
Else
  'is it a branch?
  'If OtlDat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level < OtlSet.Levels - 1 Then
  If Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).IsParent Then

      OtlSet.VisChangeFlag = True
      'was it expanded?
      If Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Expanded = True Then
          'Collapse children
          OtlSet.LastType = 2
          For foo = OtlSet.DisplayIdx(OtlSet.CurrentLine) + 1 To Otldat.Count
              If Otldat(foo).Level <= Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level Then Exit For
              Otldat(foo).Expanded = False
              Otldat(foo).Visible = False
          Next foo
      Else
          'Expand next level
          OtlSet.LastType = 3
          Children = 0
          For foo = OtlSet.DisplayIdx(OtlSet.CurrentLine) + 1 To Otldat.Count
              If Otldat(foo).Level <= Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level Then
                  Exit For
              Else
                  If Otldat(foo).Level = Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level + 1 Then
                      Otldat(foo).Expanded = False
                      Otldat(foo).Visible = True
                      Children = Children + 1
                  End If
              End If
          Next foo
      End If
      Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Expanded = Not Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Expanded
      If Children + OtlSet.CurrentLine >= OtlSet.DisplayLines Then
        If Children < OtlSet.DisplayLines Then
          OtlSet.TopIdx = OtlSet.DisplayIdx((OtlSet.CurrentLine + Children + 1) - OtlSet.DisplayLines)
          OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
          OtlSet.CurrentLine = OtlSet.CurrentLine - (Children + 1)
        Else
          OtlSet.TopIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
          OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
          OtlSet.CurrentLine = 1
        End If

      End If

  End If
End If
OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

End Sub

Public Sub OutlineExpand(Index As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer
Dim Children As Integer

'set select
OtlSet.LastType = 0
OtlSet.SelectIdx = Index

  If Otldat(Index).IsParent Then

      OtlSet.VisChangeFlag = True
      'was it expanded?
      If Otldat(Index).Expanded = False Then
          'Expand next level
          OtlSet.LastType = 3
          Children = 0
          For foo = Index + 1 To Otldat.Count
              If Otldat(foo).Level <= Otldat(Index).Level Then
                  Exit For
              Else
                  If Otldat(foo).Level = Otldat(Index).Level + 1 Then
                      Otldat(foo).Expanded = False
                      Otldat(foo).Visible = True
                      Children = Children + 1
                  End If
              End If
          Next foo

      Otldat(Index).Expanded = True
      If Children + Index >= OtlSet.DisplayLines Then
        If Children < OtlSet.DisplayLines Then
          OtlSet.TopIdx = (Index + Children + 1) - OtlSet.DisplayLines
          OtlSet.SelectIdx = Index
          Index = Index - (Children + 1)
        Else
          OtlSet.TopIdx = Index
          OtlSet.SelectIdx = Index
          OtlSet.CurrentLine = 1
        End If  'if children
      End If
      End If

  End If
OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

End Sub

Public Sub OutlineCollapse(Index As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer
Dim Children As Integer

'set select
OtlSet.LastType = 0
OtlSet.SelectIdx = Index

  If Otldat(Index).IsParent Then

      OtlSet.VisChangeFlag = True
      'was it expanded?
      If Otldat(Index).Expanded = True Then
          'Collapse children
          OtlSet.LastType = 2
          For foo = Index + 1 To Otldat.Count
              If Otldat(foo).Level <= Otldat(Index).Level Then Exit For
              Otldat(foo).Expanded = False
              Otldat(foo).Visible = False
          Next foo

          Otldat(Index).Expanded = False
          OtlSet.TopIdx = Index
          OtlSet.SelectIdx = Index
          OtlSet.CurrentLine = 1
      End If

  End If
OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

End Sub

Public Sub CheckMarkParents(OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer
ReDim LevelValue(OtlSet.Levels) As Double
ReDim levelcount(OtlSet.Levels) As Integer
For foo = Otldat.Count To 1 Step -1
  'handle control break if this is not a child
'  If OtlDat(foo).Level <= OtlSet.Levels - 2 Then
  If Otldat(foo).IsParent Then
    If LevelValue(Otldat(foo).Level + 1) = 0 Then
      Otldat(foo).Selected = 0  'none selected
    Else
      If levelcount(Otldat(foo).Level + 1) = LevelValue(Otldat(foo).Level + 1) Then
        Otldat(foo).Selected = 1  'all selected
      Else
        Otldat(foo).Selected = 2  'some selected
      End If
    End If
    LevelValue(Otldat(foo).Level + 1) = 0
    levelcount(Otldat(foo).Level + 1) = 0
  End If
  If Otldat(foo).Level > 0 Then
    'increment parent count
    Select Case Otldat(foo).Selected
    Case 1
      LevelValue(Otldat(foo).Level) = LevelValue(Otldat(foo).Level) + 1
    Case 2
      LevelValue(Otldat(foo).Level) = LevelValue(Otldat(foo).Level) + 0.0001
    End Select
    levelcount(Otldat(foo).Level) = levelcount(Otldat(foo).Level) + 1

  End If
Next foo
End Sub

'Closes all open branches.

Sub OutlineCollapseAll(OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer
Dim TotVisible As Integer
For foo = 1 To Otldat.Count
    If Otldat(foo).Level > 0 Then
        Otldat(foo).Visible = False
        Otldat(foo).Expanded = False
    Else
        Otldat(foo).Expanded = False
    End If
    If Otldat(foo).Visible = True Then TotVisible = TotVisible + 1
Next foo
If Otldat(OtlSet.SelectIdx).Visible = False Then OtlSet.SelectIdx = 1
If TotVisible <= OtlSet.DisplayLines Then
  OtlSet.TopIdx = 1
Else
  OtlSet.TopIdx = OtlSet.SelectIdx
End If
OtlSet.VisChangeFlag = True
OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

End Sub


'Opens all branches.

Sub OutlineExpandAll(OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer

For foo = 1 To Otldat.Count
    Otldat(foo).Visible = True
    'If OtlDat(foo).Level < OtlSet.Levels - 1 Then OtlDat(foo).Expanded = True
    If Otldat(foo).IsParent Then Otldat(foo).Expanded = True
Next foo
OtlSet.VisChangeFlag = True
OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

End Sub


'Locates text within the control.

Sub OutlineFind(FindItem As String, FindMode As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim ItemStart As Integer, foo As Integer, foobar As Integer
Dim foo2 As Integer
If FindMode = 0 Then
    ItemStart = 1
Else
    ItemStart = OtlSet.SelectIdx + 1
End If
For foo = ItemStart To Otldat.Count
    If InStr(1, Otldat(foo).Caption, FindItem, 1) > 0 Then
        OtlSet.SelectIdx = foo
        OtlSet.TopIdx = foo
        If Otldat(foo).Level <> 0 Then
            For foobar = foo To 1 Step -1
                If Otldat(foobar).Level = 0 Then
                    Otldat(foobar).Expanded = True
                    Otldat(foobar).Visible = True
                    Exit For
                End If
            Next foobar
            For foo2 = foobar + 1 To Otldat.Count
                If Otldat(foo2).Level = 0 Then Exit For
                Otldat(foo2).Visible = True
            Next foo2
        End If
        OtlSet.CurrentLine = 1
        OtlSet.VisChangeFlag = True
        OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat
        Exit Sub
    End If
Next foo
'item not found
Beep

End Sub

'goto a specific node

Sub OutlineGoto(FindItem As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer, foobar As Integer
Dim foo2 As Integer

foo = FindItem
If foo <= Otldat.Count Then
        OtlSet.SelectIdx = foo
        OtlSet.TopIdx = foo
        If Otldat(foo).Level <> 0 Then
            For foobar = foo To 1 Step -1
                If Otldat(foobar).Level = 0 Then
                    Otldat(foobar).Expanded = True
                    Otldat(foobar).Visible = True
                    Exit For
                End If
            Next foobar
            For foo2 = foobar + 1 To Otldat.Count
                If Otldat(foo2).Level = 0 Then Exit For
                Otldat(foo2).Visible = True
            Next foo2
        End If
        OtlSet.CurrentLine = 1
        OtlSet.VisChangeFlag = True
        OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat
Else
  Beep
End If
End Sub


'Processes outline control keys

Sub OutlineKeyPress(KeyCode As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer, VisCount As Integer
On Error Resume Next
Select Case KeyCode

Case vbKeyReturn
    OtlSet.ElementClicked = 2
    OutlineClick OtlPic, OtlScroll, OtlSet, Otldat

Case vbKeySpace
    OtlSet.ElementClicked = 1
    OutlineClick OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_PRIOR
    VisCount = 0
    foo = 0
    For foo = OtlSet.TopIdx To 1 Step -1
        If Otldat(foo).Visible = True Then VisCount = VisCount + 1
        If VisCount = OtlSet.DisplayLines Then Exit For
    Next foo
    OtlSet.CurrentLine = 1
    OtlSet.TopIdx = foo + 1
    OtlSet.SelectIdx = OtlSet.TopIdx
    OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_NEXT
    For foo = OtlSet.DisplayLines To 1 Step -1
        If OtlSet.DisplayIdx(foo) > 0 Then
            OtlSet.TopIdx = OtlSet.DisplayIdx(foo)
            Exit For
        End If
    Next foo
    OtlSet.CurrentLine = 1
    OtlSet.SelectIdx = OtlSet.TopIdx
    OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_END
    OutlineGoto Otldat.Count, OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_HOME
    OutlineGoto 1, OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_LEFT
    OutlineCollapse OtlSet.SelectIdx, OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_RIGHT
    OutlineExpand OtlSet.SelectIdx, OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_UP
    If OtlSet.CurrentLine > 1 Then
        OtlSet.CurrentLine = OtlSet.CurrentLine - 1
        OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
    Else
        For foo = OtlSet.TopIdx - 1 To 1 Step -1
            If Otldat(foo).Visible = True Then
                OtlSet.TopIdx = foo
                OtlSet.SelectIdx = OtlSet.TopIdx
                Exit For
            End If
        Next foo
    End If
    OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

Case KEY_DOWN
    If OtlSet.CurrentLine < OtlSet.DisplayCount Then
        OtlSet.CurrentLine = OtlSet.CurrentLine + 1
        OtlSet.SelectIdx = OtlSet.DisplayIdx(OtlSet.CurrentLine)
    Else
        For foo = OtlSet.DisplayIdx(OtlSet.CurrentLine) + 1 To Otldat.Count
            If Otldat(foo).Visible = True Then
                OtlSet.TopIdx = OtlSet.DisplayIdx(2)
                OtlSet.SelectIdx = foo
                Exit For
            End If
        Next foo
    End If
    OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat

Case Else
End Select
End Sub

'Processes MouseDown to get coordinates of click.

Sub OutlineMouseDown2Line(OtlSet As OtlSetup, Otldat As CollectionEx, y As Single, x As Single)
On Error Resume Next
OtlSet.CurrentLine = (y \ OtlSet.LineHeight) + 1
OtlSet.ElementClicked = (x - Otldat(OtlSet.DisplayIdx(OtlSet.CurrentLine)).Level * OtlSet.ColWidth) \ OtlSet.ColWidth  '0=+/-, 1=Pic, 2=Caption
If OtlSet.ElementClicked > 2 Then OtlSet.ElementClicked = 2

If OtlSet.LineFlag = 0 And OtlSet.ElementClicked = 0 Then
  OtlSet.ElementClicked = 1
ElseIf OtlSet.LineFlag = 0 And OtlSet.ElementClicked = 1 Then
  OtlSet.ElementClicked = 2
End If
If OtlSet.BmpFlag = 0 And OtlSet.ElementClicked = 1 Then OtlSet.ElementClicked = 2
End Sub


'Setup routine for plus/minus

Sub OutlinePlusMinusSetup(PlusPic As Control, PlusFile As String, MinusPic As Control, MinusFile As String)
On Error Resume Next

Set gPlusPic = PlusPic
Set gMinusPic = MinusPic

If PlusFile > "" Then gPlusPic.Picture = LoadPicture(PlusFile)
If MinusFile > "" Then gMinusPic.Picture = LoadPicture(MinusFile)

End Sub

'This is main drawing routine for outline control.

Sub OutlineRefresh(OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)

'On Error Resume Next
'Paints control from data array
Dim foo As Integer, foobar As Integer, TotItems As Long
Dim CurrY As Integer, currX As Integer
Dim BmpWidth As Integer, BmpHeight As Integer
Dim TwipsY As Integer, TwipsX As Integer, TxtWidth As Integer
Dim LineCount As Integer, HoldForeColor As Long
Dim TotVis As Long, SelPnt As Long
ReDim PrevLevelLine(20) As Integer
Dim PrevBmpFile As Picture
Dim SearchLevel As Integer
'GMG 989818:
Dim yLine1 As Single, yLine2 As Single

If ChangingScroll Then
    Exit Sub 'don't recurse scroll change
End If

TwipsY = Screen.TwipsPerPixelY
TwipsX = Screen.TwipsPerPixelX
'OtlSet.LineHeight = 12 * twipsx
BmpWidth = OtlSet.LineHeight
BmpHeight = OtlSet.LineHeight
'Just changing select bar?
If OtlSet.TopIdx = OtlSet.PrevTop And OtlSet.VisChangeFlag = False Then
    'OtlPic.AutoRedraw = False
    For foo = 1 To OtlSet.DisplayCount
        CurrY = (foo - 1) * OtlSet.LineHeight
        If OtlSet.DisplayIdx(foo) = OtlSet.SelectIdx Then
            OtlPic.CurrentY = CurrY
            currX = OutlineSetX(3, Otldat(OtlSet.DisplayIdx(foo)).Level, OtlSet)
            TxtWidth = currX + OtlPic.TextWidth(Otldat(OtlSet.DisplayIdx(foo)).Caption) + 75
            OtlPic.Line (currX + 10, CurrY)-(TxtWidth, CurrY + OtlSet.LineHeight - TwipsY), OtlSet.SelectColor, BF
            OtlSet.CurrentLine = foo
            'Print Caption
            OtlPic.CurrentY = CurrY
            OtlPic.CurrentX = currX
            HoldForeColor = OtlPic.ForeColor
            OtlPic.ForeColor = OtlSet.SelectTextColor
            OtlPic.Print " " & Otldat(OtlSet.DisplayIdx(foo)).Caption
            OtlPic.ForeColor = HoldForeColor
        Else
            If OtlSet.DisplayIdx(foo) = OtlSet.PrevSel Then
                OtlPic.CurrentY = CurrY
                currX = OutlineSetX(3, Otldat(OtlSet.DisplayIdx(foo)).Level, OtlSet)
                TxtWidth = currX + OtlPic.TextWidth(Otldat(OtlSet.DisplayIdx(foo)).Caption) + 75
                OtlPic.Line (currX + 10, CurrY)-(TxtWidth, CurrY + OtlSet.LineHeight - TwipsY), OtlPic.BackColor, BF
                'Print Caption
                OtlPic.CurrentY = CurrY
                OtlPic.CurrentX = currX
                OtlPic.Print " " & Otldat(OtlSet.DisplayIdx(foo)).Caption
            End If
        End If
    Next foo
    'OtlPic.AutoRedraw = True
Else
    Erase OtlSet.DisplayIdx
    OtlPic.Cls
    'TotItems = UBound(OtlDat)
    TotItems = Otldat.Count
    LineCount = 0
    For foo = OtlSet.TopIdx To TotItems
        If Otldat(foo).Visible = True Then
            CurrY = (LineCount) * OtlSet.LineHeight
            If LineCount = 0 Then
                OtlSet.TopIdx = foo
            End If
            OtlSet.DisplayIdx(LineCount + 1) = foo
            'Print Select Highlight
            If OtlSet.SelectIdx = foo Then
                OtlPic.CurrentY = CurrY
                currX = OutlineSetX(3, Otldat(foo).Level, OtlSet)
                TxtWidth = currX + OtlPic.TextWidth(Otldat(foo).Caption) + 75
                OtlPic.Line (currX + 10, CurrY)-(TxtWidth, CurrY + OtlSet.LineHeight - TwipsY), OtlSet.SelectColor, BF
                OtlSet.CurrentLine = LineCount + 1
                HoldForeColor = OtlPic.ForeColor

                'Print Select Caption
                OtlPic.ForeColor = OtlSet.SelectTextColor
                OtlPic.CurrentY = CurrY
                OtlPic.CurrentX = currX
                OtlPic.Print " " & Otldat(foo).Caption
                OtlPic.ForeColor = HoldForeColor
            Else
                'Print Caption
                OtlPic.CurrentY = CurrY
                currX = OutlineSetX(3, Otldat(foo).Level, OtlSet)
                OtlPic.CurrentX = currX
                OtlPic.Print " " & Otldat(foo).Caption
            End If
            'blt bmp
            If OtlSet.BmpFlag = 1 Then
                OtlPic.CurrentY = CurrY
                currX = OutlineSetX(2, Otldat(foo).Level, OtlSet)
                OtlPic.CurrentX = currX

                'do bitmap by kind
                'If OtlDat(foo).Level = OtlSet.Levels - 1 Then
                If Not Otldat(foo).IsParent Then
                    'Leaf

                    If Not Otldat(foo).Bitmap Is Nothing Then
                        Err = 0
                        If PrevBmpFile <> Otldat(foo).Bitmap Then
                            'gCustomPic.Picture = LoadPicture(OtlDat(foo).Bitmap)
                            Set gCustomPic.Picture = Otldat(foo).Bitmap
                            If Err <> 0 Then
                                Err = 0
                                'gCustomPic.Picture = LoadPicture(App.Path & "\" & OtlDat(foo).Bitmap)
                                Set gCustomPic.Picture = Otldat(foo).Bitmap
                            End If
                            If Err = 0 Then
                                Set PrevBmpFile = Otldat(foo).Bitmap
                            End If
                        End If
                        If Err = 0 And OtlSet.CheckmarkFlag = 0 Then
                            OtlPic.PaintPicture gCustomPic.Picture, currX, CurrY
                        Else
                            If OtlSet.CheckmarkFlag And (Otldat(foo).Selected = 1) Then
                              OtlPic.PaintPicture gLeafCheckedPic.Picture, currX, CurrY
                            Else
                              OtlPic.PaintPicture gLeafPic.Picture, currX, CurrY
                            End If
                        End If
                    Else
                        If OtlSet.CheckmarkFlag And (Otldat(foo).Selected = 1) Then
                          OtlPic.PaintPicture gLeafCheckedPic.Picture, currX, CurrY
                        Else
                          OtlPic.PaintPicture gLeafPic.Picture, currX, CurrY
                        End If
                    End If
                Else
                    PaintBranchBmp OtlPic, Otldat(foo).Expanded, Otldat(foo).Selected, OtlSet.CheckmarkFlag, currX, CurrY, OtlSet
                End If
            End If
            'draw lines with default forecolor
            'MOD FOR EXPLORER STYLE DOTTED LINES...
            If OtlSet.LineFlag = 1 Then
                PrevLevelLine(Otldat(foo).Level + 1) = LineCount
                currX = OutlineSetX(0, Otldat(foo).Level, OtlSet)
                'horizontal lines connecting subitems
                DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX + OtlSet.ColWidth * 0.6, CurrY + OtlSet.LineHeight \ 2
                If LineCount = 0 Then
                    If Otldat(foo).Level > 0 Then DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX, CurrY
                Else
                    If Otldat(foo - 1).Level = Otldat(foo).Level Then
                        'vertical lines connecting subitems
                        DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX, CurrY - OtlSet.LineHeight \ 2 '- twipsy
                    Else
                        If Otldat(foo - 1).Level < Otldat(foo).Level Then
                            'vertical line below pictures/folders
                            DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX, CurrY
                        Else
                            For foobar = LineCount - 1 To 1 Step -1
                                If Otldat(OtlSet.DisplayIdx(foobar) + 1).Level <= Otldat(foo).Level Then
                                    Exit For
                                End If
                            Next foobar
                            If Otldat(OtlSet.DisplayIdx(foobar) + 1).Level <= Otldat(foo).Level Then
                                'vertical line between collapsed parents
                                DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX, OtlSet.LineHeight * (foobar + 1) - OtlSet.LineHeight \ 2
                            Else
                                'Equal level at top or next/any is above limit of control visible area
                                DotLine95 OtlPic, currX, CurrY + OtlSet.LineHeight \ 2, currX, 0 'OtlSet.LineHeight * (foobar + 1) - OtlSet.LineHeight \ 2
                            End If
                        End If
                    End If
                End If
            End If

            'set next line
            LineCount = LineCount + 1
            If LineCount >= OtlSet.DisplayLines Or foo = Otldat.Count Then
                Exit For
            End If
        End If
    Next foo
    LineCount = LineCount - 1
    OtlSet.DisplayCount = LineCount + 1

    'Complete Line processing
    If OtlSet.LineFlag = 1 And foo < TotItems Then
        SearchLevel = Otldat(foo).Level  'Last item displayed
        For foobar = foo + 1 To TotItems
            If Otldat(foobar).Level <= SearchLevel Then
                currX = OutlineSetX(0, Otldat(foobar).Level, OtlSet)
                'vertical line down from expanded parent
                DotLine95 OtlPic, currX, OtlPic.Height, currX, PrevLevelLine(Otldat(foobar).Level + 1) * OtlSet.LineHeight '- twipsy
                SearchLevel = Otldat(foobar).Level - 1
                If SearchLevel < 0 Then Exit For
            End If
        Next foobar
    End If

    'draw plus minus boxes
    LineCount = 0
    CurrY = 0
    If (OtlSet.PlusFlag = 1) Then
      For foo = OtlSet.TopIdx To TotItems
        'If (OtlDat(foo).Level < OtlSet.Levels - 1) And OtlDat(foo).Visible Then
        If (Otldat(foo).IsParent) And Otldat(foo).Visible Then
            CurrY = (LineCount) * OtlSet.LineHeight + OtlSet.LineHeight / 2 - Screen.TwipsPerPixelY
            currX = OutlineSetX(1, Otldat(foo).Level, OtlSet)
            OtlPic.CurrentX = currX
            'does the branch have child entries?
            If foo = TotItems Then
                'last entry so no children
                Drawbox Pic:=OtlPic, x:=(currX), y:=(CurrY), Plus:=False
            Else
                'no kids
                If Otldat(foo + 1).Level <= Otldat(foo).Level Then
                    Drawbox Pic:=OtlPic, x:=(currX), y:=(CurrY), Plus:=False
                    Else
                    'does have children, but is it expanded already?
                    If Otldat(foo).Expanded = True Then
                        Drawbox Pic:=OtlPic, x:=(currX), y:=(CurrY), Plus:=False
                    Else 'PLUS - has unexpanded children
                        Drawbox Pic:=OtlPic, x:=(currX), y:=(CurrY), Plus:=True
                    End If
                End If
            End If
        End If
        If Otldat(foo).Visible Then
            'set next line
            LineCount = LineCount + 1
            If LineCount >= OtlSet.DisplayLines Or foo = Otldat.Count Then
                Exit For
            End If
        End If
      Next foo
    End If
    'Set Scroll Bar
    'Determine visible items
    If OtlSet.VisChangeFlag Then
        ChangingScroll = True
        OtlSet.VisChangeFlag = False
        OtlSet.VisibleItems = -1
        For foo = 1 To TotItems
            If Otldat(foo).Visible = True Then
                OtlSet.VisibleItems = OtlSet.VisibleItems + 1
                Otldat(foo).VisibleIdx = OtlSet.VisibleItems
            Else
                Otldat(foo).VisibleIdx = -1
            End If
        Next foo
        If OtlSet.VisibleItems > 0 Then
            OtlScroll.Visible = True
            OtlScroll.Max = OtlSet.VisibleItems
        Else
            OtlScroll.Visible = False
            OtlScroll.value = 0
        End If
        OtlScroll.SmallChange = 1
        OtlScroll.LargeChange = 10
        ChangingScroll = False
    End If
End If
If OtlScroll.Visible = True Then
    ChangingScroll = True
    OtlScroll.value = Otldat(OtlSet.SelectIdx).VisibleIdx
    ChangingScroll = False
End If
OtlSet.PrevSel = OtlSet.SelectIdx
OtlSet.PrevTop = OtlSet.TopIdx

End Sub
Public Sub PaintBranchBmp(OtlPic As Object, Expanded As Integer, Selected As Integer, CheckmarkFlag As Integer, currX As Integer, CurrY As Integer, OtlSet As OtlSetup)

If CheckmarkFlag = False Then
  If Expanded Then
    OtlPic.PaintPicture gBranchOpenPic.Picture, currX, CurrY
  Else
    OtlPic.PaintPicture gBranchClosedPic.Picture, currX, CurrY
  End If
Else
  If Expanded Then
    Select Case Selected
    Case 0
      OtlPic.PaintPicture gBranchOpenPic.Picture, currX, CurrY
    Case 1
      OtlPic.PaintPicture gBranchOpenAllPic.Picture, currX, CurrY
    Case 2
      OtlPic.PaintPicture gBranchOpenSomePic.Picture, currX, CurrY
    End Select
  Else
    Select Case Selected
    Case 0
      OtlPic.PaintPicture gBranchClosedPic.Picture, currX, CurrY
    Case 1
      OtlPic.PaintPicture gBranchClosedAllPic.Picture, currX, CurrY
    Case 2
      OtlPic.PaintPicture gBranchClosedSomePic.Picture, currX, CurrY
    End Select
  End If
End If

End Sub



Public Function OutlineSetX(ViewType As Integer, Level As Integer, OtlSet As OtlSetup) As Integer
'used for win95 style outlines -- always have bmp, lines, +/-
'ViewType --> 0 = line, 1 = +/- box, 2 = bmp, 3 = text
Dim currX As Integer

'added to move text over if bitmaps or lines are not displayed
If OtlSet.BmpFlag = 0 And ViewType = 3 Then ViewType = 2
If OtlSet.PlusFlag = 0 And OtlSet.BmpFlag = 0 And ViewType = 3 Then ViewType = 2
If OtlSet.PlusFlag = 0 And OtlSet.BmpFlag = 0 And OtlSet.LineFlag = 0 And ViewType = 2 Then ViewType = 1
If OtlSet.PlusFlag = 0 And OtlSet.BmpFlag = 1 And OtlSet.LineFlag = 0 And ViewType = 2 Then ViewType = 1
If OtlSet.PlusFlag = 0 And OtlSet.BmpFlag = 1 And OtlSet.LineFlag = 0 And ViewType = 3 Then ViewType = 2


OtlSet.ColWidth = 17 * Screen.TwipsPerPixelX
Select Case ViewType
Case 0 'lines
  If Level > 0 Then
    currX = Level * OtlSet.ColWidth + OtlSet.LineHeight \ 2
  Else
    currX = OtlSet.LineHeight \ 2
  End If
Case 1 '+/- box
  If Level > 0 Then
    currX = Level * OtlSet.ColWidth + OtlSet.LineHeight \ 2
  Else
    currX = OtlSet.LineHeight \ 2 + Screen.TwipsPerPixelX
  End If
Case 2 'bmp
  If Level > 0 Then
    currX = Level * OtlSet.ColWidth + OtlSet.ColWidth + Screen.TwipsPerPixelX * 2
  Else
    currX = OtlSet.ColWidth + (Screen.TwipsPerPixelX * 2)
  End If
Case 3 'text caption
  If Level > 0 Then
    currX = Level * OtlSet.ColWidth + OtlSet.ColWidth + OtlSet.LineHeight + (Screen.TwipsPerPixelX * 2)
  Else
    currX = OtlSet.ColWidth + OtlSet.LineHeight + (Screen.TwipsPerPixelX * 2)
  End If
End Select
OutlineSetX = currX
End Function

Sub Drawbox(Pic As Object, x As Long, y As Long, Plus As Integer)
Dim twips As Integer, Holdstyle As Integer
twips = Screen.TwipsPerPixelY
Holdstyle = Pic.DrawStyle

Pic.Line (x - 4 * twips, y - 4 * twips)-Step(8 * twips, 8 * twips), &HFFFFFF, BF
Pic.DrawStyle = 0
Pic.Line (x - 4 * twips, y - 4 * twips)-Step(8 * twips, 8 * twips), &H808080, B
Pic.Line (x - 2 * twips, y)-Step(5 * twips, 0), &H0
If Plus Then Pic.Line (x, y - 2 * twips)-Step(0, 5 * twips), &H0
Pic.DrawStyle = Holdstyle

End Sub



Public Sub DotLine95(OtlPic As Control, x1, y1, x2, y2)
'draws horizontal or vertical only ... no angles in this rev
Dim foo As Integer, LowVal, HighVal, TwipsX As Integer, TwipsY As Integer
Dim OtlPicHdc As Long
Dim Checkit As Long
TwipsX = Screen.TwipsPerPixelX
TwipsY = Screen.TwipsPerPixelY
OtlPicHdc = OtlPic.hDC
If x1 = x2 Then
  If y1 < y2 Then
    LowVal = y1
    HighVal = y2
  Else
    LowVal = y2
    HighVal = y1
  End If
  If (LowVal \ TwipsY) Mod 2 = 1 Then LowVal = (LowVal \ TwipsY) * TwipsY - TwipsY
  If (x1 \ TwipsX) Mod 2 = 1 Then x1 = (x1 \ TwipsX) * TwipsX + TwipsX
  For foo = LowVal To HighVal Step TwipsX * 2
    Checkit = SetPixel(OtlPicHdc, x1 / TwipsX, foo / TwipsY, &H808080)
  Next foo
Else
  If x1 < x2 Then
    LowVal = x1
    HighVal = x2
  Else
    LowVal = x2
    HighVal = x1
  End If
  If (LowVal \ TwipsX) Mod 2 = 1 Then
    LowVal = (LowVal \ TwipsX) * TwipsX + TwipsX
    HighVal = (HighVal \ TwipsX) * TwipsX + TwipsX
  End If
  If (HighVal \ TwipsX) Mod 2 = 1 Then HighVal = (HighVal \ TwipsX) * TwipsX + TwipsX
  If (y1 \ TwipsY) Mod 2 = 1 Then y1 = (y1 \ TwipsY) * TwipsY - TwipsY
  For foo = LowVal To HighVal Step TwipsY * 2
    Checkit = SetPixel(OtlPicHdc, foo / TwipsX, y1 / TwipsY, &H808080)
  Next foo
End If
End Sub


'Used to adjust outline control in response to scroll bar changes.

Sub OutlineScroll(ScrollValue As Integer, OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, Otldat As CollectionEx)
Dim foo As Integer, Vispoint As Long
If ChangingScroll Then Exit Sub
Vispoint = -1
If ScrollValue < Otldat(OtlSet.DisplayIdx(1)).VisibleIdx Then
    For foo = OtlSet.DisplayIdx(1) To 1 Step -1
        If ScrollValue = Otldat(foo).VisibleIdx Then
            OtlSet.CurrentLine = 1
            OtlSet.SelectIdx = foo
            OtlSet.TopIdx = OtlSet.SelectIdx
            OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat
            Exit For
        End If
    Next foo
Else
    If ScrollValue > Otldat(OtlSet.DisplayIdx(OtlSet.DisplayCount)).VisibleIdx Then
        'find bottom to select
        For foo = OtlSet.DisplayIdx(OtlSet.DisplayCount) To Otldat.Count
            If ScrollValue = Otldat(foo).VisibleIdx Then
                OtlSet.CurrentLine = OtlSet.DisplayCount
                OtlSet.SelectIdx = foo
                Exit For
            End If
        Next foo
        'Find TopIdx for display
        For foo = OtlSet.SelectIdx To 1 Step -1
            If Otldat(foo).VisibleIdx = ScrollValue - OtlSet.DisplayCount Then Exit For
        Next foo
        OtlSet.TopIdx = foo + 1
        OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat
    Else
        'make sure current item is selected within display when scrollbar moves
        For foo = 1 To OtlSet.DisplayCount
            If Otldat(OtlSet.DisplayIdx(foo)).VisibleIdx = ScrollValue Then
                OtlSet.CurrentLine = foo
                OtlSet.SelectIdx = OtlSet.DisplayIdx(foo)
                OutlineRefresh OtlPic, OtlScroll, OtlSet, Otldat
            End If
        Next foo
    End If
End If
OtlPic.SetFocus
End Sub

'Initializes the parameters for a code-based outline control

Sub OutlineSetup(OtlPic As Control, OtlScroll As Control, OtlSet As OtlSetup, DataFields As String, Bmps As Boolean, Lines As Boolean, Plus As Boolean, Checkmarks As Boolean, SelectColor As Long, SelectTextColor As Long, BmpField As String, CheckmarkField As String)
'Initializes the OtlSetup control psuedo-properties
'Note: if using bitmaps for bullets, must have pic loaded for branch open, closed, and leaf
Dim foo As Integer
'Dim VarArr() As String
'ReDim VarArr(0) As String

'OtlScroll.Move OtlPic.ScaleWidth - OtlScroll.Width, 0, OtlScroll.Width, OtlPic.ScaleHeight
OtlScroll.Move OtlPic.Width - OtlScroll.Width, 0, OtlScroll.Width, OtlPic.Height

'removed for test - kdq
'foo = Parse2Array(DataFields, VarArr(), ",")
'DoEvents
'OtlSet.Levels = UBound(VarArr) + 1

'Erase OtlSet.VariableNames()
'For foo = 0 To OtlSet.Levels - 1
'    OtlSet.VariableNames(foo) = Trim$(VarArr(foo))
'Next foo

If BmpField > "" Then OtlSet.BmpField = BmpField Else OtlSet.BmpField = ""
OtlSet.VisChangeFlag = True 'force first count
If Bmps Then OtlSet.BmpFlag = 1 Else OtlSet.BmpFlag = 0
If Lines Then OtlSet.LineFlag = 1 Else OtlSet.LineFlag = 0
If Plus Then OtlSet.PlusFlag = 1 Else OtlSet.PlusFlag = 0
If Checkmarks Then OtlSet.CheckmarkFlag = True Else OtlSet.CheckmarkFlag = False
OtlSet.CheckmarkField = CheckmarkField
OtlSet.LineHeight = OtlPic.TextHeight("X") '* 1.1

'If OtlSet.LineHeight Mod Screen.TwipsPerPixelY <> 0 Then OtlSet.LineHeight = (OtlSet.LineHeight \ Screen.TwipsPerPixelY) * Screen.TwipsPerPixelY + Screen.TwipsPerPixelY
OtlSet.LineHeight = OtlSet.LineHeight + ((OtlSet.LineHeight \ Screen.TwipsPerPixelY) Mod 4) * Screen.TwipsPerPixelY

OtlSet.DisplayLines = OtlPic.Height \ OtlSet.LineHeight
Erase OtlSet.DisplayIdx
OtlSet.SelectColor = SelectColor
OtlSet.SelectTextColor = SelectTextColor
OtlSet.TopIdx = 1
OtlSet.SelectIdx = 1
OtlSet.PrevTop = -1
OtlSet.PrevSel = -1

End Sub

'Stretches a picture to a region in Destination

Sub StrBltAllToPoint(dest As Object, dX As Integer, dY As Integer, dWidth As Integer, dHeight As Integer, source As Control)
Dim foo As Integer, DestHoldMode As Integer, SrcHoldMode As Integer

DestHoldMode = dest.ScaleMode
dest.ScaleMode = 3 'Pixels
SrcHoldMode = source.ScaleMode
source.ScaleMode = 3 'Pixels

foo = StretchBlt(dest.hDC, dX, dY, dWidth, dHeight, source.hDC, 0, 0, source.ScaleWidth, source.ScaleHeight, &HCC0020)

dest.ScaleMode = DestHoldMode
source.ScaleMode = SrcHoldMode

End Sub