Rem you also need to include the National Instruments modules Rem vbib32.bas and niglobal.bas in this routine for the Rem PTS GPIB routines to work Rem written by w3sz in visual basic 5.0, sp3 12/31/2002 Public offn, hzn As Integer Public instring As String Public fr, freq, freqpts As String Public b1, b2, b3, b4, b5 As String Public f1, f2, f3, f4 As String Public c1, c2, c3, c4, c5 As Variant Public freqflo, hzflo, freqflo1, freqrnd As Double Public freqlon As Long Public mhz, hun, ten, hz, off, ffin As String Public h As String Private Sub Command1_Click() Call snddta End Sub Private Sub Command2_Click() Close MSComm1.PortOpen = False Unload Form1 Unload Form1 End End Sub Rem com 9 is rocketport P6 is hooked to P4 running Linrad Rem com 8 is rocketport P5 is hooked to FT1000 Private Sub Form_Load() mhz = 28 hun = 0 ten = 0 off = 0 hz = 0 hz = hz + off ffin = mhz + hun + ten + off Text5.Text = off Text6.Text = ffin Text7.Text = "-200" h = "&H" ' Use COM9. MSComm1.CommPort = 9 MSComm1.InputMode = comInputModeText ' 9600 baud, no parity, 8 data, and 2 stop bits. MSComm1.Settings = "9600,N,8,2" MSComm1.DTREnable = True MSComm1.RTSEnable = True MSComm1.RThreshold = 1 MSComm1.PortOpen = True MSComm1.InBufferCount = 0 linsend: Form1.Show instring = "" Do DoEvents instring = instring & MSComm1.Input Loop Until (Right(instring, 1) = "r") Or (Right(instring, 1) = "p") Or (Right(instring, 1) = "m") If Right(instring, 1) = "r" And Left(instring, 2) = "bb" Then freq = Mid(instring, 3, 9) Call snddta ElseIf Right(instring, 1) = "p" And Left(instring, 2) = "bb" Then freqpts = Mid(instring, 3, 6) Call ptsdta ElseIf Right(instring, 1) = "m" And Left(instring, 2) = "bb" Then Call m2dta rotdata = Mid(instring, 3, 10) End If GoTo linsend End Sub Private Sub MSComm_OnComm() Select Case MSComm1.CommEvent ' Handle each event or error by placing ' code below each case statement ' Errors Case comEventBreak ' A Break was received. Print "break" Case comEventCDTO ' CD (RLSD) Timeout. Print "CD timeout" Case comEventCTSTO ' CTS Timeout. Print "CTS timeout" Case comEventDSRTO ' DSR Timeout. Print "DSR timeout" Case comEventFrame ' Framing Error Print "framing error" Case comEventOverrun ' Data Lost. Print "data lost" Case comEventRxOver ' Receive buffer overflow. Print "Rx buffer overflow" Case comEventRxParity ' Parity Error. Print "parity error" Case comEventTxFull ' Transmit buffer full. Case comEventDCB ' Unexpected error retrieving DCB] ' Events Case comEvCD ' Change in the CD line. Print "CD line change" Case comEvCTS ' Change in the CTS line. Print "CTS change" Case comEvDSR ' Change in the DSR line. Print "DSR change" Case comEvRing ' Change in the Ring Indicator. Print "ring" Case comEvReceive ' Received RThreshold # of Print "received chars" ' chars. Case comEvSend ' There are SThreshold number of ' characters in the transmit ' buffer. Print "Threshold" Case comEvEOF ' An EOF charater was found in ' the input stream Print "EOF found" End Select End Sub Private Sub snddta() MSComm1.PortOpen = False MSComm1.CommPort = 8 MSComm1.InputMode = comInputModeText ' 4800 baud, no parity, 8 data, and 2 stop bits. MSComm1.Settings = "4800,N,8,2" MSComm1.RTSEnable = False MSComm1.RThreshold = 1 MSComm1.InputLen = 0 MSComm1.InBufferCount = 0 ' Open the port. MSComm1.PortOpen = True freqrnd = Val(freq) + 5 If freqrnd >= 100000000# Then Text3.Text = Mid$(freqrnd, 1, 8) ElseIf (freqrnd < 100000000#) And (freqrnd >= 10000000#) Then Text3.Text = Mid$(freqrnd, 1, 7) Else Text3.Text = "0" + Mid$(freqrnd, 1, 6) End If freqflo = Val(freqrnd) freqflo1 = freqflo - 200 off = Text5.Text offn = Val(off * 10) freqflo2 = freqflo1 + offn freq1 = CStr(freqflo2) mhz = Mid$(freq1, 1, 2) If (freqflo2 > 30000000#) Then If Left$(freqflo2, 3) = "143" Then freq1 = Right$(freq1, 6) mhz = "27" freq1 = "27" + freq1 Else freq1 = Right$(freq1, 6) mhz = "28" freq1 = "28" + freq1 End If End If If (freqflo2 < 10000000#) Then freq1 = "0" + freq1 mhz = Mid$(freq1, 1, 2) End If hun = Mid$(freq1, 3, 1) ten = Mid$(freq1, 4, 1) hz = Mid$(freq1, 5, 4) hzn = Val(hz) hzflo = hzn / 10 hzn = Int(hzflo) hz = Format(hzn, "###") If Val(hz) < 100 And Val(hz) >= 10 Then hz = "0" + hz If Val(hz) < 10 Then hz = "00" + hz ffin = mhz + hun + ten + hz Text6.Text = ffin f1 = Mid$(ffin, 6, 2) f2 = Mid$(ffin, 4, 2) f3 = Mid$(ffin, 2, 2) f4 = Left$(ffin, 1) b1 = h & f1 b2 = h & f2 b3 = h & f3 b4 = h & f4 c1 = Val(b1) c2 = Val(b2) c3 = Val(b3) c4 = Val(b4) c5 = &HA fr = Chr$(c1) & Chr$(c2) & Chr$(c3) & Chr$(c4) & Chr$(c5) MSComm1.Output = fr MSComm1.PortOpen = False ' Use COM9. MSComm1.CommPort = 9 MSComm1.InputMode = comInputModeText ' 9600 baud, no parity, 8 data, and 2 stop bits. MSComm1.Settings = "9600,N,8,2" MSComm1.DTREnable = True MSComm1.RTSEnable = True MSComm1.RThreshold = 1 MSComm1.PortOpen = True MSComm1.InBufferCount = 0 End Sub Private Sub ptsdta() BDNAME$ = "PTS40" Call ibfind(BDNAME$, dvm%) Call ibclr(dvm%) lofreq$ = "F" + freqpts + "0000" + Chr$(10) + "X0A" Text2.Text = freqpts Call ibwrta(dvm%, lofreq$) Call ibstop(ddvm%) End Sub Private Sub m2dta() MSComm1.PortOpen = False MSComm1.CommPort = 1 MSComm1.InputMode = comInputModeText ' 9600 baud, no parity, 8 data, and 1 stop bit. MSComm1.Settings = "9600,N,8,1" ' Tell the control to read entire buffer when Input ' is used. MSComm1.RTSEnable = True MSComm1.RThreshold = 1 MSComm1.InputLen = 0 MSComm1.InBufferCount = 0 ' Open the port. MSComm1.PortOpen = True ' Turn off auto update MSComm1.Output = "N" & Chr(13) MSComm1.Output = "N" & Chr(13) Azimuth = Format(moonaz, "###.#") MSComm1.Output = "A" & Chr$(13) MSComm1.Output = Azimuth & Chr$(13) Text8.Text = Azimuth Elevation = Format(moonel, "###.#") MSComm1.Output = "E" & Chr$(13) MSComm1.Output = Elevation & Chr$(13) Text9.Text = Elevation MSComm1.PortOpen = False ' Use COM9. MSComm1.CommPort = 9 MSComm1.InputMode = comInputModeText ' 9600 baud, no parity, 8 data, and 2 stop bits. MSComm1.Settings = "9600,N,8,2" MSComm1.DTREnable = True MSComm1.RTSEnable = True MSComm1.RThreshold = 1 MSComm1.PortOpen = True MSComm1.InBufferCount = 0 End Sub Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single) End Sub rem Copyright © 1997-2007 COPYRIGHT Roger Rehr W3SZ. All Rights Reserved