Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

How to display a value as a speedometer like line

Posted on 2004-03-22
9
430 Views
Last Modified: 2006-11-17
I want to display a value that will fall between 10 and -10 with 0 being vertical. I know how to draw a line between two points and the starting point will always be the same; but how to you figure the end point on an arc between the two limits?
0
Comment
Question by:Five_Bs
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 6

Expert Comment

by:___XXX_X_XXX___
ID: 10649910
You must use trigonometric functions like Sin and/or Cos.

Imagine the circle. Your 0 value is at 90 degrees. On which degrees of circle are -10 and 10 values ?

If you say that, it will be easy to answer your question.
0
 
LVL 9

Expert Comment

by:p_sie
ID: 10650072
Remember the Sin and Cos functions in VB use radials i.e. 360 degrees (full circle) = 2 * Pi
example: value = 5 then angleInDegrees = 45 degrees --> angleInRadials = 0.7853

Distance = the length of the 'meter'/'pointer'/'line'

sin(angle) = y-value / distance --> y-value = sin(angle)* distance
cos(angle) = x-value / distance --> x-value = cos(angle) * distance

so draw a line from startpoint to (x-value,y-value).

example: value = 5 then angleInDegrees = 45 degrees --> angleInRadials = 0.7853
0
 
LVL 11

Accepted Solution

by:
jmwheeler earned 250 total points
ID: 10650083
This should help you out.  This code should work assuming you draw a line straight up and down on your form with x2, y2 as the base point for the line.  In this example you enter a number in a textbox and press the command button to update the line.  Alter it to fit your need.  This example is written specifically for -10 being a horizontal line to the left, 0 being vertical, and 10 being a horizontal line to the right.


Private MyValue As Integer
Private BaseX As Integer
Private BaseY As Integer
Private LineLength As Integer
Private pi As Double

Private Sub Command1_Click()
    MyValue = Text1
    Line1.X1 = Line1.X2 + (LineLength * (Sin(DegToRad(9 * MyValue))))
    Line1.Y1 = Line1.Y2 - (LineLength * (Cos(DegToRad(9 * MyValue))))
End Sub

Private Sub Form_Load()
    BaseX = Line1.X2
    BaseY = Line1.Y2
    LineLength = Abs(Line1.Y1 - Line1.Y2)
    pi = Atn(1) * 4
End Sub

Function DegToRad(ByVal Degrees As Double) As Double
    DegToRad = Degrees / 180 * pi
End Function
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

Author Comment

by:Five_Bs
ID: 10651259
I'm impressed with three responses in one afternoon.

Oh I do like code examples as I'm far too lazy to do it myself. Once altered and tested you'll get the points jmwheeler. Though I'm a little embarrassed as p_sie gave the mathematical solution.
Perhaps I can increase and split the points.

My intent was a 90º total swing of 45º either side of vertical. I figure I should Atn(1) * 2 instead of * 4
0
 
LVL 11

Expert Comment

by:jmwheeler
ID: 10653183
No, don't change Pi.  Change the '9' to a '4.5' in the to lines doing the calculation.
0
 
LVL 28

Expert Comment

by:Ark
ID: 10655225
Hi

'========Bas module code=============
Public Const PI As Double = 3.14159265358979

Public Function Rad(ByVal x As Double) As Double
   Rad = x * PI / 180
End Function

Public Function Deg(ByVal x As Double) As Double
   Deg = x * 180 / PI
End Function

Public Function Sind(ByVal x As Double) As Double
   Sind = Sin(Rad(x))
End Function

Public Function Cosd(ByVal x As Double) As Double
   Cosd = Cos(Rad(x))
End Function

Public Function Arccosd(ByVal x As Double) As Double
  If x = 1 Then
     Arccosd = 0
  ElseIf x = -1 Then
     Arccosd = 180
  Else
     Arccosd = Deg(Atn(-x / Sqr(1 - x * x))) + 90
  End If
End Function

Public Function NormalizeAngle(ByVal x As Double) As Double
   If x < 0 Then
      NormalizeAngle = x + 360
   ElseIf x > 360 Then
      NormalizeAngle = x - 360
   Else
      NormalizeAngle = x
   End If
End Function

Public Function Atan2(ByVal y As Double, ByVal x As Double) As Double
   If x = 0 Then
      Atan2 = IIf(y < 0, 3 * PI / 2, PI / 2)
   Else
      Atan2 = Atn(y / x)
      If x < 0 Then
         If y < 0 Then Atan2 = Atan2 + PI Else Atan2 = Atan2 - PI
      End If
   End If
End Function

Public Function GetRandom(ByVal iLow As Integer, ByVal iHi As Integer) As Integer
   GetRandom = iLow + Int((iHi - iLow) * Rnd)
End Function

'===========Form code==========
'Add picturebox, label,commandbutton and timer with default names on form
Private Declare Function FloodFill Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Sub Command1_Click()
   Timer1.Enabled = Not Timer1.Enabled
   If Timer1.Enabled Then
      Command1.Caption = "Stop show"
   Else
      Command1.Caption = "Start show"
   End If
End Sub

