-
Mar 18th, 2018, 01:40 AM
#1
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
-
Mar 18th, 2018, 06:25 AM
#2
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.
-
Mar 18th, 2018, 08:17 AM
#3
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...
-
Mar 19th, 2018, 07:47 PM
#4
Re: Restrict x movement while dragging PictureBox (via ReleaseCapture)?
ClipCursor API may be useful.
-
Mar 20th, 2018, 10:14 AM
#5
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.
-
Mar 20th, 2018, 10:36 AM
#6
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
-
Mar 20th, 2018, 10:50 AM
#7
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.
-
Mar 20th, 2018, 01:23 PM
#8
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
-
Mar 20th, 2018, 05:52 PM
#9
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.
-
Mar 20th, 2018, 07:56 PM
#10
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.
-
Mar 21st, 2018, 03:45 AM
#11
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|