Help with a calculation.

For best results, you must set 3 properties of the scrollbar (value, max, largechange).  You can study this sample:

To allow better testing, it uses Shape control (it is easy to change size and visualize it). You can use Image control.
Container is form, if you use picturebox, change ScaleHeight to Picture1.ScaleHeight

'- enter shape height in textbox (to have scrolling, height must be larger than container height)
'- move scrollbar
'- click form to see values.

' Form1, add TextBox, Shape and VScrollBar to your form.
Option Explicit

Private Sub Form_Click()
    Dim msg As String
    Cls
    msg = msg & "" & vbCrLf & vbCrLf
    msg = msg & "Form height: " & Me.ScaleHeight & vbCrLf
    msg = msg & "Shape height " & Shape1.Height & _
                ", top " & Shape1.Top & vbCrLf
    msg = msg & "VScroll Min " & VScroll1.Min & _
                ", Max " & VScroll1.Max & _
                ", Val " & VScroll1.Value & _
                ", LargeChange " & VScroll1.LargeChange & vbCrLf
    Me.CurrentY = 0
    Print msg
End Sub

Private Sub Form_Load()
    ScaleMode = vbPixels ' 3
    Shape1.Shape = vbShapeOval '2
    VScroll1.Width = 17
    VScroll1.TabStop = False
    Text1.Move 28, 4, 41
    Text1.Text = ""
End Sub

Private Sub Form_Resize()
    Caption = "Enter shape height, >" & Me.ScaleHeight
    VScroll1.Move ScaleWidth - VScroll1.Width, 0, VScroll1.Width, ScaleHeight
    Shape1.Move 0, 0, ScaleWidth - VScroll1.Width
    Adjust
End Sub

Private Sub Text1_Change()
    Dim hg As Single
    On Error GoTo EH
   
    hg = CSng(Text1.Text)
    Shape1.Top = 0
    Shape1.Height = hg ' new height
    Adjust
    Exit Sub

EH:
    Debug.Print Err.Description
End Sub

Private Sub VScroll1_Change()
    Pos
End Sub

Private Sub VScroll1_Scroll()
    Pos
End Sub

Sub Pos()
    Shape1.Top = -VScroll1.Value
End Sub

Sub Adjust()
    If ScaleHeight = 0 Then Exit Sub
   
    ' set 3 properties of vert scrollbar
    VScroll1.Value = 0
    If Shape1.Height < ScaleHeight Then ' no need to scroll
        VScroll1.Max = 0
    Else
        VScroll1.Max = Abs(ScaleHeight - Shape1.Height)
    End If
    VScroll1.LargeChange = ScaleHeight
End Sub

I looked at TimCottee's formula, and you can implement it into my code if you comment out this line:
'    VScroll1.LargeChange = ScaleHeight

You can test it with image height=210, with container height=200.
In both cases scroll range is 10, but scrollbar looks different...

thanks for the answers Tim and Ameba. I have a question for Tim though. I haven't had the chance to try it out yet but I see that you use right and left. Is this going to work for a verticle slider. Seems like I'd need Top and Bottom. Anyway, i will have more time to test it tonight and let you know if I got it to work. Ameba I will try yours tonight too, and thanks for making a whole sample program.

Thanks,
Randy

Same principle should work as you say substituting top and bottom.

ameba, sorry, I couldn't figure out what you were trying to show me here. Typing in the text box resizes the shape, but I can't "slide" it and retrieve the value like I need.

Tim, I got your example to work about half right. It is returning a value, but it doesnot go all the way from min to max. If I set min to 0 and max to 100 the value that comes back is 82 instead of 100 when the slider is slid into the max position. It goes back to zero, but will not reach max value. It goes to 825 with min set to zero and max set to 1000. I must be doing something wrong. Also since this is a vertical slider, zero should be at the bottom at the max at the top, right now it is working the opposite. How can I take care of that? Here is what I have so far.


Private Sub img1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = vbLeftButton Then
    oldY = y
    isMoving = True
End If

RaiseEvent MouseDown(Button, Shift, x, y)
   
End Sub

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long

If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

Range = MaxValue - MinValue
ActualRange = pic1.Top + pic1.ScaleHeight
CurrentLeftOffSet = pic1.Top + img1.Top
Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue

End If

Label1.Caption = Value
   
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

Private Sub img1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

isMoving = False

RaiseEvent MouseUp(Button, Shift, x, y)

