modulefunction.bas

南方科技GPS的BOX

Attribute VB_Name = "ModuleFunction"
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long                                '设置存储路径
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long           '设置存储路径
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long                    '设置存储路径
Private Const MAX_PATH = 260                    '设置存储路径
Private Type BrowseInfo                         '设置存储路径
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Public Declare Function ShellExecute Lib "shell32.dll" _
                Alias "ShellExecuteA" _
                (ByVal hwnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) _
                As Long '打开网页
Public Function strOperate(ByVal strX As String, ByVal strA As String) As ArrayData                '分割字符串
  Dim i As Integer, j As Integer, k As Integer
  Dim cnt As Integer, strTemp As String
  If Trim(strA) <> "" Then
     strX = Trim(strX)
     strA = Trim(strA)
     strX = strX & strA
     For i = 1 To Len(strX)
         If Mid(strX, i, Len(Trim(strA))) = strA Then
            cnt = cnt + 1
            i = i + Len(strA) - 1
         End If
     Next i
     strOperate.COUNT = cnt
     ReDim strOperate.DATA(cnt - 1)
     For j = 1 To Len(strX)
         If Mid(strX, j, Len(strA)) = strA Then
            strOperate.DATA(k) = Left(strX, j - 1)
            strX = Trim(Right(strX, Len(strX) - Len(strOperate.DATA(k)) - Len(strA)))
            k = k + 1
            j = 0
         End If
     Next j
  Else
    strX = Trim(strX)
    strTemp = strX
    For i = 1 To Len(strTemp)
        If Mid(strTemp, i, 1) = " " Then
           cnt = cnt + 1
           strTemp = Trim(Right(strTemp, Len(strTemp) - i + 1))
           i = 0
        End If
    Next i
    strX = strX & " "
    strOperate.COUNT = cnt + 1
    ReDim strOperate.DATA(cnt)
    For i = 1 To Len(strX)
        If Mid(strX, i, 1) = " " Then
           strOperate.DATA(j) = Left(strX, i - 1)
           strX = LTrim(Right(strX, Len(strX) - i + 1))
           j = j + 1
           i = 0
        End If
    Next i
  End If
End Function
Public Function ReturnFolder(lngHwnd As Long, mCaption As String) As String  '获取存储路径
    Dim Browser As BrowseInfo
    Dim lngFolder As Long
    Dim strPath As String
    Dim strTemp As String
    With Browser
        .hOwner = lngHwnd
        .lpszTitle = mCaption
        .pszDisplayName = String(MAX_PATH, 0)
    End With
    strPath = String(MAX_PATH, 0)                           '用空格填充字符串
    lngFolder = SHBrowseForFolder(Browser)                  '调用API函数显示文件夹列表
    If lngFolder Then                                       '使用API函数获取返回的路径
        SHGetPathFromIDList lngFolder, strPath
        strTemp = Left(strPath, InStr(strPath, vbNullChar) - 1)
        If (Right(strTemp, 1) <> "\") Then
            strTemp = strTemp & "\"
        End If
        ReturnFolder = strTemp
    End If
    If ReturnFolder = "\" Then ReturnFolder = ""
End Function
Public Sub mChangeTime(mS As Double, H As Double, M As Double, S As Double)
    H = Int(mS / 60 / 60)
    M = Int((mS - H * 60 * 60) / 60)
    S = mS - H * 60 * 60 - M * 60



End Sub