home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Ham Radio 1997
/
WOHR97_AmSoft_(1997-02-01).iso
/
amsoft
/
win95
/
source.zi_
/
AMSOFT.FRM
< prev
next >
Wrap
Text File
|
1996-04-14
|
27KB
|
875 lines
VERSION 4.00
Begin VB.Form frmCDRom
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "AmSoft"
ClientHeight = 4680
ClientLeft = 2472
ClientTop = 1536
ClientWidth = 5052
ControlBox = 0 'False
ForeColor = &H80000008&
Height = 5100
Icon = "AMSOFT.frx":0000
Left = 2424
MaxButton = 0 'False
ScaleHeight = 4680
ScaleWidth = 5052
Top = 1164
Width = 5148
Begin VB.CommandButton cmdNext
Caption = "&Next"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 612
Left = 4200
TabIndex = 29
Top = 3240
Width = 732
End
Begin VB.CommandButton cmdPrev
Caption = "&Prev"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 612
Left = 4200
TabIndex = 28
Top = 2280
Width = 732
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1812
Left = 120
ScaleHeight = 1788
ScaleWidth = 948
TabIndex = 20
Top = 2160
Width = 972
Begin VB.OptionButton Option2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Oldcall"
ForeColor = &H80000008&
Height = 252
Left = 120
TabIndex = 31
Top = 1440
Width = 732
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "None"
ForeColor = &H80000008&
Height = 252
Left = 120
TabIndex = 30
Top = 1200
Width = 852
End
Begin VB.OptionButton Option9
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Call"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 3
Top = 240
Width = 855
End
Begin VB.OptionButton Option10
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Name"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 16
Top = 480
Width = 855
End
Begin VB.OptionButton Option11
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "State"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 22
Top = 720
Width = 855
End
Begin VB.OptionButton Option12
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Zip"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 21
Top = 960
Width = 855
End
Begin VB.Label lblSearchBy
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Search by:"
ForeColor = &H00FF0000&
Height = 252
Left = 0
TabIndex = 19
Top = 0
Width = 972
End
End
Begin VB.CommandButton cmdLogIt
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&LogIt"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 375
Left = 2040
TabIndex = 18
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdPrint
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "P&rint"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 17
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdAbout
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&About"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 15
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdFind
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Find"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 375
Left = 3000
TabIndex = 1
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdExit
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Exit"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 2
Top = 4200
Width = 975
End
Begin VB.TextBox txtCall
Alignment = 2 'Center
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 18
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 555
Left = 1320
MaxLength = 8
TabIndex = 0
Top = 960
Width = 2415
End
Begin CsclockLibCtl.CurTimeCtl time1
Height = 252
Left = 120
TabIndex = 23
Top = 1080
Width = 1092
_version = 262144
_extentx = 1926
_extenty = 445
_stockprops = 13
forecolor = 12582912
backcolor = 16777215
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "Arial"
charset = 1
weight = 700
size = 7.21
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
borderstyle = 1
bordereffect = 2
showampm = -1 'True
tooltip = ""
End
Begin CsclockLibCtl.CurTimeCtl time2
Height = 252
Left = 3840
TabIndex = 24
Top = 1080
Width = 1092
_version = 262144
_extentx = 1926
_extenty = 445
_stockprops = 13
forecolor = 12582912
backcolor = 16777215
BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "Arial"
charset = 1
weight = 700
size = 7.21
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
borderstyle = 1
bordereffect = 2
showampm = -1 'True
tooltip = ""
End
Begin VB.Label lblYourCallSign
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = " AmSoft "
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 24
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 600
Left = 1440
TabIndex = 27
Top = 120
Width = 2148
End
Begin VB.Label lblUTCTime
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "UTC Time"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 252
Left = 3840
TabIndex = 26
Top = 1320
Width = 1092
End
Begin VB.Label lblLocalTime
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "Local Time"
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 252
Left = 120
TabIndex = 25
Top = 1320
Width = 1092
End
Begin VB.Line Line1
BorderStyle = 5 'Dash-Dot-Dot
BorderWidth = 3
X1 = 1200
X2 = 4060
Y1 = 3120
Y2 = 3120
End
Begin VB.Label lblClasss
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "LicClass:"
ForeColor = &H80000008&
Height = 192
Left = 1260
TabIndex = 14
Top = 3720
Width = 792
End
Begin VB.Label lblExp
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "LicExpire:"
ForeColor = &H80000008&
Height = 240
Left = 1260
TabIndex = 13
Top = 3480
Width = 792
End
Begin VB.Label lblBir
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Birthday:"
ForeColor = &H80000008&
Height = 240
Left = 1260
TabIndex = 12
Top = 3240
Width = 792
End
Begin VB.Shape Shape1
BorderWidth = 2
Height = 1812
Left = 1200
Top = 2160
Width = 2892
End
Begin VB.Label lblClass
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "License Class"
ForeColor = &H80000008&
Height = 192
Left = 2040
TabIndex = 11
Top = 3720
Width = 1992
End
Begin VB.Label lblExpires
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Lic Expires"
ForeColor = &H80000008&
Height = 240
Left = 2040
TabIndex = 10
Top = 3480
Width = 1992
End
Begin VB.Label lblBirth
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Birthday"
ForeColor = &H80000008&
Height = 240
Left = 2040
TabIndex = 9
Top = 3240
Width = 1992
End
Begin VB.Label lblCity
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "City, State, Zip"
ForeColor = &H80000008&
Height = 240
Left = 1260
TabIndex = 8
Top = 2760
Width = 2772
End
Begin VB.Label lblAddr2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Address"
ForeColor = &H80000008&
Height = 240
Left = 1200
TabIndex = 7
Top = 1800
Visible = 0 'False
Width = 2772
End
Begin VB.Label lblAddr1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Address"
ForeColor = &H80000008&
Height = 240
Left = 1260
TabIndex = 6
Top = 2520
Width = 2772
End
Begin VB.Label lblName
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Name, Call"
ForeColor = &H80000008&
Height = 240
Left = 1260
TabIndex = 5
Top = 2280
Width = 2772
End
Begin VB.Label lblHelp
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Enter the search data above."
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 7.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 252
Left = 1200
TabIndex = 4
Top = 1560
Width = 2664
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmCDRom"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Static Function FCCDate$(D$)
Yr$ = Left$(D$, 2)
Leap = 0
If Val(Yr$) Mod 4 = 0 Then Leap = 1
Dd = Val(Mid$(D$, 3))
M = 0 'Month
DT = 0
Do
M = M + 1
MT = Val(Mid$("312831303130313130313031", M * 2 - 1, 2))
DT = DT + MT
If Leap And M = 2 Then DT = DT + 1
Loop While DT < Dd
If DT >= Dd Then
DT = DT - MT
If Leap And M = 2 Then DT = DT - 1
End If
Dd = (Dd - DT) 'Day
D$ = Right$(Chr$(48) + QPTrim$(Str$(M)), 2) + Chr$(47)
D$ = D$ + Right$(Chr$(48) + QPTrim$(Str$(Dd)), 2) + Chr$(47) + Yr$
FCCDate$ = D$
End Function
Static Function ConvCase$(Work$)
Call Lower(Work$)
Call ProperName(Work$)
If InStr(UCase$(Work$), "POB") <> 0 Then
Where = InStr(UCase$(Work$), "POB")
Mid$(Work$, Where, 3) = "POB"
End If
If InStr(UCase$(Work$), "AFB") <> 0 Then
Where = InStr(UCase$(Work$), "AFB")
Mid$(Work$, Where, 3) = "AFB"
End If
ConvCase$ = Work$
End Function
Sub SetIndex()
''NoIndex = 0
''CallsignIndex = 1
''NameIndex = 2
''CityIndex = 3
''OldCallIndex = 4
''ZipCodeIndex = 5
CallSignCloseIndex
If CallSignSetIndex(Search) = 0 Then
MsgBox "Unable to set the index to the callsign index!"
CallSignClose
End
Else
NextRec& = CallSignFirstRec&()
End If
End Sub
Private Sub cmdAbout_Click()
frmAbout.Show
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFind_Click()
FindTheCall
ShowTheCall
txtCall.SetFocus
End Sub
Private Sub FindTheCall()
'iNoIndex = 0
'iCallsignIndex = 1
'iNameIndex = 2
'iCityIndex = 3
'iOldCallIndex = 4
Screen_MouseCursor = HOURGLASS
Srch$ = UCase$(Trim$(txtCall.Text))
If Trim$(Srch$) <> "" Then
Found& = CallSignSearchRec(Srch$)
If Found& = 0 Then
Ok = MsgBox("Callsign was not found.", 64, "Search Complete")
Else
Record = Found&
End If
End If
Screen_MouseCursor = Default
End Sub
Private Sub ShowTheCall()
Ok = CallSignGetRecord(Record, Rcd)
txtCall.Text = Rcd.CallSign
Rcd.LastName = ConvCase$(Rcd.LastName)
Rcd.FirstName = ConvCase$(Rcd.FirstName)
Rcd.Suffix = ConvCase$(Rcd.Suffix)
Rcd.Address = ConvCase$(Rcd.Address)
'Rcd.Address2 = ConvCase$(Rcd.Address2)
Rcd.City = ConvCase(Rcd.City)
Suffix$ = " " + Trim$(Rcd.Suffix)
If Trim$(Suffix$) <> "" Then
lblName.Caption = Trim$(Rcd.FirstName) + " " + Trim$(Rcd.Initial) + " " + Trim$(Rcd.LastName) + Suffix$ + ", " + Rcd.CallSign
Else
lblName.Caption = Trim$(Rcd.FirstName) + " " + Trim$(Rcd.Initial) + " " + Trim$(Rcd.LastName) + ", " + Rcd.CallSign
End If
lblAddr1.Caption = Trim$(Rcd.Address)
'If Trim$(Rcd.Address2) <> "" Then
' lblAddr2.Caption = Trim$(Rcd.Address2)
lblCity.Caption = Trim$(Rcd.City) + ", " + Rcd.State + " " + Trim$(Rcd.ZipCode)
'Else
' lblAddr2.Caption = Trim$(Rcd.City) + ", " + Rcd.State + " " + Trim$(Rcd.Zip)
' lblCity.Caption = Trim$(Rcd.Address2)
'End If
lblBirth.Caption = FCCDate$(Rcd.BirthDate)
lblExpires.Caption = FCCDate$(Rcd.ExpDate)
Select Case Rcd.ClassLic
Case "N": lblClass.Caption = "Novice"
Case "T": lblClass.Caption = "Tech"
Case "P": lblClass.Caption = "Tech Plus HF"
Case "G": lblClass.Caption = "General"
Case "A": lblClass.Caption = "Advanced"
Case "E": lblClass.Caption = "Extra"
Case Else
End Select
End Sub
Private Sub cmdLogIt_Click()
If Trim$(DefaultLabelFile) = "" Then
DefaultLabelFile = "C:\AMSOFT.LBL"
End If
FreeOne = FreeFile
If LabelFileAppend Then
Open DefaultLabelFile For Append Shared As #FreeOne
Else
Open DefaultLabelFile For Output Shared As #FreeOne
End If
C = 0
Print #FreeOne, lblName.Caption: C = C + 1
Print #FreeOne, lblAddr1.Caption: C = C + 1
If Trim$(lblAddr2.Caption) <> "" Then
Print #FreeOne, lblAddr2.Caption: C = C + 1
End If
Print #FreeOne, lblCity.Caption: C = C + 1
Print #FreeOne, " "
Print #FreeOne, " "
If C = 3 Then Print #FreeOne, " "
Close #FreeOne
End Sub
Private Sub cmdNext_Click()
Record = CallSignNextRec&
ShowTheCall
End Sub
Private Sub cmdPrev_Click()
Record = CallSignPrevRec&
ShowTheCall
End Sub
Private Sub cmdPrint_Click()
'On Local Error GoTo PrinterGone
If Trim$(PrintFile) = "" Then
PrintFile = "LPT1"
End If
If Exist(PrintFile) Then
FreeOne = FreeFile
Open PrintFile For Output Shared As #FreeOne
C = 0
Print #FreeOne, lblName.Caption: C = C + 1
Print #FreeOne, lblAddr1.Caption: C = C + 1
'If Trim$(lblAddr2.Caption) <> "" Then
' Print #FreeOne, lblAddr2.Caption: C = C + 1
'End If
Print #FreeOne, lblCity.Caption: C = C + 1
Print #FreeOne, " "
Print #FreeOne, " "
If C = 3 Then Print #FreeOne, " "
Close #FreeOne
Else
MsgBox "Unable to find/open " + PrintFile + "!"
End If
'Exit Sub
'PrinterGone:
' MsgBox "Unable to find/open " + PrintFile + "!"
End Sub
Private Sub Form_Load()
Full$ = ExeName$()
Where = InStr(4, Full$, "\")
If Where <> 0 Then
Path$ = Left$(Full$, Where)
If Path$ = "C:\VB\" Then
Path$ = "C:\AMSOFT\"
End If
End If
If Exist(Path$ + "amsoft.ini") Then
FreeOne = FreeFile
Open Path$ + "amsoft.ini" For Input As #FreeOne
While Not EOF(FreeOne)
Line Input #FreeOne, Temp$
Temp$ = Trim$(UCase$(Temp$))
If Left$(Temp$, 1) <> ";" And InStr(Temp$, "=") <> 0 Then
If InStr(Temp$, ";") <> 0 Then
Temp$ = Trim$(Mid$(Temp$, 1, InStr(Temp$, ";") - 1))
End If
Where = InStr(Temp$, "=")
Cmd$ = Trim$(Mid$(Temp$, 1, Where - 1))
Dat$ = Trim$(Mid$(Temp$, Where + 1))
Select Case Cmd$
Case "CDROMDRIVE": Drive$ = Dat$
If Len(Dat$) = 1 Then Drive$ = Drive$ + ":"
Case "LABELPRINTER"
PrintFile = Dat$
If Trim$(Dat$) = "" Then PrintFile = "LPT1"
Case "DEFAULTLABELFILE"
LabelCallSign = Dat$
Case "CALLSIGNONLABEL"
If Dat$ = "Y" Then CallSignOnLabel = True
Case "LABELFILEAPPEND"
If Dat$ = "Y" Then LabelFileAppend = True
Case "LOCALCLOCK24"
If Dat$ = "Y" Then
time1.TimeMode = True
End If
Case "LOCALCLOCKAMPM"
If Dat$ = "Y" Then
time1.ShowAMPM = True
End If
Case "LOCALHOURSOFFSET"
time1.ZoneOffset = Val(Dat$)
Case "UTCCLOCK24"
If Dat$ = "Y" Then
time2.TimeMode = True
End If
Case "UTCCLOCKAMPM"
If Dat$ = "Y" Then
time2.ShowAMPM = True
End If
Case "UTCHOURSOFFSET"
time2.ZoneOffset = Val(Dat$)
Case "YOURCALLSIGN"
lblYourCallSign.Caption = Chr$(32) + Dat$ + Chr$(32)
Case Else
End Select
End If
Wend
Close #FreeOne
End If
' Open the database...
If Drive$ = "" Then Drive$ = "D:"
If Exist(Drive$ + "\CALLSIGN.DAT") Then
DB$ = Drive$ + "\" + Chr$(0)
ElseIf Exist("D:\CALLSIGN.DAT") Then
DB$ = "D:\" + Chr$(0)
ElseIf Exist("E:\CALLSIGN.DAT") Then
DB$ = "E:\" + Chr$(0)
ElseIf Exist("F:\CALLSIGN.DAT") Then
DB$ = "F:\" + Chr$(0)
ElseIf Exist("G:\CALLSIGN.DAT") Then
DB$ = "G:\" + Chr$(0)
End If
Ok% = CallSignOpen%(DB$)
If Ok% = 0 Then
MsgBox "Unable to find/open CALLSIGN.DAT!"
End
End If
Show
Option9.Value = True
' Do
' DoEvents
' Loop
End Sub
Private Sub Form_LostFocus()
'If frmCDRom.WindowState = 1 Then
' Beep
'End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
CallSignCloseIndex
CallSignClose
' End
End Sub
Private Sub Option1_Click()
Search = 0
SetIndex
End Sub
Private Sub Option10_Click()
Search = 2
SetIndex
End Sub
Private Sub Option11_Click()
Search = 3
SetIndex
End Sub
Private Sub Option12_Click()
Search = 5
SetIndex
End Sub
Private Sub Option2_Click()
Search = 4
SetIndex
End Sub
Private Sub Option9_Click()
Search = 1
SetIndex
End Sub
Private Sub txtCall_LostFocus()
txtCall.Text = UCase$(txtCall.Text)
End Sub