Results 1 to 11 of 11

Thread: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,652

    Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    So in the UserControl I'm working on, I added a PictureBox that acts as a draggable sizing bar. Went with using the ReleaseCapture method to be able to drag it around after a couple others weren't playing nice, and was wondering if there's a practical way to restrict the movement to just along the y axis? There's only the one MouseMove event that fires, so can't adjust it there.
    One thing I thought of is temporarily making the width much larger than the control (and .Left a ways negative)... and visually that seems to work; but there's gotta be a better way no? Methods using subclassing are on the table too.

    For reference here's how it's set up right now (cleaned up):
    Code:
    Private Sub pbDetailSizer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        bSMove = True
        SetWindowPos pbDetailSizer.hWnd, HWND_TOP, 0&, 0&, 0&, 0&, SWP_NOSIZE Or SWP_NOMOVE
    End If
    End Sub
    
    Private Sub pbDetailSizer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bSMove Then
        If Button = 1 Then
            ReleaseCapture
            SendMessage pbDetailSizer.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
            UserControl_Resize
        End If
    End If
    End Sub

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    You didn't describe how you were using the picturebox.
    Based on the little code you have shown I'm guessing the picturebox would be in the lower left corner of the control, or at least somewhere along the left edge so you only need to move it vertically while it resizes the user control it is contained in.

    I've always used a fairly simple bit of code in the MouseMove event to move a picturebox, assuming the picturebox and its container have the same scalemode. For example, this code will just move the picturebox vertically when dragged.
    Code:
    Private Sub pbDetailSizer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Static ly As Single
      If Button = vbLeftButton Then
        pbDetailSizer.Top = pbDetailSizer.Top + (Y - ly)
      Else
        ly = Y
      End If
    End Sub
    If the scalemode could be different between picturebox and container then ScaleX and ScaleY functions could be used to convert deltas to the containers scale units, but it doesn't seem to be necessary in a usercontrol.

    I've added a little bit more code to the example to resize the usercontrol based on movement of the picturebox, since that is a stated purpose.
    Since you didn't specify what the resizing code does, I just went with the guess that the picturebox would be a small square in the lower left corner of the user control that you drag vertically to resize the user control proportionately to its original size.

    This method seems to "play nice" for me, but I really don't know what your situation is, so may not be replicating what you're trying to do.
    Code:
    Private ratio As Single
    
    Private Sub pbDetailSizer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Static ly As Single
      If Button = vbLeftButton Then
        pbDetailSizer.Top = pbDetailSizer.Top + (Y - ly)
        UserControl1_Resize
      Else
        ly = Y
      End If
    End Sub
    
    Private Sub UserControl_Initialize()
      ratio = UserControl.Width / UserControl.Height
    End Sub
    
    Private Sub UserControl1_Resize()
      UserControl.Height = pbDetailSizer.Top + pbDetailSizer.Height
      UserControl.Width = UserControl.Height * ratio
    End Sub
    p.s. The example does seem to require that the UserControl's ScaleMode be twips in the resize routine. I don't know if that is an issue.
    In the example usercontrol, code can be added to save the current scalemode, change to twips, do the resize, then restore the scalemode, in case you want to use a scalemode other than twips in the usercontrol itself.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,652

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Sorry if I wasn't clear; the picturebox is a resize bar like this:


    The code shown in the post is the entirety of the code that controls the picturebox. UserControl_Resize resizes the elements within the UserControl, after the mouse button is released (here, adjusts the height of the ListView and the other PictureBox with the details); it doesn't (and shouldn't) execute with each pixel moved during drag.

    I'll try using the method you posted again... after quite a while of top=top+(y-ly) not working going to ReleaseCapture was just so much easier. Its possible some scale setting somewhere was off...

  4. #4
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,997

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    ClipCursor API may be useful.

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Hi Fafalone,

    I'm just spit-balling here, and haven't done any testing. But it seems like GetCursorPos and SetCursorPos should get it done. If you use GetCursorPos in your pbDetailSizer_MouseDown event to save your initial mouse position, and then UserControl_MouseMove should still fire (I believe). So, in there, you could keep forcing the mouse X to the same value with SetCursorPos.

    Also, with that approach, you may see those "mouse X corrections", but you wouldn't need subclassing. If I get a bit of time, I'll test to see if that works.

    Good Luck,
    Elroy

    EDIT1: As you'd assuredly figure out, you'd need to check your bSMove flag in UserControl_MouseMove before you did anything.

    EDIT2: Hmmm, that ReleaseCapture seems to foul everything up. It does look like it's going to take some subclassing. I'm a bit busy, but that shouldn't be huge to figure out. If I want a distraction, I'll see about working it out later.
    Last edited by Elroy; Mar 20th, 2018 at 10:35 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    ClipCursor seems more elegant than forcing the mousepointer to a specific x-value, IMO.
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  7. #7
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Well, neither ClipCursor or restricting the X-value of the cursor seems to be ideal in this case since the point is to mimic a sizing bar.

    You should be aware that the cursor isn't restricted when using a sizing bar. The bar is dragged in one direction to follow the mouse along one axis, but the mouse can move freely in both axis. The code I posted should allow that, but I don't know the issues he's having with implementing it in the user control.

    As he noted, he could always make the picturebox that represents the sizing bar extra wide, for example if it was a bit more than twice the width of the usercontrol, and he did use clipCursor to keep the mouse within the bounds of the user control, or perhaps even vertically to some minimum and maximum value within the user control he could move the mouse freely within those bounds, and you should never see the left and right edges of the picturebox as you would not move it far enough left or right to expose the edge.
    When released, you would always recenter the picturebox horizontally so it is ready to be dragged again to resize the partition and not expose the edge. You wouldn't need to restrict the movement of the picturebox while dragging since clipCursor will keep in bounds enough that the left and right edges would not be exposed.

    Using clipCursor to keep the cursor within the bounds of the user control still doesn't mimic the normal behavior, i.e. the mouse can travel outside the bounds of the moving bar and the underlying window, but it seems like a reasonable compromise.
    Last edited by passel; Mar 20th, 2018 at 10:54 AM.

  8. #8
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Yes, restricting the x-value for a sizer is not standard behaviour but fafalone knows what he's doing so I just accepted the question at face value. In that spirit, I envisaged a rectangle 1 pixel wide (and however high he needs it to enforce min and max y-values) being passed to the ClipCursor call.
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  9. #9
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Yes, I'm taking fafalone at face value as well. He said he wanted to restrict the X movement of the picturebox while moving it up and down vertically. He never mentioned restricting X movement of the mouse.
    But, perhaps a tall narrow restricted cursor would be an acceptable alternative.

  10. #10

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,652

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    The mouse shouldn't be restricted... that seems like a bit of overkill. Widening it seems to work ok; the user would really have to be specifically trying to see the end of the bar...
    Code:
            cxOrig = pbDetailSizer.Width
            pbDetailSizer.Width = cxOrig * 4
            pbDetailSizer.Left = (-1) * cxOrig
            ReleaseCapture
            SendMessage pbDetailSizer.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
            pbDetailSizer.Width = cxOrig
            pbDetailSizer.Left = pbDetailPane.Left + 5
            UserControl_Resize
    (recall when this runs, code execution stops until the left button is released, and this is already in MouseMove which isn't called again)

    Still open to subclassing; hesitating only because there's already so much subclassing going on in the project I'm worried about stability; just had to add yet another subclass just to display unicode in a label.

  11. #11
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?

    Hi fafalone,

    don't know if this will help you..
    In the Class there are settings for...
    Code:
    .FromTopMin = 600
    .FromLeftMin = 300
    .FromRightMin = 300
    .FromBottomMin = 300
    here the Class..
    Code:
    'classname : clsSplitter
    Option Explicit
    
    Private WithEvents SplitImage As Image    'Image für das Verschieben
    Private SplitPic As PictureBox            'PicBox für das Anzeigen beim Verschieben
    
    Private WithEvents ParentForm As Form     'Parentform für Plazierung Image+PicBox
    Private ObjLeft As Object                 'das linke Object
    Private ObjRight As Object                'das rechte Object
    
    Private SplitterStartX As Single          'x-Achse beim Start von Splitter
    Private SplitterGo As Boolean             'ist Splitter im Gange
    
    Private mvarFromBottomMin As Single       'BottomMargin beide Objecte
    Private mvarFromLeftMin As Single         'LeftMargin Object Left
    Private mvarFromRightMin As Single        'RightMargin Object Right
    Private mvarFromTopMin As Single          'TopMargin beide Objecte
    Private mvarSplitterWidth As Single       'Breite Splitterbalken
    Private mvarObjectLeftMinWidth As Single  'Breite Minimum linkes Object
    Private mvarObjectRightMinWidth As Single 'Breite Minimum rechtes Object
    Private mvarSplitterBackColor As Long     'Farbe des Splitterbalkens
    
    Public Property Let SplitterBackColor(ByVal vData As Long)
        mvarSplitterBackColor = vData
    End Property
    
    Public Property Get SplitterBackColor() As Long
        SplitterBackColor = mvarSplitterBackColor
    End Property
    
    Public Property Let ObjectRightMinWidth(ByVal vData As Single)
        mvarObjectRightMinWidth = vData
    End Property
    
    Public Property Get ObjectRightMinWidth() As Single
        ObjectRightMinWidth = mvarObjectRightMinWidth
    End Property
    
    Public Property Let ObjectLeftMinWidth(ByVal vData As Single)
        mvarObjectLeftMinWidth = vData
    End Property
    
    Public Property Get ObjectLeftMinWidth() As Single
        ObjectLeftMinWidth = mvarObjectLeftMinWidth
    End Property
    
    Public Property Let SplitterWidth(ByVal vData As Single)
        mvarSplitterWidth = vData
        SplitImage.Width = vData
        SplitPic.Width = vData
    End Property
    
    Public Property Get SplitterWidth() As Single
        SplitterWidth = mvarSplitterWidth
    End Property
    
    Public Property Let FromTopMin(ByVal vData As Single)
        mvarFromTopMin = vData
        SetSplitterNow
    End Property
    
    Public Property Get FromTopMin() As Single
        FromTopMin = mvarFromTopMin
    End Property
    
    Public Property Let FromRightMin(ByVal vData As Single)
        mvarFromRightMin = vData
        SetSplitterNow
    End Property
    
    Public Property Get FromRightMin() As Single
        FromRightMin = mvarFromRightMin
    End Property
    
    Public Property Let FromLeftMin(ByVal vData As Single)
        mvarFromLeftMin = vData
        SetSplitterNow
    End Property
    
    Public Property Get FromLeftMin() As Single
        FromLeftMin = mvarFromLeftMin
    End Property
    
    Public Property Let FromBottomMin(ByVal vData As Single)
        mvarFromBottomMin = vData
        SetSplitterNow
    End Property
    
    Public Property Get FromBottomMin() As Single
        FromBottomMin = mvarFromBottomMin
    End Property
    
    Public Function Init(LeftObj As Object, RightObj As Object, LeftObjWidth As Single) As Boolean
    'eigentliches Initialisieren der Klasse
    
       Dim i As Long
       Dim s As String
    
          'Objecte zuweisen
          Set ObjLeft = LeftObj
          Set ObjRight = RightObj
          Set ParentForm = LeftObj.Parent
          
          'SplitterObjekte Init, Picture- und Imagebox
          For i = 0 To 999
             'Namesgleichheit mit Parentform vermeiden
             s = "SplitImage" & Format(i, "000")
             On Error Resume Next
             Set SplitImage = ParentForm.Controls.Add("VB.Image", s, ParentForm)
             If Err.Number = 0 Then
                'hat geklappt
                Exit For
             End If
          Next
          If Err.Number = 0 Then
             For i = 0 To 999
                s = "SplitPic" & Format(i, "000")
                Set SplitPic = ParentForm.Controls.Add("VB.PictureBox", s, ParentForm)
                If Err.Number = 0 Then
                   Exit For
                End If
             Next
          End If
          If Err.Number <> 0 Then
             FehlerAnzeige Err.Number, Err.Description, "clsSplitter.Init"
             Exit Function
          End If
          On Error GoTo 0
          
          'einrichten Image
          With SplitImage
             .Width = SplitterWidth
             .MousePointer = 15
             .Visible = True
          End With
          
          'einrichten Picturebox
          With SplitPic
             .BorderStyle = 0
          End With
          
          'Init erste Anzeige
          SetSplitterFirst
          'endgültige Anzeige
          SetSplitterNow
    End Function
    
    Private Function SetSplitterFirst() As Boolean
    'anordnen Splitterbox und -Image beim Start
    
          With ObjLeft
             'linkes Object setzen
             .Left = FromLeftMin
             .Top = FromTopMin
             .Height = ParentForm.ScaleHeight - .Top - FromBottomMin
             'SplitterImage anpassen
             SplitImage.Top = .Top
             SplitImage.Left = .Left + .Width
             SplitImage.Height = .Height
          End With
          
          'SplitterPicturebox anpassen
          With SplitPic
             .Left = SplitImage.Left
             .Width = SplitImage.Width
             .Top = SplitImage.Top
             .Height = SplitImage.Height
          End With
          
          'rechtes Object anpassen
          With ObjRight
             .Left = ObjLeft.Left + ObjLeft.Width + SplitImage.Width
             .Width = ParentForm.ScaleWidth - .Left - FromRightMin
          End With
    End Function
    
    Private Function SetSplitterNow() As Boolean
    'auf Veränderungen reagieren
    
       Dim w As Single
       Dim h As Single
    
          'Check auf Left
          If SplitPic.Left < (FromLeftMin + ObjectLeftMinWidth) Then
             SplitPic.Left = FromLeftMin + ObjectLeftMinWidth
             SplitImage.Left = SplitPic.Left
          End If
    
          'linkes Object anpassen
          With ObjLeft
             .Left = FromLeftMin
             .Top = FromTopMin
             .Width = SplitPic.Left - .Left
             'maximale Breite
             w = ParentForm.ScaleWidth - FromLeftMin - FromRightMin - _
                                         .Width - ObjectLeftMinWidth
             If w < ObjectLeftMinWidth Then
                .Width = ParentForm.ScaleWidth - FromLeftMin - _
                         FromRightMin - ObjectLeftMinWidth - _
                         ObjectRightMinWidth
                SplitPic.Left = .Left + .Width
                SplitImage.Left = SplitPic.Left
             End If
             'Höhe anpassen
             h = ParentForm.ScaleHeight - FromTopMin - FromBottomMin
             If h > 0 Then
                .Height = h
             End If
          End With
          
          'rechtes Object anpassen
          With ObjRight
             .Left = SplitPic.Left + SplitPic.Width
             w = ParentForm.ScaleWidth - .Left - FromRightMin
             If w > 0 Then
                .Width = w
             End If
             If w < ObjectRightMinWidth Then
                .Width = ObjectRightMinWidth
             End If
             .Top = ObjLeft.Top
             .Height = ObjLeft.Height
          End With
          
          'Splitterbalken anpassen
          With SplitPic
             .Top = ObjLeft.Top
             .Height = ObjLeft.Height
             SplitImage.Top = .Top
             SplitImage.Height = .Height
          End With
    End Function
    
    Private Sub FehlerAnzeige(ErrNumber As Long, ErrDescription As String, _
                             Optional Titel As String = "")
    
       Dim Msg As String
       
          Msg = "Fehler " & ErrNumber & vbCrLf & vbCrLf & _
                ErrDescription
          MsgBox Msg, vbCritical, Titel
    End Sub
    
    Private Sub Class_Initialize()
    
          'Standardwerte
          mvarSplitterWidth = 180                   'Breite Splitterbalken
          mvarObjectLeftMinWidth = 300              'Mindestbreite Object Left
          mvarObjectRightMinWidth = 300             'Mindestbreite Object Right
          mvarSplitterBackColor = vbInfoBackground  'Farbe des Splitterbalkens
    End Sub
    
    Private Sub Class_Terminate()
    'Klasse wird beendet durch Form_Unload
    
          'addierte Objecte entfernen
          ParentForm.Controls.Remove SplitPic
          ParentForm.Controls.Remove SplitImage
          
          'Objecte auflösen
          Set SplitPic = Nothing
          Set SplitImage = Nothing
          Set ObjLeft = Nothing
          Set ObjRight = Nothing
          Set ParentForm = Nothing
    End Sub
    
    Private Sub ParentForm_Resize()
    'auf Grössenänderungen der Form reagieren
    
          'nicht beim Minimieren
          If ParentForm.WindowState = vbMinimized Then
             Exit Sub
          End If
          'Anzeige aktualisieren
          SetSplitterNow
    End Sub
    
    Private Sub SplitImage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Starten Splitterbalken
    
          'eingestellte Farbe
          SplitPic.BackColor = SplitterBackColor
          'und auf den Schirm
          SplitPic.Visible = True
          'in den Vordergrund
          SplitPic.ZOrder 0
          'Startposition x-Achse merken
          SplitterStartX = SplitImage.Left - X
          'Splittern ist im Gange
          SplitterGo = True
    End Sub
    
    Private Sub SplitImage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Splitterbalken verschieben
    
          If Not SplitterGo Then
             'nicht initiert
             Exit Sub
          End If
          
          'Balken verschieben
          With SplitPic
             .Left = SplitterStartX + X
          End With
    End Sub
    
    Private Sub SplitImage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Splittern beenden
    
          With SplitImage
             'linke Position übernehmen
             .Left = SplitPic.Left
             SplitPic.Left = .Left
             'Balken ausblenden
             SplitPic.Visible = False
             'nix mehr mit Splittern
             SplitterGo = False
          End With
          'Anzeige aktualisieren
          SetSplitterNow
    End Sub
    and in the Form add 2 Frames for testing

    Code:
    Option Explicit
    
    Private cSplitH As clsSplitter
    
    Private Sub Form_Load()
    
          'Class Splitter einrichten
          Set cSplitH = New clsSplitter
          With cSplitH
             'linkes und rechtes Object zuweisen
             .Init Frame1, Frame2, Frame1.Width
             'Ränder setzen
             .FromTopMin = 600
             .FromLeftMin = 300
             .FromRightMin = 300
             .FromBottomMin = 300
             .SplitterBackColor = vbRed
             .SplitterWidth = 150
          End With
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
          Set cSplitH = Nothing
    End Sub
    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

Posting Permissions

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



Click Here to Expand Forum to Full Width