Length picker

[oxicottin]

I been goofing with this picker I need for a few days now and I cant figure out a few things and needed help.

1) when I click in the text box to open the picker it isnt showing the number that is in the textbox if there already is one, what does the VBA need to show this in the pickers textbox AND move the picker to the correct length?
2) I have the picker as a On Mouse Move event How can I just get the Indicator to be a Mouse Down and Up to show my length instead? I need this because mousing on and off as moving my lengths.

Thanks!

[jonh]

The Move event is ok, you just need to check the button.


Option Compare Database
Option Explicit

Private startpos As Integer

Private Sub Form_Load()
PosFromStr
End Sub

Private Sub imgIndicator_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
startpos = x
End Sub

Private Sub imgIndicator_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button <> 1 Then Exit Sub
Dim p As Long
p = Me.imgIndicator.Left + x - startpos

Select Case p
Case Is < imgSlider.Left
imgIndicator.Left = imgSlider.Left
Case Is > imgSlider.Left + imgSlider.Width - 1
imgIndicator.Left = imgSlider.Left + imgSlider.Width - 1
Case Else
imgIndicator.Left = imgIndicator.Left + x - startpos
End Select

FilltxtMeasure
End Sub

Sub PosFromStr()
Dim s As String
s = Trim("" & gtxtTarget)
If s = "" Then
Me.imgIndicator.Left = Me.imgSlider.Left
Else
Dim x As Long, p As Variant
x = imgSlider.Width / (32 * 2)
s = Left(s, InStrRev(s, "/") - 1)
p = Split(s, "-")
p(0) = CInt(p(0)) * 32
Me.imgIndicator.Left = Me.imgSlider.Left + (x * (CInt(p(1)) + CInt(p(0))))
End If
FilltxtMeasure
End Sub

Sub FilltxtMeasure()
Me.txtMeasurement = ConvertTo32nds((Me.imgIndicator.Left - Me.imgSlider.Left) / Me.imgSlider.Width * 2)
End Sub

Public Function ConvertTo32nds(dblValue As Double) As String
Dim lngWhole As Long
Dim dblRemainder As Double
Dim int32nds As Integer
lngWhole = Int(dblValue)
dblRemainder = dblValue - lngWhole
int32nds = Int(dblRemainder * 32)
ConvertTo32nds = CStr(lngWhole) & "-" & CStr(int32nds) & "/32"
End Function

Private Sub btnCancel_Click()
DoCmd.Close acForm, Me.Name
End Sub

Private Sub btnOk_Click()
On Error Resume Next
'Purpose: Transfer the result back to the calling text box (if there is one), and close.

If Me.btnOk.Enabled Then
If gtxtTarget = Me.txtMeasurement Then
'do nothing
Else
gtxtTarget = Me.txtMeasurement
End If
End If
gtxtTarget.SetFocus
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

[oxicottin]

jonh, thank you very much this is exactly what I was needing, This is way out of my leauge in VBA.....

[oxicottin]

jonh, I am having trouble with these active X sliders/pickers they work on some PC's but not on the PC's intended for so is there a way the attached sliders can be converted to a mouse move and mouse down image like the one you did for me for the length? I guess sliders dont work correct with newer versions of access but they still put them in the list....

Thanks!

[jonh]

What problem are you having?

I got a mouse move event error.
Since you don't have a mouse move event I removed all the code, saved the form, added it back in and it worked ok.

[oxicottin]

What problem are you having?

I got a mouse move event error.
Since you don't have a mouse move event I removed all the code, saved the form, added it back in and it worked ok.

Im getting this error on this the PC' I need to use it on. I get the error as soon as I mouse over the sliders.

[jonh]

That's the same error I got.

[oxicottin]

And to fix it you removed all the code in the forms OR module then saved it and pasted it back in? Then it worked.....

[jonh]

Well, you might only need to get the code to recompile again but I commented out all of the code in the two forms that don't work, saved them, ran them and then uncommented the code again. That's just the way I deal with strange bugs, remove unneeded code and add it back in piece by piece.

For some reason the form seems to think there is a mouse move event in the form module when there isn't.

[oxicottin]

Well I'm going to try to comment it out like you did and see if that works. Compile doesn't work I already tried that. The only other option is to make it like above.

I have read that the slider does not work in newer versions of access 07 and newer but why would they still offer it if it didn't... I'll post back in a bit I'll give it a try.

[oxicottin]

Well I commented out just like you did and it worked but I still dont feel at ease because it shouldnt have done it. I still would like to get out of an active X and into something like what the length picker is like. Thanks!

[SamT]

Export the Forms either before or as you remove them. Save and reopen Access and Import the saved forms.

[oxicottin]

Export the Forms either before or as you remove them. Save and reopen Access and Import the saved forms.

Sam, you lost me....:bug:

[oxicottin]

Here is another funny thing now I tried it on my PC I built it on and im now getting the error on that PC and not on the PC I need it on BUT thats not good... On mouse move is killing me where is it coming from!

[jonh]

Hehe, fun isn't it?

Access is a great program but it's always been prone to strange bugs. Sounds like your file might be corrupt.

Best thing to do in that case is use Application.SaveAsText and Application.LoadFromText to export your objects and load them back into a fresh file. Pain in the behind, but it's the only sure way to fix a broken file imho.

You can build your own controls easily enough. Just create a form that does what you need and add it as a subform.

I haven't put much effort into this, but it should get you started.

Create a new form, add a rectangle and paste the code.


Option Compare Database
Private incr As Single
Private imin As Integer
Private imax As Integer
Private ix As Single
Private tgt As Object
Public Sub Range(minval As Integer, maxval As Integer, Optional o As Object)
imin = minval
imax = maxval
incr = CInt((Me.InsideWidth - Box0.Width) / (imax - imin))
Set tgt = o
End Sub
Private Sub Box0_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
ix = x
End Sub
Private Sub Box0_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button <> 1 Then Exit Sub
Dim t As Single
t = Box0.Left + x - ix
Select Case t
Case Is < 0
Box0.Left = 0
Case Is > Me.InsideWidth - Box0.Width
Box0.Left = SnapToGrid(Me.InsideWidth - Box0.Width)
Case Else
Box0.Left = SnapToGrid(t)
End Select
If Not tgt Is Nothing Then
tgt = imin + (Box0.Left / incr)
End If
End Sub
Private Function SnapToGrid(x As Single)
SnapToGrid = CInt(x / incr) * incr
End Function
Private Sub Form_Resize()
Me.RecordSelectors = False
Me.DividingLines = False
Me.NavigationButtons = False
Me.ScrollBars = False
Me.Section(0).BackColor = RGB(150, 150, 150)

Box0.Top = 0
Box0.Left = 0
Box0.Height = Me.InsideHeight
Box0.Width = 100
Box0.BackStyle = 1
Box0.BackColor = RGB(200, 200, 200)
Box0.SpecialEffect = 1
End Sub

Create another form, add your first form as a subform and use code like this to set min/max and target control.


Private Sub Form_Load()
Child0.Form.Range 1, 10, Text1
End Sub