module2.bas

企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值

Attribute VB_Name = "mdlApi"
  

Dim bmByte() As Byte

Public Declare Function ReleaseCapture Lib "User32" () As Long

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1


Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long



Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1

'读写ini文件
'得到条目的值(小节，条目，默认值，值，路径)
Declare Function GetPrivateProfileString& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
    '为初始化文件中指定的条目获取一个整数值
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
    
Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String)

'音乐
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
'***************************
Public Sub playmusic(ByVal musicpath As String)
   opwt = "open " & musicpath & " Alias MM"
    mciSendString "close MM", 0, 0, 0
    mciSendString opwt, 0, 0, 0
    mciSendString "Play MM", 0, 0, 0
End Sub
'================================================
'停止播放音乐
'===============================================
Public Sub stopmusic(ByVal musicpath As String)
    mciSendString "close MM", 0, 0, 0
End Sub
'**********************************************************
Public Sub WriteSIni(ByVal SectionName As String, ByVal KeyWord As String, ByVal Value As String)
 Dim tmp
 Dim path As String
 path = App.path & "\RSSET.ini"
   '小节，条目，值any，路径
  tmp = WritePrivateProfileString&(SectionName, KeyWord, Value, path)
End Sub


Public Function ReadSIni(ByVal SectionName As String, ByVal KeyWord As String) As String
 Dim tmp As Integer
 Dim strResult As String * 255
 Dim path As String
 path = App.path & "\RSSET.ini"
 '小节，条目，默认值，返回值，大小，路径
 tmp = GetPrivateProfileString&(SectionName, KeyWord, "", strResult, 255, path)
 ReadSIni = strResult
End Function

Public Function WriteIni(ByVal SectionName As String, ByVal KeyWord As String, ByVal Value As Long) As Boolean
 Dim tmp
 Dim path As String
 path = App.path & "\RSSET.ini"
 WriteIni = False
   '小节，条目，值any，路径
  tmp = WritePrivateProfileString&(SectionName, KeyWord, Value, path)
  If tmp = 1 Then
     WriteIni = True
  End If
End Function


Public Function ReadIni(ByVal SectionName As String, ByVal KeyWord As String) As Long
 Dim tmp As Long
 Dim path As String
 path = App.path & "\RSSET.ini"
 '小节，条目，默认值，返回值，大小，路径
 tmp = GetPrivateProfileInt(SectionName, KeyWord, 0, path)
 ReadIni = tmp
End Function





'**********************************************************
'设置窗口的透明度
Public Function DarkMe(wnd As Form, ByVal alpha As Byte)
    If alpha < 0 Or alpha > 255 Then
        alpha = 255
    End If
    hWnd = wnd.hWnd
    Dim rtn As Long
    rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hWnd, 0, alpha, LWA_ALPHA
    '0----255
End Function