formjoystick.frm

电动平台, 控制X,Y,Z轴移动,能计数

VERSION 5.00
Begin VB.Form FormJoyStick 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "JoyStick"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3915
   ClipControls    =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4000
   ScaleMode       =   0  'User
   ScaleWidth      =   4000
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "FormJoyStick"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private X_Center As Single
Private Y_Center As Single
Private X_Last As Single
Private Y_Last As Single
Private Radius As Single
Private Radius_2 As Single
Private Radius_4 As Single
Private JoyStickActive As Boolean
Public Sub DrawJoy()
    Left = Val(GetSetting(App.Title, "Joy", "left", Left))
    Top = Val(GetSetting(App.Title, "Joy", "top", Top))
    If Left < 0 Then Left = 0 'just make sure app isn't off the screen
    If Top < 0 Then Top = 0
    If Left > Screen.Width - Me.Width Then Left = Screen.Width - Me.Width
    If Top > Screen.Height - Me.Height Then Top = Screen.Height - Me.Height
    Me.Left = Left
    Me.Top = Top
    
    X_Center = ScaleWidth / 2
    Y_Center = ScaleHeight / 2
    X_Last = X_Center
    Y_Last = Y_Center
    FillStyle = vbFSSolid
    ForeColor = RGB(0, 0, 0)
    Radius = ScaleWidth / 10
    Radius_2 = Radius / 2
    Radius_4 = Radius / 4
    Call DrawCircle(X_Center, Y_Center)
    DrawWidth = 10   ' Set starting pen width.
    Visible = True
End Sub
Public Sub Form_Unload(Cancel As Integer)
    'save trivial settings
    If Me.WindowState = vbDefault Then
        Call SaveSetting(App.Title, "Joy", "left", Me.Left)
        Call SaveSetting(App.Title, "Joy", "top", Me.Top)
    End If
End Sub
Private Sub DrawCircle(X As Single, Y As Single)
    Dim Xd As Single
    Dim Yd As Single
    Dim XXd As Single
    Dim YYd As Single
    Dim Xs As Single
    Dim Ys As Single
    Dim X_Speed As Double
    Dim y_Speed As Double
    
    Dim angle As Double
    Dim pi As Double
    
    pi = 3.14
        
    DrawWidth = 10   ' Set starting pen width.
    
    ' Erase the old Joystick
    ForeColor = vbButtonFace
    FillColor = vbButtonFace
    Circle (X_Last, Y_Last), Radius   ' Draw a circle.
    
    Xd = X_Last - X_Center
    Yd = Y_Last - Y_Center
    If Yd Then
        angle = Atn(Xd / Yd)
    Else
        If Xd > 0 Then
            angle = pi / 2
        Else
            angle = -pi / 2
        End If
    End If
    angle = angle + (pi / 2)
    Xs = Radius_4 * Sin(angle)
    Ys = Radius_4 * Cos(angle)
    
    Line (X_Center + Xs, Y_Center + Ys)-(X_Last, Y_Last)
    Line -(X_Center - Xs, Y_Center - Ys)
    Line (X_Center, Y_Center)-(X_Last, Y_Last)
    
    ' Draw the center of the joystick
    ForeColor = RGB(0, 0, 0)
    FillColor = RGB(0, 0, 0)
    Circle (X_Center, Y_Center), Radius_2 ' Draw a circle.
    
    Xd = X - X_Center
    Yd = Y - Y_Center
    XXd = Xd
    YYd = Yd
    
    If TestControl.MnuJoyEnable.Checked = True Then
    
        If TestControl.MnuJoyXRev.Checked = True Then
            XXd = -XXd
        End If
        
        If TestControl.MnuJoyYRev.Checked = True Then
            YYd = -YYd
        End If
            
        'If XXd = 0 And YYd = 0 Then
        '    TestControl.myScan.InterruptAllMotion
        'Else
            TestControl.MoveAtVelocity XXd, YYd
        'End If
    End If
    
    If Yd Then
        angle = Atn(Xd / Yd)
    Else
        If Xd > 0 Then
            angle = pi / 2
        Else
            angle = -pi / 2
        End If
    End If
    angle = angle + (pi / 2)
    Xs = Radius_4 * Sin(angle)
    Ys = Radius_4 * Cos(angle)
    Line (X_Center + Xs, Y_Center + Ys)-(X, Y)
    Line -(X_Center - Xs, Y_Center - Ys)
    Line (X_Center, Y_Center)-(X, Y)
    
    DrawWidth = 3   ' Set starting pen width.
    
    ForeColor = RGB(0, 0, 0)
    FillColor = RGB(200, 0, 0)
    Circle (X, Y), Radius   ' Draw a circle.
    
    X_Last = X
    Y_Last = Y
End Sub
Private Sub ReadJoyStick(X As Single, Y As Single)
    
    If X < Radius Then
        X = Radius
    End If
    
    If X > (ScaleWidth - Radius) Then
        X = ScaleWidth - Radius
    End If
    
    If Y < Radius Then
        Y = Radius
    End If
    
    If Y > (ScaleHeight - Radius) Then
        Y = ScaleHeight - Radius
    End If
    
    Call DrawCircle(X, Y)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    JoyStickActive = True
    ReadJoyStick X, Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    JoyStickActive = False
    ReadJoyStick X_Center, Y_Center
    
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If JoyStickActive Then
        ReadJoyStick X, Y
    End If
End Sub