Article ID: 118939
Article Last Modified on 1/8/2003
Const SM_CXBORDER = 5
Const SM_CXVSCROLL = 2
Const WS_VSCROLL = &H200000
Const GWL_STYLE = (-16)
'Enter each the following declarations on a single line:
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer
) As Integer
Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer,
ByVal nIndex As Integer) As Long
Function ScrollBarVisible (MyControl As Control) As Integer
Dim StyleFlag As Long
StyleFlag = GetWindowLong(MyControl.hWnd, GWL_STYLE)
If StyleFlag And WS_VSCROLL Then
ScrollBarVisible = True
Else
ScrollBarVisible = False
End If
End Function
NOTE: to make this a more generic routine, these declarations may be
moved into a BAS module. Add the keyword "Global" to the front of the
Const declarations if this is done.
' Note the following Sub and Line statements
' must be entered on a single line:
Sub Outline1_DragOver (Source As Control, x As Single, y As Single,
State As Integer)
Dim iScrollBarOffset As Integer
Static iDropIndex As Integer
Dim iCurrentIndex As Integer
Dim iTextHeight As Integer
If ScrollBarVisible(Outline1) Then
' If the contents don't fit in the available outline space,
' then we have to compensate for the width of the scrollbar.
iScrollBarOffset = Screen.TwipsPerPixelX *
GetSystemMetrics(SM_CXVSCROLL)
Else
' Otherwise, we don't have a scrollbar.
iScrollBarOffset = 0
End If
' This value is used to compensate for the width of scrollbars.
' If the elements in the outline control do not all fit in the
' controls display area, the scrollbars will automatically be
' added, reducing the length required for our highlight lines.
iTextHeight = TextHeight("A")
' iTextHeight is needed to determine which
' element of the list the MousePointer is
' over. This assumes that the fontname and
' fontsize on Form1 and Outline1 are the same.
Select Case State
'Action determined by the state of the source control.
Case 0 'Enter
iDropIndex = -1
Case 1 'Leave
If iDropIndex <> -1 Then
' Clean up highlight if we left one behind.
' The following must be entered on a single line:
Line (Outline1.Left, Outline1.Top + iDropIndex *
iTextHeight)-Step(Outline1.Width - iScrollBarOffset,
iTextHeight), Outline1.BackColor, B
' The following must be entered on a single line:
Line (Outline1.Left, Outline1.Top)-Step(Outline1.Width -
iScrollBarOffset, Outline1.Height), Outline1.ForeColor, B
End If
iDropIndex = -1
Case 2 'Over
iTextHeight = TextHeight("A")
iCurrentIndex = y / iTextHeight
If iDropIndex <> iCurrentIndex Then
' If the source control is over a different Outline element
...
If iDropIndex <> -1 Then 'Erase old highlight.
' The following must be entered on a single line:
Line (Outline1.Left, Outline1.Top + iDropIndex *
iTextHeight)-Step(Outline1.Width - iScrollBarOffset,
iTextHeight), Outline1.BackColor, B
' The following must be entered on a single line:
Line (Outline1.Left, Outline1.Top)-Step(Outline1.Width -
iScrollBarOffset, Outline1.Height),
Outline1.ForeColor, B
End If
iDropIndex = iCurrentIndex
If iDropIndex <= Outline1.ListCount - Outline1.TopIndex - 1
Then
' Do the highlighting.
' The following must be entered on a single line:
Line (Outline1.Left, Outline1.Top + iDropIndex *
iTextHeight)-Step(Outline1.Width - iScrollBarOffset,
iTextHeight), Outline1.ForeColor, B
Else
iDropIndex = -1
End If
End If
End Select
End Sub
Sub Form_Load ()
Dim i As Integer
For i = 1 To 20
Outline1.AddItem Str(i)
Next
End Sub
Sub Outline1_DragDrop (Source As Control, x As Single, y As Single)
Dim iTextHeight As Integer
Dim iCurrentIndex As Integer
iTextHeight = TextHeight("A")
iCurrentIndex = y / iTextHeight
If iCurrentIndex <= Outline1.ListCount - Outline1.TopIndex - 1
Then
' Add your own code here to perform an
' action on the current list element:
Outline1.List(iCurrentIndex + Outline1.TopIndex) =
Command1.Caption
End If
End Sub
Additional query words: 3.00
Keywords: KB118939