Attribute VB_Name = "Module1"
Option Explicit


Public Const MaxCF As Double = 43000000000#
Public Const MaxSP As Double = 43000000000#
Public Const MaxRef As Double = 200#
Public Const MinRef As Double = -200#

Public sDate As String * 13
Public sTime As String * 10

Public tsFg As Integer      '1=getting trace data
Public SetupLAN As Integer

Public SLVadr As Integer
Public rd As String

' for Power on recall
Public hostA As String, hostB As String, hostC As String
Public portA As String, portB As String, portC As String
Public HostMode As Integer
Public HostAinput As Integer, HostBinput As Integer, HostCinput As Integer
Public OfsFreq1 As String, OfsFreq2 As String, OfsFreq3 As String


'DispForm
Public Const PointPerPixel As Integer = 10
Public Const VOffset As Integer = 1792
Public VscaleDB As Double                       'dB/Div

Public GridType As Integer ' 0:実線 1:点線
Public GridDivX As Integer, GridDivY As Integer
Public DataGetFg As Boolean    'True:dataを1回以上読んだ
Public SizeValue As Integer    'DispFormのOptionButton値

Public TrcAdt(1002) As Integer
Public TrcBdt(1002) As Integer
Public TrcNumb As Integer       'Trace point
Public TaOn As Boolean
Public TbOn As Boolean

Public rdTrcA(1001) As Integer
Public rdTrcB(1001) As Integer
Private bTrc() As Byte


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function GetQueryDt(cmd As String) As String

DispForm.tmr01.Enabled = False
Call SendDtFunc(cmd)
GetQueryDt = RcvDtFunc
DispForm.tmr01.Enabled = True

End Function

Public Function RcvDtFunc() As String
Dim RcvDt As String

Do While (Form1.tcpClient.BytesReceived = 0)
    DoEvents
Loop
'Debug.Print Form1.tcpClient.BytesReceived
Form1.tcpClient.GetData RcvDt
RcvDtFunc = RcvDt
If Form1.chkMon.Value = 1 Then
    Form1.lstRecv.AddItem Form1.tcpClient.RemoteHost & "-->" & RcvDt
    Form1.lstRecv.ListIndex = Form1.lstRecv.ListCount - 1
    If Form1.lstRecv.ListCount > 100 Then
        Form1.lstRecv.RemoveItem 0
    End If
End If

End Function
Public Sub RcvBDtFunc()
Dim RcvDt As String

On Error Resume Next

Erase bTrc
Do While (Form1.tcpClient.BytesReceived < 2002)
    DoEvents
Loop
'Debug.Print Form1.tcpClient.BytesReceived
Form1.tcpClient.GetData bTrc
If Form1.chkMon.Value = 1 Then
    Form1.lstRecv.AddItem Form1.tcpClient.RemoteHost & "-->" & "B GET"
    Form1.lstRecv.ListIndex = Form1.lstRecv.ListCount - 1
    If Form1.lstRecv.ListCount > 100 Then
        Form1.lstRecv.RemoveItem 0
    End If
End If

End Sub

Public Function SendDtFunc(dt As String) As Integer
    Dim ipErr As Long
    
    SendDtFunc = 0
    On Error GoTo ErrOcc
    ipErr = 0
    
 '相手アプリケーションにデータを送信します
    Form1.tcpClient.SendData dt + vbLf              'Data + Delimiter(LF)
    DoEvents
    If ipErr <> 0 Then                              'Error
        SendDtFunc = 1
        Exit Function
    End If
    
    If Form1.chkMon.Value = 1 Then
        Form1.lstRecv.AddItem Form1.tcpClient.RemoteHost & "<--" & dt
        Form1.lstRecv.ListIndex = Form1.lstRecv.ListCount - 1
        If Form1.lstRecv.ListCount > 100 Then
            Form1.lstRecv.RemoveItem 0
        End If
    End If
    Exit Function

