publicfunction.bas

一个clock的 vb 源码

Attribute VB_Name = "PublicFunction"
Option Explicit

Public Const WM_MYNOTIFY = WM_USER + 108
Private uID As Long, tnid As NOTIFYICONDATA
Private hTrayIcon As Long

Public Sub DrawFrame(hDc As Long, Left&, Right&, Top&, Bottom&)
    ' 画框架控件线条
    Dim frameRect As RECT
        With frameRect
            .Left = Left
            .Right = Right
            .Top = Top
            .Bottom = Bottom
        End With
    Call DrawEdge(hDc, frameRect, EDGE_ETCHED, BF_RECT)
End Sub

Public Sub DrawButton(hDc As Long, Left&, Right&, Top&, Bottom&)
    ' 特殊效果的按钮(画按钮的边缘)
    Dim lpRect As RECT
        With lpRect
            .Left = Left
            .Right = Right
            .Top = Top
            .Bottom = Bottom
        End With
    DrawEdge hDc, lpRect, EDGE_SUNKEN, BF_RECT
End Sub

Public Function GetWindowsInfo() As Boolean
    '   判断用户所使用的操作系统及版本
    '   这钟方法并不保险，要判断是否可以使用 Win2000的通明窗体函数
    '   可判断 user32 Dll 的版本
    Dim OSInfo As OSVERSIONINFO
    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    Call GetVersionEx(OSInfo)
    If OSInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And OSInfo.dwMajorVersion > 4 Then
            GetWindowsInfo = True
    Else
            GetWindowsInfo = False
    End If
End Function

Public Function AddTrayIcon(hWnd As Long)
    tnid.cbSize = Len(tnid)
    tnid.hWnd = hWnd
    tnid.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    tnid.szTip = "小闹钟 V1.5" & vbNullChar
    hTrayIcon = LoadResImage(App.hInstance, 1, IMAGE_ICON, 0, 0, 0)
    tnid.hIcon = hTrayIcon
    tnid.uID = uID
    tnid.uCallbackMessage = WM_MYNOTIFY
    Call Shell_NotifyIcon(NIM_ADD, tnid)
End Function

Public Function DelTrayIcon()
    Call DestroyIcon(hTrayIcon)
    Call Shell_NotifyIcon(NIM_DELETE, tnid)
End Function

Public Function BugleSound() As Long
' 用机算机内置的小喇叭来报时 仅用于NT系统
    Dim I As Long
    If GetWindowsInfo Then
        For I = 0 To 3
            If I < 3 Then: BeepApi 700, 1500
            Call Sleep(1000) '线等待一秒
            If I > 2 Then BeepApi 1400, 1500
        Next
    End If
End Function
   
Public Function FnPtrToLong(ByVal lngFnPtr As Long) As Long
   FnPtrToLong = lngFnPtr
End Function

Public Function HIWord(LongIn As Long) As Integer
     ' Visual C++ Macro 转换高字节
     ' #define HIWORD(l)   ((WORD) (((DWORD) (l) >> 16) & 0xFFFF))
     HIWord = (LongIn And &HFFFF) \ &H10000
End Function

Public Function GetFileName(strFileName As String) As String
   Dim X As Long
   X = InStrRev(strFileName, "\")
   GetFileName = Mid$(strFileName, X + 1)
End Function

Public Function GetFilePath(strFilePath As String) As String
   Dim X As Long
   X = InStrRev(strFilePath, "\")
   GetFilePath = Left$(strFilePath, X)
End Function

Public Function LoWord(LongIn As Long) As Integer
  ' Visual C++ Macro 转换低字节
  ' #define LOWORD(l)   ((WORD) (l))
  Dim l As Long
  l& = LongIn& And &HFFFF&
  If l& > &H7FFF Then
       LoWord% = l& - &H10000
  Else
       LoWord% = l&
  End If
End Function

'MsgBox "您使用的操作系统为：" & GetWindowsInfo & "版本：" & tyeInfo.dwMajorVersion & "." & tyeInfo.dwMinorVersion & "  内部编号：" & tyeInfo.dwBuildNumber