找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 8607|回复: 12

【VB6】自制旋钮控件

[复制链接]

1109

主题

1649

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24180 个
贡献
46222 次
宅之契约
0 份
在线时间
2294 小时
注册时间
2014-1-26
发表于 2015-5-30 02:12:01 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有账号?立即注册→加入我们

×
20150530013938.png
这个是旋钮控件,用于调整数值。
其中旋钮的把手的形状、大小都是可以调整的。你也可以不显示把手。
那个小红点也是可以选择是否显示的。
旋钮的旋转范围也是可以调整的。
此外就是,旋钮的刻度的显示密度也是可调的。
为了保证画风不和Windows界面冲突,绘制旋钮用的颜色都是取自系统颜色(比如按钮表面、按钮暗阴影、按钮亮阴影等颜色)。
  1. VERSION 5.00
  2. Begin VB.UserControl Knob
  3.    ClientHeight    =   2415
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2430
  7.    ScaleHeight     =   161
  8.    ScaleMode       =   3  'Pixel
  9.    ScaleWidth      =   162
  10.    Begin VB.PictureBox picKnob
  11.       Align           =   1  'Align Top
  12.       AutoRedraw      =   -1  'True
  13.       Height          =   1335
  14.       Left            =   0
  15.       ScaleHeight     =   85
  16.       ScaleMode       =   3  'Pixel
  17.       ScaleWidth      =   158
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   2430
  21.       Begin VB.PictureBox picBase
  22.          AutoRedraw      =   -1  'True
  23.          BorderStyle     =   0  'None
  24.          Height          =   495
  25.          Left            =   0
  26.          ScaleHeight     =   33
  27.          ScaleMode       =   3  'Pixel
  28.          ScaleWidth      =   33
  29.          TabIndex        =   1
  30.          Top             =   0
  31.          Visible         =   0   'False
  32.          Width           =   495
  33.       End
  34.    End
  35. End
  36. Attribute VB_Name = "Knob"
  37. Attribute VB_GlobalNameSpace = False
  38. Attribute VB_Creatable = True
  39. Attribute VB_PredeclaredId = False
  40. Attribute VB_Exposed = False
  41. '==============================================================================
  42. '作者:0xAA55
  43. '论坛:[url]http://www.0xaa55.com/[/url]
  44. '版权所有 (C) 2013-2015 技术宅的结界
  45. '请保留原作者信息,否则视为侵权。
  46. '------------------------------------------------------------------------------
  47. Option Explicit

  48. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

  49. Private Const Knob_PI As Double = 3.14159265358979
  50. Private m_Rad As Double
  51. Private m_Max As Long
  52. Private m_Value As Long
  53. Private m_Steps As Long
  54. Private m_MaxAng As Double
  55. Private m_MinAng As Double
  56. Private m_MouseDown As Boolean
  57. Private m_MouseAngle As Double
  58. Private m_BaseRad As Double
  59. Private m_HandleRad As Double
  60. Private m_DrawGrad As Boolean
  61. Private m_DrawPoint As Boolean
  62. Private m_DrawRaisedHandle As Boolean
  63. Private m_RaisedHandleWidth1 As Double
  64. Private m_RaisedHandleWidth2 As Double

  65. Event Click()
  66. Attribute Click.VB_Description = "Triggerd when clicked."
  67. Attribute Click.VB_UserMemId = -600
  68. Event DblClick()
  69. Attribute DblClick.VB_Description = "Triggerd when double clicked."
  70. Attribute DblClick.VB_UserMemId = -601
  71. Event Change(ByVal OldValue As Long, ByVal NewValue As Long)
  72. Attribute Change.VB_Description = "Triggerd when the value was changed."
  73. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  74. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  75. Attribute MouseMove.VB_UserMemId = -606
  76. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  77. Attribute MouseUp.VB_UserMemId = -607
  78. Event KeyDown(KeyCode As Integer, Shift As Integer)
  79. Attribute KeyDown.VB_UserMemId = -602
  80. Event KeyPress(KeyAscii As Integer)
  81. Attribute KeyPress.VB_UserMemId = -603
  82. Event KeyUp(KeyCode As Integer, Shift As Integer)
  83. Attribute KeyUp.VB_UserMemId = -604

  84. '绘制旋钮
  85. Private Sub DrawKnob()
  86. DrawBaseCircle '先绘制底座圆圈
  87. DrawHandle '然后绘制“把手”
  88. End Sub

  89. '绘制圆圈底座
  90. Private Sub DrawBaseCircle()
  91. If m_Rad <= 0 Then Exit Sub

  92. '用picBase来存住底座圆圈的图像
  93. picBase.Cls

  94. If m_DrawGrad Then
  95.     '画刻度
  96.     picBase.DrawWidth = 1
  97.     Dim Ang As Long
  98.     For Ang = 0 To m_Steps - 1
  99.         Dim CA As Double, CX As Double, CY As Double
  100.         CA = m_MinAng + (m_MaxAng - m_MinAng) * Ang / (m_Steps - 1) + Knob_PI * 0.5 '刻度的角度
  101.         CX = Cos(CA)
  102.         CY = Sin(CA)
  103.         picBase.Line (m_Rad + CX * m_Rad * m_BaseRad, m_Rad + CY * m_Rad * m_BaseRad)-(m_Rad + CX * m_Rad, m_Rad + CY * m_Rad) '画辐射线
  104.     Next
  105. End If

  106. '画底座
  107. picBase.DrawWidth = 3
  108. DrawLightedCircle picBase, m_Rad, m_Rad, m_Rad * m_BaseRad - 1, GetSysColor(vb3DHighlight And &HFF&), GetSysColor(vb3DDKShadow And &HFF&)
  109. picBase.DrawWidth = 2
  110. DrawLightedCircle picBase, m_Rad, m_Rad, m_Rad * m_BaseRad - 3, GetSysColor(vb3DLight And &HFF&), GetSysColor(vbButtonShadow And &HFF&)
  111. End Sub

  112. '绘制带光照处理的圆圈
  113. Private Sub DrawLightedCircle(Targ As PictureBox, ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal Color1 As Long, ByVal Color2 As Long)
  114. Dim Ang As Double
  115. Dim R1 As Long, G1 As Long, B1 As Long
  116. Dim R2 As Long, G2 As Long, B2 As Long
  117. Dim DotVal As Double, XV As Double, YV As Double, RV As Long, GV As Long, BV As Long

  118. '画笔的开始位置
  119. Targ.CurrentX = X + Radius
  120. Targ.CurrentY = Y

  121. '颜色1
  122. R1 = Color1 And &HFF
  123. G1 = (Color1 And &HFF00&) \ &H100
  124. B1 = (Color1 And &HFF0000) \ &H10000

  125. '颜色2
  126. R2 = Color2 And &HFF
  127. G2 = (Color2 And &HFF00&) \ &H100
  128. B2 = (Color2 And &HFF0000) \ &H10000

  129. '以像素为单位画一圈
  130. For Ang = 0 To Knob_PI * 2 Step 1 / Radius
  131.     XV = Cos(Ang)
  132.     YV = Sin(Ang)
  133.     DotVal = (XV + YV + 1) * 0.5 '与光线方向(1,1)做点乘,然后将[-1,1]变换到[0,1]
  134.     RV = R1 + (R2 - R1) * DotVal '颜色插值
  135.     GV = G1 + (G2 - G1) * DotVal
  136.     BV = B1 + (B2 - B1) * DotVal
  137.     Targ.Line -(X + XV * Radius, Y + YV * Radius), RGB(RV, GV, BV)
  138. Next
  139. End Sub

  140. Private Sub DrawLighedLine(Targ As PictureBox, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Color1 As Long, ByVal Color2 As Long)
  141. On Error Resume Next
  142. Dim DirX As Double, DirY As Double, DirL As Double
  143. DirX = X2 - X1
  144. DirY = Y2 - Y1
  145. DirL = Sqr(DirX * DirX + DirY * DirY)

  146. DirX = DirX / DirL
  147. DirY = DirY / DirL

  148. Dim NorX As Double, NorY As Double
  149. NorX = -DirY
  150. NorY = DirX

  151. Dim R1 As Long, G1 As Long, B1 As Long
  152. Dim R2 As Long, G2 As Long, B2 As Long
  153. Dim DotVal As Double, RV As Long, GV As Long, BV As Long

  154. '颜色1
  155. R1 = Color1 And &HFF
  156. G1 = (Color1 And &HFF00&) \ &H100
  157. B1 = (Color1 And &HFF0000) \ &H10000

  158. '颜色2
  159. R2 = Color2 And &HFF
  160. G2 = (Color2 And &HFF00&) \ &H100
  161. B2 = (Color2 And &HFF0000) \ &H10000

  162. DotVal = (NorX + NorY + 1) * 0.5 '与光线方向(1,1)做点乘,然后将[-1,1]变换到[0,1]
  163. RV = R1 + (R2 - R1) * DotVal '颜色插值
  164. GV = G1 + (G2 - G1) * DotVal
  165. BV = B1 + (B2 - B1) * DotVal

  166. Targ.DrawWidth = 2
  167. Targ.Line (X1, Y1)-(X2, Y2), RGB(RV, GV, BV)
  168. End Sub

  169. '画“把手”
  170. Private Sub DrawHandle()
  171. If m_Rad <= 0 Then Exit Sub

  172. Dim Ang As Double
  173. Ang = ValueToAngle(m_Value, m_Max) '旋钮的角度

  174. '先把画好的底座盖上去
  175. picKnob.PaintPicture picBase.Image, 0, 0

  176. '画凸起的把手
  177. If m_DrawRaisedHandle Then DrawRHandle

  178. '画小圆点
  179. If m_DrawPoint Then
  180.     picKnob.DrawWidth = 1
  181.     If m_MouseDown Then '鼠标按下的时候,填充颜色
  182.         picKnob.FillStyle = vbSolid
  183.         picKnob.FillColor = vbHighlight
  184.     Else
  185.         picKnob.FillStyle = 1
  186.     End If
  187.     picKnob.Circle (m_Rad + Cos(Ang) * m_Rad * m_BaseRad * 0.5, m_Rad + Sin(Ang) * m_Rad * m_BaseRad * 0.5), 2, vbRed
  188. End If
  189. End Sub

  190. '画凸起的把手
  191. Private Sub DrawRHandle()
  192. picKnob.DrawWidth = 2

  193. Dim Ang As Double
  194. Ang = ValueToAngle(m_Value, m_Max) '旋钮的角度

  195. Dim BaseRad As Double
  196. BaseRad = m_Rad * m_BaseRad * m_HandleRad

  197. '正向
  198. Dim DirX As Double, DirY As Double
  199. DirX = Cos(Ang)
  200. DirY = Sin(Ang)

  201. '侧向
  202. Dim SideX As Double, SideY As Double
  203. SideX = -DirY
  204. SideY = DirX

  205. Dim RHW1 As Double, RHW2 As Double
  206. RHW1 = m_RaisedHandleWidth1 * BaseRad
  207. RHW2 = m_RaisedHandleWidth2 * BaseRad

  208. Dim BackL As Double, FrontL As Double
  209. FrontL = Sqr(BaseRad * BaseRad - RHW1 * RHW1)
  210. BackL = Sqr(BaseRad * BaseRad - RHW2 * RHW2)

  211. Dim Color1 As Long, Color2 As Long
  212. Color1 = GetSysColor(vb3DHighlight And &HFF&)
  213. Color2 = GetSysColor(vb3DDKShadow And &HFF&)

  214. Dim PtX(3) As Double
  215. Dim PtY(3) As Double

  216. PtX(0) = m_Rad + DirX * FrontL + SideX * RHW1
  217. PtY(0) = m_Rad + DirY * FrontL + SideY * RHW1
  218. PtX(1) = m_Rad + DirX * FrontL - SideX * RHW1
  219. PtY(1) = m_Rad + DirY * FrontL - SideY * RHW1
  220. PtX(2) = m_Rad - DirX * BackL + SideX * RHW2
  221. PtY(2) = m_Rad - DirY * BackL + SideY * RHW2
  222. PtX(3) = m_Rad - DirX * BackL - SideX * RHW2
  223. PtY(3) = m_Rad - DirY * BackL - SideY * RHW2

  224. DrawLighedLine picKnob, PtX(0), PtY(0), PtX(1), PtY(1), Color1, Color2
  225. DrawLighedLine picKnob, PtX(1), PtY(1), PtX(3), PtY(3), Color1, Color2
  226. DrawLighedLine picKnob, PtX(3), PtY(3), PtX(2), PtY(2), Color1, Color2
  227. DrawLighedLine picKnob, PtX(2), PtY(2), PtX(0), PtY(0), Color1, Color2

  228. End Sub

  229. '将数值转换为用于显示的角度值
  230. Private Function ValueToAngle(ByVal Value_ As Long, ByVal MaxValue_ As Long) As Double
  231. If MaxValue_ Then ValueToAngle = m_MinAng + (m_MaxAng - m_MinAng) * Value_ / MaxValue_ + Knob_PI * 0.5
  232. End Function

  233. '将角度值转换为数值
  234. Private Function AngleToValue(ByVal Angle As Double) As Long
  235. If m_MaxAng = 0 Then Exit Function
  236. Angle = Angle - Knob_PI * 0.5
  237. While Angle < 0
  238.     Angle = Angle + Knob_PI * 2
  239. Wend
  240. While Angle > Knob_PI * 2
  241.     Angle = Angle - Knob_PI * 2
  242. Wend
  243. AngleToValue = (Angle - m_MinAng) * m_Max / (m_MaxAng - m_MinAng)
  244. End Function

  245. '控件改变大小,重建底座图
  246. Private Sub picBase_Resize()
  247. DrawBaseCircle
  248. End Sub

  249. '鼠标单击操作
  250. Private Sub picKnob_Click()
  251. RaiseEvent Click
  252. End Sub

  253. '鼠标双击操作
  254. Private Sub picKnob_DblClick()
  255. RaiseEvent DblClick
  256. End Sub

  257. '键盘按下操作
  258. Private Sub picKnob_KeyDown(KeyCode As Integer, Shift As Integer)
  259. RaiseEvent KeyDown(KeyCode, Shift)
  260. End Sub

  261. '键盘打字操作
  262. Private Sub picKnob_KeyPress(KeyAscii As Integer)
  263. RaiseEvent KeyPress(KeyAscii)
  264. End Sub

  265. '键盘弹起操作
  266. Private Sub picKnob_KeyUp(KeyCode As Integer, Shift As Integer)
  267. RaiseEvent KeyUp(KeyCode, Shift)
  268. End Sub

  269. '鼠标按下操作
  270. Private Sub picKnob_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  271. m_MouseDown = True
  272. m_MouseAngle = GetAngle(X - m_Rad, Y - m_Rad) - ValueToAngle(m_Value, m_Max)
  273. DrawHandle
  274. RaiseEvent MouseDown(Button, Shift, X, Y)
  275. End Sub

  276. '鼠标移动操作
  277. Private Sub picKnob_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  278. If m_MouseDown Then
  279.     Dim NewAng As Double, OldVal As Long
  280.     NewAng = GetAngle(X - m_Rad, Y - m_Rad) - m_MouseAngle
  281.     OldVal = m_Value
  282.     m_Value = AngleToValue(NewAng)
  283.     If m_Value > m_Max Then m_Value = m_Max
  284.     If m_Value < 0 Then m_Value = 0
  285.     picKnob.ToolTipText = m_Value
  286.     DrawHandle
  287.     RaiseEvent MouseMove(Button, Shift, X, Y)
  288.     If OldVal <> m_Value Then
  289.         RaiseEvent Change(OldVal, m_Value)
  290.         m_MouseAngle = GetAngle(X - m_Rad, Y - m_Rad) - ValueToAngle(m_Value, m_Max)
  291.     ElseIf m_Value = 0 Or m_Value = m_Max Then
  292.         m_MouseAngle = GetAngle(X - m_Rad, Y - m_Rad) - ValueToAngle(m_Value, m_Max)
  293.     End If
  294. End If
  295. End Sub

  296. '鼠标松开操作
  297. Private Sub picKnob_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  298. m_MouseDown = False
  299. DrawHandle
  300. RaiseEvent MouseUp(Button, Shift, X, Y)
  301. End Sub

  302. Private Sub picKnob_Resize()
  303. picBase.Move 0, 0, picKnob.ScaleWidth, picKnob.ScaleHeight
  304. DrawHandle
  305. End Sub

  306. '控件初始化
  307. Private Sub UserControl_Initialize()
  308. UserControl_Resize
  309. End Sub

  310. Private Sub UserControl_InitProperties()
  311. m_Max = 100
  312. m_Value = 100
  313. m_Steps = 3
  314. m_BaseRad = 0.75
  315. m_HandleRad = 0.8
  316. m_MinAng = Knob_PI / 3
  317. m_MaxAng = Knob_PI * 5 / 3
  318. m_DrawGrad = True
  319. m_DrawPoint = True
  320. m_DrawRaisedHandle = True
  321. m_RaisedHandleWidth1 = 0.3
  322. m_RaisedHandleWidth2 = 0.3
  323. End Sub

  324. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  325. m_Max = PropBag.ReadProperty("Max", m_Max)
  326. m_Value = PropBag.ReadProperty("Value", m_Value)
  327. m_Steps = PropBag.ReadProperty("Steps", m_Steps)
  328. m_BaseRad = PropBag.ReadProperty("BaseRadius", m_BaseRad)
  329. m_HandleRad = PropBag.ReadProperty("HandleRadius", m_HandleRad)
  330. m_MinAng = PropBag.ReadProperty("MinAngle", m_MinAng)
  331. m_MaxAng = PropBag.ReadProperty("MaxAngle", m_MaxAng)
  332. m_DrawGrad = PropBag.ReadProperty("DrawGraduation", m_DrawGrad)
  333. m_DrawPoint = PropBag.ReadProperty("DrawPoint", m_DrawPoint)
  334. m_DrawRaisedHandle = PropBag.ReadProperty("DrawRaisedHandle", m_DrawRaisedHandle)
  335. m_RaisedHandleWidth1 = PropBag.ReadProperty("RaisedHandleWidth1", m_RaisedHandleWidth1)
  336. m_RaisedHandleWidth2 = PropBag.ReadProperty("RaisedHandleWidth2", m_RaisedHandleWidth2)
  337. picKnob.BorderStyle = PropBag.ReadProperty("BorderStyle", picKnob.BorderStyle)
  338. m_Rad = picKnob.ScaleHeight \ 2
  339. DrawKnob
  340. End Sub

  341. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  342. PropBag.WriteProperty "Max", m_Max
  343. PropBag.WriteProperty "Value", m_Value
  344. PropBag.WriteProperty "Steps", m_Steps
  345. PropBag.WriteProperty "BaseRadius", m_BaseRad
  346. PropBag.WriteProperty "HandleRadius", m_HandleRad
  347. PropBag.WriteProperty "MinAngle", m_MinAng
  348. PropBag.WriteProperty "MaxAngle", m_MaxAng
  349. PropBag.WriteProperty "DrawGraduation", m_DrawGrad
  350. PropBag.WriteProperty "DrawPoint", m_DrawPoint
  351. PropBag.WriteProperty "DrawRaisedHandle", m_DrawRaisedHandle
  352. PropBag.WriteProperty "RaisedHandleWidth1", m_RaisedHandleWidth1
  353. PropBag.WriteProperty "RaisedHandleWidth2", m_RaisedHandleWidth2
  354. PropBag.WriteProperty "BorderStyle", picKnob.BorderStyle
  355. End Sub

  356. '控件改变大小
  357. Private Sub UserControl_Resize()
  358. If Width > Height Then
  359.     Width = Height
  360.     Exit Sub
  361. ElseIf Width < Height Then
  362.     Height = Width
  363.     Exit Sub
  364. End If
  365. picKnob.Height = ScaleHeight
  366. m_Rad = picKnob.ScaleHeight \ 2
  367. DrawKnob
  368. End Sub

  369. '取得角度
  370. Private Function GetAngle(ByVal X As Double, ByVal Y As Double) As Double
  371. 'X为Cos计算出来的,Y为Sin计算出来的
  372. If X > 0 Then
  373.     GetAngle = Atn(Y / X)
  374. ElseIf X < 0 Then
  375.     GetAngle = Atn(Y / X) + Knob_PI
  376. ElseIf Y > 0 Then
  377.     GetAngle = Knob_PI / 2
  378. ElseIf Y < 0 Then
  379.     GetAngle = Knob_PI * 3 / 2
  380. End If
  381. End Function

  382. '边框属性,继承的PictureBox的边框属性
  383. Property Get BorderStyle() As Long
  384. Attribute BorderStyle.VB_Description = "The style of the border. Same as PictureBox."
  385. Attribute BorderStyle.VB_ProcData.VB_Invoke_Property = ";外观"
  386. Attribute BorderStyle.VB_UserMemId = -504
  387. BorderStyle = picKnob.BorderStyle
  388. End Property

  389. Property Let BorderStyle(ByVal NewBorderStyle As Long)
  390. picKnob.BorderStyle = NewBorderStyle
  391. m_Rad = picKnob.ScaleHeight \ 2
  392. DrawKnob
  393. PropertyChanged "BorderStyle"
  394. End Property

  395. '旋钮的数值,取值0到Max
  396. Property Get Value() As Long
  397. Attribute Value.VB_Description = "The value of the knob."
  398. Attribute Value.VB_ProcData.VB_Invoke_Property = ";行为"
  399. Attribute Value.VB_UserMemId = 0
  400. Value = m_Value
  401. End Property

  402. Property Let Value(ByVal NewValue As Long)
  403. If NewValue < 0 Then
  404.     m_Value = 0
  405. ElseIf NewValue > m_Max Then
  406.     m_Value = m_Max
  407. Else
  408.     m_Value = NewValue
  409. End If
  410. DrawHandle
  411. PropertyChanged "Value"
  412. End Property

  413. '旋钮的数值的最大值
  414. Property Get Max() As Long
  415. Attribute Max.VB_Description = "The maximum value"
  416. Attribute Max.VB_ProcData.VB_Invoke_Property = ";行为"
  417. Max = m_Max
  418. End Property

  419. Property Let Max(ByVal NewMaxValue As Long)
  420. If NewMaxValue < 0 Then
  421.     m_Max = 0
  422. Else
  423.     m_Max = NewMaxValue
  424. End If
  425. If m_Value > m_Max Then m_Value = m_Max
  426. DrawKnob
  427. PropertyChanged "Max"
  428. End Property

  429. '旋钮的最小角度
  430. Property Get MinAngle() As Double
  431. Attribute MinAngle.VB_Description = "The minimum angle the knob can turn."
  432. Attribute MinAngle.VB_ProcData.VB_Invoke_Property = ";外观"
  433. MinAngle = m_MinAng * 180 / Knob_PI
  434. End Property

  435. Property Let MinAngle(ByVal NewMinAngle As Double)
  436. m_MinAng = NewMinAngle * Knob_PI / 180
  437. While m_MinAng > Knob_PI * 2
  438.     m_MinAng = m_MinAng - Knob_PI * 2
  439. Wend
  440. While m_MinAng < 0
  441.     m_MinAng = m_MinAng + Knob_PI * 2
  442. Wend
  443. If m_MaxAng < m_MinAng Then
  444.     Dim Temp As Double
  445.     Temp = m_MaxAng
  446.     m_MaxAng = m_MinAng
  447.     m_MinAng = Temp
  448. End If
  449. DrawKnob
  450. PropertyChanged "MinAngle"
  451. End Property

  452. '旋钮的最大角度
  453. Property Get MaxAngle() As Double
  454. Attribute MaxAngle.VB_Description = "The maximum angle the knob can turn."
  455. Attribute MaxAngle.VB_ProcData.VB_Invoke_Property = ";外观"
  456. MaxAngle = m_MaxAng * 180 / Knob_PI
  457. End Property

  458. Property Let MaxAngle(ByVal NewMaxAngle As Double)
  459. m_MaxAng = NewMaxAngle * Knob_PI / 180
  460. While m_MaxAng > Knob_PI * 2
  461.     m_MaxAng = m_MaxAng - Knob_PI * 2
  462. Wend
  463. While m_MaxAng < 0
  464.     m_MaxAng = m_MaxAng + Knob_PI * 2
  465. Wend
  466. If m_MinAng > m_MaxAng Then
  467.     Dim Temp As Double
  468.     Temp = m_MaxAng
  469.     m_MaxAng = m_MinAng
  470.     m_MinAng = Temp
  471. End If
  472. DrawKnob
  473. PropertyChanged "MaxAngle"
  474. End Property

  475. '旋钮的刻度的密度
  476. Property Get Steps() As Long
  477. Attribute Steps.VB_Description = "The steps of the graduation."
  478. Attribute Steps.VB_ProcData.VB_Invoke_Property = ";外观"
  479. Steps = m_Steps
  480. End Property

  481. Property Let Steps(ByVal NewSteps As Long)
  482. If NewSteps > m_Max Then
  483.     m_Steps = m_Max
  484. ElseIf NewSteps < 0 Then
  485.     m_Steps = 0
  486. Else
  487.     m_Steps = NewSteps
  488. End If
  489. DrawKnob
  490. PropertyChanged "Steps"
  491. End Property

  492. '旋钮的圆盘的半径比例
  493. Property Get BaseRadius() As Double
  494. Attribute BaseRadius.VB_Description = "The radius of the base circle."
  495. Attribute BaseRadius.VB_ProcData.VB_Invoke_Property = ";外观"
  496. BaseRadius = m_BaseRad
  497. End Property

  498. Property Let BaseRadius(ByVal NewBaseRadius As Double)
  499. If NewBaseRadius < 0 Then
  500.     m_BaseRad = 0
  501. Else
  502.     m_BaseRad = NewBaseRadius
  503. End If
  504. DrawKnob
  505. PropertyChanged "BaseRadius"
  506. End Property

  507. '旋钮的把手的半径比例
  508. Property Get HandleRadius() As Double
  509. Attribute HandleRadius.VB_Description = "The radius(or length) of the raised handle."
  510. Attribute HandleRadius.VB_ProcData.VB_Invoke_Property = ";外观"
  511. HandleRadius = m_HandleRad
  512. End Property

  513. Property Let HandleRadius(ByVal NewHandleRadius As Double)
  514. If NewHandleRadius < 0 Then
  515.     m_HandleRad = 0
  516. Else
  517.     m_HandleRad = NewHandleRadius
  518. End If
  519. DrawHandle
  520. PropertyChanged "HandleRadius"
  521. End Property

  522. '是否绘制刻度
  523. Property Get DrawGraduation() As Boolean
  524. Attribute DrawGraduation.VB_Description = "Draw the graduation if it was true."
  525. Attribute DrawGraduation.VB_ProcData.VB_Invoke_Property = ";外观"
  526. DrawGraduation = m_DrawGrad
  527. End Property

  528. Property Let DrawGraduation(ByVal NewVal As Boolean)
  529. m_DrawGrad = NewVal
  530. DrawKnob
  531. PropertyChanged "DrawGraduation"
  532. End Property

  533. '是否绘制刻度
  534. Property Get DrawPoint() As Boolean
  535. Attribute DrawPoint.VB_Description = "Draw the red point if it was true."
  536. Attribute DrawPoint.VB_ProcData.VB_Invoke_Property = ";外观"
  537. DrawPoint = m_DrawPoint
  538. End Property

  539. Property Let DrawPoint(ByVal NewVal As Boolean)
  540. m_DrawPoint = NewVal
  541. DrawHandle
  542. PropertyChanged "DrawPoint"
  543. End Property

  544. '是否显示凸起的把手
  545. Property Get DrawRaisedHandle() As Boolean
  546. Attribute DrawRaisedHandle.VB_Description = "Draw the raised handle if it was true."
  547. Attribute DrawRaisedHandle.VB_ProcData.VB_Invoke_Property = ";外观"
  548. DrawRaisedHandle = m_DrawRaisedHandle
  549. End Property

  550. Property Let DrawRaisedHandle(ByVal NewVal As Boolean)
  551. m_DrawRaisedHandle = NewVal
  552. DrawHandle
  553. PropertyChanged "DrawRaisedHandle"
  554. End Property

  555. '凸起的把手的宽度1
  556. Property Get RaisedHandleWidth1() As Double
  557. Attribute RaisedHandleWidth1.VB_Description = "The width of the raised handle."
  558. Attribute RaisedHandleWidth1.VB_ProcData.VB_Invoke_Property = ";外观"
  559. RaisedHandleWidth1 = m_RaisedHandleWidth1
  560. End Property

  561. Property Let RaisedHandleWidth1(ByVal NewVal As Double)
  562. m_RaisedHandleWidth1 = NewVal
  563. DrawHandle
  564. PropertyChanged "RaisedHandleWidth1"
  565. End Property

  566. '凸起的把手的宽度2
  567. Property Get RaisedHandleWidth2() As Double
  568. Attribute RaisedHandleWidth2.VB_Description = "The width of the raised handle."
  569. Attribute RaisedHandleWidth2.VB_ProcData.VB_Invoke_Property = ";外观"
  570. RaisedHandleWidth2 = m_RaisedHandleWidth2
  571. End Property

  572. Property Let RaisedHandleWidth2(ByVal NewVal As Double)
  573. m_RaisedHandleWidth2 = NewVal
  574. DrawHandle
  575. PropertyChanged "RaisedHandleWidth2"
  576. End Property