ErrOcc:
    ipErr = Err.Number
    Form1.lstRecv.AddItem Format(Err.Number) & Err.Description
    Form1.lstRecv.ListIndex = Form1.lstRecv.ListCount - 1
    If Form1.lstRecv.ListCount > 100 Then
        Form1.lstRecv.RemoveItem 0
    End If
    Resume Next

End Function


Public Sub bGetWave()
Dim mnb As Integer, i As Integer
Dim Cell As Integer, tmp As Integer
Dim trc() As Byte

TrcNumb = 1001
TaOn = False
TbOn = False

Call SendDtFunc("DLIM0")
Call SendDtFunc("TA?")
rd = RcvDtFunc
If (Val(rd) And &HF) <> 2 Then
    TaOn = True
    Call SendDtFunc("DLIM2")
    Call SendDtFunc("TBA?")
    Call RcvBDtFunc

    If DispForm.InvertDspA.Value = 0 Then            'Invert Display (V2.2)
        For i = 0 To 1000
            TrcAdt(i) = bTrc(i * 2) * 256 + CInt(bTrc(i * 2 + 1))
        Next i
    Else
         For i = 0 To 1000
            TrcAdt(1000 - i) = bTrc(i * 2) * 256 + CInt(bTrc(i * 2 + 1))
        Next i
    End If
    
End If

Call SendDtFunc("DLIM0")
Call SendDtFunc("TB?")
rd = RcvDtFunc
If (Val(rd) And &HF) <> 2 Then
    TbOn = True
    Call SendDtFunc("DLIM2")
    Call SendDtFunc("TBB?")
    Call RcvBDtFunc

    If DispForm.InvertDspB.Value = 0 Then            'Invert Display (V2.2)
        For i = 0 To 1000
            TrcBdt(i) = bTrc(i * 2) * 256 + CInt(bTrc(i * 2 + 1))
        Next i
    Else
        For i = 0 To 1000
            TrcBdt(1000 - i) = bTrc(i * 2) * 256 + CInt(bTrc(i * 2 + 1))
        Next i
    End If
    
End If
Call SendDtFunc("DLIM0")

End Sub
Public Sub SetRefreshCombo(cRefl As ComboBox)
    cRefl.AddItem "20ms": cRefl.ItemData(cRefl.NewIndex) = 20
    cRefl.AddItem "50ms": cRefl.ItemData(cRefl.NewIndex) = 50
    cRefl.AddItem "100ms": cRefl.ItemData(cRefl.NewIndex) = 100
    cRefl.AddItem "200ms": cRefl.ItemData(cRefl.NewIndex) = 200
    cRefl.AddItem "500ms": cRefl.ItemData(cRefl.NewIndex) = 500
    cRefl.AddItem "1s": cRefl.ItemData(cRefl.NewIndex) = 1000
    cRefl.AddItem "2s": cRefl.ItemData(cRefl.NewIndex) = 2000
    cRefl.AddItem "5s": cRefl.ItemData(cRefl.NewIndex) = 5000
    cRefl.AddItem "10s": cRefl.ItemData(cRefl.NewIndex) = 10000
End Sub

Public Sub SetVbwCombo(cVbw As ComboBox)
    cVbw.AddItem "AUTO": cVbw.ItemData(cVbw.NewIndex) = 0
    cVbw.AddItem "3MHz": cVbw.ItemData(cVbw.NewIndex) = 3000000#
    cVbw.AddItem "1MHz": cVbw.ItemData(cVbw.NewIndex) = 1000000#
    cVbw.AddItem "300kHz": cVbw.ItemData(cVbw.NewIndex) = 300000#
    cVbw.AddItem "100kHz": cVbw.ItemData(cVbw.NewIndex) = 100000#
    cVbw.AddItem "30kHz": cVbw.ItemData(cVbw.NewIndex) = 30000#
    cVbw.AddItem "10kHz": cVbw.ItemData(cVbw.NewIndex) = 10000#
    cVbw.AddItem "3kHz": cVbw.ItemData(cVbw.NewIndex) = 3000#
    cVbw.AddItem "1kHz": cVbw.ItemData(cVbw.NewIndex) = 1000#
    cVbw.AddItem "300Hz": cVbw.ItemData(cVbw.NewIndex) = 300
    cVbw.AddItem "100Hz": cVbw.ItemData(cVbw.NewIndex) = 100
    cVbw.AddItem "30Hz": cVbw.ItemData(cVbw.NewIndex) = 30
    cVbw.AddItem "10Hz": cVbw.ItemData(cVbw.NewIndex) = 10

