[VB6] - Create a usercontrol with a scrollbar working on IDE-VBForums
Results 1 to 4 of 4

Thread: [VB6] - Create a usercontrol with a scrollbar working on IDE

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,916

    [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
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,916

    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)
    VB6 2D Sprite control

    To live is difficult, but we do it.

  3. #3
    Fanatic Member coolcurrent4u's Avatar
    Join Date
    Apr 2008
    Location
    *****
    Posts
    970

    Re: [VB6] - Create a usercontrol with a scrollbar working on IDE

    cab you give a sample project
    Programming is all about good logic. Spend more time here


    (vHost for Apache) (Generate pronounceable password) (Generate random number c#) (Filter array with another array)

  4. #4

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,916

    Re: [VB6] - Create a usercontrol with a scrollbar working on IDE

    Quote Originally Posted by coolcurrent4u View Post
    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
    Attached Files Attached Files
    VB6 2D Sprite control

    To live is difficult, but we do it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.