hi i have a vb program and i need to upgrade it to vb 6.
can any one please give the program as i need it for my firm and i am
not a programmer.
th program is for a camera and it orders the camera to zoom and move in or out.
the code i have is..
{
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7995
ClientLeft = 60
ClientTop = 345
ClientWidth = 10680
LinkTopic = "Form1"
ScaleHeight = 7995
ScaleMode = 0 'User
ScaleWidth = 10680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command39
Caption = "SINGLE GRAB"
Height = 735
Left = 8040
TabIndex = 35
Top = 4560
Width = 1335
End
Begin VB.CommandButton Command38
Caption = "SAVE IMAGE"
Height = 495
Left = 5760
TabIndex = 34
Top = 3840
Width = 1335
End
Begin VB.CommandButton Command22
Caption = "HALT GRAB"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 7560
TabIndex = 33
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command21
Caption = "GRAB CONTINUOUSLY"
BeginProperty Font
Name = "Times New Roman"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5640
TabIndex = 32
Top = 3000
Width = 1335
End
Begin VB.TextBox Text5
Height = 375
Left = 240
TabIndex = 29
Top = 5400
Width = 975
End
Begin VB.CommandButton Command20
Caption = "BACKZOOM"
BeginProperty Font
Name = "Times New Roman"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1320
TabIndex = 28
Top = 5400
Width = 1000
End
Begin VB.CommandButton Command19
Caption = "DOWN"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 27
Top = 5880
Width = 500
End
Begin VB.CommandButton Command18
Caption = "UP"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 26
Top = 5880
Width = 500
End
Begin VB.CommandButton Command17
Caption = "POSITION"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2640
TabIndex = 23
Top = 1800
Width = 1000
End
Begin VB.CommandButton Command16
Caption = "UP/ LEFT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 1680
TabIndex = 22
Top = 2280
Width = 500
End
Begin VB.CommandButton Command15
Caption = "DOWN/LEFT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 1680
TabIndex = 21
Top = 3240
Width = 500
End
Begin VB.CommandButton Command14
Caption = "DOWN/RIGHT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2640
TabIndex = 20
Top = 3240
Width = 500
End
Begin VB.CommandButton Command13
Caption = "UP/ RIGHT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2640
TabIndex = 19
Top = 2280
Width = 500
End
Begin VB.CommandButton Command12
Caption = "RESET PAN/TILT"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3480
TabIndex = 18
Top = 2640
Width = 975
End
Begin VB.CommandButton Command11
Caption = "HOME"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2160
TabIndex = 17
Top = 2760
Width = 500
End
Begin VB.CommandButton Command10
Caption = "LEFT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 1680
TabIndex = 16
Top = 2760
Width = 500
End
Begin VB.CommandButton Command9
Caption = "DOWN"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2160
TabIndex = 15
Top = 3240
Width = 500
End
Begin VB.CommandButton Command8
Caption = "RIGHT"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2640
TabIndex = 14
Top = 2760
Width = 500
End
Begin VB.CommandButton Command7
Caption = "UP"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 500
Left = 2160
TabIndex = 13
Top = 2280
Width = 500
End
Begin VB.CommandButton Command6
Caption = "POSITION"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3840
TabIndex = 12
Top = 1800
Width = 1000
End
Begin MSCommLib.MSComm MSComm2
Left = 3480
Top = 5520
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.CommandButton Command5
Caption = "Zoom"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1320
TabIndex = 7
Top = 5880
Width = 1000
End
Begin VB.TextBox Text4
Height = 375
Left = 1440
TabIndex = 6
Top = 1320
Width = 1000
End
Begin VB.TextBox Text3
Height = 375
Left = 240
TabIndex = 5
Top = 1320
Width = 1000
End
Begin VB.CommandButton Command4
Caption = "DOWN"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 3
Top = 1800
Width = 500
End
Begin VB.CommandButton Command3
Caption = "UP"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 2
Top = 1800
Width = 500
End
Begin VB.CommandButton Command2
Caption = "DOWN"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 1
Top = 1800
Width = 500
End
Begin VB.CommandButton Command1
Caption = "UP"
BeginProperty Font
Name = "Times New Roman"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 0
Top = 1800
Width = 500
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "ZOOMING"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 31
Top = 4440
Width = 1575
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "ZOOM SPEED"
Height = 375
Left = 240
TabIndex = 30
Top = 4920
Width = 1005
End
Begin VB.Label Labe10
BackColor = &H80000009&
Height = 375
Left = 2640
TabIndex = 25
Top = 1320
Width = 1000
End
Begin VB.Label Label11
BackColor = &H80000009&
Height = 375
Left = 3840
TabIndex = 24
Top = 1320
Width = 1005
End
Begin VB.Label Label5
Caption = "INQUIRE PAN POSITION"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3840
TabIndex = 11
Top = 840
Width = 1080
End
Begin VB.Label Label4
Caption = "INQUIRE TILT POSITION"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2640
TabIndex = 10
Top = 840
Width = 1080
End
Begin VB.Label Label3
Caption = "INPUT TILT SPEED"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 9
Top = 840
Width = 1005
End
Begin VB.Label Label2
Caption = "INPUT PAN SPEED"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 8
Top = 840
Width = 1000
End
Begin VB.Line Line8
X1 = 2400
X2 = 2400
Y1 = 4800
Y2 = 6480
End
Begin VB.Line Line7
X1 = 120
X2 = 2400
Y1 = 4800
Y2 = 4800
End
Begin VB.Line Line6
X1 = 120
X2 = 2400
Y1 = 6480
Y2 = 6480
End
Begin VB.Line Line5
X1 = 120
X2 = 120
Y1 = 4800
Y2 = 6480
End
Begin VB.Line Line4
X1 = 120
X2 = 4920
Y1 = 720
Y2 = 720
End
Begin VB.Line Line3
X1 = 4920
X2 = 4920
Y1 = 720
Y2 = 3960
End
Begin VB.Line Line2
X1 = 4920
X2 = 120
Y1 = 3960
Y2 = 3960
End
Begin VB.Line Line1
X1 = 120
X2 = 120
Y1 = 720
Y2 = 3960
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "REMOTE CONTROL"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1440
TabIndex = 4
Top = 120
Width = 2400
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Written by Michael Costa
'Project completed on 8-13-99
'Remote Control for Camera System
'Boolean variables which will be used later in the program
Dim Grabbing As Boolean
Dim SGrabbing As Boolean
Dim Tracking As Boolean
'Declarations of public variables which are to be used as arguments
'for the functions which setup, grab, and display image buffers
Public Word As String
Public MilApplication As Long ' Application identifier.
Public MilSystem As Long ' System identifier.
Public MilDisplay As Long ' Display identifier.
Public MilDigitizer As Long ' Camera identifier.
Public MilImage As Long ' Image buffer identifier.
Dim SizeX As Long
Dim SizeY As Long
'Constants that will be used later in the program to determine the
'pan and tilt speeds
Const Speed1 = ("&H01")
Const Speed2 = ("&H02")
Const Speed3 = ("&H03")
Const Speed4 = ("&H04")
Const Speed5 = ("&H05")
Const Speed6 = ("&H06")
Const Speed7 = ("&H07")
Const Speed8 = ("&H08")
Const Speed9 = ("&H09")
Const Speed10 = ("&H10")
Const Speed11 = ("&H11")
Const Speed12 = ("&H12")
Const Speed13 = ("&H13")
Const Speed14 = ("&H14")
Const Speed15 = ("&H15")
Const Speed16 = ("&H16")
Const Speed17 = ("&H17")
Const Speed18 = ("&H18")
Private Sub Command1_Click()
'increase the text value in textbox 3 by one. If the textbox does not
'have numbers displayed in it, or if it has numbers greater than 18 or
'less than 0, then a msgbox is display
If Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text = 18 Then
Text3.Text = 1
Exit Sub
End If
Text3.Text = Text3.Text + 1
End Sub
Private Sub Command2_Click()
'Decreases the text value by one in textbox 3
If Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text = 1 Then
Text3.Text = 18
Exit Sub
End If
Text3.Text = Text3.Text - 1
End Sub
Private Sub Command3_Click()
'Increases the text value by one in textbox 4
If Not IsNumeric(Text4.Text) Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text = 14 Then
Text4.Text = 1
Exit Sub
End If
Text4.Text = Text4.Text + 1
End Sub
Private Sub Command4_Click()
'Decreases the text value by one in textbox 4
If Not IsNumeric(Text4.Text) Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text = 1 Then
Text4.Text = 14
Exit Sub
End If
Text4.Text = Text4.Text - 1
End Sub
Private Sub Command5_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Starts zoom. The array, Var, stores different speeds for the
'camera. Depending on what the user inputs in the textbox, the
'speed will vary
Dim Var(1 To 6)
Var(1) = Chr("&H22")
Var(2) = Chr("&H23")
Var(3) = Chr("&H24")
Var(4) = Chr("&H25")
Var(5) = Chr("&H26")
Var(6) = Chr("&H27")
If Not IsNumeric(Text5.Text) Then
MsgBox "Please enter an integer from one to six", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text < 1 Or Text5.Text > 6 Then
MsgBox "Please enter an integer from one to six", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text >= 10 Then
MsgBox "Please enter an integer from one to six", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text > 1 And Text5.Text < 2 Or Text5.Text > 2 And Text5.Text < 3 _
Or Text5.Text > 3 And Text5.Text < 4 Or Text5.Text > 4 And Text5.Text < 5 _
Or Text5.Text > 5 And Text5.Text < 6 Then
Text5.Text = Int(Text5.Text + 0.5)
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Var(Text5.Text)
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command5_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
'Stops zoom
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H00")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command6_Click()
'This CommandButton inquires the pan position of the camera.
'An inquiry command is sent to the camera. The camera then returns
'11 bytes of information concerning the camera's position. A loop is
'done until those eleven bytes are received. They are then stored
'as bytes in an array. Bytes two through five determine the pan
'position. I then convert the data stored in those arrays to decimal,
'and then to degrees. The degrees are then shown in a TextBox.
Dim Buffer As Variant
Dim Arr() As Byte
'clears buffer, if it is not empty
MSComm2.InBufferCount = 0
'tells the camera to return binary data
MSComm2.InputMode = comInputModeBinary
'clear what is written in the label
Label11.Caption = ""
'send inquiry command
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H09")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H12")
MSComm2.Output = Chr("&HFF")
Do
Dummy = DoEvents()
Loop Until MSComm2.InBufferCount >= 11
Buffer = MSComm2.Input
Arr = Buffer
If Arr(2) = 0 Then
Store = Arr(3) * 16 * 16 + Arr(4) * 16 + Arr(5)
Label11.Caption = Store * 100 / 861
End If
If Arr(2) = 15 Then
Store = (Arr(3) * 16 * 16 + Arr(4) * 16 + Arr(5)) - 4096
Label11.Caption = Store * 100 / 860
End If
End Sub
Private Sub Command7_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves Camera up
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command7_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
'Stops movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command8_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves Camera to the right
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr((Speed + Text3.Text))
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command8_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command9_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves camera down
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command9_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves camera to the left
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr(Speed + (Text3.Text))
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command11_Click()
'Brings camera to the initial position
Label10.Caption = ""
Label11.Caption = ""
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command12_Click()
'Resets pan/tilt
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H05")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command13_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves camera to the Up-Right position
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Or Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer in the text box", vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr(Speed + (Text3.Text))
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command13_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command14_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves Camera to down right position
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Or Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer in the text box", vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr(Speed + (Text3.Text))
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command14_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command15_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves Camera to Down-Left position
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Or Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer in the text box", vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr(Speed + (Text3.Text))
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command15_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command16_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Moves Camera to Up-Left position
Label10.Caption = ""
Label11.Caption = ""
If Not IsNumeric(Text4.Text) Or Not IsNumeric(Text3.Text) Then
MsgBox "Please enter an integer in the text box", vbCritical, "Input Error"
Exit Sub
End If
If Text4.Text > 14 Or Text4.Text < 1 Then
MsgBox "Please enter an integer from 1 to 14 in the Input Tilt Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
If Text3.Text > 18 Or Text3.Text < 1 Then
MsgBox "Please enter an integer from 1 to 18 in the Input Pan Speed text box" _
, vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr(Speed + (Text3.Text))
MSComm2.Output = Chr(Speed + (Text4.Text))
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command16_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops camera movement
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command17_Click()
'This CommandButton inquires the tilt position of the camera.
'An inquiry command is sent to the camera. The camera then returns
'11 bytes of information concerning the camera's position. A loop is
'done until those eleven bytes are received. They are then stored
'as bytes in an array. Bytes seven through ten determine the tilt
'position. I then convert the data stored in those arrays to decimal,
'and then to degrees. The degrees are then shown in a TextBox.
Dim Buffer As Variant
Dim Arr() As Byte
Label10.Caption = ""
MSComm2.InBufferCount = 0
MSComm2.InputMode = comInputModeBinary
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H09")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H12")
MSComm2.Output = Chr("&HFF")
Do
Dummy = DoEvents()
Loop Until MSComm2.InBufferCount >= 11
Buffer = MSComm2.Input
Arr = Buffer
If Arr(6) = 0 Then
Store = Arr(7) * 16 * 16 + Arr(8) * 16 + Arr(9)
Label10.Caption = Store * 25 / 283
End If
If Arr(6) = 15 Then
Store = (Arr(7) * 16 * 16 + Arr(8) * 16 + Arr(9)) - 4096
Label10.Caption = Store * 25 / 281
End If
End Sub
Private Sub Command18_Click()
'Increases the text value by one in textbox 5
If Not IsNumeric(Text5.Text) Then
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
End If
Select Case Text5.Text
Case Is > 6
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
Case Is < 1
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
Case 6
Text5.Text = 1
Exit Sub
End Select
Text5.Text = Int(Text5.Text)
Text5.Text = Text5.Text + 1
End Sub
Private Sub Command19_Click()
'Decreases the text value by one in textbox 5
If Not IsNumeric(Text5.Text) Then
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text > 1 And Text5.Text < 2 Or Text5.Text > 2 And Text5.Text < 3 _
Or Text5.Text > 3 And Text5.Text < 4 Or Text5.Text > 4 And Text5.Text < 5 _
Or Text5.Text > 5 And Text5.Text < 6 Then
Text5.Text = Int(Text5.Text)
Exit Sub
End If
Select Case Text5.Text
Case Is > 6
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
Case Is < 1
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
Case 1
Text5.Text = 6
Exit Sub
End Select
Text5.Text = Text5.Text - 1
End Sub
Private Sub Command20_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'zooms back
Dim Var(1 To 6)
Var(1) = Chr("&H32")
Var(2) = Chr("&H33")
Var(3) = Chr("&H34")
Var(4) = Chr("&H35")
Var(5) = Chr("&H36")
Var(6) = Chr("&H37")
If Not IsNumeric(Text5.Text) Then
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text < 1 Or Text5.Text > 6 Then
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
End If
If Text5.Text > 1 And Text5.Text < 2 Or Text5.Text > 2 And Text5.Text < 3 _
Or Text5.Text > 3 And Text5.Text < 4 Or Text5.Text > 4 And Text5.Text < 5 _
Or Text5.Text > 5 And Text5.Text < 6 Then
Text5.Text = Int(Text5.Text + 0.5)
End If
If Text5.Text >= 10 Then
MsgBox "Please enter an integer from 1 to 6", vbCritical, "Input Error"
Exit Sub
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Var(Text5.Text)
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command20_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
'Stops zoom
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H00")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Form_Load()
'When the application is loaded, the port is opened if it already is
'not opened
If MSComm2.PortOpen = False Then
MSComm2.PortOpen = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'When the application is closed, the image display is closed if
'the image has not been closed
If SGrabbing = True Or Grabbing = True Then
Call MdispDeselect(MilDisplay, MilImage)
Call MdigHalt(MilDigitizer)
Call MbufFree(MilImage)
Call MdigFree(MilDigitizer)
Call MdispFree(MilDisplay)
Call MsysFree(MilSystem)
Call MappFree(MilApplication)
Grabbing = False
SGrabbing = False
End If
'When the application is closed, tracking mode is turned off if it has
'not already been turned off.
If Tracking = True Then
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End If
'the port is closed as well, if it is not already closed.
If MSComm2.PortOpen = True Then
MSComm2.PortOpen = False
End If
End Sub
Private Sub Command21_Click()
'grabs images continuously
If SGrabbing = True Then
'closes display if opened
Call MdispDeselect(MilDisplay, MilImage)
'stops grab if an image is being grabbed
Call MdigHalt(MilDigitizer)
'grabs continuously
Call MdigGrabContinuous(MilDigitizer, MilImage)
'displays buffer in the frame
Call MdispSelectWindow(MilDisplay, MilImage, Frame1.hWnd)
SGrabbing = False
End If
If Grabbing = False Then
'allocates an Mil application
Call MappAlloc(M_DEFAULT, MilApplication)
'Allocates an MIL system
Call MsysAlloc(M_SYSTEM_METEOR, M_DEFAULT, M_DEFAULT, MilSystem)
'Allocates an MIL display
Call MdispAlloc(MilSystem, M_DEV0, "M_DEFAULT", M_DEFAULT, MilDisplay)
'Allocates an MIL digitizer
Call MdigAlloc(MilSystem, M_DEV0, M_DEF_DIGITIZER_FORMAT, M_DEFAULT, MilDigitizer)
Call MdigInquire(MilDigitizer, M_SIZE_X, SizeX)
Call MdigInquire(MilDigitizer, M_SIZE_Y, SizeY)
'Allocate color image buffer
Call MbufAllocColor(MilSystem, 3, SizeX, SizeY, 8 + M_UNSIGNED, _
M_IMAGE + M_DISP + M_GRAB, MilImage)
'Clear the buffer
Call MbufClear(MilImage, 0)
'Continuously grab images
Call MdigGrabContinuous(MilDigitizer, MilImage)
'Display buffer in the frame
Call MdispSelectWindow(MilDisplay, MilImage, Frame1.hWnd)
Grabbing = True
End If
'disables the save, load, and single grab button
Command38.Enabled = False
Command39.Enabled = False
Command42.Enabled = False
End Sub
Private Sub Command22_Click()
'Stops image display
If Grabbing = True Or SGrabbing = True Then
'closes display window
Call MdispDeselect(MilDisplay, MilImage)
'stops grabbing images
Call MdigHalt(MilDigitizer)
'frees image buffer
Call MbufFree(MilImage)
'frees digitizer
Call MdigFree(MilDigitizer)
'frees display controller
Call MdispFree(MilDisplay)
'frees system
Call MsysFree(MilSystem)
'frees application
Call MappFree(MilApplication)
Grabbing = False
SGrabbing = False
End If
Command38.Enabled = True
Command39.Enabled = True
Command42.Enabled = True
End Sub
Private Sub Command38_Click()
'Save Image
If SGrabbing = True Then
'sets up the common dialog box
On Error GoTo DlgError
With CommonDialog1
.CancelError = True
.Filter = "bitmap (*.bmp)|*.bmp|Tiff (*.tif)|*.tif"
.DialogTitle = "Save program"
.ShowSave
MsgBox "You Selected" & .FileName
End With
Word = CommonDialog1.FileName
'saves image
Call MbufSave(Word, MilImage)
DlgError:
End If
End Sub
Private Sub Command42_Click()
'loads image
If SGrabbing = False Then
On Error GoTo DlgError
With CommonDialog1
.CancelError = True
.Filter = "bitmap (*.bmp)|*.bmp|Tiff (*.tif)|*.tif"
.DialogTitle = "Select a file to open"
.ShowOpen
End With
Call MappAlloc(M_DEFAULT, MilApplication)
Call MsysAlloc(M_SYSTEM_METEOR, M_DEFAULT, M_DEFAULT, MilSystem)
Call MdispAlloc(MilSystem, M_DEV0, "M_DEFAULT", M_DEFAULT, MilDisplay)
Call MdigAlloc(MilSystem, M_DEV0, M_DEF_DIGITIZER_FORMAT, M_DEFAULT, MilDigitizer)
Call MdigInquire(MilDigitizer, M_SIZE_X, SizeX)
Call MdigInquire(MilDigitizer, M_SIZE_Y, SizeY)
Call MbufAllocColor(MilSystem, 3, SizeX, SizeY, 8 + M_UNSIGNED, _
M_IMAGE + M_DISP + M_GRAB, MilImage)
Call MbufClear(MilImage, 0)
Call MvgaDispSelectClientArea(MilDisplay, MilImage, Frame1.hWnd)
Word = CommonDialog1.FileName
Call MbufLoad(Word, MilImage)
Grabbing = True
SGrabbing = True
DlgError:
Else
On Error GoTo DlgError1
With CommonDialog1
.CancelError = True
.Filter = "bitmap (*.bmp)|*.bmp|Tiff (*.tif)|*.tif"
.DialogTitle = "Select a file to open"
.ShowOpen
End With
Call MdispDeselect(MilDisplay, MilImage)
Call MdigHalt(MilDigitizer)
Word = CommonDialog1.FileName
Call MvgaDispSelectClientArea(MilDisplay, MilImage, Frame1.hWnd)
Call MbufLoad(Word, MilImage)
Grabbing = True
SGrabbing = True
DlgError1:
End If
End Sub
Private Sub Command39_Click()
'Grabs a single image
If SGrabbing = False Then
Call MappAlloc(M_DEFAULT, MilApplication)
Call MsysAlloc(M_SYSTEM_METEOR, M_DEFAULT, M_DEFAULT, MilSystem)
Call MdispAlloc(MilSystem, M_DEV0, "M_DEFAULT", M_DEFAULT, MilDisplay)
Call MdigAlloc(MilSystem, M_DEV0, M_DEF_DIGITIZER_FORMAT, M_DEFAULT, MilDigitizer)
Call MdigInquire(MilDigitizer, M_SIZE_X, SizeX)
Call MdigInquire(MilDigitizer, M_SIZE_Y, SizeY)
Call MbufAllocColor(MilSystem, 3, SizeX, SizeY, 8 + M_UNSIGNED, _
M_IMAGE + M_DISP + M_GRAB, MilImage)
Call MbufClear(MilImage, 0)
Call MdigGrab(MilDigitizer, MilImage)
Call MdispSelectWindow(MilDisplay, MilImage, Frame1.hWnd)
Grabbing = True
SGrabbing = True
Else
Call MdispDeselect(MilDisplay, MilImage)
Call MdigHalt(MilDigitizer)
Call MdigGrab(MilDigitizer, MilImage)
Call MdispSelectWindow(MilDisplay, MilImage, Frame1.hWnd)
Grabbing = True
SGrabbing = True
End If
End Sub
Private Sub Command23_Click()
'Turns on tracking mode
Command25.Enabled = True
Command26.Enabled = True
Command27.Enabled = True
Command28.Enabled = True
Command29.Enabled = True
Command30.Enabled = True
Command31.Enabled = True
Command32.Enabled = True
Command33.Enabled = True
Command34.Enabled = True
Command35.Enabled = True
Command37.Enabled = True
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
Check1.Value = 1
Check7.Value = 1
Check11.Value = 1
Check12 = 1
Tracking = True
End Sub
Private Sub Command24_Click()
'Turns off tracking mode
Command25.Enabled = False
Command26.Enabled = False
Command27.Enabled = False
Command28.Enabled = False
Command29.Enabled = False
Command30.Enabled = False
Command31.Enabled = False
Command32.Enabled = False
Command33.Enabled = False
Command34.Enabled = False
Command35.Enabled = False
Command36.Enabled = False
Command37.Enabled = False
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0
Check6.Value = 0
Check7.Value = 0
Check8.Value = 0
Check9.Value = 0
Check10.Value = 0
Check11.Value = 0
Check12.Value = 0
Tracking = False
End Sub
Private Sub Command25_Click()
'Autotracking start
If Command36.Enabled = False Then
Command36.Enabled = True
Else
Command36.Enabled = False
End If
If Command29.Enabled = True And Command31.Enabled = True _
And Command32.Enabled = True And Command33.Enabled = True _
And Command34.Enabled = True And Command35.Enabled = True Then
Command29.Enabled = False
Command31.Enabled = False
Command32.Enabled = False
Command33.Enabled = False
Command34.Enabled = False
Command35.Enabled = False
Else
Command29.Enabled = True
Command31.Enabled = True
Command32.Enabled = True
Command33.Enabled = True
Command34.Enabled = True
Command35.Enabled = True
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command26_Click()
'Chase one mode
Check1.Value = 1
Check2.Value = 0
Check3.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H00")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command27_Click()
'Chase two mode
Check2.Value = 1
Check1.Value = 0
Check3.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command28_Click()
'Chase three mode
Check3.Value = 1
Check1.Value = 0
Check2.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command29_Click()
'Auto exposure
If Check4.Value = 1 Then
Check4.Value = 0
Else
Check4.Value = 1
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command30_Click()
'Auto zoom
If Check5.Value = 1 Then
Check5.Value = 0
Else
Check5.Value = 1
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command31_Click()
'Offset frame
If Check6.Value = 1 Then
Check6.Value = 0
Else
Check6.Value = 1
End If
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H05")
MSComm2.Output = Chr("&H10")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command32_Click()
'Entry mode one
Check7.Value = 1
Check8.Value = 0
Check9.Value = 0
Check10.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H15")
MSComm2.Output = Chr("&H00")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command33_Click()
'Entry mode two
Check7.Value = 0
Check8.Value = 1
Check9.Value = 0
Check10.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H15")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command34_Click()
'Entry mode three
Check7.Value = 0
Check8.Value = 0
Check9.Value = 1
Check10.Value = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H15")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command35_Click()
Entry mode four
Check7.Value = 0
Check8.Value = 0
Check9.Value = 0
Check10.Value = 1
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H15")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End Sub
Private Sub Command36_Click()
'Frame display on/off
If Check11 = 0 Then
Check11 = 1
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
Else
Check11 = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H07")
MSComm2.Output = Chr("&H04")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End If
End Sub
Private Sub Command37_Click()
'Datascreen on/off
If Check12 = 0 Then
Check12 = 1
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H02")
MSComm2.Output = Chr("&HFF")
Else
Check12 = 0
MSComm2.Output = Chr("&H81")
MSComm2.Output = Chr("&H01")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H06")
MSComm2.Output = Chr("&H03")
MSComm2.Output = Chr("&HFF")
End If
End Sub
}
i can clarify if more questions are there. |