复制代码
单个用户控件文件:(添加到自己的工程就可以使用)
Knob.ctl (19.11 KB, 下载次数: 43)
示例工程:
Knob.7z (15.08 KB, 下载次数: 67)

本帖被以下淘专辑推荐:

回复

使用道具 举报

85

主题

175

回帖

3990

积分

用户组: 超级版主

No. 418

UID
418
精华
14
威望
53 点
宅币
1974 个
贡献
1582 次
宅之契约
0 份
在线时间
252 小时
注册时间
2014-8-9
发表于 2015-5-30 20:51:27 | 显示全部楼层
哈哈这可是好东西!
In the beginning I was not the best.
And the world was also not the best.
But I still know that I am who I am.
Because I think that it is good.
I have been working hard.
I have been keeping growth with the world.
And it was so.
回复 赞! 靠!

使用道具 举报

85

主题

175

回帖

3990

积分

用户组: 超级版主

No. 418

UID
418
精华
14
威望
53 点
宅币
1974 个
贡献
1582 次
宅之契约
0 份
在线时间
252 小时
注册时间
2014-8-9
发表于 2015-5-30 20:52:28 | 显示全部楼层
如果再加上抗锯齿就更完美了
In the beginning I was not the best.
And the world was also not the best.
But I still know that I am who I am.
Because I think that it is good.
I have been working hard.
I have been keeping growth with the world.
And it was so.
回复 赞! 靠!

