【VB】模拟电弧- -

0xAA55

代码没什么用。纯属娱乐。
事实上这个并不太科学。就是看起来像而已。加上音效也许更像了。
电弧的幅度可以调整。因此可以用作音乐电平显示。

1. VERSION 5.00
   
2. Begin VB.Form frmMain
   
3.    AutoRedraw      =   -1  'True
   
4.    BackColor       =   &H00000000&
   
5.    Caption         =   "模拟电弧"
   
6.    ClientHeight    =   1320
   
7.    ClientLeft      =   120
   
8.    ClientTop       =   450
   
9.    ClientWidth     =   2685
   
10.    ForeColor       =   &H0000FF00&
    
11.    LinkTopic       =   "ElecBolt"
    
12.    ScaleHeight     =   88
    
13.    ScaleMode       =   3  'Pixel
    
14.    ScaleWidth      =   179
    
15.    StartUpPosition =   3  '窗口缺省
    
16. End
    
17. Attribute VB_Name = "frmMain"
    
18. Attribute VB_GlobalNameSpace = False
    
19. Attribute VB_Creatable = False
    
20. Attribute VB_PredeclaredId = True
    
21. Attribute VB_Exposed = False
    
22. Option Explicit
    
23. 
    
24. Private Type PointType
    
25.     X As Single
    
26.     Y As Single
    
27. End Type
    
28. 
    
29. Dim Pos As PointType
    
30. Dim Neg As PointType
    
31. 
    
32. Dim MovingPos As Boolean
    
33. Dim MovingNeg As Boolean
    
34. 
    
35. Private Const PosRadius = 5
    
36. Private Const NegRadius = 5
    
37. 
    
38. Private Const Pi = 3.14159265358979
    
39. 
    
40. Private Sub Form_Load()
    
41. Randomize Timer
    
42. Show
    
43. 
    
44. Neg.X = ScaleWidth * 0.1
    
45. Neg.Y = ScaleHeight / 2
    
46. Pos.X = ScaleWidth * 0.9
    
47. Pos.Y = Neg.Y
    
48. 
    
49. 
    
50. Do
    
51.     Cls
    
52.     Circle (Pos.X, Pos.Y), PosRadius
    
53.     Circle (Neg.X, Neg.Y), NegRadius
    
54.     DrawBolt Neg.X, Neg.Y, Pos.X, Pos.Y, 0.7 '这个数值越大，电弧越扭曲，数值到1时电弧因为过于扭曲无法走到终点。
    
55. Loop While DoEvents
    
56. End Sub
    
57. 
    
58. Function GenBoltColor() As Long
    
59. Dim R!, G!, B!
    
60. R = Rnd
    
61. B = Rnd
    
62. G = (R + B) * Rnd * 0.5
    
63. GenBoltColor = RGB(R * 255, G * 255, B * 255)
    
64. End Function
    
65. 
    
66. Sub DrawBolt(ByVal StartX!, ByVal StartY!, ByVal EndX!, ByVal EndY!, ByVal Motion!)
    
67. Dim X!, Y! '当前位置
    
68. 
    
69. Dim Dist! '距离
    
70. 
    
71. Dim DirX!, DirY!, DirD! '目标方向、距离
    
72. Dim Angle! '转向的角度
    
73. Dim M11!, M12! '转向矩阵
    
74. Dim M21!, M22!
    
75. Dim NewX!, NewY! '新的坐标
    
76. 
    
77. Dim StepLen! '步长
    
78. 
    
79. DirX = EndX - StartX
    
80. DirY = EndY - StartY
    
81. Dist = Sqr(DirX * DirX + DirY * DirY)
    
82. StepLen = Dist * 0.001 '最大步长，以距离来算。用于适当减少函数运行时间
    
83. If StepLen < 1 Then StepLen = 1 '步长小于1个像素时，以1个像素为步长
    
84. 
    
85. X = StartX
    
86. Y = StartY
    
87. 
    
88. Do
    
89.     DirX = EndX - X
    
90.     DirY = EndY - Y
    
91.     DirD = Sqr(DirX * DirX + DirY * DirY)
    
92.     If DirD <= StepLen Then Exit Do '距离低于步长则结束
    
93.    
    
94.     DirX = DirX / DirD
    
95.     DirY = DirY / DirD
    
96. 
    
97.     '偏离方向的角度
    
98.     Angle = (Rnd * 2 - 1) * Pi * Motion
    
99. 
    
100.     DirD = StepLen * Rnd
     
101.     If DirD < 1 Then DirD = 1
     
102.     If DirD > 4 Then DirD = 4
     
103.     M11 = Cos(Angle) * DirD
     
104.     M12 = Sin(Angle) * DirD
     
105.     M21 = -M12
     
106.     M22 = M11
     
107.    
     
108.     NewX = DirX * M11 + DirY * M21 + X
     
109.     NewY = DirX * M12 + DirY * M22 + Y
     
110.    
     
111.     Line (X, Y)-(NewX, NewY), GenBoltColor
     
112.     X = NewX
     
113.     Y = NewY
     
114. Loop
     
115. Line (X, Y)-(EndX, EndY), GenBoltColor
     
116. End Sub
     
117. 
     
118. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     
119. Dim Dist!, DistX!, DistY!
     
120. If Button And 1 Then
     
121.     DistX = X - Pos.X
     
122.     DistY = Y - Pos.Y
     
123.     Dist = Sqr(DistX * DistX + DistY * DistY)
     
124.    
     
125.     If Dist < PosRadius Then
     
126.         MovingPos = True
     
127.         GoTo NoMoreMoving
     
128.     End If
     
129. 
     
130.     DistX = X - Neg.X
     
131.     DistY = Y - Neg.Y
     
132.     Dist = Sqr(DistX * DistX + DistY * DistY)
     
133.    
     
134.     If Dist < NegRadius Then
     
135.         MovingNeg = True
     
136.         GoTo NoMoreMoving
     
137.     End If
     
138.    
     
139. NoMoreMoving:
     
140. End If
     
141. End Sub
     
142. 
     
143. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     
144. If Button And 1 Then
     
145.     If MovingPos Then
     
146.         Pos.X = X
     
147.         Pos.Y = Y
     
148.     End If
     
149.     If MovingNeg Then
     
150.         Neg.X = X
     
151.         Neg.Y = Y
     
152.     End If
     
153. End If
     
154. End Sub
     
155. 
     
156. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
     
157. MovingPos = False
     
158. MovingNeg = False
     
159. End Sub

复制代码

BIN: ElecBolt.exe (23.59 KB, 下载次数: 13)

2015-3-1 21:04 上传

点击文件名下载附件

SRC: ElecBolt.7z (7.83 KB, 下载次数: 11)

2015-3-1 21:04 上传

点击文件名下载附件

如月桃

这个挺好玩！

大宝

这个挺好玩！，学习了

xiawan

正需要，支持楼主大人了！