module9.bas

来自「用户MODBUS规约通信编程,起参考作用.」· BAS 代码 · 共 98 行

Attribute VB_Name = "Module9"
Option Explicit
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerial_Numberber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Const GETDI_SERIAL = 1
Public Const GETDI_LABEL = 2
Public Const GETDI_TYPE = 3



Public InSound As Boolean
Public SoundVal As Integer
Public Message As Integer

Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
Public Declare Function LoadStandardIcon Lib "user32" Alias _
    "LoadIconA" (ByVal hInstance As Long, ByVal lpIconNum As _
    SystemIconConstants) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hDC _
    As Long, ByVal X As Long, ByVal Y As Long, _
    ByVal hIcon As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
    
Enum SystemIconConstants
    IDI_Application = 32512
    IDI_Error = 32513       'vbCritical (a.k.a. IDI_Hand)
    IDI_Question = 32514    'vbQuestion
    IDI_Warning = 32515     'vbExlamation (a.k.a. IDI_Exclamation)
    IDI_Information = 32516 'vbInformation (a.k.a. IDI_Asterisk)
    IDI_WinLogo = 32517
End Enum

Public Const MB_IconAsterisk = &H10&
Public Const MB_IconQuestion = &H20&
Public Const MB_IconExclamation = &H30&
Public Const MB_IconInformation = &H40&

Public Sub FormDrag(TheForm As Form)
   ReleaseCapture
   SendMessage TheForm.hWnd, &HA1, 2, 0&
End Sub
Public Function QualifyPath(Path) As String
   If Right(Path, 1) = "\" Then
      QualifyPath = Path
   Else
      QualifyPath = Path & "\"
   End If
End Function

Public Sub PlaySound(Flavor As Integer)
   Const SYNC = 1
   Dim temp As String
   If InSound Then
      If Flavor = 60 Then
         temp = "Hover.wav"
      ElseIf Flavor = 61 Then
         temp = "Clique.wav"
      End If
      sndPlaySound ByVal App.Path & "\" & temp, SYNC
   End If
End Sub




Public Sub MakeFormRounded(Obj As Object, Radius As Long)
    Dim hRgn As Long
    hRgn = CreateRoundRectRgn(0, 0, Obj.ScaleWidth, Obj.ScaleHeight, Obj.ScaleWidth / Radius, Obj.ScaleHeight / Radius)
    SetWindowRgn Obj.hWnd, hRgn, True
    Call DeleteObject(hRgn)
End Sub

Function GetDriveInfo(strDrive As String, iType As Integer)
    
    Dim Serial_Number As Long
    Dim Drive_Label As String
    Dim Fat_Type As String
    
    Dim Return_Value As Long
    
    Drive_Label = Space(256)
    Fat_Type = Space(256)
    
    Return_Value = GetVolumeInformation(strDrive, Drive_Label, Len(Drive_Label), Serial_Number, 0, 0, Fat_Type, Len(Fat_Type))
    
    GetDriveInfo = CStr(Serial_Number)
    

End Function