【VB】模拟电弧- -
代码没什么用。纯属娱乐。
事实上这个并不太科学。就是看起来像而已。加上音效也许更像了。
电弧的幅度可以调整。因此可以用作音乐电平显示。VERSION 5.00
Begin VB.Form frmMain
AutoRedraw = -1'True
BackColor = &H00000000&
Caption = "模拟电弧"
ClientHeight = 1320
ClientLeft = 120
ClientTop = 450
ClientWidth = 2685
ForeColor = &H0000FF00&
LinkTopic = "ElecBolt"
ScaleHeight = 88
ScaleMode = 3'Pixel
ScaleWidth = 179
StartUpPosition = 3'窗口缺省
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type PointType
X As Single
Y As Single
End Type
Dim Pos As PointType
Dim Neg As PointType
Dim MovingPos As Boolean
Dim MovingNeg As Boolean
Private Const PosRadius = 5
Private Const NegRadius = 5
Private Const Pi = 3.14159265358979
Private Sub Form_Load()
Randomize Timer
Show
Neg.X = ScaleWidth * 0.1
Neg.Y = ScaleHeight / 2
Pos.X = ScaleWidth * 0.9
Pos.Y = Neg.Y
Do
Cls
Circle (Pos.X, Pos.Y), PosRadius
Circle (Neg.X, Neg.Y), NegRadius
DrawBolt Neg.X, Neg.Y, Pos.X, Pos.Y, 0.7 '这个数值越大，电弧越扭曲，数值到1时电弧因为过于扭曲无法走到终点。
Loop While DoEvents
End Sub
Function GenBoltColor() As Long
Dim R!, G!, B!
R = Rnd
B = Rnd
G = (R + B) * Rnd * 0.5
GenBoltColor = RGB(R * 255, G * 255, B * 255)
End Function
Sub DrawBolt(ByVal StartX!, ByVal StartY!, ByVal EndX!, ByVal EndY!, ByVal Motion!)
Dim X!, Y! '当前位置
Dim Dist! '距离
Dim DirX!, DirY!, DirD! '目标方向、距离
Dim Angle! '转向的角度
Dim M11!, M12! '转向矩阵
Dim M21!, M22!
Dim NewX!, NewY! '新的坐标
Dim StepLen! '步长
DirX = EndX - StartX
DirY = EndY - StartY
Dist = Sqr(DirX * DirX + DirY * DirY)
StepLen = Dist * 0.001 '最大步长，以距离来算。用于适当减少函数运行时间
If StepLen < 1 Then StepLen = 1 '步长小于1个像素时，以1个像素为步长
X = StartX
Y = StartY
Do
DirX = EndX - X
DirY = EndY - Y
DirD = Sqr(DirX * DirX + DirY * DirY)
If DirD <= StepLen Then Exit Do '距离低于步长则结束
DirX = DirX / DirD
DirY = DirY / DirD
'偏离方向的角度
Angle = (Rnd * 2 - 1) * Pi * Motion
DirD = StepLen * Rnd
If DirD < 1 Then DirD = 1
If DirD > 4 Then DirD = 4
M11 = Cos(Angle) * DirD
M12 = Sin(Angle) * DirD
M21 = -M12
M22 = M11
NewX = DirX * M11 + DirY * M21 + X
NewY = DirX * M12 + DirY * M22 + Y
Line (X, Y)-(NewX, NewY), GenBoltColor
X = NewX
Y = NewY
Loop
Line (X, Y)-(EndX, EndY), GenBoltColor
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Dist!, DistX!, DistY!
If Button And 1 Then
DistX = X - Pos.X
DistY = Y - Pos.Y
Dist = Sqr(DistX * DistX + DistY * DistY)
If Dist < PosRadius Then
MovingPos = True
GoTo NoMoreMoving
End If
DistX = X - Neg.X
DistY = Y - Neg.Y
Dist = Sqr(DistX * DistX + DistY * DistY)
If Dist < NegRadius Then
MovingNeg = True
GoTo NoMoreMoving
End If
NoMoreMoving:
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 Then
If MovingPos Then
Pos.X = X
Pos.Y = Y
End If
If MovingNeg Then
Neg.X = X
Neg.Y = Y
End If
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MovingPos = False
MovingNeg = False
End SubBIN:
SRC:
这个挺好玩！ 本帖最后由 china_shy_wzb 于 2020-7-20 14:05 编辑
这个挺好玩！，学习了
正需要，支持楼主大人了！
页:
[1]