Attribute VB_Name = "Module1"
Option Explicit
Public CalibrFreq As Single
Public CalibrUr As Single
Public InOhmAdc As Single
Public CalibrVoltmData As Single
Public param_form_load As Boolean
Public start_calibr As Boolean
Public temp_data As Single

Public Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Public Sub RefreshDac()
Dim myerr As Long
Sleep (100)
myerr = MainForm.Unit1.SetParam(0, 1)            ' Тип сигнала - синус
Sleep (10)
myerr = MainForm.Unit1.SetParam(1, CalibrFreq)   ' Частота сигнала
Sleep (10)
myerr = MainForm.Unit1.SetParam(2, CalibrUr)     ' Уровень сигнала
Sleep (10)
myerr = MainForm.Unit1.SetParam(5, 0)            ' Смещение нуля
Sleep (10)
myerr = MainForm.Unit1.SetParam(255, 0)          ' Включить
End Sub

Public Function VerifyKey(KeyCode As Integer, stroka As String) As Boolean
If KeyCode < 48 Or KeyCode > 57 Then
    If KeyCode = 46 Then                'точка
        If InStr(stroka, ".") <> 0 Then 'если точка уже есть
            VerifyKey = False
            Exit Function
        Else
            KeyCode = KeyCode
            VerifyKey = True
            Exit Function
        End If
    End If
    
'    If KeyCode = 101 Then               '"e"
'        If InStr(stroka, "e") <> 0 Then 'если "е" уже есть
'            VerifyKey = False
'            Exit Function
'        Else
'            KeyCode = KeyCode
'            VerifyKey = True
'            Exit Function
'        End If
'    End If
    
'    If KeyCode = 45 Then                'минус
'        If InStr(stroka, "-") <> 0 Then 'если минус уже есть
'            VerifyKey = False
'            Exit Function
'        Else
'            KeyCode = KeyCode
'            VerifyKey = True
'            Exit Function
'        End If
'    End If
    
    If KeyCode = 8 Then                 'Backspace
        KeyCode = KeyCode
        VerifyKey = True
    Else
        Beep
        KeyCode = 0
        VerifyKey = False
    End If
Else
    VerifyKey = True
End If
End Function


Public Static Sub Kodir(stroka As String, strend As String)
Dim X As Integer, i As Integer
strend = ""
For i = 1 To Len(stroka)
X = Asc(Mid(stroka, i, 1))
 If X >= &H80 Then
  If X >= &HE0 Then
   X = X + &H10
  Else
   X = X + &H40
  End If
  If X = 256 Then X = &HA8
  If X = 257 Then X = &HB8
 End If
If X > 255 Then X = 255
strend = strend & Chr$(X)
Next i
End Sub

Public Sub DeKodir(stroka As String, strend As String)
Dim X As Integer, i As Integer
strend = ""
For i = 1 To Len(stroka)
 X = Asc(Mid(stroka, i, 1))
 If X >= &H80 Then
  X = X - &H10
  If X < &HE0 Then X = X - &H30
  If X = &H68 Then X = &HF0
  If X = &H78 Then X = &HF1
  If X <= 0 Then X = 1
  If X > 255 Then X = 255
 End If
strend = strend & Chr$(X)
Next i
End Sub
Public Sub GetDigit(stroka As String, strend As String)
Dim X As Integer, i As Integer
strend = ""
For i = 1 To Len(stroka)
 X = Asc(Mid(stroka, i, 1))
 Select Case X
 Case 46, 48 To 57
 strend = strend & Chr$(X)
 End Select
Next i
End Sub

Public Sub GetParam(param As String, keystr As String, filestr As String)
Dim filenumber As Integer
Dim stroka As String
Dim pos As Integer
Dim strik
param = ""
filenumber = FreeFile   ' Get unused file number.
On Error Resume Next
Open filestr For Input As #filenumber
If Err.Number = 0 Then
    Do While Not EOF(filenumber)
        stroka = ""
        Line Input #filenumber, stroka
        stroka = LCase$(stroka)
        pos = InStr(1, stroka, " ")
        strik = Left$(stroka, pos - 1)
        strik = Trim(strik)
        If StrComp(strik, keystr, vbTextCompare) = 0 Then
            strik = Right$(stroka, Len(stroka) - pos)
            param = Trim(strik)
        End If
        Loop
