m_function.bas

类似QQ的局域网聊天软件源码.可以实现语音聊天和对话的小型软件

Attribute VB_Name = "M_Function"
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize 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" ()

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
Public strGroupComputerName(200) As String

'**************************************************

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
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2


'**************************************************
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
'**************************************************

'****************半透明*********************
Public Function DarkForm(F As Form) As Boolean
    Dim rtn As Long
    rtn = GetWindowLong(F.hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong F.hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes F.hwnd, 0, 200, LWA_ALPHA
End Function


Public Function ComputerName() As String
    Dim l1 As String
    Dim l2 As Long
    Dim l3 As Long
    l2 = 255
    l1 = String$(l2, " ")
    l3 = GetComputerName(l1, l2)
    ComputerName = ""
    If l3 <> 0 Then
        ComputerName = Left(l1, l2)
    End If
End Function

'*********************************************************
'* 名称：FormSet(formname,mode)
'* 功能：此函数用于初始化窗体的大小和位置
'* 用法：mode 满屏(0),左上(1),右上(2),左下(3),右下(4),居中(5)
'*********************************************************
Public Function FormSet(F As Form, Nu As Integer) As String
    Dim BarHeight As Integer  '任务条的高度
    BarHeight = 27 * 15
    If IsNull(Nu) Then
        Nu = 0
    End If
    F.ScaleMode = 3 '将窗体的分辨率设为象素级
    Select Case Nu  '根据参数设置窗体的大小和位置
        Case 0          '默认的窗体效果,最大化
            With F
                .Top = 0
                .Left = 0
                .Width = Screen.Width
                .Height = Screen.Height - BarHeight
            End With
        Case 1          '窗体的位置居左上
            With F
                .Top = 0
                .Left = 0
            End With
        Case 2          '窗体的位置居右上
            With F
                .Top = 0
                .Left = Screen.Width - .Width
            End With
        Case 3          '窗体的位置居左下
            With F
                .Top = Screen.Height - .Height - BarHeight
                .Left = 0
            End With
        Case 4          '窗体的位置居右下
            With F
                .Top = Screen.Height - .Height - BarHeight
                .Left = Screen.Width - .Width
            End With
        Case 5          '窗体的位置居中
            With F
                .Top = (Screen.Height - .Height) / 2
                .Left = (Screen.Width - .Width) / 2
            End With
    End Select
  '  F.Icon = FrmFlash.Icon
End Function

'使窗体恢复普通模式：
Public Sub NoSetWinPos(F As Form)
    SetWindowPos F.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS
End Sub

'把窗体放在最前面：
Public Sub SetWinPos(F As Form)
    SetWindowPos F.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Sub