mainfunction.bas

地面测试仪

Attribute VB_Name = "mMainFunction"

'主模块

Option Base 1 '数组下标从1开始
Option Explicit

Public Const strGdyFlag = "液面高低频数据"
Public Const strDataYTTitle = "地面测试仪数据记录(无高低频)"


Type JianDingYaLi
    JianDingYaLiData(9, 11) As String '检定数据
    JianDingYaLiCol(16) As String '检定报表字段
    JainDingYaLiColData(16) As String '检定报表字段数据
End Type

Type JianDingYeMian
    JianDingYeMiandata(6000, 3) As Integer    '数据,暂时3000组，低频，高频，x轴坐标
    JianDingYeMianCol(13) As String '报表字段
    JianDianYeMianColData(13) As String '报表字段数据
    DianYi As String  '第一个波位置
    DianWuShi As String '第五十个波位置
    GaoPinZuiDa As String '高频最大值
    DiPinZuiDa As String '低频最大值
End Type

Type dmyData
'    timeMax As Long
    HLRowPiont As Long          '高低频绘图时每行点数
    ReadSuc As Boolean          '读取成功
    HaveDym As Boolean          '有没有高低频数据
    YNoodlesMax As Single       '液面最大值
    TPressMax As Single         '套压最大值
    JPressMax As Single         '静压最大值
    HFrequencyMax As Single     '高频最大值
    LFrequencyMax As Single     '低频最大值
    TimeMax As Single           '时间最大值
    fileName As String
    hanshui As String
    zhongshen As String
    
    dmyHead(11) As String      '文件头
    dmyYT() As String         '页面套压数据
    dmyHL() As String         '高低频数据
    dmyRep(37) As String       '报表数据
End Type


''''''''''''''''文件关联用的'''''''''''''''''''''''
Private Const HKEY_CLASSES_ROOT = &H80000000

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1&
Private Const ERROR_BADKEY = 2&
Private Const ERROR_CANTOPEN = 3&
Private Const ERROR_CANTREAD = 4&
Private Const ERROR_CANTWRITE = 5&
Private Const ERROR_OUTOFMEMORY = 6&
Private Const ERROR_INVALID_PARAMETER = 7&
Private Const ERROR_ACCESS_DENIED = 8&

Private Const MAX_PATH = 256&
Private Const REG_SZ = 1
Private Const strApp = "HFdmyfile"
Private Const strFileType = ".dmy"

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long    '这个函数是用来创建注册表的主键
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long   '这个函数用来关闭打开的注册表
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long  '这个函数用来改写注册表的键值
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

''''''''''''''''''''''''THE END''''''''''''''''''
'---------------------------------------------------


Public TempDmyData As dmyData '地面仪数据
Public Const HLRowCount = 4 '高低频绘图每页行数
Public PicFlag As Integer '绘图标志
Public mList As ListView
Public mPic As PictureBox
Public mDialog As CommonDialog


Public Sub RegSet()
'**********************************************************************
'* 函数名称:RegSet
'* 函数描述:文件关联
'* 参数列表:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
    Dim sKeyName As String '键名
    Dim sKeyValue As String '键值
    Dim ret& '结果
    Dim lphKey& '句柄
    Dim strFileRun As String
    Dim strFileIcon As String
    Dim strTemp As String
    Dim lenData As Long
    strFileRun = App.Path & "\" & App.EXEName & ".exe %1"
    strFileIcon = App.Path & "\" & App.EXEName & ".exe,0"
    
   
    sKeyName = strApp '*
    sKeyValue = "地面仪数据" '*
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
    '     创建文件类型
    sKeyName = strFileType '*
    sKeyValue = strApp '*
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
    '     创建对应的扩展名
    sKeyName = strApp '*
    sKeyValue = strFileRun  '*
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)
    '    创建图标
    sKeyName = strApp
    sKeyValue = strFileIcon
    ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
    ret& = RegSetValue&(lphKey&, "shell\DefaultIcon", REG_SZ, sKeyValue, 0&)
    
    RegCloseKey lphKey&
 
End Sub

Function GetStr(Sstr As String, Ssign As String, Optional Snum = 1) As String
'**********************************************************************
'* 函数名称:GetStr
'* 函数描述:获得字符串
'* 参数列表:sstr源字符 ssign指定符号 snum 第几个符号位置
'* 返    回:字符串
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
On Error GoTo errlab
Dim i As Integer
Dim strTemp As String
strTemp = Sstr
For i = 1 To Snum
    strTemp = Mid(strTemp, InStr(1, strTemp, Ssign) + 1)
Next
GetStr = strTemp
Exit Function
errlab:
GetStr = ""
End Function

'字符串补空格
Public Function strFormat(strS As String, strb As String, iLen As Integer, Optional isLeft = True) As String
'**********************************************************************
'* 函数名称:strFormat
'* 函数描述:字符串补空格
'* 参数列表:strS原字符串 strB补充字符 iLen补充后长度 isLeft默认左补齐
'* 返    回:字符串
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************

Dim strTemp As String

If Len(strS) >= iLen Then
    strFormat = strS
    Exit Function
Else
    If isLeft Then
        strTemp = Right(String(iLen, strb) & strS, iLen)
    Else
        strTemp = Left(strS & String(iLen, strb), iLen)
    End If
End If
strFormat = strTemp

End Function