End If
Close #filenumber
End Sub

Public Sub GetSignal(PathSig As String, keystr As String)
Dim filenumber As Integer
Dim stroka As String, strik As String
Dim pos As Integer

PathSig = ""
filenumber = FreeFile   ' Get unused file number.
Open App.Path & "\config.pth" For Input As filenumber
Line Input #filenumber, stroka
Line Input #filenumber, stroka
Close #filenumber
Open stroka For Input As #filenumber
Line Input #filenumber, stroka
 Do While Not EOF(filenumber)
  stroka = ""
  Line Input #filenumber, stroka
  stroka = LCase$(stroka)
  pos = InStr(1, stroka, "=")
  strik = Left$(stroka, pos - 1)
  strik = Trim(strik)
   If StrComp(strik, keystr, vbTextCompare) = 0 Then
    strik = Right$(stroka, Len(stroka) - pos)
    strik = Trim(strik)
    stroka = Right$(strik, 1)
     If StrComp(stroka, "\", vbTextCompare) <> 0 Then
      strik = strik & "\"
     End If
    PathSig = strik
   End If
 Loop
Close #filenumber
End Sub
Public Static Sub PutSignal(PathSig As String, keystr As String)
Dim filenumber As Integer
Dim FileForWrite As Integer
Dim stroka As String, stroch As String
Dim strmy, strik As String
Dim pos

filenumber = FreeFile   ' Get unused file number.
Open App.Path & "\config.pth" For Input As filenumber
Line Input #filenumber, stroka
Line Input #filenumber, stroka
Close #filenumber
strmy = Left$(stroka, Len(stroka) - 1)
Open stroka For Input As #filenumber
FileForWrite = FreeFile   ' Get unused file number.
Open strmy For Output As #FileForWrite
Line Input #filenumber, stroch
Print #FileForWrite, stroch
 Do While Not EOF(filenumber)
  stroch = ""
  Line Input #filenumber, stroch
  stroch = LCase$(stroch)
  pos = InStr(1, stroch, "=")
  strik = Left$(stroch, pos - 1)
  strik = Trim(strik)
   If StrComp(strik, keystr, vbTextCompare) = 0 Then
    Print #FileForWrite, keystr & "=" & PathSig
   Else
    Print #FileForWrite, stroch
   End If
 Loop
Close #filenumber   '-------------------
Close #FileForWrite '-------------------
Close
Kill stroka
Name strmy As stroka
End Sub

Public Static Sub PutParam(PathSig As String, keystr As String, param As String)
Dim filenumber As Integer
Dim FileForWrite As Integer
Dim stroka As String, stroch As String, strxx As String
Dim strmy, strik As String
Dim pos, prisnak

On Error Resume Next

filenumber = FreeFile   ' Get unused file number.
Open PathSig For Input As #filenumber
FileForWrite = FreeFile   ' Get unused file number.
strmy = Left$(PathSig, Len(PathSig) - 1)
Open strmy For Output As #FileForWrite
prisnak = 0
 Do While Not EOF(filenumber)
  stroch = ""
  Line Input #filenumber, strxx
  stroch = LCase$(strxx)
  pos = InStr(1, stroch, " ")
  strik = Left$(stroch, pos - 1)
  strik = Trim(strik)
   If StrComp(strik, LCase$(keystr), vbTextCompare) = 0 Then
    Print #FileForWrite, keystr & " " & param
    prisnak = 1
   Else
    Print #FileForWrite, strxx
   End If
 Loop
 If prisnak = 0 Then Print #FileForWrite, keystr & " " & param
'Close (filenumber)
'Close (FileForWrite)
Close
Kill PathSig
Name strmy As PathSig
End Sub

Public Static Sub PoisKanal(search As String, key As String, kanal As Integer)
Dim pos As Integer, pos1 As Integer
Dim stroka As String, strok As String
 pos = InStr(1, search, key)
  If pos = 0 Then
   MsgBox "Проведите измерения", 64, "Стой"
   kanal = -1
  End If
 pos = pos + Len(key) - 1
 stroka = Right(search, Len(search) - pos)
 pos1 = InStr(1, stroka, " ")
 strok = Left(stroka, pos1 - 1)
 'pos2 = InStr(pos1, ss, " ", vbTextCompare)
 kanal = Val(stroka)
End Sub

Public Static Sub FreqForGen(fgen As Double, fdiskri As Double, fras As Double)
Dim k As Integer, kmax As Integer
Dim n As Double, fr As Double, fres As Double
Dim otkl As Double, Max As Double, min As Double
Dim a
fr = fgen
otkl = 100000 * fr
If fr >= 1000 Then kmax = 46 Else: kmax = 5
 For k = 1 To kmax
 n = 8000000# / 8192# / fr * k
  If n > 65535 Then n = 65535
   n = CLng(n)
  If n < 4 Then n = 4
  fres = 8000000# / 8192# * k / n
  Max = fres - fr
  If Max < 0 Then Max = -Max
  If Max < otkl Then
    otkl = Max
   min = k
  End If
 Next k
n = 8000000# / 8192# / fr * min
If n > 65535 Then n = 65535
n = CLng(n)
fres = 8000000# / 8192# * min / n
'Text2.Text = fres
fras = fres
fdiskri = 8000000# / n
End Sub

'чтение параметра без перевода букв в нижний регистр (разделитель ключа и параметра - пробел)
Public Sub GetName(param As String, keystr As String, filestr As String)
Dim filenumber As Integer
Dim stroka As String
Dim pos As Integer
Dim strik
param = ""
filenumber = FreeFile   ' Get unused file number.
Open filestr For Input As #filenumber
 Do While Not EOF(filenumber)
  stroka = ""
  Line Input #filenumber, stroka
  pos = InStr(1, stroka, " ")
  strik = Left$(stroka, pos - 1)
  strik = Trim(strik)
   If StrComp(strik, keystr, vbTextCompare) = 0 Then
    strik = Right$(stroka, Len(stroka) - pos)
    param = Trim(strik)
   End If
 Loop
Close #filenumber
End Sub

'процедура перезаписи существующего параметра (разделитель ключа и параметра - пробел)
Public Sub RenameParam(param As String, keystr As String, filestr As String)
Dim FileForRead As Integer
Dim FileForWrite As Integer
Dim stroka As String, stroch As String, strxx As String
Dim strmy, strik As String
Dim pos, prisnak

On Error Resume Next

FileForRead = FreeFile
Open filestr For Input As #FileForRead       'откр. файл для чтения
FileForWrite = FreeFile
strmy = Left$(FileForRead, Len(FileForRead) - 1)
Open strmy For Output As #FileForWrite      'откр. файл с другим именем для записи

Do While Not EOF(FileForRead)               'пока не конец файла
    stroch = ""
    Line Input #FileForRead, strxx          'считываем в нем строку
    stroch = LCase$(strxx)                  'в нижний регистр
    pos = InStr(1, stroch, " ")             'ищем пробел
    strik = Left$(stroch, pos - 1)
    strik = Trim(strik)                     'считали ключевое слово параметра
    If StrComp(strik, LCase$(keystr), vbTextCompare) = 0 Then   'если ключевое слово такое, как мы ищем
        Print #FileForWrite, keystr & " " & param               'пишем ключевое слово и параметр
        prisnak = 1                                             'признак найденного ключевого слова
    Else
        Print #FileForWrite, strxx                              'иначе записываем прочитанную строку
    End If
Loop                                        'повторяем пока не конец файла
If prisnak = 0 Then Print #FileForWrite, keystr & " " & param   'если строку с искомым ключевым словом не нашли
Close #FileForRead
Close #FileForWrite
'Close
Kill filestr
Name strmy As filestr


End Sub


Public Function Log10(X As Double)
    Log10 = Log(X) / Log(10#)
End Function
