- Private Sub DrawACCMAG(x As Single, y As Single, z As Single)
- Dim wd As Integer
- Dim maxv As Integer
- maxv = 5000
- If OptMag.Value Then
- maxv = 3000
- End If
- wd = 30
- '确保不会超过最大值,ACC设为-5000 5000,MAG设为-3000 3000
- x = IIf(x > maxv, maxv, x) '[-maxv maxv]
- y = IIf(y > maxv, maxv, y)
- z = IIf(z > maxv, maxv, z)
- x = IIf(x < -maxv, -maxv, x)
- y = IIf(y < -maxv, -maxv, y)
- z = IIf(z < -maxv, -maxv, z)
- xpos = xpos + wd
- '新点位置尚未到达图框边缘,则顺序往后画线条
- If xpos <= Pic2.ScaleWidth Then
- Pic2.PSet (xpos - wd, PreYpos_x), vbRed
- PreYpos_x = x + maxv
- Pic2.Line -(xpos, PreYpos_x), vbRed
- Pic2.PSet (xpos - wd, PreYpos_y), vbGreen
- PreYpos_y = y + Max
- Pic2.Line -(xpos, PreYpos_y), vbGreen
- Pic2.PSet (xpos - wd, PreYpos_z), vbBlue
- PreYpos_z = z + maxv
- Pic2.Line -(xpos, PreYpos_z), vbBlue
- Else
- '新点位值已到达图框边缘,则往前移动一帧,并将新点画到图框最后
- Pic1.PaintPicture Pic2.Image, 0, 0, Pic1.ScaleWidth, Pic1.ScaleHeight, 0, 0, Pic1.ScaleWidth, Pic1.ScaleHeight '复制pic2
- Pic2.PaintPicture Pic1.Image, 0, 0, Pic1.ScaleWidth - wd, Pic1.ScaleHeight, wd, 0, Pic1.ScaleWidth - wd, Pic1.ScaleHeight 'pic2左移30
- Pic1.PaintPicture Pic3.Image, 0, 0, Pic1.ScaleWidth, Pic1.ScaleHeight, 0, 0, Pic1.ScaleWidth, Pic1.ScaleHeight ' pic1 去line
- Pic1.PSet (0, PreYpos_x), vbRed
- PreYpos_x = x + maxv
- Pic1.Line -(wd, PreYpos_x), vbRed
- Pic1.PSet (0, PreYpos_y), vbGreen
- PreYpos_y = y + maxv
- Pic1.Line -(wd, PreYpos_y), vbGreen
- Pic1.PSet (0, PreYpos_z), vbBlue
- PreYpos_z = z + maxv
- Pic1.Line -(wd, PreYpos_z), vbBlue
-
- Pic2.PaintPicture Pic1.Image, Pic2.ScaleWidth - wd, 0, wd, Pic2.ScaleHeight, 0, 0, wd, Pic1.ScaleHeight
- End If
- End Sub