End Sub
Public Sub SetRbwCombo(cRbw As ComboBox)
    cRbw.AddItem "AUTO": cRbw.ItemData(cRbw.NewIndex) = 0
    cRbw.AddItem "3MHz": cRbw.ItemData(cRbw.NewIndex) = 3000000#
    cRbw.AddItem "1MHz": cRbw.ItemData(cRbw.NewIndex) = 1000000#
    cRbw.AddItem "300kHz": cRbw.ItemData(cRbw.NewIndex) = 300000#
    cRbw.AddItem "100kHz": cRbw.ItemData(cRbw.NewIndex) = 100000#
    cRbw.AddItem "30kHz": cRbw.ItemData(cRbw.NewIndex) = 30000#
    cRbw.AddItem "10kHz": cRbw.ItemData(cRbw.NewIndex) = 10000#
    cRbw.AddItem "3kHz": cRbw.ItemData(cRbw.NewIndex) = 3000#
    cRbw.AddItem "1kHz": cRbw.ItemData(cRbw.NewIndex) = 1000#
    cRbw.AddItem "300Hz": cRbw.ItemData(cRbw.NewIndex) = 300
    cRbw.AddItem "100Hz": cRbw.ItemData(cRbw.NewIndex) = 100

End Sub

Public Function CplSFormat(dTime As Double) As String
If dTime < 0.001 Then
    CplSFormat = Format(dTime * 1000000#, "####0.0") & " us"
ElseIf dTime < 1# Then
    CplSFormat = Format(dTime * 1000#, "####0.0") & " ms"
Else
    CplSFormat = Format(dTime, "####0.0") & " s"
End If

End Function

Public Function DmkrSweep(dTime As Double) As String
If dTime < 0.001 Then
    DmkrSweep = Format(dTime * 1000000#, "####0.00") & " us"
ElseIf dTime < 1# Then
    DmkrSweep = Format(dTime * 1000#, "####0.000") & " ms"
Else
    DmkrSweep = Format(dTime, "####0.000") & " s"
End If

End Function

Public Function CplFFormat(dFreq As Double) As String
If dFreq < 1000# Then
    CplFFormat = Format(dFreq, "####0") & " Hz"
ElseIf dFreq < 1000000# Then
    CplFFormat = Format(dFreq / 1000#, "####0") & " kHz"
ElseIf dFreq < 1000000000# Then
    CplFFormat = Format(dFreq / 1000000#, "####0") & " MHz"
Else
    CplFFormat = ""
End If

End Function

Public Sub FormatCfSpan(Freq As Double, Span As Double, cf As String, Sp As String)
Dim Form As String, cc As String, Str As String, SetFormat As String
Dim Work As Double
Dim Lwork As Long, Lwork2 As Long, Lwork3 As Long
Dim l As Long
Dim iWork As Integer
Dim Dwork As Double, Dwork2 As Double
Dim Sbeki As Long, Ssimo As Long
Dim Fbeki As Long, Fsimo As Long
    
    
    cf = ""
    Sp = ""
    
    If Span > 0 Then
        SetFormat = Left(Format(Log(Span) / Log(10#)), 2)
        Sbeki = CLng(Val(SetFormat))
        Lwork = Sbeki Mod 3
        Lwork = 3 - Lwork
        Form = ""
        For l = 1 To Lwork
            Form = Form & "0"
        Next l
        If Lwork > 0 Then
            Form = "." & Form
        End If
    Else
        Form = ""
        Sbeki = 3
        Lwork = 0
    End If
    
    Ssimo = Lwork
    If Span < 1000# Then
        SetFormat = Format(Span, "###0" & Form) & " Hz"
    ElseIf Span < 1000000# Then
        SetFormat = Format(Span / 1000#, "###0" & Form) & " kHz"
    ElseIf Span < 1000000000# Then
        SetFormat = Format(Span / 1000000#, "###0" & Form) & " MHz"
    ElseIf Span < 10000000000# Then
        SetFormat = Format(Span / 1000000000#, "###0" & Form) & " GHz"
    Else
        SetFormat = Format(Span / 1000000000#, "###0" & Form & "0") & " GHz"
    End If
    Sp = SetFormat
    
    If Freq > 0 Then
        SetFormat = Left(Format(Log(Freq) / Log(10#)), 2)
        Fbeki = CLng(Val(SetFormat))
        Lwork2 = Fbeki - (Sbeki - 3)    'Ｆと、ＳＰＡＮの最小表示桁の差（１０のべき乗単位）
        Lwork3 = Fbeki Mod 3            'Ｆの表示単位(GHz,MHz,kHz)に対する差（１０のべき乗単位）
        Lwork = Lwork2 - Lwork3
        Form = ""
        For l = 1 To Lwork
            Form = Form & "0"
        Next l
        If Lwork > 0 Then
            Form = "." & Form
        End If
    Else
        Form = ""
        Lwork = 0
    End If
    
    Fsimo = Lwork
    If Freq < 1000# Then
        SetFormat = Format(Freq, "###0" & Form) & " Hz"
    ElseIf Freq < 1000000# Then
        SetFormat = Format(Freq / 1000#, "###0" & Form) & " kHz"
    ElseIf Freq < 1000000000# Then
        SetFormat = Format(Freq / 1000000#, "###0" & Form) & " MHz"
    ElseIf Freq < 10000000000# Then
        SetFormat = Format(Freq / 1000000000#, "###0" & Form) & " GHz"
    Else
        SetFormat = Format(Freq / 1000000000#, "###0" & Form & "0") & " GHz"
    End If
    cf = SetFormat

End Sub


'Select a Text box ALL
'
Public Sub SelTxtAll(txt As Object)

txt.SelStart = 0
txt.SelLength = Len(txt.Text)

End Sub
' @(f)
' 機能      :Permit a key to input only Integer(+/-)
' 引き数    :ARG1 - Key code
' 返り値    :なし
' 機能説明  :整数入力のみ受け付け
Public Sub TextKeyChkAllInt(KeyAscii As Integer)
Dim key As String

   key = Chr$(KeyAscii)
    
    Select Case key
        Case "0" To "9", Chr$(vbKeyBack), "-" ', Chr$(vbKeyDelete)
            
        Case Else
            KeyAscii = 0
    End Select

End Sub

' @(f)
' 機能      :Permit a key to input only Integer(+)
' 引き数    :ARG1 - Key code
' 返り値    :なし
' 機能説明  :正の整数入力のみ受け付け
Public Sub TextKeyChkInt(KeyAscii As Integer)
Dim key As String

   key = Chr$(KeyAscii)
    
    Select Case key
        Case "0" To "9", Chr$(vbKeyBack)
            
        Case Else
            KeyAscii = 0
    End Select

End Sub
' @(f)
' 機能      :Permit a key to input only Real
' 引き数    :ARG1 - Key code
' 返り値    :なし
' 機能説明  :実数入力のみ受け付け
Public Sub TextKeyChkReal(KeyAscii As Integer)
Dim key As String

   key = Chr$(KeyAscii)
    
    Select Case key
        Case "0" To "9", Chr$(vbKeyBack), ".", "-"
        Case Else
            KeyAscii = 0
    End Select

End Sub

