home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Custom_Gau204692282007.psc / gauge / GaugeOCX / UserControl1.ctl < prev    next >
Text File  |  2007-02-08  |  5KB  |  145 lines
  1. VERSION 5.00
  2. Begin VB.UserControl gauge 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   1590
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   1590
  8.    ControlContainer=   -1  'True
  9.    HitBehavior     =   2  'Use Paint
  10.    Picture         =   "UserControl1.ctx":0000
  11.    ScaleHeight     =   1590
  12.    ScaleWidth      =   1590
  13.    ToolboxBitmap   =   "UserControl1.ctx":84C2
  14.    Begin VB.Shape Shape1 
  15.       Height          =   1590
  16.       Left            =   0
  17.       Top             =   0
  18.       Width           =   1590
  19.    End
  20.    Begin VB.Label lblReading 
  21.       Alignment       =   2  'Center
  22.       BackColor       =   &H00404040&
  23.       BorderStyle     =   1  'Fixed Single
  24.       ForeColor       =   &H0000FF00&
  25.       Height          =   240
  26.       Left            =   540
  27.       TabIndex        =   0
  28.       Top             =   1095
  29.       Width           =   525
  30.    End
  31.    Begin VB.Line LinePointer 
  32.       BorderWidth     =   2
  33.       X1              =   810
  34.       X2              =   315
  35.       Y1              =   795
  36.       Y2              =   795
  37.    End
  38. End
  39. Attribute VB_Name = "gauge"
  40. Attribute VB_GlobalNameSpace = False
  41. Attribute VB_Creatable = True
  42. Attribute VB_PredeclaredId = False
  43. Attribute VB_Exposed = True
  44. '*******************************************************************************
  45. ' FREEWARE OCX guage
  46. ' by Diaa Eldessouky
  47. ' diaa1972@gmail.com
  48. '*******************************************************************************
  49. Option Explicit
  50.  
  51. Const pointerLength As Integer = 600 ' gauge pointer length
  52. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  53. Dim pointerUnitAngle As Single ' the unit angle by which the pointer will change
  54. Dim PI As Double ' PI= 3.14159265358979 !!
  55. Dim numMin As Single ' the minimum gauge reading
  56. Dim numMax As Single ' the maximum gauge reading
  57. Dim numValue As Single ' the current gauge reading
  58.  
  59. Public Property Get min() As Single
  60.     min = numMin
  61. End Property
  62.  
  63. Public Property Let min(mini As Single)
  64.     numMin = mini
  65.     PropertyChanged "min"
  66.     initgauge min, max
  67. End Property
  68.  
  69. Public Property Get max() As Single
  70.     max = numMax
  71. End Property
  72.  
  73. Public Property Let max(maxi As Single)
  74.     numMax = maxi
  75.     PropertyChanged "max"
  76.     initgauge min, max
  77. End Property
  78.  
  79. Public Property Get value() As Single
  80.     value = numValue
  81. End Property
  82.  
  83. Public Property Let value(reading As Single)
  84.     numValue = reading
  85.     PropertyChanged "value"
  86.     setReading reading
  87. End Property
  88.  
  89. Private Sub setReading(curValue As Single)
  90.     curValue = curValue - min
  91.     lblReading = curValue + min
  92.     movePointer (180 + curValue * pointerUnitAngle)
  93.         ' 180 to start the pointer motion at the left side of the gauge
  94. End Sub
  95.  
  96. Private Sub initgauge(minReading As Single, maxReading As Single)
  97.     Cls
  98.     UserControl_Resize
  99.     LinePointer.X1 = UserControl.Width / 2 - 22
  100.     LinePointer.Y1 = UserControl.Height / 2 - 22
  101.     DrawGaugeLimits
  102.      
  103.     If maxReading = minReading Then maxReading = minReading + 1 ' to avoid dev/zero
  104.     pointerUnitAngle = 180 / (maxReading - minReading)
  105.             ' 180 means that the pointer will move in half circle
  106.     value = minReading ' initial gauge reading will be the minimum one
  107. End Sub
  108.  
  109. Private Sub movePointer(curcurValue As Single)
  110.    LinePointer.X2 = LinePointer.X1 + pointerLength * Cos(curcurValue * PI / 180)
  111.    LinePointer.Y2 = LinePointer.Y1 + pointerLength * Sin(curcurValue * PI / 180)
  112. End Sub
  113.  
  114. Private Sub UserControl_Initialize()
  115.     PI = 4 * Atn(1) ' thanx to Ian Bunting
  116. End Sub
  117.  
  118. Private Sub UserControl_Resize()
  119.     UserControl.Width = 1600
  120.     UserControl.Height = 1600
  121. End Sub
  122.  
  123. Private Sub DrawGaugeLimits()
  124.     ' thanx to Roger Gilchrist
  125.    Dim tmpShift As Integer
  126.    tmpShift = 130 ' this number is got by trials
  127.    ForeColor = vbBlack
  128.    TextOut hdc, tmpShift / 15, Height / 30, Str$(min), Len(Str$(min))
  129.    ForeColor = vbRed
  130.    TextOut hdc, (Width - tmpShift * 2 - (Len(Str$(max)) - 1) * 100) / 15, Height / 30, Str$(max), Len(Str$(max))
  131. End Sub
  132.  
  133. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  134.     PropBag.WriteProperty "min", numMin, 0
  135.     PropBag.WriteProperty "max", numMax, 1
  136.     PropBag.WriteProperty "value", numValue, numMin
  137. End Sub
  138.  
  139. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  140.     min = PropBag.ReadProperty("min", 0)
  141.     max = PropBag.ReadProperty("max", 1)
  142.     value = PropBag.ReadProperty("value", numMin)
  143. End Sub
  144.  
  145.