Private Sub Form_Load()
   Picture1.AutoRedraw = True
   Picture1.Move 0, 0, ScaleWidth, ScaleHeight - 600
   Label1.Move 0, Picture1.Height + 120, 750, 450
   Label1.AutoSize = True
   Command1.Width = 1500
   Command1.Move ScaleWidth - Command1.Width, Label1.Top, Command1.Width, 450
   Label1 = "Value = 0"
   Timer1.Interval = 1000
   Timer1.Enabled = False
   Command1.Caption = "Start show"
   DrawGauge Picture1, 0, vbRed, vbYellow, vbBlue
End Sub

Private Sub DrawGauge(pb As PictureBox, m_Value As Single, _
        Optional LineColor As Long = vbRed, Optional GaugeColor = vbBlack, _
        Optional GaugeFillColor = -1)
   pb.Cls
   pb.ForeColor = GaugeColor
   
   Dim h As Single, w As Single, r As Single
   Dim x As Single, y As Single
   Dim x1 As Single, y1 As Single
   Dim i As Integer
   w = pb.ScaleWidth - 30
   h = pb.ScaleHeight ' - 180
   
   r = w / 2
'   pb.Circle (r, h), r, , PI / 4, 3 * PI / 4
'   y = h - r * Cosd(45)
'   x = r + r * Sind(45)
'   pb.Line (w / 2, h)-(x, y)
'   x = r - r * Sind(45)
'   pb.Line (w / 2, h)-(x, y)
   If GaugeFillColor <> -1 Then
      FloodFill pb.hDC, r / Screen.TwipsPerPixelX, h / Screen.TwipsPerPixelY / 2, GaugeFillColor
   End If
   
   For i = -10 To 10
      x = r + r * Sind(i * 4.5)
      y = h - r * Cosd(i * 4.5)
      x1 = r + (r - 120) * Sind(i * 4.5)
      y1 = h - (r - 120) * Cosd(i * 4.5)
      pb.Line (x, y)-(x1, y1)
      If (i Mod 2) = 0 Then
         If i = -10 Then
            pb.CurrentX = x + 60
         ElseIf i = 10 Then
            pb.CurrentX = x - 300
         Else
            pb.CurrentX = x1 - 90
         End If
         pb.Print i
      End If
   Next i
   x = r + r * Sind(m_Value * 4.5)
   y = h - r * Cosd(m_Value * 4.5)
   pb.DrawWidth = 2
   pb.Line (r, h)-(x, y), LineColor
   pb.DrawWidth = 1
End Sub

Private Sub Timer1_Timer()
   Dim iVal As Single
   iVal = GetRandom(-100, 100) / 10
   Label1 = "Value = " & iVal
   DrawGauge Picture1, iVal, vbRed, vbYellow, vbBlue
End Sub




0
 
LVL 28

Expert Comment

by:Ark
ID: 10655237
PS. Sorry, bas module is a bit overloaded - I just copied it from my mTrigo module which I use often. You need Rad(Deg->Rad), Sind(Sin in degrees), Cosd (Cos in degrees) and GetRandom functions from it.
0
 
LVL 28

Expert Comment

by:Ark
ID: 10655287
Another Gauge type:

Private Sub DrawGauge(pb As PictureBox, m_Value As Single, _
        Optional LineColor As Long = vbRed, Optional GaugeColor = vbBlack, _
        Optional GaugeFillColor = -1)
   pb.Cls
   pb.ForeColor = GaugeColor
   
   Dim h As Single, w As Single, r As Single
   Dim x As Single, y As Single
   Dim x1 As Single, y1 As Single
   Dim i As Integer
   w = pb.ScaleWidth - 30
   h = pb.ScaleHeight ' - 180
   
   r = w / 2
   If GaugeFillColor <> -1 Then
      FloodFill pb.hDC, r / Screen.TwipsPerPixelX, h / Screen.TwipsPerPixelY / 2, GaugeFillColor
   End If
   x = r + r * Sind(m_Value * 4.5)
   y = h - r * Cosd(m_Value * 4.5)
   pb.DrawWidth = 8
   pb.Circle (r, h), r - 60, LineColor, Rad(90 - m_Value * 4.5), 3 * PI / 4
   pb.DrawWidth = 1
   
   For i = -10 To 10
      x = r + r * Sind(i * 4.5)
      y = h - r * Cosd(i * 4.5)
      x1 = r + (r - 120) * Sind(i * 4.5)
      y1 = h - (r - 120) * Cosd(i * 4.5)
      pb.Line (x, y)-(x1, y1)
      If (i Mod 2) = 0 Then
         If i = -10 Then
            pb.CurrentX = x + 60
         ElseIf i = 10 Then
            pb.CurrentX = x - 300
         Else
            pb.CurrentX = x1 - 90
         End If
         pb.Print i
      End If
   Next i
End Sub
0
 

Author Comment

by:Five_Bs
ID: 10656917
Thanks Arc but I have already integrated jmwheeler's code.
The line now points to exactly where I want it.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Access 2013 combo box not working 3 51
Sorting multiple rows and columns, and count duplicates in Excel 2013 4 87
Help me. 3 60
checkbox to hide entire section 10 42
Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

838 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question