Started on : 2017.04.30. at 16:06:42This is the Demonstration Edition.
You may view the new code in the Viewer, but no .PAS files have been created.
Start analysis pass -
Analysing astro32.bas
Error parsing line 'Attribute VB_Name = "Astronomy_Funcs"
'---------------------------------------------------------------------
'
' ===========
' ASTRO32.BAS
' ===========
'
' Interface declarations for the Astronomy Library. Drop this into
' any VB project to get access to the astronomical support functions
' in astro32.dll. For the latest copy of astro32.dll, contact the
' author at the address below.
'
' Routines in astronomy DLL have been taken from various open source
' and freeware applications as well as original code by the author.
' Astro32.dll and this VB module are freely usable in any software
' project. The author assumes no responsibilities for bugs, etc.
'
' Written: 18-Jul-96 Robert B. Denny 
Done code part. Lines - 1 Analysing eqmath.basError parsing line 'Attribute VB_Name = "EQMath"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' EQMATH.bas - Math functions for EQMOD ASCOM RADECALTAZ computations
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 04-Nov-06 rcs Initial edit for EQ Mount Driver Function Prototype
' 20-Nov-06 rcs wrote a new function for now_lst that will generate millisecond
' granularity
' 21-Nov-06 rcs Append RA GOTO Compensation to minimize discrepancy
' 19-Mar-07 rcs Initial Edit for Three star alignment
' 05-Apr-07 rcs Add MAXSYNC
' 08-Apr-07 rcs N-star implementation
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
Public Const DEG_RAD As Double = 0.0174532925
Public Const RAD_DEG As Double = 57.2957795
Public Const HRS_RAD As Double = 0.2617993881
Public Const RAD_HRS As Double = 3.81971863
Public Const SID_RATE As Double = 15.041067
Public Const SOL_RATE As Double = 15
Public Const LUN_RATE As Double = 14.511415
Public Const gEMUL_RATE As Double = 20.98 ' 0.2 * 9024000/( (23*60*60)+(56*60)+4)
' 0.2 = 200ms
Public Const gEMUL_RATE2 As Double = 104.730403903004 ' (9024000/86164.0905)
' 104.73040390300411747513310083625
Public Const gARCSECSTEP As Double = 0.144 ' .144 arcesconds / step
' Iterative GOTO Constants
'Public Const NUM_SLEW_RETRIES As Long = 5 ' Iterative MAX retries
Public Const gRA_Allowed_diff As Double = 10 ' Iterative Slew minimum difference
' Home Position of the mount (pointing at NCP/SCP)
Public Const RAEncoder_Home_pos As Double = &H800000 ' Start at 0 Hour
Public Const DECEncoder_Home_pos As Double = &HA26C80 ' Start at 90 Degree position
Public Const gRAEncoder_Zero_pos As Double = &H800000 ' ENCODER 0 Hour initial position
Public Const gDECEncoder_Zero_pos As Double = &H800000 ' ENCODER 0 Degree Initial position
Public Const gDefault_step As Double = 9024000 ' Total Encoder count (EQ5/6)
'Public Const EQ_MAXSYNC As Double = &H111700
' Public Const EQ_MAXSYNC_Const As Double = &H88B80 ' Allow a 45 degree discrepancy
Public Const EQ_MAXSYNC_Const As Double = &H113640 ' Allow a 45 degree discrepancy
'------------------------------------------------------------------------------------------------
' Define all Global Variables
Public gXshift As Double
Public gYshift As Double
Public gXmouse As Double
Public gYmouse As Double
Public gEQ_MAXSYNC As Double ' Max Sync Diff
Public gSiderealRate As Double ' Sidereal rate arcsecs/sec
Public gMount_Ver As Double ' Mount Version
Public gMount_Features As Long ' Mount Features
Public gRA_LastRate As Double ' Last PEC Rate
Public gpl_interval As Integer ' Pulseguide Interval
Public eqres As Double
Public gTot_step As Double ' Total Common RA-Encoder Steps
Public gTot_RA As Double ' Total RA Encoder Steps
Public gTot_DEC As Double ' Total DEC Encoder Steps
Public gRAWormSteps As Double ' Steps per RA worm revolution
Public gRAWormPeriod As Double ' Period of RA worm revolution
Public gDECWormSteps As Double ' Steps per DEC worm revolution
Public gDECWormPeriod As Double ' Period of DEC worm revolution
Public gLatitude As Double ' Site Latitude
Public gLongitude As Double ' Site Longitude
Public gElevation As Double ' Site Elevation
Public gHemisphere As Long
Public gDECEncoder_Home_pos As Double ' DEC HomePos - Varies with different mounts
Public gRA_Encoder As Double ' RA Current Polled RA Encoder value
Public gDec_Encoder As Double ' DEC Current Polled Encoder value
Public gRA_Hours As Double ' RA Encoder to Hour position
Public gDec_Degrees As Double ' DEC Encoder to Degree position Ranged to -90 to 90
Public gDec_DegNoAdjust As Double ' DEC Encoder to actual degree position
Public gRAStatus As Double ' RA Polled Motor Status
Public gRAStatus_slew As Boolean ' RA motor tracking poll status
Public gDECStatus As Double ' DEC Polloed motor status
Public gRA_Limit_East As Double ' RA Limit at East Side
Public gRA_Limit_West As Double ' RA Limit at West Side
Public gRA1Star As Double ' Initial RA Alignment adjustment
Public gDEC1Star As Double ' Initial DEC Alignment adjustment
Public gRASync01 As Double ' Initial RA sync adjustment
Public gDECSync01 As Double ' Initial DEC sync adjustment
Public gRA As Double
Public gDec As Double
Public gAlt As Double
Public gAz As Double
Public gha As Double
Public gSOP As Double
Public gPort As String
Public gBaud As Long
Public gTimeout As Long
Public gRetry As Long
Public gTrackingStatus As Long
Public gSlewStatus As Boolean
Public gRAMoveAxis_Rate As Double
Public gDECMoveAxis_Rate As Double
' Added for emulated Stepper Counters
Public gEmulRA As Double
Public gEmulDEC As Double
Public gEmulOneShot As Boolean
Public gEmulNudge As Boolean
Public gCurrent_time As Double
Public gLast_time As Double
Public gEmulRA_Init As Double
Public Enum PierSide2
pierUnknown2 = -1
PierEast2 = 0
PierWest2 = 1
End Enum
Public gSideofPier As PierSide2
Public gRAEncoderPolarHomeGoto As Long
Public gDECEncoderPolarHomeGoto As Long
Public gRAEncoderUNPark As Long
Public gDECEncoderUNPark As Long
Public gRAEncoderPark As Long
Public gDECEncoderPark As Long
Public gRAEncoderlastpos As Long
Public gDECEncoderlastpos As Long
Public gEQparkstatus As Long
Public gEQRAPulseDuration As Long
Public gEQDECPulseDuration As Long
Public gEQRAPulseEnd As Long
Public gEQDECPulseEnd As Long
Public gEQDECPulseStart As Long
Public gEQRAPulseStart As Long
Public gEQPulsetimerflag As Boolean
Public gEQTimeDelta As Double
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
' Public variables for Custom Tracking rates
Public gDeclinationRate As Double
Public gRightAscensionRate As Double
' Public Variables for Spiral Slew
Public gSPIRAL_JUMP As Long
Public gDeclination_Start As Double
Public gRightAscension_Start As Double
Public gDeclination_Dir As Double
Public gRightAscension_Dir As Double
Public gDeclination_Len As Long
Public gRightAscension_Len As Long
Public gSpiral_AxisFlag As Double
' Public variables for debugging
Public gAffine1 As Double
Public gAffine2 As Double
Public gAffine3 As Double
Public gTaki1 As Double
Public gTaki2 As Double
Public gTaki3 As Double
'Pulseguide Indicators
Public Const gMAX_plotpoints As Integer = 100
Public gMAX_RAlevel As Integer
Public gMAX_DEClevel As Integer
Public gPlot_ra_pos As Integer
Public gPlot_dec_pos As Integer
Public gplot_ra_cur As Double
Public gPlot_dec_cur As Double
Public gRAHeight As Double
Public gDecHeight As Double
' Polar Alignment Variables
Public gPolarAlign_RA As Double
Public gPolarAlign_DEC As Double
Public Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)
Public Function Get_EncoderHours(encOffset0 As Double, encoderval As Double, Tot_enc As Double, hmspr As Long) As Double
Dim i As Double
' Compute in Hours the encoder value based on 0 position value (RAOffset0)
' and Total 360 degree rotation microstep count (Tot_Enc
If encoderval > encOffset0 Then
i = ((encoderval - encOffset0) / Tot_enc) * 24
i = 24 - i
Else
i = ((encOffset0 - encoderval) / Tot_enc) * 24
End If
If hmspr = 0 Then
Get_EncoderHours = Range24(i + 6#) ' Set to true Hours which is perpendicula to RA Axis
Else
Get_EncoderHours = Range24((24 - i) + 6#)
End If
End Function
Public Function Get_EncoderfromHours(encOffset0 As Double, hourval As Double, Tot_enc As Double, hmspr As Long) As Long
hourval = Range24(hourval - 6#) ' Re-normalize from a perpendicular position
If hmspr = 0 Then
If (hourval < 12) Then
Get_EncoderfromHours = encOffset0 - ((hourval / 24) * Tot_enc)
Else
Get_EncoderfromHours = (((24 - hourval) / 24) * Tot_enc) + encOffset0
End If
Else
If (hourval < 12) Then
Get_EncoderfromHours = ((hourval / 24) * Tot_enc) + encOffset0
Else
Get_EncoderfromHours = encOffset0 - (((24 - hourval) / 24) * Tot_enc)
End If
End If
End Function
Public Function Get_EncoderfromDegrees(encOffset0 As Double, degval As Double, Tot_enc As Double, Pier As Double, hmspr As Long) As Long
If hmspr = 1 Then degval = 360 - degval
If (degval > 180) And (Pier = 0) Then
Get_EncoderfromDegrees = encOffset0 - (((360 - degval) / 360) * Tot_enc)
Else
Get_EncoderfromDegrees = ((degval / 360) * Tot_enc) + encOffset0
End If
End Function
Public Function Get_EncoderDegrees(encOffset0 As Double, encoderval As Double, Tot_enc As Double, hmspr As Long) As Double
Dim i As Double
' Compute in Hours the encoder value based on 0 position value (EncOffset0)
' and Total 360 degree rotation microstep count (Tot_Enc
If encoderval > encOffset0 Then
i = ((encoderval - encOffset0) / Tot_enc) * 360
Else
i = ((encOffset0 - encoderval) / Tot_enc) * 360
i = 360 - i
End If
If hmspr = 0 Then
Get_EncoderDegrees = Range360(i)
Else
Get_EncoderDegrees = Range360(360 - i)
End If
End Function
' Function that will ensure that the DEC value will be between -90 to 90
' Even if it is set at the other side of the pier
Public Function Range_DEC(decdegrees As Double) As Double
If (decdegrees >= 270) And (decdegrees <= 360) Then
Range_DEC = decdegrees - 360
Exit Function
End If
If (decdegrees >= 180) And (decdegrees < 270) Then
Range_DEC = 180 - decdegrees
Exit Function
End If
If (decdegrees >= 90) And (decdegrees < 180) Then
Range_DEC = 180 - decdegrees
Exit Function
End If
Range_DEC = decdegrees
End Function
Public Function Get_RAEncoderfromRA(ra_in_hours As Double, dec_in_degrees As Double, pLongitude As Double, encOffset0 As Double, Tot_enc As Double, hmspr As Long) As Long
Dim i As Double
Dim j As Double
i = ra_in_hours - EQnow_lst(pLongitude * DEG_RAD)
If hmspr = 0 Then
If (dec_in_degrees > 90) And (dec_in_degrees <= 270) Then i = i - 12#
Else
If (dec_in_degrees > 90) And (dec_in_degrees <= 270) Then i = i + 12#
End If
i = Range24(i)
Get_RAEncoderfromRA = Get_EncoderfromHours(encOffset0, i, Tot_enc, hmspr)
End Function
Public Function Get_RAEncoderfromAltAz(Alt_in_deg As Double, Az_in_deg As Double, pLongitude As Double, pLatitude As Double, encOffset0 As Double, Tot_enc As Double, hmspr As Long) As Long
Dim i As Double
Dim ttha As Double
Dim ttdec As Double
aa_hadec (pLatitude * DEG_RAD), (Alt_in_deg * DEG_RAD), ((360# - Az_in_deg) * DEG_RAD), ttha, ttdec
i = (ttha * RAD_HRS)
i = Range24(i)
Get_RAEncoderfromAltAz = Get_EncoderfromHours(encOffset0, i, Tot_enc, hmspr)
End Function
Public Function Get_DECEncoderfromAltAz(Alt_in_deg As Double, Az_in_deg As Double, pLongitude As Double, pLatitude As Double, encOffset0 As Double, Tot_enc As Double, Pier As Double, hmspr As Long) As Long
Dim i As Double
Dim ttha As Double
Dim ttdec As Double
aa_hadec (pLatitude * DEG_RAD), (Alt_in_deg * DEG_RAD), ((360# - Az_in_deg) * DEG_RAD), ttha, ttdec
i = ttdec * RAD_DEG ' tDec was in Radians
If Pier = 1 Then i = 180 - i
Get_DECEncoderfromAltAz = Get_EncoderfromDegrees(encOffset0, i, Tot_enc, Pier, hmspr)
End Function
Public Function Get_DECEncoderfromDEC(dec_in_degrees As Double, Pier As Double, encOffset0 As Double, Tot_enc As Double, hmspr As Long) As Long
Dim i As Double
i = dec_in_degrees
If Pier = 1 Then i = 180 - i
Get_DECEncoderfromDEC = Get_EncoderfromDegrees(encOffset0, i, Tot_enc, Pier, hmspr)
End Function
Public Function printhex(inpval As Double) As String
printhex = " " & Hex$((inpval And &HF00000) / 1048576 And &HF) + Hex$((inpval And &HF0000) / 65536 And &HF) + Hex$((inpval And &HF000) / 4096 And &HF) + Hex$((inpval And &HF00) / 256 And &HF) + Hex$((inpval And &HF0) / 16 And &HF) + Hex$(inpval And &HF)
End Function
Public Function FmtSexa(ByVal N As Double, ShowPlus As Boolean) As String
Dim sg As String
Dim us As String
Dim ms As String
Dim ss As String
Dim u As Long
Dim m As Long
Dim fmt
sg = "+" ' Assume positive
If N < 0 Then ' Check neg.
N = -N ' Make pos.
sg = "-" ' Remember sign
End If
m = Fix(N) ' Units (deg or hr)
us = Format$(m, "00")
N = (N - m) * 60#
m = Fix(N) ' Minutes
ms = Format$(m, "00")
N = (N - m) * 60#
m = Fix(N) ' Minutes
ss = Format$(m, "00")
FmtSexa = us & ":" & ms & ":" & ss
If ShowPlus Or (sg = "-") Then FmtSexa = sg & FmtSexa
End Function
Public Function EQnow_lst(plong As Double) As Double
Dim typTime As SYSTEMTIME
Dim eps As Double
Dim lst As Double
Dim deps As Double
Dim dpsi As Double
Dim mjd As Double
' mjd = vb_mjd(CDbl(Now) + gGPSTimeDelta)
GetSystemTime typTime
mjd = vb_mjd(CDbl(gEQTimeDelta + Now + (typTime.wMilliseconds / 86400000)))
Call utc_gst(mjd_day(mjd), mjd_hr(mjd), lst)
lst = lst + radhr(plong)
Call obliq(mjd, eps)
Call nut(mjd, deps, dpsi)
lst = lst + radhr(dpsi * Cos(eps + deps))
Call range(lst, 24#)
EQnow_lst = lst
' EQnow_lst = now_lst(plong)
End Function
Public Function EQnow_lst_norange() As Double
Dim typTime As SYSTEMTIME
Dim mjd As Double
Dim MTMP As Double
GetSystemTime typTime
mjd = (typTime.wMinute * 60) + (typTime.wSecond) + (typTime.wMilliseconds / 1000)
MTMP = (typTime.wHour)
MTMP = MTMP * 3600
mjd = mjd + MTMP + (typTime.wDay * 86400)
EQnow_lst_norange = mjd
End Function
Public Function EQnow_lst_time(plong As Double, ptime As Double) As Double
Dim eps As Double
Dim lst As Double
Dim deps As Double
Dim dpsi As Double
Dim mjd As Double
mjd = vb_mjd(ptime)
Call utc_gst(mjd_day(mjd), mjd_hr(mjd), lst)
lst = lst + radhr(plong)
Call obliq(mjd, eps)
Call nut(mjd, deps, dpsi)
lst = lst + radhr(dpsi * Cos(eps + deps))
Call range(lst, 24#)
EQnow_lst_time = lst
End Function
Public Function SOP_DEC(ByVal DEC As Double) As PierSide2
DEC = Abs(DEC - 180)
If DEC <= 90 Then
SOP_DEC = PierEast2
Else
SOP_DEC = PierWest2
End If
End Function
Public Function SOP_Physical(vha As Double) As PierSide2
Dim ha As Double
ha = RangeHA(vha - 6#)
If gAscomCompatibility.SwapPhysicalSideOfPier Then
SOP_Physical = IIf(ha >= 0, PierWest2, PierEast2)
Else
SOP_Physical = IIf(ha >= 0, PierEast2, PierWest2)
End If
End Function
Public Function SOP_Pointing(ByVal DEC As Double) As PierSide2
If DEC <= 90 Or DEC >= 270 Then
If gAscomCompatibility.SwapPointingSideOfPier Then
SOP_Pointing = PierEast2
Else
SOP_Pointing = PierWest2
End If
Else
If gAscomCompatibility.SwapPointingSideOfPier Then
SOP_Pointing = PierWest2
Else
SOP_Pointing = PierEast2
End If
End If
' in the south east is west and west is east!
If gHemisphere = 1 Then
If SOP_Pointing = PierWest2 Then
SOP_Pointing = PierEast2
Else
SOP_Pointing = PierWest2
End If
End If
End Function
Public Function SOP_RA(vRA As Double, pLongitude As Double) As PierSide2
Dim i As Double
i = vRA - EQnow_lst(pLongitude * DEG_RAD)
i = RangeHA(i - 6#)
SOP_RA = IIf(i < 0, PierEast2, PierWest2)
End Function
Public Function Range24(ByVal vha As Double)
While vha < 0#
vha = vha + 24#
Wend
While vha >= 24#
vha = vha - 24#
Wend
Range24 = vha
End Function
Public Function Range360(ByVal vdeg As Double)
While vdeg < 0#
vdeg = vdeg + 360#
Wend
While vdeg >= 360#
vdeg = vdeg - 360#
Wend
Range360 = vdeg
End Function
Public Function Range90(ByVal vdeg As Double)
While vdeg < -90#
vdeg = vdeg + 360#
Wend
While vdeg >= 360#
vdeg = vdeg - 90#
Wend
Range90 = vdeg
End Function
Public Function RangeHA(ByVal ha As Double)
While ha < -12#
ha = ha + 24#
Wend
While ha >= 12#
ha = ha - 24#
Wend
RangeHA = ha
End Function
Public Function GetSlowdown(ByVal deltaval As Double) As Double
Dim i As Double
i = deltaval - 80000
If i < 0 Then i = deltaval * 0.5
GetSlowdown = i
End Function
Public Function Delta_RA_Map(ByVal RAENCODER As Double) As Double
Delta_RA_Map = RAENCODER + gRA1Star + gRASync01
End Function
Public Function Delta_DEC_Map(ByVal DecEncoder As Double) As Double
Delta_DEC_Map = DecEncoder + gDEC1Star + gDECSync01
End Function
Public Function Delta_Matrix_Map(ByVal RA As Double, ByVal DEC As Double) As Coordt
Dim i As Integer
Dim obtmp As Coord
Dim obtmp2 As Coord
If (RA >= &H1000000) Or (DEC >= &H1000000) Then
Delta_Matrix_Map.X = RA
Delta_Matrix_Map.Y = DEC
Delta_Matrix_Map.z = 1
Delta_Matrix_Map.F = 0
Exit Function
End If
obtmp.X = RA
obtmp.Y = DEC
obtmp.z = 1
' re transform based on the nearest 3 stars
i = EQ_UpdateTaki(RA, DEC)
obtmp2 = EQ_plTaki(obtmp)
Delta_Matrix_Map.X = obtmp2.X
Delta_Matrix_Map.Y = obtmp2.Y
Delta_Matrix_Map.z = 1
Delta_Matrix_Map.F = i
End Function
Public Function Delta_Matrix_Reverse_Map(ByVal RA As Double, ByVal DEC As Double) As Coordt
Dim i As Integer
Dim obtmp As Coord
Dim obtmp2 As Coord
If (RA >= &H1000000) Or (DEC >= &H1000000) Then
Delta_Matrix_Reverse_Map.X = RA
Delta_Matrix_Reverse_Map.Y = DEC
Delta_Matrix_Reverse_Map.z = 1
Delta_Matrix_Reverse_Map.F = 0
Exit Function
End If
obtmp.X = RA + gRASync01
obtmp.Y = DEC + gDECSync01
obtmp.z = 1
' re transform using the 3 nearest stars
i = EQ_UpdateAffine(obtmp.X, obtmp.Y)
obtmp2 = EQ_plAffine(obtmp)
Delta_Matrix_Reverse_Map.X = obtmp2.X
Delta_Matrix_Reverse_Map.Y = obtmp2.Y
Delta_Matrix_Reverse_Map.z = 1
Delta_Matrix_Reverse_Map.F = i
gSelectStar = 0
End Function
Public Function DeltaSync_Matrix_Map(ByVal RA As Double, ByVal DEC As Double) As Coordt
Dim i As Long
If (RA >= &H1000000) Or (DEC >= &H1000000) Then GoTo HandleError
i = GetNearest(RA, DEC)
If i <> -1 Then
gSelectStar = i
DeltaSync_Matrix_Map.X = RA + (ct_Points(i).X - my_Points(i).X) + gRASync01
DeltaSync_Matrix_Map.Y = DEC + (ct_Points(i).Y - my_Points(i).Y) + gDECSync01
DeltaSync_Matrix_Map.z = 1
DeltaSync_Matrix_Map.F = 0
Else
HandleError:
DeltaSync_Matrix_Map.X = RA
DeltaSync_Matrix_Map.Y = DEC
DeltaSync_Matrix_Map.z = 0
DeltaSync_Matrix_Map.F = 0
End If
End Function
Public Function DeltaSyncReverse_Matrix_Map(ByVal RA As Double, ByVal DEC As Double) As Coordt
Dim i As Long
If (RA >= &H1000000) Or (DEC >= &H1000000) Or gAlignmentStars_count = 0 Then GoTo HandleError
i = GetNearest(RA, DEC)
If i <> -1 Then
gSelectStar = i
DeltaSyncReverse_Matrix_Map.X = RA - (ct_Points(i).X - my_Points(i).X)
DeltaSyncReverse_Matrix_Map.Y = DEC - (ct_Points(i).Y - my_Points(i).Y)
DeltaSyncReverse_Matrix_Map.z = 1
DeltaSyncReverse_Matrix_Map.F = 0
Else
HandleError:
DeltaSyncReverse_Matrix_Map.X = RA
DeltaSyncReverse_Matrix_Map.Y = DEC
DeltaSyncReverse_Matrix_Map.z = 1
DeltaSyncReverse_Matrix_Map.F = 0
End If
End Function
Public Function GetQuadrant(ByRef tmpcoord As Coord) As Integer
Dim ret As Integer
If tmpcoord.X >= 0 Then
If tmpcoord.Y >= 0 Then
ret = 0
Else
ret = 1
End If
Else
If tmpcoord.Y >= 0 Then
ret = 2
Else
ret = 3
End If
End If
GetQuadrant = ret
End Function
Public Function GetNearest(ByVal RA As Double, ByVal DEC As Double) As Integer
Dim i As Integer
Dim tmpcoord As Coord
Dim tmpcoord2 As Coord
Dim datholder(1 To MAX_STARS) As Double
Dim datholder2(1 To MAX_STARS) As Integer
Dim Count As Integer
tmpcoord.X = RA
tmpcoord.Y = DEC
tmpcoord = EQ_sp2Cs(tmpcoord)
Count = 0
For i = 1 To gAlignmentStars_count
tmpcoord2 = my_PointsC(i)
Select Case gPointFilter
Case 0
' all points
Case 1
' only consider points on this side of the meridian
If tmpcoord2.Y * tmpcoord.Y < 0 Then
GoTo NextPoint
End If
Case 2
' local quadrant
If GetQuadrant(tmpcoord) <> GetQuadrant(tmpcoord2) Then
GoTo NextPoint
End If
End Select
Count = Count + 1
If HC.CheckLocalPier.Value = 1 Then
' calculate polar distance
datholder(Count) = (my_Points(i).X - RA) ^ 2 + (my_Points(i).Y - DEC) ^ 2
Else
' calculate cartesian disatnce
datholder(Count) = (tmpcoord2.X - tmpcoord.X) ^ 2 + (tmpcoord2.Y - tmpcoord.Y) ^ 2
End If
datholder2(Count) = i
NextPoint:
Next i
If Count = 0 Then
GetNearest = -1
Else
' i = EQ_FindLowest(datholder(), 1, gAlignmentStars_count)
i = EQ_FindLowest(datholder(), 1, Count)
If i = -1 Then
GetNearest = -1
Else
GetNearest = datholder2(i)
End If
End If
End Function
'Public Function Delta_RA_Map_encoder(ByVal RAENCODER As Double) As Double'
'
' Delta_RA_Map_encoder = RAENCODER - gRASync01 - gRA1Star
'
'End Function
'Public Function Delta_DEC_Map_encoder(ByVal DECENCODER As Double) As Double
'
' Delta_DEC_Map_encoder = DECENCODER - gDECSync01 - gDEC1Star
'
'End Function
' at 4124 Done code part. Lines - 1 Analysing errorconstants.bas Done code part. Lines - 1 Analysing common.basError parsing line 'Attribute VB_Name = "Common"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' Common.bas - Common functions for EQMOD ASCOM driver
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
'------------------- EQCONTRL.DLL Constants -----------------------
Public Const EQ_OK As Double = &H0
Public Const EQ_COMNOTOPEN As Double = &H1
Public Const EQ_COMTIMEOUT As Double = &H3
Public Const EQ_MOTORBUSY As Double = &H10
Public Const EQ_NOTINITIALIZED As Double = &HC8
Public Const EQ_INVALIDCOORDINATE As Double = &H1000000
Public Const EQ_INVALID As Double = &H3000000
' Protocol types
Public Const CURMOUNT As Long = 0 'Detected Current Mount
Public Const EQMOUNT As Long = 1 'EQG Protocol
Public Const NXMOUNT As Long = 2 'NexStar Protocol
Public Const LXMOUNT As Long = 3 'LX200 Protocol
Public Const TKMOUNT As Long = 4 'Takahashi Protocol
Public Const HBXMOUNT As Long = 5 'Meade HBX
' coordinate types
Public Const CT_STEP As Long = 0
Public Const CT_RADEC As Long = 1
Public Const CT_AZALT As Long = 2
'------------------------------------------------------------------
'Virtual Desktop sizes
Const SM_XVIRTUALSCREEN = 76 'Virtual Left
Const SM_YVIRTUALSCREEN = 77 'Virtual Top
Const SM_CXVIRTUALSCREEN = 78 'Virtual Width
Const SM_CYVIRTUALSCREEN = 79 'Virtual Height
Const SM_CMONITORS = 80 'Get number of monitors
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_NOTTOPMOST = -2
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Type ASCOM_COMPLIANCE
SlewWithTrackingOff As Boolean
AllowPulseGuide As Boolean
AllowExceptions As Boolean
AllowPulseGuideExceptions As Boolean
BlockPark As Boolean
AllowSiteWrites As Boolean
Epoch As Integer
SideOfPier As Integer
SwapPointingSideOfPier As Boolean
SwapPhysicalSideOfPier As Boolean
Strict As Boolean
End Type
Public gAscomCompatibility As ASCOM_COMPLIANCE
Public oProfile As DriverHelper.Profile
Public Const oID As String = "EQMOD.Telescope"
Public m_telescope As Telescope
Public gPresetSlewRates(1 To 10) As Double
Public gRateButtons(1 To 4) As Integer
Public gPresetSlewRatesCount As Integer
Public gCurrentRatePreset As Integer
Public gPoleStarRa As Double
Public gPoleStarDec As Double
Public gPoleStarRaJ2000 As Double
Public gPoleStarDecJ2000 As Double
Public gPoleStarReticuleDec As Double
Public gPolarReticuleEpoch As Double
Public gPolHa As Double
Public gVersion As String
Public gShowPolarAlign As Integer
Public gAlignmentMode As Integer
Public gCoordType As Long
Public gDllVer As Double
Public g3PointAlgorithm As Integer
Public gAdvanced As Integer
Public gPointFilter As Integer
Public gBacklashDec As Integer
Public gDriftComp As Integer
Public gPoleStarIdx As Integer
Public gLstDisplayMode As Integer
Public gPulseguideRateRa As Double
Public gPulseguideRateDec As Double
Public gCommErrorStop As Integer
Public ClientCount As Integer
Public gInitResult As Long
Public gDisableSyncLimit As Boolean
Private Const oDESC As String = "EQMOD ASCOM Scope Driver"
Private Const SC_CLOSE As Long = &HF060&
Private Const MIIM_STATE As Long = &H1&
Private Const MIIM_ID As Long = &H2&
Private Const MFS_GRAYED As Long = &H3&
Private Const WM_NCACTIVATE As Long = &H86
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Private Declare Function GetSystemMenu Lib "user32" ( _
ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias _
"SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
' Locale Info for Regional Settings processing
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Sub PutWindowOnTop(pFrm As Form)
Dim lngWindowPosition As Long
lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Public Sub PutWindowNormal(pFrm As Form)
Dim lngWindowPosition As Long
lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_NOTTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Public Function EnableCloseButton(ByVal hwnd As Long, Enable As Boolean) _
As Integer
Const xSC_CLOSE As Long = -10
' Check that the window handle passed is valid
EnableCloseButton = -1
If IsWindow(hwnd) = 0 Then Exit Function
' Retrieve a handle to the window's system menu
Dim hMenu As Long
hMenu = GetSystemMenu(hwnd, 0)
' Retrieve the menu item information for the close menu item/button
Dim MII As MENUITEMINFO
MII.cbSize = Len(MII)
MII.dwTypeData = String(80, 0)
MII.cch = Len(MII.dwTypeData)
MII.fMask = MIIM_STATE
If Enable Then
MII.wID = xSC_CLOSE
Else
MII.wID = SC_CLOSE
End If
EnableCloseButton = -0
If GetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Switch the ID of the menu item so that VB can not undo the action itself
Dim lngMenuID As Long
lngMenuID = MII.wID
If Enable Then
MII.wID = SC_CLOSE
Else
MII.wID = xSC_CLOSE
End If
MII.fMask = MIIM_ID
EnableCloseButton = -2
If SetMenuItemInfo(hMenu, lngMenuID, False, MII) = 0 Then Exit Function
' Set the enabled / disabled state of the menu item
If Enable Then
MII.fState = (MII.fState Or MFS_GRAYED)
MII.fState = MII.fState - MFS_GRAYED
Else
MII.fState = (MII.fState Or MFS_GRAYED)
End If
MII.fMask = MIIM_STATE
EnableCloseButton = -3
If SetMenuItemInfo(hMenu, MII.wID, False, MII) = 0 Then Exit Function
' Activate the non-client area of the window to update the titlebar, and
' draw the close button in its new state.
SendMessage hwnd, WM_NCACTIVATE, True, 0
EnableCloseButton = 0
End Function
Public Sub Main()
ClientCount = 0
Set oProfile = New DriverHelper.Profile
'Dim m_telescope As Telescope
Set m_telescope = New Telescope
oProfile.DeviceType = "Telescope"
Set g_TrackingRates = New TrackingRates
g_TrackingRates.Add driveSidereal
' g_TrackingRates.Add driveLunar
' g_TrackingRates.Add driveSolar
If App.StartMode = vbSModeStandalone Then
MsgBox AppName & " is an ASCOM driver. It cannot be run stand-alone", _
(vbOKOnly + vbCritical + vbMsgBoxSetForeground), App.FileDescription
Exit Sub
End If
End Sub
Public Function SyncToRADEC(ByVal RightAscension As Double, ByVal Declination As Double, ByVal pLongitude As Double, ByVal pHemisphere As Long) As Boolean
Dim targetRAEncoder As Double
Dim targetDECEncoder As Double
Dim currentRAEncoder As Double
Dim currentDECEncoder As Double
Dim SaveRaSync As Double
Dim SaveDecSync As Double
Dim tRa As Double
Dim tha As Double
Dim tPier As Double
Dim tmpcoord As Coordt
SyncToRADEC = True
If HC.ListSyncMode.ListIndex = 1 Then
' Append via sync mode!
SyncToRADEC = EQ_NPointAppend(RightAscension, Declination, pLongitude, pHemisphere)
Exit Function
Else
' its an ascom sync - shift whole model
SaveDecSync = gDECSync01
SaveRaSync = gRASync01
gRASync01 = 0
gDECSync01 = 0
HC.EncoderTimer.Enabled = False
If gThreeStarEnable = False Then
currentRAEncoder = EQGetMotorValues(0) + gRA1Star
currentDECEncoder = EQGetMotorValues(1) + gDEC1Star
Else
Select Case gAlignmentMode
Case 2
' nearest
tmpcoord = DeltaSync_Matrix_Map(EQGetMotorValues(0), EQGetMotorValues(1))
currentRAEncoder = tmpcoord.x
currentDECEncoder = tmpcoord.Y
Case 1
' n-star
tmpcoord = Delta_Matrix_Reverse_Map(EQGetMotorValues(0), EQGetMotorValues(1))
currentRAEncoder = tmpcoord.x
currentDECEncoder = tmpcoord.Y
Case Else
'n-star+nearest
tmpcoord = Delta_Matrix_Reverse_Map(EQGetMotorValues(0), EQGetMotorValues(1))
currentRAEncoder = tmpcoord.x
currentDECEncoder = tmpcoord.Y
If tmpcoord.F = 0 Then
tmpcoord = DeltaSync_Matrix_Map(EQGetMotorValues(0), EQGetMotorValues(1))
currentRAEncoder = tmpcoord.x
currentDECEncoder = tmpcoord.Y
End If
End Select
End If
HC.EncoderTimer.Enabled = True
tha = RangeHA(RightAscension - EQnow_lst(pLongitude * DEG_RAD))
If tha < 0 Then
If pHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(RightAscension - 12)
Else
If pHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = RightAscension
End If
'Compute for Sync RA/DEC Encoder Values
targetRAEncoder = Get_RAEncoderfromRA(tRa, 0, pLongitude, gRAEncoder_Zero_pos, gTot_RA, pHemisphere)
targetDECEncoder = Get_DECEncoderfromDEC(Declination, tPier, gDECEncoder_Zero_pos, gTot_DEC, pHemisphere)
If gDisableSyncLimit = True Then
gRASync01 = targetRAEncoder - currentRAEncoder
gDECSync01 = targetDECEncoder - currentDECEncoder
Else
If (Abs(targetRAEncoder - currentRAEncoder) > gEQ_MAXSYNC) Or (Abs(targetDECEncoder - currentDECEncoder) > gEQ_MAXSYNC) Then
Call HC.Add_Message(oLangDll.GetLangString(6004))
gDECSync01 = SaveDecSync
gRASync01 = SaveRaSync
HC.Add_Message ("RA=" & FmtSexa(gRA, False) & " " & CStr(currentRAEncoder))
HC.Add_Message ("SyncRA=" & FmtSexa(RightAscension, False) & " " & CStr(targetRAEncoder))
HC.Add_Message ("DEC=" & FmtSexa(gDec, True) & " " & CStr(currentDECEncoder))
HC.Add_Message ("Sync DEC=" & FmtSexa(Declination, True) & " " & CStr(targetDECEncoder))
SyncToRADEC = False
Else
gRASync01 = targetRAEncoder - currentRAEncoder
gDECSync01 = targetDECEncoder - currentDECEncoder
End If
End If
Call WriteSyncMap
gEmulOneShot = True ' Re Sync Display
HC.DxSalbl.Caption = Format$(str(gRASync01), "000000000")
HC.DxSblbl.Caption = Format$(str(gDECSync01), "000000000")
End If
End Function
Public Sub readlastpos()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("LASTPOS_RA")
If tmptxt <> "" Then
gRAEncoderlastpos = val(tmptxt)
Else
gRAEncoderlastpos = RAEncoder_Home_pos
End If
tmptxt = HC.oPersist.ReadIniValue("LASTPOS_DEC")
If tmptxt <> "" Then
gDECEncoderlastpos = val(tmptxt)
Else
gDECEncoderlastpos = gDECEncoder_Home_pos
End If
End Sub
Public Sub writelastpos()
HC.oPersist.WriteIniValue "LASTPOS_RA", CStr(gRAEncoderlastpos)
HC.oPersist.WriteIniValue "LASTPOS_DEC", CStr(gDECEncoderlastpos)
End Sub
Public Sub WriteSyncMap()
HC.oPersist.WriteIniValue "RSYNC01", CStr(gRASync01)
HC.oPersist.WriteIniValue "DSYNC01", CStr(gDECSync01)
End Sub
Public Sub WriteAlignMap()
HC.oPersist.WriteIniValue "RALIGN01", CStr(gRA1Star)
HC.oPersist.WriteIniValue "DALIGN01", CStr(gDEC1Star)
End Sub
Public Sub readPolarHomeGoto()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("POLARHOME_GOTO_RA")
If tmptxt <> "" Then
gRAEncoderPolarHomeGoto = val(tmptxt)
Else
gRAEncoderPolarHomeGoto = 0
End If
tmptxt = HC.oPersist.ReadIniValue("POLARHOME_GOTO_DEC")
If tmptxt <> "" Then
gDECEncoderPolarHomeGoto = val(tmptxt)
Else
gDECEncoderPolarHomeGoto = 0
End If
End Sub
Public Sub writePolarHomeGoto(ByVal StartPos As Integer)
HC.oPersist.WriteIniValue "POLARHOME_GOTO_RA", CStr(gRAEncoderPolarHomeGoto)
HC.oPersist.WriteIniValue "POLARHOME_GOTO_DEC", CStr(gDECEncoderPolarHomeGoto)
Call HC.oPersist.WriteIniValue("POLARHOME_RETICULE_START", CStr(StartPos))
End Sub
Public Sub resetsync()
gRASync01 = 0
gDECSync01 = 0
WriteSyncMap
HC.DxSalbl.Caption = Format$(str(gRASync01), "000000000")
HC.DxSblbl.Caption = Format$(str(gDECSync01), "000000000")
End Sub
Public Sub writeratebarstateHC()
HC.oPersist.WriteIniValue "BAR01_1", CStr(HC.VScrollRASlewRate.value)
HC.oPersist.WriteIniValue "BAR01_2", CStr(HC.VScrollDecSlewRate.value)
HC.oPersist.WriteIniValue "BAR01_3", CStr(HC.HScrollRARate.value)
HC.oPersist.WriteIniValue "BAR01_4", CStr(HC.HScrollDecRate.value)
HC.oPersist.WriteIniValue "BAR01_5", CStr(HC.HScrollRAOride.value)
HC.oPersist.WriteIniValue "BAR01_6", CStr(HC.HScrollDecOride.value)
End Sub
Public Sub readratebarstateHC()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("BAR01_1")
If tmptxt <> "" Then
HC.VScrollRASlewRate.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR01_2")
If tmptxt <> "" Then
HC.VScrollDecSlewRate.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR01_3")
If tmptxt <> "" Then
HC.HScrollRARate.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR01_4")
If tmptxt <> "" Then
HC.HScrollDecRate.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR01_5")
If tmptxt <> "" Then
HC.HScrollRAOride.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR01_6")
If tmptxt <> "" Then
HC.HScrollDecOride.value = val(tmptxt)
End If
End Sub
Public Sub writeratebarstateAlign()
HC.oPersist.WriteIniValue "BAR02_1", CStr(Align.HScroll1.value)
HC.oPersist.WriteIniValue "BAR02_2", CStr(Align.HScroll2.value)
End Sub
Public Sub readratebarstateAlign()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("BAR02_1")
If tmptxt <> "" Then
Align.HScroll1.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR02_2")
If tmptxt <> "" Then
Align.HScroll2.value = val(tmptxt)
End If
End Sub
Public Sub writeratebarstatePad()
HC.oPersist.WriteIniValue "BAR03_1", CStr(Slewpad.VScroll1.value)
HC.oPersist.WriteIniValue "BAR03_2", CStr(Slewpad.VScroll2.value)
End Sub
Public Sub writeOnTop()
HC.oPersist.WriteIniValue "ON_TOP1", CStr(HC.HCOnTop.value)
End Sub
Public Sub readOnTop()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("ON_TOP1")
If tmptxt <> "" Then
HC.HCOnTop.value = val(tmptxt)
End If
End Sub
Public Sub writeAlignCheck1()
Select Case gAlignmentMode
Case 0
' n-star+nearset
HC.oPersist.WriteIniValue "SYNCNSTAR", "0"
Case 1
' n-star - no longer used so force to n-star_nearest
HC.oPersist.WriteIniValue "SYNCNSTAR", "0"
Case 2
' nearest
HC.oPersist.WriteIniValue "SYNCNSTAR", "2"
End Select
End Sub
Public Sub writeAlignCheck2()
HC.oPersist.WriteIniValue "APPENDSYNCNSTAR", CStr(HC.ListSyncMode.ListIndex)
Select Case HC.ListSyncMode.ListIndex
Case 0
' ascom standard
HC.CommandAddPoint.Visible = True
Case 1
' append syncs
HC.CommandAddPoint.Visible = False
End Select
End Sub
Public Sub readAlignCheck()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("SYNCNSTAR")
If tmptxt <> "" Then
Select Case tmptxt
Case "0"
' nstar+nearest
gAlignmentMode = 0
HC.ListAlignMode.ListIndex = 0 ' N-Star+nearest
Case "1"
' nstar - no longer provided!
gAlignmentMode = 0 ' use nstar+nearest insted
HC.ListAlignMode.ListIndex = 0 ' N-Star+nearest
Case "2"
' nearest
gAlignmentMode = 2
HC.ListAlignMode.ListIndex = 1 ' nearest
End Select
Else
gAlignmentMode = 0
HC.ListAlignMode.ListIndex = 0
End If
tmptxt = HC.oPersist.ReadIniValue("APPENDSYNCNSTAR")
Select Case tmptxt
Case "0"
' ascom standard
HC.ListSyncMode.ListIndex = 0
Case "1"
' append syncs
HC.ListSyncMode.ListIndex = 1
Case Else
' default = append syncs
HC.ListSyncMode.ListIndex = 1
' write default to ini file
Call writeAlignCheck2
End Select
tmptxt = HC.oPersist.ReadIniValue("NSTAR_MAXCOMBINATION")
If tmptxt <> "" Then
gMaxCombinationCount = val(tmptxt)
Else
gMaxCombinationCount = MAX_COMBINATION_COUNT
HC.oPersist.WriteIniValue "NSTAR_MAXCOMBINATION", CStr(gMaxCombinationCount)
End If
tmptxt = HC.oPersist.ReadIniValue("ALIGN_PROXIMITY")
If tmptxt <> "" Then
HC.HScrollProximity.value = val(tmptxt)
Else
HC.HScrollProximity.value = 0
Call writeAlignProximity
End If
tmptxt = HC.oPersist.ReadIniValue("ALIGN_SELECTION")
If tmptxt <> "" Then
gPointFilter = val(tmptxt)
Else
gPointFilter = 0
HC.oPersist.WriteIniValue "ALIGN_SELECTION", "0"
End If
HC.ComboActivePoints.ListIndex = gPointFilter
tmptxt = HC.oPersist.ReadIniValue("ALIGN_LOCALTOPIER")
If tmptxt <> "" Then
HC.CheckLocalPier.value = val(tmptxt)
Else
HC.CheckLocalPier.value = 1
HC.oPersist.WriteIniValue "ALIGN_LOCALTOPIER", "1"
End If
End Sub
Public Sub writeAlignProximity()
HC.oPersist.WriteIniValue "ALIGN_PROXIMITY", CStr(HC.HScrollProximity.value)
End Sub
Public Sub readAlignProximity()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("ALIGN_PROXIMITY")
If tmptxt <> "" Then
HC.HScrollProximity.value = val(tmptxt)
Else
HC.HScrollProximity.value = 0
Call writeAlignProximity
End If
CalcPromximityLimits (HC.HScrollProximity.value)
End Sub
Public Sub writeColorDat(a1 As Long, a2 As Long, a3 As Long, b1 As Long, b2 As Long, b3 As Long, F1 As Long)
HC.oPersist.WriteIniValue "FOR_R", CStr(a1)
HC.oPersist.WriteIniValue "FOR_G", CStr(a2)
HC.oPersist.WriteIniValue "FOR_B", CStr(a3)
HC.oPersist.WriteIniValue "BAK_R", CStr(b1)
HC.oPersist.WriteIniValue "BAK_G", CStr(b2)
HC.oPersist.WriteIniValue "BAK_B", CStr(b3)
HC.oPersist.WriteIniValue "FONT_S", CStr(F1)
End Sub
Public Sub readColorDat()
Dim i As Long
Dim j As Long
Dim k As Long
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("FOR_R")
If tmptxt <> "" Then
i = val(tmptxt)
Else
i = &HFF
End If
tmptxt = HC.oPersist.ReadIniValue("FOR_G")
If tmptxt <> "" Then
j = val(tmptxt)
Else
j = &H80
End If
tmptxt = HC.oPersist.ReadIniValue("FOR_B")
If tmptxt <> "" Then
k = val(tmptxt)
Else
k = &H0
End If
i = i And &HFF
j = (j * 256) And &HFF00
k = (k * 65536) And &HFF0000
HC.HCMessage.ForeColor = i + j + k
' HC.HCTextAlign.ForeColor = i + j + k
tmptxt = HC.oPersist.ReadIniValue("BAK_R")
If tmptxt <> "" Then
i = val(tmptxt)
Else
i = &H80
End If
tmptxt = HC.oPersist.ReadIniValue("BAK_G")
If tmptxt <> "" Then
j = val(tmptxt)
Else
j = &H0
End If
tmptxt = HC.oPersist.ReadIniValue("BAK_B")
If tmptxt <> "" Then
k = val(tmptxt)
Else
k = &H0
End If
i = i And &HFF
j = (j * 256) And &HFF00
k = (k * 65536) And &HFF0000
HC.HCMessage.BackColor = i + j + k
' HC.HCTextAlign.BackColor = i + j + k
tmptxt = HC.oPersist.ReadIniValue("FONT_S")
If tmptxt <> "" Then
i = val(tmptxt)
Else
i = 7
End If
HC.HCMessage.FontSize = i
' HC.HCTextAlign.FontSize = i
End Sub
Public Sub readratebarstatePad()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("BAR03_1")
If tmptxt <> "" Then
Slewpad.VScroll1.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("BAR03_2")
If tmptxt <> "" Then
Slewpad.VScroll2.value = val(tmptxt)
End If
End Sub
Public Sub readportrate()
Dim raval As String
Dim decval As String
raval = HC.oPersist.ReadIniValue("AUTOGUIDER_RA")
Select Case raval
Case "x1.00":
eqres = EQ_SetAutoguiderPortRate(0, 3)
HC.RAGuideRateList.ListIndex = 3
Case "x0.75":
eqres = EQ_SetAutoguiderPortRate(0, 2)
HC.RAGuideRateList.ListIndex = 2
Case "x0.50":
eqres = EQ_SetAutoguiderPortRate(0, 1)
HC.RAGuideRateList.ListIndex = 1
Case "x0.25"
eqres = EQ_SetAutoguiderPortRate(0, 0)
HC.RAGuideRateList.ListIndex = 0
Case Else
HC.RAGuideRateList.ListIndex = 4
End Select
decval = HC.oPersist.ReadIniValue("AUTOGUIDER_DEC")
Select Case decval
Case "x1.00":
eqres = EQ_SetAutoguiderPortRate(1, 3)
HC.DECGuideRateList.ListIndex = 3
Case "x0.75":
eqres = EQ_SetAutoguiderPortRate(1, 2)
HC.DECGuideRateList.ListIndex = 2
Case "x0.50":
eqres = EQ_SetAutoguiderPortRate(1, 1)
HC.DECGuideRateList.ListIndex = 1
Case "x0.25"
eqres = EQ_SetAutoguiderPortRate(1, 0)
HC.DECGuideRateList.ListIndex = 0
Case Else
HC.DECGuideRateList.ListIndex = 4
End Select
End Sub
Public Sub writeportrateRa(strRate As String)
HC.oPersist.WriteIniValue "AUTOGUIDER_RA", strRate
End Sub
Public Sub writeportrateDec(strRate As String)
HC.oPersist.WriteIniValue "AUTOGUIDER_DEC", strRate
End Sub
Public Sub writePulseguidepwidth()
HC.oPersist.WriteIniValue "PULSEGUIDE_TIMER_INTERVAL", CStr(HC.PltimerHscroll.value)
End Sub
Public Sub readPulseguidepwidth()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("PULSEGUIDE_TIMER_INTERVAL")
If tmptxt = "" Then
HC.PltimerHscroll.value = 20
HC.Label40.Caption = " 20"
HC.Pulseguide_Timer.Interval = 20
gpl_interval = 20
Else
gpl_interval = val(tmptxt)
If gpl_interval < HC.PltimerHscroll.min Then
gpl_interval = HC.PltimerHscroll.min
Else
If gpl_interval > HC.PltimerHscroll.max Then
gpl_interval = HC.PltimerHscroll.max
End If
End If
HC.PltimerHscroll.value = gpl_interval
HC.Label40.Caption = tmptxt
HC.Pulseguide_Timer.Interval = gpl_interval
End If
tmptxt = HC.oPersist.ReadIniValue("DEC_BACKLASH")
If tmptxt = "" Then
gBacklashDec = 0
Else
gBacklashDec = val(tmptxt)
If gBacklashDec > 2000 Or gBacklashDec < 0 Then
gBacklashDec = 0
End If
End If
HC.HScrollBacklashDec.value = gBacklashDec
HC.LabelBacklashDec.Caption = CStr(gBacklashDec)
End Sub
Public Sub writeRASyncCheckVal()
HC.oPersist.WriteIniValue "AUTOSYNCRA", CStr(HC.CheckRASync.value)
End Sub
Public Sub readRASyncCheckVal()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("AUTOSYNCRA")
If tmptxt = "" Then
HC.CheckRASync.value = 1
Call writeRASyncCheckVal
Else
HC.CheckRASync.value = val(tmptxt)
End If
End Sub
Public Sub writeDriftVal()
HC.oPersist.WriteIniValue "RA_DRIFT_VAL", CStr(gDriftComp)
End Sub
Public Sub readDriftVal()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("RA_DRIFT_VAL")
If tmptxt = "" Then
gDriftComp = 0
HC.DriftScroll.value = 0
HC.Driftlbl.Caption = "0"
Else
gDriftComp = val(tmptxt)
HC.DriftScroll.value = gDriftComp
HC.Driftlbl.Caption = tmptxt
End If
Call EQSetOffsets
End Sub
Public Sub writeAxisRevRA()
HC.oPersist.WriteIniValue "RA_REVERSE", CStr(HC.RA_inv.value)
End Sub
Public Sub writeAxisRevDEC()
HC.oPersist.WriteIniValue "DEC_REVERSE", CStr(HC.DEC_Inv.value)
End Sub
Public Sub readDevelopmentOptions()
Dim tmp As String
Dim ver As Double
If HC.oPersist.ReadIniValue("Advanced") = "1" Then
gAdvanced = 1
HC.Combo3PointAlgorithm.Visible = True
HC.CheckRASync.Visible = True
HC.Label35.Visible = True
HC.CheckLocalPier.Visible = True
HC.FrameAdvanced.Visible = True
HC.FramePGAvanced.Visible = True
HC.LabelSlewLimit.Visible = True
HC.Label31.Visible = True
HC.HScrollSlewLimit.Visible = True
Else
HC.oPersist.WriteIniValue "Advanced", "0"
gAdvanced = 0
HC.Combo3PointAlgorithm.Visible = False
HC.CheckRASync.Visible = False
HC.Label35.Visible = False
HC.CheckLocalPier.Visible = False
HC.FrameAdvanced.Visible = False
HC.FramePGAvanced.Visible = False
HC.LabelSlewLimit.Visible = False
HC.Label31.Visible = False
HC.HScrollSlewLimit.Visible = False
End If
If HC.oPersist.ReadIniValue("POLAR_ALIGNMENT") = "1" Then
gShowPolarAlign = 1
HC.puPolar.Visible = True
Else
HC.oPersist.WriteIniValue "POLAR_ALIGNMENT", "0"
gShowPolarAlign = 0
HC.puPolar.Visible = False
End If
If HC.oPersist.ReadIniValue("3POINT_ALGORITHM") = "1" Then
g3PointAlgorithm = 1
Else
HC.oPersist.WriteIniValue "3POINT_ALGORITHM", "0"
g3PointAlgorithm = 0
End If
HC.Combo3PointAlgorithm.ListIndex = g3PointAlgorithm
tmp = HC.oPersist.ReadIniValue("MAX_GOTO_INTERATIONS")
If tmp <> "" Then
gMaxSlewCount = val(tmp)
Else
HC.oPersist.WriteIniValue "MAX_GOTO_INTERATIONS", "5"
gMaxSlewCount = 5
End If
HC.HScrollSlewRetries.value = gMaxSlewCount
tmp = HC.oPersist.ReadIniValue("GOTO_RESOLUTION")
If tmp <> "" Then
gGotoResolution = val(tmp)
Else
HC.oPersist.WriteIniValue "GOTO_RESOLUTION", "20"
gGotoResolution = 20
End If
HC.HScrollGotoRes.value = gGotoResolution
tmp = HC.oPersist.ReadIniValue("GOTO_RA_COMPENSATE")
If tmp <> "" Then
gRA_Compensate = val(tmp)
Else
HC.oPersist.WriteIniValue "GOTO_RA_COMPENSATE", "40"
gRA_Compensate = 40
End If
HC.HScrollSlewAdjust.value = gRA_Compensate
tmp = HC.oPersist.ReadIniValue("COMMS_ERROR_STOP")
If tmp <> "" Then
gCommErrorStop = val(tmp)
Else
HC.oPersist.WriteIniValue "COMMS_ERROR_STOP", "0"
gCommErrorStop = 0
End If
tmp = HC.oPersist.ReadIniValue("LST_DISPLAY_MODE")
If tmp <> "" Then
gLstDisplayMode = val(tmp)
Else
HC.oPersist.WriteIniValue "LST_DISPLAY_MODE", "0"
gLstDisplayMode = 0
End If
End Sub
Public Sub readAscomCompatibiity()
Dim tmptxt As String
On Error GoTo readerr1
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_SLEWTRACKOFF")
If tmptxt <> "" Then
gAscomCompatibility.SlewWithTrackingOff = CBool(tmptxt)
Else
gAscomCompatibility.SlewWithTrackingOff = True
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SLEWTRACKOFF", CStr(gAscomCompatibility.SlewWithTrackingOff)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_PULSEGUIDE")
If tmptxt <> "" Then
gAscomCompatibility.AllowPulseGuide = CBool(tmptxt)
Else
gAscomCompatibility.AllowPulseGuide = True
HC.oPersist.WriteIniValue "ASCOM_COMPAT_PULSEGUIDE", CStr(gAscomCompatibility.AllowPulseGuide)
End If
If gAscomCompatibility.AllowPulseGuide Then
HC.Frame5.Visible = True
HC.Frame6.Visible = False
Else
HC.Frame6.Visible = True
HC.Frame5.Visible = False
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_EXCEPTIONS")
If tmptxt <> "" Then
gAscomCompatibility.AllowExceptions = CBool(tmptxt)
Else
gAscomCompatibility.AllowExceptions = True
HC.oPersist.WriteIniValue "ASCOM_COMPAT_EXCEPTIONS", CStr(gAscomCompatibility.AllowExceptions)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_PG_EXCEPTIONS")
If tmptxt <> "" Then
gAscomCompatibility.AllowPulseGuideExceptions = CBool(tmptxt)
Else
gAscomCompatibility.AllowPulseGuideExceptions = True
HC.oPersist.WriteIniValue "ASCOM_COMPAT_PG_EXCEPTIONS", CStr(gAscomCompatibility.AllowPulseGuideExceptions)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_BLOCK_PARK")
If tmptxt <> "" Then
gAscomCompatibility.BlockPark = CBool(tmptxt)
Else
gAscomCompatibility.BlockPark = False
HC.oPersist.WriteIniValue "ASCOM_COMPAT_BLOCK_PARK", CStr(gAscomCompatibility.BlockPark)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_SITEWRITES")
If tmptxt <> "" Then
gAscomCompatibility.AllowSiteWrites = CBool(tmptxt)
Else
gAscomCompatibility.AllowSiteWrites = False
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SITEWRITES", CStr(gAscomCompatibility.AllowSiteWrites)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_EPOCH")
If tmptxt <> "" Then
gAscomCompatibility.Epoch = val(tmptxt)
Else
gAscomCompatibility.Epoch = 0
HC.oPersist.WriteIniValue "ASCOM_COMPAT_EPOCH", CStr(gAscomCompatibility.Epoch)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_SOP")
If tmptxt <> "" Then
gAscomCompatibility.SideOfPier = val(tmptxt)
Else
gAscomCompatibility.SideOfPier = 0
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SOP", CStr(gAscomCompatibility.SideOfPier)
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_SWAP_PSOP")
If tmptxt <> "" Then
If tmptxt = "1" Then
gAscomCompatibility.SwapPointingSideOfPier = True
Else
gAscomCompatibility.SwapPointingSideOfPier = False
End If
Else
gAscomCompatibility.SwapPointingSideOfPier = False
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SWAP_PSOP", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_SWAP_SOP")
If tmptxt <> "" Then
If tmptxt = "1" Then
gAscomCompatibility.SwapPhysicalSideOfPier = True
Else
gAscomCompatibility.SwapPhysicalSideOfPier = False
End If
Else
gAscomCompatibility.SwapPhysicalSideOfPier = False
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SWAP_SOP", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("ASCOM_COMPAT_STRICT")
If tmptxt <> "" Then
If tmptxt = "1" Then
gAscomCompatibility.Strict = True
gAscomCompatibility.SideOfPier = 0
Else
gAscomCompatibility.Strict = False
End If
Else
gAscomCompatibility.Strict = False
HC.oPersist.WriteIniValue "ASCOM_COMPAT_STRICT", "0"
gAscomCompatibility.AllowExceptions = True
End If
Exit Sub
readerr1:
gAscomCompatibility.Strict = False
gAscomCompatibility.SlewWithTrackingOff = True
gAscomCompatibility.AllowPulseGuide = True
gAscomCompatibility.AllowExceptions = True
gAscomCompatibility.AllowPulseGuideExceptions = True
gAscomCompatibility.Epoch = 0
gAscomCompatibility.SideOfPier = 0
gAscomCompatibility.BlockPark = False
WriteAscomCompatibiity
End Sub
Public Sub WriteAscomCompatibiity()
If (gAscomCompatibility.Strict) Then
HC.oPersist.WriteIniValue "ASCOM_COMPAT_STRICT", "1"
Else
HC.oPersist.WriteIniValue "ASCOM_COMPAT_STRICT", "0"
End If
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SLEWTRACKOFF", CStr(gAscomCompatibility.SlewWithTrackingOff)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SLEWTRACKOFF", CStr(gAscomCompatibility.SlewWithTrackingOff)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_PULSEGUIDE", CStr(gAscomCompatibility.AllowPulseGuide)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_EXCEPTIONS", CStr(gAscomCompatibility.AllowExceptions)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_PG_EXCEPTIONS", CStr(gAscomCompatibility.AllowPulseGuideExceptions)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_BLOCK_PARK", CStr(gAscomCompatibility.BlockPark)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SITEWRITES", CStr(gAscomCompatibility.AllowSiteWrites)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_EPOCH", CStr(gAscomCompatibility.Epoch)
HC.oPersist.WriteIniValue "ASCOM_COMPAT_SOP", CStr(gAscomCompatibility.SideOfPier)
End Sub
Public Sub readAutoFlipData()
Dim tmptxt As String
On Error GoTo readerr1
tmptxt = HC.oPersist.ReadIniValue("FLIP_AUTO_ALLOWED")
If tmptxt <> "" Then
gAutoFlipAllowed = CBool(tmptxt)
Else
' default to allow slews when not tracking - not ASCOM compliant but is CDC compliant!
gAutoFlipAllowed = False
End If
tmptxt = HC.oPersist.ReadIniValue("FLIP_AUTO_ENABLED")
If tmptxt <> "" Then
gAutoFlipEnabled = CBool(tmptxt)
Else
' default to allow slews when not tracking - not ASCOM compliant but is CDC compliant!
gAutoFlipEnabled = False
End If
Call WriteAutoFlipData
Exit Sub
readerr1:
gAutoFlipEnabled = False
gAutoFlipAllowed = False
Call WriteAutoFlipData
End Sub
Public Sub WriteAutoFlipData()
HC.oPersist.WriteIniValue "FLIP_AUTO_ALLOWED", CStr(gAutoFlipAllowed)
HC.oPersist.WriteIniValue "FLIP_AUTO_ENABLED", CStr(gAutoFlipEnabled)
End Sub
Public Sub readAxisRev()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("RA_REVERSE")
If tmptxt <> "" Then
HC.RA_inv.value = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("DEC_REVERSE")
If tmptxt <> "" Then
HC.DEC_Inv.value = val(tmptxt)
End If
End Sub
Public Sub writePresetSlewRates()
Dim tmptxt As String
Dim key As String
Dim valstr As String
Dim Ini As String
Dim Count As Integer
' set up a file path for the align.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[slewrates]"
Call HC.oPersist.WriteIniValueEx("COUNT", CStr(gPresetSlewRatesCount), key, Ini)
For Count = 1 To gPresetSlewRatesCount
valstr = "RATE_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(gPresetSlewRates(Count)), key, Ini)
Next Count
For Count = 1 To 4
valstr = "RATEBTN_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(gRateButtons(Count)), key, Ini)
Next Count
End Sub
Public Sub readPresetSlewRates()
Dim tmptxt As String
Dim key As String
Dim valstr As String
Dim Ini As String
Dim Count As Integer
Dim DefaultRates(1 To 10) As Integer
DefaultRates(1) = 1
DefaultRates(2) = 8
DefaultRates(3) = 64
DefaultRates(4) = 800
DefaultRates(5) = 0
DefaultRates(6) = 0
DefaultRates(7) = 0
DefaultRates(8) = 0
DefaultRates(9) = 0
DefaultRates(10) = 0
HC.PresetRateCombo.Clear
HC.PresetRate2Combo.Clear
' set up a file path for the align.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[slewrates]"
' read preset count
tmptxt = HC.oPersist.ReadIniValueEx("COUNT", key, Ini)
If tmptxt <> "" Then
gPresetSlewRatesCount = val(tmptxt)
If gPresetSlewRatesCount > 10 Then
gPresetSlewRatesCount = 10
Call HC.oPersist.WriteIniValueEx("COUNT", "10", key, Ini)
End If
Else
gPresetSlewRatesCount = 4
Call HC.oPersist.WriteIniValueEx("COUNT", "4", key, Ini)
End If
For Count = 1 To gPresetSlewRatesCount
valstr = "RATE_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
gPresetSlewRates(Count) = val(tmptxt)
Else
gPresetSlewRates(Count) = DefaultRates(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(gPresetSlewRates(Count)), key, Ini)
End If
' add preset to combo
HC.PresetRateCombo.AddItem (CStr(Count))
HC.PresetRate2Combo.AddItem (CStr(Count))
Next Count
tmptxt = HC.oPersist.ReadIniValueEx("InitalPreset", key, Ini)
If tmptxt <> "" Then
gCurrentRatePreset = val(tmptxt)
If gCurrentRatePreset > 10 Then
gCurrentRatePreset = 1
Call HC.oPersist.WriteIniValueEx("InitalPreset", "1", key, Ini)
End If
Else
gCurrentRatePreset = 1
Call HC.oPersist.WriteIniValueEx("InitalPreset", "1", key, Ini)
End If
HC.PresetRateCombo.ListIndex = gCurrentRatePreset - 1
HC.PresetRate2Combo.ListIndex = gCurrentRatePreset - 1
For Count = 1 To 4
valstr = "RATEBTN_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
gRateButtons(Count) = val(tmptxt)
Else
gRateButtons(Count) = Count
Call HC.oPersist.WriteIniValueEx(valstr, CStr(Count), key, Ini)
End If
Next Count
End Sub
Public Sub readPoleStar()
Dim tmptxt As String
Dim RA As Double
Dim DEC As Double
Dim RA2 As Double
Dim DEC2 As Double
Dim epochnow As Double
'J2000 = RA: 02h31m50.209s DE:+89°15'50.86"
tmptxt = HC.oPersist.ReadIniValue("PoleStarId")
If tmptxt <> "" Then
gPoleStarIdx = val(tmptxt)
If gPoleStarIdx >= HC.ComboPoleStar.ListCount Then
gPoleStarIdx = 0
End If
Else
gPoleStarIdx = 0
End If
Select Case gPoleStarIdx
Case 0
' polaris
RA = 2.53019444444444
DEC = 89.2641666666667
Case 1
' Chi Oct
RA = 18.91286139
DEC = -87.60628056
Case 2
'Tau Oct
RA = 23.46775278
DEC = -87.48219167
Case 3
' Sigma Oct
RA = 21.146498333333
DEC = -88.9547972222
Case Else
tmptxt = HC.oPersist.ReadIniValue("POLE_STAR_J2000RA")
If tmptxt <> "" Then
RA = CDbl(tmptxt)
Else
RA = 2.53061361
HC.oPersist.WriteIniValue "POLE_STAR_J2000RA", CStr(RA)
End If
tmptxt = HC.oPersist.ReadIniValue("POLE_STAR_J2000DEC")
If tmptxt <> "" Then
DEC = CDbl(tmptxt)
Else
DEC = 89.2641278
HC.oPersist.WriteIniValue "POLE_STAR_J2000DEC", CStr(DEC)
End If
End Select
' HC.oPersist.WriteIniValue "POLE_STAR_J2000RA", CStr(RA)
' HC.oPersist.WriteIniValue "POLE_STAR_J2000DEC", CStr(DEC)
tmptxt = HC.oPersist.ReadIniValue("PolarReticuleEpoch")
If tmptxt <> "" Then
gPolarReticuleEpoch = val(tmptxt)
Else
gPolarReticuleEpoch = 2000
HC.oPersist.WriteIniValue "PolarReticuleEpoch", "2000"
End If
HC.ComboPoleStar.ListIndex = gPoleStarIdx
gPoleStarRaJ2000 = RA
gPoleStarDecJ2000 = DEC
RA2 = RA
DEC2 = DEC
epochnow = 2000 + (now_mjd() - J2000) / 365.25
Call Precess(RA2, DEC2, 2000, epochnow)
gPoleStarRa = RA2
gPoleStarDec = DEC2
Call Precess(RA, DEC, 2000, gPolarReticuleEpoch)
gPoleStarReticuleDec = DEC
End Sub
Public Sub writePoleStar()
Dim tmptxt As String
Dim RA As Double
Dim DEC As Double
Dim epochnow As Double
HC.oPersist.WriteIniValue "PoleStarId", CStr(gPoleStarIdx)
Select Case gPoleStarIdx
Case 0
' polaris
RA = 2.53019444444444 ' 2.53061361 ' 2.53019444444444
DEC = 89.2641666666667 ' 89.2641278 ' 89.2641666666667
Case 1
' Chi Oct
RA = 18.91286139
DEC = -87.60628056
Case 2
'Tau Oct
RA = 23.46775278
DEC = -87.48219167
Case Else
tmptxt = HC.oPersist.ReadIniValue("POLE_STAR_J2000RA")
If tmptxt <> "" Then
RA = CDbl(tmptxt)
Else
RA = 2.53061361
HC.oPersist.WriteIniValue "POLE_STAR_J2000RA", CStr(RA)
End If
tmptxt = HC.oPersist.ReadIniValue("POLE_STAR_J2000DEC")
If tmptxt <> "" Then
DEC = CDbl(tmptxt)
Else
DEC = 89.2641278
HC.oPersist.WriteIniValue "POLE_STAR_J2000DEC", CStr(DEC)
End If
End Select
' HC.oPersist.WriteIniValue "POLE_STAR_J2000RA", CStr(RA)
' HC.oPersist.WriteIniValue "POLE_STAR_J2000DEC", CStr(DEC)
epochnow = 2000 + (now_mjd() - J2000) / 365.25
Call Precess(RA, DEC, 2000, epochnow)
gPoleStarRa = RA
gPoleStarDec = DEC
End Sub
Public Sub readExtendedMountFunctions()
Dim tmptxt As String
On Error Resume Next
HC.Label5(3).Caption = printhex(CDbl(gMount_Features))
If gMount_Features And &H10000 Then
tmptxt = HC.oPersist.ReadIniValue("POLAR_SCOPE_BRIGHTNESS")
If tmptxt <> "" Then
HC.HScrollPolarLed.value = val(tmptxt)
Else
Call HC.oPersist.WriteIniValue("POLAR_SCOPE_BRIGHTNESS", "125")
HC.HScrollPolarLed.value = 125
End If
' write to mount.
Call EQ_WP(0, 10006, HC.HScrollPolarLed.value)
End If
If gMount_Features And &H30 Then
tmptxt = HC.oPersist.ReadIniValue("ENABLE_HW_ENCODERS")
If tmptxt = "0" Then
HC.Combo1.ListIndex = 0
Else
HC.Combo1.ListIndex = 1
Call HC.oPersist.WriteIniValue("ENABLE_HW_ENCODERS", "1")
End If
End If
End Sub
Public Sub ShowExtendedMountFunctions()
HC.Label5(3).Caption = printhex(CDbl(gMount_Features))
If gMount_Features And &H10000 Then
HC.HScrollPolarLed.Visible = True
HC.Label5(0).Visible = True
HC.Label5(1).Visible = True
HC.Command1(3).Visible = True
Else
HC.HScrollPolarLed.Visible = False
HC.Label5(0).Visible = False
HC.Label5(1).Visible = False
HC.Command1(3).Visible = False
End If
If gMount_Features And &H30 Then
HC.Combo1.Visible = True
Else
HC.Combo1.Visible = False
End If
' PPEC
If gMount_Features And &H4 Then
HC.Check1(0).Visible = True
HC.Check1(1).Visible = True
HC.Command1(0).Visible = True
HC.Label5(4).Visible = True
Else
HC.Command1(0).Visible = False
HC.Check1(0).Visible = False
HC.Check1(1).Visible = False
HC.Label5(4).Visible = False
End If
' SNAP1
If gMount_Features And &H1 Then
HC.Check1(2).Visible = True
Else
HC.Check1(2).Visible = False
End If
' SNAP3
If gMount_Features And &H2 Then
HC.Check1(3).Visible = True
Else
HC.Check1(3).Visible = False
End If
End Sub
Public Function GetEmulRA() As Double
Dim emulinc As Double
' Compute for elapsed Time
If gTrackingStatus = 1 Then
gCurrent_time = EQnow_lst_norange()
If gLast_time = 0 Then gCurrent_time = 0.000002
If gEmulRA_Init = 0 Then gEmulRA_Init = gEmulRA
If gLast_time > gCurrent_time Then ' Counter wrap around ?
gLast_time = EQnow_lst_norange()
gCurrent_time = gLast_time
gEmulRA_Init = gEmulRA
End If
' Compute Elapste stepper count based on Elapsed Local Sidreal time (PC time)
emulinc = gEMUL_RATE2 * (gCurrent_time - gLast_time)
' If gRA_LastRate = 0 Then
' emulinc = gEMUL_RATE2 * (gCurrent_time - gLast_time)
' Else ' PEC tracking
' emulinc = (gRightAscensionRate / gARCSECSTEP) * (gCurrent_time - gLast_time)
' emulinc = (gCurrent_time - gLast_time) * gTot_RA / (1296000 / gRightAscensionRate)
' End If
If gHemisphere = 0 Then
GetEmulRA = gEmulRA_Init + emulinc
Else
GetEmulRA = gEmulRA_Init - emulinc
End If
Else
GetEmulRA = gEmulRA
End If
End Function
Public Function GetEmulRA_EQ() As Double
Dim emulinc As Double
Dim tmpEmulRA As Double
Dim tmpgRA_Hours As Double
Dim tmpgRA_Encoder As Double
Dim tmpgDec_Encoder As Double
Dim tRa As Double
Dim tmpgDec_DegNoAdjust As Double
Dim tmpcoord As Coordt
'Compute for elapsed Time
If gTrackingStatus = 1 Then
gCurrent_time = EQnow_lst_norange()
If gLast_time = 0 Then gCurrent_time = 0.000002
If gEmulRA_Init = 0 Then gEmulRA_Init = gEmulRA
If gLast_time > gCurrent_time Then ' Counter wrap around ?
gLast_time = EQnow_lst_norange()
gCurrent_time = gLast_time
gEmulRA_Init = gEmulRA
End If
' Compute Elapste stepper count based on Elapsed Local Sidreal time (PC time)
emulinc = gEMUL_RATE2 * (gCurrent_time - gLast_time)
' If gRA_LastRate = 0 Then
' emulinc = gEMUL_RATE2 * (gCurrent_time - gLast_time)
' Else ' PEC tracking
' emulinc = (gRightAscensionRate / gARCSECSTEP) * (gCurrent_time - gLast_time)
' emulinc = (gCurrent_time - gLast_time) * gTot_RA / (1296000 / gRightAscensionRate)
' End If
If gHemisphere = 0 Then
tmpEmulRA = gEmulRA_Init + emulinc
Else
tmpEmulRA = gEmulRA_Init - emulinc
End If
Else
tmpEmulRA = gEmulRA
End If
If gThreeStarEnable = False Then
tmpgRA_Encoder = Delta_RA_Map(tmpEmulRA)
tmpgDec_Encoder = Delta_DEC_Map(gEmulDEC)
Else
Select Case gAlignmentMode
Case 2
' nearest
tmpcoord = DeltaSync_Matrix_Map(tmpEmulRA, gEmulDEC)
tmpgRA_Encoder = tmpcoord.x
tmpgDec_Encoder = tmpcoord.Y
Case 1
' n-star+nearest
tmpcoord = Delta_Matrix_Reverse_Map(tmpEmulRA, gEmulDEC)
tmpgRA_Encoder = tmpcoord.x
tmpgDec_Encoder = tmpcoord.Y
Case Else
tmpcoord = Delta_Matrix_Reverse_Map(tmpEmulRA, gEmulDEC)
tmpgRA_Encoder = tmpcoord.x
tmpgDec_Encoder = tmpcoord.Y
If tmpcoord.F = 0 Then
tmpcoord = DeltaSync_Matrix_Map(tmpEmulRA, gEmulDEC)
tmpgRA_Encoder = tmpcoord.x
tmpgDec_Encoder = tmpcoord.Y
End If
End Select
End If
If (tmpgRA_Encoder < &H1000000) Then tmpgRA_Hours = Get_EncoderHours(gRAEncoder_Zero_pos, tmpgRA_Encoder, gTot_RA, gHemisphere)
tRa = EQnow_lst(gLongitude * DEG_RAD) + tmpgRA_Hours
tmpgDec_DegNoAdjust = Get_EncoderDegrees(gDECEncoder_Zero_pos, tmpgDec_Encoder, gTot_DEC, gHemisphere)
If gHemisphere = 0 Then
If (tmpgDec_DegNoAdjust > 90) And (tmpgDec_DegNoAdjust <= 270) Then tRa = tRa - 12
Else
If (tmpgDec_DegNoAdjust <= 90) Or (tmpgDec_DegNoAdjust > 270) Then tRa = tRa + 12
End If
GetEmulRA_EQ = Range24(tRa)
End Function
' checks that a guiding rate commanded is in range
Public Function RateIsInRange(ByVal rate As Double, ByVal Rates As Rates) As Boolean
Dim i As Integer
Dim r As rate
For i = 1 To Rates.Count
Set r = Rates.Item(i)
If Abs(rate) > r.Maximum Or Abs(rate) < r.Minimum Then
RateIsInRange = False
Exit Function
End If
Next i
RateIsInRange = True
End Function
Public Function EQGP(ByVal motor_id As Long, ByVal p_id As Long) As Long
Dim ret As Long
Select Case p_id
Case 10006
' get worm steps from ini file this way we can easilly simulate heq5
If gCustomMount = 1 Then
Select Case motor_id
Case 0
ret = gCustomRAWormSteps
Case 1
ret = gCustomDECWormSteps
Case Else
ret = EQ_GP(motor_id, p_id)
End Select
Else
ret = EQ_GP(motor_id, p_id)
End If
Case Else
ret = EQ_GP(motor_id, p_id)
End Select
EQGP = ret
End Function
Public Sub ReadFormPosition()
Dim tmptxt As String
Dim tmp As Single
Dim DesktopLeft As Long
Dim DesktopTop As Long
Dim DesktopWidth As Long
Dim DesktopHeight As Long
Dim DesktopRight As Long
Dim DesktopBottom As Long
If GetSystemMetrics(SM_CMONITORS) = 0 Then
'No multi monitor
DesktopLeft = 0
DesktopRight = Screen.width
DesktopTop = 0
DesktopBottom = Screen.Height
Else
DesktopLeft = GetSystemMetrics(SM_XVIRTUALSCREEN)
DesktopLeft = DesktopLeft * Screen.TwipsPerPixelX
DesktopTop = GetSystemMetrics(SM_YVIRTUALSCREEN)
DesktopTop = DesktopTop * Screen.TwipsPerPixelY
DesktopWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN) * Screen.TwipsPerPixelX
DesktopHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN) * Screen.TwipsPerPixelY
DesktopRight = DesktopLeft + DesktopWidth
DesktopBottom = DesktopTop + DesktopHeight
End If
tmptxt = HC.oPersist.ReadIniValue("form_height")
If tmptxt = "" Then
Call HC.oPersist.WriteIniValue("form_height", HC.Height)
Else
HC.Height = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValue("form_top")
If tmptxt = "" Then
Call HC.oPersist.WriteIniValue("form_top", 0)
HC.Top = 0
Else
tmp = val(tmptxt)
If tmp < DesktopTop Then tmp = DesktopTop
If tmp > DesktopBottom - HC.Height Then tmp = DesktopBottom - HC.Height
HC.Top = tmp
End If
tmptxt = HC.oPersist.ReadIniValue("form_left")
If tmptxt = "" Then
Call HC.oPersist.WriteIniValue("form_left", 0)
HC.Left = 0
Else
tmp = val(tmptxt)
If tmp < DesktopLeft Then tmp = DesktopLeft
If tmp > DesktopRight - HC.width Then tmp = DesktopRight - HC.width
HC.Left = tmp
End If
End Sub
Public Sub WriteFormPosition()
Call HC.oPersist.WriteIniValue("form_height", HC.Height)
Call HC.oPersist.WriteIniValue("form_top", HC.Top)
Call HC.oPersist.WriteIniValue("form_left", HC.Left)
End Sub
Public Sub ResetFormPosition()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("form_dleft")
HC.Left = val(tmptxt)
HC.Top = val(HC.oPersist.ReadIniValue("form_dtop"))
HC.Height = val(HC.oPersist.ReadIniValue("form_dheight"))
Call WriteFormPosition
End Sub
Public Sub GetDllVer()
Dim dllver As Long
Dim tmpstr As String
dllver = EQ_DriverVersion()
tmpstr = Hex$((dllver And &HF000) / 4096 And &HF) + Hex$((dllver And &HF00) / 256 And &HF)
tmpstr = tmpstr & "." & Hex$((dllver And &HF0) / 16 And &HF) + Hex$(dllver And &HF)
' tmpstr = Hex$((dllver And &HF00000) / 1048576 And &HF) + Hex$((dllver And &HF0000) / 65536 And &HF)
gDllVer = val(tmpstr)
End Sub
' Interceptor functions for different mount types
Public Function EQGetMotorValues(ByVal motor_id As Long) As Long
Dim ret As Long
On Error GoTo errhandle
ret = EQ_GetMotorValues(motor_id)
EQGetMotorValues = ret
Exit Function
errhandle:
EQGetMotorValues = EQ_INVALID
End Function
Public Function EQSetMotorValues(ByVal motor_id As Long, motor_val As Long) As Long
Dim ret As Long
On Error GoTo errhandle
ret = EQ_SetMotorValues(motor_id, motor_val)
EQSetMotorValues = ret
Exit Function
errhandle:
EQSetMotorValues = EQ_INVALID
End Function
Public Function EQStartMoveMotor(ByVal motor_id As Long, ByVal hemisphere As Long, ByVal direction As Long, ByVal Steps As Long, ByVal stepslowdown As Long) As Long
Dim ret As Long
ret = EQ_StartMoveMotor(motor_id, hemisphere, direction, Steps, stepslowdown)
EQStartMoveMotor = ret
End Function
Public Sub EQSetOffsets()
If gCustomMount = 0 Then
' apply drift compenstation only to standard mounts
eqres = EQ_SetOffset(0, gDriftComp * -1)
eqres = EQ_SetOffset(1, 0)
Else
' for customised mounts apply tracking offsets
eqres = EQ_SetOffset(0, (gCustomTrackingOffsetRA + gDriftComp) * -1)
eqres = EQ_SetOffset(1, (gCustomTrackingOffsetDEC) * -1)
End If
End Sub
Public Function StripPath(str As String) As String
Dim i As Integer
i = InStrRev(str, "\")
StripPath = Right$(str, Len(str) - i)
End Function
Public Function GetPath(str As String) As String
Dim i As Integer
i = InStrRev(str, "\")
GetPath = Left$(str, i)
End Function
Public Function ByteArrayToString(bytArray() As Byte) As String
Dim sAns As String
Dim iPos As Integer
sAns = StrConv(bytArray, vbUnicode)
iPos = InStr(sAns, Chr(0))
If iPos > 0 Then
sAns = Left(sAns, iPos - 1)
End If
ByteArrayToString = sAns
End Function
' at 4124 Done code part. Lines - 1 Analysing setupfrm.frm Done form part, 70 controls found Done code part. Lines - 1569 Analysing align.frm Done form part, 23 controls found Done code part. Lines - 729 Analysing eqcontrl.basError parsing line 'Attribute VB_Name = "EQCONTRL"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 24-Oct-03 rcs Initial edit for EQ Mount Driver Function Prototype
' 29-Jan-07 rcs Added functions for ALT/AZ tracking
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
'///// Conection-Initalization Functions /////
'
' Function name : EQ_Init()
' Description : Connect to the EQ Controller via Serial and initialize the stepper board
' Return type : DOUBLE
' 000 - Success
' 001 - COM Port Not available
' 002 - COM Port already Open
' 003 - COM Timeout Error
' 005 - Mount Initialized on using non-standard parameters
' 010 - Cannot execute command at the current stepper controller state
' 999 - Invalid parameter
' Argument : STRING COMPORT Name
' Argument : DOUBLE baud - Baud Rate
' Argument : DOUBLE timeout - COMPORT Timeout (1 - 50000)
' Argument : DOUBLE retry - COMPORT Retry (0 - 100)
'
Public Declare Function EQ_Init Lib "EQCONTRL" (ByVal COMPORT As String, ByVal baud As Long, ByVal timeout As Long, ByVal retry As Long) As Long
'
' Function name : EQ_End()
' Description : Close the COM Port and end EQ Connection
' Return type : DOUBLE
' 00 - Success
' 01 - COM Port Not Openavailable
'
Public Declare Function EQ_End Lib "EQContrl.dll" () As Long
'
' Function name : EQ_InitMotors()
' Description : Initialize RA/DEC Motors and activate Motor Driver Coils
' Return type : DOUBLE
' 000 - Success
' 001 - COM PORT Not available
' 003 - COM Timeout Error
' 006 - RA Motor still running
' 007 - DEC Motor still running
' 008 - Error Initializing RA Motor
' 009 - Error Initilizing DEC Motor
' 010 - Cannot execute command at the current stepper controller state
' Argument : DOUBLE RA_val Initial ra microstep counter value
' Argument : DOUBLE DEC_val Initial dec microstep counter value
'
Public Declare Function EQ_InitMotors Lib "EQCONTRL" (ByVal RA As Long, ByVal DEC As Long) As Long
'///// Motor Status Functions /////
'
' Function name : EQ_GetMotorValues()
' Description : Get RA/DEC Motor microstep counts
' Return type : Double - Stepper Counter Values
' 0 - 16777215 Valid Count Values
' 0x1000000 - Mount Not available
' 0x1000005 - COM TIMEOUT
' 0x10000FF - Illegal Mount reply
' 0x3000000 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
'
Public Declare Function EQ_GetMotorValues Lib "EQCONTRL" (ByVal motor_id As Long) As Long
'
' Function name : EQ_GetMotorStatus()
' Description : Get RA/DEC Stepper Motor Status
' Return type : DOUBLE
' 128 - Motor not rotating, Teeth at front contact
' 144 - Motor rotating, Teeth at front contact
' 160 - Motor not rotating, Teeth at rear contact
' 176 - Motor rotating, Teeth at rear contact
' 200 - Motor not initialized
' 001 - COM Port Not available
' 003 - COM Timeout Error
' 999 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
'
Public Declare Function EQ_GetMotorStatus Lib "EQCONTRL" (ByVal motor_id As Long) As Long
'
' Function name : EQ_SeTMotorValues()
' Description : Sets RA/DEC Motor microstep counters (pseudo encoder position)
' Return type : DOUBLE - Stepper Counter Values
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE motor_val
' 0 - 16777215 Valid Count Values
'
Public Declare Function EQ_SetMotorValues Lib "EQCONTRL" (ByVal motor_id As Long, ByVal motor_val As Long) As Long
'///// Motor Movement Functions /////
'
' Function name : EQ_StartMoveMotor
' Description : Slew RA/DEC Motor based on provided microstep counts
' Return type : DOUBLE
' 000 - Success
' 001 - COM PORT Not available
' 003 - COM Timeout Error
' 004 - Motor still busy, aborted
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE hemisphere
' 00 - North
' 01 - South
' Argument : DOUBLE direction
' 00 - Forward(+)
' 01 - Reverse(-)
' Argument : DOUBLE steps count
' Argument : DOUBLE motor de-acceleration point (set between 50% t0 90% of total steps)
'
Public Declare Function EQ_StartMoveMotor Lib "EQCONTRL" (ByVal motor_id As Long, ByVal hemisphere As Long, ByVal direction As Long, ByVal Steps As Long, ByVal stepslowdown As Long) As Long
'
' Function name : EQ_Slew()
' Description : Slew RA/DEC Motor based on given rate
' Return type : DOUBLE
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 004 - Motor still busy
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : INTEGER direction
' 00 - Forward(+)
' 01 - Reverse(-)
' Argument : INTEGER rate
' 1-800 of Sidreal Rate
'
Public Declare Function EQ_Slew Lib "EQCONTRL" (ByVal motor_id As Long, ByVal hemisphere As Long, ByVal direction As Long, ByVal rate As Long) As Long
'
' Function name : EQ_StartRATrack()
' Description : Track or rotate RA/DEC Stepper Motors at the specified rate
' Return type : DOUBLE
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
' Argument : DOUBLE trackrate
' 00 - Sidreal
' 01 - Lunar
' 02 - Solar
' Argument : DOUBLE hemisphere
' 00 - North
' 01 - South
' Argument : DOUBLE direction
' 00 - Forward(+)
' 01 - Reverse(-)
'
Public Declare Function EQ_StartRATrack Lib "EQCONTRL" (ByVal trackrate As Long, ByVal hemisphere As Long, ByVal direction As Long) As Long
'
' Function name : EQ_SendGuideRate()
' Description : Adjust the RA/DEC rotation trackrate based on a given speed adjustment rate
' Return type : int
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 004 - Motor still busy
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
'
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE trackrate
' 00 - Sidreal
' 01 - Lunar
' 02 - Solar
' Argument : DOUBLE guiderate
' 00 - No Change
' 01 - 10%
' 02 - 20%
' 03 - 30%
' 04 - 40%
' 05 - 50%
' 06 - 60%
' 07 - 70%
' 08 - 80%
' 09 - 90%
' Argument : DOUBLE guidedir
' 00 - Positive
' 01 - Negative
' Argument : DOUBLE hemisphere (used for DEC Motor control)
' 00 - North
' 01 - South
' Argument : DOUBLE direction (used for DEC Motor control)
' 00 - Forward(+)
' 01 - Reverse(-)
'
Public Declare Function EQ_SendGuideRate Lib "EQCONTRL" (ByVal motor_id As Long, ByVal trackrate As Long, ByVal guiderate As Long, ByVal guidedir As Long, ByVal hemisphere As Long, ByVal direction As Long) As Long
'
' Function name : EQ_SendCustomTrackRate()
' Description : Adjust the RA/DEC rotation trackrate based on a given speed adjustment offset
' Return type : DOUBLE
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 004 - Motor still busy
' 010 - Cannot Execute command at the current state
' 011 - Motor not initialized
' 999 - Invalid Parameter
'
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE trackrate
' 00 - Sidreal
' 01 - Lunar
' 02 - Solar
' Argument : DOUBLE trackoffset
' 0 - 300
' Argument : DOUBLE trackdir
' 00 - Positive
' 01 - Negative
' Argument : DOUBLE hemisphere (used for DEC Motor)
' 00 - North
' 01 - South
' Argument : DOUBLE direction (used for DEC Motor)
' 00 - Forward(+)
' 01 - Reverse(-)
'
Public Declare Function EQ_SendCustomTrackRate Lib "EQCONTRL" (ByVal motor_id As Long, ByVal trackrate As Long, ByVal trackoffset As Long, ByVal trackdir As Long, ByVal hemisphere As Long, ByVal direction As Long) As Long
'
' Function name : EQ_SetCustomTrackRate()
' Description : Adjust the RA/DEC rotation trackrate based on a given speed adjustment offset
' Return type : DOUBLE
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 004 - Motor still busy
' 010 - Cannot Execute command at the current state
' 011 - Motor not initialized
' 999 - Invalid Parameter
'
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE trackmode
' 01 - Initial
' 00 - Update
' Argument : DOUBLE trackoffset
' Argument : DOUBLE trackbase
' 00 - LowSpeed
' Argument : DOUBLE hemisphere
' 00 - North
' 01 - South
' Argument : DOUBLE direction
' 00 - Forward(+)
' 01 - Reverse(-)
'
Public Declare Function EQ_SetCustomTrackRate Lib "EQCONTRL" (ByVal motor_id As Long, ByVal trackmode As Long, ByVal trackoffset As Long, ByVal trackbase As Long, ByVal hemisphere As Long, ByVal direction As Long) As Long
'
' Function name : EQ_MotorStop()
' Description : Stop RA/DEC Motor
' Return type : DOUBLE
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 010 - Cannot execute command at the current stepper controller state
' 011 - Motor not initialized
' 999 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
' 02 - RA & DEC
'
Public Declare Function EQ_MotorStop Lib "EQCONTRL" (ByVal value As Long) As Long
'
' Function name : EQ_SetAutoguiderPortRate()
' Description : Sets RA/DEC Autoguideport rate
' Return type : DOUBLE - Stepper Counter Values
' 000 - Success
' 001 - Comport Not available
' 003 - COM Timeout Error
' 999 - Invalid Parameter
' Argument : motor_id
' 00 - RA Motor
' 01 - DEC Motor
' Argument : DOUBLE guideportrate
' 00 - 0.25x
' 01 - 0.50x
' 02 - 0.75x
' 03 - 1.00x
'
Public Declare Function EQ_SetAutoguiderPortRate Lib "EQCONTRL" (ByVal motor_id As Long, ByVal guideportrate As Long) As Long
' Function name : EQ_GetTotal360microstep()
' Description : Get RA/DEC Motor Total 360 degree microstep counts
' Return type : Double - Stepper Counter Values
' 0 - 16777215 Valid Count Values
' 0x1000000 - Mount Not available
' 0x3000000 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
'
Public Declare Function EQ_GetTotal360microstep Lib "EQCONTRL" (ByVal value As Long) As Long
' Function name : EQ_GetMountVersion()
' Description : Get Mount's Firmware version
' Return type : Double - Mount's Firmware Version
'
' 0x1000000 - Mount Not available
'
Public Declare Function EQ_GetMountVersion Lib "EQCONTRL" () As Long
' Function name : EQ_GetMountStatus()
' Description : Get Mount's Firmware version
' Return type : Double - Mount Status
'
' 000 - Not Connected
' 001 - Connected
'
Public Declare Function EQ_GetMountStatus Lib "EQCONTRL" () As Long
' Function name : EQ_DriverVersion()
' Description : Get Drivr Version
' Return type : Double - Driver Version
'
Public Declare Function EQ_DriverVersion Lib "EQCONTRL" () As Long
' Function name : EQ_GP()
' Description : Get Mount Parameters
' Return type : Double - parameter value
Public Declare Function EQ_GP Lib "EQCONTRL" (ByVal motor_id As Long, ByVal p_id As Long) As Long
' Function name : EQ_WP()
' Description : write parameter
' Parameter : value
' Return type : error code
Public Declare Function EQ_WP Lib "EQContrl.dll" (ByVal motor_id As Long, ByVal p_id As Long, ByVal value As Long) As Long
Public Declare Function EQ_SetOffset Lib "EQCONTRL" (ByVal motor_id As Long, ByVal doffset As Long) As Long
' Function name : EQ_SetMountType
' Description : Sets Mount protocol tpye
' Return type : 0
Public Declare Function EQ_SetMountType Lib "EQCONTRL" (ByVal motor_type As Long) As Long
' Function name : EQ_WriteByte
' Description : write a byte out of the serial port
' Return type : error code
Public Declare Function EQ_WriteByte Lib "EQContrl.dll" (ByVal bData As Byte) As Long
' Function name : EQ_SendMountCommand
' Description : send a mount command
' Return type : error code
Public Declare Function EQ_SendMountCommand Lib "EQContrl.dll" (ByVal motor_id As Long, ByVal command As Byte, ByVal params As Long, ByVal Count As Long) As Long
' Function name : EQ_QueryMount
' Description : send a string to the mount and get respnse back
' Return type : error code
Public Declare Function EQ_QueryMount Lib "EQCONTRL" (ByVal ptx As Long, ByVal prx As Long, ByVal sz As Long) As Long
' Function name : EQCom::EQ_DebugLog
' Description : Control of debug logging to file
' param BYTE* : pointer to file name
' param BYTE* : pointer to comment
' param DWORD : Operation (stop=0; start=1; append=2)
' return DWORD : DLL Return Code
' - DLL_SUCCESS 000 Success
' - DLL_GENERALERROR 012 Error
' - DLL_BADPARAM 999 bad parmComport timeout
Public Declare Function EQ_DebugLog Lib "EQCONTRL" (ByVal FileName As String, ByVal comment As String, ByVal operation As Long) As Long
'/////////////////////////////////////////////////////////////////////////////////////
'/** \brief Function name : EQCom::EQ_SetCustomTrackRate()
' * \brief Description : Guiderate activate
' * \param DWORD : motor_id (0 RA, 1 DEC)
' * \param DOUBLE : rate arcsec/sec
' * \param DWORD : hemisphere (0 NORTHERN, 1 SOUTHERN)
' * \param DWORD : direction (0 FORWARD, 1 REVERSE)
' * \return DWORD : DLL Return Code
' *
' * - DLL_SUCCESS 000 Success
' * - DLL_NOCOMPORT 001 Comport Not available
' * - DLL_COMERROR 003 COM Timeout Error
' * - DLL_MOTORBUSY 004 Motor still busy
' * - DLL_NONSTANDARD 005 Mount Initialized on non-standard parameters
' * - DLL_MOUNTBUSY 010 Cannot execute command at the current state
' * - DLL_MOTORERROR 011 Motor not initialized
' * - DLL_MOTORINACTIVE 200 Motor coils not active
' * - DLL_BADPARAM 999 Invalid parameter
' */
Public Declare Function EQ_SetAxisRate Lib "EQCONTRL" (ByVal motor_id As Long, ByVal rate As Double, hemisphere As Long, direction As Long) As Long
Public Function EQ_GetMountFeatures() As Long
Dim res As Long
res = EQ_GP(0, 10009)
If res <> 999 Then
EQ_GetMountFeatures = res
Else
EQ_GetMountFeatures = 0
End If
End Function
' at 4126 Done code part. Lines - 1 Analysing slewpad.frm Done form part, 15 controls found Done code part. Lines - 622 Analysing mousewheel.basError parsing line 'Attribute VB_Name = "Mousewheel"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' Mousewheel.bas - Mousewheel Module for slewpad
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 20-Nov-06 rcs Initial edit for EQ Mount Driver Function Prototype
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
' Store WndProcs
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
' Hooking
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
' Position Checking
Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private Const CB_GETDROPPEDSTATE = &H157
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Check Messages
' ================================================
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
Dim Xpos As Long
Dim Ypos As Long
Dim fFrm As Form
Select Case Lmsg
Case WM_MOUSEWHEEL
MouseKeys = wParam And 65535
Rotation = wParam / 65536
Xpos = lParam And 65535
Ypos = lParam / 65536
Set fFrm = GetForm(Lwnd)
If fFrm Is Nothing Then
' it's not a form
If Not IsOver(Lwnd, Xpos, Ypos) And IsOver(GetParent(Lwnd), Xpos, Ypos) Then
' it's not over the control and is over the form,
' so fire mousewheel on form (if it's not a dropped down combo)
If SendMessage(Lwnd, CB_GETDROPPEDSTATE, 0&, 0&) <> 1 Then
GetForm(GetParent(Lwnd)).Mousewheel MouseKeys, Rotation, Xpos, Ypos
Exit Function ' Discard scroll message to control
End If
End If
Else
' it's a form so fire mousewheel
If IsOver(fFrm.hWnd, Xpos, Ypos) Then fFrm.Mousewheel MouseKeys, Rotation, Xpos, Ypos
End If
End Select
WindowProc = CallWindowProc(GetProp(Lwnd, "PrevWndProc"), Lwnd, Lmsg, wParam, lParam)
End Function
' Hook / UnHook
' ================================================
Public Sub WheelHook(ByVal hWnd As Long)
On Error Resume Next
SetProp hWnd, "PrevWndProc", SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook(ByVal hWnd As Long)
On Error Resume Next
SetWindowLong hWnd, GWL_WNDPROC, GetProp(hWnd, "PrevWndProc")
RemoveProp hWnd, "PrevWndProc"
End Sub
' Window Checks
' ================================================
Public Function IsOver(ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long) As Boolean
Dim rectCtl As RECT
GetWindowRect hWnd, rectCtl
With rectCtl
IsOver = (lX >= .Left And lX <= .Right And lY >= .Top And lY <= .Bottom)
End With
End Function
Private Function GetForm(ByVal hWnd As Long) As Form
For Each GetForm In Forms
If GetForm.hWnd = hWnd Then Exit Function
Next GetForm
Set GetForm = Nothing
End Function
' at 4128 Done code part. Lines - 1 Analysing gpssetup.frmUnknown class->mscomm Done form part, 46 controls found Done code part. Lines - 1212 Analysing eqmodnmea.cls Done code part. Lines - 319 Analysing jstickkbrd.basError parsing line 'Attribute VB_Name = "JStickKbrd"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' JStickKbrd.bas - Keyboard/Joystick functions for EQMOD ASCOM Driver
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 17-Dec-06 rcs Initial edit for EQ Mount Driver Function Prototype
' 09-Jun-07 rcs Fixed bug DPAD E-W Reversal
' 25-Jul-07 cs User defined joystick button assignments
' 29-Jul-07 cs Joystick Caibration save/load; Slew presets added.
' 30-Jul-07 cs Alignment end button handling
' 31-Jul-07 cs Fixed rate buttons handling
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFOEX) As Long
Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS1, ByVal uSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public gJoyTimerFlag As Boolean
Public gJoyTimerFlag2 As Boolean
Public gSpiralTimerFlag As Boolean
Public gParkTimerFlag As Boolean
Public gdwXpos As Long
Public gdwYpos As Long
Public gdwZpos As Long
Public gdwRpos As Long
Public gdwButtons As Long
Public gdwPov As Long
Public gZoneX As Integer
Public gZoneY As Integer
Public gEQjbuttons As Long
Public gPrevCode As Long
Public SyncPressCount As Integer
Public PollCount As Integer
Public gSwapXY As Integer
Public BTN_STARTSIDREAL As Long
Public BTN_EMERGENCYSTOP As Long
Public BTN_SPIRAL As Long
Public BTN_RARATEINC As Long
Public BTN_DECRATEINC As Long
Public BTN_RARATEDEC As Long
Public BTN_DECRATEDEC As Long
Public BTN_HOMEPARK As Long
Public BTN_USERPARK As Long
Public BTN_ALIGNACCEPT As Long
Public BTN_ALIGNCANCEL As Long
Public BTN_ALIGNEND As Long
Public BTN_UNPARK As Long
Public BTN_EAST As Long
Public BTN_WEST As Long
Public BTN_NORTH As Long
Public BTN_SOUTH As Long
Public BTN_RAREVERSE As Long
Public BTN_DECREVERSE As Long
Public BTN_CUSTOMTRACKSTART As Long
Public BTN_CURRENTPARK As Long
Public BTN_STARTSOLAR As Long
Public BTN_STARTLUNAR As Long
Public BTN_INCRATEPRESET As Long
Public BTN_DECRATEPRESET As Long
Public BTN_RATE1 As Long
Public BTN_RATE2 As Long
Public BTN_RATE3 As Long
Public BTN_RATE4 As Long
Public BTN_PEC As Long
Public BTN_SYNC As Long
Public BTN_NORTHEAST As Long
Public BTN_NORTHWEST As Long
Public BTN_SOUTHEAST As Long
Public BTN_SOUTHWEST As Long
Public BTN_POLARSCOPEALIGN As Long
Public BTN_DEADMANSHANDLE As Long
Public BTN_TOGGLELOCK As Long
Public BTN_TOGGLESCREENSAVER As Long
' default joystick button assignments
Public Const BTN_UNDEFINED = 0
Public Const BTN_JOY1 = 1
Public Const BTN_JOY2 = 2
Public Const BTN_JOY3 = 4
Public Const BTN_JOY4 = 8
Public Const BTN_JOY5 = 16
Public Const BTN_JOY6 = 32
Public Const BTN_JOY7 = 64
Public Const BTN_JOY8 = 128
Public Const BTN_JOY9 = 256
Public Const BTN_JOY10 = 512
Public Const BTN_JOY11 = 1024
Public Const BTN_JOY12 = 2048
Public Const BTN_POVN = 0 + 65536
Public Const BTN_POVS = 18000 + 65536
Public Const BTN_POVE = 9000 + 65536
Public Const BTN_POVW = 27000 + 65536
Public Const BTN_POVNE = 4500 + 65536
Public Const BTN_POVNW = 31500 + 65536
Public Const BTN_POVSW = 22500 + 65536
Public Const BTN_POVSE = 13500 + 65536
Type JOYCALIB
dwMinXpos As Long
dwMaxXpos As Long
dwX25Left As Long
dwX25Right As Long
dwX75left As Long
dwX75Right As Long
dwX90left As Long
dwX90Right As Long
dwMinYpos As Long
dwMaxYpos As Long
dwY25Left As Long
dwY25Right As Long
dwY75left As Long
dwY75Right As Long
dwY90left As Long
dwY90Right As Long
dwMinZpos As Long
dwMaxZpos As Long
dwMinRpos As Long
dwMaxRpos As Long
Enabled As Integer
DualSpeed As Integer
StickEnabled As Integer
POVEnabled As Integer
SwapXY As Integer
HalfRes As Boolean
id As Long
End Type
Type JOYINFOEX
dwSize As Long ' size of structure
dwFlags As Long ' flags to indicate what to return
dwXpos As Long ' x position
dwYpos As Long ' y position
dwZpos As Long ' z position
dwRpos As Long ' rudder/4th axis position
dwUpos As Long ' 5th axis position
dwVpos As Long ' 6th axis position
dwButtons As Long ' button states
dwButtonNumber As Long ' current button number pressed
dwPOV As Long ' point of view state
dwReserved1 As Long ' reserved for communication between winmm driver
dwReserved2 As Long ' reserved for future expansion
End Type
Public Const MAX_JOYSTICKOEMVXDNAME = 260
Public Const MAXPNAMELEN = 32
' The JOYCAPS user-defined type contains information about the joystick capabilities
Type JOYCAPS
wMid As Integer ' Manufacturer identifier of the device driver for the MIDI output device
' For a list of identifiers, see the Manufacturer Indentifier topic in the
' Multimedia Reference of the Platform SDK.
wPid As Integer ' Product Identifier Product of the MIDI output device. For a list of
' product identifiers, see the Product Identifiers topic in the Multimedia
' Reference of the Platform SDK.
szPname As String * MAXPNAMELEN ' Null-terminated string containing the joystick product name
wXmin As Long ' Minimum X-coordinate.
wXmax As Long ' Maximum X-coordinate.
wYmin As Long ' Minimum Y-coordinate
wYmax As Long ' Maximum Y-coordinate
wZmin As Long ' Minimum Z-coordinate
wZmax As Long ' Maximum Z-coordinate
wNumButtons As Long ' Number of joystick buttons
wPeriodMin As Long ' Smallest polling frequency supported when captured by the joySetCapture function.
wPeriodMax As Long ' Largest polling frequency supported when captured by the joySetCapture function.
wRmin As Long ' Minimum rudder value. The rudder is a fourth axis of movement.
wRmax As Long ' Maximum rudder value. The rudder is a fourth axis of movement.
wUmin As Long ' Minimum u-coordinate (fifth axis) values.
wUmax As Long ' Maximum u-coordinate (fifth axis) values.
wVmin As Long ' Minimum v-coordinate (sixth axis) values.
wVmax As Long ' Maximum v-coordinate (sixth axis) values.
wCaps As Long ' Joystick capabilities as defined by the following flags
' JOYCAPS_HASZ- Joystick has z-coordinate information.
' JOYCAPS_HASR- Joystick has rudder (fourth axis) information.
' JOYCAPS_HASU- Joystick has u-coordinate (fifth axis) information.
' JOYCAPS_HASV- Joystick has v-coordinate (sixth axis) information.
' JOYCAPS_HASPOV- Joystick has point-of-view information.
' JOYCAPS_POV4DIR- Joystick point-of-view supports discrete values (centered, forward, backward, left, and right).
' JOYCAPS_POVCTS Joystick point-of-view supports continuous degree bearings.
wMaxAxes As Long ' Maximum number of axes supported by the joystick.
wNumAxes As Long ' Number of axes currently in use by the joystick.
wMaxButtons As Long ' Maximum number of buttons supported by the joystick.
szRegKey As String * MAXPNAMELEN ' String containing the registry key for the joystick.
szOEMVxD As String * MAX_JOYSTICKOEMVXDNAME ' OEM VxD in use
End Type
Type JOYCAPS1
wMid As Integer ' Manufacturer identifier of the device driver for the MIDI output device
' For a list of identifiers, see the Manufacturer Indentifier topic in the
' Multimedia Reference of the Platform SDK.
wPid As Integer ' Product Identifier Product of the MIDI output device. For a list of
' product identifiers, see the Product Identifiers topic in the Multimedia
' Reference of the Platform SDK.
szPname As String * 32 ' Null-terminated string containing the joystick product name
wXmin As Long ' Minimum X-coordinate.
wXmax As Long ' Maximum X-coordinate.
wYmin As Long ' Minimum Y-coordinate
wYmax As Long ' Maximum Y-coordinate
wZmin As Long ' Minimum Z-coordinate
wZmax As Long ' Maximum Z-coordinate
wNumButtons As Long ' Number of joystick buttons
wPeriodMin As Long ' Smallest polling frequency supported when captured by the joySetCapture function.
wPeriodMax As Long ' Largest polling frequency supported when captured by the joySetCapture function.
End Type
Public Const JOYSTICKID1 = 0
Public Const JOYSTICKID2 = 1
Public Const JOY_RETURNBUTTONS = &H80&
Public Const JOY_RETURNCENTERED = &H400&
Public Const JOY_RETURNPOV = &H40&
Public Const JOY_RETURNR = &H8&
Public Const JOY_RETURNU = &H10
Public Const JOY_RETURNV = &H20
Public Const JOY_RETURNX = &H1&
Public Const JOY_RETURNY = &H2&
Public Const JOY_RETURNZ = &H4&
Public Const JOY_RETURNALL = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)
Public Const JOYCAPS_HASZ = &H1&
Public Const JOYCAPS_HASR = &H2&
Public Const JOYCAPS_HASU = &H4&
Public Const JOYCAPS_HASV = &H8&
Public Const JOYCAPS_HASPOV = &H10&
Public Const JOYCAPS_POV4DIR = &H20&
Public Const JOYCAPS_POVCTS = &H40&
Public Const JOYERR_BASE = 160
Public Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
Public Const JOYERR_NOCANDO = (JOYERR_BASE + 6) ' Request Not Completed
Public Const JOYERR_NOERROR = (0) ' No Error
Public Const JOYERR_PARMS = (JOYERR_BASE + 5) ' Bad Parameters
Public JoystickDat As JOYINFOEX
Public JoystickInfo As JOYCAPS1
Public JoystickCal As JOYCALIB
Dim RAGuidingNudge As Boolean
Dim DECGuidingNudge As Boolean
Public SlewActive As Integer
Type t_userkeydef
North As Integer
South As Integer
East As Integer
West As Integer
NorthEast As Integer
NorthWest As Integer
SouthEast As Integer
SouthWest As Integer
RateInc As Integer
RateDec As Integer
Track As Integer
Stop As Integer
Spiral As Integer
Park As Integer
End Type
Public UserKeyDefs As t_userkeydef
Public Function EQ_JoystickPoller(RRATE As Long, DRATE As Long) As Boolean
Dim i As Long
Dim dwXpos As Long
Dim dwYpos As Long
Dim dwZpos As Long
Dim dwRpos As Long
Dim dwButtons As Long
Dim dwPOV As Long
Dim ZoneX As Integer
Dim ZoneY As Integer
Dim rate As Double
On Error GoTo reterror
PollCount = PollCount + 1
If PollCount > 10 Then
If SyncPressCount <> 0 Then
SyncPressCount = 0
End If
PollCount = 0
End If
JoystickDat.dwSize = Len(JoystickDat)
JoystickDat.dwFlags = JOY_RETURNALL
If JoystickCal.id = -1 Then
'Auto search first two ids
i = joyGetPosEx(JOYSTICKID1, JoystickDat)
If i <> JOYERR_NOERROR Then i = joyGetPosEx(JOYSTICKID2, JoystickDat)
Else
' use specific id
i = joyGetPosEx(JoystickCal.id, JoystickDat)
End If
If i <> JOYERR_NOERROR Then
' Joystick not found disable joystick scan
reterror:
EQ_JoystickPoller = False
Exit Function
End If
' Start Polling for JoyStick routines here
If i = JOYERR_NOERROR Then
If JoystickCal.SwapXY = 1 Then
dwXpos = JoystickDat.dwYpos
dwYpos = JoystickDat.dwXpos
Else
dwXpos = JoystickDat.dwXpos
dwYpos = JoystickDat.dwYpos
End If
If JoystickCal.HalfRes Then
dwXpos = dwXpos / 2
dwYpos = dwYpos / 2
End If
dwZpos = JoystickDat.dwZpos
dwRpos = JoystickDat.dwRpos
dwButtons = JoystickDat.dwButtons
dwPOV = JoystickDat.dwPOV
' if no stick go straight to handlign buttons.
If JoystickCal.StickEnabled = 0 Then GoTo CheckButtons
ZoneX = 0
If dwXpos >= JoystickCal.dwX90Right Then
ZoneX = 4
Else
If dwXpos > JoystickCal.dwX25Right And dwXpos < JoystickCal.dwX75Right Then
If JoystickCal.DualSpeed = 1 Then
ZoneX = 3
End If
Else
If dwXpos > JoystickCal.dwX75left And dwXpos < JoystickCal.dwX25Left Then
If JoystickCal.DualSpeed = 1 Then
ZoneX = 1
End If
Else
If dwXpos <= JoystickCal.dwX90left Then
ZoneX = 2
Else
ZoneX = 0
End If
End If
End If
End If
ZoneY = 0
If dwYpos >= JoystickCal.dwY90Right Then
ZoneY = 4
Else
If dwYpos > JoystickCal.dwY25Right And dwYpos < JoystickCal.dwY75Right Then
If JoystickCal.DualSpeed = 1 Then
ZoneY = 3
End If
Else
If dwYpos > JoystickCal.dwY75left And dwYpos < JoystickCal.dwY25Left Then
If JoystickCal.DualSpeed = 1 Then
ZoneY = 1
End If
Else
If dwYpos <= JoystickCal.dwY90left Then
ZoneY = 2
End If
End If
End If
End If
' Debouncing on Both Axis
If (dwXpos <> gdwXpos) And (dwYpos <> gdwYpos) Then
If (gdwXpos <= JoystickCal.dwMinXpos) And (gdwYpos <= JoystickCal.dwMinYpos) Then
Call NorthWest_Up
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (gdwXpos <= JoystickCal.dwMinXpos) And (gdwYpos >= JoystickCal.dwMaxYpos) Then
Call SouthWest_Up
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (gdwXpos >= JoystickCal.dwMaxXpos) And (gdwYpos <= JoystickCal.dwMinYpos) Then
Call NorthEast_Up
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (gdwXpos >= JoystickCal.dwMaxXpos) And (gdwYpos >= JoystickCal.dwMaxYpos) Then
Call SouthEast_Up
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (dwXpos <= JoystickCal.dwMinXpos) And (dwYpos <= JoystickCal.dwMinYpos) Then
Call HC.Add_Message(oLangDll.GetLangString(5126))
Call NorthWest_Down(RRATE, DRATE)
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (dwXpos <= JoystickCal.dwMinXpos) And (dwYpos >= JoystickCal.dwMaxYpos) Then
Call HC.Add_Message(oLangDll.GetLangString(5127))
Call SouthWest_Down(RRATE, DRATE)
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (dwXpos >= JoystickCal.dwMaxXpos) And (dwYpos <= JoystickCal.dwMinYpos) Then
Call HC.Add_Message(oLangDll.GetLangString(5128))
Call NorthEast_Down(RRATE, DRATE)
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
If (dwXpos >= JoystickCal.dwMaxXpos) And (dwYpos >= JoystickCal.dwMaxYpos) Then
Call HC.Add_Message(oLangDll.GetLangString(5129))
Call SouthEast_Down(RRATE, DRATE)
gdwXpos = dwXpos
gdwYpos = dwYpos
EQ_JoystickPoller = True
Exit Function
End If
End If
' Debouncing on X Axis
rate = gPresetSlewRates(1)
If rate > 0 Then
If rate >= 1 Then
rate = rate + 9
Else
rate = rate * 10
End If
End If
If gZoneX <> ZoneX Then
' change in zone so stop current slew
Call Slew_Release_RA
HC.Add_Message "ZoneX=" & CStr(ZoneX)
SlewActive = 0
' Decide what to do now
Select Case ZoneX
Case 0
' released
Case 1
Call Slew_Release_RA
SlewActive = 0
Call HC.Add_Message(oLangDll.GetLangString(5112))
If RRATE > rate Then
Call West_Down(CInt(rate))
Else
Call West_Down(RRATE)
End If
Case 2
Call HC.Add_Message(oLangDll.GetLangString(5112))
Call West_Down(RRATE)
Case 3
Call HC.Add_Message(oLangDll.GetLangString(5111))
If RRATE > rate Then
Call East_Down(CInt(rate))
Else
Call East_Down(CInt(RRATE))
End If
Case 4
Call HC.Add_Message(oLangDll.GetLangString(5111))
Call East_Down(RRATE)
End Select
gZoneX = ZoneX
End If
' If dwXpos <> gdwXpos Then
'
' 'Scan for Joystick Release here
'
' If (gdwXpos <= JoystickCal.dwMinXpos) And (dwXpos > JoystickCal.dwMinXpos) Then Call West_Up
' If (gdwXpos >= JoystickCal.dwMaxXpos) And (dwXpos < JoystickCal.dwMaxXpos) Then Call East_Up
'
' ' Scan for Joystick Activate Here
'
' If (dwXpos <= JoystickCal.dwMinXpos) And (gdwXpos > JoystickCal.dwMinXpos) Then
' Call HC.Add_Message(oLangDll.GetLangString(5112))
' Call West_Down(RRATE)
' End If
'
' If (dwXpos >= JoystickCal.dwMaxXpos) And (gdwXpos < JoystickCal.dwMaxXpos) Then
' Call HC.Add_Message(oLangDll.GetLangString(5111))
' Call East_Down(RRATE)
' End If
'
gdwXpos = dwXpos
' End If
' Debouncing on Y Axis
If gZoneY <> ZoneY Then
' change in zone so stop current slew
HC.Add_Message "ZoneY=" & CStr(ZoneY)
Call Slew_Release_DEC
SlewActive = 0
' Decide what to do now
Select Case ZoneY
Case 0
' released
Case 1
Call HC.Add_Message(oLangDll.GetLangString(5109))
If DRATE > rate Then
Call North_Down(CInt(rate))
Else
Call North_Down(DRATE)
End If
Case 2
Call HC.Add_Message(oLangDll.GetLangString(5109))
Call North_Down(DRATE)
Case 3
Call HC.Add_Message(oLangDll.GetLangString(5110))
If DRATE > rate Then
Call South_Down(CInt(rate))
Else
Call South_Down(DRATE)
End If
Case 4
Call HC.Add_Message(oLangDll.GetLangString(5110))
Call South_Down(DRATE)
End Select
gZoneY = ZoneY
End If
' If dwYpos <> gdwYpos Then
'
' 'Scan for Joystick Release here
' If (gdwYpos <= JoystickCal.dwMinYpos) And (dwYpos > JoystickCal.dwMinYpos) Then Call North_Up
' If (gdwYpos >= JoystickCal.dwMaxYpos) And (dwYpos < JoystickCal.dwMaxYpos) Then Call South_Up
'
' ' Scan for Joystick Activate Here
' If (dwYpos <= JoystickCal.dwMinYpos) And (gdwYpos > JoystickCal.dwMinYpos) Then
' Call HC.Add_Message(oLangDll.GetLangString(5109))
' Call North_Down(DRATE)
' End If
'
' If (dwYpos >= JoystickCal.dwMaxYpos) And (gdwYpos < JoystickCal.dwMaxYpos) Then
' Call HC.Add_Message(oLangDll.GetLangString(5110))
' Call South_Down(DRATE)
' End If
'
gdwYpos = dwYpos
' End If
' Debouncing on R Axis
' If dwRpos <> gdwRpos Then
'Scan for Joystick Release here
' If gdwRpos = 0 Then
' End If
' If gdwRpos = 65535 Then
' End If
' Scan for Joystick Activate Here
' If dwRpos = 0 Then
' End If
' If dwRpos = 65535 Then
' End If
' gdwRpos = dwRpos
' End If
' Debouncing on Z Axis
' If dwZpos <> gdwZpos Then
' ' Scan for Joystick Activate Here
' If gdwZpos = 0 Then
' End If
' If gdwZpos = 65535 Then
' End If
'
' ' Scan for Joystick Activate Here
' If dwZpos = 0 Then
' End If
' If dwZpos = 65535 Then
' End If
'
' gdwZpos = dwZpos
' End If
CheckButtons:
' check for button preses
Call ButtonHandler(dwButtons, gdwButtons, RRATE, DRATE)
If JoystickCal.POVEnabled Then
' Debouncing on the POV Pads
Select Case dwPOV
Case 9000, 27000, 0, 18000, 31500, 4500, 22500, 13500
dwPOV = dwPOV + 65536
Case Else
dwPOV = 0
End Select
Call POVHandler(dwPOV, gdwPov, RRATE, DRATE)
End If
End If
EQ_JoystickPoller = True
End Function
Public Function EQ_JoystickPoller2() As Boolean
Dim i As Long
Dim dwButtons As Long
Dim dwPOV As Long
On Error GoTo reterror
JoystickDat.dwSize = Len(JoystickDat)
JoystickDat.dwFlags = JOY_RETURNALL
If JoystickCal.id = -1 Then
'Auto search first two ids
i = joyGetPosEx(JOYSTICKID1, JoystickDat)
If i <> JOYERR_NOERROR Then i = joyGetPosEx(JOYSTICKID2, JoystickDat)
Else
' use specific id
i = joyGetPosEx(JoystickCal.id, JoystickDat)
End If
If i <> JOYERR_NOERROR Then
' Joystick not found disable joystick scan
reterror:
EQ_JoystickPoller2 = False
Exit Function
End If
' Start Polling for Joytick routines here
If i = JOYERR_NOERROR Then
dwButtons = JoystickDat.dwButtons
dwPOV = JoystickDat.dwPOV
' check for button preses
If dwButtons <> gdwButtons Then
If BTN_EMERGENCYSTOP <> BTN_UNDEFINED Then
If (dwButtons And BTN_EMERGENCYSTOP) = BTN_EMERGENCYSTOP Then
Call EmergencyStopPark
GoTo skiplock1:
End If
Else
End If
If BTN_TOGGLELOCK <> BTN_UNDEFINED Then
If (dwButtons And BTN_TOGGLELOCK) = BTN_TOGGLELOCK Then
If JoystickCal.Enabled Then
JStickConfigForm.Check1.Value = 0
Call EQ_Beep(33)
Else
JStickConfigForm.Check1.Value = 1
Call EQ_Beep(34)
End If
Else
If dwButtons <> 0 Then
Call EQ_Beep(33)
End If
End If
End If
skiplock1:
gdwButtons = dwButtons
End If
If JoystickCal.POVEnabled Then
' Debouncing on the POV Pads
Select Case dwPOV
Case 9000, 27000, 0, 18000, 31500, 4500, 22500, 13500
dwPOV = dwPOV + 65536
Case Else
dwPOV = 0
End Select
If dwPOV <> gdwPov Then
If BTN_EMERGENCYSTOP <> BTN_UNDEFINED Then
If dwPOV = BTN_EMERGENCYSTOP Then
Call EmergencyStopPark 'Call emergency_stop
GoTo skiplock2
End If
End If
If BTN_TOGGLELOCK <> BTN_UNDEFINED Then
If (dwPOV = BTN_TOGGLELOCK) Then
If JoystickCal.Enabled Then
JStickConfigForm.Check1.Value = 0
Call EQ_Beep(33)
Else
JStickConfigForm.Check1.Value = 1
Call EQ_Beep(34)
End If
Else
If dwPOV <> 0 Then
Call EQ_Beep(33)
End If
End If
End If
skiplock2:
gdwPov = dwPOV
End If
End If
End If
EQ_JoystickPoller2 = True
End Function
Public Sub ButtonHandler(ByRef CURRENT As Long, ByRef last As Long, RRATE As Long, DRATE As Long)
' Debouncing on Buttons
If CURRENT <> last Then
If BTN_SPIRAL <> BTN_UNDEFINED Then
If (last And BTN_SPIRAL) Then Call Spiral_Slew_Stop
If (CURRENT And BTN_SPIRAL) Then
Call HC.Add_Message(oLangDll.GetLangString(5113))
Call Spiral_Slew
End If
End If
' alignment buttons are handled on the alignment form
' apply a mask
If CURRENT = BTN_ALIGNACCEPT Or CURRENT = BTN_ALIGNCANCEL Or CURRENT = BTN_ALIGNEND Then
gEQjbuttons = CURRENT
End If
If BTN_STARTSIDREAL <> BTN_UNDEFINED Then
If (CURRENT And BTN_STARTSIDREAL) = BTN_STARTSIDREAL Then Call Start_sidereal
End If
If BTN_STARTLUNAR <> BTN_UNDEFINED Then
If (CURRENT And BTN_STARTLUNAR) = BTN_STARTLUNAR Then Call Start_Lunar(0)
End If
If BTN_STARTSOLAR <> BTN_UNDEFINED Then
If (CURRENT And BTN_STARTSOLAR) = BTN_STARTSOLAR Then Call Start_Solar(0)
End If
If BTN_EMERGENCYSTOP <> BTN_UNDEFINED Then
If (CURRENT And BTN_EMERGENCYSTOP) = BTN_EMERGENCYSTOP Then Call EmergencyStopPark ' Call emergency_stop
End If
If BTN_HOMEPARK <> BTN_UNDEFINED Then
If (CURRENT And BTN_HOMEPARK) = BTN_HOMEPARK Then Call ParkToHome
End If
If BTN_USERPARK <> BTN_UNDEFINED Then
If (CURRENT And BTN_USERPARK) = BTN_USERPARK Then Call ParkToUser
End If
If BTN_CURRENTPARK <> BTN_UNDEFINED Then
If (CURRENT And BTN_CURRENTPARK) = BTN_CURRENTPARK Then Call ParkToCurrent
End If
If BTN_UNPARK <> BTN_UNDEFINED Then
If (CURRENT And BTN_UNPARK) = BTN_UNPARK Then Call UnPark
End If
If BTN_RAREVERSE <> BTN_UNDEFINED Then
If (CURRENT And BTN_RAREVERSE) = BTN_RAREVERSE Then Call RAReverse
End If
If BTN_DECREVERSE <> BTN_UNDEFINED Then
If (CURRENT And BTN_DECREVERSE) = BTN_DECREVERSE Then Call DecReverse
End If
If BTN_CUSTOMTRACKSTART <> BTN_UNDEFINED Then
If (CURRENT And BTN_CUSTOMTRACKSTART) = BTN_CUSTOMTRACKSTART Then Call Start_CustomTracking2
End If
If BTN_INCRATEPRESET <> BTN_UNDEFINED Then
If (CURRENT And BTN_INCRATEPRESET) = BTN_INCRATEPRESET Then Call ChangeRatePreset(1)
End If
If BTN_DECRATEPRESET <> BTN_UNDEFINED Then
If (CURRENT And BTN_DECRATEPRESET) = BTN_DECRATEPRESET Then Call ChangeRatePreset(-1)
End If
If BTN_RATE1 <> BTN_UNDEFINED Then
If (CURRENT And BTN_RATE1) = BTN_RATE1 Then Call SetRate(1)
End If
If BTN_RATE2 <> BTN_UNDEFINED Then
If (CURRENT And BTN_RATE2) = BTN_RATE2 Then Call SetRate(2)
End If
If BTN_RATE3 <> BTN_UNDEFINED Then
If (CURRENT And BTN_RATE3) = BTN_RATE3 Then Call SetRate(3)
End If
If BTN_RATE4 <> BTN_UNDEFINED Then
If (CURRENT And BTN_RATE4) = BTN_RATE4 Then Call SetRate(4)
End If
If BTN_POLARSCOPEALIGN <> BTN_UNDEFINED Then
If (CURRENT And BTN_POLARSCOPEALIGN) = BTN_POLARSCOPEALIGN Then
If polarfrm.Visible = True Then
gEQjbuttons = BTN_POLARSCOPEALIGN
End If
End If
End If
If (BTN_DEADMANSHANDLE <> BTN_UNDEFINED) Then
If (last = BTN_DEADMANSHANDLE) Then
If gSlewStatus Then
Call ParkToCurrent
Else
EQ_Beep (32)
End If
End If
If (CURRENT And BTN_DEADMANSHANDLE) = BTN_DEADMANSHANDLE Then Call EQ_Beep(31)
End If
If BTN_SYNC <> BTN_UNDEFINED Then
If (CURRENT And BTN_SYNC) = BTN_SYNC Then
SyncPressCount = SyncPressCount + 1
If SyncPressCount >= 2 Then
Call DoSync
End If
End If
End If
If BTN_TOGGLELOCK <> BTN_UNDEFINED Then
If (CURRENT And BTN_TOGGLELOCK) = BTN_TOGGLELOCK Then
If JoystickCal.Enabled Then
JStickConfigForm.Check1.Value = 0
Call EQ_Beep(33)
Else
JStickConfigForm.Check1.Value = 1
Call EQ_Beep(34)
End If
End If
End If
If BTN_TOGGLESCREENSAVER <> BTN_UNDEFINED Then
If (CURRENT And BTN_TOGGLESCREENSAVER) = BTN_TOGGLESCREENSAVER Then
Call ToggleMonitorPower
End If
End If
If (BTN_SOUTH <> BTN_UNDEFINED) Then
If (last = BTN_SOUTH) Then Call South_Up
If CURRENT = BTN_SOUTH Then
Call HC.Add_Message(oLangDll.GetLangString(5114))
Call South_Down(DRATE)
End If
End If
If (BTN_EAST <> BTN_UNDEFINED) Then
If (last = BTN_EAST) Then Call East_Up
If (CURRENT = BTN_EAST) Then
Call HC.Add_Message(oLangDll.GetLangString(5115))
Call East_Down(RRATE)
End If
End If
If (BTN_WEST <> BTN_UNDEFINED) Then
If last = BTN_WEST Then Call West_Up
If CURRENT = BTN_WEST Then
Call HC.Add_Message(oLangDll.GetLangString(5116))
Call West_Down(RRATE)
End If
End If
If (BTN_NORTH <> BTN_UNDEFINED) Then
If last = BTN_NORTH Then Call North_Up
If CURRENT = BTN_NORTH Then
Call HC.Add_Message(oLangDll.GetLangString(5117))
Call North_Down(DRATE)
End If
End If
If (BTN_NORTHWEST <> BTN_UNDEFINED) Then
If last = BTN_NORTHWEST Then Call NorthWest_Up
If CURRENT = BTN_NORTHWEST Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call NorthWest_Down(DRATE, RRATE)
End If
End If
If (BTN_NORTHEAST <> BTN_UNDEFINED) Then
If last = BTN_NORTHEAST Then Call NorthEast_Up
If CURRENT = BTN_NORTHEAST Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call NorthEast_Down(DRATE, RRATE)
End If
End If
If (BTN_SOUTHWEST <> BTN_UNDEFINED) Then
If last = BTN_SOUTHWEST Then Call SouthWest_Up
If CURRENT = BTN_SOUTHWEST Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call SouthWest_Down(DRATE, RRATE)
End If
End If
If (BTN_SOUTHEAST <> BTN_UNDEFINED) Then
If last = BTN_SOUTHEAST Then Call SouthEast_Up
If CURRENT = BTN_SOUTHEAST Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call SouthEast_Down(DRATE, RRATE)
End If
End If
End If
' auto repeating buttons here
' Slew Rate Adjustment Buttons
If BTN_RARATEINC <> BTN_UNDEFINED Then
If (CURRENT And BTN_RARATEINC) = BTN_RARATEINC Then Call Adjust_rate(0, 1)
End If
If BTN_RARATEDEC <> BTN_UNDEFINED Then
If (CURRENT And BTN_RARATEDEC) = BTN_RARATEDEC Then Call Adjust_rate(0, -1)
End If
If BTN_DECRATEINC <> BTN_UNDEFINED Then
If (CURRENT And BTN_DECRATEINC) = BTN_DECRATEINC Then Call Adjust_rate(1, 1)
End If
If BTN_DECRATEDEC <> BTN_UNDEFINED Then
If (CURRENT And BTN_DECRATEDEC) = BTN_DECRATEDEC Then Call Adjust_rate(1, -1)
End If
last = CURRENT
End Sub
Public Sub POVHandler(ByRef CURRENT As Long, ByRef last As Long, RRATE As Long, DRATE As Long)
' Debouncing on Buttons
If CURRENT <> last Then
If BTN_SPIRAL <> BTN_UNDEFINED Then
If (last = BTN_SPIRAL) Then Call Spiral_Slew_Stop
If (CURRENT = BTN_SPIRAL) Then
Call HC.Add_Message(oLangDll.GetLangString(5113))
Call Spiral_Slew
End If
End If
' alignment buttons are handled on the alignment form
' apply a mask
If CURRENT = BTN_ALIGNACCEPT Or CURRENT = BTN_ALIGNCANCEL Or CURRENT = BTN_ALIGNEND Then
gEQjbuttons = CURRENT
End If
If BTN_STARTSIDREAL <> BTN_UNDEFINED Then
If CURRENT = BTN_STARTSIDREAL Then Call Start_sidereal
End If
If BTN_STARTLUNAR <> BTN_UNDEFINED Then
If CURRENT = BTN_STARTLUNAR Then Call Start_Lunar(0)
End If
If BTN_STARTSOLAR <> BTN_UNDEFINED Then
If CURRENT = BTN_STARTSOLAR Then Call Start_Solar(0)
End If
If BTN_EMERGENCYSTOP <> BTN_UNDEFINED Then
If CURRENT = BTN_EMERGENCYSTOP Then Call EmergencyStopPark 'Call emergency_stop
End If
If BTN_HOMEPARK <> BTN_UNDEFINED Then
If CURRENT = BTN_HOMEPARK Then Call ParkToHome
End If
If BTN_USERPARK <> BTN_UNDEFINED Then
If CURRENT = BTN_USERPARK Then Call ParkToUser
End If
If BTN_CURRENTPARK <> BTN_UNDEFINED Then
If CURRENT = BTN_CURRENTPARK Then Call ParkToCurrent
End If
If BTN_UNPARK <> BTN_UNDEFINED Then
If CURRENT = BTN_UNPARK Then Call UnPark
End If
If BTN_RAREVERSE <> BTN_UNDEFINED Then
If CURRENT = BTN_RAREVERSE Then Call RAReverse
End If
If BTN_DECREVERSE <> BTN_UNDEFINED Then
If CURRENT = BTN_DECREVERSE Then Call DecReverse
End If
If BTN_CUSTOMTRACKSTART <> BTN_UNDEFINED Then
If CURRENT = BTN_CUSTOMTRACKSTART Then Call Start_CustomTracking2
End If
If BTN_INCRATEPRESET <> BTN_UNDEFINED Then
If CURRENT = BTN_INCRATEPRESET Then Call ChangeRatePreset(1)
End If
If BTN_DECRATEPRESET <> BTN_UNDEFINED Then
If CURRENT = BTN_DECRATEPRESET Then Call ChangeRatePreset(-1)
End If
If BTN_RATE1 <> BTN_UNDEFINED Then
If CURRENT = BTN_RATE1 Then Call SetRate(1)
End If
If BTN_RATE2 <> BTN_UNDEFINED Then
If CURRENT = BTN_RATE2 Then Call SetRate(2)
End If
If BTN_RATE3 <> BTN_UNDEFINED Then
If CURRENT = BTN_RATE3 Then Call SetRate(3)
End If
If BTN_RATE4 <> BTN_UNDEFINED Then
If CURRENT = BTN_RATE4 Then Call SetRate(4)
End If
If BTN_POLARSCOPEALIGN <> BTN_UNDEFINED Then
If CURRENT = BTN_POLARSCOPEALIGN Then
If polarfrm.Visible = True Then
gEQjbuttons = BTN_POLARSCOPEALIGN
End If
End If
End If
If (BTN_DEADMANSHANDLE <> BTN_UNDEFINED) Then
If (last = BTN_DEADMANSHANDLE) Then
If gSlewStatus Then
Call ParkToCurrent
Else
EQ_Beep (32)
End If
End If
If CURRENT = BTN_DEADMANSHANDLE Then Call EQ_Beep(31)
End If
If BTN_SYNC <> BTN_UNDEFINED Then
If CURRENT = BTN_SYNC Then
SyncPressCount = SyncPressCount + 1
If SyncPressCount >= 2 Then
Call DoSync
End If
End If
End If
If (BTN_SOUTH <> BTN_UNDEFINED) Then
If (last = BTN_SOUTH) Then Call South_Up
If (CURRENT = BTN_SOUTH) Then
Call HC.Add_Message(oLangDll.GetLangString(5114))
Call South_Down(DRATE)
End If
End If
If (BTN_EAST <> BTN_UNDEFINED) Then
If (last = BTN_EAST) Then Call East_Up
If (CURRENT = BTN_EAST) Then
Call HC.Add_Message(oLangDll.GetLangString(5115))
Call East_Down(RRATE)
End If
End If
If (BTN_WEST <> BTN_UNDEFINED) Then
If (last = BTN_WEST) Then Call West_Up
If (CURRENT = BTN_WEST) Then
Call HC.Add_Message(oLangDll.GetLangString(5116))
Call West_Down(RRATE)
End If
End If
If (BTN_NORTH <> BTN_UNDEFINED) Then
If (last = BTN_NORTH) Then Call North_Up
If (CURRENT = BTN_NORTH) Then
Call HC.Add_Message(oLangDll.GetLangString(5117))
Call North_Down(DRATE)
End If
End If
If (BTN_NORTHWEST <> BTN_UNDEFINED) Then
If (last = BTN_NORTHWEST) Then Call NorthWest_Up
If (CURRENT = BTN_NORTHWEST) Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call NorthWest_Down(DRATE, RRATE)
End If
End If
If (BTN_NORTHEAST <> BTN_UNDEFINED) Then
If (last = BTN_NORTHEAST) Then Call NorthEast_Up
If (CURRENT = BTN_NORTHEAST) Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call NorthEast_Down(DRATE, RRATE)
End If
End If
If (BTN_SOUTHWEST <> BTN_UNDEFINED) Then
If (last = BTN_SOUTHWEST) Then Call SouthWest_Up
If (CURRENT = BTN_SOUTHWEST) Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call SouthWest_Down(DRATE, RRATE)
End If
End If
If (BTN_SOUTHEAST <> BTN_UNDEFINED) Then
If (last = BTN_SOUTHEAST) Then Call SouthEast_Up
If (CURRENT = BTN_SOUTHEAST) Then
' Call HC.Add_Message(oLangDll.GetLangString(5117))
Call SouthEast_Down(DRATE, RRATE)
End If
End If
If BTN_TOGGLELOCK <> BTN_UNDEFINED Then
If (CURRENT = BTN_TOGGLELOCK) Then
If JoystickCal.Enabled Then
JStickConfigForm.Check1.Value = 0
Call EQ_Beep(33)
Else
JStickConfigForm.Check1.Value = 1
Call EQ_Beep(34)
End If
End If
End If
If BTN_TOGGLESCREENSAVER <> BTN_UNDEFINED Then
If CURRENT = BTN_TOGGLESCREENSAVER Then
Call ToggleMonitorPower
End If
End If
End If
' auto repeating buttons here
' Slew Rate Adjustment Buttons
If BTN_RARATEINC <> BTN_UNDEFINED Then
If CURRENT = BTN_RARATEINC Then Call Adjust_rate(0, 1)
End If
If BTN_RARATEDEC <> BTN_UNDEFINED Then
If CURRENT = BTN_RARATEDEC Then Call Adjust_rate(0, -1)
End If
If BTN_DECRATEINC <> BTN_UNDEFINED Then
If CURRENT = BTN_DECRATEINC Then Call Adjust_rate(1, 1)
End If
If BTN_DECRATEDEC <> BTN_UNDEFINED Then
If CURRENT = BTN_DECRATEDEC Then Call Adjust_rate(1, -1)
End If
last = CURRENT
End Sub
Public Sub West_Down(rate As Long)
If HC.RA_inv.Value Then
Slew_East (rate)
Else
Slew_West (rate)
End If
End Sub
Private Sub Slew_West(rate As Long)
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop pec from sending updates
StopTrackingUpdates
If rate > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo SWEND01
'
' 'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SWEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
rate = rate - 9
If gTrackingStatus Then
If rate < 800 Then
rate = rate + 1
End If
End If
If Not gHemisphere = 1 Then
eqres = EQ_Slew(0, 0, 0, rate)
Else
eqres = EQ_Slew(0, 0, 1, rate)
End If
RAGuidingNudge = False
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, rate, 0, gHemisphere, gHemisphere)
End If
' Stop Emulation
gEmulNudge = True
SlewActive = 7
SWEND01:
End Sub
Public Sub East_Down(rate As Long)
If HC.RA_inv.Value Then
Slew_West (rate)
Else
Slew_East (rate)
End If
End Sub
Private Sub Slew_East(rate As Long)
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop pec from sending updates
StopTrackingUpdates
If rate > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo EDEND01
'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo EDEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
rate = rate - 9
If gTrackingStatus Then
' allow for the fact that sidereal drift gives us a boost in this direction.
rate = rate - 1
End If
If rate <> 0 Then
If Not gHemisphere = 1 Then
eqres = EQ_Slew(0, 0, 1, rate)
Else
eqres = EQ_Slew(0, 0, 0, rate)
End If
End If
RAGuidingNudge = False
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, rate, 1, gHemisphere, gHemisphere)
End If
' Stop Emulation
gEmulNudge = True
SlewActive = 3
EDEND01:
End Sub
Public Sub North_Down(rate As Long)
If HC.DEC_Inv.Value = 1 Then
Slew_South (rate)
Else
Slew_North (rate)
End If
End Sub
Private Sub Slew_North(rate As Long)
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If rate > 9 Then
eqres = EQ_MotorStop(1) ' Stop DEC Motor
If eqres <> EQ_OK Then GoTo NDEND01
' ' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo NDEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
rate = rate - 9
eqres = EQ_Slew(1, 0, 0, rate)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, rate, 0, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 1
NDEND01:
End Sub
Public Sub South_Down(rate As Long)
If HC.DEC_Inv.Value = 1 Then
Slew_North (rate)
Else
Slew_South (rate)
End If
End Sub
Private Sub Slew_South(rate As Long)
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If rate > 9 Then
eqres = EQ_MotorStop(1) ' Stop DEC Motor
If eqres <> EQ_OK Then GoTo SDEND01
'
' ' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SDEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
rate = rate - 9
eqres = EQ_Slew(1, 0, 1, rate)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, rate, 1, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 5
SDEND01:
End Sub
Public Sub keydown(KeyCode As Integer, RRATE As Long, DRATE As Long)
If KeyCode = 16 Then Exit Sub
If gPrevCode = KeyCode Then Exit Sub
gPrevCode = KeyCode
If KeyCode = UserKeyDefs.North Then
Call North_Down(DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.South Then
Call South_Down(DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.West Then
Call West_Down(RRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.East Then
Call East_Down(RRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.NorthWest Then
Call NorthWest_Down(RRATE, DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.NorthEast Then
Call NorthEast_Down(RRATE, DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.SouthWest Then
Call SouthWest_Down(RRATE, DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.SouthEast Then
Call SouthEast_Down(RRATE, DRATE)
Exit Sub
End If
If KeyCode = UserKeyDefs.Stop Then
Call emergency_stop
Exit Sub
End If
If KeyCode = UserKeyDefs.Track Then
Call Start_sidereal
Exit Sub
End If
If KeyCode = UserKeyDefs.Spiral Then
Call Spiral_Slew
Exit Sub
End If
If KeyCode = UserKeyDefs.RateDec Then
Call ChangeRatePreset(-1)
If slewpadcls.Visible Then
slewpadcls.SetFocus
End If
Exit Sub
End If
If KeyCode = UserKeyDefs.RateInc Then
Call ChangeRatePreset(1)
If slewpadcls.Visible Then
slewpadcls.SetFocus
End If
Exit Sub
End If
Select Case (KeyCode)
' Case 104 ' Numeric Keypad 9
' Call North_Down(DRATE)
Case 56 ' 9
Call North_Down(DRATE)
Case 27 ' ESC
Call North_Down(DRATE)
Case 116 ' F5
Call North_Down(DRATE)
' Case 98 ' Numeric Keypad 2
' Call South_Down(DRATE)
Case 75 ' K
Call South_Down(DRATE)
Case 66 ' A
Call South_Down(DRATE)
' Case 100 ' Numeric Keypad 4
' Call West_Down(RRATE)
Case 85 ' U
Call West_Down(RRATE)
Case 102 ' Numeric Keypad 6
Call East_Down(RRATE)
Case 79 ' O
Call East_Down(RRATE)
' Case 103 ' Numeric Keypad 7
' Call NorthWest_Down(RRATE, DRATE)
Case 55 ' 7
Call NorthWest_Down(RRATE, DRATE)
' Case 105 ' Numeric Keypad 9
' Call NorthEast_Down(RRATE, DRATE)
Case 57 ' 9 key
Call NorthEast_Down(RRATE, DRATE)
' Case 97 ' Numeric Keypad 1
' Call SouthWest_Down(RRATE, DRATE)
Case 74 ' J
Call SouthWest_Down(RRATE, DRATE)
' Call SouthEast_Down(RRATE, DRATE)
' Case 99 ' Numeric Keypad 3
Call SouthEast_Down(RRATE, DRATE)
Case 76 ' L
Call SouthEast_Down(RRATE, DRATE)
Case 12 ' Clear
Call emergency_stop
Case 73 ' I
Call emergency_stop
' Case 96 ' Numeric keypad 0
' Call Start_sidereal
Case 77 ' M
Call Start_sidereal
Case 177 ' Presenter Button 2 (media previous track)
Call ChangeRatePreset(-1)
If slewpadcls.Visible Then
slewpadcls.SetFocus
End If
Case 176 ' Presenter Button 3 (media next track)
Call ChangeRatePreset(1)
If slewpadcls.Visible Then
slewpadcls.SetFocus
End If
Case Else
eqres = 0
End Select
End Sub
Public Sub keyup(KeyCode As Integer)
If KeyCode = 16 Then Exit Sub
If KeyCode = UserKeyDefs.North Then
Call North_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.South Then
Call South_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.West Then
Call West_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.East Then
Call East_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.NorthWest Then
Call NorthWest_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.NorthEast Then
Call NorthEast_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.SouthWest Then
Call SouthWest_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.SouthEast Then
Call SouthEast_Up
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.Stop Then
Call emergency_stop
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.Track Then
Call Start_sidereal
GoTo endkeyup
End If
If KeyCode = UserKeyDefs.Spiral Then
Call Spiral_Slew_Stop
GoTo endkeyup
End If
Select Case (KeyCode)
' Case 104 ' Numeric Keypad 9
' Call North_Up
Case 56 ' 9
Call North_Up
Case 27 ' ESC
Call North_Up
Case 116 ' F5
Call North_Up
' Case 98 ' Numeric Keypad 2
' Call South_Up
Case 75 ' K
Call South_Up
Case 66 ' A
Call South_Up
' Case 100 ' Numeric Keypad 4
' Call West_Up
Case 85 ' U
Call West_Up
Case 102 ' Numeric Keypad 6
' Call East_Up
Case 79 ' O
Call East_Up
' Case 103 ' Numeric Keypad 7
' Call NorthWest_Up
Case 55 ' 7
Call NorthWest_Up
' Case 105 ' Numeric Keypad 9
' Call NorthEast_Up
Case 57 ' 9 key
Call NorthEast_Up
' Case 97 ' Numeric Keypad 1
' Call SouthWest_Up
Case 74 ' J
Call SouthWest_Up
' Case 99 ' Numeric Keypad 3
' Call SouthEast_Up
Case 76 ' L
Call SouthEast_Up
Case Else
eqres = 0
End Select
endkeyup:
gPrevCode = 0
End Sub
Public Sub NorthEast_Down(RRATE As Long, DRATE As Long)
If HC.DEC_Inv.Value = 1 Then
If HC.RA_inv.Value = 1 Then
Call Slew_SouthWest(RRATE, DRATE)
Else
Call Slew_SouthEast(RRATE, DRATE)
End If
Else
If HC.RA_inv.Value = 1 Then
Call Slew_NorthWest(RRATE, DRATE)
Else
Call Slew_NorthEast(RRATE, DRATE)
End If
End If
End Sub
Private Sub Slew_NorthEast(RRATE As Long, DRATE As Long)
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If RRATE > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo NEEND01
'
' ' Wait for RA motor stop
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo NEEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
RRATE = RRATE - 9
If gTrackingStatus Then
' allow for the fact that sidereal drift gives us a boost in this direction.
RRATE = RRATE - 1
End If
If RRATE > 0 Then
eqres = EQ_Slew(0, 0, 1, RRATE)
End If
RAGuidingNudge = False
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, RRATE, 1, gHemisphere, gHemisphere)
End If
If DRATE > 9 Then
' Stop DEC Motor
eqres = EQ_MotorStop(1)
If eqres <> EQ_OK Then GoTo NEEND01
'
' ' Wait for DEC motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo NEEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
eqres = EQ_Slew(1, 0, 0, DRATE - 9)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, DRATE, 0, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 2
NEEND01:
End Sub
Public Sub NorthWest_Down(RRATE As Long, DRATE As Long)
If HC.DEC_Inv.Value = 1 Then
If HC.RA_inv.Value = 1 Then
Call Slew_SouthEast(RRATE, DRATE)
Else
Call Slew_SouthWest(RRATE, DRATE)
End If
Else
If HC.RA_inv.Value = 1 Then
Call Slew_NorthEast(RRATE, DRATE)
Else
Call Slew_NorthWest(RRATE, DRATE)
End If
End If
End Sub
Private Sub Slew_NorthWest(RRATE As Long, DRATE As Long)
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If RRATE > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo NWEND01
' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo NWEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
RRATE = RRATE - 9
If gTrackingStatus Then
If RRATE < 800 Then
RRATE = RRATE + 1
End If
End If
eqres = EQ_Slew(0, 0, 0, RRATE)
RAGuidingNudge = False
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, RRATE, 0, gHemisphere, gHemisphere)
End If
If DRATE > 9 Then
' Stop DEC Motor
eqres = EQ_MotorStop(1)
If eqres <> EQ_OK Then GoTo NWEND01
' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo NWEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
eqres = EQ_Slew(1, 0, 0, DRATE - 9)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, DRATE, 0, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 8
NWEND01:
End Sub
Public Sub SouthEast_Down(RRATE As Long, DRATE As Long)
If HC.DEC_Inv.Value = 1 Then
If HC.RA_inv.Value = 1 Then
Call Slew_NorthWest(RRATE, DRATE)
Else
Call Slew_NorthEast(RRATE, DRATE)
End If
Else
If HC.RA_inv.Value = 1 Then
Call Slew_SouthWest(RRATE, DRATE)
Else
Call Slew_SouthEast(RRATE, DRATE)
End If
End If
End Sub
Private Sub Slew_SouthEast(RRATE As Long, DRATE As Long)
' no sleing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If RRATE > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo SEEND01
'
' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SEEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
RRATE = RRATE - 9
If gTrackingStatus Then
' allow for the fact that sidereal drift gives us a boost in this direction.
RRATE = RRATE - 1
End If
If RRATE > 0 Then
eqres = EQ_Slew(0, 0, 1, RRATE)
End If
DECGuidingNudge = True
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, RRATE, 1, gHemisphere, gHemisphere)
End If
If DRATE > 9 Then
' Stop DEC Motor
eqres = EQ_MotorStop(1)
If eqres <> EQ_OK Then GoTo SEEND01
'
' Wait for motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SEEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
eqres = EQ_Slew(1, 0, 1, DRATE - 9)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, DRATE, 1, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 4
SEEND01:
End Sub
Public Sub SouthWest_Down(RRATE As Long, DRATE As Long)
If HC.DEC_Inv.Value = 1 Then
If HC.RA_inv.Value = 1 Then
Call Slew_NorthEast(RRATE, DRATE)
Else
Call Slew_NorthWest(RRATE, DRATE)
End If
Else
If HC.RA_inv.Value = 1 Then
Call Slew_SouthEast(RRATE, DRATE)
Else
Call Slew_SouthWest(RRATE, DRATE)
End If
End If
End Sub
Private Sub Slew_SouthWest(RRATE As Long, DRATE As Long)
' no sleing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop PEC sending update
StopTrackingUpdates
If RRATE > 9 Then
' Stop RA Motor
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo SWEND01
'
' Wait for ra motor stop
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SWEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
RRATE = RRATE - 9
If gTrackingStatus Then
If RRATE < 800 Then
RRATE = RRATE + 1
End If
End If
eqres = EQ_Slew(0, 0, 0, RRATE)
RAGuidingNudge = False
Else
RAGuidingNudge = True
eqres = EQ_SendGuideRate(0, 0, RRATE, 0, gHemisphere, gHemisphere)
End If
If DRATE > 9 Then
' Stop DEC Motor
eqres = EQ_MotorStop(1)
If eqres <> EQ_OK Then GoTo SWEND01
' ' Wait for dec motor stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SWEND01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
eqres = EQ_Slew(1, 0, 1, DRATE - 9)
DECGuidingNudge = False
Else
DECGuidingNudge = True
eqres = EQ_SendGuideRate(1, 0, DRATE, 1, 0, 0)
End If
gEmulNudge = True ' Stop Emulation
SlewActive = 6
SWEND01:
End Sub
Public Sub North_Up()
Call Slew_Release_DEC
SlewActive = 0
End Sub
Public Sub South_Up()
Call Slew_Release_DEC
SlewActive = 0
End Sub
Public Sub East_Up()
Call Slew_Release_RA
SlewActive = 0
End Sub
Public Sub West_Up()
Call Slew_Release_RA
SlewActive = 0
End Sub
Public Sub NorthEast_Up()
Call Slew_Release
SlewActive = 0
End Sub
Public Sub NorthWest_Up()
Call Slew_Release
SlewActive = 0
End Sub
Public Sub SouthEast_Up()
Call Slew_Release
SlewActive = 0
End Sub
Public Sub SouthWest_Up()
Call Slew_Release
SlewActive = 0
End Sub
Private Sub Slew_Release_RA()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
If RAGuidingNudge Then
Call EQ_SendGuideRate(0, gTrackingStatus - 1, 0, 0, gHemisphere, gHemisphere)
If HC.CheckPEC.Value = 1 Then
PEC_StartTracking
' Else
' Call RestartTracking
End If
Else
' Stop Motors
' eqres = EQ_MotorStop(1)
' eqres = EQ_MotorStop(0)
eqres = EQ_MotorStop(2)
'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SRRA1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
SRRA1:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SRRA2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
SRRA2:
Call RestartTracking
End If
RAGuidingNudge = False
gEmulNudge = False ' Enable Emulation
gEmulOneShot = True ' Get One shot cap
End Sub
Private Sub Slew_Release_DEC()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
If DECGuidingNudge Then
Call EQ_MotorStop(1)
Else
' Stop Motors
' eqres = EQ_MotorStop(1)
' eqres = EQ_MotorStop(0)
eqres = EQ_MotorStop(2)
'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SRDEC1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SRDEC1:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SRDEC2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SRDEC2:
Call RestartTracking
End If
DECGuidingNudge = False
gEmulNudge = False ' Enable Emulation
gEmulOneShot = True ' Get One shot cap
End Sub
Private Sub Slew_Release()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' eqres = EQ_MotorStop(1)
' eqres = EQ_MotorStop(0) ' Stop RA Motor
eqres = EQ_MotorStop(2) ' Stop RA & DEC Motor
'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SR1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SR1:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SR2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SR2:
Call RestartTracking
RAGuidingNudge = False
DECGuidingNudge = False
gEmulNudge = False ' Enable Emulation
gEmulOneShot = True ' Get One shot cap
End Sub
Public Sub emergency_stop()
gSlewStatus = False
If gEQparkstatus = 2 Then
' we were slewing to park position
' well its not happening now!
gEQparkstatus = 0
HC.ParkTimer.Enabled = False
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(179)
Call SetParkCaption
End If
If gPEC_Enabled Then
PEC_StopTracking
End If
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
eqres = EQ_MotorStop(2)
gRA_LastRate = 0
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo STOPEND1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'STOPEND1:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo STOPEND2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'STOPEND2:
' clear an active flips
HC.ChkForceFlip.Value = 0
gCWUP = False
gGotoParams.SuperSafeMode = 0
gRAStatus_slew = False
gTrackingStatus = 0
gDeclinationRate = 0
gRightAscensionRate = 0
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
HC.Add_Message (oLangDll.GetLangString(5130))
gEmulNudge = False ' Enable Emulation
gEmulOneShot = True ' Get One shot cap
EQ_Beep (7)
End Sub
Public Sub Start_sidereal()
EQStartSidereal2
gEmulNudge = False ' Enable Emulation
End Sub
Public Sub Start_Lunar(mute As Integer)
gRA_LastRate = 0
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5013))
Exit Sub
End If
If gPEC_Enabled Then
PEC_StopTracking
End If
eqres = EQ_StartRATrack(1, gHemisphere, gHemisphere)
eqres = EQ_MotorStop(1)
gTrackingStatus = 2 'Lunar rate tracking'
gDeclinationRate = 0
gRightAscensionRate = LUN_RATE
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(123)
HC.Add_Message (oLangDll.GetLangString(5015))
gEmulNudge = False ' Enable Emulation
If mute = 0 Then
EQ_Beep (11)
End If
End Sub
Public Sub Start_Solar(mute As Integer)
gRA_LastRate = 0
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5013))
Exit Sub
End If
If gPEC_Enabled Then
PEC_StopTracking
End If
eqres = EQ_StartRATrack(2, gHemisphere, gHemisphere)
eqres = EQ_MotorStop(1)
gTrackingStatus = 3 'Solar rate tracking'
gDeclinationRate = 0
gRightAscensionRate = SOL_RATE
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(124)
HC.Add_Message (oLangDll.GetLangString(5016))
gEmulNudge = False ' Enable Emulation
If mute = 0 Then
EQ_Beep (12)
End If
End Sub
Public Sub Adjust_rate(axis As Integer, direction As Integer)
Dim i As Integer
Dim j As Integer
If axis = 0 Then
i = HC.VScrollRASlewRate.Value
If i > 50 Then
j = 20
Else
j = 1
End If
If direction > 0 Then
i = i + j
If i >= 800 Then i = 800
Else
i = i - j
If i <= 0 Then i = 2
End If
HC.VScrollRASlewRate.Value = i
Else
i = HC.VScrollDecSlewRate.Value
If i > 50 Then
j = 20
Else
j = 1
End If
If direction > 0 Then
i = i + j
If i >= 800 Then i = 800
Else
i = i - j
If i <= 0 Then i = 2
End If
HC.VScrollDecSlewRate.Value = i
End If
Call ReApplySlew
End Sub
Private Sub ReApplySlew()
Select Case SlewActive
Case 0
'none
Case 1
' north
Call Slew_North(HC.VScrollDecSlewRate.Value)
Case 2
' northeast
Call Slew_NorthEast(HC.VScrollRASlewRate.Value, HC.VScrollDecSlewRate.Value)
Case 3
' east
Call Slew_East(HC.VScrollRASlewRate.Value)
Case 4
' southeast
Call Slew_SouthEast(HC.VScrollRASlewRate.Value, HC.VScrollDecSlewRate.Value)
Case 5
'south
Call Slew_South(HC.VScrollDecSlewRate.Value)
Case 6
'southwest
Call Slew_SouthWest(HC.VScrollRASlewRate.Value, HC.VScrollDecSlewRate.Value)
Case 7
' west
Call Slew_West(HC.VScrollRASlewRate.Value)
Case 8
' northwest
Call Slew_NorthWest(HC.VScrollRASlewRate.Value, HC.VScrollDecSlewRate.Value)
End Select
End Sub
Public Sub Adjust_rate2(direction As Integer)
Dim i As Integer
i = slewpadcls.VScroll1.Value
If direction > 0 Then
i = i + 20
If i >= 800 Then i = 800
Else
i = i - 20
If i <= 0 Then i = 2
End If
slewpadcls.VScroll1.Value = i
slewpadcls.VScroll2.Value = i
End Sub
Public Sub Spiral_Slew()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' stop pec from senidng rate updates
StopTrackingUpdates
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
eqres = EQ_MotorStop(2)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SSLEW01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SSLEW01:
'
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SSLEW02
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SSLEW02:
' Initialize Slew Parameters
gSPIRAL_JUMP = HC.SpiralHScroll1.Value
gRightAscension_Start = EQGetMotorValues(0)
gDeclination_Start = EQGetMotorValues(1)
gDeclination_Dir = 0
gRightAscension_Dir = 0
gDeclination_Len = gSPIRAL_JUMP
gRightAscension_Len = gSPIRAL_JUMP
gSpiral_AxisFlag = 0
If gRightAscension_Dir = 0 Then
eqres = EQStartMoveMotor(0, 0, 0, gRightAscension_Len, GetSlowdown(gRightAscension_Len))
gRightAscension_Dir = 1
Else
eqres = EQStartMoveMotor(0, 0, 1, gRightAscension_Len, GetSlowdown(gRightAscension_Len))
gRightAscension_Dir = 0
End If
gSpiralTimerFlag = True
HC.Spiral_Timer.Enabled = True
gEmulNudge = True ' Stop Emulation
End Sub
Public Sub Spiral_Slew_Stop()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
gSpiralTimerFlag = False
HC.Spiral_Timer.Enabled = False
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
eqres = EQ_MotorStop(2)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SSLEWSTOP01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SSLEWSTOP01:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SSLEWSTOP02
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SSLEWSTOP02:
Call RestartTracking
gEmulNudge = False ' Enable Emulation
gEmulOneShot = True ' Get One shot cap
HC.Add_Message (oLangDll.GetLangString(5131))
End Sub
Public Sub ParkToCurrent()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
' do the park
Call Park2Current
End Sub
Public Sub ParkToHome()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
Call ParkHome
End Sub
Public Sub ParkToUser()
' no slewing possible if parked!
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5000))
Exit Sub
End If
Call ParktoUserDefine2(UserParks(1))
End Sub
Public Sub UnPark()
Call Unparkscope
End Sub
Public Sub RAReverse()
If HC.RA_inv.Value = 0 Then
HC.RA_inv.Value = 1
Else
HC.RA_inv.Value = 0
End If
End Sub
Public Sub DecReverse()
If HC.DEC_Inv.Value = 0 Then
HC.DEC_Inv.Value = 1
Else
HC.DEC_Inv.Value = 0
End If
End Sub
Public Function ChangeRatePreset(Shift As Integer)
Dim newrate As Double
On Error GoTo errhandle
gCurrentRatePreset = gCurrentRatePreset + Shift
If gCurrentRatePreset > gPresetSlewRatesCount Then
' no more preset in this direction
gCurrentRatePreset = gPresetSlewRatesCount
Call EQ_Beep(30)
Else
If gCurrentRatePreset < 1 Then
' no more preset in this direction
gCurrentRatePreset = 1
Call EQ_Beep(30)
Else
' make a click so the user knows the press has been actioned
End If
End If
' Call EQ_Beep(100 + gCurrentRatePreset)
newrate = gPresetSlewRates(gCurrentRatePreset)
' set the new rates
If newrate > 0 And newrate <= 800 Then
If newrate < 1 Then
newrate = newrate * 10
Else
newrate = newrate + 9
End If
HC.VScrollRASlewRate.Value = newrate
HC.VScrollDecSlewRate.Value = newrate
End If
HC.PresetRateCombo.ListIndex = gCurrentRatePreset - 1
HC.PresetRate2Combo.ListIndex = gCurrentRatePreset - 1
Call ReApplySlew
errhandle:
End Function
Public Function SetRate(rate As Integer)
Dim newrate As Integer
If rate <= HC.PresetRateCombo.ListCount Then
gCurrentRatePreset = gRateButtons(rate)
newrate = gPresetSlewRates(gCurrentRatePreset)
EQ_Beep (100 + gCurrentRatePreset)
' set the new rates
If newrate > 0 And newrate <= 800 Then
If newrate < 1 Then
newrate = newrate * 10
Else
newrate = newrate + 9
End If
HC.VScrollRASlewRate.Value = newrate
HC.VScrollDecSlewRate.Value = newrate
End If
HC.PresetRateCombo.ListIndex = gCurrentRatePreset - 1
HC.PresetRate2Combo.ListIndex = gCurrentRatePreset - 1
Call ReApplySlew
End If
End Function
Public Sub DoSync()
If gTargetRA <> EQ_INVALIDCOORDINATE And gTargetDec <> EQ_INVALIDCOORDINATE Then
HC.Add_Message ("SyncTaget: " & oLangDll.GetLangString(105) & "[ " & FmtSexa(gTargetRA, False) & "] " & oLangDll.GetLangString(106) & "[ " & FmtSexa(gTargetDec, True) & " ]")
SyncToRADEC gTargetRA, gTargetDec, gLongitude, gHemisphere
' force a beep - sounds even if user has selected sounds to be off
EQ_Beep (4)
End If
End Sub
Public Sub LoadJoystickBtns()
Dim tmptxt As String
Dim VarStr As String
Dim key As String
Dim Ini As String
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\JOYSTICK.ini"
key = "[buttondefs]"
tmptxt = HC.oPersist.ReadIniValueEx("StartSidreal", key, Ini)
If tmptxt <> "" Then
BTN_STARTSIDREAL = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY10)
Call HC.oPersist.WriteIniValueEx("StartSidreal", tmptxt, key, Ini)
BTN_STARTSIDREAL = BTN_JOY10
End If
tmptxt = HC.oPersist.ReadIniValueEx("StartPEC", key, Ini)
If tmptxt <> "" Then
BTN_PEC = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("StartPEC", tmptxt, key, Ini)
BTN_STARTSIDREAL = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("StartCustom", key, Ini)
If tmptxt <> "" Then
BTN_CUSTOMTRACKSTART = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("StartCustom", tmptxt, key, Ini)
BTN_CUSTOMTRACKSTART = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("StartLunar", key, Ini)
If tmptxt <> "" Then
BTN_STARTLUNAR = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("StartLunar", tmptxt, key, Ini)
BTN_STARTLUNAR = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("StartSolar", key, Ini)
If tmptxt <> "" Then
BTN_STARTSOLAR = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("StartSolar", tmptxt, key, Ini)
BTN_STARTSOLAR = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("SpiralSearch", key, Ini)
If tmptxt <> "" Then
BTN_SPIRAL = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY1)
Call HC.oPersist.WriteIniValueEx("SpiralSearch", tmptxt, key, Ini)
BTN_SPIRAL = BTN_JOY1
End If
tmptxt = HC.oPersist.ReadIniValueEx("EmergencyStop", key, Ini)
If tmptxt <> "" Then
BTN_EMERGENCYSTOP = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY11)
Call HC.oPersist.WriteIniValueEx("EmergencyStop", tmptxt, key, Ini)
BTN_EMERGENCYSTOP = BTN_JOY11
End If
tmptxt = HC.oPersist.ReadIniValueEx("RARateInc", key, Ini)
If tmptxt <> "" Then
BTN_RARATEINC = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY5)
Call HC.oPersist.WriteIniValueEx("RARateInc", tmptxt, key, Ini)
BTN_RARATEINC = BTN_JOY5
End If
tmptxt = HC.oPersist.ReadIniValueEx("RARateDec", key, Ini)
If tmptxt <> "" Then
BTN_RARATEDEC = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY7)
Call HC.oPersist.WriteIniValueEx("RARateDec", tmptxt, key, Ini)
BTN_RARATEDEC = BTN_JOY7
End If
tmptxt = HC.oPersist.ReadIniValueEx("DecRateInc", key, Ini)
If tmptxt <> "" Then
BTN_DECRATEINC = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY6)
Call HC.oPersist.WriteIniValueEx("DecRateInc", tmptxt, key, Ini)
BTN_DECRATEINC = BTN_JOY6
End If
tmptxt = HC.oPersist.ReadIniValueEx("DecRateDec", key, Ini)
If tmptxt <> "" Then
BTN_DECRATEDEC = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY8)
Call HC.oPersist.WriteIniValueEx("DecRateDec", tmptxt, key, Ini)
BTN_DECRATEDEC = BTN_JOY8
End If
tmptxt = HC.oPersist.ReadIniValueEx("ParkHome", key, Ini)
If tmptxt <> "" Then
BTN_HOMEPARK = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("ParkHome", tmptxt, key, Ini)
BTN_HOMEPARK = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("ParkUser", key, Ini)
If tmptxt <> "" Then
BTN_USERPARK = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("ParkUser", tmptxt, key, Ini)
BTN_USERPARK = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("UnPark", key, Ini)
If tmptxt <> "" Then
BTN_UNPARK = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("UnPark", tmptxt, key, Ini)
BTN_UNPARK = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("AlignAccept", key, Ini)
If tmptxt <> "" Then
BTN_ALIGNACCEPT = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY3)
Call HC.oPersist.WriteIniValueEx("AcceptAlign", tmptxt, key, Ini)
BTN_ALIGNACCEPT = BTN_JOY3
End If
tmptxt = HC.oPersist.ReadIniValueEx("AlignCancel", key, Ini)
If tmptxt <> "" Then
BTN_ALIGNCANCEL = val(tmptxt)
Else
tmptxt = CStr(BTN_JOY2)
Call HC.oPersist.WriteIniValueEx("AlignCancel", tmptxt, key, Ini)
BTN_ALIGNCANCEL = BTN_JOY2
End If
tmptxt = HC.oPersist.ReadIniValueEx("AlignEnd", key, Ini)
If tmptxt <> "" Then
BTN_ALIGNEND = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("AlignEnd", tmptxt, key, Ini)
BTN_ALIGNEND = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("PolarScopeAlign", key, Ini)
If tmptxt <> "" Then
BTN_POLARSCOPEALIGN = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("PolarScopeAlign", tmptxt, key, Ini)
BTN_POLARSCOPEALIGN = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("East", key, Ini)
If tmptxt <> "" Then
BTN_EAST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVE)
Call HC.oPersist.WriteIniValueEx("East", tmptxt, key, Ini)
BTN_EAST = BTN_POVE
End If
tmptxt = HC.oPersist.ReadIniValueEx("West", key, Ini)
If tmptxt <> "" Then
BTN_WEST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVW)
Call HC.oPersist.WriteIniValueEx("West", tmptxt, key, Ini)
BTN_WEST = BTN_POVW
End If
tmptxt = HC.oPersist.ReadIniValueEx("North", key, Ini)
If tmptxt <> "" Then
BTN_NORTH = val(tmptxt)
Else
tmptxt = CStr(BTN_POVN)
Call HC.oPersist.WriteIniValueEx("North", tmptxt, key, Ini)
BTN_NORTH = BTN_POVN
End If
tmptxt = HC.oPersist.ReadIniValueEx("South", key, Ini)
If tmptxt <> "" Then
BTN_SOUTH = val(tmptxt)
Else
tmptxt = CStr(BTN_POVS)
Call HC.oPersist.WriteIniValueEx("South", tmptxt, key, Ini)
BTN_SOUTH = BTN_POVS
End If
tmptxt = HC.oPersist.ReadIniValueEx("NorthEast", key, Ini)
If tmptxt <> "" Then
BTN_NORTHEAST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVNE)
Call HC.oPersist.WriteIniValueEx("NorthEast", tmptxt, key, Ini)
BTN_NORTHEAST = BTN_POVNE
End If
tmptxt = HC.oPersist.ReadIniValueEx("NorthWest", key, Ini)
If tmptxt <> "" Then
BTN_NORTHWEST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVNW)
Call HC.oPersist.WriteIniValueEx("NorthWest", tmptxt, key, Ini)
BTN_NORTHWEST = BTN_POVNW
End If
tmptxt = HC.oPersist.ReadIniValueEx("SouthEast", key, Ini)
If tmptxt <> "" Then
BTN_SOUTHEAST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVSE)
Call HC.oPersist.WriteIniValueEx("SouthEast", tmptxt, key, Ini)
BTN_SOUTHEAST = BTN_POVSE
End If
tmptxt = HC.oPersist.ReadIniValueEx("SouthWest", key, Ini)
If tmptxt <> "" Then
BTN_SOUTHWEST = val(tmptxt)
Else
tmptxt = CStr(BTN_POVSW)
Call HC.oPersist.WriteIniValueEx("SouthWest", tmptxt, key, Ini)
BTN_SOUTHWEST = BTN_POVSW
End If
tmptxt = HC.oPersist.ReadIniValueEx("ReverseRA", key, Ini)
If tmptxt <> "" Then
BTN_RAREVERSE = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("ReverseRA", tmptxt, key, Ini)
BTN_RAREVERSE = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("ReverseDec", key, Ini)
If tmptxt <> "" Then
BTN_DECREVERSE = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("ReverseDec", tmptxt, key, Ini)
BTN_DECREVERSE = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("IncRatePreset", key, Ini)
If tmptxt <> "" Then
BTN_INCRATEPRESET = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("IncRatePreset", tmptxt, key, Ini)
BTN_INCRATEPRESET = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("DecRatePreset", key, Ini)
If tmptxt <> "" Then
BTN_DECRATEPRESET = val(tmptxt)
Else
tmptxt = CStr(BTN_UNDEFINED)
Call HC.oPersist.WriteIniValueEx("DecRatePreset", tmptxt, key, Ini)
BTN_DECRATEPRESET = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("Rate1", key, Ini)
If tmptxt <> "" Then
BTN_RATE1 = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("Rate1", CStr(BTN_UNDEFINED), key, Ini)
BTN_RATE1 = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("Rate2", key, Ini)
If tmptxt <> "" Then
BTN_RATE2 = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("Rate2", CStr(BTN_UNDEFINED), key, Ini)
BTN_RATE2 = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("Rate3", key, Ini)
If tmptxt <> "" Then
BTN_RATE3 = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("Rate3", CStr(BTN_UNDEFINED), key, Ini)
BTN_RATE3 = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("Rate4", key, Ini)
If tmptxt <> "" Then
BTN_RATE4 = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("Rate4", CStr(BTN_UNDEFINED), key, Ini)
BTN_RATE4 = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("GPSync", key, Ini)
If tmptxt <> "" Then
BTN_SYNC = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("GPsync", CStr(BTN_UNDEFINED), key, Ini)
BTN_SYNC = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("DeadMansHandle", key, Ini)
If tmptxt <> "" Then
BTN_DEADMANSHANDLE = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("DeadMansHandle", CStr(BTN_DEADMANSHANDLE), key, Ini)
BTN_DEADMANSHANDLE = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("ToggleLock", key, Ini)
If tmptxt <> "" Then
BTN_TOGGLELOCK = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("ToggleLock", CStr(BTN_TOGGLELOCK), key, Ini)
BTN_TOGGLELOCK = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("ToggleScreenSaver", key, Ini)
If tmptxt <> "" Then
BTN_TOGGLESCREENSAVER = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("ToggleScreenSaver", CStr(BTN_TOGGLESCREENSAVER), key, Ini)
BTN_TOGGLESCREENSAVER = BTN_UNDEFINED
End If
tmptxt = HC.oPersist.ReadIniValueEx("MonitorMode", key, Ini)
If tmptxt <> "" Then
gMonitorMode = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("MonitorMode", "0", key, Ini)
gMonitorMode = 0
End If
key = "[keydefs]"
tmptxt = HC.oPersist.ReadIniValueEx("key_north", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.North = val(tmptxt)
Else
UserKeyDefs.North = 38 ' up arrow
Call HC.oPersist.WriteIniValueEx("key_north", "38", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_south", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.South = val(tmptxt)
Else
UserKeyDefs.South = 40 ' down arrow
Call HC.oPersist.WriteIniValueEx("key_south", "40", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_west", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.West = val(tmptxt)
Else
UserKeyDefs.West = 37 ' left arrow
Call HC.oPersist.WriteIniValueEx("key_west", "37", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_east", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.East = val(tmptxt)
Else
UserKeyDefs.East = 37 ' right arrow
Call HC.oPersist.WriteIniValueEx("key_east", "39", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_northwest", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.NorthWest = val(tmptxt)
Else
UserKeyDefs.NorthWest = 36 ' Home
Call HC.oPersist.WriteIniValueEx("key_northwest", "36", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_northeast", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.NorthEast = val(tmptxt)
Else
UserKeyDefs.NorthEast = 33 ' Home
Call HC.oPersist.WriteIniValueEx("key_northeast", "33", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_southwest", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.SouthWest = val(tmptxt)
Else
UserKeyDefs.SouthWest = 35 ' End
Call HC.oPersist.WriteIniValueEx("key_southwest", "35", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_southeast", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.SouthEast = val(tmptxt)
Else
UserKeyDefs.SouthEast = 34 ' PageDown
Call HC.oPersist.WriteIniValueEx("key_southeast", "34", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_stop", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.Stop = val(tmptxt)
Else
UserKeyDefs.Stop = 101 ' Numeric Keypad 5
Call HC.oPersist.WriteIniValueEx("key_stop", "101", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_track", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.Track = val(tmptxt)
Else
UserKeyDefs.Track = 45 ' Numeric Keypad INS
Call HC.oPersist.WriteIniValueEx("key_track", "45", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_ratedec", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.RateDec = val(tmptxt)
Else
UserKeyDefs.RateDec = 109 ' Numeric Keypad -
Call HC.oPersist.WriteIniValueEx("key_ratedec", "109", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_rateinc", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.RateInc = val(tmptxt)
Else
UserKeyDefs.RateInc = 107 ' Numeric Keypad +
Call HC.oPersist.WriteIniValueEx("key_rateinc", "107", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("key_spiral", key, Ini)
If tmptxt <> "" Then
UserKeyDefs.Spiral = val(tmptxt)
Else
UserKeyDefs.Spiral = 106 ' Numeric Keypad *
Call HC.oPersist.WriteIniValueEx("key_spiral", "106", key, Ini)
End If
End Sub
Public Sub SaveJoystickBtns()
Dim key As String
Dim Ini As String
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\JOYSTICK.ini"
key = "[buttondefs]"
Call HC.oPersist.WriteIniValueEx("StartSidreal", CStr(BTN_STARTSIDREAL), key, Ini)
Call HC.oPersist.WriteIniValueEx("StartPEC", CStr(BTN_PEC), key, Ini)
Call HC.oPersist.WriteIniValueEx("SpiralSearch", CStr(BTN_SPIRAL), key, Ini)
Call HC.oPersist.WriteIniValueEx("EmergencyStop", CStr(BTN_EMERGENCYSTOP), key, Ini)
Call HC.oPersist.WriteIniValueEx("RARateInc", CStr(BTN_RARATEINC), key, Ini)
Call HC.oPersist.WriteIniValueEx("RARateDec", CStr(BTN_RARATEDEC), key, Ini)
Call HC.oPersist.WriteIniValueEx("DecRateInc", CStr(BTN_DECRATEINC), key, Ini)
Call HC.oPersist.WriteIniValueEx("DecRateDec", CStr(BTN_DECRATEDEC), key, Ini)
Call HC.oPersist.WriteIniValueEx("ParkHome", CStr(BTN_HOMEPARK), key, Ini)
Call HC.oPersist.WriteIniValueEx("ParkUser", CStr(BTN_USERPARK), key, Ini)
Call HC.oPersist.WriteIniValueEx("ParkCurrent", CStr(BTN_CURRENTPARK), key, Ini)
Call HC.oPersist.WriteIniValueEx("UnPark", CStr(BTN_UNPARK), key, Ini)
Call HC.oPersist.WriteIniValueEx("AlignAccept", CStr(BTN_ALIGNACCEPT), key, Ini)
Call HC.oPersist.WriteIniValueEx("AlignCancel", CStr(BTN_ALIGNCANCEL), key, Ini)
Call HC.oPersist.WriteIniValueEx("AlignEnd", CStr(BTN_ALIGNEND), key, Ini)
Call HC.oPersist.WriteIniValueEx("PolarScopeAlign", CStr(BTN_POLARSCOPEALIGN), key, Ini)
Call HC.oPersist.WriteIniValueEx("East", CStr(BTN_EAST), key, Ini)
Call HC.oPersist.WriteIniValueEx("West", CStr(BTN_WEST), key, Ini)
Call HC.oPersist.WriteIniValueEx("North", CStr(BTN_NORTH), key, Ini)
Call HC.oPersist.WriteIniValueEx("South", CStr(BTN_SOUTH), key, Ini)
Call HC.oPersist.WriteIniValueEx("NorthEast", CStr(BTN_NORTHEAST), key, Ini)
Call HC.oPersist.WriteIniValueEx("NorthWest", CStr(BTN_NORTHWEST), key, Ini)
Call HC.oPersist.WriteIniValueEx("SouthEast", CStr(BTN_SOUTHEAST), key, Ini)
Call HC.oPersist.WriteIniValueEx("SouthWest", CStr(BTN_SOUTHWEST), key, Ini)
Call HC.oPersist.WriteIniValueEx("ReverseRA", CStr(BTN_RAREVERSE), key, Ini)
Call HC.oPersist.WriteIniValueEx("ReverseDec", CStr(BTN_DECREVERSE), key, Ini)
Call HC.oPersist.WriteIniValueEx("StartCustom", CStr(BTN_CUSTOMTRACKSTART), key, Ini)
Call HC.oPersist.WriteIniValueEx("StartLunar", CStr(BTN_STARTLUNAR), key, Ini)
Call HC.oPersist.WriteIniValueEx("StartSolar", CStr(BTN_STARTSOLAR), key, Ini)
Call HC.oPersist.WriteIniValueEx("IncRatePreset", CStr(BTN_INCRATEPRESET), key, Ini)
Call HC.oPersist.WriteIniValueEx("DecRatePreset", CStr(BTN_DECRATEPRESET), key, Ini)
Call HC.oPersist.WriteIniValueEx("Rate1", CStr(BTN_RATE1), key, Ini)
Call HC.oPersist.WriteIniValueEx("Rate2", CStr(BTN_RATE2), key, Ini)
Call HC.oPersist.WriteIniValueEx("Rate3", CStr(BTN_RATE3), key, Ini)
Call HC.oPersist.WriteIniValueEx("Rate4", CStr(BTN_RATE4), key, Ini)
Call HC.oPersist.WriteIniValueEx("GPSync", CStr(BTN_SYNC), key, Ini)
Call HC.oPersist.WriteIniValueEx("DeadMansHandle", CStr(BTN_DEADMANSHANDLE), key, Ini)
Call HC.oPersist.WriteIniValueEx("ToggleLock", CStr(BTN_TOGGLELOCK), key, Ini)
Call HC.oPersist.WriteIniValueEx("ToggleScreenSaver", CStr(BTN_TOGGLESCREENSAVER), key, Ini)
Call HC.oPersist.WriteIniValueEx("MonitorMode", CStr(gMonitorMode), key, Ini)
End Sub
Public Sub LoadJoystickCalib()
Dim tmptxt As String
Dim VarStr As String
Dim key As String
Dim Ini As String
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\JOYSTICK.ini"
key = "[calibration]"
tmptxt = HC.oPersist.ReadIniValueEx("Debug1", key, Ini)
If tmptxt = "1" Then
JoystickCal.HalfRes = True
Else
JoystickCal.HalfRes = False
Call HC.oPersist.WriteIniValueEx("Debug1", "0", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("MinX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMinXpos = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("MinX", tmptxt, key, Ini)
JoystickCal.dwMinXpos = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("90LX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX90left = val(tmptxt)
Else
tmptxt = "3277"
Call HC.oPersist.WriteIniValueEx("90LX", tmptxt, key, Ini)
JoystickCal.dwX90left = 3277
End If
tmptxt = HC.oPersist.ReadIniValueEx("75LX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX75left = val(tmptxt)
Else
tmptxt = "8192"
Call HC.oPersist.WriteIniValueEx("75LX", tmptxt, key, Ini)
JoystickCal.dwX75left = 8192
End If
tmptxt = HC.oPersist.ReadIniValueEx("25LX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX25Left = val(tmptxt)
Else
tmptxt = "24576"
Call HC.oPersist.WriteIniValueEx("25LX", tmptxt, key, Ini)
JoystickCal.dwX25Left = 24576
End If
tmptxt = HC.oPersist.ReadIniValueEx("25RX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX25Right = val(tmptxt)
Else
tmptxt = "40960"
Call HC.oPersist.WriteIniValueEx("25RX", tmptxt, key, Ini)
JoystickCal.dwX25Right = 40960
End If
tmptxt = HC.oPersist.ReadIniValueEx("75RX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX75Right = val(tmptxt)
Else
tmptxt = "57344"
Call HC.oPersist.WriteIniValueEx("75RX", tmptxt, key, Ini)
JoystickCal.dwX75Right = 57344
End If
tmptxt = HC.oPersist.ReadIniValueEx("90RX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwX90Right = val(tmptxt)
Else
tmptxt = "62258"
Call HC.oPersist.WriteIniValueEx("90RX", tmptxt, key, Ini)
JoystickCal.dwX90Right = 62258
End If
tmptxt = HC.oPersist.ReadIniValueEx("MaxX", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMaxXpos = val(tmptxt)
Else
tmptxt = "65535"
Call HC.oPersist.WriteIniValueEx("MaxX", tmptxt, key, Ini)
JoystickCal.dwMaxXpos = 65535
End If
tmptxt = HC.oPersist.ReadIniValueEx("MinY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMinYpos = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("MinY", tmptxt, key, Ini)
JoystickCal.dwMinYpos = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("90LY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY90left = val(tmptxt)
Else
tmptxt = "3277"
Call HC.oPersist.WriteIniValueEx("90LY", tmptxt, key, Ini)
JoystickCal.dwY90left = 3277
End If
tmptxt = HC.oPersist.ReadIniValueEx("75LY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY75left = val(tmptxt)
Else
tmptxt = "8192"
Call HC.oPersist.WriteIniValueEx("75LY", tmptxt, key, Ini)
JoystickCal.dwY75left = 8192
End If
tmptxt = HC.oPersist.ReadIniValueEx("25LY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY25Left = val(tmptxt)
Else
tmptxt = "24576"
Call HC.oPersist.WriteIniValueEx("25LY", tmptxt, key, Ini)
JoystickCal.dwY25Left = 24576
End If
tmptxt = HC.oPersist.ReadIniValueEx("25RY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY25Right = val(tmptxt)
Else
tmptxt = "40960"
Call HC.oPersist.WriteIniValueEx("25RY", tmptxt, key, Ini)
JoystickCal.dwY25Right = 40960
End If
tmptxt = HC.oPersist.ReadIniValueEx("75RY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY75Right = val(tmptxt)
Else
tmptxt = "57344"
Call HC.oPersist.WriteIniValueEx("75RY", tmptxt, key, Ini)
JoystickCal.dwY75Right = 57344
End If
tmptxt = HC.oPersist.ReadIniValueEx("90RY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwY90Right = val(tmptxt)
Else
tmptxt = "62258"
Call HC.oPersist.WriteIniValueEx("90RY", tmptxt, key, Ini)
JoystickCal.dwY90Right = 62258
End If
tmptxt = HC.oPersist.ReadIniValueEx("MaxY", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMaxYpos = val(tmptxt)
Else
tmptxt = "65535"
Call HC.oPersist.WriteIniValueEx("MaxY", tmptxt, key, Ini)
JoystickCal.dwMaxYpos = 65535
End If
tmptxt = HC.oPersist.ReadIniValueEx("MinZ", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMinZpos = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("MinZ", tmptxt, key, Ini)
JoystickCal.dwMinZpos = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("MaxZ", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMaxZpos = val(tmptxt)
Else
tmptxt = "65535"
Call HC.oPersist.WriteIniValueEx("MaxZ", tmptxt, key, Ini)
JoystickCal.dwMaxZpos = 65535
End If
tmptxt = HC.oPersist.ReadIniValueEx("MinR", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMinRpos = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("MinR", tmptxt, key, Ini)
JoystickCal.dwMinRpos = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("MaxR", key, Ini)
If tmptxt <> "" Then
JoystickCal.dwMaxRpos = val(tmptxt)
Else
tmptxt = "65535"
Call HC.oPersist.WriteIniValueEx("MaxR", tmptxt, key, Ini)
JoystickCal.dwMaxRpos = 65535
End If
tmptxt = HC.oPersist.ReadIniValueEx("Enabled", key, Ini)
If tmptxt <> "" Then
JoystickCal.Enabled = val(tmptxt)
Else
tmptxt = "1"
Call HC.oPersist.WriteIniValueEx("Enabled", tmptxt, key, Ini)
JoystickCal.Enabled = 1
End If
tmptxt = HC.oPersist.ReadIniValueEx("JS_Enabled", key, Ini)
If tmptxt <> "" Then
JoystickCal.StickEnabled = val(tmptxt)
Else
tmptxt = "1"
Call HC.oPersist.WriteIniValueEx("JS_Enabled", tmptxt, key, Ini)
JoystickCal.StickEnabled = 1
End If
tmptxt = HC.oPersist.ReadIniValueEx("POV_Enabled", key, Ini)
If tmptxt <> "" Then
JoystickCal.POVEnabled = val(tmptxt)
Else
tmptxt = "1"
Call HC.oPersist.WriteIniValueEx("POV_Enabled", tmptxt, key, Ini)
JoystickCal.POVEnabled = 1
End If
tmptxt = HC.oPersist.ReadIniValueEx("DualSpeed", key, Ini)
If tmptxt <> "" Then
JoystickCal.DualSpeed = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("DualSpeed", tmptxt, key, Ini)
JoystickCal.DualSpeed = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("SwapXY", key, Ini)
If tmptxt <> "" Then
JoystickCal.SwapXY = val(tmptxt)
Else
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("SwapXY", tmptxt, key, Ini)
JoystickCal.SwapXY = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("Id", key, Ini)
If tmptxt <> "" Then
JoystickCal.id = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("id", "-1", key, Ini)
JoystickCal.id = -1
End If
End Sub
Public Sub SaveJoystickCalib()
Dim tmptxt As String
Dim VarStr As String
Dim key As String
Dim Ini As String
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\JOYSTICK.ini"
key = "[calibration]"
tmptxt = CStr(JoystickCal.dwMinXpos)
Call HC.oPersist.WriteIniValueEx("MinX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX25Left)
Call HC.oPersist.WriteIniValueEx("25LX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX75left)
Call HC.oPersist.WriteIniValueEx("75LX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX90left)
Call HC.oPersist.WriteIniValueEx("90LX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX25Right)
Call HC.oPersist.WriteIniValueEx("25RX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX75Right)
Call HC.oPersist.WriteIniValueEx("75RX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwX90Right)
Call HC.oPersist.WriteIniValueEx("90RX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMaxXpos)
Call HC.oPersist.WriteIniValueEx("MaxX", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMinYpos)
Call HC.oPersist.WriteIniValueEx("MinY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY25Left)
Call HC.oPersist.WriteIniValueEx("25LY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY75left)
Call HC.oPersist.WriteIniValueEx("75LY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY90left)
Call HC.oPersist.WriteIniValueEx("90LY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY25Right)
Call HC.oPersist.WriteIniValueEx("25RY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY75Right)
Call HC.oPersist.WriteIniValueEx("75RY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwY90Right)
Call HC.oPersist.WriteIniValueEx("90RY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMaxYpos)
Call HC.oPersist.WriteIniValueEx("MaxY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMinZpos)
Call HC.oPersist.WriteIniValueEx("MinZ", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMaxZpos)
Call HC.oPersist.WriteIniValueEx("MaxZ", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMinRpos)
Call HC.oPersist.WriteIniValueEx("MinR", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.dwMaxRpos)
Call HC.oPersist.WriteIniValueEx("MaxR", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.Enabled)
Call HC.oPersist.WriteIniValueEx("Enabled", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.StickEnabled)
Call HC.oPersist.WriteIniValueEx("JS_Enabled", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.POVEnabled)
Call HC.oPersist.WriteIniValueEx("POV_Enabled", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.DualSpeed)
Call HC.oPersist.WriteIniValueEx("DualSpeed", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.SwapXY)
Call HC.oPersist.WriteIniValueEx("SwapXY", tmptxt, key, Ini)
tmptxt = CStr(JoystickCal.id)
Call HC.oPersist.WriteIniValueEx("id", tmptxt, key, Ini)
End Sub
' at 4128 Done code part. Lines - 1 Analysing hcsmall.frm Done form part, 286 controls found Done code part. Lines - 7389 Analysing alignment.basError parsing line 'Attribute VB_Name = "Alignment"
Option Explicit
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' Common.bas - Common functions for EQMOD ASCOM driver
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 12-Feb-07 sander Created file, copied contents from common.bas
' including new datastructure for alignment data
' 19-Mar-07 rcs Initial Edit for Three star alignment
' 08-Apr-07 rcs N-star implementation
' 14-Jul-07 Use 1star even before 3 star is activated
'---------------------------------------------------------------------
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
Public Const MAX_STARS As Integer = 1000
Public Const MAX_COMBINATION As Integer = 32767
Public Const MAX_COMBINATION_COUNT As Integer = 50
Public gThreeStarEnable As Boolean
Public gSelectStar As Long
Public gMaxCombinationCount As Integer
Public gLoadAPresetOnUnpark As Integer
Public gSaveAPresetOnPark As Integer
Public gSaveAPresetOnAppend As Integer
Public ProximityRa As Long
Public ProximityDec As Long
Public gRA_GOTO As Double
Public gDEC_GOTO As Double
Public Type AlignmentData
OrigTargetRA As Double
OrigTargetDEC As Double
TargetRA As Double
TargetDEC As Double
EncoderRA As Double
EncoderDEC As Double
AlignTime As Date
End Type
Public Enum AlignmentType
Onestar = 1
ThreeStar = 3
multistar = 99
End Enum
Public gAlignmentStars_count As Integer
Public AlignmentStars(MAX_STARS) As AlignmentData
Public ct_Points(1 To MAX_STARS) As Coord 'Catalog Points
Public my_Points(1 To MAX_STARS) As Coord 'My Measured Points
Public ct_PointsC(1 To MAX_STARS) As Coord 'Catalog Points (Cartesian)
Public my_PointsC(1 To MAX_STARS) As Coord 'My Measured Points (Cartesian)
Public Sub EQ_NPointDelete(ByVal Index As Long)
Dim i As Long
If Index <> gAlignmentStars_count Then
' first or middle element, move elements one spot
For i = Index To gAlignmentStars_count - 1
AlignmentStars(i) = AlignmentStars(i + 1)
Next i
End If
gAlignmentStars_count = gAlignmentStars_count - 1
End Sub
Public Sub CalcPromximityLimits(ByVal range As Integer)
ProximityRa = range * gTot_RA / 360
ProximityDec = range * gTot_DEC / 360
End Sub
Public Function EQ_NPointAppend(ByVal RightAscension As Double, ByVal Declination As Double, ByVal pLongitude As Double, ByVal pHemisphere As Long) As Boolean
Dim tRa As Double
Dim tha As Double
Dim tPier As Double
Dim vRA As Double
Dim vDEC As Double
Dim DeltaRa As Double
Dim DeltaDec As Double
Dim curalign As Integer
Dim i As Integer
Dim Count As Integer
Dim ERa As Long
Dim EDec As Long
Dim RA_Hours As Double
Dim flipped As Boolean
EQ_NPointAppend = True
If gSlewStatus = True Then
HC.Add_Message (oLangDll.GetLangString(5027))
EQ_NPointAppend = False
Exit Function
End If
HC.EncoderTimer.Enabled = False
curalign = gAlignmentStars_count + 1
' build alignment record
ERa = EQGetMotorValues(0)
EDec = EQGetMotorValues(1)
vRA = RightAscension
vDEC = Declination
' look at current position and detemrine if flipped
RA_Hours = Get_EncoderHours(gRAEncoder_Zero_pos, CDbl(ERa), gTot_RA, gHemisphere)
If RA_Hours > 12 Then
' Yes we're currently flipped!
flipped = True
Else
flipped = False
End If
tha = RangeHA(vRA - EQnow_lst(pLongitude * DEG_RAD))
If tha < 0 Then
If flipped Then
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = vRA
Else
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(vRA - 12)
End If
Else
If flipped Then
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(vRA - 12)
Else
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = vRA
End If
End If
'Compute for Sync RA/DEC Encoder Values
With AlignmentStars(curalign)
.OrigTargetDEC = Declination
.OrigTargetRA = RightAscension
.TargetRA = Get_RAEncoderfromRA(tRa, 0, pLongitude, gRAEncoder_Zero_pos, gTot_RA, pHemisphere)
.TargetDEC = Get_DECEncoderfromDEC(vDEC, tPier, gDECEncoder_Zero_pos, gTot_DEC, pHemisphere)
.EncoderRA = ERa
.EncoderDEC = EDec
.AlignTime = Now
DeltaRa = .TargetRA - .EncoderRA
DeltaDec = .TargetDEC - .EncoderDEC
End With
HC.EncoderTimer.Enabled = True
If (Abs(DeltaRa) < gEQ_MAXSYNC) And (Abs(DeltaDec) < gEQ_MAXSYNC) Or gDisableSyncLimit = True Then
' Use this data also for next sync until a three star is achieved
gRA1Star = DeltaRa
gDEC1Star = DeltaDec
If curalign < 3 Then
HC.Add_Message (str(curalign) & " " & oLangDll.GetLangString(6009))
gAlignmentStars_count = gAlignmentStars_count + 1
Else
If curalign = 3 Then
gAlignmentStars_count = 3
Call SendtoMatrix
Else
' add new point
Count = 1
' copy points to temp array
For i = 1 To curalign - 1
DeltaRa = Abs(AlignmentStars(i).EncoderRA - ERa)
DeltaDec = Abs(AlignmentStars(i).EncoderDEC - EDec)
If DeltaRa > ProximityRa Or DeltaDec > ProximityDec Then
' point is far enough away from the new point - so keep it
AlignmentStars(Count) = AlignmentStars(i)
Count = Count + 1
Else
' HC.Add_Message ("Old Point too close " & CStr(deltaRA) & " " & CStr(deltadec) & " " & CStr(ProximityDec))
End If
Next i
AlignmentStars(Count) = AlignmentStars(curalign)
curalign = Count
gAlignmentStars_count = curalign
Call SendtoMatrix
StarEditform.RefreshDisplay = True
End If
End If
Else
' sync is too large!
EQ_NPointAppend = False
HC.Add_Message (oLangDll.GetLangString(6004))
HC.Add_Message ("Target RA=" & FmtSexa(gRA, False))
HC.Add_Message ("Sync RA=" & FmtSexa(RightAscension, False))
HC.Add_Message ("Target DEC=" & FmtSexa(gDec, True))
HC.Add_Message ("Sync DEC=" & FmtSexa(Declination, True))
End If
If gSaveAPresetOnAppend = 1 Then
' don't write emtpy list!
If (gAlignmentStars_count > 0) Then
'idx = GetPresetIdx
Call SaveAlignmentStars(GetPresetIdx, "")
End If
End If
End Function
Public Sub SendtoMatrix()
Dim i As Integer
For i = 1 To gAlignmentStars_count
ct_Points(i).x = AlignmentStars(i).TargetRA
ct_Points(i).Y = AlignmentStars(i).TargetDEC
ct_Points(i).z = 1
ct_PointsC(i) = EQ_sp2Cs(ct_Points(i))
my_Points(i).x = AlignmentStars(i).EncoderRA
my_Points(i).Y = AlignmentStars(i).EncoderDEC
my_Points(i).z = 1
my_PointsC(i) = EQ_sp2Cs(my_Points(i))
Next i
'Activate Matrix here
Call ActivateMatrix
End Sub
Public Sub ActivateMatrix()
Dim i As Integer
' assume false - will set true later if 3 stars active
gThreeStarEnable = False
HC.EncoderTimer.Enabled = False
If HC.PolarEnable.Value = 1 Then
If gAlignmentStars_count >= 3 Then
i = EQ_AssembleMatrix_Taki(0, 0, ct_PointsC(1), ct_PointsC(2), ct_PointsC(3), my_PointsC(1), my_PointsC(2), my_PointsC(3))
i = EQ_AssembleMatrix_Affine(0, 0, my_PointsC(1), my_PointsC(2), my_PointsC(3), ct_PointsC(1), ct_PointsC(2), ct_PointsC(3))
gThreeStarEnable = True
End If
Else
If gAlignmentStars_count >= 3 Then
i = EQ_AssembleMatrix_Taki(0, 0, ct_PointsC(1), ct_PointsC(2), ct_PointsC(3), my_PointsC(1), my_PointsC(2), my_PointsC(3))
i = EQ_AssembleMatrix_Affine(0, 0, my_PointsC(1), my_PointsC(2), my_PointsC(3), ct_PointsC(1), ct_PointsC(2), ct_PointsC(3))
gThreeStarEnable = True
End If
End If
HC.EncoderTimer.Enabled = True
End Sub
'''''''''''''''''''''''''
' Alignment preset stuff
'''''''''''''''''''''''''
Public Sub SaveAlignmentStars(preset As Integer, presetName As String)
Dim Index As Integer
Dim DataStr As String
Dim tmp As String
Dim key As String
Dim Alignini As String
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
key = "[alignment_preset" & CStr(preset) & "]"
If presetName = "" Then
' get existing name
presetName = HC.oPersist.ReadIniValueEx("NAME", key, Alignini)
End If
' delete existing section
Call HC.oPersist.DeleteSection(key, Alignini)
' write new data
HC.oPersist.WriteIniValueEx "STAR_COUNT", CStr(gAlignmentStars_count), key, Alignini
HC.oPersist.WriteIniValueEx "NAME", presetName, key, Alignini
For Index = 1 To gAlignmentStars_count
tmp = "Star" + CStr(Index)
With AlignmentStars(Index)
DataStr = CStr(.AlignTime) + ";" + CStr(.OrigTargetRA) + ";" + CStr(.OrigTargetDEC) + ";" + CStr(.TargetRA) + ";" + CStr(.TargetDEC) + ";" + CStr(.EncoderRA) + ";" + CStr(.EncoderDEC) + ";"
HC.oPersist.WriteIniValueEx tmp, DataStr, key, Alignini
End With
Next Index
End Sub
Public Function LoadAlignmentPreset(preset As Integer) As Boolean
Dim Count As Integer
Dim tmptxt As String
Dim tmptxt2 As String
Dim VarStr As String
Dim pos As Integer
Dim Index As Integer
Dim ValidCount As Integer
Dim MaxCount As Integer
Dim NewData As AlignmentData
Dim key As String
Dim Alignini As String
Dim ret As Boolean
ret = False
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
key = "[alignment_preset" & CStr(preset) & "]"
tmptxt = HC.oPersist.ReadIniValueEx("STAR_COUNT", key, Alignini)
If tmptxt <> "" Then
MaxCount = val(tmptxt)
If MaxCount > MAX_STARS Then
MaxCount = MAX_STARS
End If
Else
MaxCount = 0
End If
On Error GoTo DecodeError
If MaxCount <> 0 Then
ValidCount = 0
For Index = 1 To MaxCount
VarStr = "Star" + CStr(Index)
tmptxt = HC.oPersist.ReadIniValueEx(VarStr, key, Alignini)
If tmptxt <> "" Then
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.AlignTime = tmptxt2
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.OrigTargetRA = CDbl(tmptxt2)
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.OrigTargetDEC = CDbl(tmptxt2)
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.TargetRA = CDbl(tmptxt2)
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.TargetDEC = CDbl(tmptxt2)
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
tmptxt = Right$(tmptxt, Len(tmptxt) - pos)
NewData.EncoderRA = CDbl(tmptxt2)
pos = InStr(tmptxt, ";")
If pos = 0 Then GoTo DecodeError
tmptxt2 = Left$(tmptxt, pos - 1)
NewData.EncoderDEC = CDbl(tmptxt2)
' all data read ok - copy to alignment stars
AlignmentStars(Index) = NewData
ValidCount = ValidCount + 1
Else
GoTo DecodeError
End If
Next Index
DecodeError:
On Error Resume Next
gAlignmentStars_count = ValidCount
' send to matrix will initialise the catalog and measured points arrays
Call SendtoMatrix
ret = True
End If
LoadAlignmentPreset = ret
End Function
Public Sub SavePresetIdx(idx As Integer)
Dim Index As Integer
Dim tmptxt As String
Dim Alignini As String
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
tmptxt = CStr(idx)
Call HC.oPersist.WriteIniValueEx("active_preset", tmptxt, "[default]", Alignini)
End Sub
Public Function GetPresetIdx() As Integer
Dim Index As Integer
Dim tmptxt As String
Dim Alignini As String
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
tmptxt = HC.oPersist.ReadIniValueEx("active_preset", "[default]", Alignini)
If tmptxt = "" Then
' ini file entry doesn't exist so create one
tmptxt = "0"
Call HC.oPersist.WriteIniValueEx("active_preset", tmptxt, "[default]", Alignini)
End If
GetPresetIdx = val(tmptxt)
If GetPresetIdx > 10 Then
GetPresetIdx = 0
End If
End Function
Public Sub ReadParkOptions()
Dim keyStr As String
Dim tmptxt As String
Dim Alignini As String
keyStr = "[default]"
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
tmptxt = HC.oPersist.ReadIniValueEx("LOAD_APRESET_ON_UNPARK", keyStr, Alignini)
If tmptxt = "" Then
' create a preset place holder
Call HC.oPersist.WriteIniValueEx("LOAD_APRESET_ON_UNPARK", "0", keyStr, Alignini)
gLoadAPresetOnUnpark = 0
Else
gLoadAPresetOnUnpark = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValueEx("SAVE_APRESET_ON_UNPARK", keyStr, Alignini)
If tmptxt = "" Then
' create a preset place holder
Call HC.oPersist.WriteIniValueEx("SAVE_APRESET_ON_UNPARK", "0", keyStr, Alignini)
gSaveAPresetOnPark = 0
Else
gSaveAPresetOnPark = val(tmptxt)
End If
tmptxt = HC.oPersist.ReadIniValueEx("SAVE_APRESET_ON_APPEND", keyStr, Alignini)
If tmptxt = "" Then
' create a preset place holder
Call HC.oPersist.WriteIniValueEx("SAVE_APRESET_ON_APPEND", "0", keyStr, Alignini)
gSaveAPresetOnAppend = 0
Else
gSaveAPresetOnAppend = val(tmptxt)
End If
End Sub
Public Sub WriteParkOptions()
Dim keyStr As String
Dim tmptxt As String
Dim Alignini As String
keyStr = "[default]"
' set up a file path for the aligncls.ini file
Alignini = HC.oPersist.GetIniPath & "\aligncls.ini"
Call HC.oPersist.WriteIniValueEx("LOAD_APRESET_ON_UNPARK", CStr(gLoadAPresetOnUnpark), keyStr, Alignini)
Call HC.oPersist.WriteIniValueEx("SAVE_APRESET_ON_UNPARK", CStr(gSaveAPresetOnPark), keyStr, Alignini)
Call HC.oPersist.WriteIniValueEx("SAVE_APRESET_ON_APPEND", CStr(gSaveAPresetOnAppend), keyStr, Alignini)
End Sub
Public Sub AligmentStarsPark()
Dim idx As Integer
ReadParkOptions
If gSaveAPresetOnPark = 1 Then
' don't write emtpy list!
If (gAlignmentStars_count > 0) Then
idx = GetPresetIdx
Call SaveAlignmentStars(idx, "")
End If
End If
End Sub
Public Sub AlignmentStarsUnpark()
Dim idx As Integer
ReadParkOptions
' if load on unpark selected
If gLoadAPresetOnUnpark = 1 Then
' read curent preset index from ini file
idx = GetPresetIdx
' load the preset data
Call LoadAlignmentPreset(idx)
End If
End Sub
' at 4143 Done code part. Lines - 1 Analysing eqmodvector.basError parsing line 'Attribute VB_Name = "eqmodvector"
'---------------------------------------------------------------------
' Copyright © 2006 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' EQMODVECTOR.BAS - Matrix Transformation Routines for 3-Star Alignment
'
' Written: 10-Dec-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 10-Dec-06 rcs Initial edit for EQ Mount 3-Star Matrix Transformation
' 14-Dec-06 rcs Added Taki Method on top of Affine Mapping Method for Comparison
' Taki Routines based on John Archbold's Excel computation
' 08-Apr-07 rcs N-star implementation
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of the 3-Star Alignment Algorithm for the EQContrl.DLL
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
Option Explicit
Public Type Coord
x As Double 'x = X Coordinate
Y As Double 'y = Y Coordinate
z As Double
End Type
Type Tdatholder
dat As Double
idx As Integer
cc As Coord ' cartesian coordinate
End Type
Type THolder
a As Double
b As Double
c As Double
End Type
Public Type Matrix
Element(1 To 3, 1 To 3) As Double '2D array of elements
End Type
Public Type Matrix2
Element(1 To 4, 1 To 4) As Double '2D array of elements
End Type
Public Type Coordt
x As Double 'x = X Coordinate
Y As Double 'y = Y Coordinate
z As Double
f As Integer
End Type
Public Type CartesCoord
x As Double 'x = X Coordinate
Y As Double 'y = Y Coordinate
r As Double ' Radius Sign
RA As Double ' Radius Alpha
End Type
Public Type SphereCoord
x As Double 'x = X Coordinate
Y As Double 'y = Y Coordinate
r As Double 'r = RA Range Flag
End Type
Public Type TriangleCoord
i As Double ' Offset 1
j As Double ' Offset 2
k As Double ' offset 3
End Type
'Define Affine Matrix
Public EQMP As Matrix
Public EQMQ As Matrix
Public EQMI As Matrix
Public EQMM As Matrix
Public EQCO As Coord
'Define Taki Matrix
Public EQLMN1 As Matrix
Public EQLMN2 As Matrix
Public EQMI_T As Matrix
Public EQMT As Matrix
Public EQCT As Coord
'Function to put coordinate values into a LMN/lmn matrix array
Public Function GETLMN(ByRef p1 As Coord, ByRef p2 As Coord, ByRef p3 As Coord) As Matrix
Dim temp As Matrix
Dim UnitVect As Matrix
With temp
.Element(1, 1) = p2.x - p1.x
.Element(2, 1) = p3.x - p1.x
.Element(1, 2) = p2.Y - p1.Y
.Element(2, 2) = p3.Y - p1.Y
.Element(1, 3) = p2.z - p1.z
.Element(2, 3) = p3.z - p1.z
End With
With UnitVect
.Element(1, 1) = (temp.Element(1, 2) * temp.Element(2, 3)) - (temp.Element(1, 3) * temp.Element(2, 2))
.Element(1, 2) = (temp.Element(1, 3) * temp.Element(2, 1)) - (temp.Element(1, 1) * temp.Element(2, 3))
.Element(1, 3) = (temp.Element(1, 1) * temp.Element(2, 2)) - (temp.Element(1, 2) * temp.Element(2, 1))
.Element(2, 1) = .Element(1, 1) ^ 2 + .Element(1, 2) ^ 2 + .Element(1, 3) ^ 2
.Element(2, 2) = Sqr(.Element(2, 1))
If .Element(2, 2) <> 0 Then .Element(2, 3) = 1 / .Element(2, 2)
End With
With temp
.Element(3, 1) = UnitVect.Element(2, 3) * UnitVect.Element(1, 1)
.Element(3, 2) = UnitVect.Element(2, 3) * UnitVect.Element(1, 2)
.Element(3, 3) = UnitVect.Element(2, 3) * UnitVect.Element(1, 3)
End With
GETLMN = temp
End Function
'Function to put coordinate values into a P/Q Affine matrix array
Public Function GETPQ(ByRef p1 As Coord, ByRef p2 As Coord, ByRef p3 As Coord) As Matrix
Dim temp As Matrix
With temp
.Element(1, 1) = p2.x - p1.x
.Element(2, 1) = p3.x - p1.x
.Element(1, 2) = p2.Y - p1.Y
.Element(2, 2) = p3.Y - p1.Y
End With
GETPQ = temp
End Function
' Subroutine to draw the Transformation Matrix (Taki Method)
Public Function EQ_AssembleMatrix_Taki(x As Double, Y As Double, ByRef a1 As Coord, ByRef a2 As Coord, ByRef a3 As Coord, ByRef m1 As Coord, ByRef m2 As Coord, ByRef m3 As Coord) As Integer
Dim Det As Double
' Get the LMN Matrix
EQLMN1 = GETLMN(a1, a2, a3)
' Get the lmn Matrix
EQLMN2 = GETLMN(m1, m2, m3)
With EQLMN1
' Get the Determinant
Det = .Element(1, 1) * ((.Element(2, 2) * .Element(3, 3)) - (.Element(3, 2) * .Element(2, 3)))
Det = Det - (.Element(1, 2) * ((.Element(2, 1) * .Element(3, 3)) - (.Element(3, 1) * .Element(2, 3))))
Det = Det + (.Element(1, 3) * ((.Element(2, 1) * .Element(3, 2)) - (.Element(3, 1) * .Element(2, 2))))
' Compute for the Matrix Inverse of EQLMN1
If Det = 0 Then
Err.Raise 999, "AssembleMatrix", "Cannot invert matrix with Determinant = 0"
Else
EQMI_T.Element(1, 1) = ((.Element(2, 2) * .Element(3, 3)) - (.Element(3, 2) * .Element(2, 3))) / Det
EQMI_T.Element(1, 2) = ((.Element(1, 3) * .Element(3, 2)) - (.Element(1, 2) * .Element(3, 3))) / Det
EQMI_T.Element(1, 3) = ((.Element(1, 2) * .Element(2, 3)) - (.Element(2, 2) * .Element(1, 3))) / Det
EQMI_T.Element(2, 1) = ((.Element(2, 3) * .Element(3, 1)) - (.Element(3, 3) * .Element(2, 1))) / Det
EQMI_T.Element(2, 2) = ((.Element(1, 1) * .Element(3, 3)) - (.Element(3, 1) * .Element(1, 3))) / Det
EQMI_T.Element(2, 3) = ((.Element(1, 3) * .Element(2, 1)) - (.Element(2, 3) * .Element(1, 1))) / Det
EQMI_T.Element(3, 1) = ((.Element(2, 1) * .Element(3, 2)) - (.Element(3, 1) * .Element(2, 2))) / Det
EQMI_T.Element(3, 2) = ((.Element(1, 2) * .Element(3, 1)) - (.Element(3, 2) * .Element(1, 1))) / Det
EQMI_T.Element(3, 3) = ((.Element(1, 1) * .Element(2, 2)) - (.Element(2, 1) * .Element(1, 2))) / Det
End If
End With
' Get the M Matrix by Multiplying EQMI and EQLMN2
' EQMI_T - Matrix A
' EQLMN2 - Matrix B
EQMT.Element(1, 1) = (EQMI_T.Element(1, 1) * EQLMN2.Element(1, 1)) + (EQMI_T.Element(1, 2) * EQLMN2.Element(2, 1)) + (EQMI_T.Element(1, 3) * EQLMN2.Element(3, 1))
EQMT.Element(1, 2) = (EQMI_T.Element(1, 1) * EQLMN2.Element(1, 2)) + (EQMI_T.Element(1, 2) * EQLMN2.Element(2, 2)) + (EQMI_T.Element(1, 3) * EQLMN2.Element(3, 2))
EQMT.Element(1, 3) = (EQMI_T.Element(1, 1) * EQLMN2.Element(1, 3)) + (EQMI_T.Element(1, 2) * EQLMN2.Element(2, 3)) + (EQMI_T.Element(1, 3) * EQLMN2.Element(3, 3))
EQMT.Element(2, 1) = (EQMI_T.Element(2, 1) * EQLMN2.Element(1, 1)) + (EQMI_T.Element(2, 2) * EQLMN2.Element(2, 1)) + (EQMI_T.Element(2, 3) * EQLMN2.Element(3, 1))
EQMT.Element(2, 2) = (EQMI_T.Element(2, 1) * EQLMN2.Element(1, 2)) + (EQMI_T.Element(2, 2) * EQLMN2.Element(2, 2)) + (EQMI_T.Element(2, 3) * EQLMN2.Element(3, 2))
EQMT.Element(2, 3) = (EQMI_T.Element(2, 1) * EQLMN2.Element(1, 3)) + (EQMI_T.Element(2, 2) * EQLMN2.Element(2, 3)) + (EQMI_T.Element(2, 3) * EQLMN2.Element(3, 3))
EQMT.Element(3, 1) = (EQMI_T.Element(3, 1) * EQLMN2.Element(1, 1)) + (EQMI_T.Element(3, 2) * EQLMN2.Element(2, 1)) + (EQMI_T.Element(3, 3) * EQLMN2.Element(3, 1))
EQMT.Element(3, 2) = (EQMI_T.Element(3, 1) * EQLMN2.Element(1, 2)) + (EQMI_T.Element(3, 2) * EQLMN2.Element(2, 2)) + (EQMI_T.Element(3, 3) * EQLMN2.Element(3, 2))
EQMT.Element(3, 3) = (EQMI_T.Element(3, 1) * EQLMN2.Element(1, 3)) + (EQMI_T.Element(3, 2) * EQLMN2.Element(2, 3)) + (EQMI_T.Element(3, 3) * EQLMN2.Element(3, 3))
' Get the Coordinate Offset Vector and store it at EQCO Matrix
EQCT.x = m1.x - ((a1.x * EQMT.Element(1, 1)) + (a1.Y * EQMT.Element(2, 1)) + (a1.z * EQMT.Element(3, 1)))
EQCT.Y = m1.Y - ((a1.x * EQMT.Element(1, 2)) + (a1.Y * EQMT.Element(2, 2)) + (a1.z * EQMT.Element(3, 2)))
EQCT.z = m1.z - ((a1.x * EQMT.Element(1, 3)) + (a1.Y * EQMT.Element(2, 3)) + (a1.z * EQMT.Element(3, 3)))
If (x + Y) = 0 Then
EQ_AssembleMatrix_Taki = 0
Else
EQ_AssembleMatrix_Taki = EQ_CheckPoint_in_Triangle(x, Y, a1.x, a1.Y, a2.x, a2.Y, a3.x, a3.Y)
End If
End Function
'Function to transform the Coordinates (Taki Method) using the MT Matrix and Offset Vector
Public Function EQ_Transform_Taki(ByRef ob As Coord) As Coord
' CoordTransform = Offset + CoordObject * Matrix MT
EQ_Transform_Taki.x = EQCT.x + ((ob.x * EQMT.Element(1, 1)) + (ob.Y * EQMT.Element(2, 1)) + (ob.z * EQMT.Element(3, 1)))
EQ_Transform_Taki.Y = EQCT.Y + ((ob.x * EQMT.Element(1, 2)) + (ob.Y * EQMT.Element(2, 2)) + (ob.z * EQMT.Element(3, 2)))
EQ_Transform_Taki.z = EQCT.z + ((ob.x * EQMT.Element(1, 3)) + (ob.Y * EQMT.Element(2, 3)) + (ob.z * EQMT.Element(3, 3)))
End Function
' Subroutine to draw the Transformation Matrix (Affine Mapping Method)
Public Function EQ_AssembleMatrix_Affine(x As Double, Y As Double, ByRef a1 As Coord, ByRef a2 As Coord, ByRef a3 As Coord, ByRef m1 As Coord, ByRef m2 As Coord, ByRef m3 As Coord) As Integer
Dim Det As Double
' Get the P Matrix
EQMP = GETPQ(a1, a2, a3)
' Get the Q Matrix
EQMQ = GETPQ(m1, m2, m3)
' Get the Inverse of P
With EQMP
' Get the EQMP Determinant for Inverse Computation
Det = (.Element(1, 1) * .Element(2, 2)) - (.Element(1, 2) * .Element(2, 1))
' Make sure Determinant is NON ZERO
If Det = 0 Then
Err.Raise 999, "AssembleMatrix", "Cannot invert matrix with Determinant = 0"
Else
'Perform the Matrix Inversion, put result to EQMI matrix
EQMI.Element(1, 1) = (.Element(2, 2)) / Det
EQMI.Element(1, 2) = (-.Element(1, 2)) / Det
EQMI.Element(2, 1) = (-.Element(2, 1)) / Det
EQMI.Element(2, 2) = (.Element(1, 1)) / Det
End If
End With
' Get the M Matrix by Multiplying EQMI and EQMQ
' EQMI - Matrix A
' EQMQ - Matrix B
EQMM.Element(1, 1) = (EQMI.Element(1, 1) * EQMQ.Element(1, 1)) + (EQMI.Element(1, 2) * EQMQ.Element(2, 1))
EQMM.Element(1, 2) = (EQMI.Element(1, 1) * EQMQ.Element(1, 2)) + (EQMI.Element(1, 2) * EQMQ.Element(2, 2))
EQMM.Element(2, 1) = (EQMI.Element(2, 1) * EQMQ.Element(1, 1)) + (EQMI.Element(2, 2) * EQMQ.Element(2, 1))
EQMM.Element(2, 2) = (EQMI.Element(2, 1) * EQMQ.Element(1, 2)) + (EQMI.Element(2, 2) * EQMQ.Element(2, 2))
' Get the Coordinate Offset Vector and store it at EQCO Matrix
EQCO.x = m1.x - ((a1.x * EQMM.Element(1, 1)) + (a1.Y * EQMM.Element(2, 1)))
EQCO.Y = m1.Y - ((a1.x * EQMM.Element(1, 2)) + (a1.Y * EQMM.Element(2, 2)))
If (x + Y) = 0 Then
EQ_AssembleMatrix_Affine = 0
Else
EQ_AssembleMatrix_Affine = EQ_CheckPoint_in_Triangle(x, Y, m1.x, m1.Y, m2.x, m2.Y, m3.x, m3.Y)
End If
End Function
'Function to transform the Coordinates (Affine Mapping) using the M Matrix and Offset Vector
Public Function EQ_Transform_Affine(ByRef ob As Coord) As Coord
' CoordTransform = Offset + CoordObject * Matrix M
EQ_Transform_Affine.x = EQCO.x + ((ob.x * EQMM.Element(1, 1)) + (ob.Y * EQMM.Element(2, 1)))
EQ_Transform_Affine.Y = EQCO.Y + ((ob.x * EQMM.Element(1, 2)) + (ob.Y * EQMM.Element(2, 2)))
End Function
'Function to convert spherical coordinates to Cartesian using the Coord structure
Public Function EQ_sp2Cs(ByRef obj As Coord) As Coord
Dim tmpobj As CartesCoord
Dim tmpobj4 As SphereCoord
If HC.PolarEnable.Value = 1 Then
tmpobj4 = EQ_SphericalPolar(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude)
tmpobj = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_sp2Cs.x = tmpobj.x
EQ_sp2Cs.Y = tmpobj.Y
EQ_sp2Cs.z = 1
Else
EQ_sp2Cs.x = obj.x
EQ_sp2Cs.Y = obj.Y
EQ_sp2Cs.z = 1
End If
End Function
'Function to convert spherical coordinates to Cartesian using the Coord structure
Public Function EQ_sp2Cs2(ByRef obj As Coord) As Coord
Dim tmpobj As CartesCoord
Dim tmpobj4 As SphereCoord
Dim lat As Double
If HC.PolarEnable.Value = 1 Then
tmpobj4 = EQ_SphericalPolar(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, Abs(gLatitude))
tmpobj = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_sp2Cs2.x = tmpobj.x
EQ_sp2Cs2.Y = tmpobj.Y
EQ_sp2Cs2.z = 1
Else
EQ_sp2Cs2.x = obj.x
EQ_sp2Cs2.Y = obj.Y
EQ_sp2Cs2.z = 1
End If
End Function
'Function to convert polar coordinates to Cartesian using the Coord structure
Public Function EQ_pl2Cs(ByRef obj As Coord) As Coord
Dim tmpobj As CartesCoord
If HC.PolarEnable.Value = 1 Then
tmpobj = EQ_Polar2Cartes(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_pl2Cs.x = tmpobj.x
EQ_pl2Cs.Y = tmpobj.Y
EQ_pl2Cs.z = 1
Else
EQ_pl2Cs.x = obj.x
EQ_pl2Cs.Y = obj.Y
EQ_pl2Cs.z = 1
End If
End Function
'Implement an Affine transformation on a Polar coordinate system
'This is done by converting the Polar Data to Cartesian, Apply affine transformation
'Then restore the transformed Cartesian Coordinates back to polar
Public Function EQ_plAffine(ByRef obj As Coord) As Coord
Dim tmpobj1 As CartesCoord
Dim tmpobj2 As Coord
Dim tmpobj3 As Coord
Dim tmpobj4 As SphereCoord
If HC.PolarEnable.Value = 1 Then
tmpobj4 = EQ_SphericalPolar(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude)
tmpobj1 = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
tmpobj2.x = tmpobj1.x
tmpobj2.Y = tmpobj1.Y
tmpobj2.z = 1
tmpobj3 = EQ_Transform_Affine(tmpobj2)
tmpobj2 = EQ_Cartes2Polar(tmpobj3.x, tmpobj3.Y, tmpobj1.r, tmpobj1.RA, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_plAffine = EQ_PolarSpherical(tmpobj2.x, tmpobj2.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude, tmpobj4.r)
Else
tmpobj3 = EQ_Transform_Affine(obj)
EQ_plAffine.x = tmpobj3.x
EQ_plAffine.Y = tmpobj3.Y
EQ_plAffine.z = 1
End If
End Function
Public Function EQ_plAffine2(ByRef obj As Coord) As Coord
Dim tmpobj1 As CartesCoord
Dim tmpobj2 As Coord
Dim tmpobj3 As Coord
Dim tmpobj4 As SphereCoord
If HC.PolarEnable.Value = 1 Then
tmpobj4 = EQ_SphericalPolar(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude)
tmpobj1 = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
tmpobj2.x = tmpobj1.x
tmpobj2.Y = tmpobj1.Y
tmpobj2.z = 1
tmpobj3 = EQ_Transform_Affine(tmpobj2)
tmpobj2 = EQ_Cartes2Polar(tmpobj3.x, tmpobj3.Y, tmpobj1.r, tmpobj1.RA, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_plAffine2 = EQ_PolarSpherical(tmpobj2.x, tmpobj2.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude, tmpobj4.r)
Else
tmpobj3 = EQ_Transform_Affine(obj)
EQ_plAffine2.x = tmpobj3.x
EQ_plAffine2.Y = tmpobj3.Y
EQ_plAffine2.z = 1
End If
End Function
'Implement a TAKI transformation on a Polar coordinate system
'This is done by converting the Polar Data to Cartesian, Apply TAKI transformation
'Then restore the transformed Cartesian Coordinates back to polar
Public Function EQ_plTaki(ByRef obj As Coord) As Coord
Dim tmpobj1 As CartesCoord
Dim tmpobj2 As Coord
Dim tmpobj3 As Coord
Dim tmpobj4 As SphereCoord
If HC.PolarEnable.Value = 1 Then
tmpobj4 = EQ_SphericalPolar(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude)
tmpobj1 = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
tmpobj2.x = tmpobj1.x
tmpobj2.Y = tmpobj1.Y
tmpobj2.z = 1
tmpobj3 = EQ_Transform_Taki(tmpobj2)
tmpobj2 = EQ_Cartes2Polar(tmpobj3.x, tmpobj3.Y, tmpobj1.r, tmpobj1.RA, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_plTaki = EQ_PolarSpherical(tmpobj2.x, tmpobj2.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude, tmpobj4.r)
Else
tmpobj3 = EQ_Transform_Taki(obj)
EQ_plTaki.x = tmpobj3.x
EQ_plTaki.Y = tmpobj3.Y
EQ_plTaki.z = 1
End If
End Function
' Function to Convert Polar RA/DEC Stepper coordinates to Cartesian Coordinates
Public Function EQ_Polar2Cartes(RA As Double, DEC As Double, TOT As Double, RACENTER As Double, DECCENTER As Double) As CartesCoord
Dim x2 As Double
Dim y2 As Double
Dim theta As Double
Dim radius As Double
Dim angle As Double
Dim radiusder As Double
Dim i As Double
Dim radpeak As Double
' make angle stays within the 360 bound
If RA > RACENTER Then
i = ((RA - RACENTER) / TOT) * 360
Else
i = ((RACENTER - RA) / TOT) * 360
i = 360 - i
End If
theta = Range360(i) * DEG_RAD
'treat y as the radius of the polar coordinate
radius = DEC - DECCENTER
radpeak = 0
' Removed
' If Abs(radius) > DECPEAK Then
' radpeak = radius
' If radius > 0 Then
' radius = (2 * DECPEAK) - radius
' Else
' radius = ((2 * DECPEAK) + radius) * -1
' End If
' radpeak = radpeak - radius
' End If
' Avoid division 0 errors
If radius = 0 Then radius = 1
' Get the cartesian coordinates
EQ_Polar2Cartes.x = Cos(theta) * radius
EQ_Polar2Cartes.Y = Sin(theta) * radius
EQ_Polar2Cartes.RA = radpeak
' if radius is a negative number, pass this info on the next conversion routine
If radius > 0 Then
EQ_Polar2Cartes.r = 1
Else
EQ_Polar2Cartes.r = -1
End If
End Function
'Function to convert the Cartesian Coordinate data back to RA/DEC polar
Public Function EQ_Cartes2Polar(x As Double, Y As Double, r As Double, RA As Double, TOT As Double, RACENTER As Double, DECCENTER As Double) As Coord
Dim radiusder As Double
Dim angle As Double
' Ah the famous radius formula
radiusder = Sqr((x * x) + (Y * Y)) * r
' And the nasty angle compute routine (any simpler way to impelent this ?)
angle = 0
If x > 0 Then angle = Atn(Y / x)
If x < 0 Then
If Y >= 0 Then
angle = Atn(Y / x) + PI
Else
angle = Atn(Y / x) - PI
End If
End If
If x = 0 Then
If Y > 0 Then
angle = PI / 2
Else
angle = -1 * (PI / 2)
End If
End If
' Convert angle to degrees
angle = angle * RAD_DEG
If angle < 0 Then angle = 360 + angle
If r < 0 Then angle = Range360(angle + 180)
If (angle > 180) Then
EQ_Cartes2Polar.x = RACENTER - (((360 - angle) / 360) * TOT)
Else
EQ_Cartes2Polar.x = ((angle / 360) * TOT) + RACENTER
End If
'treat y as the polar coordinate radius (ra var not used - always 0)
EQ_Cartes2Polar.Y = radiusder + DECCENTER + RA
End Function
Public Function EQ_UpdateTaki(x As Double, Y As Double) As Integer
Dim tr As TriangleCoord
Dim tmpcoord As Coord
' Adjust only if there are four alignment stars
If gAlignmentStars_count < 3 Then Exit Function
Select Case g3PointAlgorithm
Case 1
' find the 50 nearest points - then find the nearest enclosing triangle
tr = EQ_ChooseNearest3Points(x, Y)
Case Else
' find the 50 nearest points - then find the enclosing triangle with the nearest centre point
tr = EQ_Choose_3Points(x, Y)
End Select
gTaki1 = tr.i
gTaki2 = tr.j
gTaki3 = tr.k
If gTaki1 = 0 Or gTaki2 = 0 Or gTaki3 = 0 Then
EQ_UpdateTaki = 0
Exit Function
End If
tmpcoord.x = x
tmpcoord.Y = Y
tmpcoord = EQ_sp2Cs(tmpcoord)
EQ_UpdateTaki = EQ_AssembleMatrix_Taki(tmpcoord.x, tmpcoord.Y, ct_PointsC(gTaki1), ct_PointsC(gTaki2), ct_PointsC(gTaki3), my_PointsC(gTaki1), my_PointsC(gTaki2), my_PointsC(gTaki3))
End Function
Public Function EQ_UpdateAffine(x As Double, Y As Double) As Integer
Dim tmpcoord As Coord
Dim tr As TriangleCoord
If gAlignmentStars_count < 3 Then Exit Function
Select Case g3PointAlgorithm
Case 1
' find the 50 nearest points - then find the nearest enclosing triangle
tr = EQ_ChooseNearest3Points(x, Y)
Case Else
' find the 50 nearest points - then find the enclosing triangle with the nearest centre point
tr = EQ_Choose_3Points(x, Y)
End Select
gAffine1 = tr.i
gAffine2 = tr.j
gAffine3 = tr.k
If gAffine1 = 0 Or gAffine1 = 0 Or gAffine1 = 0 Then
EQ_UpdateAffine = 0
Exit Function
End If
tmpcoord.x = x
tmpcoord.Y = Y
tmpcoord = EQ_sp2Cs(tmpcoord)
EQ_UpdateAffine = EQ_AssembleMatrix_Affine(tmpcoord.x, tmpcoord.Y, my_PointsC(gAffine1), my_PointsC(gAffine2), my_PointsC(gAffine3), ct_PointsC(gAffine1), ct_PointsC(gAffine2), ct_PointsC(gAffine3))
If EQ_UpdateAffine = 0 Then
gAffine1 = 0
gAffine2 = 0
gAffine3 = 0
End If
End Function
' Subroutine to implement find Array index with the lowest value
Public Function EQ_FindLowest(List() As Double, min As Integer, max As Integer) As Integer
Dim val As Double
Dim newval As Double
Dim i As Integer
Dim idx As Integer
idx = -1
If min >= max Or max > UBound(List) Then GoTo endfn
val = List(min)
For i = min To max Step 1
newval = List(i)
If newval <= val Then
val = newval
idx = i
End If
Next i
endfn:
EQ_FindLowest = idx
End Function
Public Sub EQ_FindLowest3(List() As Double, Sublist() As Integer, min As Integer, max As Integer)
Dim val As Double
Dim min1 As Double
Dim min2 As Double
Dim min3 As Double
Dim i As Integer
If min >= max Or max > UBound(List) Then GoTo endfn
If List(1) <= List(2) And List(1) <= List(3) Then
'List 1 is first
min1 = List(1)
If List(2) <= List(3) Then
'List2 is second
'List3 is third
min2 = List(2)
min3 = List(3)
Else
'List3 is second
'List2 is third
min2 = List(3)
min3 = List(2)
End If
Else
If List(2) <= List(1) And List(2) <= List(3) Then
'List 2 is first
min1 = List(2)
If List(1) <= List(3) Then
'List1 is second
'List3 is third
min2 = List(1)
min3 = List(3)
Else
'List3 is second
'List1 is third
min2 = List(3)
min3 = List(1)
End If
Else
If List(3) <= List(1) And List(3) <= List(2) Then
'List 3 is first
min1 = List(3)
If List(1) <= List(2) Then
'List1 is second
'List2 is third
min2 = List(1)
min3 = List(2)
Else
'List2 is second
'List1 is third
min2 = List(2)
min3 = List(1)
End If
End If
End If
End If
val = List(min)
For i = min To max Step 1
val = List(i)
If val < min1 Then
min1 = val
Sublist(3) = Sublist(2)
Sublist(2) = Sublist(1)
Sublist(1) = i
Else
If val < min2 Then
min2 = val
Sublist(3) = Sublist(2)
Sublist(2) = i
Else
If val < min3 Then
Sublist(3) = i
End If
End If
End If
Next i
endfn:
End Sub
' Subroutine to implement an Array sort
Public Sub EQ_Quicksort(List() As Double, Sublist() As Double, min As Integer, max As Integer)
Dim med_value As Double
Dim submed As Double
Dim hi As Integer
Dim lo As Integer
Dim i As Integer
If min >= max Then Exit Sub
i = Int((max - min + 1) * Rnd + min)
med_value = List(i)
submed = Sublist(i)
List(i) = List(min)
Sublist(i) = Sublist(min)
lo = min
hi = max
Do
Do While List(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
List(lo) = med_value
Sublist(lo) = submed
Exit Do
End If
List(lo) = List(hi)
Sublist(lo) = Sublist(hi)
lo = lo + 1
Do While List(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
List(hi) = med_value
Sublist(hi) = submed
Exit Do
End If
List(hi) = List(lo)
Sublist(hi) = Sublist(lo)
Loop
EQ_Quicksort List(), Sublist(), min, lo - 1
EQ_Quicksort List(), Sublist(), lo + 1, max
End Sub
' Subroutine to implement an Array sort
Public Sub EQ_Quicksort2(List() As Tdatholder, min As Integer, max As Integer)
Dim med_value As Tdatholder
Dim hi As Integer
Dim lo As Integer
Dim i As Integer
If min >= max Then Exit Sub
i = Int((max - min + 1) * Rnd + min)
med_value = List(i)
List(i) = List(min)
lo = min
hi = max
Do
Do While List(hi).dat >= med_value.dat
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
List(lo) = med_value
Exit Do
End If
List(lo) = List(hi)
lo = lo + 1
Do While List(lo).dat < med_value.dat
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
List(hi) = med_value
Exit Do
End If
List(hi) = List(lo)
Loop
EQ_Quicksort2 List(), min, lo - 1
EQ_Quicksort2 List(), lo + 1, max
End Sub
' Subroutine to implement an Array sort with three sublists
Public Sub EQ_Quicksort3(List() As Double, Sublist1() As Double, Sublist2() As Double, Sublist3() As Double, min As Integer, max As Integer)
Dim med_value As Double
Dim submed1 As Double
Dim submed2 As Double
Dim submed3 As Double
Dim hi As Integer
Dim lo As Integer
Dim i As Integer
If min >= max Then Exit Sub
i = Int((max - min + 1) * Rnd + min)
med_value = List(i)
submed1 = Sublist1(i)
submed2 = Sublist2(i)
submed3 = Sublist3(i)
List(i) = List(min)
Sublist1(i) = Sublist1(min)
Sublist2(i) = Sublist2(min)
Sublist3(i) = Sublist3(min)
lo = min
hi = max
Do
Do While List(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
List(lo) = med_value
Sublist1(lo) = submed1
Sublist2(lo) = submed2
Sublist3(lo) = submed3
Exit Do
End If
List(lo) = List(hi)
Sublist1(lo) = Sublist1(hi)
Sublist2(lo) = Sublist2(hi)
Sublist3(lo) = Sublist3(hi)
lo = lo + 1
Do While List(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
List(hi) = med_value
Sublist1(hi) = submed1
Sublist2(hi) = submed2
Sublist3(hi) = submed3
Exit Do
End If
List(hi) = List(lo)
Sublist1(hi) = Sublist1(lo)
Sublist2(hi) = Sublist2(lo)
Sublist3(hi) = Sublist3(lo)
Loop
EQ_Quicksort3 List(), Sublist1(), Sublist2(), Sublist3(), min, lo - 1
EQ_Quicksort3 List(), Sublist1(), Sublist2(), Sublist3(), lo + 1, max
End Sub
' Function to compute for an area of a triangle
Public Function EQ_Triangle_Area(px1 As Double, py1 As Double, px2 As Double, py2 As Double, px3 As Double, py3 As Double) As Double
Dim ta As Double
'True formula is this
' EQ_Triangle_Area = Abs(((px2 * py1) - (px1 * py2)) + ((px3 * py2) - (px2 * py3)) + ((px1 * py3) - (px3 * py1))) / 2
' Make LARGE numerical value safe for Windows by adding a scaling factor
ta = (((px2 * py1) - (px1 * py2)) / 10000) + (((px3 * py2) - (px2 * py3)) / 10000) + (((px1 * py3) - (px3 * py1)) / 10000)
EQ_Triangle_Area = Abs(ta) / 2
End Function
' Function to check if a point is inside the triangle. Computed based sum of areas method
Public Function EQ_CheckPoint_in_Triangle(px As Double, py As Double, px1 As Double, py1 As Double, px2 As Double, py2 As Double, px3 As Double, py3 As Double) As Integer
Dim ta As Double
Dim t1 As Double
Dim t2 As Double
Dim t3 As Double
ta = EQ_Triangle_Area(px1, py1, px2, py2, px3, py3)
t1 = EQ_Triangle_Area(px, py, px2, py2, px3, py3)
t2 = EQ_Triangle_Area(px1, py1, px, py, px3, py3)
t3 = EQ_Triangle_Area(px1, py1, px2, py2, px, py)
If Abs(ta - t1 - t2 - t3) < 2 Then
EQ_CheckPoint_in_Triangle = 1
Else
EQ_CheckPoint_in_Triangle = 0
End If
End Function
Public Function EQ_GetCenterPoint(p1 As Coord, p2 As Coord, p3 As Coord) As Coord
Dim p1x As Double
Dim p1y As Double
Dim p2x As Double
Dim p2y As Double
Dim p3x As Double
Dim p3y As Double
Dim p4x As Double
Dim p4y As Double
Dim XD1 As Double
Dim YD1 As Double
Dim XD2 As Double
Dim YD2 As Double
Dim XD3 As Double
Dim YD3 As Double
Dim ua As Double
Dim ub As Double
Dim dv As Double
' Get the two line 4 point data
p1x = p1.x
p1y = p1.Y
If p3.x > p2.x Then
p2x = ((p3.x - p2.x) / 2) + p2.x
Else
p2x = ((p2.x - p3.x) / 2) + p3.x
End If
If p3.Y > p2.Y Then
p2y = ((p3.Y - p2.Y) / 2) + p2.Y
Else
p2y = ((p2.Y - p3.Y) / 2) + p3.Y
End If
p3x = p2.x
p3y = p2.Y
If p1.x > p3.x Then
p4x = ((p1.x - p3.x) / 2) + p3.x
Else
p4x = ((p3.x - p1.x) / 2) + p1.x
End If
If p1.Y > p3.Y Then
p4y = ((p1.Y - p3.Y) / 2) + p3.Y
Else
p4y = ((p3.Y - p1.Y) / 2) + p1.Y
End If
XD1 = p2x - p1x
XD2 = p4x - p3x
YD1 = p2y - p1y
YD2 = p4y - p3y
XD3 = p1x - p3x
YD3 = p1y - p3y
dv = (YD2 * XD1) - (XD2 * YD1)
If dv = 0 Then dv = 0.00000001 'avoid div 0 errors
ua = ((XD2 * YD3) - (YD2 * XD3)) / dv
ub = ((XD1 * YD3) - (YD1 * XD3)) / dv
EQ_GetCenterPoint.x = p1x + (ua * XD1)
EQ_GetCenterPoint.Y = p1y + (ub * YD1)
End Function
Public Function EQ_SphericalPolar(RA As Double, DEC As Double, TOT As Double, RACENTER As Double, DECCENTER As Double, Latitude As Double) As SphereCoord
Dim i As Double
Dim j As Double
Dim x As Double
Dim Y As Double
i = Get_EncoderHours(RACENTER, RA, TOT, 0)
j = Get_EncoderDegrees(DECCENTER, DEC, TOT, 0) + 270
j = Range360(j)
Call hadec_aa(Latitude * DEG_RAD, i * HRS_RAD, j * DEG_RAD, Y, x)
EQ_SphericalPolar.x = ((((x * RAD_DEG) - 180) / 360) * TOT) + RACENTER
EQ_SphericalPolar.Y = ((((Y * RAD_DEG) + 90) / 180) * TOT) + DECCENTER
' Check if RA value is within allowed visible range
i = TOT / 4
If (RA <= (RACENTER + i)) And (RA >= (RACENTER - i)) Then
EQ_SphericalPolar.r = 1
Else
EQ_SphericalPolar.r = 0
End If
End Function
Public Function EQ_PolarSpherical(RA As Double, DEC As Double, TOT As Double, RACENTER As Double, DECCENTER As Double, Latitude As Double, range As Double) As Coord
Dim i As Double
Dim j As Double
Dim x As Double
Dim Y As Double
Dim pr As Double
i = (((RA - RACENTER) / TOT) * 360) + 180
j = (((DEC - DECCENTER) / TOT) * 180) - 90
Call aa_hadec(Latitude * DEG_RAD, j * DEG_RAD, i * DEG_RAD, x, Y)
If i > 180 Then
If range = 0 Then
Y = Range360(180 - (Y * RAD_DEG))
Else
Y = Range360(Y * RAD_DEG)
End If
Else
If range = 0 Then
Y = Range360(Y * RAD_DEG)
Else
Y = Range360(180 - (Y * RAD_DEG))
End If
End If
j = Range360(Y + 90)
If j < 180 Then
If range = 1 Then
x = Range24(x * RAD_HRS)
Else
x = Range24(24 + (x * RAD_HRS))
End If
Else
x = Range24(12 + (x * RAD_HRS))
End If
EQ_PolarSpherical.x = Get_EncoderfromHours(RACENTER, x, TOT, 0)
EQ_PolarSpherical.Y = Get_EncoderfromDegrees(DECCENTER, Y + 90, TOT, 0, 0)
End Function
Public Function EQ_Spherical2Cartes(RA As Double, DEC As Double, TOT As Double, RACENTER As Double, DECCENTER As Double) As CartesCoord
Dim tmpobj1 As CartesCoord
Dim tmpobj4 As SphereCoord
tmpobj4 = EQ_SphericalPolar(RA, DEC, TOT, RACENTER, DECCENTER, gLatitude)
tmpobj1 = EQ_Polar2Cartes(tmpobj4.x, tmpobj4.Y, TOT, RACENTER, DECCENTER)
EQ_Spherical2Cartes.x = tmpobj1.x
EQ_Spherical2Cartes.Y = tmpobj1.Y
EQ_Spherical2Cartes.RA = tmpobj1.RA
EQ_Spherical2Cartes.r = tmpobj1.r
End Function
Public Function EQ_Cartes2Spherical(x As Double, Y As Double, r As Double, RA As Double, range As Double, TOT As Double, RACENTER As Double, DECCENTER As Double) As Coord
Dim tmpobj2 As Coord
tmpobj2 = EQ_Cartes2Polar(x, Y, r, RA, TOT, RACENTER, DECCENTER)
EQ_Cartes2Spherical = EQ_PolarSpherical(tmpobj2.x, tmpobj2.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos, gLatitude, range)
End Function
Public Function EQ_Choose_3Points(x As Double, Y As Double) As TriangleCoord
Dim i, j, k, l, m, n As Integer
Dim tmpcoords As Coord
Dim tmpcoord As Coord
Dim p1 As Coord
Dim p2 As Coord
Dim p3 As Coord
Dim pc As Coord
Dim Count As Integer
Dim datholder(1 To MAX_STARS) As Tdatholder
Dim combi_cnt, tmp1, tmp2 As Integer
Dim first As Boolean
Dim last_dist, new_dist As Double
' Adjust only if there are three alignment stars
If gAlignmentStars_count <= 3 Then
EQ_Choose_3Points.i = 1
EQ_Choose_3Points.j = 2
EQ_Choose_3Points.k = 3
Exit Function
End If
tmpcoords.x = x
tmpcoords.Y = Y
tmpcoord = EQ_sp2Cs(tmpcoords)
Count = 0
' first find out the distances to the alignment stars
For i = 1 To gAlignmentStars_count
With datholder(Count + 1)
.cc = my_PointsC(i)
Select Case gPointFilter
Case 0
' all points
Case 1
' only consider points on this side of the meridian
If .cc.Y * tmpcoord.Y < 0 Then
GoTo NextPoint
End If
Case 2
' local quadrant
If GetQuadrant(tmpcoord) <> GetQuadrant(.cc) Then
GoTo NextPoint
End If
End Select
If HC.CheckLocalPier.Value = 1 Then
' calculate polar distance
.dat = (my_Points(i).x - x) ^ 2 + (my_Points(i).Y - Y) ^ 2
Else
' calculate cartesian disatnce
.dat = (CDbl(.cc.x - tmpcoord.x)) ^ 2 + (CDbl(.cc.Y - tmpcoord.Y)) ^ 2
End If
' Also save the reference star id for this particular reference star
.idx = i
End With
Count = Count + 1
NextPoint:
Next i
If Count < 3 Then
' not enough points to do 3-point
EQ_Choose_3Points.i = 0
EQ_Choose_3Points.j = 0
EQ_Choose_3Points.k = 0
Exit Function
End If
' now sort the disatnces so the closest stars are at the top
Call EQ_Quicksort2(datholder(), 1, Count)
'Just use the nearest 50 stars (max) - saves processing time
If Count > gMaxCombinationCount - 1 Then
combi_cnt = gMaxCombinationCount
Else
combi_cnt = Count
End If
' combi_offset = 1
tmp1 = combi_cnt - 1
tmp2 = combi_cnt - 2
first = True
' iterate through all the triangles posible using the nearest alignment points
l = 1
m = 2
n = 3
For i = 1 To (tmp2)
p1 = datholder(i).cc
For j = i + 1 To (tmp1)
p2 = datholder(j).cc
For k = (j + 1) To combi_cnt
p3 = datholder(k).cc
If EQ_CheckPoint_in_Triangle(tmpcoord.x, tmpcoord.Y, p1.x, p1.Y, p2.x, p2.Y, p3.x, p3.Y) = 1 Then
' Compute for the center point
pc = EQ_GetCenterPoint(p1, p2, p3)
' don't need full pythagoras - sum of squares is good enough
new_dist = (pc.x - tmpcoord.x) ^ 2 + (pc.Y - tmpcoord.Y) ^ 2
If first Then
' first time through
last_dist = new_dist
first = False
l = i
m = j
n = k
Else
If new_dist < last_dist Then
l = i
m = j
n = k
last_dist = new_dist
End If
End If
End If
Next k
Next j
Next i
If first = True Then
EQ_Choose_3Points.i = 0
EQ_Choose_3Points.j = 0
EQ_Choose_3Points.k = 0
Else
EQ_Choose_3Points.i = datholder(l).idx
EQ_Choose_3Points.j = datholder(m).idx
EQ_Choose_3Points.k = datholder(n).idx
End If
End Function
Public Function EQ_ChooseNearest3Points(x As Double, Y As Double) As TriangleCoord
Dim i, j, k, l, m, n As Integer
Dim tmpcoords As Coord
Dim tmpcoord As Coord
Dim p1 As Coord
Dim p2 As Coord
Dim p3 As Coord
Dim pc As Coord
Dim Count As Integer
Dim datholder(1 To MAX_STARS) As Tdatholder
Dim combi_cnt, tmp1, tmp2 As Integer
Dim first As Boolean
Dim last_dist, new_dist As Double
' Adjust only if there are three alignment stars
If gAlignmentStars_count <= 3 Then
EQ_ChooseNearest3Points.i = 1
EQ_ChooseNearest3Points.j = 2
EQ_ChooseNearest3Points.k = 3
Exit Function
End If
tmpcoords.x = x
tmpcoords.Y = Y
tmpcoord = EQ_sp2Cs(tmpcoords)
Count = 0
' first find out the distances to the alignment stars
For i = 1 To gAlignmentStars_count
With datholder(Count + 1)
.cc = my_PointsC(i)
Select Case gPointFilter
Case 0
' all points
Case 1
' only consider points on this side of the meridian
If .cc.Y * tmpcoord.Y < 0 Then
GoTo NextPoint
End If
Case 2
' local quadrant
If GetQuadrant(tmpcoord) <> GetQuadrant(.cc) Then
GoTo NextPoint
End If
End Select
If HC.CheckLocalPier.Value = 1 Then
' calculate polar distance
.dat = (my_Points(i).x - x) ^ 2 + (my_Points(i).Y - Y) ^ 2
Else
' calculate cartesian disatnce
.dat = (CDbl(.cc.x - tmpcoord.x)) ^ 2 + (CDbl(.cc.Y - tmpcoord.Y)) ^ 2
End If
' Also save the reference star id for this particular reference star
.idx = i
End With
Count = Count + 1
NextPoint:
Next i
If Count < 3 Then
' not enough points to do 3-point
EQ_ChooseNearest3Points.i = 0
EQ_ChooseNearest3Points.j = 0
EQ_ChooseNearest3Points.k = 0
Exit Function
End If
' now sort the disatnces so the closest stars are at the top
Call EQ_Quicksort2(datholder(), 1, Count)
'Just use the nearest 50 stars (max) - saves processing time
If Count > gMaxCombinationCount - 1 Then
combi_cnt = gMaxCombinationCount
Else
combi_cnt = Count
End If
tmp1 = combi_cnt - 1
tmp2 = combi_cnt - 2
first = True
' iterate through all the triangles posible using the nearest alignment points
l = 1
m = 2
n = 3
For i = 1 To (tmp2)
p1 = datholder(i).cc
For j = i + 1 To (tmp1)
p2 = datholder(j).cc
For k = (j + 1) To combi_cnt
p3 = datholder(k).cc
If EQ_CheckPoint_in_Triangle(tmpcoord.x, tmpcoord.Y, p1.x, p1.Y, p2.x, p2.Y, p3.x, p3.Y) = 1 Then
l = i
m = j
n = k
GoTo alldone
End If
Next k
Next j
Next i
EQ_ChooseNearest3Points.i = 0
EQ_ChooseNearest3Points.j = 0
EQ_ChooseNearest3Points.k = 0
Exit Function
alldone:
EQ_ChooseNearest3Points.i = datholder(l).idx
EQ_ChooseNearest3Points.j = datholder(m).idx
EQ_ChooseNearest3Points.k = datholder(n).idx
End Function
' at 4129 Done code part. Lines - 1 Analysing colorpick.frm Done form part, 21 controls found Done code part. Lines - 571 Analysing persist.cls Done code part. Lines - 228 Analysing stareditform.frm Done form part, 28 controls found Done code part. Lines - 1284 Analysing definitions.bas Done code part. Lines - 1 Analysing jstickconfig.frm Done form part, 112 controls found Done code part. Lines - 2631 Analysing langdll.cls Done code part. Lines - 125 Analysing pec.basError parsing line 'Attribute VB_Name = "PEC"
'---------------------------------------------------------------------
' Copyright © 2008 EQMOD Development Team
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' PEC.bas - Periodic Error Correction functions for EQMOD ASCOM Driver
'
'
' Written: 12-Oct-07 Chris Shillito
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this program to work.
' Circuit details can be found at http://sourceforge.net/projects/eq-mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
Option Explicit
Type CapRecord
time As Double
MotorPos As Double
DeltaPos As Double
DeltaTime As Double
rate As Double
pe As Double
peSmoothed As Double
peInc As Double
End Type
Type PECCapDef
StartTime As Date
Period As Double
Steps As Double
idx As Integer
FileName As String
CapureData() As CapRecord
End Type
Type PECData
time As Double
PEPosition As Double
PECPosition As Double
RawPosn As Double
signal As Double
PErate As Double
PECrate As Double
cycle As Integer
End Type
Type PECDefinition
PECCurve() As PECData
PECCurveTmp() As PECData
Period As Double
Steps As Double
MaxPe As Double
MinPe As Double
FileName As String
CurrIdx As Integer
End Type
Type PECFileData
time As Double
Position As Double
pe As Double
cycle As Integer
End Type
Private PECCap As PECCapDef
Public PECDef1 As PECDefinition
Public gLastPE As Double
Public gPEC_Enabled As Boolean
Public gUsePEC As Boolean
Public gPEC_Gain As Double ' current gain setting
Public gPEC_Capture_Cycles As Integer
Public gPEC_filter_lowpass As Integer
Public gPEC_mag As Integer
Public gPEC_PhaseAdjust As Integer ' current phase adjustment (samples)
Public gPEC_TimeStampFiles As Integer
Public gPEC_DynamicRateAdjust As Integer
Public gPEC_FileDir As String
Public gPEC_trace As Integer
Public gPEC_AutoApply As Integer
Public gPEC_Debug As Integer
Private PEC_File As String ' path and name of PEC file
Private threshold As Double ' minimum correction PEC will make
Private phaseshift As Double ' current phase shift (steps)
Private gMaxRateAdjust As Double ' Maximum correction PEC is allowed to make
Private MaxRate As Double ' Fastset rate allowed
Private MinRate As Double ' slowest rate allowed
Private SID_RATE_NORTH As Double ' 15.041067 ' arcsecs/sec (60*60*360) / ((23*60*60)+(56*60)+4)
Private SID_RATE_SOUTH As Double ' -15.041067 ' arcsecs/sec
Type PlaybackTimerStatic
PecResyncCount As Integer
CurrRate As Double ' current rate
Firsttime As Boolean ' oneshot flag
newpos As Single
oldpos As Single
timerflag As Boolean ' timer interlock
ringcounter As Long
StartRingCounter As Double
LastRingCounter As Double
StartTime As Double
lasttime As Double
RateSumExpected As Double
RateSumActual As Double
TraceIdx As Long
strPlayback As String
End Type
Type CaptureTimerStatic
State As Integer
timerflag As Boolean ' timer interlock
ringcounter As Long
StartRingCounter As Double
LastRingCounter As Double
StartTime As Double
lasttime As Double
pe As Double
yoffset As Single
lastx As Single
lasty As Single
PenToggle As Boolean
InvertCapture As Integer
strCapture As String
MaxStepChange As Double
End Type
Private CaptureTimer As CaptureTimerStatic
Private PlaybackTimer As PlaybackTimerStatic
Private TraceFileNum As Integer
Const ARCSECS_PER_360DEGREES = 1296000 ' 360*60*60
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub PEC_LoPassScroll_Change()
gPEC_filter_lowpass = PECConfigFrm.HScroll1.Value
If gPEC_filter_lowpass < 9 Then
PECConfigFrm.Label3.Caption = oLangDll.GetLangString(6116)
gPEC_filter_lowpass = 0
Else
PECConfigFrm.Label3.Caption = CStr(gPEC_filter_lowpass)
End If
End Sub
Public Sub PEC_MagScroll_Change()
gPEC_mag = PECConfigFrm.HScroll2.Value
If gPEC_mag = 0 Then
PECConfigFrm.Label2.Caption = oLangDll.GetLangString(6116)
Else
PECConfigFrm.Label2.Caption = CStr(gPEC_mag)
End If
End Sub
Public Sub PEC_PhaseScroll_Change()
Dim adj As Double
PECConfigFrm.Label45.Caption = CStr(Int(360 * (PECConfigFrm.PhaseScroll.Value / gRAWormPeriod))) & " deg."
gPEC_PhaseAdjust = PECConfigFrm.PhaseScroll.Value
phaseshift = PECConfigFrm.PhaseScroll.Value * (gRAWormSteps / gRAWormPeriod)
If PECConfigFrm.PhaseScroll.Enabled Then
PlaybackTimer.ringcounter = EQGetMotorValues(0)
PECDef1.CurrIdx = GetIdx(PECDef1)
End If
End Sub
Public Sub PECMode_click()
Dim key As String
Dim Ini As String
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[pec]"
Call HC.oPersist.WriteIniValueEx("DYNAMIC_RATE_ADJUST", CStr(gPEC_DynamicRateAdjust), key, Ini)
End Sub
Public Sub PEC_Initialise()
PlaybackTimer.Firsttime = True
HC.CmdPecSave.Enabled = False
PECConfigFrm.GainScroll.Enabled = False
PECConfigFrm.PhaseScroll.Enabled = False
ReDim PECDef1.PECCurve(gRAWormPeriod)
ReDim PECDef1.PECCurveTmp(gRAWormPeriod)
PECDef1.Period = gRAWormPeriod
PECDef1.Steps = gRAWormSteps
SID_RATE_NORTH = SID_RATE
SID_RATE_SOUTH = -1 * SID_RATE ' gSiderealRate
Call PEC_ReadParams
If gHemisphere Then
MaxRate = SID_RATE_SOUTH + gMaxRateAdjust
MinRate = SID_RATE_SOUTH - gMaxRateAdjust
Else
MaxRate = SID_RATE_NORTH + gMaxRateAdjust
MinRate = SID_RATE_NORTH - gMaxRateAdjust
End If
If (gTot_RA <> 0) Then
If (gRAWormPeriod > 0) Then
PECConfigFrm.PhaseScroll.max = gRAWormPeriod
If Import(PECDef1) <> True Then KillPec
End If
End If
Call PEC_DrawAxis(HC.plot)
Call PEC_DrawAxis(HC.PlotCap)
Call PEC_UpdateControls
PlaybackTimer.strPlayback = oLangDll.GetLangString(6117)
End Sub
Public Sub PEC_Timestamp()
Dim key As String
Dim Ini As String
Dim pos As Double
Dim temp As String
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[pec]"
pos = EQGetMotorValues(0)
temp = Now
Call HC.oPersist.WriteIniValueEx("SYNCPOS", CStr(pos), key, Ini)
Call HC.oPersist.WriteIniValueEx("SYNCTIME", temp, key, Ini)
Call HC.oPersist.WriteIniValueEx("STAR_DEC", CStr(gDec), key, Ini)
Call HC.oPersist.WriteIniValueEx("STAR_RA", CStr(gRA), key, Ini)
End Sub
Public Sub PEC_StartTracking()
Dim rate As Double
HC.PECTimer.Enabled = False
gPEC_Enabled = True
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(188)
PlaybackTimer.CurrRate = 0
If gTrackingStatus = 0 Then
gTrackingStatus = 1
End If
Call PEC_PlotCurve(PECDef1)
PlaybackTimer.Firsttime = True
PlaybackTimer.timerflag = False
PlaybackTimer.TraceIdx = 0
HC.PECTimer.Interval = 1000
HC.PECTimer.Enabled = True
On Error Resume Next
TraceFileNum = FreeFile
Close TraceFileNum
If gPEC_trace = 1 Then
Close TraceFileNum
Open HC.oPersist.GetIniPath() + "\pectrace_" & CStr(gPEC_DynamicRateAdjust) & ".txt" For Output As TraceFileNum
' Print TraceFileNum, "Idx WormIndex Motor StepsMoved NextRate ElapsedTime CurrentRate RateAchived RateSumExpected RateSumActual RateError OverallRate"
Print #TraceFileNum, "Idx WormIdx Motor StepsMoved NextRate OverallRate elapesedtime dt TimerInterval RateError MeasuredRate"
End If
End Sub
Public Sub PEC_StopTracking()
gPEC_Enabled = False
PlaybackTimer.strPlayback = oLangDll.GetLangString(6117)
gRA_LastRate = 0
Close TraceFileNum
End Sub
Public Sub PEC_Unload()
Call PEC_WriteParams
Close TraceFileNum
End Sub
Public Sub PEC_GainScroll_Change()
On Error Resume Next
gPEC_Gain = CDbl(PECConfigFrm.GainScroll.Value) / 10
PECConfigFrm.Label43.Caption = "x" & CStr(gPEC_Gain)
If PECConfigFrm.GainScroll.Enabled Then
If CalcRates(PECDef1) Then KillPec
PEC_WriteParams
End If
End Sub
Public Sub PEC_Clear()
PEC_File = ""
PEC_WriteParams
KillPec
End Sub
Public Sub PEC_OnUse()
If HC.CheckPEC.Value Then
HC.CmdTrack(1).Visible = True
HC.CmdTrack(0).Visible = False
HC.CommandPecPlay.Picture = LoadResPicture(109, vbResBitmap)
Else
HC.CmdTrack(1).Visible = False
HC.CmdTrack(0).Visible = True
HC.CommandPecPlay.Picture = LoadResPicture(108, vbResBitmap)
PEC_StopTracking
End If
If gTrackingStatus = 1 Then
EQStartSidereal
End If
End Sub
Public Function PEC_SetGain(sGain As String) As Boolean
Dim dGain As Double
dGain = val(sGain)
If (dGain >= PECConfigFrm.GainScroll.min And dGain <= PECConfigFrm.GainScroll.max) Then
PECConfigFrm.GainScroll.Value = dGain
PEC_SetGain = True
Else
PEC_SetGain = False
End If
End Function
Public Function PEC_SetPhase(sPhase As String) As Boolean
Dim dPhase As Double
dPhase = val(sPhase)
If (dPhase >= PECConfigFrm.PhaseScroll.min And dPhase <= PECConfigFrm.PhaseScroll.max) Then
PECConfigFrm.PhaseScroll.Value = dPhase
PEC_SetPhase = True
Else
PEC_SetPhase = False
End If
End Function
Public Sub PEC_Load()
FileDlg.filter = "*.txt*"
FileDlg.Show (1)
If FileDlg.FileName <> "" Then PEC_LoadFile FileDlg.FileName
End Sub
Public Function PEC_LoadFile(FileName As String) As Boolean
PEC_File = FileName
PECDef1.FileName = FileName
If Import(PECDef1) Then
PEC_WriteParams
HC.Change_Display (3)
PEC_LoadFile = True
Else
KillPec
PEC_LoadFile = False
End If
End Function
Public Sub PEC_Save()
Dim i As Integer
FileDlg.filter = "*.txt*"
FileDlg.Show (1)
If FileDlg.FileName <> "" Then
PEC_File = FileDlg.FileName
' force a .txt extension
i = InStr(PEC_File, ".")
If i <> 0 Then
PEC_File = Left$(PEC_File, i - 1)
End If
PEC_File = PEC_File & ".txt"
PECDef1.FileName = PEC_File
Call Export(PECDef1, PECConfigFrm.PhaseScroll.Value)
PECConfigFrm.PhaseScroll.Value = 0
Call PEC_WriteParams
If Import(PECDef1) = True Then
Call PEC_PlotCurve(PECDef1)
Else
KillPec
End If
End If
End Sub
Public Function PEC_SaveFile(FileName As String, PECDef As PECDefinition) As Boolean
PECDef.FileName = FileName
If Export(PECDef, 0) Then
PEC_SaveFile = True
Else
PEC_SaveFile = False
End If
End Function
Public Sub PEC_Timer()
Dim rate As Double
Dim X As Integer
Dim timenow As Double
Dim TimeSlip As Double
Dim RateSumError As Double
Dim StepsMoved As Long
Dim RateError As Double
Dim OverallRate As Double
Dim MeasuredRate As Double
Dim elapsedtime As Double
Dim curr As Double 'current time
Dim dt As Double 'delta time
Dim TimerInterval As Double
On Error Resume Next
If Not PlaybackTimer.timerflag Then
PlaybackTimer.timerflag = True
If PlaybackTimer.Firsttime Then
PlaybackTimer.lasttime = GetTickCount()
PlaybackTimer.StartTime = PlaybackTimer.lasttime
PlaybackTimer.ringcounter = EQGetMotorValues(0)
PlaybackTimer.LastRingCounter = PlaybackTimer.ringcounter
PlaybackTimer.StartRingCounter = PlaybackTimer.ringcounter
' force immediate rate update
PECDef1.CurrIdx = GetIdx(PECDef1)
rate = PECDef1.PECCurve(PECDef1.CurrIdx).PECrate
If gPEC_Enabled And gTrackingStatus = 1 Then
Call PEC_MoveAxis(0, rate)
End If
HC.plot.DrawMode = 7
PlaybackTimer.newpos = PECDef1.CurrIdx * HC.plot.ScaleWidth / PECDef1.Period
HC.plot.Line (PlaybackTimer.newpos, 0)-(PlaybackTimer.newpos, HC.plot.ScaleHeight), vbRed
PlaybackTimer.oldpos = PlaybackTimer.newpos
PlaybackTimer.RateSumActual = 0
PlaybackTimer.RateSumExpected = rate
PlaybackTimer.CurrRate = rate
PlaybackTimer.Firsttime = False
Else
curr = GetTickCount() ' read current system time
'determine the diff between times
elapsedtime = Abs(CDbl(curr - PlaybackTimer.StartTime)) / 1000
dt = Abs(CDbl(curr - PlaybackTimer.lasttime)) / 1000 'determine the diff between times
PlaybackTimer.lasttime = curr
' If gTrackingStatus <> 0 Then
'only maintain pe trace updates if we're tracking
' only apply rate changes if we're tracking at sidreal and PEC is on
If gPEC_Enabled And gTrackingStatus = 1 Then
PlaybackTimer.ringcounter = EQGetMotorValues(0)
StepsMoved = PlaybackTimer.ringcounter - PlaybackTimer.LastRingCounter
PECDef1.CurrIdx = PECDef1.CurrIdx + 1
If PECDef1.CurrIdx >= PECDef1.Period Then
PECDef1.CurrIdx = 0
End If
PlaybackTimer.PecResyncCount = PlaybackTimer.PecResyncCount + 1
If PlaybackTimer.PecResyncCount >= PECDef1.Period Then
PECDef1.CurrIdx = GetIdx(PECDef1)
TimerInterval = 1000
PlaybackTimer.StartTime = GetTickCount()
PlaybackTimer.StartRingCounter = PlaybackTimer.ringcounter
PlaybackTimer.RateSumExpected = 0
PlaybackTimer.RateSumActual = 0
RateError = 0
Call PEC_PlotCurve(PECDef1)
Else
TimeSlip = elapsedtime - PlaybackTimer.PecResyncCount
MeasuredRate = (StepsMoved / dt) * (1296000 / CDbl(gTot_RA))
PlaybackTimer.RateSumActual = PlaybackTimer.RateSumActual + MeasuredRate
RateError = PlaybackTimer.RateSumExpected - PlaybackTimer.RateSumActual
If TimeSlip > 0 Then
TimerInterval = 1000 - (TimeSlip * 1000)
If TimerInterval < 100 Then TimerInterval = 100
Else
TimerInterval = 1000
End If
End If
HC.PECTimer.Interval = TimerInterval
PlaybackTimer.LastRingCounter = PlaybackTimer.ringcounter
' Get next rate to apply.
rate = PECDef1.PECCurve(PECDef1.CurrIdx).PECrate
PlaybackTimer.RateSumExpected = PlaybackTimer.RateSumExpected + rate
If rate <> PlaybackTimer.CurrRate Then
' apply the min/max limits - just in case there's
' an error in the rate calculations this prevents'
' the mount from ever slewing wildly!
If rate > MaxRate Then
rate = MaxRate
Else
If rate < MinRate Then
rate = MinRate
End If
End If
If gHemisphere = 0 Then
PlaybackTimer.strPlayback = oLangDll.GetLangString(6118) & " " & FormatNumber(rate - SID_RATE, 3)
Else
PlaybackTimer.strPlayback = oLangDll.GetLangString(6118) & " " & FormatNumber(-rate - SID_RATE, 3)
End If
Select Case gPEC_DynamicRateAdjust
Case 1
Call PEC_MoveAxis(0, rate + RateError)
Case 0
Call PEC_MoveAxis(0, rate)
End Select
PlaybackTimer.CurrRate = rate
End If
Else
PlaybackTimer.strPlayback = oLangDll.GetLangString(6117)
PlaybackTimer.ringcounter = gEmulRA
PECDef1.CurrIdx = GetIdx(PECDef1)
End If
HC.plot.DrawMode = 7
PlaybackTimer.newpos = PECDef1.CurrIdx * HC.plot.ScaleWidth / PECDef1.Period
If CInt(PlaybackTimer.oldpos) <> CInt(PlaybackTimer.newpos) Then
HC.plot.Line (PlaybackTimer.oldpos, 0)-(PlaybackTimer.oldpos, HC.plot.ScaleHeight), vbRed
HC.plot.Line (PlaybackTimer.newpos, 0)-(PlaybackTimer.newpos, HC.plot.ScaleHeight), vbRed
PlaybackTimer.oldpos = PlaybackTimer.newpos
End If
' End If
If gPEC_trace = 1 Then
OverallRate = ((PlaybackTimer.ringcounter - PlaybackTimer.StartRingCounter) * 1296000 / gTot_RA) / elapsedtime
Print #TraceFileNum, CStr(PlaybackTimer.TraceIdx) & " " & CStr(PECDef1.CurrIdx) & " " & CStr(PlaybackTimer.ringcounter) & " " & CStr(StepsMoved) & " " & CStr(PlaybackTimer.CurrRate) & " " & CStr(OverallRate) & " " & CStr(elapsedtime) & " " & CStr(dt) & " " & CStr(CInt(TimerInterval)) & " " & CStr(RateError) & " " & CStr(MeasuredRate)
End If
End If
PlaybackTimer.timerflag = False
Else
Print #TraceFileNum, "TimerOverflow"
End If
PlaybackTimer.TraceIdx = PlaybackTimer.TraceIdx + 1
End Sub
Public Sub PEC_CaptureTimer()
Dim timenow As Double
Dim TimeSlip As Double
Dim StepsMoved As Long
Dim elapsedtime As Double
Dim curr As Double 'current time
Dim dt As Double 'delta time
Dim motor As Double
Dim TimerInterval As Double
Dim X As Single
Dim Y As Single
On Error Resume Next
If Not CaptureTimer.timerflag Then
CaptureTimer.timerflag = True
Select Case CaptureTimer.State
Case 0
' initialise
gPEC_Capture_Cycles = PECConfigFrm.ComboPecCap.ItemData(PECConfigFrm.ComboPecCap.ListIndex)
ReDim PECCap.CapureData(gRAWormPeriod * gPEC_Capture_Cycles)
PECCap.Period = gRAWormPeriod
PECCap.Steps = gRAWormSteps
PECCap.idx = 0
CaptureTimer.lasttime = GetTickCount()
CaptureTimer.StartTime = CaptureTimer.lasttime
CaptureTimer.ringcounter = EQGetMotorValues(0)
CaptureTimer.LastRingCounter = CaptureTimer.ringcounter
CaptureTimer.StartRingCounter = CaptureTimer.ringcounter
CaptureTimer.pe = 0
CaptureTimer.lastx = 0
CaptureTimer.lasty = HC.PlotCap.ScaleHeight / 2
CaptureTimer.yoffset = 0
' what is the max epected change in motor position
' well in a second we could guide 15 arcsecs and track move by 15 arcsec
' so call it 40 arc secs difference is possible
' 1 arc sec = CDbl(gTot_RA) / 1296000 steps
CaptureTimer.MaxStepChange = 40 * CDbl(gTot_RA) / 1296000
HC.PlotCap.Cls
HC.PlotCap.DrawMode = 13
CaptureTimer.State = 1
Case 1
' capture
If gTrackingStatus = 1 Then
motor = EQGetMotorValues(0)
curr = GetTickCount() ' read current system time
'determine the diff between times
elapsedtime = Abs(CDbl(curr - CaptureTimer.StartTime)) / 1000
dt = Abs(CDbl(curr - CaptureTimer.lasttime)) / 1000 'determine the diff between times
If Abs(motor - CaptureTimer.LastRingCounter) < (CaptureTimer.MaxStepChange * dt) Then
' If motor <= 16777215 Then
CaptureTimer.strCapture = oLangDll.GetLangString(6119) & " " & CStr(PECCap.idx) & "/" & CStr(UBound(PECCap.CapureData()))
CaptureTimer.lasttime = curr
With PECCap.CapureData(PECCap.idx)
.MotorPos = motor
.DeltaPos = .MotorPos - CaptureTimer.LastRingCounter
.DeltaTime = dt
CaptureTimer.LastRingCounter = .MotorPos
.time = elapsedtime
.rate = (.DeltaPos / .DeltaTime) * (1296000 / CDbl(gTot_RA))
If CaptureTimer.InvertCapture <> 0 Then
.peInc = .rate - gSiderealRate
Else
.peInc = gSiderealRate - .rate
End If
CaptureTimer.pe = CaptureTimer.pe + .peInc
.pe = CaptureTimer.pe
X = PECCap.idx Mod PECCap.Period
If X = 0 Then
CaptureTimer.yoffset = CaptureTimer.pe * HC.PlotCap.ScaleHeight / 180
CaptureTimer.lasty = HC.PlotCap.ScaleHeight / 2
CaptureTimer.lastx = 0
If CaptureTimer.PenToggle Then
HC.PlotCap.ForeColor = vbGreen
CaptureTimer.PenToggle = False
Else
HC.PlotCap.ForeColor = vbRed
CaptureTimer.PenToggle = True
End If
End If
X = X * HC.PlotCap.ScaleWidth / PECCap.Period
If CInt(X) <> CInt(CaptureTimer.lastx) Then
Y = HC.PlotCap.ScaleHeight / 2 - (CaptureTimer.pe * HC.PlotCap.ScaleHeight / 180) + CaptureTimer.yoffset
HC.PlotCap.Line (X + 1, HC.PlotCap.ScaleHeight / 2)-(X + 1, Y) ', vbRed
HC.PlotCap.Line (X, 0)-(X, HC.PlotCap.ScaleHeight), vbBlack
HC.PlotCap.Line (CaptureTimer.lastx, CaptureTimer.lasty)-(X, Y) ', vbMagenta
CaptureTimer.lastx = X
CaptureTimer.lasty = Y
End If
Call PEC_DrawAxis(HC.PlotCap)
End With
PECCap.idx = PECCap.idx + 1
If PECCap.idx < UBound(PECCap.CapureData()) Then
TimeSlip = elapsedtime - PECCap.idx
If TimeSlip > 0 Then
TimerInterval = 1000 - (TimeSlip * 1000)
If TimerInterval < 100 Then TimerInterval = 100
Else
TimerInterval = 1000
End If
HC.PECCapTimer.Interval = TimerInterval
Else
' capture complete
CaptureTimer.State = 2
HC.PECCapTimer.Enabled = False
HC.CheckCapPec.Value = 0
CaptureTimer.strCapture = ""
End If
Else
' error reading motor position!
End If
Else
' kill capture if not tracking
HC.CheckCapPec.Value = 0
End If
Case 2
' capture complete
HC.PECCapTimer.Enabled = False
CaptureTimer.strCapture = ""
Case Else
HC.CheckCapPec.Value = 0
End Select
CaptureTimer.timerflag = False
End If
End Sub
Public Sub PEC_UpdateControls()
If gPEC_Gain * 10 > PECConfigFrm.GainScroll.max Then gPEC_Gain = 1
PECConfigFrm.GainScroll.Value = gPEC_Gain * 10
Call PEC_GainScroll_Change
PECConfigFrm.PhaseScroll.Value = gPEC_PhaseAdjust
Call PEC_PhaseScroll_Change
End Sub
Public Sub PEC_ReadParams()
Dim tmptxt As String
Dim i As Integer
Dim key As String
Dim Ini As String
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[pec]"
tmptxt = HC.oPersist.ReadIniValueEx("WORKING_DIR", key, Ini)
If tmptxt <> "" Then
gPEC_FileDir = tmptxt
Else
' no value exists - create a default
gPEC_FileDir = Environ("ProgramFiles") & "\EQMOD\PEC\"
Call HC.oPersist.WriteIniValueEx("WORKING_DIR", gPEC_FileDir, key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("INVERT_CAPTURE", key, Ini)
If tmptxt <> "" Then
CaptureTimer.InvertCapture = CInt(tmptxt)
Else
' no value exists - create a default
CaptureTimer.InvertCapture = 0
Call HC.oPersist.WriteIniValueEx("INVERT_CAPTURE", CStr(CaptureTimer.InvertCapture), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("TIMESTAMP_FILES", key, Ini)
If tmptxt <> "" Then
gPEC_TimeStampFiles = CInt(tmptxt)
Else
' no value exists - create a default
gPEC_TimeStampFiles = 0
Call HC.oPersist.WriteIniValueEx("TIMESTAMP_FILES", CStr(gPEC_TimeStampFiles), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("FILTER_LOPASS", key, Ini)
If tmptxt <> "" Then
gPEC_filter_lowpass = CInt(tmptxt)
If gPEC_filter_lowpass < 10 Then gPEC_filter_lowpass = 10
Else
' no value exists - create a default
gPEC_filter_lowpass = 30
Call HC.oPersist.WriteIniValueEx("FILTER_LOPASS", CStr(gPEC_filter_lowpass), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("FILTER_MAG", key, Ini)
If tmptxt <> "" Then
gPEC_mag = CInt(tmptxt)
Else
' no value exists - create a default
gPEC_mag = 10
Call HC.oPersist.WriteIniValueEx("FILTER_MAG", CStr(gPEC_mag), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("CAPTURE_CYCLES", key, Ini)
If tmptxt <> "" Then
gPEC_Capture_Cycles = CInt(tmptxt)
Else
' no value exists - create a default
gPEC_Capture_Cycles = 5
Call HC.oPersist.WriteIniValueEx("CAPTURE_CYCLES", CStr(gPEC_Capture_Cycles), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("AUTO_APPLY", key, Ini)
If tmptxt <> "" Then
If CInt(tmptxt) = 1 Then
gPEC_AutoApply = 1
Else
gPEC_AutoApply = 0
End If
Else
' no value exists - create a default
gPEC_AutoApply = 1
Call HC.oPersist.WriteIniValueEx("AUTO_APPLY", CStr(gPEC_AutoApply), key, Ini)
End If
' tmptxt = HC.oPersist.ReadIniValueEx("FILTER_HIPASS", key, Ini)
' If tmptxt <> "" Then
' filter_hipass = CInt(tmptxt)
' Else
' ' no value exists - create a default
' filter_hipass = 1000#
' Call HC.oPersist.WriteIniValueEx("FILTER_HIPASS", CStr(filter_hipass), key, Ini)
' End If
tmptxt = HC.oPersist.ReadIniValueEx("THRESHOLD", key, Ini)
If tmptxt <> "" Then
threshold = CDbl(tmptxt)
Else
' no value exists - create a default
threshold = 0#
Call HC.oPersist.WriteIniValueEx("THRESHOLD", CStr(threshold), key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("GAIN", key, Ini)
If tmptxt <> "" Then
gPEC_Gain = CDbl(tmptxt)
Else
' no value exists - create a default
gPEC_Gain = 1#
Call HC.oPersist.WriteIniValueEx("GAIN", CStr(gPEC_Gain), key, Ini)
End If
PEC_File = HC.oPersist.ReadIniValueEx("PEC_FILE", key, Ini)
PECDef1.FileName = PEC_File
If PECDef1.FileName = "" Then
' PEC_File = "pec.txt"
' no value exists - create a default
Call HC.oPersist.WriteIniValueEx("PEC_FILE", "", key, Ini)
End If
tmptxt = HC.oPersist.ReadIniValueEx("PHASE_SHIFT", key, Ini)
If tmptxt <> "" Then
gPEC_PhaseAdjust = CInt(tmptxt)
Else
' no value exists - create a default
Call HC.oPersist.WriteIniValueEx("PHASE_SHIFT", "0", key, Ini)
gPEC_PhaseAdjust = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("MAX_RATEADJUST", key, Ini)
If tmptxt <> "" Then
gMaxRateAdjust = CDbl(tmptxt)
If gMaxRateAdjust < 3 Then
' fix to increse previous default of 1
gMaxRateAdjust = 3
Call HC.oPersist.WriteIniValueEx("MAX_RATEDAJUST", "3", key, Ini)
End If
Else
' no value exists - create a default
Call HC.oPersist.WriteIniValueEx("MAX_RATEDAJUST", "3", key, Ini)
gMaxRateAdjust = 3
End If
tmptxt = HC.oPersist.ReadIniValueEx("DYNAMIC_RATE_ADJUST", key, Ini)
If tmptxt <> "" Then
gPEC_DynamicRateAdjust = val(tmptxt)
Else
Call HC.oPersist.WriteIniValueEx("DYNAMIC_RATE_ADJUST", "0", key, Ini)
gPEC_DynamicRateAdjust = 0
End If
tmptxt = HC.oPersist.ReadIniValueEx("DEBUG", key, Ini)
If tmptxt = "" Then
gPEC_Debug = 0
Call HC.oPersist.WriteIniValueEx("DEBUG", "0", key, Ini)
Else
gPEC_Debug = val(tmptxt)
End If
Select Case gPEC_Debug
Case 1
PECConfigFrm.CheckTracePec.Visible = True
PECConfigFrm.PECMethodCombo.Visible = True
Case Else
PECConfigFrm.CheckTracePec.Visible = False
PECConfigFrm.PECMethodCombo.Visible = False
End Select
End Sub
Public Sub PEC_WriteParams()
Dim key As String
Dim Ini As String
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[pec]"
Call HC.oPersist.WriteIniValueEx("THRESHOLD", CStr(threshold), key, Ini)
Call HC.oPersist.WriteIniValueEx("GAIN", CStr(gPEC_Gain), key, Ini)
Call HC.oPersist.WriteIniValueEx("PEC_FILE", PECDef1.FileName, key, Ini)
Call HC.oPersist.WriteIniValueEx("PHASE_SHIFT", CStr(PECConfigFrm.PhaseScroll.Value), key, Ini)
Call HC.oPersist.WriteIniValueEx("CAPTURE_CYCLES", CStr(gPEC_Capture_Cycles), key, Ini)
Call HC.oPersist.WriteIniValueEx("FILTER_LOPASS", CStr(gPEC_filter_lowpass), key, Ini)
Call HC.oPersist.WriteIniValueEx("FILTER_MAG", CStr(gPEC_mag), key, Ini)
Call HC.oPersist.WriteIniValueEx("TIMESTAMP_FILES", CStr(gPEC_TimeStampFiles), key, Ini)
Call HC.oPersist.WriteIniValueEx("AUTO_APPLY", CStr(gPEC_AutoApply), key, Ini)
Call HC.oPersist.WriteIniValueEx("WORKING_DIR", gPEC_FileDir, key, Ini)
End Sub
Public Function NormalisePosition(ByVal Position As Double, wormsteps As Double) As Double
' Normalisation is intended for raw stepper position which are centered
' around H80000. Once normalised the range will be 0-50132.
If Position > wormsteps Then
' While position < gRAEncoder_Zero_pos
' position = position + gTot_RA
' Wend
' position = position - gRAEncoder_Zero_pos
NormalisePosition = Position Mod (wormsteps)
Else
' don't take into account the H80000 ofset if the position
' is already normalised!
NormalisePosition = Position
End If
End Function
Private Function Import(PECDef As PECDefinition) As Boolean
Dim temp1 As String
Dim temp2 As String
Dim lineno As Integer
Dim idx As Integer
Dim pos As Integer
Dim CurveMin As PECData
Dim CurveMax As PECData
Dim ratesum As Double
Dim MotorPos As Double
Dim CycleCount As Integer
Dim error As Boolean
Dim drift As Double
Dim wp As Double
Dim NF1 As Integer
On Error GoTo ImportError
NF1 = FreeFile
error = False
If PECDef.FileName = "" Then
error = True
GoTo errCheck
End If
Close #NF1
Open PECDef.FileName For Input As NF1
lineno = 0
idx = 0
While Not EOF(NF1)
Line Input #NF1, temp1
If lineno > 0 Then
If Left$(temp1, 1) = "!" Then
' parse parameters
pos = InStr(temp1, "=")
If pos <> 0 Then
temp2 = Left$(temp1, pos - 1)
If temp2 = "!WormPeriod" Then
temp1 = Right$(temp1, Len(temp1) - pos)
wp = Int(CDbl(temp1) + 0.5)
PECDef.Period = wp
ReDim PECDef.PECCurve(wp)
ReDim PECDef.PECCurveTmp(wp)
For idx = 0 To (wp - 1)
PECDef.PECCurve(idx).signal = 0
Next idx
idx = 0
' apply a default if steps per worm isn't in the pec file
PECDef.Steps = gRAWormSteps
Else
If temp2 = "!StepsPerWorm" Then
temp1 = Right$(temp1, Len(temp1) - pos)
PECDef.Steps = Int(CDbl(temp1) + 0.5)
End If
End If
End If
Else
If Left$(temp1, 1) <> "#" Then
With PECDef.PECCurve(idx)
' replace tabs with spaces
temp1 = Replace(temp1, Chr(9), " ")
pos = InStr(temp1, " ")
If pos <> 0 Then
temp2 = Left$(temp1, pos - 1)
temp1 = Right$(temp1, Len(temp1) - pos)
.time = CDbl(temp2)
pos = InStr(temp1, " ")
If pos <> 0 Then
temp2 = Left$(temp1, pos - 1)
temp1 = Right$(temp1, Len(temp1) - pos)
If CycleCount = 0 Then
' store the motor positions for the first cycle
MotorPos = CDbl(temp2)
.RawPosn = MotorPos
.PEPosition = NormalisePosition(Int(MotorPos), PECDef.Steps)
End If
.signal = (.signal + CDbl(temp1))
.cycle = CycleCount + 1
End If
idx = idx + 1
If idx = wp Then
CycleCount = CycleCount + 1
idx = 0
End If
End If
End With
End If
End If
End If
lineno = lineno + 1
Wend
closefile:
Close #NF1
If error Then GoTo errCheck
If CycleCount >= 1 Then
' average the signal
For idx = 0 To (PECDef.Period - 1)
With PECDef.PECCurve(idx)
.signal = .signal / .cycle
End With
Next idx
' remove any net cycle offset from the PEC curve
drift = (PECDef.PECCurve(PECDef.Period - 1).signal - PECDef.PECCurve(0).signal) / (PECDef.Period + 1)
CurveMin.signal = 100
CurveMax.signal = -100
For idx = 0 To (PECDef.Period - 1)
With PECDef.PECCurve(idx)
.signal = .signal - idx * drift
If .signal > CurveMax.signal Then
CurveMax = PECDef.PECCurve(idx)
End If
If .signal < CurveMin.signal Then
CurveMin = PECDef.PECCurve(idx)
End If
End With
Next idx
PECDef.CurrIdx = 0
PECDef.MaxPe = CurveMax.signal
PECDef.MinPe = CurveMin.signal
Call PEC_PlotCurve(PECDef)
' caluculate correction rates to be used.
error = CalcRates(PECDef)
Else
HC.Add_Message ("PECImport: Insufficient PEC samples!")
error = True
End If
GoTo errCheck
ImportError:
Close #NF1
error = True
HC.Add_Message ("PECImport: ErrNo." & Err.Number)
HC.Add_Message (Err.Description)
Err.Clear
errCheck:
If error Then
Import = False
Else
HC.PECTimer.Enabled = True
HC.CmdPecSave.Enabled = True
PECConfigFrm.GainScroll.Enabled = True
PECConfigFrm.PhaseScroll.Enabled = True
HC.CheckPEC.Enabled = True
HC.CheckPEC.Value = 1
HC.CmdTrack(1).Enabled = True
Import = True
' set the PEC frame caption to show file name
pos = InStrRev(PEC_File, "\")
temp1 = Right(PEC_File, Len(PEC_File) - pos)
HC.Frame9.Caption = oLangDll.GetLangString(19) & " " & temp1
End If
End Function
Private Sub KillPec()
HC.Add_Message ("PEC: Disabled")
HC.Frame9.Caption = oLangDll.GetLangString(19)
HC.CmdTrack(1).Visible = False
HC.PECTimer.Enabled = False
HC.CmdPecSave.Enabled = False
PECConfigFrm.GainScroll.Enabled = False
PECConfigFrm.PhaseScroll.Enabled = False
HC.CheckPEC.Enabled = False
HC.CheckPEC.Value = 0
gPEC_Enabled = False
HC.plot.Cls
End Sub
Private Function Export(PECDef As PECDefinition, phaseshift As Integer) As Boolean
Dim temp1 As String
Dim idx As Integer
Dim pos As Integer
Dim NF1 As Integer
On Error GoTo exporterr
Export = True
NF1 = FreeFile
Close #NF1
Open PECDef.FileName For Output As NF1
' Print NF1, Date$ & " " & Time$
Print #NF1, "# " & HC.MainLabel.Caption
Print #NF1, "!WormPeriod=" & CStr(PECDef.Period)
Print #NF1, "!StepsPerWorm=" & CStr(PECDef.Steps)
Print #NF1, "# time - motor - smoothed PE"
For idx = 0 To UBound(PECDef.PECCurve) - 1
' apply local phase shift
pos = (idx + phaseshift) Mod PECDef.Period
Print #NF1, FormatNumber(idx, 0, , , 0) & " " & FormatNumber(PECDef.PECCurve(idx).PEPosition, 0, , , 0) & " " & FormatNumber(PECDef.PECCurve(pos).signal, 4, , , 0)
Next idx
GoTo endexport
exporterr:
Export = False
endexport:
Close #NF1
End Function
Public Function PEC_Write_Table(Index As Double, Position As Double, signal As Double) As Boolean
Dim i As Integer
If Index = 0 Then
' first element being written - clear out existing data
ReDim PECDef1.PECCurveTmp(PECDef1.Period)
End If
If Index >= UBound(PECDef1.PECCurveTmp) Then
PEC_Write_Table = False
Exit Function
End If
If Position > PECDef1.Steps Then
PEC_Write_Table = False
Exit Function
End If
' data is only written to the temporary curve
With PECDef1.PECCurveTmp(Index)
.time = Index
.signal = signal
.PEPosition = Position
.RawPosn = Position
End With
If Index = UBound(PECDef1.PECCurveTmp) - 1 Then
' when the last index is written we save the file.
PEC_File = HC.oPersist.GetIniPath & "\PEC.txt"
PECDef1.FileName = PEC_File
' copy temp store to real curve
For i = 0 To PECDef1.Period - 1
PECDef1.PECCurve(i) = PECDef1.PECCurveTmp(i)
Next i
' write curve to file
Export PECDef1, 0
' save PEC file name
Call PEC_WriteParams
' load from file
If Import(PECDef1) = True Then
' update display
Call PEC_PlotCurve(PECDef1)
Else
KillPec
End If
End If
PEC_Write_Table = True
End Function
Private Sub PEC_DrawAxis(plot As PictureBox)
Dim mid As Integer
mid = plot.ScaleHeight / 2
plot.Line (0, mid)-(plot.ScaleWidth, mid), &H80FF&
plot.Line (0, (mid) - 4)-(0, mid + 2), &H80FF&
plot.Line (plot.ScaleWidth * 0.25, mid - 2)-(plot.ScaleWidth * 0.25, mid + 2), &H80FF&
plot.Line (plot.ScaleWidth * 0.5, mid - 2)-(plot.ScaleWidth * 0.5, mid + 2), &H80FF&
plot.Line (plot.ScaleWidth * 0.75, (mid) - 2)-(plot.ScaleWidth * 0.75, mid + 2), &H80FF&
plot.Line (plot.ScaleWidth - 1, mid - 2)-(plot.ScaleWidth - 1, mid + 2), &H80FF&
End Sub
Private Sub PEC_PlotCurve(PECDef As PECDefinition)
Dim idx As Integer
Dim oldval, newval As Double
Dim range, hscale As Double
Dim mid As Integer
range = PECDef.MaxPe - PECDef.MinPe
HC.plot.Cls
Call PEC_DrawAxis(HC.plot)
mid = HC.plot.ScaleHeight / 2
hscale = HC.plot.ScaleWidth / PECDef.Period
If range > 0 Then
oldval = mid - PECDef.PECCurve(0).signal * 0.8 * HC.plot.ScaleHeight / range
For idx = 1 To (PECDef.Period - 1)
newval = mid - PECDef.PECCurve(idx).signal * 0.8 * HC.plot.ScaleHeight / range
HC.plot.Line (idx * hscale, newval)-((idx - 1) * hscale, oldval), vbMagenta
oldval = newval
Next idx
End If
End Sub
Private Function CalcRates(PECDef As PECDefinition) As Boolean
Dim idx, sec As Integer
Dim ratesum As Double
Dim rate, lastrate, truerate, remainder As Double
Dim newpos As Double
Dim StepsMoved As Double
Dim debugfile As String
Dim debugmark As Integer
Dim i As Integer
Dim NF1 As Integer
debugmark = 0
debugfile = HC.oPersist.GetIniPath() + "\pec_rates_" & CStr(PECDef.Period) & ".txt"
On Error GoTo endsub
NF1 = FreeFile
Close #NF1
Open debugfile For Output As NF1
On Error GoTo handle_error
' calculate the rate change between each PE curve sample
ratesum = 0
For idx = 1 To (PECDef.Period - 1)
With PECDef.PECCurve(idx)
.PErate = PECDef.PECCurve(idx - 1).signal - .signal
ratesum = ratesum + .PErate
End With
Next idx
' first rate = average of 2nd and last to remove any discontinuities
PECDef.PECCurve(0).PErate = (PECDef.PECCurve(PECDef.Period - 1).PErate + PECDef.PECCurve(1).PErate) / 2
ratesum = ratesum + PECDef.PECCurve(0).PErate
' Apply the current threshhold and gain settings
' The threshold setting allows us to reduce the number of rate corrections sent
' to the mount.
' The gain is just a user 'fiddle' factor ;-)
debugmark = 1
ratesum = 0
lastrate = PECDef.PECCurve(PECDef.Period - 1).PErate
For idx = 0 To (PECDef.Period - 1)
rate = PECDef.PECCurve(idx).PErate
If Abs(lastrate - rate) > threshold Then
lastrate = PECDef.PECCurve(idx).PErate
Else
rate = lastrate
End If
rate = rate * gPEC_Gain
PECDef.PECCurve(idx).PECrate = rate
ratesum = ratesum + rate
Next idx
' The sum of all rate changes over a single cycle should be 0 i.e. sidereal rate
' If this isn't the case then adjust them accordingly to ensure there is no net drift
debugmark = 2
For idx = 0 To (PECDef.Period - 1)
PECDef.PECCurve(idx).PECrate = PECDef.PECCurve(idx).PECrate - (ratesum / PECDef.Period)
Next idx
' unfortunately the way the mount accepts 'quantised' rate change messages means that we can't have
' just any rate we want. So work out what the rate will the mount will actually track at
' determine any error and attemp to correct for it in the next sample.
' Using this approach we should be able to acheve at worst sidereal - 0.024 arcsecs/sec
debugmark = 3
remainder = 0
For i = 1 To 3
ratesum = 0
For idx = 0 To (PECDef.Period - 1)
With PECDef.PECCurve(idx)
If gHemisphere = 0 Then
rate = SID_RATE_NORTH + .PECrate + remainder
' truerate = (9325.46154 / (Int((9325.46154 / RATE) + 0.5)))
truerate = (gTrackFactorRA / (Int((gTrackFactorRA / rate) + 0.5)))
' work out the error for next time
remainder = rate - truerate
.PECrate = truerate - SID_RATE_NORTH
ratesum = ratesum + .PECrate
Else
rate = SID_RATE_SOUTH + .PECrate + remainder
' truerate = (9325.46154 / (Int((9325.46154 / RATE) - 0.5)))
truerate = (gTrackFactorRA / (Int((gTrackFactorRA / rate) - 0.5)))
remainder = rate - truerate
.PECrate = truerate - SID_RATE_SOUTH
ratesum = ratesum + .PECrate
End If
End With
Next idx
Next i
For idx = 0 To (PECDef.Period - 1)
If gHemisphere = 0 Then
PECDef.PECCurve(idx).PECrate = PECDef.PECCurve(idx).PECrate + SID_RATE_NORTH
Else
PECDef.PECCurve(idx).PECrate = PECDef.PECCurve(idx).PECrate + SID_RATE_SOUTH
End If
Next idx
' now we know what rates the mount will be tracking at we can
' calculate the expected motor positions at each sample
debugmark = 4
PECDef.PECCurve(0).PECPosition = PECDef.PECCurve(0).PEPosition
lastrate = 0
For idx = 1 To (PECDef.Period - 1)
' motorpos = lastmotorpos + elapsedtime * gTot_RA / (ARCSECS_PER_360DEGREES / lastRate)
rate = PECDef.PECCurve(idx - 1).PECrate
If rate = 0 Then
rate = lastrate
Else
lastrate = rate
End If
StepsMoved = gTot_RA / (ARCSECS_PER_360DEGREES / rate)
newpos = PECDef.PECCurve(idx - 1).PECPosition + StepsMoved
PECDef.PECCurve(idx).PECPosition = newpos Mod (PECDef.Steps)
Next idx
' A lot has gone on here so write out a debug file
' for anaysis if things don't work as the should.
debugmark = 5
Print #NF1, "Index PE PosRawPE PosPE PosPEC RatePE RatePEC"
For idx = 0 To (PECDef.Period - 1)
With PECDef.PECCurve(idx)
Print #NF1, CStr(idx) & " " & _
FormatNumber(.signal, 4) & " " & _
FormatNumber(.RawPosn, 0) & " " & _
FormatNumber(.PEPosition, 0) & " " & _
FormatNumber(.PECPosition, 0) & " " & _
FormatNumber(.PErate, 4) & " " & _
FormatNumber(.PECrate, 4)
End With
Next idx
Print #NF1, "RateSum=" & FormatNumber(ratesum, 4)
CalcRates = False
GoTo endsub
handle_error:
Print #NF1, "ERROR NUMBER=" & Err.Number
Print #NF1, "ERROR DESCRIPTION=" & Err.Description
Print #NF1, "CodeTrace=" & debugmark
Print #NF1, "idx=" & idx
Print #NF1, "PECDef.PECCurve LBound=" & CStr(LBound(PECDef1.PECCurve))
Print #NF1, "PECDef.PECCurve UBound=" & CStr(UBound(PECDef1.PECCurve))
Print #NF1, "Period=" & CStr(PECDef.Period)
Err.Clear
CalcRates = True
endsub:
Close #NF1
End Function
Private Function GetIdx(PECDef As PECDefinition) As Integer
Dim MotorPos As Double
Dim curvepos As Double
Dim i, idx As Integer
' Determine an appropriate index into the PEC table that gives the
' best match for the current motor position. The best match is the
' position that is one step in advance of the motor.
' Generally this will just result in an incermenting of the index so
' a starting position is suplied to speed up the number of comparisons
' required.
idx = 0
' if this PEC definition is in use
If PECDef.Period <> 0 Then
idx = PECDef.CurrIdx
If gPEC_Enabled Then
' PEC tacking - sync with PEC calculated motor positions.
curvepos = PECDef.PECCurve(idx).PECPosition
Else
' sidereal track so use uncorrected positions
If PECDef.Period <> 0 Then
curvepos = PECDef.PECCurve(idx).PEPosition
Else
idx = 0
GoTo endfunc
End If
End If
i = 0
If gHemisphere = 0 Then
' Northern hemisphere
' For northern hemisphere curves the motor positions increase
' with increasing index
MotorPos = NormalisePosition(PlaybackTimer.ringcounter + phaseshift, PECDef.Steps)
If (MotorPos > curvepos) Then
While MotorPos > curvepos And i < PECDef.Period
' search forwards till we find a curve position that is
' greater than the motor position
idx = (idx + 1) Mod PECDef.Period
curvepos = PECDef.PECCurve(idx).PECPosition
i = i + 1
Wend
Else
While MotorPos < curvepos And i < PECDef.Period
' search backwards till we find a curve position that is
' less than the motor position
idx = idx - 1
If idx < 0 Then idx = (PECDef.Period - 1)
curvepos = PECDef.PECCurve(idx).PECPosition
i = i + 1
Wend
' now increment to next curve position
' its best to have the curve in advance of the motor!
idx = (idx + 1) Mod PECDef.Period
End If
Else
' Southern hemisphere
' For southern hemisphere curves the motor positions decrease
' with increasing index
MotorPos = NormalisePosition(PlaybackTimer.ringcounter - phaseshift, PECDef.Steps)
If (MotorPos > curvepos) Then
While MotorPos > curvepos And i < PECDef.Period
' search backwards till we find a curve position that is
' smaller than the motor position
idx = idx - 1
If idx < 0 Then idx = (PECDef.Period - 1)
curvepos = PECDef.PECCurve(idx).PECPosition
i = i + 1
Wend
' now increment to next curve position
' its best to have the curve in advance of the motor!
idx = (idx + 1) Mod PECDef.Period
Else
' search forwards till we find a curve position that is
' greater than the motor position
While MotorPos < curvepos And i < PECDef.Period
idx = (idx + 1) Mod PECDef.Period
curvepos = PECDef.PECCurve(idx).PECPosition
i = i + 1
Wend
End If
End If
End If
endfunc:
GetIdx = idx
PlaybackTimer.PecResyncCount = 0
End Function
Public Sub PEC_MoveAxis(axis As Double, rate As Double)
' If rate <> 0 Then HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(188)
If axis = 0 Then
If (rate = 0) And (gDeclinationRate = 0) Then HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
If gEQRAPulseDuration = 0 Then
If (gRightAscensionRate * rate) <= 0 Or gTrackingStatus <> 1 Then
Call StartRA_by_Rate(rate)
Else
Call ChangeRA_by_Rate(rate)
End If
End If
gRightAscensionRate = rate
gTrackingStatus = 1
gRA_LastRate = rate
End If
End Sub
Public Sub PEC_StartCapture()
If gTrackingStatus = 1 Then
' Call KillPec
CaptureTimer.State = 0
HC.PECCapTimer.Enabled = True
Else
' can't capture if not tacking!
HC.CheckCapPec.Value = 0
End If
End Sub
Public Sub PEC_StopCapture()
HC.PECCapTimer.Enabled = False
If CaptureTimer.State = 2 Then
' capture has completed
Call SaveCaptureData
Else
' capture has been aborted
End If
CaptureTimer.State = 0
End Sub
Private Sub SaveCaptureData()
Dim temp1 As String
Dim idx As Integer
Dim PECIdx As Integer
Dim pos As Integer
Dim pe As Double
Dim PEC_Data() As PECFileData
Dim FileName As String
Dim NF1 As Integer
On Error GoTo exporterr
' create a capture file for debug
ReDim PEC_Data(PECCap.Period)
' clear pe
For idx = 0 To UBound(PEC_Data) - 1
PEC_Data(idx).pe = 0
PEC_Data(idx).cycle = 0
Next idx
' linearly regress to remove drifts and apply fft smoothing
PEC_RegressAndSmooth
If gPEC_TimeStampFiles = 1 Then
FileName = gPEC_FileDir & "pecapture_" & GetTimeStamp & "_EQMOD.txt"
Else
FileName = gPEC_FileDir & "pecapture_EQMOD.txt"
End If
NF1 = FreeFile
Close #NF1
Open FileName For Output As NF1
' output a perecorder format type file of the raw data
Print #NF1, "# " & HC.MainLabel.Caption
Print #NF1, "# AUTO-PEC"
Print #NF1, "# RA = " & CStr(gRA)
Print #NF1, "# DEC = " & CStr(gDec)
If gAscomCompatibility.AllowPulseGuide Then
Print #NF1, "# PulseGuide, Rate=" & CStr(HC.HScrollRARate.Value * 0.1)
Else
Print #NF1, "# ST-4 Guide, Rate=" & HC.RAGuideRateList.Text
End If
Print #NF1, "!WormPeriod=" & CStr(PECCap.Period)
Print #NF1, "!StepsPerWorm=" & CStr(PECCap.Steps)
Print #NF1, "#Time MotorPosition PE"
' Average signals to get a single cycle error signal
For idx = 0 To PECCap.idx - 1 'UBound(PECCap.CapureData) - 1
With PECCap.CapureData(idx)
PECIdx = idx Mod PECCap.Period
PEC_Data(PECIdx).Position = NormalisePosition(.MotorPos, PECCap.Steps)
' ignore first and last 120 samples as fft filter may exagerate their data
If idx > 120 And idx < PECCap.idx - 120 Then
' PEC_signal(PECIdx) = PEC_signal(PECIdx) + .peSmoothed / (gPEC_Capture_Cycles)
pe = PEC_Data(PECIdx).pe * PEC_Data(PECIdx).cycle + .peSmoothed
PEC_Data(PECIdx).cycle = PEC_Data(PECIdx).cycle + 1
PEC_Data(PECIdx).pe = pe / PEC_Data(PECIdx).cycle
End If
Print #NF1, FormatNumber(.time, 3, , , 0) & " " & CStr(.MotorPos) & " " & FormatNumber(.pe, 4, , , 0)
End With
Next idx
Close #NF1
' generate pec file
If gPEC_TimeStampFiles = 1 Then
FileName = gPEC_FileDir & "pec_" & GetTimeStamp & ".txt"
Else
FileName = gPEC_FileDir & "pec.txt"
End If
NF1 = FreeFile
Close #NF1
Open FileName For Output As NF1
Print #NF1, "# " & HC.MainLabel.Caption
Print #NF1, "!WormPeriod=" & CStr(PECCap.Period)
Print #NF1, "!StepsPerWorm=" & CStr(PECCap.Steps)
Print #NF1, "# time - motor - smoothed PE"
For idx = 0 To UBound(PEC_Data) - 1
pe = PEC_Data(idx).pe
Print #NF1, FormatNumber(idx, 0, , , 0) & " " & FormatNumber(PEC_Data(idx).Position, 0, , , 0) & " " & FormatNumber(pe, 4, , , 0)
Next idx
Close #NF1
' load pec
If gPEC_AutoApply = 1 Then
PEC_LoadFile FileName
' set pec gain to x1
PECConfigFrm.GainScroll.Value = 10
' set phase shift to 0
PECConfigFrm.PhaseScroll.Value = 0
End If
GoTo endexport
exporterr:
Close #NF1
endexport:
End Sub
Private Sub PEC_RegressAndSmooth()
Dim xy_sum As Double
Dim xx_sum As Double
Dim x_sum As Double
Dim y_sum As Double
Dim tmp As Double
Dim i As Long
Dim RawDataSize As Double
Dim slope As Double
Dim intercept As Double
Dim NF1 As Integer
On Error GoTo endsub
xy_sum = 0
xx_sum = 0
y_sum = 0
x_sum = 0
RawDataSize = UBound(PECCap.CapureData)
For i = 0 To PECCap.idx - 1
xy_sum = xy_sum + (i * PECCap.CapureData(i).pe)
x_sum = x_sum + i
y_sum = y_sum + PECCap.CapureData(i).pe
xx_sum = xx_sum + (i * i)
Next i
' Calculate slope of linear regression line
slope = ((RawDataSize * xy_sum) - (x_sum * y_sum)) / ((RawDataSize * xx_sum) - (x_sum * x_sum))
' Calculate intercept of linear regression line
intercept = (y_sum - (slope * x_sum)) / RawDataSize
' initalise fft
Call FFT_Initialise(4096, 1)
' remove slope from data and store in fft time domain
For i = 0 To RawDataSize - 1
tmp = PECCap.CapureData(i).pe - (slope * i) - intercept
' PECCap.CapureData(i).pe = tmp
' add to time domain
Call FFT_SetSample(CInt(i), tmp)
Next i
' generate frequency domain
Call FFT_ForwardFFTComplex
Call FFT_NormaliseMag
' filter out anything with a relative magnitude of 10% or less, and anything with a period < 33 sec or period > 1.5*worm period
' Call FFT_ApplyFilter(0.03, 1 / (2 * PECCap.Period), 10)
Call FFT_ApplyFilter(1 / CDbl(gPEC_filter_lowpass), 1 / (1.5 * PECCap.Period), CDbl(gPEC_mag))
' generate new time domain
FFT_InverseFFTComplex
If gPEC_Debug = 1 Then
' create a capture file for debug
PECCap.FileName = gPEC_FileDir & "PECCapture_" & GetTimeStamp & ".txt"
NF1 = FreeFile
Close #NF1
Open PECCap.FileName For Output As NF1
Print #NF1, "# " & HC.MainLabel.Caption
Print #NF1, "!WormPeriod=" & CStr(PECCap.Period)
Print #NF1, "!StepsPerWorm=" & CStr(PECCap.Steps)
Print #NF1, "# RA = " & CStr(gRA)
Print #NF1, "# DEC = " & CStr(gDec)
If gAscomCompatibility.AllowPulseGuide Then
Print #NF1, "# PulseGuide, Rate=" & CStr(HC.HScrollRARate.Value * 0.1)
Else
Print #NF1, "# ST-4 Guide, Rate=" & HC.RAGuideRateList.Text
End If
Print #NF1, "#Idx Time DeltaTime MotorPos DeltaPos Rate DeltaPE RawPE SmothedPE"
End If
' store as smoothed capture data.
For i = 0 To RawDataSize - 1
With PECCap.CapureData(i)
.peSmoothed = FFT_GetSample(CInt(i))
If gPEC_Debug = 1 Then
Print #NF1, FormatNumber(i, 0, , , 0) & " " & FormatNumber(.time, 3, , , 0) & " " & FormatNumber(.DeltaTime, 3, , , 0) & " " & CStr(.MotorPos) & " " & CStr(.DeltaPos) & " " & FormatNumber(.rate, 4, , , 0) & " " & FormatNumber(.peInc, 4, , , 0) & " " & FormatNumber(.pe, 4, , , 0) & " " & FormatNumber(.peSmoothed, 4, , , 0)
End If
End With
Next i
Close #NF1
FFT_Free
endsub:
End Sub
Private Function GetTimeStamp() As String
GetTimeStamp = Date$ & time$
GetTimeStamp = Replace(GetTimeStamp, ":", "")
GetTimeStamp = Replace(GetTimeStamp, "\", "")
GetTimeStamp = Replace(GetTimeStamp, "/", "")
GetTimeStamp = Replace(GetTimeStamp, " ", "")
GetTimeStamp = Replace(GetTimeStamp, "-", "")
End Function
Public Sub PEC_DispalyUpdate(ByRef plot As PictureBox)
plot.Cls
plot.FontSize = 8
plot.Print oLangDll.GetLangString(191) & " = " & CStr(gPEC_Gain)
plot.FontSize = 12
plot.Print PlaybackTimer.strPlayback
plot.Print CaptureTimer.strCapture
End Sub
' at 4121 Done code part. Lines - 1 Analysing filedlg.frm Done form part, 8 controls found Done code part. Lines - 283 Analysing launchapp.basError parsing line 'Attribute VB_Name = "LaunchApp"
Option Explicit
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
x As Long
Y As Long
End Type
Public Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_RESTORE = 9
Private Const GW_HWNDNEXT As Integer = 2
Private Const SW_NORMAL As Integer = 1
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Integer) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Integer
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Integer) As Integer
' Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
' Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Function GetFirstWindowHandle(ByVal sStartingWith As String) As Long
Dim hwnd As Long
Dim sWindowName As String
Dim iHandle As Long
hwnd = GetTopWindow(GetDesktopWindow())
Do While hwnd <> 0
sWindowName = zGetWindowName(hwnd)
If InStr(1, sWindowName, sStartingWith) = 1 Then
iHandle = hwnd
Exit Do
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
GetFirstWindowHandle = iHandle
End Function
Private Function zGetWindowName(ByVal hwnd As Long) As String
Dim nBufferLength As Integer
Dim nTextLength As Integer
Dim sName As String
sName = String(100, Chr$(0))
' nBufferLength = GetWindowTextLength(hwnd) + 4
' sName = Space(nBufferLength + 1)
nTextLength = GetWindowText(hwnd, sName, 100)
sName = Left(sName, nTextLength)
zGetWindowName = sName
End Function
Public Sub LaunchUtilityApp(Index As Integer)
Dim tmptxt As String
Dim nofile As Boolean
Dim THandle As Long
Dim processId As Long
Dim iret As Long
Dim inistr As String
Dim strwnd As String
Dim clientini As String
Dim found As Boolean
Dim pos As Integer
Dim lState As Long
Dim lpwndpl As WINDOWPLACEMENT
On Error GoTo launcherr:
Select Case Index
Case 0
inistr = "TOUR_EXE"
clientini = Environ("APPDATA") & "\EQMOD\EQTOUR.ini"
Case 1
inistr = "MOSAIC_EXE"
clientini = Environ("APPDATA") & "\EQMOD\EQMOSAIC.ini"
End Select
nofile = False
' get application path
tmptxt = HC.oPersist.ReadIniValue(inistr)
If tmptxt = "" Then
nofile = True
Else
If dir(tmptxt) = "" Then
nofile = True
End If
End If
' no application path set so let user assign one
If nofile Then
Call SetUtilityApp(Index)
tmptxt = HC.oPersist.ReadIniValue(inistr)
If tmptxt = "" Then
Exit Sub
Else
If dir(tmptxt) = "" Then
Exit Sub
End If
End If
End If
pos = InStrRev(tmptxt, "\")
strwnd = Right(tmptxt, Len(tmptxt) - pos)
strwnd = Left(strwnd, Len(strwnd) - 4)
Select Case strwnd
Case "EQTOUR"
strwnd = "EQTOUR V"
Case "EQMOSAIC"
strwnd = "EQMOSAIC V"
Case "TonightSky"
strwnd = "Tonight Sky"
End Select
' set tour or mosaic to connect to this driver.
Call HC.oPersist.WriteIniValueEx("ASCOM_ID", ASCOM_id, "[default]", clientini)
found = False
THandle = GetFirstWindowHandle(strwnd)
' THandle = FindWindow(vbNullString, strwnd)
If THandle <> 0 Then
' found a window bit is a the main window?
' If GetParent(THandle) = 0 Then
RestoreWindow THandle
found = True
' End If
End If
If Not found Then
' open application
processId = Shell(tmptxt, vbNormalFocus)
If processId <> 0 Then
' bring it to the top
' THandle = FindWindow(vbEmpty, strwnd)
THandle = GetFirstWindowHandle(strwnd)
If THandle <> 0 Then
iret = BringWindowToTop(THandle)
End If
End If
End If
Exit Sub
launcherr:
' been an error of some sort! - remove infile entry
Call HC.oPersist.WriteIniValue(inistr, "")
endlaunch:
End Sub
Public Sub SetUtilityApp(Index As Integer)
Dim tmptxt As String
Dim nofile As Boolean
Dim THandle As Long
Dim processId As Long
Dim iret As Long
Dim inistr As String
Dim strfilter As String
On Error GoTo Seterr:
Select Case Index
Case 0
inistr = "TOUR_EXE"
strfilter = "eqtour.exe;tonightsky.exe"
Case 1
inistr = "MOSAIC_EXE"
strfilter = "eqmosaic.exe"
End Select
filedlgcls.filter = strfilter
filedlgcls.Show (1)
tmptxt = filedlgcls.FileName
If tmptxt <> "" Then
If dir(tmptxt) <> "" Then
Call HC.oPersist.WriteIniValue(inistr, tmptxt)
End If
End If
GoTo endset
Seterr:
' been an error of some sort! - remove infile entry
Call HC.oPersist.WriteIniValue(inistr, "")
endset:
End Sub
Private Sub RestoreWindow(hWndCtlApp As Long)
Dim currWinP As WINDOWPLACEMENT
'prepare the WINDOWPLACEMENT type
currWinP.Length = Len(currWinP)
If GetWindowPlacement(hWndCtlApp, currWinP) > 0 Then
'determine the window state
If currWinP.showCmd = SW_SHOWMINIMIZED Then
'minimized, so restore
currWinP.Length = Len(currWinP)
currWinP.flags = 0&
currWinP.showCmd = SW_SHOWNORMAL
Call SetWindowPlacement(hWndCtlApp, currWinP)
Else
'on screen, so assure visible
Call SetForegroundWindow(hWndCtlApp)
Call BringWindowToTop(hWndCtlApp)
End If
End If
End Sub
' at 6028 Done code part. Lines - 1 Analysing nstar_polar.basError parsing line 'Attribute VB_Name = "Nstar_Polar"
'---------------------------------------------------------------------
' Copyright © 2007 Raymund Sarmiento
'
' Permission is hereby granted to use this Software for any purpose
' including combining with commercial products, creating derivative
' works, and redistribution of source or binary code, without
' limitation or consideration. Any redistributed copies of this
' Software must include the above Copyright Notice.
'
' THIS SOFTWARE IS PROVIDED "AS IS". THE AUTHOR OF THIS CODE MAKES NO
' WARRANTIES REGARDING THIS SOFTWARE, EXPRESS OR IMPLIED, AS TO ITS
' SUITABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
'---------------------------------------------------------------------
'
' Nstar_polar.bas - Polar Alignment using the N-star table
'
'
' Written: 07-Oct-06 Raymund Sarmiento
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 21-Dec-07 rcs Initial edit for EQ Mount Driver Function Prototype
'---------------------------------------------------------------------
'
'
' SYNOPSIS:
'
' This is a demonstration of a EQ6/ATLAS/EQG direct stepper motor control access
' using the EQCONTRL.DLL driver code.
'
' File EQCONTROL.bas contains all the function prototypes of all subroutines
' encoded in the EQCONTRL.dll
'
' The EQ6CONTRL.DLL simplifies execution of the Mount controller board stepper
' commands.
'
' The mount circuitry needs to be modified for this test program to work.
' Circuit details can be found at http://www.freewebs.com/eq6mod/
'
' DISCLAIMER:
' You can use the information on this site COMPLETELY AT YOUR OWN RISK.
' The modification steps and other information on this site is provided
' to you "AS IS" and WITHOUT WARRANTY OF ANY KIND, express, statutory,
' implied or otherwise, including without limitation any warranty of
' merchantability or fitness for any particular or intended purpose.
' In no event the author will be liable for any direct, indirect,
' punitive, special, incidental or consequential damages or loss of any
' kind whether or not the author has been advised of the possibility
' of such loss.
' WARNING:
' Circuit modifications implemented on your setup could invalidate
' any warranty that you may have with your product. Use this
' information at your own risk. The modifications involve direct
' access to the stepper motor controls of your mount. Any "mis-control"
' or "mis-command" / "invalid parameter" or "garbage" data sent to the
' mount could accidentally activate the stepper motors and allow it to
' rotate "freely" damaging any equipment connected to your mount.
' It is also possible that any garbage or invalid data sent to the mount
' could cause its firmware to generate mis-steps pulse sequences to the
' motors causing it to overheat. Make sure that you perform the
' modifications and testing while there is no physical "load" or
' dangling wires on your mount. Be sure to disconnect the power once
' this event happens or if you notice any unusual sound coming from
' the motor assembly.
'
' CREDITS:
'
' Portions of the information on this code should be attributed
' to Mr. John Archbold from his initial observations and analysis
' of the interface circuits and of the ASCII data stream between
' the Hand Controller (HC) and the Go To Controller.
'
Option Explicit
Public Function EQGet_Polar_Offset(RA As Double, DEC As Double, radius As Double, raprobe As Double, pscale As Double) As Double
Dim i As Integer
Dim tmpcoord1 As Coord
Dim tmpcoord2 As Coord
Dim dy1 As Double
Dim dy2 As Double
Dim dx As Double
' Must perform the usual Update Affine here
' Transform using the Negative RA boundary
i = EQ_UpdateAffine_PolarDrift(RA - raprobe, DEC)
tmpcoord1.x = RA - raprobe
tmpcoord1.Y = DEC
tmpcoord1 = EQ_plAffine2(tmpcoord1)
' Transform using the Positive RA Boundary
i = EQ_UpdateAffine_PolarDrift(RA + raprobe, DEC)
tmpcoord2.x = RA + raprobe
tmpcoord2.Y = DEC
tmpcoord2 = EQ_plAffine2(tmpcoord2)
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(tmpcoord1).x, pscale), pxlate_y(EQ_pl2Cs(tmpcoord1).Y, pscale))-(pxlate_x(EQ_pl2Cs(tmpcoord2).x, pscale), pxlate_y(EQ_pl2Cs(tmpcoord2).Y, pscale)), vbRed
' Get the drift points
dy1 = DEC - tmpcoord1.Y
dy2 = DEC - tmpcoord2.Y
' Coompute for the run data for slope computations
dx = raprobe * Sin(360 * (radius / gTot_step) * DEG_RAD) * 2
If dx = 0 Then dx = 0.00000001
' Get the Perpendicular offset error
EQGet_Polar_Offset = Tan(Atn((dy2 - dy1) / dx)) * Abs(radius)
End Function
' Function to Normalize the Virtual Horizon Measurement data
Public Function EQNormalize_Polar(Alt As Double, Az As Double, vhoriz As Double) As Coord
Dim crt As CartesCoord
Dim crt2 As CartesCoord
' Transform Alt/Az data based on the horiz value
' 90 degrees from the virtual horizon
crt = EQ_Polar2Cartes(vhoriz + (gTot_step / 4), Alt, gTot_step, 0, 0)
' 180 degrees from the virtual horizon
crt2 = EQ_Polar2Cartes(vhoriz + (gTot_step / 2), Az, gTot_step, 0, 0)
' Return the normalized data
EQNormalize_Polar.x = (crt.x + crt2.x) * -1
EQNormalize_Polar.Y = crt.Y + crt2.Y
End Function
'Function to convert polar coordinates to Cartesian using the Coord structure (for Polar Alignment function)
Public Function EQ_pl2Cs_Polar(ByRef obj As Coord, poffset As Double) As Coord
Dim tmpobj As CartesCoord
tmpobj = EQ_Polar2Cartes(obj.x, obj.Y - poffset, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
EQ_pl2Cs_Polar.x = tmpobj.x
EQ_pl2Cs_Polar.Y = tmpobj.Y
EQ_pl2Cs_Polar.z = 1
End Function
Public Function EQ_UpdateAffine_PolarDrift(x As Double, Y As Double) As Integer
Dim tmpcoord As Coord
Dim i As Long
Dim j As Long
Dim k As Long
Dim datholder(1 To MAX_STARS) As Double
Dim dotidholder(1 To MAX_STARS) As Double
' Adjust only if there are four alignment stars
If gAlignmentStars_count < 3 Then Exit Function
tmpcoord.x = x
tmpcoord.Y = Y
tmpcoord = EQ_sp2Cs(tmpcoord)
For i = 1 To gAlignmentStars_count
' Compute for total X-Y distance.
datholder(i) = Abs(my_PointsC(i).x - tmpcoord.x) + Abs(my_PointsC(i).Y - tmpcoord.Y)
' Also save the reference star id for this particular reference star
dotidholder(i) = i
Next i
Call EQ_Quicksort(datholder(), dotidholder(), 1, gAlignmentStars_count)
' Get the nearest Star (lowest at the head of the sorted list)
i = dotidholder(1)
j = dotidholder(2)
k = dotidholder(3)
EQ_UpdateAffine_PolarDrift = EQ_AssembleMatrix_Affine(tmpcoord.x, tmpcoord.Y, ct_PointsC(i), ct_PointsC(j), ct_PointsC(k), my_PointsC(i), my_PointsC(j), my_PointsC(k))
End Function
'Implement an Affine transformation on a Polar coordinate system
'This is done by converting the Polar Data to Cartesian, Apply affine transformation
'then return the transformed coordinates
Public Function EQ_plAffineCartes(ByRef obj As Coord) As Coord
Dim tmpobj1 As CartesCoord
Dim tmpobj2 As Coord
Dim tmpobj3 As Coord
tmpobj1 = EQ_Polar2Cartes(obj.x, obj.Y, gTot_step, RAEncoder_Home_pos, gDECEncoder_Home_pos)
tmpobj2.x = tmpobj1.x
tmpobj2.Y = tmpobj1.Y
tmpobj2.z = 1
tmpobj3 = EQ_Transform_Affine(tmpobj2)
EQ_plAffineCartes.x = tmpobj3.x
EQ_plAffineCartes.Y = tmpobj3.Y
EQ_plAffineCartes.z = 1
End Function
Public Sub PolarAlign_init(stepcount As Integer)
Dim i As Integer
HC.polarplot.DrawMode = 13
HC.polarplot.Cls
If stepcount > 50 Then
For i = 0 To HC.polarplot.width Step stepcount
HC.polarplot.Circle (HC.polarplot.width / 2, HC.polarplot.Height / 2), i, vbBlue
Next i
End If
HC.polarplot.Line (0, HC.polarplot.Height / 2)-(HC.polarplot.width, HC.polarplot.Height / 2), vbRed
HC.polarplot.Line (HC.polarplot.width / 2, 0)-(HC.polarplot.width / 2, HC.polarplot.Height), vbRed
End Sub
Public Sub Plot_PolarAlign(RA As Double, DEC As Double, pscale As Double)
' 0.0024 = 0.144 / 60 that is .0024 arcminute / microsteps
HC.polarplot.Circle ((HC.polarplot.width / 2) + ((RA * 0.0024) * pscale), (HC.polarplot.Height / 2) - ((DEC * 0.0024) * pscale)), 50, vbYellow
HC.polarplot.Line (HC.polarplot.width / 2, HC.polarplot.Height / 2)-((HC.polarplot.width / 2) + ((RA * 0.0024) * pscale), (HC.polarplot.Height / 2) - ((DEC * 0.0024) * pscale)), vbYellow
End Sub
Public Sub NStar_Polar_plot_init(stepcount As Integer)
Dim i As Integer
HC.polarplot.DrawMode = 13
HC.polarplot.Cls
HC.polarplot.Line (gXshift, gYshift + (HC.polarplot.Height * 3 / 4))-(gXshift + HC.polarplot.width, gYshift + (HC.polarplot.Height * 3 / 4)), vbRed
HC.polarplot.Line (gXshift + (HC.polarplot.width / 2), gYshift)-(gXshift + (HC.polarplot.width / 2), gYshift + HC.polarplot.Height), vbRed
End Sub
Function pxlate_x(inpx As Double, pscale As Double) As Double
pxlate_x = (HC.polarplot.width / 2) - (inpx * pscale / (gTot_step / 2)) + gXshift
End Function
Function pxlate_y(inpy As Double, pscale As Double) As Double
pxlate_y = (HC.polarplot.Height * 3 / 4) + (inpy * pscale / (gTot_step / 2)) + gYshift
End Function
Public Sub NStar_Polar_plot(RA1 As Double, DEC1 As Double, RA2 As Double, DEC2 As Double, pscale As Double)
Dim i As Double
Dim j As Double
Dim k As Double
Dim raprobe As Double
Dim tmpobj As Coord
Dim tmpobj2 As Coord
Dim datholder(1 To MAX_STARS) As Double
Dim dotidholder(1 To MAX_STARS) As Double
If (gThreeStarEnable = False) Then
Exit Sub
End If
raprobe = HC.HScroll4.Value
raprobe = raprobe * 100
tmpobj.x = RA1
tmpobj.Y = DEC1
HC.polarplot.Circle (pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale)), 30, vbYellow
HC.polarplot.Line (pxlate_x(0, pscale), pxlate_y(0, pscale))-(pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale)), vbYellow
tmpobj.x = RA1 - raprobe
tmpobj2.x = RA1 + raprobe
tmpobj2.Y = DEC1
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale))-(pxlate_x(EQ_pl2Cs(tmpobj2).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj2).Y, pscale)), vbBlue
tmpobj.x = RA2
tmpobj.Y = DEC2
HC.polarplot.Circle (pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale)), 30, vbGreen
HC.polarplot.Line (pxlate_x(0, pscale), pxlate_y(0, pscale))-(pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale)), vbGreen
tmpobj.x = RA2 - raprobe
tmpobj2.x = RA2 + raprobe
tmpobj2.Y = DEC2
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(tmpobj).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj).Y, pscale))-(pxlate_x(EQ_pl2Cs(tmpobj2).x, pscale), pxlate_y(EQ_pl2Cs(tmpobj2).Y, pscale)), vbBlue
tmpobj.x = RA1
tmpobj.Y = DEC1
For i = 1 To gAlignmentStars_count
HC.polarplot.Circle (pxlate_x(EQ_pl2Cs(ct_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(i)).Y, pscale)), 30, vbCyan
' Compute for total X-Y distance.
datholder(i) = Abs(my_PointsC(i).x - EQ_sp2Cs(tmpobj).x) + Abs(my_PointsC(i).Y - EQ_sp2Cs(tmpobj).Y)
' Also save the reference star id for this particular reference star
dotidholder(i) = i
Next i
Call EQ_Quicksort(datholder(), dotidholder(), 1, gAlignmentStars_count)
' Get the nearest Star (lowest at the head of the sorted list)
i = dotidholder(1)
j = dotidholder(2)
k = dotidholder(3)
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(j)).Y, pscale)), vbYellow
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(j)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(k)).Y, pscale)), vbYellow
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(k)).Y, pscale)), vbYellow
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(j)).Y, pscale)), vbBlue
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(j)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(k)).Y, pscale)), vbBlue
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(k)).Y, pscale)), vbBlue
tmpobj.x = RA2
tmpobj.Y = DEC2
For i = 1 To gAlignmentStars_count
' Compute for total X-Y distance.
datholder(i) = Abs(my_PointsC(i).x - EQ_sp2Cs(tmpobj).x) + Abs(my_PointsC(i).Y - EQ_sp2Cs(tmpobj).Y)
' Also save the reference star id for this particular reference star
dotidholder(i) = i
Next i
Call EQ_Quicksort(datholder(), dotidholder(), 1, gAlignmentStars_count)
' Get the nearest Star (lowest at the head of the sorted list)
i = dotidholder(1)
j = dotidholder(2)
k = dotidholder(3)
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(j)).Y, pscale)), vbGreen
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(j)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(k)).Y, pscale)), vbGreen
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(my_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(my_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(my_Points(k)).Y, pscale)), vbGreen
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(j)).Y, pscale)), vbBlue
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(j)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(j)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(k)).Y, pscale)), vbBlue
HC.polarplot.Line (pxlate_x(EQ_pl2Cs(ct_Points(i)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(i)).Y, pscale))-(pxlate_x(EQ_pl2Cs(ct_Points(k)).x, pscale), pxlate_y(EQ_pl2Cs(ct_Points(k)).Y, pscale)), vbBlue
End Sub
Public Function PolarAlignDrift_Map(ByVal RA1 As Double, ByVal DEC1 As Double, ByVal RA2 As Double, ByVal DEC2 As Double, ByVal raprobe As Double, ByVal pscale As Double) As Coord
Dim obtmp2 As Coord
Dim dy1 As Double
Dim dy2 As Double
If (RA1 >= &H1000000) Or (DEC1 >= &H1000000) Or (gThreeStarEnable = False) Then
PolarAlignDrift_Map.x = 0
PolarAlignDrift_Map.Y = 0
PolarAlignDrift_Map.z = 0
Exit Function
End If
' re transform using the 3 nearest stars
HC.EncoderTimer.Enabled = False
dy1 = EQGet_Polar_Offset(RA1, DEC1, gDECEncoder_Home_pos - DEC1, raprobe, pscale)
dy2 = EQGet_Polar_Offset(RA2, DEC2, gDECEncoder_Home_pos - DEC1, raprobe, pscale)
HC.EncoderTimer.Enabled = True
obtmp2 = EQNormalize_Polar(dy1, dy2, RAEncoder_Home_pos - RA1)
PolarAlignDrift_Map.x = obtmp2.x
PolarAlignDrift_Map.Y = obtmp2.Y
PolarAlignDrift_Map.z = 1
End Function
Public Sub Position_polar(pscale As Double)
Dim vh As Double
Dim vy As Double
Dim RA1 As Double
Dim DEC1 As Double
Dim RA2 As Double
Dim DEC2 As Double
Dim obtmp As Coord
Dim raprobe As Double
If (gThreeStarEnable = False) Then
Exit Sub
End If
raprobe = HC.HScroll4.Value
raprobe = raprobe * 100
vh = HC.HScroll2.Value
vh = (vh / 360) * gTot_step
vy = 90 + HC.HScroll3.Value
vy = (vy / 360) * gTot_step
RA1 = RAEncoder_Home_pos + vh
DEC1 = gDECEncoder_Home_pos - vy
RA2 = RAEncoder_Home_pos + vh - (gTot_step / 4)
DEC2 = gDECEncoder_Home_pos + vy
NStar_Polar_plot_init (pscale)
Call NStar_Polar_plot(RA1, DEC1, RA2, DEC2, pscale)
obtmp = PolarAlignDrift_Map(RA1, DEC1, RA2, DEC2, raprobe, pscale)
' HC.Label62.Caption = Format(obtmp.x * 0.0024, "####0.0000000000") '.144 * 60
' HC.Label64.Caption = Format(obtmp.y * 0.0024, "####0.0000000000")
End Sub
' at 4129 Done code part. Lines - 1 Analysing ascomtrace.frm Done form part, 14 controls found Done code part. Lines - 353 Analysing limits.basError parsing line 'Attribute VB_Name = "Limits"
Option Explicit
Public Type LIMIT
Alt As Double
Az As Double
ha As Double
DEC As Double
End Type
Public Type TLIMIT_STATUS
LimitDetected As Boolean
AtLimit As Boolean
Horizon As Boolean
RA As Boolean
End Type
Public LimitStatus As TLIMIT_STATUS
Public LimitArray() As LIMIT ' used for file I/O
Public LimitArray2(360) As LIMIT ' constructed from LimitArray to allow speedy indexing by azimuth.
Public gHorizonAlgorithm As Integer
Public gLimitSlews As Integer
Public gLimitPark As Integer
Public gAutoFlipAllowed As Boolean
Public gAutoFlipEnabled As Boolean
Public gSupressHorizonLimits As Boolean
Private AutoFlipState As Integer
Public Sub Limits_Init()
Dim str As String
LimitStatus.Horizon = False
LimitStatus.RA = False
LimitStatus.LimitDetected = False
gSupressHorizonLimits = False
ReDim LimitArray(0)
Call Limits_BuildLimitDef
str = HC.oPersist.ReadIniValue("LIMIT_ENABLE")
If str <> "" Then
HC.ChkEnableLimits.Value = val(str)
Else
HC.ChkEnableLimits.Value = 1
End If
str = HC.oPersist.ReadIniValue("LIMIT_FILE")
If str <> "" Then
' got a file to load
Limits_ReadFile str
Else
' no file assined - set defaults?
End If
str = HC.oPersist.ReadIniValue("LIMIT_HORIZON_ALGORITHM")
If str <> "" Then
gHorizonAlgorithm = val(str)
Else
' default to interpolated
gHorizonAlgorithm = 0
Call HC.oPersist.WriteIniValue("LIMIT_HORIZON_ALGORITHM", "0")
End If
str = HC.oPersist.ReadIniValue("LIMIT_PARK")
If str <> "" Then
gLimitPark = val(str)
Else
' default to interpolated
gLimitPark = 0
Call HC.oPersist.WriteIniValue("LIMIT_PARK", "0")
End If
str = HC.oPersist.ReadIniValue("LIMIT_SLEWS")
If str <> "" Then
gLimitSlews = val(str)
Else
' default to interpolated
gLimitSlews = 1
Call HC.oPersist.WriteIniValue("LIMIT_SLEWS", "1")
End If
Call readAutoFlipData
AutoFlipState = 0
End Sub
Public Sub Limits_Load()
filedlgcls.filter = "*.txt"
filedlgcls.Show (1)
Limits_ReadFile filedlgcls.FileName
Call HC.oPersist.WriteIniValue("LIMIT_FILE", filedlgcls.FileName)
End Sub
Public Sub Limits_ReadFile(FileName As String)
Dim i As Integer
Dim size, pos, redimcount As Integer
Dim temp1, temp2 As String
Dim ha, DEC As Double
ReDim LimitArray(0)
On Error GoTo fileerr
If FileName <> "" Then
Close #1
Open FileName For Input As #1
ReDim LimitArray(100)
size = 0
redimcount = 0
While Not EOF(1)
Line Input #1, temp1
temp2 = Left$(temp1, 1)
If temp2 <> "#" And temp2 <> " " Then
pos = InStr(temp1, " ")
If pos <> 0 Then
temp2 = Left$(temp1, pos - 1)
temp1 = Right$(temp1, Len(temp1) - pos)
With LimitArray(size)
.Az = CDbl(temp2)
.Alt = CDbl(temp1)
aa_hadec gLatitude * DEG_RAD, .Alt * DEG_RAD, .Az * DEG_RAD, ha, DEC
.ha = Range24(ha * RAD_HRS)
.DEC = DEC * RAD_DEG
End With
size = size + 1
redimcount = redimcount + 1
If redimcount > 90 Then
redimcount = 0
ReDim Preserve LimitArray(size + 100)
End If
End If
End If
Wend
ReDim Preserve LimitArray(size)
End If
Call Limits_BuildLimitDef
GoTo endsub
fileerr:
HC.Add_Message ("Error reading limits file")
endsub:
Close #1
End Sub
Public Sub Limits_Save()
Dim i As Integer
Dim size As Integer
Dim FileName As String
On Error GoTo fileerr
size = UBound(LimitArray)
filedlgcls.filter = "*.txt"
filedlgcls.Show (1)
FileName = filedlgcls.FileName
If filedlgcls.FileName <> "" Then
' force a .txt extension
i = InStr(FileName, ".")
If i <> 0 Then
FileName = Left$(FileName, i - 1)
End If
FileName = FileName & ".txt"
Close #1
Open FileName For Output As #1
For i = 0 To size - 1
Print #1, CStr(CInt(LimitArray(i).Az)) & " " & CStr(LimitArray(i).Alt)
Next i
Close #1
End If
GoTo endsub
fileerr:
HC.Add_Message ("Error writing limits file")
endsub:
End Sub
Public Sub Limits_Add(ByRef lim As LIMIT)
Dim size, i, j As Integer
On Error GoTo endsub
size = UBound(LimitArray)
lim.Az = CInt(lim.Az)
i = 0
While i < size
If LimitArray(i).Az > lim.Az Then
GoTo insert
Else
If LimitArray(i).Az = lim.Az Then
LimitArray(i).Alt = lim.Alt
GoTo endsub
End If
End If
i = i + 1
Wend
GoTo Store
insert:
For j = size To i + 1 Step -1
LimitArray(j) = LimitArray(j - 1)
Next j
Store:
LimitArray(i) = lim
ReDim Preserve LimitArray(size + 1)
Call Limits_BuildLimitDef
endsub:
End Sub
Public Sub Limits_DeleteIdx(idx As Integer)
Dim i, size As Integer
On Error GoTo endsub
If idx >= 0 Then
size = UBound(LimitArray)
For i = idx To size - 2
LimitArray(i).Alt = LimitArray(i + 1).Alt
LimitArray(i).Az = LimitArray(i + 1).Az
Next i
ReDim Preserve LimitArray(size - 1)
Call Limits_BuildLimitDef
End If
endsub:
End Sub
Public Sub Limits_Execute()
Dim i As Integer
Dim size As Integer
Dim a, b As Integer
Dim Alt As Double
Dim dalt, daz As Double
LimitStatus.Horizon = False
LimitStatus.RA = False
LimitStatus.LimitDetected = False
If HC.ChkEnableLimits.Value = 1 Then
If gEQparkstatus = 0 Then
If (gSlewStatus = True And gLimitSlews = 1) Or (gSlewStatus = False And gTrackingStatus > 0) Then
LimitStatus = Limits_Detect()
If Limits_Detect.LimitDetected Then
LimitStatus.AtLimit = True
Call emergency_stop
HC.Add_Message (oLangDll.GetLangString(5017))
If gLimitPark Then
' park using currently selected park mode.
Call HC.ApplyParkMode
End If
Else
LimitStatus.AtLimit = False
End If
Else
If LimitStatus.AtLimit Then
' Currently in the limit state so look for clear.
LimitStatus = Limits_Detect()
LimitStatus.AtLimit = Limits_Detect.LimitDetected
End If
End If
Else
'If unparking, parking or parked, limits don't apply
LimitStatus.AtLimit = False
End If
Else
'limits not enabled so we can't be at the limit can we!
LimitStatus.AtLimit = False
End If
End Sub
Private Function Limits_Detect() As TLIMIT_STATUS
Dim Alt As Double
Dim LimitDetected As Boolean
Limits_Detect.LimitDetected = False
Limits_Detect.Horizon = False
Limits_Detect.RA = False
' Routine to handle RA LIMIT processing
If (gRA_Limit_East <> 0) And (gEmulRA < gRAEncoder_Zero_pos) Then
If (gEmulRA < gRA_Limit_East) Then
If gAutoFlipEnabled Then
Select Case AutoFlipState
Case 0
'we've hit the RA limit so initiate autoflip!
gTargetRA = gRA
gTargetDec = gDec
HC.Add_Message ("CoordSlew: " & oLangDll.GetLangString(105) & "[ " & FmtSexa(gTargetRA, False) & " ] " & oLangDll.GetLangString(106) & "[ " & FmtSexa(gTargetDec, True) & " ]")
gSlewCount = gMaxSlewCount 'NUM_SLEW_RETRIES 'Set initial iterative slew count
Call EQ_Beep(2)
Call radecAsyncSlew(gGotoRate)
AutoFlipState = 1
Case Else
End Select
Else
Limits_Detect.RA = True
End If
GoTo endsub
Else
AutoFlipState = 0
End If
End If
If (gRA_Limit_West <> 0) And (gEmulRA > gRAEncoder_Zero_pos) Then
If (gEmulRA > gRA_Limit_West) Then
If gAutoFlipEnabled Then
Select Case AutoFlipState
Case 0
'we've hit the RA limit so initiate autoflip!
gTargetRA = gRA
gTargetDec = gDec
HC.Add_Message ("CoordSlew: " & oLangDll.GetLangString(105) & "[ " & FmtSexa(gTargetRA, False) & " ] " & oLangDll.GetLangString(106) & "[ " & FmtSexa(gTargetDec, True) & " ]")
gSlewCount = gMaxSlewCount 'NUM_SLEW_RETRIES 'Set initial iterative slew count
Call EQ_Beep(2)
Call radecAsyncSlew(gGotoRate)
AutoFlipState = 1
Case Else
End Select
Else
Limits_Detect.RA = True
End If
GoTo endsub
Else
AutoFlipState = 0
End If
End If
endsub:
' get altitude limit for current azimuth
If gSupressHorizonLimits = False Then
If gAlt <= LimitArray2(CInt(gAz)).Alt Then
Limits_Detect.Horizon = True
End If
Else
Limits_Detect.Horizon = False
End If
If Limits_Detect.Horizon = True Or Limits_Detect.RA = True Then
Limits_Detect.LimitDetected = True
Else
Limits_Detect.LimitDetected = False
End If
End Function
Public Function Limits_GetAltLimit(Az As Double) As Double
Dim i As Integer
Dim size As Integer
Dim a, b As Integer
Dim dalt, daz As Double
' default to absolute horizon
Limits_GetAltLimit = 0
On Error GoTo endsub
size = UBound(LimitArray)
Select Case size
Case 0
Limits_GetAltLimit = 0
Case 1
Limits_GetAltLimit = LimitArray(0).Alt
Case Else
If size > 0 Then
' If size = 1 Then
' ' only one limit
' Limits_GetAltLimit = LimitArray(0).alt
' GoTo endsub
' End If
a = 0
For i = 0 To size - 1
If LimitArray(i).Az > Az Then
a = i
GoTo found
End If
Next i
found:
If a = 0 Then
b = size - 1
Else
b = a - 1
End If
Select Case gHorizonAlgorithm
Case 0
' interpolated between two points
dalt = LimitArray(a).Alt - LimitArray(b).Alt
If LimitArray(a).Az > LimitArray(b).Az Then
daz = LimitArray(a).Az - LimitArray(b).Az
Else
daz = (360 - LimitArray(b).Az) + LimitArray(a).Az
End If
If daz = 0 Then
' two points with the same azimuth so take the lowest altitude
If LimitArray(a).Alt > LimitArray(b).Alt Then
Limits_GetAltLimit = LimitArray(a).Alt
Else
Limits_GetAltLimit = LimitArray(b).Alt
End If
Else
If a = 0 Then
If Az < LimitArray(a).Az Then
Limits_GetAltLimit = LimitArray(b).Alt + (dalt / daz * (359 - LimitArray(b).Az + Az))
Else
Limits_GetAltLimit = LimitArray(b).Alt + (dalt / daz * (Az - LimitArray(b).Az))
End If
Else
Limits_GetAltLimit = LimitArray(b).Alt + ((Az - LimitArray(b).Az) * dalt / daz)
End If
End If
Case 1
' higher value of two points
If LimitArray(a).Alt > LimitArray(b).Alt Then
Limits_GetAltLimit = LimitArray(a).Alt
Else
Limits_GetAltLimit = LimitArray(b).Alt
End If
End Select
End If
End Select
endsub:
End Function
Public Sub Limits_Clear()
ReDim LimitArray(0)
Call Limits_BuildLimitDef
' remove reference to limits file
Call HC.oPersist.WriteIniValue("LIMIT_FILE", "")
End Sub
Public Sub Limits_edit()
LimitEditForm.Show (0)
End Sub
Public Sub Limits_BuildLimitDef()
Dim idx As Integer
Dim ha, DEC As Double
' Because of the amount of maths involved to determine current limits we
' maintain two arrays. LimitArray is a 'sparse' array used to file storage.
' From this we construct LimitArray2 which holds limits for every degree of azimuth.
' Limit and display code can therefore quickly access limits by using the current
' azimuth as an index into LimitArray(2)
For idx = 0 To 359
With LimitArray2(idx)
.Alt = Limits_GetAltLimit(CDbl(idx))
.Az = idx
aa_hadec gLatitude * DEG_RAD, .Alt * DEG_RAD, .Az * DEG_RAD, ha, DEC
.ha = Range24(ha * RAD_HRS)
.DEC = DEC * RAD_DEG
End With
Next idx
End Sub
Public Function Limits_TimeToHorizon() As Double
Dim i As Integer
Dim ha, tmp As Double
' Establish the time the scaope will take, at sidereal rate, to reach the horizon
' -1 indicates never reaches horizon
Limits_TimeToHorizon = -1
On Error GoTo endsub
If gHemisphere = 0 Then
' only consider western horizon (stars just don't set in the east!)
For i = 180 To 359
' search for the point where the horizon declination is greater or equal to our scope declination
ha = LimitArray2(i).ha
tmp = LimitArray2(i).DEC
If tmp >= gDec Then
' calulate difference between horizon hour angle and scope hour angle
tmp = ha - Range24(EQnow_lst(gLongitude * DEG_RAD) - gRA)
If tmp < 0 Then
tmp = 24 + tmp
End If
Limits_TimeToHorizon = tmp
GoTo endsub
End If
Next i
Else
' only consider western horizon (stars just don't set in the east!)
For i = 180 To 359
' search for the point where the horizon declination is greater or equal to our scope declination
ha = LimitArray2(i).ha
tmp = LimitArray2(i).DEC
If tmp >= gDec Then
' calulate difference between horizon hour angle and scope hour angle
tmp = ha - Range24(EQnow_lst(gLongitude * DEG_RAD) - gRA)
If tmp < 0 Then
tmp = 24 + tmp
End If
Limits_TimeToHorizon = tmp
GoTo endsub
End If
Next i
End If
endsub:
End Function
Public Function Limits_TimeToMeridian() As Double
Dim Steps As Double
Dim rate As Double
' Establish the time the scope will take, at sidereal rate, to reach the Meridian limit
' -1 indicates never reaches horizon
Limits_TimeToMeridian = -1
On Error GoTo endsub
If gHemisphere = 0 Then
If gRA_Limit_West <> 0 Then
If (gEmulRA < gRA_Limit_West) Then
Steps = gRA_Limit_West - gEmulRA
' sidereal rate as steps hour
rate = 3600 * gTot_RA / 86164.0905
Limits_TimeToMeridian = Steps / rate
End If
End If
Else
If gRA_Limit_East <> 0 Then
If (gEmulRA > gRA_Limit_East) Then
Steps = gEmulRA - gRA_Limit_East
' sidereal rate as steps hour
rate = 3600 * gTot_RA / 86164.0905
Limits_TimeToMeridian = Steps / rate
End If
End If
End If
endsub:
End Function
Public Sub SetRaLimitDefaults()
Dim tmp As Double
' make up some defaults
tmp = 90.88 * CDbl(gTot_step) / 360
gRA_Limit_East = gRAEncoder_Zero_pos - CLng(tmp) ' homepos - 90.88degrees of step
gRA_Limit_West = gRAEncoder_Zero_pos + CLng(tmp) ' homepos + 90.88degrees of step
End Sub
Public Sub writeRAlimit()
HC.oPersist.WriteIniValue "RA_LIMIT_EAST", CStr(gRA_Limit_East)
HC.oPersist.WriteIniValue "RA_LIMIT_WEST", CStr(gRA_Limit_West)
End Sub
Public Sub readRALimit()
Dim tmptxt As String
Dim i As Long
Call SetRaLimitDefaults
tmptxt = HC.oPersist.ReadIniValue("RA_LIMIT_EAST")
If tmptxt <> "" Then
gRA_Limit_East = val(tmptxt)
Else
Call HC.oPersist.WriteIniValue("RA_LIMIT_EAST", CStr(gRA_Limit_East))
End If
tmptxt = HC.oPersist.ReadIniValue("RA_LIMIT_WEST")
If tmptxt <> "" Then
gRA_Limit_West = val(tmptxt)
Else
Call HC.oPersist.WriteIniValue("RA_LIMIT_WEST", CStr(gRA_Limit_West))
End If
If gRA_Limit_West = gRA_Limit_East And gRA_Limit_West <> 0 Then
Call SetRaLimitDefaults
Call writeRAlimit
End If
End Sub
Public Function OutOfBounds(ByVal pos As Double) As Boolean
OutOfBounds = False
If HC.ChkEnableLimits.Value = 0 Then
' no limits
OutOfBounds = True
Exit Function
End If
' Routine to handle RA LIMIT processing
If (gRA_Limit_East <> 0) And (pos < gRAEncoder_Zero_pos) Then
If (pos < gRA_Limit_East) Then
OutOfBounds = True
Exit Function
End If
End If
If (gRA_Limit_West <> 0) And (pos > gRAEncoder_Zero_pos) Then
If (pos > gRA_Limit_West) Then
OutOfBounds = True
End If
End If
End Function
Public Function RALimitsActive() As Boolean
If HC.ChkEnableLimits.Value = 0 Then
RALimitsActive = False
Else
If gRA_Limit_West = 0 Or gRA_Limit_West = 0 Then
RALimitsActive = False
Else
RALimitsActive = True
End If
End If
End Function
' at 4440 Done code part. Lines - 1 Analysing limiteditform.frm Done form part, 41 controls found Done code part. Lines - 1094 Analysing polarfrm.frm Done form part, 11 controls found Done code part. Lines - 826 Analysing defineparkform.frm Done form part, 17 controls found Done code part. Lines - 483 Analysing soundsfrm.frm Done form part, 133 controls found Done code part. Lines - 2079 Analysing telescope.clsType 'IAxisRates' not found.Type 'PierSide' not found. Done code part. Lines - 3036 Analysing rates.cls Done code part. Lines - 135 Analysing trackingrates.cls Done code part. Lines - 128 Analysing rate.cls Done code part. Lines - 83 Analysing progressfrm.frm Done form part, 3 controls found Done code part. Lines - 80 Analysing gotodialog.frm Done form part, 19 controls found Done code part. Lines - 523 Analysing custommountdlg.frm Done form part, 19 controls found Done code part. Lines - 364 Analysing processpriority.bas Done code part. Lines - 1 Analysing updatecheck.basError parsing line 'Attribute VB_Name = "UpdateCheck"
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_FLAG_DONT_CACHE = &H4000000
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Const INTERNET_FLAG_RELOAD = &H80000000
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal lpszAgent As String, ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As _
Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As _
Long, ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public gUpdateFileUrl As String
Public gUpdateFullUrl As String
Public gUpdateTestUrl As String
Public gUpdateMode As Integer
Public gUpdateAvailable As Boolean
Public gStrUpdateVersion As String
Type VersionData
Major As Integer
Minor As Integer
alpha As Integer
End Type
Public Sub CheckForUpdate()
gUpdateAvailable = False
Call ReadUpdateParams
Select Case gUpdateMode
Case 0
Case 1, 2
If CopyURLToFile(gUpdateFileUrl, "versions.txt") = True Then
Call CheckUpdateFile
End If
End Select
End Sub
Public Sub ReadUpdateParams()
Dim tmptxt As String
gUpdateFileUrl = HC.oPersist.ReadIniValue("UpdateFileUrl")
If gUpdateFileUrl = "" Then
gUpdateFileUrl = "http://eq-mod.sourceforge.net/versions/versions.txt"
Call HC.oPersist.WriteIniValue("UpdateFileUrl", gUpdateFileUrl)
End If
gUpdateFullUrl = HC.oPersist.ReadIniValue("UpdateReleaseUrl")
If gUpdateFullUrl = "" Then
gUpdateFullUrl = "http://sourceforge.net/projects/eq-mod/files/"
Call HC.oPersist.WriteIniValue("UpdateReleaseUrl", gUpdateFullUrl)
End If
gUpdateTestUrl = HC.oPersist.ReadIniValue("UpdateTestUrl")
If gUpdateTestUrl = "" Then
gUpdateTestUrl = "http://tech.groups.yahoo.com/group/EQMOD/"
Call HC.oPersist.WriteIniValue("UpdateTestUrl", gUpdateTestUrl)
End If
tmptxt = HC.oPersist.ReadIniValue("UpdateMode")
Select Case tmptxt
Case "0", "1", "2"
gUpdateMode = val(tmptxt)
Case Else
gUpdateMode = 0
Call HC.oPersist.WriteIniValue("UpdateMode", "0")
End Select
End Sub
' Download a file from Internet and save it to a local file
'
' it works with HTTP and FTP, but you must explicitly include
' the protocol name in the URL, as in
' CopyURLToFile "http://www.vb2themax.com/default.asp", "C:\vb2themax.htm"
Public Function CopyURLToFile(ByVal URL As String, ByVal FileName As String) As Boolean
Dim hInternetSession As Long
Dim hUrl As Long
Dim FileNum As Integer
Dim ok As Boolean
Dim NumberOfBytesRead As Long
Dim Buffer As String
Dim fileIsOpen As Boolean
Dim error As Boolean
error = False
On Error GoTo errorhandler
' check obvious syntax errors
If Len(URL) = 0 Or Len(FileName) = 0 Then
error = True
Else
' open an Internet session, and retrieve its handle
hInternetSession = InternetOpen(App.EXEName, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hInternetSession = 0 Then
error = True
Else
' open the file and retrieve its handle
hUrl = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, INTERNET_FLAG_EXISTING_CONNECT + INTERNET_FLAG_RELOAD, 0)
If hUrl = 0 Then
error = True
Else
' ensure that there is no local file
On Error Resume Next
Kill FileName
On Error GoTo errorhandler
' open the local file
FileNum = FreeFile
Open FileName For Binary As FileNum
fileIsOpen = True
' prepare the receiving buffer
Buffer = Space(4096)
Do
' read a chunk of the file - returns True if no error
ok = InternetReadFile(hUrl, Buffer, Len(Buffer), NumberOfBytesRead)
' makes sure our lines have CRLF terminators
Buffer = Replace(Buffer, vbCr, "")
Buffer = Replace(Buffer, vbLf, vbCrLf)
' exit if error or no more data
If NumberOfBytesRead = 0 Or Not ok Then Exit Do
' save the data to the local file
Put #FileNum, , Left$(Buffer, NumberOfBytesRead + Len(Buffer) - 4096)
Loop
End If
End If
GoTo endfunc
End If
errorhandler:
On Error Resume Next
error = True
endfunc:
' close the local file, if necessary
Close #FileNum
' close internet handles, if necessary
If hUrl Then InternetCloseHandle hUrl
If hInternetSession Then InternetCloseHandle hInternetSession
CopyURLToFile = Not error
End Function
Private Sub CheckUpdateFile()
Dim FileNum As Integer
Dim tmp1 As String
Dim tmp2() As String
Dim tmp3 As String
Dim ver1 As VersionData
Dim ver2 As VersionData
On Error GoTo errhandler
ver1 = GetVersionData(gVersion)
' open the local file
FileNum = FreeFile
Close FileNum
Open "versions.txt" For Input As FileNum
While Not EOF(1)
Line Input #1, tmp1
If Left(tmp1, 1) <> "#" Then
tmp2 = Split(tmp1, " ")
If tmp2(0) = "EQASCOM" Then
Select Case gUpdateMode
Case 1
ver2 = GetVersionData(tmp2(1))
gUpdateAvailable = False
If ver2.Major > ver1.Major Then
gUpdateAvailable = True
Else
If ver2.Major = ver1.Major Then
If ver2.Minor > ver1.Minor Then
gUpdateAvailable = True
Else
If ver2.Minor = ver1.Minor Then
If ver2.alpha > ver1.alpha Then
gUpdateAvailable = True
End If
End If
End If
End If
End If
If gUpdateAvailable Then
gStrUpdateVersion = tmp2(1)
End If
Case 2
ver2 = GetVersionData(tmp2(2))
gUpdateAvailable = False
If ver2.Major > ver1.Major Then
gUpdateAvailable = True
Else
If ver2.Major = ver1.Major Then
If ver2.Minor > ver1.Minor Then
gUpdateAvailable = True
Else
If ver2.Minor = ver1.Minor Then
If ver2.alpha > ver1.alpha Then
gUpdateAvailable = True
End If
End If
End If
End If
End If
If gUpdateAvailable Then
gStrUpdateVersion = Replace(tmp2(2), vbLf, "")
End If
End Select
End If
End If
Wend
GoTo closefile
errhandler:
gUpdateAvailable = False
closefile:
Close FileNum
End Sub
Private Function GetVersionData(ByVal str As String) As VersionData
Dim ver As VersionData
Dim tmp() As String
str = Replace(str, vbLf, "")
ver.alpha = Asc(Right(str, 1))
' strip of the V and alpha
str = mid(str, 2, Len(str) - 2)
tmp = Split(str, ".")
ver.Major = val(tmp(0))
ver.Minor = val(tmp(1))
GetVersionData = ver
End Function
' Open the default browser on a given URL
' Returns True if successful, False otherwise
Public Function OpenBrowser(ByVal URL As String) As Boolean
Dim res As Long
res = ShellExecute(0&, "open", URL, vbNullString, vbNullString, vbNormalFocus)
OpenBrowser = (res > 32)
End Function
' at 7133 Done code part. Lines - 1 Analysing parking.basError parsing line 'Attribute VB_Name = "Parking"
Option Explicit
Public Type parkpos
name As String
posR As Long
posD As Long
End Type
Public gParkParams As GOTO_PARAMS
Public UserParks(10) As parkpos
Public UserUnparks(10) As parkpos
Public Sub ApplyUnParkMode2(mode As Integer)
' only ever allow unparks if mount is already parked
If gEQparkstatus = 1 Then
Select Case mode
Case 0
'Unpark
Call Unparkscope
Case 1
'Unpark and slew to last position
UnparkscopeToLastPos
Case Else
'Unpark and slew to user defined startup position
Call UnparkscopeToUserDef(UserUnparks(mode - 1))
End Select
End If
End Sub
Public Sub ApplyParkMode2(mode As Integer)
Select Case mode
Case 0
' Park to Home
Call ParkHome
Case 1
' Park to current
Call Park2Current
Case Else
'Park to defined
Call ParktoUserDefine2(UserParks(mode - 1))
End Select
End Sub
Private Function ParkInit() As Boolean
HC.ParkTimer.Enabled = False
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(50)
gEQparkstatus = 2
' Save Alignment if required
Call AligmentStarsPark
Call StopTrackingUpdates
' stop any active slews from completing
gSlewStatus = False
gRAStatus_slew = False
' clear an active flips
HC.ChkForceFlip.value = 0
gCWUP = False
gGotoParams.SuperSafeMode = 0
' stop the motors
eqres = EQ_MotorStop(2) ' Stop RA & DEC Motor
If eqres <> EQ_OK Then
ParkInit = False
Exit Function
End If
' ' stop the motors
' eqres = EQ_MotorStop(0) ' Stop RA Motor
' If eqres <> EQ_OK Then
' ParkInit = False
' Exit Function
' End If
' eqres = EQ_MotorStop(1) ' Stop DEC Motor
' If eqres <> EQ_OK Then
' ParkInit = False
' Exit Function
' End If
'
' 'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' ParkInit = False
' Exit Function
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
' 'Wait until DEC motor is stable
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' ParkInit = False
' Exit Function
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
' update tracking status
gTrackingStatus = 0
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
ParkInit = True
End Function
Public Sub ParkHome()
Dim currentdecpos As Double
Dim currentrapos As Double
' only allow parking if currently unparked
If gEQparkstatus = 0 Then
If ParkInit() = True Then
'Read Motor Values
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
gRAEncoderlastpos = currentrapos
gDECEncoderlastpos = currentdecpos
writelastpos ' Save current position
gRAEncoderUNPark = RAEncoder_Home_pos
gDECEncoderUNPark = gDECEncoder_Home_pos
Call writeUnpark
Call StartPark(currentrapos, RAEncoder_Home_pos, currentdecpos, gDECEncoder_Home_pos)
HC.Add_Message (oLangDll.GetLangString(5035))
HC.ParkTimer.Enabled = True
' No need to wait at this point - return control to main routine
Call EQ_Beep(5)
Call writeRAlimit
Call SetParkCaption
End If
End If
Endhome:
End Sub
' ascom park
Public Sub ParktoUserDefine()
Dim currentdecpos As Double
Dim currentrapos As Double
' only allow parking if currently unparked
If gEQparkstatus = 0 Then
If ParkInit() = True Then
'Read Motor Values
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
gRAEncoderlastpos = currentrapos
gDECEncoderlastpos = currentdecpos
Call writelastpos ' Save current position
Call readpark ' Read Userdefined Park data
gRAEncoderUNPark = gRAEncoderPark
gDECEncoderUNPark = gDECEncoderPark
Call writeUnpark ' Save Unpark Data
Call StartPark(currentrapos, CDbl(gRAEncoderPark), currentdecpos, CDbl(gDECEncoderPark))
HC.Add_Message oLangDll.GetLangString(5003)
HC.ParkTimer.Enabled = True
Call EQ_Beep(5)
Call writeRAlimit
Call SetParkCaption
End If
End If
Endparkuser:
End Sub
Public Sub ParktoUserDefine2(userpark As parkpos)
Dim currentdecpos As Double
Dim currentrapos As Double
' only allow parking if currently unparked
If gEQparkstatus = 0 Then
' don't park if user position is undefined!
If userpark.posD = 0 Or userpark.posR = 0 Then GoTo Endparkuser2
If ParkInit() = True Then
'Read Motor Values
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
gRAEncoderlastpos = currentrapos
gDECEncoderlastpos = currentdecpos
' Save current position
Call writelastpos
'set target for encoders
gRAEncoderPark = userpark.posR
gDECEncoderPark = userpark.posD
' set the unpark position
gRAEncoderUNPark = gRAEncoderPark
gDECEncoderUNPark = gDECEncoderPark
' Save Unpark Data
Call writeUnpark
Call StartPark(currentrapos, CDbl(gRAEncoderPark), currentdecpos, CDbl(gDECEncoderPark))
HC.Add_Message oLangDll.GetLangString(5003)
HC.ParkTimer.Enabled = True
Call EQ_Beep(5)
Call writeRAlimit
Call SetParkCaption
End If
End If
Endparkuser2:
End Sub
Public Sub Park2Current()
' only allow parking if currently unparked or unparking (used for emergency stop)
If gEQparkstatus <> 1 Then
If ParkInit() = True Then
gRAEncoderPark = EQGetMotorValues(0)
gDECEncoderPark = EQGetMotorValues(1)
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(177)
' Save Alignment if required
Call AligmentStarsPark
gRAEncoderlastpos = gRAEncoderPark
gDECEncoderlastpos = gDECEncoderPark
' Save current position
Call writelastpos
gRAEncoderUNPark = gRAEncoderPark
gDECEncoderUNPark = gDECEncoderPark
' Save Unpark Data
Call writeUnpark
' set staues as parked
gEQparkstatus = 1
' save park status just incase we don't shutdown
Call writeParkStatus(gEQparkstatus)
Call EQ_Beep(8)
HC.Add_Message (oLangDll.GetLangString(5003))
Call writeRAlimit
Call SetParkCaption
End If
End If
ENDParkToCurrent:
End Sub
Public Sub EmergencyStopPark()
' only allow parking if currently unparked or unparking (used for emergency stop)
If gEQparkstatus <> 1 Then
If ParkInit() = True Then
gRAEncoderPark = EQGetMotorValues(0)
gDECEncoderPark = EQGetMotorValues(1)
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(177)
' Save Alignment if required
Call AligmentStarsPark
gRAEncoderlastpos = gRAEncoderPark
gDECEncoderlastpos = gDECEncoderPark
' Save current position
Call writelastpos
gRAEncoderUNPark = gRAEncoderPark
gDECEncoderUNPark = gDECEncoderPark
' Save Unpark Data
Call writeUnpark
' set staues as parked
gEQparkstatus = 1
' save park status just incase we don't shutdown
Call writeParkStatus(gEQparkstatus)
Call EQ_Beep(7)
HC.Add_Message (oLangDll.GetLangString(5003))
Call writeRAlimit
Call SetParkCaption
End If
End If
ENDParkToCurrent:
End Sub
Public Sub StartPark(ByVal currentRa As Double, ByVal TargetRA As Double, ByVal currentDec As Double, ByVal TargetDEC As Double)
Dim i As Long
Dim j As Long
Dim hours As Double
If gParkParams.SuperSafeMode = 0 Then
gParkParams.RA_targetencoder = TargetRA
gParkParams.DEC_targetencoder = TargetDEC
gParkParams.rate = gGotoRate
If RALimitsActive() = False Then
' Limits are off
If gRA_Hours > 12 Then
' current position is CW up
If currentRa > RAEncoder_Home_pos Then
'Slew in RA only to nearest limit position
'then slew in RA/DEfollowed by dual axis slew
gParkParams.SuperSafeMode = 4
TargetRA = gRAMeridianWest
TargetDEC = currentDec
Else
'Slew in RA to limit position - then complete move as dual axis slew
gParkParams.SuperSafeMode = 4
TargetRA = gRAMeridianEast
TargetDEC = currentDec
End If
Else
' current postion is CW down
If TargetRA > gRAMeridianWest Then
' dual axis slew to meridian followed by ra slew to target
gParkParams.SuperSafeMode = 1
TargetRA = gRAMeridianWest
Else
If TargetRA < gRAMeridianEast Then
' dual axis slew to meridian followed by ra slew to target
gParkParams.SuperSafeMode = 1
TargetRA = gRAMeridianEast
End If
End If
End If
Else
' limits are active
If OutOfBounds(currentRa) = True Then
' current position is outside the limits
If OutOfBounds(TargetRA) = True Then
' target is out of limits
' first slew in RA to the nearest limit
' then slew in RA/DEC to the RA limit nearest the target
' then slew in RA to target
If currentRa > RAEncoder_Home_pos Then
TargetRA = gRA_Limit_West
TargetDEC = currentDec
Else
TargetRA = gRA_Limit_East
TargetDEC = currentDec
End If
gParkParams.SuperSafeMode = 3
Else
' target is in limits
' first slew in RA to the nearest limit
' then slew in RA/DEC to the target
If currentRa > RAEncoder_Home_pos Then
TargetRA = gRA_Limit_West
TargetDEC = currentDec
Else
TargetRA = gRA_Limit_East
TargetDEC = currentDec
End If
gParkParams.SuperSafeMode = 2
End If
Else
If OutOfBounds(TargetRA) = True Then
' target is out of limits
' slew in RA/DEC to limit nearest the target
' then slew in RA to target
If TargetRA > RAEncoder_Home_pos Then
TargetRA = gRA_Limit_West
TargetDEC = TargetDEC
Else
TargetRA = gRA_Limit_East
TargetDEC = TargetDEC
End If
gParkParams.SuperSafeMode = 1
Else
' target is in limits
' then slew in RA/DEC to the target
End If
End If
End If
End If
i = Abs(currentRa - TargetRA)
j = Abs(currentDec - TargetDEC)
If i <> 0 Then
If currentRa < TargetRA Then
gParkParams.RA_Direction = 0
Select Case gParkParams.rate
Case 0
' let mount decide on slew rate
gParkParams.RA_SlewActive = 0
eqres = EQStartMoveMotor(0, 0, 0, i, GetSlowdown(i))
Case Else
gParkParams.RA_SlewActive = 1
eqres = EQ_Slew(0, 0, 0, CLng(gParkParams.rate))
End Select
Else
gParkParams.RA_Direction = 1
Select Case gParkParams.rate
Case 0
' let mount decide on slew rate
gParkParams.RA_SlewActive = 0
eqres = EQStartMoveMotor(0, 0, 1, i, GetSlowdown(i))
Case Else
gParkParams.RA_SlewActive = 1
eqres = EQ_Slew(0, 0, 1, CLng(gParkParams.rate))
End Select
End If
End If
If j <> 0 Then
If currentDec < TargetDEC Then
gParkParams.DEC_Direction = 0
Select Case gParkParams.rate
Case 0
' let mount decide on slew rate
gParkParams.DEC_SlewActive = 0
eqres = EQStartMoveMotor(1, 0, 0, j, GetSlowdown(j))
Case Else
gParkParams.DEC_SlewActive = 1
eqres = EQ_Slew(1, 0, 0, CLng(gParkParams.rate))
End Select
Else
gParkParams.DEC_Direction = 1
Select Case gParkParams.rate
Case 0
' let mount decide on slew rate
gParkParams.DEC_SlewActive = 0
eqres = EQStartMoveMotor(1, 0, 1, j, GetSlowdown(j))
Case Else
gParkParams.DEC_SlewActive = 1
eqres = EQ_Slew(1, 0, 1, CLng(gParkParams.rate))
End Select
End If
End If
End Sub
Public Sub DefinePark(ByVal StopMotors As Boolean)
If StopMotors Then
Call StopTrackingUpdates
eqres = EQ_MotorStop(2) ' Stop RA & DEC Motor
If eqres <> 0 Then
GoTo ENDDefinePark
End If
' eqres = EQ_MotorStop(0) ' Stop RA Motor
' If eqres <> 0 Then
' GoTo ENDDefinePark
' End If
' eqres = EQ_MotorStop(1) ' Stop DEC Motor
' If eqres <> 0 Then
' GoTo ENDDefinePark
' End If
'
' 'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If eqres = 1 Then
' GoTo ENDDefinePark
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
' 'Wait until DEC motor is stable
' Do
' eqres = EQ_GetMotorStatus(1)
' If eqres = 1 Then
' GoTo ENDDefinePark
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
End If
'Read Motor Values
gRAEncoderPark = EQGetMotorValues(0)
gDECEncoderPark = EQGetMotorValues(1)
Call writepark
ENDDefinePark:
End Sub
Public Sub DefineUserPark(ByVal StopMotors As Boolean, ByVal Index As Integer, name As String)
If StopMotors Then
Call StopTrackingUpdates
eqres = EQ_MotorStop(2) ' Stop RA & DEC Motor
If eqres <> 0 Then GoTo ENDDefineUserPark
' eqres = EQ_MotorStop(0) ' Stop RA Motor
' If eqres <> 0 Then GoTo ENDDefineUserPark
' eqres = EQ_MotorStop(1) ' Stop DEC Motor
' If eqres <> 0 Then GoTo ENDDefineUserPark
'
' 'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If eqres = 1 Then GoTo ENDDefineUserPark
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
' 'Wait until DEC motor is stable
' Do
' eqres = EQ_GetMotorStatus(1)
' If eqres = 1 Then GoTo ENDDefineUserPark
' Loop While (eqres And EQ_MOTORBUSY) <> 0
End If
'Read Motor Values
UserParks(Index).posR = EQGetMotorValues(0)
UserParks(Index).posD = EQGetMotorValues(1)
UserParks(Index).name = name
Call writeUserParkPos
ENDDefineUserPark:
End Sub
Public Sub DefineUserUnPark(ByVal StopMotors As Boolean, ByVal Index As Integer, name As String)
If StopMotors Then
Call StopTrackingUpdates
eqres = EQ_MotorStop(2) ' Stop RA & DEC Motor
If eqres <> 0 Then GoTo ENDDefineUserUnPark
' eqres = EQ_MotorStop(0) ' Stop RA Motor
' If eqres <> 0 Then GoTo ENDDefineUserUnPark
' eqres = EQ_MotorStop(1) ' Stop DEC Motor
' If eqres <> 0 Then GoTo ENDDefineUserUnPark
'
' 'Wait until RA motor is stable
' Do
' eqres = EQ_GetMotorStatus(0)
' If eqres = 1 Then GoTo ENDDefineUserUnPark
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
' 'Wait until DEC motor is stable
' Do
' eqres = EQ_GetMotorStatus(1)
' If eqres = 1 Then GoTo ENDDefineUserUnPark
' Loop While (eqres And EQ_MOTORBUSY) <> 0
End If
'Read Motor Values
UserUnparks(Index).posR = EQGetMotorValues(0)
UserUnparks(Index).posD = EQGetMotorValues(1)
UserUnparks(Index).name = name
Call writeUserParkPos
ENDDefineUserUnPark:
End Sub
Public Sub Unparkscope()
If EQ_GetMountStatus() = 1 Then ' Make sure that we unpark only if the mount is online
If gEQparkstatus = 1 Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
' Load Alignment if required
Call AlignmentStarsUnpark
'Just make sure motors are not moving
PEC_StopTracking
eqres = EQ_MotorStop(2)
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
' Restore Encoder values
Call readUnpark
eqres = EQSetMotorValues(0, gRAEncoderUNPark)
eqres = EQSetMotorValues(1, gDECEncoderUNPark)
HC.Add_Message (oLangDll.GetLangString(5036))
' set status as unparked
gEQparkstatus = 0
writeParkStatus gEQparkstatus
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(179)
Call SetParkCaption
EQ_Beep (9)
Else
HC.Add_Message (oLangDll.GetLangString(5037))
End If
End If
End Sub
Public Sub UnparkscopeToLastPos()
Dim i As Long
Dim j As Long
If EQ_GetMountStatus() = 1 Then ' Make sure that we unpark only if the mount is online
If gEQparkstatus = 1 Then
' Load Alignment if required
Call AlignmentStarsUnpark
'Unpark Scope first
'Just make sure motors are not moving
PEC_StopTracking
eqres = EQ_MotorStop(2)
'eqres = EQ_MotorStop(0)
'eqres = EQ_MotorStop(1)
' Restore encoder values
Call readUnpark
eqres = EQSetMotorValues(0, gRAEncoderUNPark)
eqres = EQSetMotorValues(1, gDECEncoderUNPark)
'get last position prior to park command
Call readlastpos
' set status as unparking
gEQparkstatus = 3
' start slewing
Call StartPark(CDbl(gRAEncoderUNPark), CDbl(gRAEncoderlastpos), CDbl(gDECEncoderUNPark), CDbl(gDECEncoderlastpos))
HC.ParkTimer.Enabled = True
HC.Add_Message (oLangDll.GetLangString(5038))
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
Else
HC.Add_Message (oLangDll.GetLangString(5037))
End If
End If
End Sub
Public Sub UnparkscopeToUserDef(userpos As parkpos)
Dim i As Long
Dim j As Long
' don't unpark if user position is undefined!
If userpos.posD = 0 Or userpos.posR = 0 Then GoTo EndUnparkscopeToUserDef:
If EQ_GetMountStatus() = 1 Then ' Make sure that we unpark only if the mount is online
If gEQparkstatus = 1 Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
' Load Alignment if required
Call AlignmentStarsUnpark
'Unpark Scope first
readUnpark
'Just make sure motors are not moving
PEC_StopTracking
eqres = EQ_MotorStop(2)
'eqres = EQ_MotorStop(0)
'eqres = EQ_MotorStop(1)
' Restore encoder values
eqres = EQSetMotorValues(0, gRAEncoderUNPark)
eqres = EQSetMotorValues(1, gDECEncoderUNPark)
gEQparkstatus = 3
Call StartPark(CDbl(gRAEncoderUNPark), CDbl(userpos.posR), CDbl(gDECEncoderUNPark), CDbl(userpos.posD))
HC.ParkTimer.Enabled = True
HC.Add_Message (oLangDll.GetLangString(5038))
Else
HC.Add_Message (oLangDll.GetLangString(5037))
End If
End If
EndUnparkscopeToUserDef:
End Sub
Public Sub readUnpark()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("UNPARK_RA")
If tmptxt <> "" Then
gRAEncoderUNPark = val(tmptxt)
Else
gRAEncoderUNPark = RAEncoder_Home_pos
End If
tmptxt = HC.oPersist.ReadIniValue("UNPARK_DEC")
If tmptxt <> "" Then
gDECEncoderUNPark = val(tmptxt)
Else
gDECEncoderUNPark = gDECEncoder_Home_pos
End If
End Sub
Public Sub readpark()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("PARK_RA")
If tmptxt <> "" Then
gRAEncoderPark = val(tmptxt)
Else
gRAEncoderPark = RAEncoder_Home_pos
End If
tmptxt = HC.oPersist.ReadIniValue("PARK_DEC")
If tmptxt <> "" Then
gDECEncoderPark = val(tmptxt)
Else
gDECEncoderPark = gDECEncoder_Home_pos
End If
End Sub
Public Function readparkStatus() As Long
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("EQPARKSTATUS")
If tmptxt = "parked" Then
readparkStatus = 1
Else
readparkStatus = 0
End If
End Function
Public Sub readParkModes()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("DEFAULT_PARK_MODE")
If tmptxt <> "" Then
HC.ComboPark.ListIndex = val(tmptxt)
Else
HC.ComboPark.ListIndex = 0
End If
tmptxt = HC.oPersist.ReadIniValue("DEFAULT_UNPARK_MODE")
If tmptxt <> "" Then
HC.ComboUnPark.ListIndex = val(tmptxt)
Else
HC.ComboUnPark.ListIndex = 0
End If
Call SetParkCaption
End Sub
Public Sub writeParkMode_park()
HC.oPersist.WriteIniValue "DEFAULT_PARK_MODE", CStr(HC.ComboPark.ListIndex)
End Sub
Public Sub writeParkMode_unpark()
HC.oPersist.WriteIniValue "DEFAULT_UNPARK_MODE", CStr(HC.ComboUnPark.ListIndex)
End Sub
Public Sub writeParkStatus(ByVal pval As Long)
If pval = 1 Then
' mount is parked
HC.oPersist.WriteIniValue "EQPARKSTATUS", CStr("parked")
Else
' mount is unparked or parking
HC.oPersist.WriteIniValue "EQPARKSTATUS", CStr("unparked")
End If
End Sub
Public Sub writeUnpark()
HC.oPersist.WriteIniValue "UNPARK_RA", CStr(gRAEncoderUNPark)
HC.oPersist.WriteIniValue "UNPARK_DEC", CStr(gDECEncoderUNPark)
End Sub
Public Sub writepark()
HC.oPersist.WriteIniValue "PARK_RA", CStr(gRAEncoderPark)
HC.oPersist.WriteIniValue "PARK_DEC", CStr(gDECEncoderPark)
End Sub
Public Sub readUserParkPos()
Dim tmptxt As String
Dim valstr As String
Dim Ini As String
Dim key As String
Dim Count As Integer
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
For Count = 1 To 10
key = "[userparkposn]"
With UserParks(Count)
.name = oLangDll.GetLangString(2730)
.posR = 0
.posD = 0
valstr = "NAME_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.name = tmptxt
Else
If Count = 1 Then
.name = oLangDll.GetLangString(148)
End If
Call HC.oPersist.WriteIniValueEx(valstr, .name, key, Ini)
End If
valstr = "RCOUNT_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.posR = val(tmptxt)
Else
If Count = 1 Then
tmptxt = HC.oPersist.ReadIniValue("PARK_RA")
If tmptxt <> "" Then
.posR = tmptxt
End If
End If
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posR), key, Ini)
End If
valstr = "DCOUNT_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.posD = val(tmptxt)
Else
If Count = 1 Then
tmptxt = HC.oPersist.ReadIniValue("PARK_DEC")
If tmptxt <> "" Then
.posD = tmptxt
End If
End If
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posD), key, Ini)
End If
End With
key = "[userunparkposn]"
With UserUnparks(Count)
.name = oLangDll.GetLangString(2730)
.posR = 0
.posD = 0
valstr = "NAME_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.name = tmptxt
Else
If Count = 1 Then
.name = oLangDll.GetLangString(2000)
End If
Call HC.oPersist.WriteIniValueEx(valstr, .name, key, Ini)
End If
valstr = "RCOUNT_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.posR = val(tmptxt)
Else
If Count = 1 Then
tmptxt = HC.oPersist.ReadIniValue("UNPARK_RA")
If tmptxt <> "" Then
.posR = tmptxt
End If
End If
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posR), key, Ini)
End If
valstr = "DCOUNT_" & CStr(Count)
tmptxt = HC.oPersist.ReadIniValueEx(valstr, key, Ini)
If tmptxt <> "" Then
.posD = val(tmptxt)
Else
If Count = 1 Then
tmptxt = HC.oPersist.ReadIniValue("UNPARK_DEC")
If tmptxt <> "" Then
.posD = tmptxt
End If
End If
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posD), key, Ini)
End If
End With
Next Count
End Sub
Public Sub writeUserParkPos()
Dim tmptxt As String
Dim valstr As String
Dim Ini As String
Dim key As String
Dim Count As Integer
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
For Count = 1 To 10
key = "[userparkposn]"
With UserParks(Count)
valstr = "NAME_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, .name, key, Ini)
valstr = "RCOUNT_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posR), key, Ini)
valstr = "DCOUNT_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posD), key, Ini)
End With
key = "[userunparkposn]"
With UserUnparks(Count)
valstr = "NAME_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, .name, key, Ini)
valstr = "RCOUNT_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posR), key, Ini)
valstr = "DCOUNT_" & CStr(Count)
Call HC.oPersist.WriteIniValueEx(valstr, CStr(.posD), key, Ini)
End With
Next Count
End Sub
Public Sub SetParkCaption()
If gEQparkstatus Then
' parked - use unpark text
HC.CommandPark.Caption = HC.ComboUnPark.Text
Else
' unparked - use park text
HC.CommandPark.Caption = HC.ComboPark.Text
End If
End Sub
' called from park timer
Public Sub ManagePark()
Dim currentrapos As Double
Dim currentdecpos As Double
Dim i As Long
Dim j As Long
If gParkParams.RA_SlewActive = 1 Or gParkParams.DEC_SlewActive = 1 Then
If gParkParams.RA_SlewActive Then
If gParkParams.RA_Direction = 0 Then
If gRA_Encoder >= gParkParams.RA_targetencoder Then
eqres = EQ_MotorStop(0)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo PT1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'PT1:
gParkParams.RA_SlewActive = 0
End If
Else
If gRA_Encoder <= gParkParams.RA_targetencoder Then
eqres = EQ_MotorStop(0)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo PT2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'PT2:
gParkParams.RA_SlewActive = 0
End If
End If
End If
If gParkParams.DEC_SlewActive Then
If gParkParams.DEC_Direction = 0 Then
If gDec_Encoder >= gParkParams.DEC_targetencoder Then
eqres = EQ_MotorStop(1)
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo PT3
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'PT3:
gParkParams.DEC_SlewActive = 0
End If
Else
If gDec_Encoder <= gParkParams.DEC_targetencoder Then
eqres = EQ_MotorStop(1)
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo PT4
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'PT4:
gParkParams.DEC_SlewActive = 0
End If
End If
End If
If gParkParams.RA_SlewActive = 0 And gParkParams.DEC_SlewActive = 0 Then
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
i = Abs(currentrapos - gParkParams.RA_targetencoder)
j = Abs(currentdecpos - gParkParams.DEC_targetencoder)
If i <> 0 Then
If currentrapos < gParkParams.RA_targetencoder Then
eqres = EQStartMoveMotor(0, 0, 0, i, GetSlowdown(i))
Else
eqres = EQStartMoveMotor(0, 0, 1, i, GetSlowdown(i))
End If
End If
If j <> 0 Then
If currentdecpos < gParkParams.DEC_targetencoder Then
eqres = EQStartMoveMotor(1, 0, 0, j, GetSlowdown(j))
Else
eqres = EQStartMoveMotor(1, 0, 1, j, GetSlowdown(j))
End If
End If
End If
Exit Sub
End If
If ((EQ_GetMotorStatus(0) And EQ_MOTORBUSY) = 0) And ((EQ_GetMotorStatus(1) And EQ_MOTORBUSY) = 0) Then
gEmulOneShot = True ' update ra/dec with real reads fron the mount
Select Case gParkParams.SuperSafeMode
Case 0
HC.ParkTimer.Enabled = False
Select Case gEQparkstatus
Case 0
' was unparked
Case 1
' was parked
gEQparkstatus = 0
writeParkStatus gEQparkstatus
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(179)
Call readRALimit
Call SetParkCaption
EQ_Beep (9)
Case 2
' was parking
' write the park status - just incase EQMOD crashes before normal shutdown!
gEQparkstatus = 1
writeParkStatus gEQparkstatus
Call EQ_Beep(8)
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(177)
Case 3
' was unparking
gEQparkstatus = 0
writeParkStatus gEQparkstatus
HC.Frame15.Caption = oLangDll.GetLangString(146) & " " & oLangDll.GetLangString(179)
Call readRALimit
Call SetParkCaption
EQ_Beep (9)
End Select
Case 1
' Currently at RA home and target DEC: Now move to RA target
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
Call StartPark(currentrapos, gParkParams.RA_targetencoder, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 0
Case 2
' we're at the RA home/limit position
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
If OutOfBounds(gParkParams.RA_targetencoder) Then
' RA target is outside limits so first slew in dec
Call StartPark(currentrapos, RAEncoder_Home_pos, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 1
Else
' RA target is within limits so slew both RA and DEC to target
Call StartPark(currentrapos, gParkParams.RA_targetencoder, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 0
End If
Case 3
' we're at the RA Limit position
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
If gParkParams.RA_targetencoder > RAEncoder_Home_pos Then
' now move to limit nearest to target
Call StartPark(currentrapos, gRA_Limit_West, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 1
Else
' now move to limit nearest to target
Call StartPark(currentrapos, gRA_Limit_East, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 1
End If
Case 4
' we're at the RA Limit position
currentrapos = EQGetMotorValues(0)
currentdecpos = EQGetMotorValues(1)
If gParkParams.RA_targetencoder > gRAMeridianWest Then
' now move to limit nearest to target
Call StartPark(currentrapos, gRAMeridianWest, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 1
Else
If gParkParams.RA_targetencoder < gRAMeridianEast Then
' now move to limit nearest to target
Call StartPark(currentrapos, gRAMeridianEast, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 1
Else
Call StartPark(currentrapos, gParkParams.RA_targetencoder, currentdecpos, gParkParams.DEC_targetencoder)
gParkParams.SuperSafeMode = 0
End If
End If
End Select
End If
End Sub
' at 4376 Done code part. Lines - 1 Analysing sounds.basError parsing line 'Attribute VB_Name = "Sounds"
Option Explicit
Public Type EQMOD_SOUNDS
mode As Integer
PositionBeep As Boolean
ButtonClick As Boolean
RateClick As Boolean
GotoClick As Boolean
GotoStartClick As Boolean
ParkClick As Boolean
ParkedClick As Boolean
Stopclick As Boolean
Unparkclick As Boolean
FlipWarning As Boolean
TrackClick As Boolean
AlignClick As Boolean
PolarClick As Boolean
DMSClick As Boolean
GPLClick As Boolean
MonitorClick As Boolean
ReverseClick As Boolean
BeepWav As String
ClickWav As String
AlarmWav As String
RateWav(1 To 10) As String
SyncWav As String
GotoWav As String
GotoStartWav As String
ParkWav As String
ParkedWav As String
StopWav As String
Unparkwav As String
SiderealWav As String
LunarWav As String
SolarWav As String
CustomWav As String
AcceptWav As String
CancelWav As String
EndWav As String
PHomeWav As String
PAlignwav As String
PAlignedwav As String
DMSwav As String
DMS2wav As String
GPLOnwav As String
GPLOffwav As String
MonitorOnwav As String
MonitorOffwav As String
RAReverseOnwav As String
RaReverseOffwav As String
DecReverseOnwav As String
DecReverseOffwav As String
End Type
Public EQSounds As EQMOD_SOUNDS
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1 ' play asynchronously
Private Const SND_SYNC = &H0
Public Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency _
As Long, ByVal dwMilliseconds As Long) As Long
Public Sub EQ_Beep(BeepType As Integer)
On Error Resume Next
Select Case BeepType
' Beep
Case 0
If EQSounds.PositionBeep = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.BeepWav, SND_ASYNC)
End Select
End If
' Click
Case 1
If EQSounds.ButtonClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 100, 1
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.ClickWav, SND_ASYNC)
End Select
End If
' Alarm
Case 2
If EQSounds.FlipWarning = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 200, 500
BeepAPI 100, 500
BeepAPI 200, 500
BeepAPI 100, 500
BeepAPI 200, 500
BeepAPI 100, 500
BeepAPI 200, 500
BeepAPI 100, 500
BeepAPI 200, 500
BeepAPI 100, 500
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.AlarmWav, SND_ASYNC)
End Select
End If
' Beep - always sounds
Case 3
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.BeepWav, SND_ASYNC)
End Select
' Sync
Case 4
If EQSounds.AlignClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.SyncWav, SND_ASYNC)
End Select
End If
' Park
Case 5
If EQSounds.ParkClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.ParkWav, SND_ASYNC)
End Select
End If
' Goto
Case 6
If EQSounds.GotoClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.GotoWav, SND_ASYNC)
End Select
End If
' Stop
Case 7
If EQSounds.Stopclick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.StopWav, SND_ASYNC)
End Select
End If
' Parked
Case 8
If EQSounds.ParkedClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.ParkedWav, SND_ASYNC)
End Select
End If
' Unpark
Case 9
If EQSounds.Unparkclick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.Unparkwav, SND_ASYNC)
End Select
End If
' Sidereal
Case 10
If EQSounds.TrackClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.SiderealWav, SND_ASYNC)
End Select
End If
' lunar
Case 11
If EQSounds.TrackClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.LunarWav, SND_ASYNC)
End Select
End If
' solar
Case 12
If EQSounds.TrackClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.SolarWav, SND_ASYNC)
End Select
End If
' custom
Case 13
If EQSounds.TrackClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.CustomWav, SND_ASYNC)
End Select
End If
' Goto
Case 20
If EQSounds.GotoStartClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.GotoStartWav, SND_ASYNC)
End Select
End If
' Accept
Case 21
If EQSounds.AlignClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.AcceptWav, SND_ASYNC)
End Select
End If
' Cancel
Case 22
If EQSounds.AlignClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.CancelWav, SND_ASYNC)
End Select
End If
' End
Case 23
If EQSounds.AlignClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.EndWav, SND_ASYNC)
End Select
End If
' Polar Home
Case 24
If EQSounds.PolarClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.PHomeWav, SND_ASYNC)
End Select
End If
' Polar Aligning
Case 25
If EQSounds.PolarClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.PAlignwav, SND_ASYNC)
End Select
End If
' Polar Aligned
Case 26
If EQSounds.PolarClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.PAlignedwav, SND_ASYNC)
End Select
End If
Case 30
' end beep
If EQSounds.ButtonClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
' play asynchronously
End Select
End If
Case 31
' Dead mans switch armed
If EQSounds.DMSClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.DMSwav, SND_ASYNC)
End Select
End If
Case 32
' Dead mans switch armed
If EQSounds.DMSClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.DMS2wav, SND_ASYNC)
End Select
End If
Case 33
' GamePad Lock on
If EQSounds.GPLClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.GPLOnwav, SND_ASYNC)
End Select
End If
Case 34
' GamePad Lock off
If EQSounds.GPLClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.GPLOffwav, SND_ASYNC)
End Select
End If
Case 35
' Monitor On
If EQSounds.MonitorClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.MonitorOnwav, SND_ASYNC)
End Select
End If
Case 36
' Monitor Off
If EQSounds.MonitorClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.MonitorOffwav, SND_ASYNC)
End Select
End If
Case 40
' RaReverseOn
If EQSounds.ReverseClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.RAReverseOnwav, SND_ASYNC)
End Select
End If
Case 41
' RaReverseOff
If EQSounds.ReverseClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.RaReverseOffwav, SND_ASYNC)
End Select
End If
Case 42
' DecReverseOn
If EQSounds.ReverseClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.DecReverseOnwav, SND_ASYNC)
End Select
End If
Case 43
' DecReverseOff
If EQSounds.ReverseClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 600, 100
Case 1
Call sndPlaySound(EQSounds.DecReverseOffwav, SND_ASYNC)
End Select
End If
' rate sounds
Case 101, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110
If EQSounds.RateClick = True Then
Select Case EQSounds.mode
Case 0
BeepAPI 100, 1
Case 1
' play asynchronously
Call sndPlaySound(EQSounds.RateWav(BeepType - 100), SND_ASYNC)
End Select
End If
End Select
End Sub
Public Sub writeBeep()
Dim key As String
Dim i As Integer
With EQSounds
HC.oPersist.WriteIniValue "SND_WAV_ALARM", .AlarmWav
HC.oPersist.WriteIniValue "SND_WAV_CLICK", .ClickWav
HC.oPersist.WriteIniValue "SND_WAV_BEEP", .BeepWav
HC.oPersist.WriteIniValue "SND_WAV_SYNC", .SyncWav
HC.oPersist.WriteIniValue "SND_WAV_PARK", .ParkWav
HC.oPersist.WriteIniValue "SND_WAV_PARKED", .ParkedWav
HC.oPersist.WriteIniValue "SND_WAV_GOTO", .GotoWav
HC.oPersist.WriteIniValue "SND_WAV_GOTOSTART", .GotoStartWav
HC.oPersist.WriteIniValue "SND_WAV_STOP", .StopWav
HC.oPersist.WriteIniValue "SND_WAV_UNPARK", .Unparkwav
HC.oPersist.WriteIniValue "SND_WAV_SIDEREAL", .SiderealWav
HC.oPersist.WriteIniValue "SND_WAV_LUNAR", .LunarWav
HC.oPersist.WriteIniValue "SND_WAV_SOLAR", .SolarWav
HC.oPersist.WriteIniValue "SND_WAV_ACCEPT", .AcceptWav
HC.oPersist.WriteIniValue "SND_WAV_CANCEL", .CancelWav
HC.oPersist.WriteIniValue "SND_WAV_END", .EndWav
HC.oPersist.WriteIniValue "SND_WAV_PHOME", .PHomeWav
HC.oPersist.WriteIniValue "SND_WAV_PALIGN", .PAlignwav
HC.oPersist.WriteIniValue "SND_WAV_PALIGNED", .PAlignedwav
HC.oPersist.WriteIniValue "SND_WAV_DMS", .DMSwav
HC.oPersist.WriteIniValue "SND_WAV_DMS2", .DMS2wav
HC.oPersist.WriteIniValue "SND_WAV_GPLON", .GPLOnwav
HC.oPersist.WriteIniValue "SND_WAV_GPLOFF", .GPLOffwav
HC.oPersist.WriteIniValue "SND_WAV_MONITORON", .MonitorOnwav
HC.oPersist.WriteIniValue "SND_WAV_MONITOROFF", .MonitorOffwav
HC.oPersist.WriteIniValue "SND_WAV_CUSTOM", .CustomWav
HC.oPersist.WriteIniValue "SND_WAV_RAREVERSEON", .RAReverseOnwav
HC.oPersist.WriteIniValue "SND_WAV_RAREVERSEOFF", .RaReverseOffwav
HC.oPersist.WriteIniValue "SND_WAV_DECREVERSEON", .DecReverseOnwav
HC.oPersist.WriteIniValue "SND_WAV_DECREVERSEOFF", .DecReverseOffwav
For i = 1 To 10
key = "SND_WAV_RATE" & CStr(i)
HC.oPersist.WriteIniValue key, .RateWav(i)
Next i
HC.oPersist.WriteIniValue "SND_MODE", CStr(.mode)
If .PositionBeep Then
HC.oPersist.WriteIniValue "SND_ENABLE_BEEP", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_BEEP", "0"
End If
If .ButtonClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_CLICK", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_CLICK", "0"
End If
If .FlipWarning Then
HC.oPersist.WriteIniValue "SND_ENABLE_ALARM", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_ALARM", "0"
End If
If .RateClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_RATE", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_RATE", "0"
End If
If .ParkClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_PARK", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_PARK", "0"
End If
If .ParkedClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_PARKED", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_PARKED", "0"
End If
If .GotoClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_GOTO", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_GOTO", "0"
End If
If .GotoStartClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_GOTOSTART", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_GOTOSTART", "0"
End If
If .Stopclick Then
HC.oPersist.WriteIniValue "SND_ENABLE_STOP", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_STOP", "0"
End If
If .Unparkclick Then
HC.oPersist.WriteIniValue "SND_ENABLE_UNPARK", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_UNPARK", "0"
End If
If .TrackClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_TRACKING", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_TRACKING", "0"
End If
If .AlignClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_ALIGN", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_ALIGN", "0"
End If
If .PolarClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_POLAR", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_POLAR", "0"
End If
If .DMSClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_DMS", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_DMS", "0"
End If
If .GPLClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_GPL", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_GPL", "0"
End If
If .MonitorClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_MONITOR", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_MONITOR", "0"
End If
If .ReverseClick Then
HC.oPersist.WriteIniValue "SND_ENABLE_REVERSE", "1"
Else
HC.oPersist.WriteIniValue "SND_ENABLE_REVERSE", "0"
End If
End With
End Sub
Public Sub readBeep()
Dim tmptxt As String
Dim key As String
Dim i As Integer
With EQSounds
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_ALARM")
If tmptxt <> "" Then
.AlarmWav = tmptxt
Else
.AlarmWav = "EQMOD_klaxton.wav"
HC.oPersist.WriteIniValue "SND_WAV_ALARM", .AlarmWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_CLICK")
If tmptxt <> "" Then
.ClickWav = tmptxt
Else
.ClickWav = "EQMOD_click.wav"
HC.oPersist.WriteIniValue "SND_WAV_CLICK", .ClickWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_BEEP")
If tmptxt <> "" Then
.BeepWav = tmptxt
Else
.BeepWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_BEEP", .BeepWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_SYNC")
If tmptxt <> "" Then
.SyncWav = tmptxt
Else
.SyncWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_SYNC", .SyncWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_PARK")
If tmptxt <> "" Then
.ParkWav = tmptxt
Else
.ParkWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_PARK", .ParkWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_UNPARK")
If tmptxt <> "" Then
.Unparkwav = tmptxt
Else
.Unparkwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_UNPARK", .Unparkwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_PARKED")
If tmptxt <> "" Then
.ParkedWav = tmptxt
Else
.ParkedWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_PARKED", .ParkedWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_GOTO")
If tmptxt <> "" Then
.GotoWav = tmptxt
Else
.GotoWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_GOTO", .GotoWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_GOTOSTART")
If tmptxt <> "" Then
.GotoStartWav = tmptxt
Else
.GotoStartWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_GOTOSTART", .GotoStartWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_STOP")
If tmptxt <> "" Then
.StopWav = tmptxt
Else
.StopWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_STOP", .StopWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_SIDEREAL")
If tmptxt <> "" Then
.SiderealWav = tmptxt
Else
.SiderealWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_SIDEREAL", .SiderealWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_LUNAR")
If tmptxt <> "" Then
.LunarWav = tmptxt
Else
.LunarWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_LUNAR", .LunarWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_SOLAR")
If tmptxt <> "" Then
.SolarWav = tmptxt
Else
.SolarWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_SOLAR", .SolarWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_CUSTOM")
If tmptxt <> "" Then
.CustomWav = tmptxt
Else
.CustomWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_CUSTOM", .CustomWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_ACCEPT")
If tmptxt <> "" Then
.AcceptWav = tmptxt
Else
.AcceptWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_ACCEPT", .AcceptWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_CANCEL")
If tmptxt <> "" Then
.CancelWav = tmptxt
Else
.CancelWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_CANCEL", .CancelWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_END")
If tmptxt <> "" Then
.EndWav = tmptxt
Else
.EndWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_END", .EndWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_PHOME")
If tmptxt <> "" Then
.PHomeWav = tmptxt
Else
.PHomeWav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_PHOME", .PHomeWav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_PALIGN")
If tmptxt <> "" Then
.PAlignwav = tmptxt
Else
.PAlignwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_PALIGN", .PAlignwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_PALIGNED")
If tmptxt <> "" Then
.PAlignedwav = tmptxt
Else
.PAlignedwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_PALIGNED", .PAlignedwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_DMS")
If tmptxt <> "" Then
.DMSwav = tmptxt
Else
.DMSwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_DMS", .DMSwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_DMS2")
If tmptxt <> "" Then
.DMS2wav = tmptxt
Else
.DMS2wav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_DMS2", .DMS2wav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_GPLON")
If tmptxt <> "" Then
.GPLOnwav = tmptxt
Else
.GPLOnwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_GPLON", .GPLOnwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_GPLOFF")
If tmptxt <> "" Then
.GPLOffwav = tmptxt
Else
.GPLOffwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_GPLOFF", .GPLOffwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_MONITORON")
If tmptxt <> "" Then
.MonitorOnwav = tmptxt
Else
.MonitorOnwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_MONITORON", .MonitorOnwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_MONITOROFF")
If tmptxt <> "" Then
.MonitorOffwav = tmptxt
Else
.MonitorOffwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_MONITOROFF", .MonitorOffwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_RAREVERSEOFF")
If tmptxt <> "" Then
.RaReverseOffwav = tmptxt
Else
.RaReverseOffwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_RAREVERSEOFF", .RaReverseOffwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_RAREVERSEON")
If tmptxt <> "" Then
.RAReverseOnwav = tmptxt
Else
.RAReverseOnwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_RAREVERSEON", .RAReverseOnwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_DECREVERSEOFF")
If tmptxt <> "" Then
.DecReverseOffwav = tmptxt
Else
.DecReverseOffwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_DECREVERSEOFF", .DecReverseOffwav
End If
tmptxt = HC.oPersist.ReadIniValue("SND_WAV_DECREVERSEON")
If tmptxt <> "" Then
.DecReverseOnwav = tmptxt
Else
.DecReverseOnwav = "EQMOD_beep.wav"
HC.oPersist.WriteIniValue "SND_WAV_DECREVERSEON", .DecReverseOnwav
End If
For i = 1 To 10
key = "SND_WAV_RATE" & CStr(i)
tmptxt = HC.oPersist.ReadIniValue(key)
If tmptxt <> "" Then
.RateWav(i) = tmptxt
Else
.RateWav(i) = "EQMOD_click.wav"
HC.oPersist.WriteIniValue key, .ClickWav
End If
Next i
tmptxt = HC.oPersist.ReadIniValue("SND_MODE")
If tmptxt <> "" Then
.mode = val(tmptxt)
Else
.mode = 0
HC.oPersist.WriteIniValue "SND_MODE", CStr(.mode)
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_BEEP")
If tmptxt <> "" Then
If tmptxt = "1" Then
.PositionBeep = True
Else
.PositionBeep = False
End If
Else
.PositionBeep = False
HC.oPersist.WriteIniValue "SND_ENABLE_BEEP", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_CLICK")
If tmptxt <> "" Then
If tmptxt = "1" Then
.ButtonClick = True
Else
.ButtonClick = False
End If
Else
.ButtonClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_CLICK", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_ALARM")
If tmptxt <> "" Then
If tmptxt = "1" Then
.FlipWarning = True
Else
.FlipWarning = False
End If
Else
.FlipWarning = False
HC.oPersist.WriteIniValue "SND_ENABLE_ALARM", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_RATE")
If tmptxt <> "" Then
If tmptxt = "1" Then
.RateClick = True
Else
.RateClick = False
End If
Else
.RateClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_RATE", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_PARK")
If tmptxt <> "" Then
If tmptxt = "1" Then
.ParkClick = True
Else
.ParkClick = False
End If
Else
.ParkClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_PARK", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_UNPARK")
If tmptxt <> "" Then
If tmptxt = "1" Then
.Unparkclick = True
Else
.Unparkclick = False
End If
Else
.Unparkclick = False
HC.oPersist.WriteIniValue "SND_ENABLE_UNPARK", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_PARKED")
If tmptxt <> "" Then
If tmptxt = "1" Then
.ParkedClick = True
Else
.ParkedClick = False
End If
Else
.ParkedClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_PARKED", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_GOTO")
If tmptxt <> "" Then
If tmptxt = "1" Then
.GotoClick = True
Else
.GotoClick = False
End If
Else
.GotoClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_GOTO", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_GOTOSTART")
If tmptxt <> "" Then
If tmptxt = "1" Then
.GotoStartClick = True
Else
.GotoStartClick = False
End If
Else
.GotoStartClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_GOTOSTART", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_STOP")
If tmptxt <> "" Then
If tmptxt = "1" Then
.Stopclick = True
Else
.Stopclick = False
End If
Else
.Stopclick = False
HC.oPersist.WriteIniValue "SND_ENABLE_STOP", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_TRACKING")
If tmptxt <> "" Then
If tmptxt = "1" Then
.TrackClick = True
Else
.TrackClick = False
End If
Else
.TrackClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_TRACKING", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_ALIGN")
If tmptxt <> "" Then
If tmptxt = "1" Then
.AlignClick = True
Else
.AlignClick = False
End If
Else
.AlignClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_ALIGN", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_POLAR")
If tmptxt <> "" Then
If tmptxt = "1" Then
.PolarClick = True
Else
.PolarClick = False
End If
Else
.PolarClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_POLAR", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_DMS")
If tmptxt <> "" Then
If tmptxt = "1" Then
.DMSClick = True
Else
.DMSClick = False
End If
Else
.DMSClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_DMS", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_GPL")
If tmptxt <> "" Then
If tmptxt = "1" Then
.GPLClick = True
Else
.GPLClick = False
End If
Else
.GPLClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_GPL", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_MONITOR")
If tmptxt <> "" Then
If tmptxt = "1" Then
.MonitorClick = True
Else
.MonitorClick = False
End If
Else
.MonitorClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_MONITOR", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("SND_ENABLE_REVERSE")
If tmptxt <> "" Then
If tmptxt = "1" Then
.ReverseClick = True
Else
.ReverseClick = False
End If
Else
.ReverseClick = False
HC.oPersist.WriteIniValue "SND_ENABLE_REVERSE", "0"
End If
End With
End Sub
' at 5618 Done code part. Lines - 1 Analysing goto.basError parsing line 'Attribute VB_Name = "Goto"
Option Explicit
Type GOTO_PARAMS
RA_currentencoder As Double
RA_Direction As Integer
RA_targetencoder As Double
RA_SlewActive As Integer
DEC_currentencoder As Double
DEC_Direction As Integer
DEC_targetencoder As Double
DEC_SlewActive As Integer
rate As Integer
SuperSafeMode As Integer
End Type
Public gGotoParams As GOTO_PARAMS
Public gGotoRate As Integer
Public gDisbleFlipGotoReset As Integer
Public gCWUP As Boolean
Public gMaxSlewCount As Integer
Public gSlewCount As Long
Public gFRSlewCount As Integer
Public gGotoResolution As Integer
Public gTargetRA As Double
Public gTargetDec As Double
Public gRAGotoRes As Double ' Iterative Slew minimum difference in arcsecs
Public gDECGotoRes As Double ' Iterative Slew minimum difference in arcsecs
Public gRA_Compensate As Long ' Least RA discrepancy Compensation
Public gRAMeridianWest As Double
Public gRAMeridianEast As Double
'Routine to Slew the mount to target location
Public Sub radecAsyncSlew(ByVal GotoRate As Integer)
HC.EncoderTimer.Enabled = False
With gGotoParams
Call CalcEncoderTargets
.rate = GotoRate
If gCWUP Then
gSupressHorizonLimits = True
' a counterweights up slew has been requested
If RALimitsActive() = False Then
' Limits are off so play safe and slew RA and DEC independently
If gRA_Hours > 12 Then
' we're currently in a counterweights up position
If .RA_currentencoder > RAEncoder_Home_pos Then
' single axis slew to nearest limit position
' followed by dual axis slew to target limit
' followed by single axis slew to target ra
.SuperSafeMode = 3
Call StartSlew(gRAMeridianWest, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
Else
' single axis slew to nearest limit position
' followed by dual axis slew to target limit
' followed by single axis slew to target ra
.SuperSafeMode = 3
Call StartSlew(gRAMeridianEast, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
End If
Else
' we're currently in a counterweights down position
If .RA_targetencoder > RAEncoder_Home_pos Then
' dual axis slew to limit position followed by ra only slew to target
.SuperSafeMode = 1
Call StartSlew(gRAMeridianWest, .DEC_targetencoder, .RA_currentencoder, .DEC_currentencoder)
Else
' dual axis slew to limit position followed by ra only slew to target
.SuperSafeMode = 1
Call StartSlew(gRAMeridianEast, .DEC_targetencoder, .RA_currentencoder, .DEC_currentencoder)
End If
End If
Else
' Limits are active so allow simulatenous RA/DEC movement
.SuperSafeMode = 0
Call StartSlew(.RA_targetencoder, .DEC_targetencoder, .RA_currentencoder, .DEC_currentencoder)
End If
Else
' we're currently in a counterweights up position
If RALimitsActive() = False Then
' Limits are off
If .RA_currentencoder > gRAMeridianWest Then
'Slew in RA to limit position - then complete move as dual axis slew
.SuperSafeMode = 1
gSupressHorizonLimits = True
Call StartSlew(gRAMeridianWest, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
Else
If .RA_currentencoder < gRAMeridianEast Then
'Slew in RA to limit position - then complete move as dual axis slew
.SuperSafeMode = 1
gSupressHorizonLimits = True
Call StartSlew(gRAMeridianEast, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
Else
' standard slew - simulatanous RA and DEc movement
.SuperSafeMode = 0
Call StartSlew(.RA_targetencoder, .DEC_targetencoder, .RA_currentencoder, .DEC_currentencoder)
End If
End If
Else
' Limits are enabled
If .RA_currentencoder > gRA_Limit_West Then
'Slew in RA to limit position - then complete move as dual axis slew
.SuperSafeMode = 1
gSupressHorizonLimits = True
Call StartSlew(gRA_Limit_West, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
Else
If .RA_currentencoder < gRA_Limit_East Then
'Slew in RA to limit position - then complete move as dual axis slew
.SuperSafeMode = 1
gSupressHorizonLimits = True
Call StartSlew(gRA_Limit_East, .DEC_currentencoder, .RA_currentencoder, .DEC_currentencoder)
Else
' standard slew - simulatanous RA and DEc movement
.SuperSafeMode = 0
Call StartSlew(.RA_targetencoder, .DEC_targetencoder, .RA_currentencoder, .DEC_currentencoder)
End If
End If
End If
End If
End With
HC.EncoderTimer.Enabled = True
End Sub
Public Sub CalcEncoderTargets()
Dim targetRAEncoder As Double
Dim targetDECEncoder As Double
Dim currentRAEncoder As Double
Dim currentDECEncoder As Double
Dim tmpcoord As Coordt
Dim DeltaRAStep As Long
Dim DeltaDECStep As Long
Dim RASlowdown As Long
Dim DECSlowdown As Long
Dim tRa As Double
Dim tha As Double
Dim tPier As Double
On Error GoTo endradecslew
gSlewStatus = False
'stop the motors
PEC_StopTracking
eqres = EQ_MotorStop(2)
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
' 'Wait for motor stop , Need to add timeout routines here
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SL01
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SL01:
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo SL02
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'
'SL02:
' read current
currentRAEncoder = EQGetMotorValues(0)
currentDECEncoder = EQGetMotorValues(1)
tha = RangeHA(gTargetRA - EQnow_lst(gLongitude * DEG_RAD))
If tha < 0 Then
If gCWUP Then
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = gTargetRA
Else
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(gTargetRA - 12)
End If
Else
If gCWUP Then
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(gTargetRA - 12)
Else
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = gTargetRA
End If
End If
'Compute for Target RA/DEC Encoder
targetRAEncoder = Get_RAEncoderfromRA(tRa, 0, gLongitude, gRAEncoder_Zero_pos, gTot_RA, gHemisphere)
targetDECEncoder = Get_DECEncoderfromDEC(gTargetDec, tPier, gDECEncoder_Zero_pos, gTot_DEC, gHemisphere)
If gCWUP Then
HC.Add_Message "Goto: CW-UP slew requested"
' if RA limits are active
If HC.ChkEnableLimits.value = 1 And gRA_Limit_East <> 0 And gRA_Limit_West <> 0 Then
' check that the target position is within limits
If gHemisphere = 0 Then
If targetRAEncoder < gRA_Limit_East Or targetRAEncoder > gRA_Limit_West Then
' target position is outside limits
gCWUP = False
End If
Else
If targetRAEncoder > gRA_Limit_East Or targetRAEncoder < gRA_Limit_West Then
' target position is outside limits
gCWUP = False
End If
End If
' if target position is outside limits
If gCWUP = False Then
HC.Add_Message "Goto: RA Limits prevent CW-UP slew"
'then abandon Counter Weights up Slew and recalculate for a standard slew.
If tha < 0 Then
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(gTargetRA - 12)
Else
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
tRa = gTargetRA
End If
targetRAEncoder = Get_RAEncoderfromRA(tRa, 0, gLongitude, gRAEncoder_Zero_pos, gTot_RA, gHemisphere)
targetDECEncoder = Get_DECEncoderfromDEC(gTargetDec, tPier, gDECEncoder_Zero_pos, gTot_DEC, gHemisphere)
End If
End If
End If
If gThreeStarEnable = False Then
gSelectStar = 0
currentRAEncoder = Delta_RA_Map(currentRAEncoder)
currentDECEncoder = Delta_DEC_Map(currentDECEncoder)
Else
' Transform target using model
Select Case gAlignmentMode
Case 2
' n-star+nearest
tmpcoord = DeltaSyncReverse_Matrix_Map(targetRAEncoder - gRASync01, targetDECEncoder - gDECSync01)
Case 1
' n-star
tmpcoord = Delta_Matrix_Map(targetRAEncoder - gRASync01, targetDECEncoder - gDECSync01)
Case Else
' nearest
tmpcoord = Delta_Matrix_Map(targetRAEncoder - gRASync01, targetDECEncoder - gDECSync01)
If tmpcoord.F = 0 Then
tmpcoord = DeltaSyncReverse_Matrix_Map(targetRAEncoder - gRASync01, targetDECEncoder - gDECSync01)
End If
End Select
targetRAEncoder = tmpcoord.x
targetDECEncoder = tmpcoord.Y
End If
'Execute the actual slew
gGotoParams.RA_targetencoder = targetRAEncoder
gGotoParams.RA_currentencoder = currentRAEncoder
gGotoParams.DEC_targetencoder = targetDECEncoder
gGotoParams.DEC_currentencoder = currentDECEncoder
HC.Add_Message "Goto: " & FmtSexa(gTargetRA, False) & " " & FmtSexa(gTargetDec, True)
' HC.Add_Message "Goto: RaEnc=" & CStr(currentRAEncoder) & " Target=" & CStr(targetRAEncoder)
' HC.Add_Message "Goto: DecEnc=" & CStr(currentDECEncoder) & " Target=" & CStr(targetDECEncoder)
endradecslew:
End Sub
Public Sub CalcEncoderGotoTargets(ByVal tRa As Double, ByVal tDec As Double, ByRef RaEnc As Double, ByRef DecEnc As Double)
Dim tmpcoord As Coordt
Dim tha As Double
Dim tPier As Double
tha = RangeHA(tRa - EQnow_lst(gLongitude * DEG_RAD))
If tha < 0 Then
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
tRa = Range24(tRa - 12)
Else
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
End If
'Compute for Target RA/DEC Encoder
RaEnc = Get_RAEncoderfromRA(tRa, 0, gLongitude, gRAEncoder_Zero_pos, gTot_RA, gHemisphere)
DecEnc = Get_DECEncoderfromDEC(tDec, tPier, gDECEncoder_Zero_pos, gTot_DEC, gHemisphere)
If gThreeStarEnable = True Then
' Transform target using model
Select Case gAlignmentMode
Case 2
' n-star+nearest
tmpcoord = DeltaSyncReverse_Matrix_Map(RaEnc - gRASync01, DecEnc - gDECSync01)
Case 1
' n-star
tmpcoord = Delta_Matrix_Map(RaEnc - gRASync01, DecEnc - gDECSync01)
Case Else
' nearest
tmpcoord = Delta_Matrix_Map(RaEnc - gRASync01, DecEnc - gDECSync01)
If tmpcoord.F = 0 Then
tmpcoord = DeltaSyncReverse_Matrix_Map(RaEnc - gRASync01, DecEnc - gDECSync01)
End If
End Select
RaEnc = tmpcoord.x
DecEnc = tmpcoord.Y
End If
End Sub
Public Sub StartSlew(ByVal targetRAEncoder As Double, ByVal targetDECEncoder As Double, ByVal currentRAEncoder As Double, ByVal currentDECEncoder As Double)
Dim DeltaRAStep As Long
Dim DeltaDECStep As Long
On Error GoTo endradecslew
' calculate relative amount to move
DeltaRAStep = Abs(targetRAEncoder - currentRAEncoder)
DeltaDECStep = Abs(targetDECEncoder - currentDECEncoder)
If DeltaRAStep <> 0 Then
' Compensate for the smallest discrepancy after the final slew
If gTrackingStatus > 0 Then
If targetRAEncoder > currentRAEncoder Then
If gHemisphere = 0 Then
DeltaRAStep = DeltaRAStep + gRA_Compensate
Else
DeltaRAStep = DeltaRAStep - gRA_Compensate
End If
Else
If gHemisphere = 0 Then
DeltaRAStep = DeltaRAStep - gRA_Compensate
Else
DeltaRAStep = DeltaRAStep + gRA_Compensate
End If
End If
If DeltaRAStep < 0 Then DeltaRAStep = 0
End If
If targetRAEncoder > currentRAEncoder Then
gGotoParams.RA_Direction = 0
Select Case gGotoParams.rate
Case 0
' let mount decide on slew rate
gGotoParams.RA_SlewActive = 0
eqres = EQStartMoveMotor(0, 0, 0, DeltaRAStep, GetSlowdown(DeltaRAStep))
Case Else
gGotoParams.RA_SlewActive = 1
eqres = EQ_Slew(0, 0, 0, CLng(gGotoParams.rate))
End Select
Else
gGotoParams.RA_Direction = 1
Select Case gGotoParams.rate
Case 0
gGotoParams.RA_SlewActive = 0
eqres = EQStartMoveMotor(0, 0, 1, DeltaRAStep, GetSlowdown(DeltaRAStep))
Case Else
gGotoParams.RA_SlewActive = 1
eqres = EQ_Slew(0, 0, 1, CLng(gGotoParams.rate))
End Select
End If
End If
If DeltaDECStep <> 0 Then
If targetDECEncoder > currentDECEncoder Then
gGotoParams.DEC_Direction = 0
Select Case gGotoParams.rate
Case 0
' let mount decide on slew rate
gGotoParams.DEC_SlewActive = 0
eqres = EQStartMoveMotor(1, 0, 0, DeltaDECStep, GetSlowdown(DeltaDECStep))
Case Else
gGotoParams.DEC_SlewActive = 1
eqres = EQ_Slew(1, 0, 0, CLng(gGotoParams.rate))
End Select
Else
gGotoParams.DEC_Direction = 1
Select Case gGotoParams.rate
Case 0
' let mount decide on slew rate
gGotoParams.DEC_SlewActive = 0
eqres = EQStartMoveMotor(1, 0, 1, DeltaDECStep, GetSlowdown(DeltaDECStep))
Case Else
gGotoParams.DEC_SlewActive = 1
eqres = EQ_Slew(1, 0, 1, CLng(gGotoParams.rate))
End Select
End If
End If
' Activate Asynchronous Slew Monitoring Routine
gRAStatus = EQ_MOTORBUSY
gDECStatus = EQ_MOTORBUSY
gRAStatus_slew = False
endradecslew:
gSlewStatus = True
End Sub
' called from the encoder timer to supervise active gotos
Public Sub ManageGoto()
Dim tRa As Double
Dim tha As Double
Dim ra_diff As Double
Dim dec_diff As Double
''''''''''''''''''''''''''''''''''''''''''''''
' Fixed rate slew
''''''''''''''''''''''''''''''''''''''''''''''
If gGotoParams.RA_SlewActive = 1 Or gGotoParams.DEC_SlewActive = 1 Then
' Handle as fixed rate slew
If gGotoParams.RA_SlewActive Then
If gGotoParams.RA_Direction = 0 Then
If gRA_Encoder >= gGotoParams.RA_targetencoder Then
eqres = EQ_MotorStop(0)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo MG1
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'MG1:
gGotoParams.RA_SlewActive = 0
eqres = EQ_StartRATrack(0, gHemisphere, gHemisphere)
End If
Else
If gRA_Encoder <= gGotoParams.RA_targetencoder Then
eqres = EQ_MotorStop(0)
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo MG2
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'MG2:
gGotoParams.RA_SlewActive = 0
eqres = EQ_StartRATrack(0, gHemisphere, gHemisphere)
End If
End If
End If
If gGotoParams.DEC_SlewActive Then
If gGotoParams.DEC_Direction = 0 Then
If gDec_Encoder >= gGotoParams.DEC_targetencoder Then
eqres = EQ_MotorStop(1)
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo MG3
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'MG3:
gGotoParams.DEC_SlewActive = 0
End If
Else
If gDec_Encoder <= gGotoParams.DEC_targetencoder Then
eqres = EQ_MotorStop(1)
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then GoTo MG4
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'MG4:
gGotoParams.DEC_SlewActive = 0
End If
End If
End If
If gGotoParams.RA_SlewActive = 0 And gGotoParams.DEC_SlewActive = 0 Then
Select Case gGotoParams.SuperSafeMode
Case 0
' rough fixed rate slew complete
Call CalcEncoderTargets
ra_diff = Abs(gGotoParams.RA_targetencoder - gRA_Encoder)
dec_diff = Abs(gGotoParams.DEC_targetencoder - gDec_Encoder)
HC.Add_Message "Goto: FRSlew complete ra_diff=" & CStr(ra_diff) & " dec_diff=" & CStr(dec_diff)
If (ra_diff < gTot_RA / 360) And (dec_diff < gTot_DEC / 540) Then
' initiate a standard itterative goto if within a 3/4 of a degree.
gGotoParams.rate = 0
Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
Else
' Do another rough slew.
HC.Add_Message "Goto: FRSlew"
gFRSlewCount = gFRSlewCount + 1
If gFRSlewCount >= 5 Then
'if we can't get close after 5 attempts then abandon the FR slew
'and use the full speed iterative slew
gFRSlewCount = 0
gGotoParams.rate = 0
End If
Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
End If
Case 1
' move to RA target
Call CalcEncoderTargets
gGotoParams.SuperSafeMode = 0
Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
' Case 2
' ' we're at a limit about to go to target
' Call CalcEncoderTargets
' gGotoParams.SuperSafeMode = 0
' Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
Case 3
' were at a limit position
If gGotoParams.RA_targetencoder > RAEncoder_Home_pos Then
' dual axis slew to limit position nearest to target
gGotoParams.SuperSafeMode = 1
If RALimitsActive() = False Then
Call StartSlew(gRAMeridianWest, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
Else
Call StartSlew(gRA_Limit_West, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
End If
Else
' dual axis slew to limit position nearest to target
gGotoParams.SuperSafeMode = 1
If RALimitsActive() = False Then
Call StartSlew(gRAMeridianEast, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
Else
Call StartSlew(gRA_Limit_East, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
End If
End If
End Select
End If
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''
' Iterative slew - variable rate
''''''''''''''''''''''''''''''''''''''''''''''
If (gRAStatus And EQ_MOTORBUSY) = 0 Then
'At This point RA motor has completed the slew
gRAStatus_slew = True
If (gDECStatus And EQ_MOTORBUSY) <> 0 Then
' The DEC motor is still moving so start sidereal tracking to hold position in RA
eqres = EQ_StartRATrack(0, gHemisphere, gHemisphere)
End If
End If
If (gDECStatus And EQ_MOTORBUSY) = 0 And gRAStatus_slew Then
'DEC and RA motors have finished slewing at this point
'We need to check if a new slew is needed to reduce the any difference
'Caused by the Movement of the earth during the slew process
Select Case gGotoParams.SuperSafeMode
Case 0
' decrement the slew retry count
gSlewCount = gSlewCount - 1
' calculate the difference (arcsec) between target and current coords
ra_diff = 3600 * Abs(gRA - gTargetRA)
dec_diff = 3600 * Abs(gDec - gTargetDec)
If (gSlewCount > 0) And (gTrackingStatus > 0) Then ' Retry only if tracking is enabled
' aim to get within the goto resolution (default = 10 steps)
If gGotoResolution > 0 And ra_diff <= gRAGotoRes And dec_diff <= gDECGotoRes Then
GoTo slewcomplete
Else
'Re Execute a new RA-Only slew here
Call CalcEncoderTargets
gGotoParams.rate = 0
Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
End If
Else
GoTo slewcomplete
End If
Case 1
' move to target
gGotoParams.SuperSafeMode = 0
Call CalcEncoderTargets
gGotoParams.rate = 0
'kick of an iterative slew to get us accurately to target RA
Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gGotoParams.RA_currentencoder, gGotoParams.DEC_currentencoder)
' Case 2
' ' At a limit about to slew to target
' Call CalcEncoderTargets
' gGotoParams.SuperSafeMode = 0
' Call StartSlew(gGotoParams.RA_targetencoder, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
Case 3
' we are at a limit position
If gGotoParams.RA_targetencoder > RAEncoder_Home_pos Then
' dual axis slew to limit position nearest to target
gGotoParams.SuperSafeMode = 1
If RALimitsActive() = False Then
Call StartSlew(gRAMeridianWest, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
Else
Call StartSlew(gRA_Limit_West, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
End If
Else
' dual axis slew to limit position nearest to target
gGotoParams.SuperSafeMode = 1
If RALimitsActive() = False Then
Call StartSlew(gRAMeridianEast, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
Else
Call StartSlew(gRA_Limit_West, gGotoParams.DEC_targetencoder, gEmulRA, gEmulDEC)
End If
End If
End Select
End If
Exit Sub
slewcomplete:
gSlewStatus = False
gRAStatus_slew = False
gSupressHorizonLimits = False
' slew may have terminated early if parked
If gEQparkstatus <> 1 Then
' we've reached the desired target coords - resume tracking.
Select Case gTrackingStatus
Case 0, 1
EQStartSidereal
Case 2, 3, 4
RestartTracking
End Select
HC.Add_Message (oLangDll.GetLangString(5018) & " " & FmtSexa(gRA, False) & " " & FmtSexa(gDec, True))
HC.Add_Message ("Goto: SlewItereations=" & CStr(gMaxSlewCount - gSlewCount))
HC.Add_Message ("Goto: " & "RaDiff=" & Format$(str(ra_diff), "000.00") & " DecDiff=" & Format$(str(dec_diff), "000.00"))
' goto complete
Call EQ_Beep(6)
End If
If gDisbleFlipGotoReset = 0 Then
HC.ChkForceFlip.value = 0
End If
End Sub
Public Sub writeGotoRate()
HC.oPersist.WriteIniValue "GOTO_RATE", CStr(gGotoRate)
End Sub
Public Sub readGotoRate()
Dim tmptxt As String
On Error Resume Next
tmptxt = HC.oPersist.ReadIniValue("GOTO_RATE")
If tmptxt <> "" Then
gGotoRate = val(tmptxt)
Else
gGotoRate = 0
Call writeCustomRa
End If
' gGotoRate = 0
If gGotoRate = 0 Then
HC.HScrollSlewLimit.value = HC.HScrollSlewLimit.min
Else
HC.HScrollSlewLimit.value = gGotoRate
End If
gParkParams.rate = gGotoRate
End Sub
Public Sub readFlipGoto()
Dim tmptxt As String
On Error Resume Next
tmptxt = HC.oPersist.ReadIniValue("DISABLE_FLIPGOTO_RESET")
If tmptxt <> "" Then
gDisbleFlipGotoReset = val(tmptxt)
Else
HC.oPersist.WriteIniValue "DISABLE_FLIPGOTO_RESET", "0"
gDisbleFlipGotoReset = 0
End If
End Sub
' at 4793 Done code part. Lines - 1 Analysing tracking.basError parsing line 'Attribute VB_Name = "Tracking"
Option Explicit
Public gCustomTrackingOffsetRA As Integer
Public gCustomTrackingOffsetDEC As Integer
Public gTrackFactorRA As Double
Public gTrackFactorDEC As Double
Public g_RAAxisRates As Rates ' rates available for MoveAxis
Public g_DECAxisRates As Rates ' rates available for MoveAxis
Public g_TrackingRates As TrackingRates ' Collection of supported drive rates
Public gCustomTrackFile As String
Public gCustomTrackName As String
Public gMoveAxisRASlew As Boolean
Public gMoveAxisDECSlew As Boolean
Public gMoveAxisSlewing As Boolean
Type TrackRecord_def
time_mjd As Double
DeltaRa As Double
DeltaDec As Double
RaRate As Double
DecRate As Double
DecDir As Integer
RAJ2000 As Double
DECJ2000 As Double
RaRateRaw As Double
DECRateRaw As Double
UseRate As Boolean
End Type
' main control structure for custom tracking
Type TrackCtrl_def
FileFormat As Integer
Precess As Boolean
Waypoint As Boolean
AdjustRA As Double
AdjustDEC As Double
TrackIdx As Integer
TrackingChangesEnabled As Boolean
TrackSchedule() As TrackRecord_def
End Type
Type RaDecCoords
RA As Double
DEC As Double
End Type
Dim TrackCtrl As TrackCtrl_def
' Start RA motor based on an input rate of arcsec per Second
Public Sub StartRA_by_Rate(ByVal RA_RATE As Double)
Dim i As Double
Dim j As Double
Dim k As Double
Dim m As Double
k = 0
m = 1
i = Abs(RA_RATE)
If gMount_Ver > &H301 Then
If i > 1000 Then
k = 1
m = EQGP(0, 10003)
End If
Else
If i > 3000 Then
k = 1
m = EQGP(0, 10003)
End If
End If
HC.Add_Message (oLangDll.GetLangString(117) & " " & str(m) & " , " & str(RA_RATE) & " arcsec/sec")
eqres = EQ_MotorStop(0) ' Stop RA Motor
If eqres <> EQ_OK Then
GoTo RARateEndhome1
End If
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' GoTo RARateEndhome1
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
If RA_RATE = 0 Then
gSlewStatus = False
gRAStatus_slew = False
eqres = EQ_MotorStop(0)
gRAMoveAxis_Rate = 0
Exit Sub
End If
i = RA_RATE
j = Abs(i) 'Get the absolute value for parameter passing
If gMount_Ver = &H301 Then
If (j > 1350) And (j <= 3000) Then
If j < 2175 Then
j = 1350
Else
j = 3001
k = 1
m = EQGP(0, 10003)
End If
End If
End If
gRAMoveAxis_Rate = k 'Save Speed Settings
HC.Add_FileMessage ("StartRARate=" & FormatNumber(RA_RATE, 5))
' j = Int((m * 9325.46154 / j) + 0.5) + 30000 'Compute for the rate
j = Int((m * gTrackFactorRA / j) + 0.5) + 30000 'Compute for the rate
If i >= 0 Then
eqres = EQ_SetCustomTrackRate(0, 1, j, k, gHemisphere, 0)
Else
eqres = EQ_SetCustomTrackRate(0, 1, j, k, gHemisphere, 1)
End If
RARateEndhome1:
End Sub
' Change RA motor rate based on an input rate of arcsec per Second
Public Sub ChangeRA_by_Rate(ByVal rate As Double)
Dim j As Double
Dim k As Double
Dim m As Double
Dim dir As Long
Dim init As Long
If rate >= 0 Then
dir = 0
Else
dir = 1
End If
If rate = 0 Then
' rate = 0 so stop motors
gSlewStatus = False
eqres = EQ_MotorStop(0)
gRAStatus_slew = False
gRAMoveAxis_Rate = 0
Exit Sub
End If
k = 0 ' Assume low speed
m = 1 ' Speed multiplier = 1
init = 0
j = Abs(rate)
If gMount_Ver > &H301 Then
' if above high speed theshold
If j > 1000 Then
k = 1 ' HIGH SPEED
m = EQGP(0, 10003) ' GET HIGH SPEED MULTIPLIER
End If
Else
' who knows what Mon is up to here - a special for his mount perhaps?
If gMount_Ver = &H301 Then
If (j > 1350) And (j <= 3000) Then
If j < 2175 Then
j = 1350
Else
j = 3001
k = 1
m = EQGP(0, 10003)
End If
End If
End If
' if above high speed theshold
If j > 3000 Then
k = 1 ' HIGH SPEED
m = EQGP(0, 10003) ' GET HIGH SPEED MULTIPLIER
End If
End If
HC.Add_FileMessage ("ChangeRARate=" & FormatNumber(rate, 5))
' if there's a switch between high/low speed or if operating at high speed
' we ned to do additional initialisation
If k <> 0 Or k <> gRAMoveAxis_Rate Then init = 1
If init = 1 Then
' Stop Motor
HC.Add_FileMessage ("Direction or High/Low speed change")
eqres = EQ_MotorStop(0)
If eqres <> EQ_OK Then GoTo RARateEndhome2
' ' wait for motor to stop
' Do
' eqres = EQ_GetMotorStatus(0)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' GoTo RARateEndhome2
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'force initialisation
End If
gRAMoveAxis_Rate = k
'Compute for the rate
' j = Int((m * 9325.46154 / j) + 0.5) + 30000
j = Int((m * gTrackFactorRA / j) + 0.5) + 30000
eqres = EQ_SetCustomTrackRate(0, init, j, k, gHemisphere, dir)
HC.Add_FileMessage ("EQ_SetCustomTrackRate=0," & CStr(init) & "," & CStr(j) & "," & CStr(k) & "," & CStr(gHemisphere) & "," & CStr(dir))
HC.Add_Message (oLangDll.GetLangString(117) & "=" & str(rate) & " arcsec/sec" & "," & CStr(eqres))
RARateEndhome2:
End Sub
' Start DEC motor based on an input rate of arcsec per Second
Public Sub StartDEC_by_Rate(ByVal DEC_RATE As Double)
Dim i As Double
Dim j As Double
Dim k As Double
Dim m As Double
k = 0
m = 1
i = Abs(DEC_RATE)
If gMount_Ver > &H301 Then
If i > 1000 Then
k = 1
m = EQGP(1, 10003)
End If
Else
If i > 3000 Then
k = 1
m = EQGP(1, 10003)
End If
End If
HC.Add_Message (oLangDll.GetLangString(118) & " " & str(m) & " , " & str(DEC_RATE) & " arcsec/sec")
eqres = EQ_MotorStop(1) ' Stop RA Motor
If eqres <> EQ_OK Then
GoTo DECRateEndhome1
End If
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' GoTo DECRateEndhome1
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
If DEC_RATE = 0 Then
gSlewStatus = False
gRAStatus_slew = False
eqres = EQ_MotorStop(1)
gDECMoveAxis_Rate = 0
Exit Sub
End If
i = DEC_RATE
j = Abs(i) 'Get the absolute value for parameter passing
If gMount_Ver = &H301 Then
If (j > 1350) And (j <= 3000) Then
If j < 2175 Then
j = 1350
Else
j = 3001
k = 1
m = EQGP(1, 10003)
End If
End If
End If
gDECMoveAxis_Rate = k 'Save Speed Settings
HC.Add_FileMessage ("StartDecRate=" & FormatNumber(DEC_RATE, 5))
' j = Int((m * 9325.46154 / j) + 0.5) + 30000 'Compute for the rate
j = Int((m * gTrackFactorDEC / j) + 0.5) + 30000 'Compute for the rate
If i >= 0 Then
eqres = EQ_SetCustomTrackRate(1, 1, j, k, gHemisphere, 0)
Else
eqres = EQ_SetCustomTrackRate(1, 1, j, k, gHemisphere, 1)
End If
DECRateEndhome1:
End Sub
' Change DEC motor rate based on an input rate of arcsec per Second
Public Sub ChangeDEC_by_Rate(ByVal rate As Double)
Dim j As Double
Dim k As Double
Dim m As Double
Dim dir As Long
Dim init As Long
If rate >= 0 Then
dir = 0
Else
dir = 1
End If
If rate = 0 Then
' rate = 0 so stop motors
gSlewStatus = False
eqres = EQ_MotorStop(1)
' gRAStatus_slew = False
gDECMoveAxis_Rate = 0
Exit Sub
End If
k = 0 ' Assume low speed
m = 1 ' Speed multiplier = 1
init = 0
j = Abs(rate)
If gMount_Ver > &H301 Then
' if above high speed theshold
If j > 1000 Then
k = 1 ' HIGH SPEED
m = EQGP(1, 10003) ' GET HIGH SPEED MULTIPLIER
End If
Else
' who knows what Mon is up to here - a special for his mount perhaps?
If gMount_Ver = &H301 Then
If (j > 1350) And (j <= 3000) Then
If j < 2175 Then
j = 1350
Else
j = 3001
k = 1
m = EQGP(1, 10003)
End If
End If
End If
' if above high speed theshold
If j > 3000 Then
k = 1 ' HIGH SPEED
m = EQGP(1, 10003) ' GET HIGH SPEED MULTIPLIER
End If
End If
HC.Add_FileMessage ("ChangeDECRate=" & FormatNumber(rate, 5))
' if there's a switch between high/low speed or if operating at high speed
' we need to do additional initialisation
If k <> 0 Or k <> gDECMoveAxis_Rate Then init = 1
If init = 1 Then
' Stop Motor
HC.Add_FileMessage ("Direction or High/Low speed change")
eqres = EQ_MotorStop(1)
If eqres <> EQ_OK Then GoTo DECRateEndhome2
' ' wait for motor to stop
' Do
' eqres = EQ_GetMotorStatus(1)
' If (eqres = EQ_NOTINITIALIZED) Or (eqres = EQ_COMNOTOPEN) Or (eqres = EQ_COMTIMEOUT) Then
' GoTo DECRateEndhome2
' End If
' Loop While (eqres And EQ_MOTORBUSY) <> 0
'force initialisation
End If
gDECMoveAxis_Rate = k
'Compute for the rate
j = Int((m * gTrackFactorDEC / j) + 0.5) + 30000
' j = Int((m * 9325.46154 / j) + 0.5) + 30000
eqres = EQ_SetCustomTrackRate(1, init, j, k, gHemisphere, dir)
HC.Add_FileMessage ("EQ_SetCustomTrackRate=1," & CStr(init) & "," & CStr(j) & "," & CStr(k) & "," & CStr(gHemisphere) & "," & CStr(dir))
HC.Add_Message (oLangDll.GetLangString(118) & "=" & str(rate) & " arcsec/sec" & "," & CStr(eqres))
DECRateEndhome2:
End Sub
Public Sub EQMoveAxis(axis As Double, rate As Double)
Dim j As Double
Dim current_rate As Double
If rate <> 0 Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(189)
End If
j = rate * 3600 ' Convert to Arcseconds
If axis = 0 Then
If rate = 0 And (gDeclinationRate = 0) Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
End If
If gHemisphere = 1 Then
j = -1 * j
current_rate = gRightAscensionRate * -1
Else
current_rate = gRightAscensionRate
End If
' check for change of direction
If (current_rate * j) <= 0 Then
Call StartRA_by_Rate(j)
Else
Call ChangeRA_by_Rate(j)
End If
gRightAscensionRate = j
If rate = 0 Then
gMoveAxisRASlew = False
Else
gTrackingStatus = 4
gMoveAxisRASlew = True
End If
End If
If axis = 1 Then
If rate = 0 And (gRightAscensionRate = 0) Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
End If
' Mon seems to have included the code below for the Move South/Move North requirements of satelite tracking
' However ASCOM requires that a positive rate always moces the axis clockwise so this code is well iffy!
' j = j * -1
'
' If gHemisphere = 0 Then
' If (gDec_DegNoAdjust > 90) And (gDec_DegNoAdjust <= 270) Then j = j * -1
' Else
' If (gDec_DegNoAdjust <= 90) Or (gDec_DegNoAdjust > 270) Then j = j * -1
' End If
' check for change of direction
If (gDeclinationRate * j) <= 0 Then
Call StartDEC_by_Rate(j)
Else
Call ChangeDEC_by_Rate(j)
End If
gDeclinationRate = j
If rate = 0 Then
gMoveAxisDECSlew = False
Else
gTrackingStatus = 4
gMoveAxisDECSlew = True
End If
End If
gMoveAxisSlewing = False
If gMoveAxisDECSlew Or gMoveAxisRASlew Then
gMoveAxisSlewing = True
End If
End Sub
Public Sub CustomMoveAxis(axis As Double, rate As Double, init As Boolean, RateName As String)
Dim j As Double
If rate <> 0 Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & RateName
End If
j = rate
If axis = 0 Then
If rate = 0 And (gDeclinationRate = 0) Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
End If
If init = True Then
Call StartRA_by_Rate(j)
Else
If j <> gRightAscensionRate Then
Call ChangeRA_by_Rate(j)
End If
End If
gRightAscensionRate = j
gTrackingStatus = 4
End If
If axis = 1 Then
If rate = 0 And (gRightAscensionRate = 0) Then
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(178)
End If
If init = True Then
Call StartDEC_by_Rate(j)
Else
If j <> gDeclinationRate Then
Call ChangeDEC_by_Rate(j)
End If
End If
gDeclinationRate = j
gTrackingStatus = 4
End If
End Sub
Public Sub Start_CustomTracking2()
If gEQparkstatus <> 0 Then
HC.Add_Message (oLangDll.GetLangString(5013))
Exit Sub
End If
gRA_LastRate = 0
If gPEC_Enabled Then
PEC_StopTracking
End If
EQ_Beep (13)
Call Start_CustomTracking
End Sub
Public Sub Start_CustomTracking()
Dim i As Double
Dim j As Double
On Error GoTo handlerr
If gCustomTrackFile = "" Then
TrackCtrl.TrackingChangesEnabled = False
i = CDbl(HC.raCustom)
j = CDbl(HC.decCustom)
If gHemisphere = 1 Then
i = -1 * i
End If
If (Abs(i) > 12000) Or (Abs(j) > 12000) Then
GoTo handlerr
End If
HC.Add_Message (oLangDll.GetLangString(5040) & Format$(str(i), "000.00") & " DEC:" & Format$(str(j), "000.00") & " arcsec/sec")
Call CustomMoveAxis(0, i, True, oLangDll.GetLangString(189))
Call CustomMoveAxis(1, j, True, oLangDll.GetLangString(189))
Else
' custom track file is assigned
TrackCtrl.TrackIdx = GetTrackFileIdx(1, True)
If TrackCtrl.TrackIdx <> -1 Then
If TrackCtrl.Waypoint Then
Call GetTrackTarget(i, j)
TrackCtrl.AdjustRA = gRA - i
TrackCtrl.AdjustDEC = gDec - j
Else
TrackCtrl.AdjustRA = 0
TrackCtrl.AdjustDEC = 0
End If
i = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).RaRate
j = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).DecRate
HC.decCustom.Text = FormatNumber(j, 5)
If gHemisphere = 1 Then
HC.raCustom.Text = FormatNumber(-1 * i, 5)
Else
HC.raCustom.Text = FormatNumber(i, 5)
End If
Call CustomMoveAxis(0, i, True, gCustomTrackName)
Call CustomMoveAxis(1, j, True, gCustomTrackName)
Else
End If
TrackCtrl.TrackingChangesEnabled = True
HC.CustomTrackTimer.Enabled = True
End If
Exit Sub
handlerr:
' HC.Add_Message (oLangDll.GetLangString(5039))
Call emergency_stop
End Sub
Public Sub Restore_CustomTracking()
Dim rate As Double
Dim RA As Double
Dim DEC As Double
If gTrackingStatus = 4 Then
If gCustomTrackFile = "" Then
TrackCtrl.TrackingChangesEnabled = False
Call CustomMoveAxis(0, gRightAscensionRate, True, oLangDll.GetLangString(189))
Call CustomMoveAxis(1, gDeclinationRate, True, oLangDll.GetLangString(189))
Else
TrackCtrl.TrackIdx = GetTrackFileIdx(1, False)
If TrackCtrl.TrackIdx <> -1 Then
If TrackCtrl.Waypoint Then
Call GetTrackTarget(RA, DEC)
TrackCtrl.AdjustRA = gRA - RA
TrackCtrl.AdjustDEC = gDec - DEC
Else
TrackCtrl.AdjustRA = 0
TrackCtrl.AdjustDEC = 0
End If
rate = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).RaRate
If gHemisphere = 1 Then
HC.raCustom.Text = FormatNumber(-1 * rate, 5)
Else
HC.raCustom.Text = FormatNumber(rate, 5)
End If
Call CustomMoveAxis(0, rate, True, gCustomTrackName)
rate = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).DecRate
HC.decCustom.Text = FormatNumber(rate, 5)
Call CustomMoveAxis(1, rate, True, gCustomTrackName)
Else
Call CustomMoveAxis(0, gRightAscensionRate, True, oLangDll.GetLangString(189))
Call CustomMoveAxis(1, gDeclinationRate, True, oLangDll.GetLangString(189))
HC.raCustom.Text = FormatNumber(gRightAscensionRate, 5)
HC.decCustom.Text = FormatNumber(gDeclinationRate, 5)
End If
TrackCtrl.TrackingChangesEnabled = True
End If
End If
End Sub
Public Sub EQStartSidereal2()
If gEQparkstatus <> 0 Then
' no tracking if parked!
HC.Add_Message (oLangDll.GetLangString(5013))
Else
Call EQStartSidereal
EQ_Beep (10)
End If
End Sub
Public Sub EQStartSidereal()
gRA_LastRate = 0
If gEQparkstatus <> 0 Then
' no tracking if parked!
HC.Add_Message (oLangDll.GetLangString(5013))
Else
' Stop DEC motor
eqres = EQ_MotorStop(1)
gDeclinationRate = 0
' start RA motor at sidereal
eqres = EQ_StartRATrack(0, gHemisphere, gHemisphere)
gRAMoveAxis_Rate = 0
gTrackingStatus = 1
gRightAscensionRate = SID_RATE
If HC.CheckPEC.Value = 1 Then
' track using PEC
PEC_StartTracking
Else
' Set Caption
HC.TrackingFrame.Caption = oLangDll.GetLangString(121) & " " & oLangDll.GetLangString(122)
HC.Add_Message (oLangDll.GetLangString(5014))
End If
End If
End Sub
Public Sub StopTrackingUpdates()
Select Case gTrackingStatus
Case 1
Call PEC_StopTracking
Case 2
Case 3
Case 4
TrackCtrl.TrackingChangesEnabled = False
Case Else
End Select
End Sub
Public Sub RestartTracking()
gRAMoveAxis_Rate = 0
Select Case gTrackingStatus
Case 1
EQStartSidereal
Case 2
Start_Lunar (1)
Case 3
Call Start_Solar(1)
Case 4
Call Restore_CustomTracking
Case Else
' not tracking
' eqres = EQ_MotorStop(0)
' eqres = EQ_MotorStop(1)
eqres = EQ_MotorStop(2)
End Select
End Sub
Public Sub writeCustomRa()
HC.oPersist.WriteIniValue "CUSTOM_RA", HC.raCustom.Text
HC.oPersist.WriteIniValue "CUSTOM_DEC", HC.decCustom.Text
HC.oPersist.WriteIniValue "CUSTOM_TRACKFILE", HC.LabelTrackFile.ToolTipText
End Sub
Public Sub readCustomRa()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_RA")
If tmptxt <> "" Then
HC.raCustom.Text = tmptxt
Else
HC.raCustom.Text = CStr(15.041067)
Call writeCustomRa
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_DEC")
If tmptxt <> "" Then
HC.decCustom.Text = tmptxt
Else
HC.decCustom.Text = "0"
Call writeCustomRa
End If
' reload custom track file
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_TRACKFILE")
If tmptxt <> "" Then
If Track_LoadFile(tmptxt) = True Then
gCustomTrackFile = tmptxt
HC.LabelTrackFile.Caption = StripPath(gCustomTrackFile)
HC.LabelTrackFile.ToolTipText = gCustomTrackFile
HC.CmdTrack(4).ToolTipText = gCustomTrackName
' check data is current
TrackCtrl.TrackIdx = GetTrackFileIdx(1, True)
Else
gCustomTrackFile = ""
HC.LabelTrackFile.Caption = ""
HC.LabelTrackFile.ToolTipText = ""
HC.CmdTrack(4).ToolTipText = oLangDll.GetLangString(189)
Call writeCustomRa
End If
Else
gCustomTrackFile = ""
HC.LabelTrackFile.Caption = ""
HC.LabelTrackFile.ToolTipText = ""
End If
If gCustomTrackFile <> "" Then
HC.CmdTrack(4).Picture = LoadResPicture(111, vbResBitmap)
Else
HC.CmdTrack(4).Picture = LoadResPicture(110, vbResBitmap)
End If
End Sub
Public Sub readSiderealRate()
Dim tmptxt As String
On Error GoTo readerr
tmptxt = HC.oPersist.ReadIniValue("SIDEREAL_RATE")
If tmptxt <> "" Then
gSiderealRate = CDbl(tmptxt)
Else
readerr:
gSiderealRate = 15.041067
Call writeSiderealRate
End If
End Sub
Public Sub writeSiderealRate()
HC.oPersist.WriteIniValue "SIDEREAL_RATE", CStr(gSiderealRate)
End Sub
Public Sub LoadTrackingRates()
filedlgcls.filter = "*.txt*"
If gCustomTrackFile <> "" Then
filedlgcls.lastdir = GetPath(gCustomTrackFile)
filedlgcls.notfirst = True
End If
filedlgcls.Show (1)
If filedlgcls.FileName <> "" Then
If Track_LoadFile(filedlgcls.FileName) = True Then
gCustomTrackFile = filedlgcls.FileName
HC.LabelTrackFile.Caption = filedlgcls.filename2
HC.LabelTrackFile.ToolTipText = filedlgcls.FileName
If gCustomTrackName = "" Then
gCustomTrackName = filedlgcls.filename2
End If
HC.CmdTrack(4).ToolTipText = gCustomTrackName
' check data is current
TrackCtrl.TrackIdx = GetTrackFileIdx(1, True)
Else
gCustomTrackFile = ""
HC.LabelTrackFile.Caption = ""
HC.LabelTrackFile.ToolTipText = ""
HC.CmdTrack(4).ToolTipText = oLangDll.GetLangString(189)
End If
End If
If gCustomTrackFile <> "" Then
HC.CmdTrack(4).Picture = LoadResPicture(111, vbResBitmap)
Else
HC.CmdTrack(4).Picture = LoadResPicture(110, vbResBitmap)
HC.CmdTrack(4).ToolTipText = oLangDll.GetLangString(189)
End If
Call writeCustomRa
End Sub
Public Function Track_LoadFile(FileName As String) As Boolean
Dim temp1 As String
Dim temp2() As String
Dim lineno As Integer
Dim idx As Integer
Dim NF1 As Integer
Dim NF2 As Integer
Dim month As Double
Dim year As Double
Dim day As Double
Dim hour As Double
Dim minute As Double
Dim second As Double
Dim RA As Double
Dim DEC As Double
Dim Lastra As Double
Dim Lastdec As Double
Dim mjd As Double
Dim Lastmjd As Double
Dim DecEncoder As Double
Dim LastDecEncoder As Double
Dim LastRaRate As Double
Dim LastDecRate As Double
Dim RaRate As Double
Dim DecRate As Double
Dim deltat As Double
Dim Format As Integer
Dim TrackNew As TrackRecord_def
Dim params() As String
Dim timestr As String
Dim typTime As SYSTEMTIME
Dim mjdNow As Double
On Error GoTo ImportError
Track_LoadFile = False
If FileName = "" Then
GoTo ImportError
End If
NF2 = FreeFile
Close #NF2
temp1 = HC.oPersist.GetIniPath & "\CustomRateDebug.txt"
Open temp1 For Output As #NF2
Print #NF2, "MJD RaDelta RaRate DecDelta DecRate DecDir"
NF1 = FreeFile
Close #NF1
Open FileName For Input As #NF1
lineno = 0
idx = 0
Lastra = 0
Lastdec = 0
Lastmjd = 0
TrackCtrl.FileFormat = 0
TrackCtrl.Precess = True
TrackCtrl.Waypoint = False
ReDim TrackCtrl.TrackSchedule(1)
gCustomTrackName = StripPath(FileName)
While Not EOF(NF1)
Line Input #NF1, temp1
If temp1 <> "" Then
Select Case Left(temp1, 1)
Case "#"
' comment
Case "!"
' parameter
params = Split(temp1, "=")
Select Case params(0)
Case "!Format", "!Format "
Select Case params(1)
Case " MPC", "MPC"
TrackCtrl.FileFormat = 1
Case "MPC2"
TrackCtrl.FileFormat = 2
Case "JPL"
TrackCtrl.FileFormat = 3
Case "JPL2"
TrackCtrl.FileFormat = 4
Case Else
TrackCtrl.FileFormat = 0
End Select
Case "!Name"
gCustomTrackName = params(1)
Case "!Precess"
Select Case params(1)
Case "1"
TrackCtrl.Precess = True
Case "0"
TrackCtrl.Precess = False
Case Else
TrackCtrl.Precess = False
End Select
Case "!Waypoints"
Select Case params(1)
Case "1"
TrackCtrl.Waypoint = True
Case "0"
TrackCtrl.Waypoint = False
Case Else
TrackCtrl.Waypoint = False
End Select
Case "!End"
GoTo ParseEnd
End Select
Case Else
Select Case TrackCtrl.FileFormat
Case 0
Case 1, 2
'mpc
' strip out multiple spaces
Do While (InStr(temp1, " "))
temp1 = Replace(temp1, " ", " ")
Loop
temp2 = Split(temp1, " ")
year = val(temp2(0))
month = val(temp2(1))
day = val(temp2(2))
hour = val(Left(temp2(3), 2))
minute = val(mid(temp2(3), 3, 2))
second = val(mid(temp2(3), 5, 2))
' day = day + (hour * 3600 + minute * 60 + second) / 86400
Call cal_mjd(month, day, year, mjd)
' convert to "julian seconds"
mjd = mjd * 86400 + (hour * 3600 + minute * 60 + second)
' calculates current julian date in seconds
GetSystemTime typTime
day = CDbl(typTime.wDay)
Call cal_mjd(typTime.wMonth, day, typTime.wYear, mjdNow)
mjdNow = mjdNow * 86400 + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond))
If mjd < mjdNow Then
' data is earlier then now so keep line number reset to 0
lineno = 0
End If
' get RA in seconds (of time)
RA = val(temp2(4)) * 3600 + val(temp2(5)) * 60 + val(temp2(6))
' get DEC in seconds (angle)
DEC = val(temp2(7))
If DEC < 0 Then
DEC = DEC * 3600 - val(temp2(8)) * 60 - val(temp2(9))
Else
DEC = DEC * 3600 + val(temp2(8)) * 60 + val(temp2(9))
End If
DecEncoder = EncoderFromDec(DEC / 3600, RA / 3600)
RaRate = val(temp2(15))
DecRate = val(temp2(16))
If lineno > 0 Then
With TrackNew
' DeltaT = (mjd - Lastmjd) * 86400
deltat = (mjd - Lastmjd)
' calc change in RA (seconds of time)
.DeltaRa = RA - Lastra
' calc change in DEC (seconds of angle)
.DeltaDec = DEC - Lastdec
' Establish DEC direction
If DecEncoder > LastDecEncoder Then
.DecDir = 0
Else
.DecDir = 1
End If
.time_mjd = Lastmjd
.RAJ2000 = Lastra
.DECJ2000 = Lastdec
If TrackCtrl.FileFormat = 2 Then
' high precision - calculated
' Convert from seconds to arcseconds
.RaRate = .DeltaRa * 15 / deltat
.DecRate = .DeltaDec / deltat
Else
' lower precision - read rates direct from file
.RaRate = LastRaRate
.DecRate = LastDecRate
End If
.RaRateRaw = .RaRate
.DECRateRaw = .DecRate
' increase in tracking rate will decrease RA
' so need to subtract
.RaRate = SID_RATE - .RaRate
If gHemisphere = 1 Then
' for some reason dll doesn't seem to sort out
' southern hemisphere movement so we must make it negative
.RaRate = .RaRate * -1
End If
.DecRate = Abs(.DecRate)
If .DecDir = 1 Then
.DecRate = -1 * .DecRate
End If
' add new record
ReDim Preserve TrackCtrl.TrackSchedule(lineno)
TrackCtrl.TrackSchedule(lineno) = TrackNew
Print #NF2, CStr(.time_mjd) & " " & FormatNumber(.DeltaRa, 5) & " " & FormatNumber(.RaRate, 5) & " " & FormatNumber(.DeltaDec, 5) & " " & FormatNumber(.DecRate, 5) & " " & FormatNumber(.DecDir, 0)
End With
End If
lineno = lineno + 1
Lastra = RA
Lastdec = DEC
Lastmjd = mjd
LastDecEncoder = DecEncoder
LastRaRate = RaRate
LastDecRate = DecRate
If mjd > (mjdNow + 86400) Then
'we've loaded 24 hours of data - should be enough
'if it isn't then user can always reload when current set runs out
GoTo ParseEnd
End If
Case 3
'JPL
temp1 = Replace(temp1, " ", " ? ")
' strip out multiple spaces
Do While (InStr(temp1, " "))
temp1 = Replace(temp1, " ", " ")
Loop
temp2 = Split(Trim(temp1), " ")
year = val(Left(temp2(0), 4))
Select Case mid(temp2(0), 6, 3)
Case "Jan"
month = 1
Case "Feb"
month = 2
Case "Mar"
month = 3
Case "Apr"
month = 4
Case "May"
month = 5
Case "Jun"
month = 6
Case "Jul"
month = 7
Case "Aug"
month = 8
Case "Sep"
month = 9
Case "Oct"
month = 10
Case "Nov"
month = 11
Case "Dec"
month = 12
End Select
day = val(Right(temp2(0), 2))
Select Case Len(temp2(1))
Case 5
hour = val(Left(temp2(1), 2))
minute = val(mid(temp2(1), 4, 2))
second = 0
Case 8
hour = val(Left(temp2(1), 2))
minute = val(mid(temp2(1), 4, 2))
second = val(Right(temp2(1), 2))
Case 12
hour = val(Left(temp2(1), 2))
minute = val(mid(temp2(1), 4, 2))
second = val(Right(temp2(1), 6))
Case Else
GoTo ImportError
End Select
' day = day + (hour * 3600 + minute * 60 + second) / 86400
Call cal_mjd(month, day, year, mjd)
' convert to "julian seconds"
mjd = mjd * 86400 + (hour * 3600 + minute * 60 + second)
' calculates current julian date in seconds
GetSystemTime typTime
day = CDbl(typTime.wDay)
Call cal_mjd(typTime.wMonth, day, typTime.wYear, mjdNow)
mjdNow = mjdNow * 86400 + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond))
If mjd < mjdNow Then
' data is earlier then now so keep line number reset to 0
lineno = 0
End If
RA = val(temp2(3)) * 3600 + val(temp2(4)) * 60 + val(temp2(5))
DEC = val(temp2(6))
If DEC < 0 Then
DEC = DEC * 3600 - val(temp2(7)) * 60 - val(temp2(8))
Else
DEC = DEC * 3600 + val(temp2(7)) * 60 + val(temp2(8))
End If
DecEncoder = EncoderFromDec(DEC / 3600, RA / 3600)
' ' d(RA*cos(Dec))/dt arcsec/hour
' RaRate = val(temp2(9)) / Cos(RA * DEG_RAD / 3600)
' RaRate = RaRate / 3600
' ' d(DEC)/dt arcsec/hour
' DecRate = val(temp2(10)) / 3600
If lineno > 0 Then
With TrackNew
' DeltaT = (mjd - Lastmjd) * 86400
deltat = (mjd - Lastmjd)
.DeltaRa = RA - Lastra
.DeltaDec = DEC - Lastdec
If DecEncoder > LastDecEncoder Then
.DecDir = 0
Else
.DecDir = 1
End If
.time_mjd = Lastmjd
.RAJ2000 = Lastra
.DECJ2000 = Lastdec
If TrackCtrl.FileFormat = 3 Then
.RaRate = .DeltaRa * 15 / deltat
.DecRate = .DeltaDec / deltat
Else
' .RaRate = LastRaRate
' .DecRate = LastDecRate
End If
.RaRateRaw = .RaRate
.DECRateRaw = .DecRate
' increase in tracking rate will decrease RA
' so need to subtract
.RaRate = SID_RATE - .RaRate
If gHemisphere = 1 Then
' for some reason dll doesn't seem to sort out
' southern hemisphere movement so we must make it negative
.RaRate = .RaRate * -1
End If
.DecRate = Abs(.DecRate)
If .DecDir = 1 Then
.DecRate = -1 * .DecRate
End If
' add new record
ReDim Preserve TrackCtrl.TrackSchedule(lineno)
TrackCtrl.TrackSchedule(lineno) = TrackNew
Print #NF2, CStr(.time_mjd) & " " & FormatNumber(.DeltaRa, 5) & " " & FormatNumber(.RaRate, 5) & " " & FormatNumber(.DeltaDec, 5) & " " & FormatNumber(.DecRate, 5) & " " & FormatNumber(.DecDir, 0)
End With
End If
lineno = lineno + 1
Lastra = RA
Lastdec = DEC
Lastmjd = mjd
LastDecEncoder = DecEncoder
LastRaRate = RaRate
LastDecRate = DecRate
If mjd > (mjdNow + 86400) Then
'we've loaded 24 hours of data - should be enough
'if it isn't then user can always reload when current set runs out
GoTo ParseEnd
End If
End Select
End Select
End If
Wend
ParseEnd:
If lineno >= 2 Then
Track_LoadFile = True
Else
gCustomTrackName = ""
If Format = 0 Then
HC.Add_Message ("Tracking File Error: Missing Header")
Else
HC.Add_Message ("Tracking File Error: Insufficient Data")
End If
End If
Close #NF1
Close #NF2
Exit Function
ImportError:
HC.Add_Message ("Tracking File Error")
Close #NF1
Close #NF2
gCustomTrackName = ""
End Function
Public Sub TrackTimer()
Dim rate As Double
Dim idx As Integer
Dim RA As Double
Dim DEC As Double
If gTrackingStatus = 4 Then
If TrackCtrl.TrackingChangesEnabled = True Then
If TrackCtrl.TrackIdx <> -1 Then
idx = GetTrackFileIdx(TrackCtrl.TrackIdx, False)
If idx <> -1 Then
If idx <> TrackCtrl.TrackIdx Then
TrackCtrl.TrackIdx = idx
rate = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).RaRate
If gHemisphere = 1 Then
HC.raCustom.Text = FormatNumber(-1 * rate, 5)
Else
HC.raCustom.Text = FormatNumber(rate, 5)
End If
If rate <> gRightAscensionRate Then
Call CustomMoveAxis(0, rate, False, gCustomTrackName)
End If
rate = TrackCtrl.TrackSchedule(TrackCtrl.TrackIdx).DecRate
If rate <> gDeclinationRate Then
Call CustomMoveAxis(1, rate, False, gCustomTrackName)
End If
HC.decCustom.Text = FormatNumber(gDeclinationRate, 5)
If TrackCtrl.Waypoint = True Then
' perform waypoint correction
If GetTrackTarget(RA, DEC) = True Then
Call goto_TrackTarget(RA + TrackCtrl.AdjustRA, DEC + TrackCtrl.AdjustDEC, True)
End If
End If
End If
Else
End If
End If
End If
End If
End Sub
Public Function GetTrackFileIdx(StartIdx As Integer, Alert As Boolean) As Integer
Dim i As Integer
Dim typTime As SYSTEMTIME
Dim mjd As Double
Dim day As Double
On Error GoTo HandleError
GetSystemTime typTime
GetTrackFileIdx = -1
day = CDbl(typTime.wDay)
' day = CDbl(typTime.wDay) + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond)) / 86400
Call cal_mjd(typTime.wMonth, day, typTime.wYear, mjd)
' calc elasped 'julian' seconds
mjd = mjd * 86400 + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond))
If StartIdx = 0 Then StartIdx = 1
' search forwards through data
For i = StartIdx To UBound(TrackCtrl.TrackSchedule())
If TrackCtrl.TrackSchedule(i).time_mjd > mjd Then
GetTrackFileIdx = i - 1
Exit Function
End If
Next i
' data set is out of date - try reloading new data set from file
Track_LoadFile (gCustomTrackFile)
' check through all of data
For i = 1 To UBound(TrackCtrl.TrackSchedule())
If TrackCtrl.TrackSchedule(i).time_mjd > mjd Then
GetTrackFileIdx = i - 1
Exit Function
End If
Next i
' file has no useful data - use last rate we know about
GetTrackFileIdx = i - 1
' turn icon red
HC.CmdTrack(4).Picture = LoadResPicture(112, vbResBitmap)
' send out warning message
If Alert Then
HC.Add_Message "Tracking file is out of date!" & vbCrLf & "Using last known rate."
End If
Exit Function
HandleError:
GetTrackFileIdx = -1
HC.CmdTrack(4).Picture = LoadResPicture(112, vbResBitmap)
End Function
Private Function GetPosnIdx(StartIdx As Integer, Alert As Boolean) As Integer
Dim i As Integer
Dim typTime As SYSTEMTIME
Dim mjd As Double
Dim day As Double
On Error GoTo HandleError
GetSystemTime typTime
GetPosnIdx = -1
day = CDbl(typTime.wDay)
' day = CDbl(typTime.wDay) + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond)) / 86400
Call cal_mjd(typTime.wMonth, day, typTime.wYear, mjd)
' calc elasped 'julian' seconds
mjd = mjd * 86400 + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond))
If StartIdx = 0 Then StartIdx = 1
For i = StartIdx To UBound(TrackCtrl.TrackSchedule())
If TrackCtrl.TrackSchedule(i).time_mjd > mjd Then
GetPosnIdx = i - 1
Exit Function
End If
Next i
' data set is out of date - try reloading new data set from file
Track_LoadFile (gCustomTrackFile)
' check through all of data
For i = 1 To UBound(TrackCtrl.TrackSchedule())
If TrackCtrl.TrackSchedule(i).time_mjd > mjd Then
GetPosnIdx = i - 1
Exit Function
End If
Next i
If Alert Then
HC.CmdTrack(4).Picture = LoadResPicture(112, vbResBitmap)
HC.Add_Message "Tracking data is out of date!"
End If
Exit Function
HandleError:
If Alert Then
End If
GetPosnIdx = -1
End Function
Private Function EncoderFromDec(DEC As Double, RA) As Double
Dim tPier As Double
If RangeHA(RA - EQnow_lst(gLongitude * DEG_RAD)) < 0 Then
If gHemisphere = 0 Then
tPier = 1
Else
tPier = 0
End If
Else
If gHemisphere = 0 Then
tPier = 0
Else
tPier = 1
End If
End If
EncoderFromDec = Get_DECEncoderfromDEC(DEC, tPier, gDECEncoder_Zero_pos, gTot_DEC, gHemisphere)
End Function
Public Function goto_TrackTarget(RA As Double, DEC As Double, mute As Boolean)
Dim idx As Integer
Dim epochnow As Double
Dim typTime As SYSTEMTIME
Dim mjd As Double
Dim day As Double
Dim deltat As Double
On Error GoTo HandleError
If gEQparkstatus = 0 Then
' slew
gTargetRA = RA
gTargetDec = DEC
HC.Add_Message ("Goto: " & oLangDll.GetLangString(105) & "[ " & FmtSexa(gTargetRA, False) & " ] " & oLangDll.GetLangString(106) & "[ " & FmtSexa(gTargetDec, True) & " ]")
gSlewCount = gMaxSlewCount 'NUM_SLEW_RETRIES 'Set initial iterative slew count
Call radecAsyncSlew(gGotoRate)
If Not mute Then
EQ_Beep (20)
End If
Else
HC.Add_Message (oLangDll.GetLangString(5000))
End If
HandleError:
End Function
Public Function GetTrackTarget(ByRef RA As Double, ByRef DEC As Double) As Boolean
Dim idx As Integer
Dim epochnow As Double
Dim typTime As SYSTEMTIME
Dim mjd As Double
Dim day As Double
Dim deltat As Double
idx = GetPosnIdx(0, True)
If idx >= 0 Then
' get RA,DEC (in seconds)
RA = TrackCtrl.TrackSchedule(idx).RAJ2000
DEC = TrackCtrl.TrackSchedule(idx).DECJ2000
' calculates current julian date in seconds
GetSystemTime typTime
day = CDbl(typTime.wDay)
Call cal_mjd(typTime.wMonth, day, typTime.wYear, mjd)
mjd = mjd * 86400 + (CDbl(typTime.wHour) * 3600 + CDbl(typTime.wMinute) * 60 + CDbl(typTime.wSecond))
' establish how many seconds have elapsed since record date/time
deltat = mjd - TrackCtrl.TrackSchedule(idx).time_mjd
' compensate for movement
RA = RA + TrackCtrl.TrackSchedule(idx).RaRateRaw * deltat / 15
DEC = DEC + TrackCtrl.TrackSchedule(idx).DECRateRaw * deltat
' convert back into hours
RA = RA / 3600
DEC = DEC / 3600
' adjust to JNOW
If TrackCtrl.Precess = True Then
epochnow = 2000 + (now_mjd() - J2000) / 365.25
Call Precess(RA, DEC, 2000, epochnow)
End If
GetTrackTarget = True
Else
GetTrackTarget = False
End If
End Function
' at 4333 Done code part. Lines - 1 Analysing mount.basError parsing line 'Attribute VB_Name = "Mount"
Option Explicit
Public Type MountDefn
TotalSteps As String
wormsteps As String
offset As String
End Type
Public gCustomMount As Integer
Public gCustomRA360 As Long
Public gCustomDEC360 As Long
Public gCustomRAWormSteps As Double
Public gCustomDECWormSteps As Double
Public gMountType As Long
Public Function CheckMount(openstat As Long) As Long
gTot_step = EQGetTotal360microstep(0)
gRAMeridianWest = gRAEncoder_Zero_pos + CDbl(gTot_step) / 4
gRAMeridianEast = gRAEncoder_Zero_pos - CDbl(gTot_step) / 4
gDECEncoder_Home_pos = EQGetTotal360microstep(1) / 4 + gDECEncoder_Zero_pos ' totstep/4 + Homepos
gEQ_MAXSYNC = gTot_step / 16 ' totalstep /16 = 22.5 degree field
CheckMount = EQ_OK
End Function
Public Sub readCustomMount()
Dim tmptxt As String
Dim i As Long
Dim NF1 As Integer
NF1 = FreeFile
On Error Resume Next
Close #NF1
Open HC.oPersist.GetIniPath() + "\mountparams.txt" For Output As #NF1
For i = 10000 To 10007
Print #NF1, "0," & CStr(i) & ":" & CStr(EQGP(0, i))
Print #NF1, "1," & CStr(i) & ":" & CStr(EQGP(1, i))
Next i
Close #NF1
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_MOUNT")
If tmptxt <> "" Then
gCustomMount = val(tmptxt)
Else
gCustomMount = 0
HC.oPersist.WriteIniValue "CUSTOM_MOUNT", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_RA_STEPS_360")
If tmptxt <> "" Then
gCustomRA360 = val(tmptxt)
Else
gCustomRA360 = 9024000
HC.oPersist.WriteIniValue "CUSTOM_RA_STEPS_360", "9024000"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_DEC_STEPS_360")
If tmptxt <> "" Then
gCustomDEC360 = val(tmptxt)
Else
gCustomDEC360 = 9024000
HC.oPersist.WriteIniValue "CUSTOM_DEC_STEPS_360", "9024000"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_RA_STEPS_WORM")
If tmptxt <> "" Then
gCustomRAWormSteps = val(tmptxt)
Else
gCustomRAWormSteps = 50133
HC.oPersist.WriteIniValue "CUSTOM_RA_STEPS_WORM", "50133"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_DEC_STEPS_WORM")
If tmptxt <> "" Then
gCustomDECWormSteps = val(tmptxt)
Else
gCustomDECWormSteps = 50133
HC.oPersist.WriteIniValue "CUSTOM_DEC_STEPS_WORM", "50133"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_TRACKING_OFFSET_RA")
If tmptxt <> "" Then
gCustomTrackingOffsetRA = val(tmptxt)
Else
gCustomTrackingOffsetRA = 0
HC.oPersist.WriteIniValue "CUSTOM_TRACKING_OFFSET_RA", "0"
End If
tmptxt = HC.oPersist.ReadIniValue("CUSTOM_TRACKING_OFFSET_DEC")
If tmptxt <> "" Then
gCustomTrackingOffsetDEC = val(tmptxt)
Else
gCustomTrackingOffsetDEC = 0
HC.oPersist.WriteIniValue "CUSTOM_TRACKING_OFFSET_DEC", "0"
End If
Call EQSetOffsets
End Sub
Public Sub writeCustomMount()
HC.oPersist.WriteIniValue "CUSTOM_MOUNT", CStr(gCustomMount)
HC.oPersist.WriteIniValue "CUSTOM_RA_STEPS_360", CStr(gCustomRA360)
HC.oPersist.WriteIniValue "CUSTOM_DEC_STEPS_360", CStr(gCustomDEC360)
HC.oPersist.WriteIniValue "CUSTOM_RA_STEPS_WORM", CStr(gCustomRAWormSteps)
HC.oPersist.WriteIniValue "CUSTOM_DEC_STEPS_WORM", CStr(gCustomDECWormSteps)
HC.oPersist.WriteIniValue "CUSTOM_TRACKING_OFFSET_RA", CStr(gCustomTrackingOffsetRA)
HC.oPersist.WriteIniValue "CUSTOM_TRACKING_OFFSET_DEC", CStr(gCustomTrackingOffsetDEC)
End Sub
Public Function readMountType2() As String
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("SIM_MOUNT_TYPE")
If tmptxt = "" Then
tmptxt = "EQ6PRO"
HC.oPersist.WriteIniValue "SIM_MOUNT_TYPE", tmptxt
End If
readMountType2 = tmptxt
End Function
Public Sub readWormSteps()
Dim tmptxt As String
tmptxt = HC.oPersist.ReadIniValue("RA_STEPS_PER_WORM")
If tmptxt <> "" Then
gRAWormSteps = val(tmptxt)
Else
gRAWormSteps = 50133
HC.oPersist.WriteIniValue "RA_STEPS_PER_WORM", CStr(gRAWormSteps)
End If
tmptxt = HC.oPersist.ReadIniValue("DEC_STEPS_PER_WORM")
If tmptxt <> "" Then
gDECWormSteps = val(tmptxt)
Else
gDECWormSteps = 50133
HC.oPersist.WriteIniValue "DEC_STEPS_PER_WORM", CStr(gDECWormSteps)
End If
End Sub
' Function name : EQGetTotal360microstep()
' Description : Get RA/DEC Motor Total 360 degree microstep counts
' Return type : Double - Stepper Counter Values
' 0 - 16777215 Valid Count Values
' 0x1000000 - Mount Not available
' 0x3000000 - Invalid Parameter
' Argument : DOUBLE motor_id
' 00 - RA Motor
' 01 - DEC Motor
'
Public Function EQGetTotal360microstep(ByVal motor_id As Long) As Long
Dim ret As Long
If gCustomMount = 1 Then
Select Case motor_id
Case 0
ret = gCustomRA360
Case 1
ret = gCustomDEC360
Case Else
ret = EQ_GetTotal360microstep(motor_id)
End Select
Else
ret = EQ_GetTotal360microstep(motor_id)
End If
EQGetTotal360microstep = ret
End Function
' at 4737 Done code part. Lines - 1 Analysing sites.basError parsing line 'Attribute VB_Name = "Sites"
Option Explicit
Public Sub ReadSiteValues()
Dim tmptxt As String
Dim mins As Double
Dim secs As Double
HC.cbNS.ListIndex = 0
HC.cbEW.ListIndex = 0
HC.cbhem.ListIndex = 0
tmptxt = HC.oPersist.ReadIniValue("LongitudeDeg")
If tmptxt <> "" Then HC.txtLongDeg.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValue("LongitudeMin")
If tmptxt <> "" Then
HC.txtLongMin.Text = tmptxt
mins = CDbl(HC.txtLongMin.Text)
secs = 60 * (mins - Int(mins))
HC.txtLongMin.Text = CStr(Int(mins))
If secs <> 0 Then
Call HC.oPersist.WriteIniValue("LongitudeSec", CStr(secs))
Call HC.oPersist.WriteIniValue("LongitudeMin", HC.txtLongMin.Text)
End If
End If
tmptxt = HC.oPersist.ReadIniValue("LongitudeSec")
If tmptxt <> "" Then HC.txtLongSec.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValue("LongitudeEW")
If tmptxt <> "" Then HC.cbEW.ListIndex = val(tmptxt)
tmptxt = HC.oPersist.ReadIniValue("LatitudeDeg")
If tmptxt <> "" Then HC.txtLatDeg.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValue("LatitudeMin")
If tmptxt <> "" Then
HC.txtLatMin.Text = tmptxt
mins = CDbl(HC.txtLatMin.Text)
secs = 60 * (mins - Int(mins))
HC.txtLatMin.Text = CStr(Int(mins))
If secs <> 0 Then
Call HC.oPersist.WriteIniValue("LatitudeMin", HC.txtLatMin.Text)
Call HC.oPersist.WriteIniValue("LatitudeSec", CStr(secs))
End If
End If
tmptxt = HC.oPersist.ReadIniValue("LatitudeSec")
If tmptxt <> "" Then HC.txtLatSec.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValue("LatitudeNS")
If tmptxt <> "" Then HC.cbNS.ListIndex = val(tmptxt)
tmptxt = HC.oPersist.ReadIniValue("Elevation")
If tmptxt <> "" Then HC.txtElevation = tmptxt
tmptxt = HC.oPersist.ReadIniValue("TimeDelta")
If tmptxt <> "" Then gEQTimeDelta = val(EQFixNum(tmptxt))
HC.cbhem.ListIndex = HC.cbNS.ListIndex
' tmptxt = HC.oPersist.ReadIniValue("HemisphereNS")
' If tmptxt <> "" Then HC.cbhem.ListIndex = val(tmptxt)
gLongitude = CDbl(EQFixNum(HC.txtLongDeg)) + (CDbl(EQFixNum(HC.txtLongMin)) / 60#) + (CDbl(EQFixNum(HC.txtLongSec)) / 3600#)
If HC.cbEW.Text = oLangDll.GetLangString(115) Then gLongitude = -gLongitude ' W is neg
gLatitude = CDbl(EQFixNum(HC.txtLatDeg)) + (CDbl(EQFixNum(HC.txtLatMin)) / 60#) + (CDbl(EQFixNum(HC.txtLatSec)) / 3600#)
If HC.cbNS.Text = oLangDll.GetLangString(116) Then gLatitude = -gLatitude
gElevation = CDbl(EQFixNum(HC.txtElevation))
If HC.cbhem.Text = oLangDll.GetLangString(1110) Then
gHemisphere = 0
Else
gHemisphere = 1
End If
tmptxt = HC.oPersist.ReadIniValue("SiteName")
HC.SitesCombo.Text = HC.oPersist.ReadIniValue("SiteName")
End Sub
Public Sub WriteSiteValues()
HC.oPersist.WriteIniValue "LatitudeDeg", CStr(HC.txtLatDeg.Text)
HC.oPersist.WriteIniValue "LatitudeMin", CStr(HC.txtLatMin.Text)
HC.oPersist.WriteIniValue "LatitudeSec", CStr(HC.txtLatSec.Text)
HC.oPersist.WriteIniValue "LatitudeNS", CStr(HC.cbNS.ListIndex)
HC.oPersist.WriteIniValue "LongitudeDeg", CStr(HC.txtLongDeg.Text)
HC.oPersist.WriteIniValue "LongitudeMin", CStr(HC.txtLongMin.Text)
HC.oPersist.WriteIniValue "LongitudeSec", CStr(HC.txtLongSec.Text)
HC.oPersist.WriteIniValue "LongitudeEW", CStr(HC.cbEW.ListIndex)
HC.oPersist.WriteIniValue "HemisphereNS", CStr(HC.cbhem.ListIndex)
HC.oPersist.WriteIniValue "Elevation", CStr(HC.txtElevation.Text)
HC.oPersist.WriteIniValue "TimeDelta", CStr(EQFixNum(str(gEQTimeDelta)))
HC.oPersist.WriteIniValue "SiteName", CStr(HC.SitesCombo.Text)
End Sub
Public Sub LoadSites(combo As ComboBox)
Dim tmptxt As String
Dim key As String
Dim valstr As String
Dim Ini As String
Dim Index As Integer
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
combo.Clear
For Index = 1 To 10
key = "[site" & CStr(Index) & "]"
tmptxt = HC.oPersist.ReadIniValueEx("Name", key, Ini)
If tmptxt <> "" Then
combo.AddItem (tmptxt)
Else
combo.AddItem (oLangDll.GetLangString(187) & CStr(Index))
End If
Next Index
' set text
combo.Text = HC.oPersist.ReadIniValue("SiteName")
End Sub
Public Sub LoadSite(ByVal Index As Integer)
Dim tmptxt As String
Dim key As String
Dim Ini As String
Dim Count As Integer
Dim secs As Double
Dim mins As Double
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[site" & CStr(Index + 1) & "]"
tmptxt = HC.oPersist.ReadIniValueEx("LongitudeDeg", key, Ini)
If tmptxt <> "" Then HC.txtLongDeg.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValueEx("LongitudeMin", key, Ini)
If tmptxt <> "" Then
HC.txtLongMin.Text = tmptxt
mins = CDbl(HC.txtLongMin.Text)
secs = 60 * (mins - Int(mins))
HC.txtLongMin.Text = CStr(Int(mins))
If secs <> 0 Then
Call HC.oPersist.WriteIniValueEx("LongitudeMin", HC.txtLongMin.Text, key, Ini)
Call HC.oPersist.WriteIniValueEx("LongitudeSec", CStr(secs), key, Ini)
End If
End If
tmptxt = HC.oPersist.ReadIniValueEx("LongitudeSec", key, Ini)
If tmptxt <> "" Then HC.txtLongSec.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValueEx("LongitudeEW", key, Ini)
If tmptxt <> "" Then HC.cbEW.ListIndex = val(tmptxt)
tmptxt = HC.oPersist.ReadIniValueEx("LatitudeDeg", key, Ini)
If tmptxt <> "" Then HC.txtLatDeg.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValueEx("LatitudeMin", key, Ini)
If tmptxt <> "" Then
HC.txtLatMin.Text = tmptxt
mins = CDbl(HC.txtLatMin.Text)
secs = 60 * (mins - Int(mins))
HC.txtLatMin.Text = CStr(Int(mins))
If secs <> 0 Then
Call HC.oPersist.WriteIniValueEx("LatitudeMin", HC.txtLatMin.Text, key, Ini)
Call HC.oPersist.WriteIniValueEx("LatitudeSec", CStr(secs), key, Ini)
End If
End If
tmptxt = HC.oPersist.ReadIniValueEx("LatitudeSec", key, Ini)
If tmptxt <> "" Then HC.txtLatSec.Text = tmptxt
tmptxt = HC.oPersist.ReadIniValueEx("LatitudeNS", key, Ini)
If tmptxt <> "" Then HC.cbNS.ListIndex = val(tmptxt)
tmptxt = HC.oPersist.ReadIniValueEx("Elevation", key, Ini)
If tmptxt <> "" Then HC.txtElevation = tmptxt
tmptxt = HC.oPersist.ReadIniValueEx("TimeDelta", key, Ini)
If tmptxt <> "" Then gEQTimeDelta = val(EQFixNum(tmptxt))
HC.cbhem.ListIndex = HC.cbNS.ListIndex
' tmptxt = HC.oPersist.ReadIniValueEx("HemisphereNS", key, Ini)
' If tmptxt <> "" Then HC.cbhem.ListIndex = val(tmptxt)
End Sub
Public Sub SaveSite(ByVal Index As Integer, ByVal name As String)
Dim key As String
Dim Ini As String
' set up a file path for the aligncls.ini file
Ini = HC.oPersist.GetIniPath & "\EQMOD.ini"
key = "[site" & CStr(Index + 1) & "]"
Call HC.oPersist.WriteIniValueEx("Name", name, key, Ini)
Call HC.oPersist.WriteIniValueEx("LatitudeDeg", CStr(HC.txtLatDeg.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LatitudeMin", CStr(HC.txtLatMin.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LatitudeSec", CStr(HC.txtLatSec.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LatitudeNS", CStr(HC.cbNS.ListIndex), key, Ini)
Call HC.oPersist.WriteIniValueEx("LongitudeDeg", CStr(HC.txtLongDeg.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LongitudeMin", CStr(HC.txtLongMin.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LongitudeSec", CStr(HC.txtLongSec.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("LongitudeEW", CStr(HC.cbEW.ListIndex), key, Ini)
Call HC.oPersist.WriteIniValueEx("HemisphereNS", CStr(HC.cbhem.ListIndex), key, Ini)
Call HC.oPersist.WriteIniValueEx("Elevation", CStr(HC.txtElevation.Text), key, Ini)
Call HC.oPersist.WriteIniValueEx("TimeDelta", CStr(EQFixNum(str(gEQTimeDelta))), key, Ini)
End Sub
Public Sub UpdateSiteControls()
Dim tmp As Double
Dim h As Integer
Dim m As Integer
Dim s As Double
tmp = Abs(gLongitude)
If gLongitude < 0 Then
HC.cbEW.ListIndex = 1
Else
HC.cbEW.ListIndex = 0
End If
h = Int(tmp)
tmp = Int((tmp - h) * 60)
m = Int(tmp)
s = (tmp - m) * 60
HC.txtLongDeg.Text = CStr(h)
HC.txtLongMin.Text = CStr(m)
HC.txtLongSec.Text = CStr(s)
tmp = Abs(gLatitude)
If gLatitude < 0 Then
HC.cbNS.ListIndex = 1
HC.cbhem.ListIndex = 1
Else
HC.cbNS.ListIndex = 0
HC.cbhem.ListIndex = 0
End If
h = Int(tmp)
tmp = (tmp - h) * 60
m = Int(tmp)
s = (tmp - m) * 60
HC.txtLatDeg.Text = CStr(h)
HC.txtLatMin.Text = CStr(m)
HC.txtLatSec.Text = CStr(s)
HC.txtElevation.Text = CStr(gElevation)
Call WriteSiteValues
End Sub
' at 6162 Done code part. Lines - 1 Analysing language.bas Done code part. Lines - 1 Analysing graphics.basError parsing line 'Attribute VB_Name = "Graphics"
Option Explicit
Private Declare Function Arc Lib "gdi32" (ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function AngleArc Lib "GDI32.dll" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, ByVal dwRadius As Long, ByVal eStartAngle As Single, ByVal eSweepAngle As Single) As Long
Private Declare Function MoveToEx Lib "GDI32.dll" (ByVal hDC As Long, ByVal x As Long, ByVal Y As Long, ByRef lpPoint As Any) As Long
Public Sub PlotInit()
Dim i As Integer
HC.Plot_RA.DrawMode = 13
HC.Plot_DEC.DrawMode = 13
HC.Plot_RA.Cls
HC.Plot_DEC.Cls
HC.Plot_RA.Line (0, HC.Plot_RA.ScaleHeight / 2)-(HC.Plot_RA.ScaleWidth, HC.Plot_RA.ScaleHeight / 2), vbBlue
HC.Plot_DEC.Line (0, HC.Plot_DEC.ScaleHeight / 2)-(HC.Plot_DEC.ScaleWidth, HC.Plot_DEC.ScaleHeight / 2), vbBlue
gPlot_ra_pos = 0
gPlot_dec_pos = 0
gRAHeight = (HC.Plot_RA.ScaleHeight / 2)
gDecHeight = (HC.Plot_DEC.ScaleHeight / 2)
gplot_ra_cur = gRAHeight
gPlot_dec_cur = gDecHeight
End Sub
Public Sub Plot_PG(id As Integer, side As Integer, ppvalue As Long)
Dim pheight As Double
Dim pscale As Double
Dim pvalue As Double
Dim nextpos As Double
' If HC.Frame16.Visible = True Then
pvalue = ppvalue
gMAX_RAlevel = HC.RAdisplay_gain.Value + 100
gMAX_DEClevel = HC.DECdisplay_gain.Value + 100
If id = 0 Then
nextpos = gPlot_ra_pos + 3
If nextpos > HC.Plot_RA.ScaleWidth Then
gPlot_ra_pos = 0
nextpos = 3
HC.Plot_RA.Line (0, 0)-(0, HC.Plot_RA.ScaleHeight), &H40&
End If
If pvalue > gMAX_RAlevel Then pvalue = gMAX_RAlevel
pscale = (pvalue / gMAX_RAlevel) * gRAHeight
HC.Plot_RA.Line (gPlot_ra_pos + 1, 0)-(gPlot_ra_pos + 1, HC.Plot_RA.ScaleHeight), &H40&
HC.Plot_RA.Line (gPlot_ra_pos + 2, 0)-(gPlot_ra_pos + 2, HC.Plot_RA.ScaleHeight), &H40&
HC.Plot_RA.Line (gPlot_ra_pos + 3, 0)-(gPlot_ra_pos + 3, HC.Plot_RA.ScaleHeight), &H40&
HC.Plot_RA.Line (gPlot_ra_pos + 4, 0)-(gPlot_ra_pos + 4, HC.Plot_RA.ScaleHeight), vbBlue
HC.Plot_RA.Line (gPlot_ra_pos + 5, 0)-(gPlot_ra_pos + 5, HC.Plot_RA.ScaleHeight), &H40&
HC.Plot_RA.Line (gPlot_ra_pos, gRAHeight)-(nextpos + 1, gRAHeight), vbBlue
If side = 0 Then
HC.Plot_RA.Line (gPlot_ra_pos, gplot_ra_cur)-(nextpos, gRAHeight - pscale), vbRed
gplot_ra_cur = gRAHeight - pscale
Else
HC.Plot_RA.Line (gPlot_ra_pos, gplot_ra_cur)-(nextpos, gRAHeight + pscale), vbRed
gplot_ra_cur = gRAHeight + pscale
End If
gPlot_ra_pos = nextpos
Else
nextpos = gPlot_dec_pos + 3
If nextpos > HC.Plot_DEC.ScaleWidth Then
gPlot_dec_pos = 0
nextpos = 3
HC.Plot_DEC.Line (0, 0)-(0, HC.Plot_DEC.ScaleHeight), &H40&
End If
If pvalue > gMAX_DEClevel Then pvalue = gMAX_DEClevel
pscale = (pvalue / gMAX_DEClevel) * gDecHeight
HC.Plot_DEC.Line (gPlot_dec_pos + 1, 0)-(gPlot_dec_pos + 1, HC.Plot_DEC.ScaleHeight), &H40&
HC.Plot_DEC.Line (gPlot_dec_pos + 2, 0)-(gPlot_dec_pos + 2, HC.Plot_DEC.ScaleHeight), &H40&
HC.Plot_DEC.Line (gPlot_dec_pos + 3, 0)-(gPlot_dec_pos + 3, HC.Plot_DEC.ScaleHeight), &H40&
HC.Plot_DEC.Line (gPlot_dec_pos + 4, 0)-(gPlot_dec_pos + 4, HC.Plot_DEC.ScaleHeight), vbBlue
HC.Plot_DEC.Line (gPlot_dec_pos + 5, 0)-(gPlot_dec_pos + 5, HC.Plot_DEC.ScaleHeight), &H40&
HC.Plot_DEC.Line (gPlot_dec_pos, gDecHeight)-(nextpos + 1, gRAHeight), vbBlue
If side = 0 Then
HC.Plot_DEC.Line (gPlot_dec_pos, gPlot_dec_cur)-(nextpos, gDecHeight - pscale), vbRed
gPlot_dec_cur = gDecHeight - pscale
Else
HC.Plot_DEC.Line (gPlot_dec_pos, gPlot_dec_cur)-(nextpos, gDecHeight + pscale), vbRed
gPlot_dec_cur = gDecHeight + pscale
End If
gPlot_dec_pos = nextpos
End If
' End If
End Sub
Public Sub DrawAxis(pic As PictureBox, mode As Integer, val As Double, lowlimit As Double, highlimit As Double)
Dim i As Integer
Dim x1, y1, x2, y2, tmp As Double
pic.Cls
val = val * 3.6
pic.DrawWidth = 10
If mode = -1 Then
pic.Circle (40, 40), 35, &H808080
Else
pic.Circle (40, 40), 35, &H8000&
pic.DrawWidth = 2
For i = 1 To 9
pic.ForeColor = vbRed
Call MoveToEx(pic.hDC, 40, i, ByVal 0&)
AngleArc pic.hDC, 40, 40, 40 - i, 90, -val
Next i
End If
pic.DrawWidth = 1
pic.Circle (40, 40), 30, vbBlack
pic.Circle (40, 40), 40, vbBlack
For i = 0 To 345 Step 15
tmp = i * PI / 180
x1 = 30 * Cos(tmp) + 40
y1 = 30 * Sin(tmp) + 40
x2 = (40) * Cos(tmp) + 40
y2 = (40) * Sin(tmp) + 40
If i = 0 Or i = 180 Then
pic.Line (x1, y1)-(x2, y2), vbCyan
Else
pic.Line (x1, y1)-(x2, y2), vbBlack
End If
Next i
pic.DrawWidth = 2
If lowlimit > 0 Then
tmp = lowlimit * 3.6 - 90
tmp = tmp * PI / 180
x1 = 30 * Cos(tmp) + 40
y1 = 30 * Sin(tmp) + 40
x2 = (40) * Cos(tmp) + 40
y2 = (40) * Sin(tmp) + 40
pic.Line (x1, y1)-(x2, y2), vbYellow
End If
If highlimit > 0 Then
tmp = highlimit * 3.6 - 90
tmp = tmp * PI / 180
x1 = 30 * Cos(tmp) + 40
y1 = 30 * Sin(tmp) + 40
x2 = (40) * Cos(tmp) + 40
y2 = (40) * Sin(tmp) + 40
pic.Line (x1, y1)-(x2, y2), vbYellow
End If
pic.DrawWidth = 1
pic.ForeColor = &H80FF&
i = pic.TextHeight("0") / 2
Select Case mode
Case 0
pic.CurrentX = 40 - pic.TextWidth("6") / 2
pic.CurrentY = 20 - i
pic.Print "6"
pic.CurrentX = 40 - pic.TextWidth("18") / 2
pic.CurrentY = 60 - i
pic.Print "18"
pic.CurrentX = 20 - pic.TextWidth("0") / 2
pic.CurrentY = 40 - i
pic.Print "0"
pic.CurrentX = 60 - pic.TextWidth("12") / 2
pic.CurrentY = 40 - i
pic.Print "12"
pic.CurrentX = 40 - pic.TextWidth(oLangDll.GetLangString(105)) / 2
pic.CurrentY = 40 - i
pic.Print oLangDll.GetLangString(105)
Case 1
pic.CurrentX = 40 - pic.TextWidth("90") / 2
pic.CurrentY = 20 - i
pic.Print "90"
pic.CurrentX = 40 - pic.TextWidth("-90") / 2
pic.CurrentY = 60 - i
pic.Print "-90"
pic.CurrentX = 20 - pic.TextWidth("0") / 2
pic.CurrentY = 40 - i
pic.Print "0"
pic.CurrentX = 60 - pic.TextWidth("0") / 2
pic.CurrentY = 40 - i
pic.Print "0"
pic.CurrentX = 40 - pic.TextWidth(oLangDll.GetLangString(106)) / 2
pic.CurrentY = 40 - i
pic.Print oLangDll.GetLangString(106)
End Select
End Sub
' at 5433 Done code part. Lines - 1 Analysing monitor.bas Done code part. Lines - 1 Analysing fft.basError parsing line 'Attribute VB_Name = "FFT"
'***************************************************************
' Copyright © 2006 Chris Shillito
'
' Fast Fourier Transform
'
'***************************************************************
Option Explicit
Private ReX() As Double
Private ImX() As Double
Private FFTSampleRate As Double
Private SampleCount As Integer
Private MaxMag As Double
Private N As Integer
Const pi = 3.14159265 'Set constants
Public Function FFT_Free()
ReDim ReX(0)
ReDim ImX(0)
N = 0
End Function
Public Sub FFT_Initialise(ByVal size As Integer, ByVal rate As Double)
Dim i As Integer
ReDim ReX(size)
ReDim ImX(size)
N = size
For i = 0 To N
ReX(i) = 0
ImX(i) = 0
Next i
FFTSampleRate = rate
MaxMag = 0
SampleCount = 0
End Sub
'Upon entry, N% contains the number of points in the DFT, fftReal[ ] and
'fft[].Img contain the real and imaginary parts of the input.
' Upon return, fft[].Real and fft[].Img contain the DFT output. All signals run from 0 to N-1.
Public Sub FFT_ForwardFFTComplex()
Dim TI, TR As Double
Dim i, j, k, l, m As Integer
Dim IP, LE, LE2 As Integer
Dim ur, ui, sr, si As Double
Dim NDiv2 As Integer
Dim NSub1 As Integer
Dim NSub2 As Integer
If N <> 0 Then
ImX(0) = 0
ReX(0) = 0
NSub1 = N - 1
NSub2 = N - 2
NDiv2 = N / 2
m = CInt(Log(N) / Log(2))
j = NDiv2
For i = 1 To (NSub2) 'Bit reversal sorting
If i < j Then
TR = ReX(j)
TI = ImX(j)
ReX(j) = ReX(i)
ImX(j) = ImX(i)
ReX(i) = TR
ImX(i) = TI
End If
k = NDiv2
While k <= j
j = j - k
k = k / 2
Wend
j = j + k
Next i
For l = 1 To m 'Loop for each stage
LE = CInt(2 ^ l)
LE2 = LE / 2
ur = 1
ui = 0
sr = Cos(pi / LE2) 'Calculate sine & cosine values
si = -Sin(pi / LE2)
For j = 1 To LE2 'Loop for each sub DFT
For i = (j - 1) To (NSub1) Step LE 'Loop for each butterfly
IP = i + LE2
TR = ReX(IP) * ur - ImX(IP) * ui 'Butterfly calculation
TI = ReX(IP) * ui + ImX(IP) * ur
ReX(IP) = ReX(i) - TR
ImX(IP) = ImX(i) - TI
ReX(i) = ReX(i) + TR
ImX(i) = ImX(i) + TI
Next i
TR = ur
ur = TR * sr - ui * si
ui = TR * si + ui * sr
Next j
Next l
End If
End Sub
Public Sub FFT_NormaliseMag()
Dim idx As Integer
Dim mag As Double
Dim max As Double
MaxMag = 0
max = 0
For idx = 1 To N / 2 - 1
mag = FFT_GetMagnitude(idx)
If mag > max Then
max = mag
End If
Next idx
MaxMag = max
End Sub
Public Sub FFT_InverseFFTComplex()
' upon entry N is the numbr of real and imaginary points.
' real[] and img[] contain the real and imaginary parts of the frequency domain
' running for index 0 to n/2
' On return real[] containds the real time domain, img[] contains zeros.
Dim k As Integer
Dim NSub1 As Integer
NSub1 = N - 1
If N <> 0 Then
For k = 0 To NSub1
ImX(k) = -ImX(k)
Next k
FFT_ForwardFFTComplex
For k = 0 To NSub1
ReX(k) = ReX(k) / N
' don't really need the imaginary part of the time domain
' ImX(K) = -ImX(K) / N
Next k
End If
End Sub
Public Sub FFT_InverseFFTReal()
' upon entry N is the numbr of real and imaginary points.
' real[] and img[] contain the real and imaginary parts of the frequency domain
' running for index 0 to n/2
' On return real[] contains the real time domain, img[] contains zeros.
Dim k As Integer
If N <> 0 Then
For k = N / 2 + 1 To N - 1
ReX(k) = ReX(N - k)
ImX(k) = -ImX(N - k)
Next k
For k = 0 To N - 1
ReX(k) = ReX(k) + ImX(k)
Next k
FFT_ForwardFFTComplex
For k = 0 To N - 1
ReX(k) = (ReX(k) + ImX(k)) / N
ImX(k) = 0
Next k
End If
End Sub
Public Sub FFT_ApplyFilter(lofilter As Double, hifilter As Double, MagLimit As Double)
Dim lo As Double
Dim hi As Double
If lofilter = 0 Then
lo = N
Else
lo = FFT_Freq2Bin(lofilter)
End If
hi = FFT_Freq2Bin(hifilter)
If lo <> -1 And hi <> -1 Then Call FFT_Filter(lo, hi, MagLimit)
End Sub
Public Sub FFT_Filter(lofilter As Double, hifilter As Double, MagLimit As Double)
Dim k As Integer
Dim NDiv2Sub1 As Integer
Dim NSub1 As Integer
NDiv2Sub1 = N / 2 - 1
NSub1 = N - 1
If N <> 0 Then
If Not (lofilter = 0 And hifilter = 0) Then
For k = 0 To NDiv2Sub1
If (k >= lofilter) Or (k <= hifilter) Then
ImX(k) = 0
ReX(k) = 0
Else
If FFT_GetMagnitude(k) < MagLimit Then
ImX(k) = 0
ReX(k) = 0
End If
End If
Next k
End If
For k = N / 2 + 1 To NSub1
ReX(k) = ReX(N - k)
ImX(k) = -ImX(N - k)
Next k
End If
End Sub
Public Function FFT_Bin2Freq(bin As Double) As Double
Dim NDiv2 As Integer
NDiv2 = N / 2
If bin > NDiv2 Then
FFT_Bin2Freq = -1
Else
FFT_Bin2Freq = bin * FFTSampleRate / N ' Div2
End If
End Function
Public Function FFT_Freq2Bin(freq As Double) As Double
Dim NDiv2 As Integer
NDiv2 = N / 2
If freq > FFTSampleRate / 2 Then
FFT_Freq2Bin = -1
Else
FFT_Freq2Bin = freq * N / FFTSampleRate
End If
End Function
Public Function FFT_GetPhase(idx As Integer) As Double
If idx <= N Then
If ReX(idx) = 0 Then
' divide by 0 error
If ImX(idx) < 0 Then
FFT_GetPhase = -pi / 2
Else
FFT_GetPhase = pi / 2
End If
Else
' calculate phase
FFT_GetPhase = Atn(ImX(idx) / ReX(idx))
' fix incorrect arctan
If ReX(idx) < 0 Then
If ImX(idx) < 0 Then
' Rex < 0 and imx < 0
FFT_GetPhase = FFT_GetPhase - pi
Else
' rex < 0 and imx > 0
FFT_GetPhase = FFT_GetPhase + pi
End If
End If
End If
Else
FFT_GetPhase = 0
End If
End Function
Public Function FFT_GetMagnitude(idx As Integer) As Double
If idx <= N Then
If MaxMag <> 0 Then
FFT_GetMagnitude = Sqr((ImX(idx) * ImX(idx)) + (ReX(idx) * ReX(idx)))
' normalise magnitude
FFT_GetMagnitude = 100 * FFT_GetMagnitude / MaxMag
Else
FFT_GetMagnitude = Sqr((ImX(idx) * ImX(idx)) + (ReX(idx) * ReX(idx)))
End If
Else
FFT_GetMagnitude = 0
End If
End Function
Public Function FFT_GetReX(idx As Integer) As Double
If idx <= N Then
FFT_GetReX = ReX(idx)
Else
FFT_GetReX = 0
End If
End Function
Public Function FFT_GetImX(idx As Integer) As Double
If idx <= N Then
FFT_GetImX = ImX(idx)
Else
FFT_GetImX = 0
End If
End Function
Public Sub FFT_SetSample(idx As Integer, sample As Double)
If idx <= N Then
ReX(idx) = sample
ImX(idx) = 0
If idx >= SampleCount Then SampleCount = idx + 1
End If
End Sub
Public Sub FFT_SetFSample(idx As Integer, r As Double, i As Double)
If idx <= N Then
ReX(idx) = r
ImX(idx) = i
End If
End Sub
Public Sub FFT_MoveFSample(idx1 As Integer, idx2 As Integer)
If idx1 <= N And idx2 < N Then
ReX(idx2) = ReX(idx1)
ImX(idx2) = ImX(idx1)
ReX(idx1) = 0
ImX(idx1) = 0
End If
End Sub
Public Function FFT_GetSample(idx As Integer) As Double
If idx <= N Then
FFT_GetSample = ReX(idx)
End If
End Function
Public Function FFT_GetSampleCount() As Integer
FFT_GetSampleCount = SampleCount
End Function
Public Function FFT_GetSize() As Integer
FFT_GetSize = N
End Function
Public Function FFT_GetSampleRate() As Double
FFT_GetSampleRate = FFTSampleRate
End Function
' at 4121 Done code part. Lines - 1 Analysing pecconfigfrm.frm Done form part, 23 controls found Done code part. Lines - 545 Analysing featuresdlg.frm Done form part, 2 controls found Done code part. Lines - 80 Analysing commentdlg.frm Done form part, 3 controls found Done code part. Lines - 74
Done analysis pass.Start code generation -
Recoding astro32.bas -> astro32.pas Done astro32.bas -> C:\EQ_DELPHI\astro32.pas Recoding eqmath.bas -> eqmath.pas Done eqmath.bas -> C:\EQ_DELPHI\eqmath.pas Recoding errorconstants.bas -> errorconstants.pas Done errorconstants.bas -> C:\EQ_DELPHI\errorconstants.pas Recoding common.bas -> common.pas Done common.bas -> C:\EQ_DELPHI\common.pas Form setupfrm.frm -> setupfrm.dfm Done form. Recoding setupfrm.frm -> setupfrm.pasType 'Profile' not found.
procedure TSetupfrmCls.cbNS_Change(Sender: TObject );procedure TSetupfrmCls.CheckAdvanced_Click(Sender: TObject );procedure TSetupfrmCls.CheckStrict_Click(Sender: TObject );procedure TSetupfrmCls.Combo2_Click(Sender: TObject );procedure TSetupfrmCls.ComboMount_Click(Sender: TObject );procedure TSetupfrmCls.Commandcustomise_Click(Sender: TObject );Class of gAscomCompatibility not found
1025: gAscomCompatibility.Strict = FalseClass of oLangDll not found1107: If setupfrmcls.cbEW.Text = oLangDll.GetLangString(115) Then gLongitude = -gLongitude ' W is negno mapping for method-> .1145: Call HC.oPersist.WriteIniValue("ProcessPrioirty", CStr(ComboProcessPriority.ListIndex))procedure TSetupfrmCls.CommandOK_Click(Sender: TObject );procedure TSetupfrmCls.Command2_Click(Sender: TObject );property/method(1200)->form:SiteIdxprocedure TSetupfrmCls.CommandLoadSite_Click(Sender: TObject );procedure TSetupfrmCls.CommandSaveSite_Click(Sender: TObject );procedure TSetupfrmCls.Commandgps_Click(Sender: TObject );Unknown class->profileproperty/method(1315)->form:txtElevationprocedure TSetupfrmCls.Form_Load(Sender: TObject);procedure TSetupfrmCls.SetText;procedure TSetupfrmCls.HScroll1_Change;procedure TSetupfrmCls.HScroll1_Scroll;procedure TSetupfrmCls.Command1_Click(Sender: TObject );procedure TSetupfrmCls.SlewPresetList_Click(Sender: TObject );procedure TSetupfrmCls.refreshrates;procedure TSetupfrmCls.JStickSetupCommand_Click(Sender: TObject );procedure TSetupfrmCls.SitesCombo_Click(Sender: TObject ); Done setupfrm.frm -> C:\EQ_DELPHI\setupfrm.pas Form align.frm -> align.dfm Done form. Recoding align.frm -> align.pasType 'Util' not found.procedure TAlignCls.Command1_MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command1_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command2_MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command2_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command3_MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command3_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command4_MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Command4_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TAlignCls.Accept_Command_Click(Sender: TObject );procedure TAlignCls.End_Command_Click(Sender: TObject );procedure TAlignCls.Abort_Command_Click(Sender: TObject );procedure TAlignCls.Command7_Click(Sender: TObject );Unknown class->utilprocedure TAlignCls.Form_Load(Sender: TObject);procedure TAlignCls.HScroll1_Change;procedure TAlignCls.HScroll1_Scroll;procedure TAlignCls.HScroll2_Change;procedure TAlignCls.HScroll2_Scroll;procedure TAlignCls.Timer1_Timer(Sender : TObject );procedure TAlignCls.SetText;procedure TAlignCls.FillAlignmentStar(RA : double;DEC : double);procedure TAlignCls.AcceptClick; Done align.frm -> C:\EQ_DELPHI\align.pas Recoding eqcontrl.bas -> eqcontrl.pas Done eqcontrl.bas -> C:\EQ_DELPHI\eqcontrl.pas Form slewpad.frm -> slewpad.dfm Done form. Recoding slewpad.frm -> slewpad.pasprocedure TSlewpadCls.Command1_Click(Sender: TObject );procedure TSlewpadCls.Form_Activate(Sender: TObject );procedure TSlewpadCls.Form_Deactivate(Sender: TObject );procedure TSlewpadCls.Form_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);procedure TSlewpadCls.Form_KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);procedure TSlewpadCls.Form_Load(Sender: TObject);procedure TSlewpadCls.Form_Resize(Sender: TObject);procedure TSlewpadCls.Form_Unload(Sender: TObject; var Action: TCloseAction) ;procedure TSlewpadCls.Frame1_MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TSlewpadCls.Frame1_MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);procedure TSlewpadCls.Vscroll3_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);procedure TSlewpadCls.Vscroll3_KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);procedure TSlewpadCls.VScroll1_Change;