使用道具 举报

1109

主题

1649

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24180 个
贡献
46222 次
宅之契约
0 份
在线时间
2294 小时
注册时间
2014-1-26
 楼主| 发表于 2015-5-30 22:34:52 | 显示全部楼层
cyycoish 发表于 2015-5-30 20:52
如果再加上抗锯齿就更完美了

然而正因为懒,我没有加抗锯齿。
回复 赞! 靠!

使用道具 举报

0

主题

4

回帖

15

积分

用户组: 初·技术宅

UID
2077
精华
0
威望
0 点
宅币
11 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2016-11-21
发表于 2016-11-21 16:34:50 | 显示全部楼层
学习了
回复

使用道具 举报

0

主题

5

回帖

26

积分

用户组: 初·技术宅

UID
2284
精华
0
威望
2 点
宅币
17 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-2-25
发表于 2017-2-26 00:30:54 | 显示全部楼层
永远都是在学习中。。。
回复 赞! 靠!

使用道具 举报

0

主题

15

回帖

27

积分

用户组: 初·技术宅

UID
2664
精华
0
威望
0 点
宅币
12 个
贡献
0 次
宅之契约
0 份
在线时间
2 小时
注册时间
2017-7-8
发表于 2017-7-24 07:05:30 | 显示全部楼层
顶一下,先收藏说不定啥时候就用上了呢.
回复 赞! 靠!

