[VB6] - Create a usercontrol with a scrollbar working on IDE
heres how create an usercontrol with scrollbars working on IDE....
Put these code on a module:
Code:
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetFocus Lib "user32.dll" () As Long
Private PrevWin2 As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Const RDW_INVALIDATE = &H1
' Get mouse X coordinates in pixels
'
' If a window handle is passed, the result is relative to the client area
' of that window, otherwise the result is relative to the screen
Public Function MouseX(Optional ByVal hwnd As Long) As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
If hwnd Then ScreenToClient hwnd, lpPoint
MouseX = lpPoint.x
End Function
' Get mouse Y coordinates in pixels
'
' If a window handle is passed, the result is relative to the client area
' of that window, otherwise the result is relative to the screen
Public Function MouseY(Optional ByVal hwnd As Long) As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
If hwnd Then ScreenToClient hwnd, lpPoint
MouseY = lpPoint.y
End Function
Public Function IsCodeWindowActivated() As Boolean
Dim lngActivatedWindow As Long
lngActivatedWindow = GetFocus
If GetWindowCaption(lngActivatedWindow) Like "*(Code)*" Then
IsCodeWindowActivated = True
Else
IsCodeWindowActivated = False
End If
End Function
Private Function GetWindowCaption(ByVal Handle As Long) As String
' Display the text of the title bar of window Form1
Dim textlen As Long ' receives length of text of title bar
Dim titlebar As String ' receives the text of the title bar
Dim slength As Long ' receives the length of the returned string
' Find out how many characters are in the window's title bar
textlen = GetWindowTextLength(Handle)
titlebar = Space(textlen + 1) ' make room in the buffer, allowing for the terminating null character
slength = GetWindowText(Handle, titlebar, textlen + 1) ' read the text of the window
titlebar = Left(titlebar, slength) ' extract information from the buffer
GetWindowCaption = titlebar
End Function
Private Function Proc2(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If IsCodeWindowActivated = False Then
RedrawWindow hwnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE
Unhook2 hwnd
End If
Proc2 = CallWindowProc(PrevWin2, hwnd, Msg, wParam, lParam)
End Function
Public Sub Hook2(Handle As Long)
If PrevWin2 = 0 Then
PrevWin2 = SetWindowLong(Handle, GWL_WNDPROC, AddressOf Proc2)
End If
End Sub
Public Sub Unhook2(Handle As Long)
If PrevWin2 Then
Call SetWindowLong(Handle, GWL_WNDPROC, PrevWin2)
PrevWin2 = 0
End If
End Sub
'Detect a precise collision by a position and size of 2 objects
Public Function CollisionPrecise(X1 As Long, Y1 As Long, Width1 As Long, Height1 As Long, X2 As Long, Y2 As Long, Width2 As Long, Height2 As Long) As Boolean
If (X1 + Width1 >= X2 And X1 <= X2 + Width2) And (Y1 + Height1 >= Y2 And Y1 <= Y2 + Height2) Then
CollisionPrecise = True
Else
CollisionPrecise = False
End If
End Function
now, active a timer with 100ms:
Code:
Private Sub tmrIDEScrollClick_Timer()
'Vertical scroll
If CollisionPrecise(MouseX(UserControl.hwnd), MouseY(UserControl.hwnd), 1, 1, ScrollingVertical.Left, 0, 17, 17) = True And GetKeyState(VK_LBUTTON) < 0 Then
If ScrollingVertical.Value - 10 <= ScrollingVertical.Min Then
ScrollingVertical.Value = ScrollingVertical.Min
Else
ScrollingVertical.Value = ScrollingVertical.Value - 10
End If
ElseIf CollisionPrecise(MouseX(UserControl.hwnd), MouseY(UserControl.hwnd), 1, 1, ScrollingVertical.Left, ScrollingVertical.Height - 17, 17, 17) = True And GetKeyState(VK_LBUTTON) < 0 Then
If ScrollingVertical.Value + 10 >= ScrollingVertical.Max Then
ScrollingVertical.Value = ScrollingVertical.Max
Else
ScrollingVertical.Value = ScrollingVertical.Value + 10
End If
'Horizontal scroll
ElseIf CollisionPrecise(MouseX(UserControl.hwnd), MouseY(UserControl.hwnd), 1, 1, 0, ScrollingHorizontal.Top, 17, 17) = True And GetKeyState(VK_LBUTTON) < 0 Then
If ScrollingHorizontal.Value - 10 <= ScrollingHorizontal.Min Then
ScrollingHorizontal.Value = ScrollingHorizontal.Min
Else
ScrollingHorizontal.Value = ScrollingHorizontal.Value - 10
End If
ElseIf CollisionPrecise(MouseX(UserControl.hwnd), MouseY(UserControl.hwnd), 1, 1, ScrollingHorizontal.Width - 17, ScrollingHorizontal.Top, 17, 17) = True And GetKeyState(VK_LBUTTON) < 0 Then
If ScrollingHorizontal.Value + 10 >= ScrollingHorizontal.Max Then
ScrollingHorizontal.Value = ScrollingHorizontal.Max
Else
ScrollingHorizontal.Value = ScrollingHorizontal.Value + 10
End If
End If
If IsCodeWindowActivated = True Then
tmrIDEScrollClick.Enabled = False
Hook2 UserControl.hwnd
End If
End Sub
these timer detect the click event and mouse position on both scrollbars.
and that IsCodeWindowActivated() function is for detect if the code window is foced(is for avoid the Intelligence list hide automatic).
and then activate the hook. these hook is like a cycle for test if the code window lose focus and if so then reactivate the timer and close the hook.
i accept questions and sugestions. good pratice and coding;)
Re: [VB6] - Create a usercontrol with a scrollbar working on IDE
forget some important things. on hook i activate the Paint event:
Code:
RedrawWindow hwnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE
because the Paint event activate the timer. and the show event too. and the hide event desactivate it:
Code:
Private Sub UserControl_Paint()
If Ambient.UserMode = False Then
tmrIDEScrollClick.Enabled = True
End If
End Sub
Private Sub UserControl_Hide()
blnShowed = False
If Ambient.UserMode = False Then
tmrIDEScrollClick.Enabled = False
End If
End Sub
Private Sub UserControl_Show()
If Ambient.UserMode = False Then
tmrIDEScrollClick.Enabled = True
End If
Picture1.ZOrder 0
ScrollingHorizontal.ZOrder 0
ScrollingVertical.ZOrder 0
End Sub
that ZOrder is for put the scrollbars and that little box on top;)
(these ZOrder can be puted on timer;))
Re: [VB6] - Create a usercontrol with a scrollbar working on IDE
cab you give a sample project
1 Attachment(s)
Re: [VB6] - Create a usercontrol with a scrollbar working on IDE
Quote:
Originally Posted by
coolcurrent4u
cab you give a sample project
yes. heres my Lebel Editor 2D. isn't finish but have the code you need;)
i hope you understand all;)