module2.bas

DSO2902示波器源码,半年多才做好的,功能超牛

Attribute VB_Name = "Module2"


'面板控件设置读入及保存到文件模块


Dim strDefaultfilename As String   '默认的配置文件
Dim strCurfilename As String       '当前的配置文件


Public Function readini(filename As String)

On Error Resume Next

Dim ctrobj As Control

Dim Filenum As Integer
Dim strBuff As String
Dim s_col As New Collection
'Dim spliter As New splitword
Dim strCtrname As String
Dim strctrvalue As String

Filenum = FreeFile()
Err.Clear

Open filename For Input As #Filenum
If Err <> 0 Then
    MsgBox "打开文件" & filename & "失败:" & Err.Description
    Err.Clear
    Exit Function
End If

'spliter.addsplitchar "="

While Not EOF(Filenum)

    Input #Filenum, strBuff
    If InStr(strBuff, "=") Then
    
    Else  '
        strCtrname = strBuff
            
        If EOF(Filenum) Then
            MsgBox "配置文件非正常结束,设置失败"
            Close #Filenum
            Set spliter = Nothing
            Set s_col = Nothing
            
            Exit Function
            
        End If
        
        Input #Filenum, strBuff
        
        strctrvalue = strBuff
        
        s_col.Add strctrvalue, strCtrname
        
    End If
Wend


Close #Filenum

'设置控件

Dim strTempstr As String

Err.Clear
For Each ctrobj In Form2.Controls
    
    If TypeOf ctrobj Is Label Then  '标签标题
    
        strTempstr = s_col(ctrobj.Name)
        If Err = 0 Then
            ctrobj.Caption = strTempstr
        Else
            Err.Clear
        End If
        
    ElseIf TypeOf ctrobj Is PictureBox Then  '图片忽略
    
    Else  '非图片 非标签时
    
        strTempstr = s_col(ctrobj.Name)
        If Err = 0 Then
            ctrobj.Value = strTempstr
        Else
            Err.Clear
        End If
        
    End If
    
Next

Err.Clear
Set spliter = Nothing
Set s_col = Nothing

End Function

Public Function readdefaultini()

Dim Filenum As Integer

strDefaultfilename = App.Path & "\default.ini"
If Dir(strDefaultfilename) = "" Then
    
    MsgBox "程序默认文件夹下找不到default.ini配置文件,您可以利用已有配置文件重建该文件,或者重新安装本软件"
    
    Exit Function

Else
    readini strDefaultfilename
End If

End Function

Public Function saveini(filename As String)

Dim ctrobj As Control

Dim Filenum As Integer

Filenum = FreeFile()
Err.Clear

Open filename For Output As #Filenum
If Err <> 0 Then
    MsgBox "打开文件" & filename & "失败:" & Err.Description
    Err.Clear
    Exit Function
End If


For Each ctrobj In Form2.Controls

    If TypeOf ctrobj Is Label Then  '标签输出名字和标题

        Print #Filenum, ctrobj.Name
        Print #Filenum, ctrobj.Caption
        
    ElseIf TypeOf ctrobj Is PictureBox Then  '图片忽略
    
    Else  '非图片 非标签时
        Print #Filenum, ctrobj.Name
        Print #Filenum, ctrobj.Value
    End If
    
Next

Close #Filenum

End Function

Public Function savecurini()

strCurfilename = App.Path & "\dso29xx_dll.ini"

saveini strCurfilename

End Function


Public Function savedsodata(TypeNum As Integer, SaveFilestr As String, saveSize As String)

Dim BuffSize As Long

Select Case UCase(saveSize)
       Case "1K"
       BuffSize = 1024 / 128
       Case "8K"
       BuffSize = 1024 / 16
       Case "128K"
       BuffSize = 1024 * 1
       Case "256K"
       BuffSize = 1024 * 2
End Select

Call SaveDatasinfo(bufanalog0, bufanalog1, buflogic0, SaveFilestr & "bufanalog.txt", BuffSize)
MsgBox "文件保存结束路径=" & SaveFilestr

End Function

Function SaveDatainfo(ByRef ReadData() As Byte, ByVal FileNamestr As String, BuffSize As Long)
Dim Temptxt As String, H As Long
Dim Filenum As Long
Dim i As Long, j As Long, Hhao As Long
Filenum = FreeFile
Temptxt = FileNamestr
H = BuffSize   '提供数据长度
Const L = 128         '提供数据长度
Open Temptxt For Output As Filenum
Close #Filenum
Filenum = FreeFile
Open Temptxt For Output As Filenum
Print #Filenum, "Position"
Hhao = 0
For i = 0 To H - 1
 For j = 0 To L - 1
 Print #Filenum, Format(Hhao, "000000") & Space(10) & ReadData(i, j)
 Hhao = Hhao + 1
 Next j
Next i

Close #Filenum
End Function

Function SaveDatasinfo(ByRef ReadData0() As Byte, ByRef ReadData1() As Byte, ByRef ReadData2() As Byte, ByVal FileNamestr As String, BuffSize As Long)
Dim Temptxt As String, H As Long
Dim Filenum As Long
Dim i As Long, j As Long, Hhao As Long
Filenum = FreeFile
Temptxt = FileNamestr
H = BuffSize  '提供数据长度
Const L = 128        '提供数据长度
Open Temptxt For Output As Filenum
Close #Filenum
Filenum = FreeFile
Open Temptxt For Output As Filenum
Print #Filenum, "Position" & Space(10) & "A1" & Space(10) & "A2" & Space(10) & "logic0"
Hhao = 0
For i = 0 To H - 1
 For j = 0 To L - 1
  Print #Filenum, Format(Hhao, "000000") & Space(10) & ReadData0(i, j) & Space(10) & ReadData1(i, j) & Space(10) & ReadData2(i, j)
  Hhao = Hhao + 1
 Next j
Next i
Close #Filenum
End Function