home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rotate2a / angbutto.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-18  |  10.5 KB  |  304 lines
  1. VERSION 5.00
  2. Begin VB.UserControl angButton 
  3.    ClientHeight    =   1245
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   1395
  7.    ForeColor       =   &H8000000F&
  8.    MousePointer    =   2  'Cross
  9.    ScaleHeight     =   83
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   93
  12.    ToolboxBitmap   =   "angButton.ctx":0000
  13.    Begin VB.PictureBox picMask 
  14.       Appearance      =   0  'Flat
  15.       BorderStyle     =   0  'None
  16.       DrawWidth       =   2
  17.       ForeColor       =   &H80000008&
  18.       Height          =   1320
  19.       Left            =   0
  20.       ScaleHeight     =   88
  21.       ScaleMode       =   3  'Pixel
  22.       ScaleWidth      =   96
  23.       TabIndex        =   1
  24.       Top             =   0
  25.       Width           =   1440
  26.    End
  27.    Begin VB.PictureBox picImage 
  28.       AutoRedraw      =   -1  'True
  29.       Height          =   1260
  30.       Left            =   1440
  31.       Picture         =   "angButton.ctx":0312
  32.       ScaleHeight     =   80
  33.       ScaleMode       =   3  'Pixel
  34.       ScaleWidth      =   160
  35.       TabIndex        =   0
  36.       Top             =   0
  37.       Visible         =   0   'False
  38.       Width           =   2460
  39.    End
  40. Attribute VB_Name = "angButton"
  41. Attribute VB_GlobalNameSpace = False
  42. Attribute VB_Creatable = True
  43. Attribute VB_PredeclaredId = False
  44. Attribute VB_Exposed = False
  45. '-----------------------------------------------------
  46. ' AngButton (c) Copyright Emilio Aguirre 1999
  47. '               eaguirre@comtrade.com.mx
  48. '_----------------------------------------------------
  49. Option Explicit
  50. 'Types
  51. Private Type POINTAPI
  52.    x As Long
  53.    y As Long
  54. End Type
  55. Private Type LOGBRUSH
  56.         lbStyle As Long
  57.         lbColor As Long
  58.         lbHatch As Long
  59. End Type
  60. 'API Declares & Constants
  61. Const SRCAND = &H8800C6          ' (DWORD) dest = source AND dest
  62. Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  63. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
  64.     ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
  65.     ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  66. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, _
  67.         ByVal nCount As Long) As Long
  68. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  69. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  70. Private Declare Function SetPolyFillMode Lib "gdi32" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long
  71. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  72. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  73. Const BS_SOLID = 0
  74. 'Enumarations
  75. Enum TraceValue
  76.   Set_Off = 0
  77.   Set_On = 1
  78. End Enum
  79. 'Default Property Values:
  80. Const m_def_Angle = 0
  81. Const m_def_Color = vbRed
  82. Const m_def_Trace = Set_On
  83. Const m_PI = 3.14159265358979
  84. 'Property Variables:
  85. Dim m_Angle As Integer
  86. Dim m_Color As OLE_COLOR
  87. Dim m_Trace As TraceValue
  88. Dim m_blnMouse As Boolean
  89. 'Value of angle in degrees
  90. Public Property Get Angle() As Integer
  91.     Angle = m_Angle
  92. End Property
  93. Public Property Let Angle(ByVal New_Angle As Integer)
  94.     m_Angle = New_Angle
  95.     PropertyChanged "Angle"
  96. End Property
  97. 'Draw color
  98. Public Property Get color() As OLE_COLOR
  99.     color = m_Color
  100. End Property
  101. Public Property Let color(ByVal New_Color As OLE_COLOR)
  102.     m_Color = New_Color
  103.     PropertyChanged "Color"
  104.     PaintControl
  105. End Property
  106. 'Value of trace mode
  107. Public Property Get Trace() As TraceValue
  108.     Trace = m_Trace
  109. End Property
  110. Public Property Let Trace(ByVal New_Trace As TraceValue)
  111.     m_Trace = New_Trace
  112.     PropertyChanged "Trace"
  113.     PaintControl
  114. End Property
  115. Private Sub picMask_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  116.   If (Not m_blnMouse) Then m_blnMouse = True
  117.   CalculateNewAngle x, y
  118. End Sub
  119. Private Sub picMask_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  120. If ((Button And vbLeftButton) > 0) And (m_blnMouse) Then
  121.    CalculateNewAngle x, y
  122. End If
  123. End Sub
  124. Private Sub picMask_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  125. If (m_blnMouse) Then m_blnMouse = False
  126. End Sub
  127. Private Sub picMask_Paint()
  128. PaintControl
  129. End Sub
  130. Private Sub UserControl_Resize()
  131. Height = 1200: Width = 1200 'Force to keep original values in twips
  132. picMask.Height = 1200
  133. picMask.Width = 1200
  134. PaintControl
  135. End Sub
  136. 'Load property values from storage
  137. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  138.     m_Angle = PropBag.ReadProperty("Angle", m_def_Angle)
  139.     m_Color = PropBag.ReadProperty("Color", m_def_Color)
  140.     m_Trace = PropBag.ReadProperty("Trace", m_def_Trace)
  141. End Sub
  142. 'Write property values to storage
  143. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  144.     Call PropBag.WriteProperty("Angle", m_Angle, m_def_Angle)
  145.     Call PropBag.WriteProperty("Color", m_Color, m_def_Color)
  146.     Call PropBag.WriteProperty("Trace", m_Trace, m_def_Trace)
  147. End Sub
  148. 'Initialize Properties for User Control
  149. Private Sub UserControl_InitProperties()
  150.     m_Angle = m_def_Angle
  151.     m_Color = m_def_Color
  152.     m_Trace = m_def_Trace
  153. End Sub
  154. Private Sub CalculateNewAngle(x As Single, y As Single)
  155. Dim intX As Integer
  156. Dim intY As Integer
  157. Dim intAngle As Integer
  158. Dim blnNoKeep As Boolean    'Flag for prevent redrawing when it is not necessary
  159. blnNoKeep = True
  160. If y > 40 Then
  161.     ' Plus button. Increments the angle by one
  162.     If (x > 3) And (x < 15) And (y > 58) And (y < 68) Then
  163.       intAngle = Angle + 1
  164.       If intAngle > 180 Then intAngle = 180
  165.     ElseIf (x > 63) And (x < 74) And (y > 58) And (y < 68) Then
  166.     ' Minus buton. Decrements the angle by one
  167.        intAngle = Angle - 1
  168.        If intAngle < 0 Then intAngle = 0
  169.     Else
  170.        blnNoKeep = False
  171.     End If
  172.     'Calculate the position of the click button, in a standard coordinate
  173.     'system.
  174.     intX = x - 40
  175.     intY = (y - 40) * -1
  176.     If intY = 0 Then
  177.        If intX > 0 Then
  178.          intAngle = 0
  179.        Else
  180.          intAngle = 180
  181.         End If
  182.     Else
  183.       If intY > 0 Then
  184.         If intX = 0 Then
  185.           intAngle = 90
  186.         Else
  187.           intAngle = (Atn(intY / intX) * (180 / m_PI))
  188.         End If
  189.         If (intAngle < 0) Then intAngle = 180 + intAngle
  190.       Else
  191.         blnNoKeep = False 'No repainting
  192.       End If
  193.     End If
  194. End If
  195. If blnNoKeep Then
  196.    Angle = intAngle
  197.    PaintControl
  198. End If
  199. End Sub
  200. Private Sub PaintControl()
  201. Dim sngTheta As Single          'Angle in Radians
  202. Dim j As Integer
  203. Dim ang As Integer
  204. Dim col As Long
  205. Dim m_P(3) As POINTAPI
  206. Dim m_R(3) As POINTAPI
  207. Dim lb As LOGBRUSH
  208. Dim brush As Long
  209. Dim pen As Long
  210. ang = Angle
  211. col = color
  212. m_P(0).x = 36:  m_P(0).y = 0
  213. m_P(1).x = 27: m_P(1).y = 0
  214. m_P(2).x = 10:  m_P(2).y = 5
  215. m_P(3).x = 10:  m_P(3).y = -5
  216. 'Drawing the background
  217. BitBlt picMask.hdc, 0, 0, 79, 79, picImage.hdc, 80, 0, SRCAND
  218. BitBlt picMask.hdc, 0, 0, 79, 79, picImage.hdc, 0, 0, SRCPAINT
  219. 'Drawing the angle marker
  220. sngTheta = -ang * m_PI / 180
  221. If Trace = Set_Off Then
  222.     'Trace off option
  223.      For j = 0 To 3
  224.       If j = 0 Then
  225.         picMask.DrawWidth = 5
  226.       Else
  227.         picMask.DrawWidth = 1
  228.       End If
  229.       m_R(j).x = (m_P(j).x * Cos(sngTheta) - m_P(j).y * Sin(sngTheta)) + 40
  230.       m_R(j).y = (m_P(j).x * Sin(sngTheta) + m_P(j).y * Cos(sngTheta)) + 40
  231.       picMask.PSet (m_R(j).x, m_R(j).y), col
  232.     Next j
  233.     picMask.DrawWidth = 2
  234.     lb.lbStyle = BS_SOLID
  235.     lb.lbColor = col
  236.     lb.lbHatch = 0
  237.     brush = CreateBrushIndirect(lb)
  238.     pen = CreatePen(0, 1, col)
  239.     SelectObject picMask.hdc, brush
  240.     SelectObject picMask.hdc, pen
  241.     Polygon picMask.hdc, m_R(1), 3
  242.     DeleteObject pen
  243.     DeleteObject brush
  244.    'Trace on option
  245.    picMask.DrawWidth = 5
  246.    m_R(0).x = (m_P(0).x * Cos(sngTheta) - m_P(0).y * Sin(sngTheta)) + 40
  247.    m_R(0).y = (m_P(0).x * Sin(sngTheta) + m_P(0).y * Cos(sngTheta)) + 40
  248.    picMask.PSet (m_R(0).x, m_R(0).y), col
  249.    picMask.DrawWidth = 10
  250.    If ang > 0 Then picMask.Circle (42, 40), 20, col, 0, ang * m_PI / 180
  251.    picMask.DrawWidth = 2
  252. End If
  253. 'Display LED numbers
  254. LEDNumbers picMask, 28, 57, Angle, color, 1
  255. End Sub
  256. Private Sub LEDNumbers(objCurrent As Object, ByVal x As Single, ByVal y As Single, ByVal intNbr As Integer, ByVal olecolor As OLE_COLOR, Optional ByVal sngScale As Single)
  257. '----------------------------------------------------
  258. 'objCurrent     - Object where the numbers will be painted
  259. 'x,y            - Position of the upper-left point where
  260. '                 the numbers will start to appear
  261. 'intNbr         - Value (max. 3 characters)
  262. 'olecolor       - Color for painting
  263. 'sngScale       - Scale Factor
  264. '----------------------------------------------------
  265. Dim intDigit As Integer     ' Next digit number for paint
  266. Dim intLine As Integer      ' Next number line for paint.
  267. Dim i As Integer            ' Each line number is composed by 7 lines:
  268. Dim j As Integer            '    0  __
  269. Dim intCurPos As Integer    '   1  |  |  2
  270. Dim X1 As Single            '   3   __
  271. Dim Y1 As Single            '   4  |  |  5
  272. Dim X2 As Single            '    6  __
  273. Dim Y2 As Single
  274. Dim strChain As String      ' String chain number (example. for constructing number 3 we need
  275. Dim strNum As String        ' to draw lines 0, 2, 3, 5 and 6
  276. If sngScale = 0 Then sngScale = 1       'Default Scale Value
  277. intCurPos = 0
  278. strNum = Format(CStr(intNbr), "000")    'Format the output
  279. For j = 1 To Len(strNum)
  280. intDigit = Val(Mid$(strNum, j, 1))
  281.     strChain = Choose(intDigit + 1, "654210", "52", "64320", "65320", "5321", "65310", "654310", "520", "6543210", "653210")
  282.     For i = 1 To Len(strChain)
  283.        intLine = Val(Mid$(strChain, i, 1))
  284.        Select Case intLine
  285.          Case 0, 3, 6                   'Drawing lines 0,3 and 6
  286.            X1 = x + 1: Y1 = y + (intLine * 2): X2 = x + 5: Y2 = y + (intLine * 2)
  287.          Case Else
  288.            If intLine < 3 Then
  289.              Y1 = y + 1: Y2 = y + 5
  290.            Else
  291.              Y1 = y + 7: Y2 = y + 11
  292.            End If
  293.            If (intLine = 1) Or (intLine = 4) Then
  294.               X1 = x: X2 = x
  295.            Else
  296.              X1 = x + 6: X2 = x + 6
  297.            End If
  298.        End Select
  299.        objCurrent.Line ((X1 + intCurPos) * sngScale, Y1 * sngScale)-((X2 + intCurPos) * sngScale, Y2 * sngScale), olecolor
  300.     Next i
  301.     intCurPos = intCurPos + 9           'skip to the next character position
  302. Next j
  303. End Sub
  304.