End Sub


Thanks for any help
Randy

Randy:

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long

If isMoving Then
   img1.Top = img1.Top + y - oldY
       If img1.Top < 120 Then img1.Top = 120
       If img1.Top > Pic1.ScaleHeight - img1.Height Then img1.Top = Pic1.ScaleHeight - img1.Height

Range = MaxValue - MinValue
ActualRange = Pic1.ScaleHeight - 120 - img1.Height
CurrentLeftOffSet = img1.Top - 120
Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue

End If

Label1.Caption = Value
   

End Sub

This is a bit strange, sorting out the end value wasn't a problem but I found it didn't go to the bottom either, the reason being that it seemed impossible to move it less than 120 from the top. Anyway I will have a quick look at reversing this process as well, though of course you could always use 100 - Value instead thinking about it. Which would give for 85; 100 - 85 = 15

hey Tim,

    Hot dog, I got it to work now, looking at your code made me realize that for the actual range, I did not subtract the height of the image box. I set the actualrange to pic1.top + pic1.scaleheight - img1.height and it works like a charm. I still heave the problem of it working backwards though. Let me know if you figure it out and I'll snd the points your way.

Thanks again,
Randy

I think I got it there, Just use

Value = 100 - Value

To invert it.

hey Tim,

    Hot dog, I got it to work now, looking at your code made me realize that for the actual range, I did not subtract the height of the image box. I set the actualrange to pic1.top + pic1.scaleheight - img1.height and it works like a charm. I still heave the problem of it working backwards though. Let me know if you figure it out and I'll snd the points your way.

Thanks again,
Randy

tried it, it works fine if values are 0 and 100, but if I set them to 100 and 1000 it's all screwed up. Getting closer though

Of course, it should be ActualRange - Value not 100, I forgot that the min and max values could change.

tried it, it works fine if values are 0 and 100, but if I set them to 100 and 1000 it's all screwed up. Getting closer though

nope, that made it worse because the actual range is up in the thousands due to the size of the picture box

here is the sub right now

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long

If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

    Range = MaxValue - MinValue
    ActualRange = pic1.Top + pic1.ScaleHeight - img1.Height
    CurrentLeftOffSet = pic1.Top + img1.Top
    Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue
    Value = MaxValue - Value
    RaiseEvent Change
End If
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

here is the sub right now

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long

If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

    Range = MaxValue - MinValue
    ActualRange = pic1.Top + pic1.ScaleHeight - img1.Height
    CurrentLeftOffSet = pic1.Top + img1.Top
    Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue
    Value = MaxValue - Value
    RaiseEvent Change
End If
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

here is the sub right now

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long

If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

    Range = MaxValue - MinValue
    ActualRange = pic1.Top + pic1.ScaleHeight - img1.Height
    CurrentLeftOffSet = pic1.Top + img1.Top
    Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue
    Value = MaxValue - Value
    RaiseEvent Change
End If
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

hey Tim, check it out, I finally figured it out. I just changed the offset to be calculated from the bottom rather than the top. Here it is.

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long


If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

    Range = MaxValue - MinValue
    ActualRange = pic1.Top + pic1.ScaleHeight - img1.Height
    CurrentLeftOffSet = pic1.ScaleHeight - img1.Top - img1.Height
    Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue
   
    RaiseEvent Change
End If
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub


Post again so I can give you the points and thank you again.
Randy

Hey Tim, check it out. I got it to work by calculating the offset from the bottom instead of from the top and it works great. Here is the sub:

Private Sub img1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Range As Long, ActualRange As Long, CurrentLeftOffSet As Long


If isMoving Then
    img1.Top = img1.Top + y - oldY
        If img1.Top < pic1.Top Then img1.Top = pic1.Top
        If img1.Top > pic1.ScaleHeight - img1.Height Then img1.Top = pic1.ScaleHeight - img1.Height

    Range = MaxValue - MinValue
    ActualRange = pic1.Top + pic1.ScaleHeight - img1.Height
    CurrentLeftOffSet = pic1.ScaleHeight - img1.Top - img1.Height
    Value = Range * (CurrentLeftOffSet / ActualRange) + MinValue
   
    RaiseEvent Change
End If
RaiseEvent MouseMove(Button, Shift, x, y)

End Sub

Thanks for all your help. I need you to post again so I can give you the points.

RandyB30

Thanks for the help Tim