📄 ctlmeter.ctl
字号:
ctlPic.CurrentX = ctlW / 2 + 30
ctlPic.CurrentY = ctlW / 2 + 30
ctlPic.Print "0"
ctlPic.DrawWidth = 3
ctlPic.PSet (ctlW / 2, ctlW / 2), vbBlue
ctlPic.DrawWidth = 1
ctlPic.FontSize = 10
R = mR / 8
If mFlaG34 Then
ctlPic.ForeColor = &HFF00FF
If mUa > 0 Then
X = ctlW / 2 + mUa / 100 * mR * Cos(-mUaQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mUa / 100 * mR * Sin(-mUaQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mUaQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mUaQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mUaQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "U1"
Else
ctlPic.Print "Ua"
End If
End If
Next I
End If
ctlPic.ForeColor = vbBlue
If mUb > 0 Then
X = ctlW / 2 + mUb / 100 * mR * Cos(-mUbQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mUb / 100 * mR * Sin(-mUbQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mUbQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mUbQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mUbQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "U2"
Else
ctlPic.Print "Ub"
End If
End If
Next I
End If
ctlPic.ForeColor = vbRed
If mUc > 0 Then
X = ctlW / 2 + mUc / 100 * mR * Cos(-mUcQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mUc / 100 * mR * Sin(-mUcQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mUcQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mUcQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mUcQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "U3"
Else
ctlPic.Print "Uc"
End If
End If
Next I
End If
Else '0799 3666396- ' 33
ctlPic.ForeColor = vblack ' &HFF00FF
If mUa > 0 Then
XXX(0) = ctlW / 2 + mUa / 100 * mR * Cos(-mUaQ / 360 * 2 * 3.1415926)
YYY(0) = ctlW / 2 + mUa / 100 * mR * Sin(-mUaQ / 360 * 2 * 3.1415926)
End If
ctlPic.ForeColor = vblack
If mUb > 0 Then
XXX(1) = ctlW / 2 + mUb / 100 * mR * Cos(-mUbQ / 360 * 2 * 3.1415926)
YYY(1) = ctlW / 2 + mUb / 100 * mR * Sin(-mUbQ / 360 * 2 * 3.1415926)
End If
ctlPic.ForeColor = vblack
If mUc > 0 Then
XXX(2) = ctlW / 2 + mUc / 100 * mR * Cos(-mUcQ / 360 * 2 * 3.1415926)
YYY(2) = ctlW / 2 + mUc / 100 * mR * Sin(-mUcQ / 360 * 2 * 3.1415926)
End If
XXX(0) = (XXX(0) - XXX(1))
YYY(0) = (Val(YYY(0) - YYY(1)))
RRR(0) = Sqr(XXX(0) ^ 2 + YYY(0) ^ 2)
XXX(0) = mR * XXX(0) / RRR(0) * mUa / 100
YYY(0) = mR * YYY(0) / RRR(0) * mUa / 100
XXX(2) = (XXX(2) - XXX(1))
YYY(2) = (YYY(2) - YYY(1))
RRR(2) = Sqr(XXX(2) ^ 2 + YYY(2) ^ 2)
XXX(2) = mR * XXX(2) / RRR(2) * mUc / 100
YYY(2) = mR * YYY(2) / RRR(2) * mUc / 100
ctlPic.ForeColor = &HFF00FF
XXX(0) = XXX(0) + ctlW / 2
YYY(0) = YYY(0) + ctlW / 2
ctlPic.Line (ctlW / 2, ctlW / 2)-(XXX(0), YYY(0))
If XXX(0) <> ctlW / 2 Then
If (XXX(0) - ctlW / 2) > 0 And (YYY(0) - ctlW / 2) > 0 Then '4
QQQQ(0) = 360 - Atn((YYY(0) - ctlW / 2) / (XXX(0) - ctlW / 2)) * 180 / 3.1415926
ElseIf (XXX(0) - ctlW / 2) > 0 And (YYY(0) - ctlW / 2) < 0 Then '1
QQQQ(0) = Atn((-YYY(0) + ctlW / 2) / (XXX(0) - ctlW / 2)) * 180 / 3.1415926
ElseIf (XXX(0) - ctlW / 2) < 0 And (YYY(0) - ctlW / 2) > 0 Then '3
QQQQ(0) = 180 + Atn((YYY(0) - ctlW / 2) / (-XXX(0) + ctlW / 2)) * 180 / 3.1415926
Else '2
QQQQ(0) = 180 - Atn((-YYY(0) + ctlW / 2) / (-XXX(0) + ctlW / 2)) * 180 / 3.1415926
End If
If YYY(0) = ctlW / 2 Then
If XXX(0) > ctlW / 2 Then
QQQQ(0) = 0
Else
QQQQ(0) = 180
End If
End If
Else
If YYY(0) >= ctlW / 2 Then
QQQQ(0) = 270
Else
QQQQ(0) = 90
End If
End If
For I = 1 To 2
QQQ = (QQQQ(0) - 180) + Choose(I, 15, -15)
Xx = XXX(0) + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = YYY(0) + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (XXX(0), YYY(0))-(Xx, Yy)
If I = 1 Then
Xx = Xx + R * Cos(-(QQQQ(0) - 90) / 360 * 2 * 3.1415926)
Yy = Yy + R * Sin(-(QQQQ(0) - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "U12"
Else
ctlPic.Print "Uab"
End If
End If
Next I
ctlPic.ForeColor = vbRed
XXX(2) = XXX(2) + ctlW / 2
YYY(2) = YYY(2) + ctlW / 2
ctlPic.Line (ctlW / 2, ctlW / 2)-(XXX(2), YYY(2))
If XXX(2) <> ctlW / 2 Then
If (XXX(2) - ctlW / 2) > 0 And (YYY(2) - ctlW / 2) > 0 Then '4
QQQQ(2) = 360 - Atn((YYY(2) - ctlW / 2) / (XXX(2) - ctlW / 2)) * 180 / 3.1415926
ElseIf (XXX(2) - ctlW / 2) > 0 And (YYY(2) - ctlW / 2) < 0 Then '1
QQQQ(2) = Atn((-YYY(2) + ctlW / 2) / (XXX(2) - ctlW / 2)) * 180 / 3.1415926
ElseIf (XXX(2) - ctlW / 2) < 0 And (YYY(2) - ctlW / 2) > 0 Then '3
QQQQ(2) = 180 + Atn((YYY(2) - ctlW / 2) / (-XXX(2) + ctlW / 2)) * 180 / 3.1415926
Else '2
QQQQ(2) = 180 - Atn((-YYY(2) + ctlW / 2) / (-XXX(2) + ctlW / 2)) * 180 / 3.1415926
End If
If YYY(2) = ctlW / 2 Then
If XXX(2) > ctlW / 2 Then
QQQQ(2) = 0
Else
QQQQ(2) = 180
End If
End If
Else
If YYY(2) < ctlW / 2 Then
QQQQ(2) = 90
Else
QQQQ(2) = 270
End If
End If
For I = 1 To 2
QQQ = (QQQQ(2) - 180) + Choose(I, 15, -15)
Xx = XXX(2) + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = YYY(2) + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (XXX(2), YYY(2))-(Xx, Yy)
If I = 1 Then
Xx = Xx + R * Cos(-(QQQQ(2) - 90) / 360 * 2 * 3.1415926)
Yy = Yy + R * Sin(-(QQQQ(2) - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "U32"
Else
ctlPic.Print "Ucb"
End If
End If
Next I
End If
'''''''''''''''''''''''''''I
ctlPic.ForeColor = &HFF00FF
If mIa > 0 Then
X = ctlW / 2 + mIa / 100 * mR * 0.8 * Cos(-mIaQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mIa / 100 * mR * 0.8 * Sin(-mIaQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mIaQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mIaQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mIaQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "I1"
Else
ctlPic.Print "Ia"
End If
End If
Next I
End If
ctlPic.ForeColor = vbBlue
If mIb > 0 Then
X = ctlW / 2 + mIb / 100 * mR * 0.8 * Cos(-mIbQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mIb / 100 * mR * 0.8 * Sin(-mIbQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mIbQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mIbQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mIbQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "I2"
Else
ctlPic.Print "Ib"
End If
End If
Next I
End If
ctlPic.ForeColor = vbRed
If mIc > 0 Then
X = ctlW / 2 + mIc / 100 * mR * 0.8 * Cos(-mIcQ / 360 * 2 * 3.1415926)
Y = ctlW / 2 + mIc / 100 * mR * 0.8 * Sin(-mIcQ / 360 * 2 * 3.1415926)
ctlPic.Line (ctlW / 2, ctlW / 2)-(X, Y)
For I = 1 To 2
QQQ = (mIcQ - 180) + Choose(I, 15, -15)
Xx = X + R * Cos(-QQQ / 360 * 2 * 3.1415926)
Yy = Y + R * Sin(-QQQ / 360 * 2 * 3.1415926)
ctlPic.Line (X, Y)-(Xx, Yy)
If I = 1 Then
Xx = Xx + (R) * Cos(-(mIcQ - 90) / 360 * 2 * 3.1415926)
Yy = Yy + (R) * Sin(-(mIcQ - 90) / 360 * 2 * 3.1415926)
If mPreSet Then
ctlPic.Print "I3"
Else
ctlPic.Print "Ic"
End If
End If
Next I
End If
End Sub
Public Function RefreshMeter()
RefreshMeter1
End Function
Public Function ClearData()
ctlPic.Cls
mUa = 0
mUb = 0
mUc = 0
mUaQ = 0
mUbQ = 0
mUcQ = 0
mIa = 0
mIb = 0
mIc = 0
mIaQ = 0
mIbQ = 0
mIcQ = 0
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -