We help IT Professionals succeed at work.

Help with a calculation.

on
Medium Priority
217 Views
Ok, this doesn't seem like it should be that difficult, but I be darned if I can figure it out. I am trying to make my own "Slider.OCX". I have an imagebox inside a picturebox and it scrolls up and down likeit should with working ticks and all that other crap. My problem is coming up with the formula to figure out the current value for the slider. It has "Min" & "Max" values that need to be taken into consideration also. So I'm guessing you subtract the "min" from the "max" to get the available range and use that to calculate where the imagebox is inside the picturebox.....(somehow). I'm giving 100 points because this has p!ssed me off so much. OK math guru's, what do you say?

Thanks,
RandyB30
Comment
Watch Question

View Solution Only

Commented:
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.

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

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
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
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

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
CERTIFIED EXPERT
Commented:
RandyB30, I haven't looked through ameba's example though it probably has the same stuff there, anyway here is how I would calculate it:

Range = Max - Min
ActualRange = Right - Left (Range of image box positions)
CurrentLeftOffset = CurrentLeftPos - Left
Value = Range * (CurrentLeftOffset / ActualRange) + Min

So ActualRange is the lowest possible .Left to the highest possible .Left value of the slider thumb itself.

Calculating the currentleftoffset as the current .left position - the lowest possible gives you the relative position in the range, this divided by the range gives you a multiplier in the range 0 - 1 which can be interpreted as the percentage of the range complete which when applied to the "virtual" range adding back the virtual minimum value gives the actual current value.

Commented:
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...
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
CERTIFIED EXPERT

Commented:
Same principle should work as you say substituting top and bottom.
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
CERTIFIED EXPERT

Commented:
I think I got it there, Just use

Value = 100 - Value

To invert it.
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
CERTIFIED EXPERT

Commented:
Of course, it should be ActualRange - Value not 100, I forgot that the min and max values could change.
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
nope, that made it worse because the actual range is up in the thousands due to the size of the picture box
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
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
Senior Systems Analyst
CERTIFIED EXPERT

Commented:
Thanks for the help Tim