使用道具 举报

1

主题

7

回帖

27

积分

用户组: 初·技术宅

UID
2744
精华
0
威望
0 点
宅币
19 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2017-8-1
发表于 2017-8-1 20:48:46 | 显示全部楼层
要这么多代码饿么
回复 赞! 靠!

使用道具 举报

2

主题

22

回帖

117

积分

用户组: 小·技术宅

UID
3003
精华
0
威望
2 点
宅币
89 个
贡献
0 次
宅之契约
0 份
在线时间
20 小时
注册时间
2017-10-24
发表于 2017-10-25 02:03:32 | 显示全部楼层
不懂自定义控件,正好可以学习了
回复 赞! 靠!

使用道具 举报

1

主题

83

回帖

89

积分

用户组: 小·技术宅

UID
3026
精华
0
威望
1 点
宅币
3 个
贡献
0 次
宅之契约
0 份
在线时间
6 小时
注册时间
2017-10-31
发表于 2017-11-7 23:54:08 | 显示全部楼层
不懂自定义控件,正好可以学习了
回复 赞! 靠!

使用道具 举报

0

主题

21

回帖

14

积分

用户组: 初·技术宅

UID
3807
精华
0
威望
0 点
宅币
-7 个
贡献
0 次
宅之契约
0 份
在线时间
6 小时
注册时间
2018-5-5
发表于 2018-5-6 07:36:22 | 显示全部楼层
不平滑....不够叼
回复 赞! 靠!

使用道具 举报

1

主题

157

回帖

603

积分

用户组: 大·技术宅

UID
7535
精华
0
威望
0 点
宅币
445 个
贡献
0 次
宅之契约
0 份
在线时间
67 小时
注册时间
2021-10-16
发表于 2022-5-9 16:16:34 | 显示全部楼层

楼主大能,感谢感谢
回复 赞! 靠!

使用道具 举报

0

主题

48

回帖

69

积分

用户组: 小·技术宅

UID
8099
精华
0
威望
2 点
宅币
17 个
贡献
0 次
宅之契约
0 份
在线时间
9 小时
注册时间
2022-10-22
发表于 2022-11-23 21:21:28 | 显示全部楼层
终于可以替代那个类似滑动变阻器的控件了
回复 赞! 靠!

使用道具 举报

QQ|Archiver|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2024-3-28 18:14 , Processed in 0.063228 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表