modapp.bas

用vb编的网络聊天程序

Attribute VB_Name = "modApp"
Option Explicit

Public Const TM_CLASSMASK As Long = &HF0&

Public Const TM_CALLCLASS As Long = &H10
Public Const TM_CALLSETUP As Long = TM_CALLCLASS + &H0
Public Const TM_CALLANSWER As Long = TM_CALLCLASS + &H1
Public Const TM_CALLREJECT As Long = TM_CALLCLASS + &H2
Public Const TM_CALLHANGUP As Long = TM_CALLCLASS + &H3
Public Const TM_CALLHANDREQ As Long = TM_CALLCLASS + &H4
Public Const TM_CALLHANDRR As Long = TM_CALLCLASS + &H5


Public Const TM_AUDIOVIDEOCLASS As Long = &H20
Public Const TM_AUDIOFORMAT As Long = TM_AUDIOVIDEOCLASS + &H0
Public Const TM_AUDIOSTART As Long = TM_AUDIOVIDEOCLASS + &H1
Public Const TM_AUDIOSTOP As Long = TM_AUDIOVIDEOCLASS + &H2
Public Const TM_AUDIOFRAME As Long = TM_AUDIOVIDEOCLASS + &H3
Public Const TM_VIDEOFORMAT As Long = TM_AUDIOVIDEOCLASS + &H4
Public Const TM_VIDEOSTART As Long = TM_AUDIOVIDEOCLASS + &H5
Public Const TM_VIDEOSTOP As Long = TM_AUDIOVIDEOCLASS + &H6
Public Const TM_VIDEOFRAME As Long = TM_AUDIOVIDEOCLASS + &H7
Public Const TM_VIDEOFRAMEKEY As Long = TM_AUDIOVIDEOCLASS + &H8

Public Const TM_FILECLASS As Long = &H30
Public Const TM_FILETRANS As Long = TM_FILECLASS + &H0
Public Const TM_FILEBEGIN As Long = TM_FILECLASS + &H1
Public Const TM_FILEDATA As Long = TM_FILECLASS + &H2
Public Const TM_FILEEND As Long = TM_FILECLASS + &H3
Public Const TM_FILECANCEL As Long = TM_FILECLASS + &H4

Public Const TM_WHITECLASS As Long = &H40
Public Const TM_WHITEBEGIN As Long = TM_WHITECLASS + &H0
Public Const TM_WHITEDATA As Long = TM_WHITECLASS + &H1
Public Const TM_WHITEEND As Long = TM_WHITECLASS + &H2

Public Const TM_CHATCLASS As Long = &H50
Public Const TM_CHATDATA As Long = TM_CHATCLASS + &H0

Public gstrMyName As String
Public gstrMyEmail As String

Public gblnAutoStart As Boolean
Public gblnShellIcon As Boolean
Public gblnHighSpeed As Boolean


Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Declare Function 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) As Long

Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Private Sub Main()
   '  MsgBox "这是一个可视电话控件的DEMO源码，您可能在多种渠道得到并使用过。您很幸运，本次得到的破解版，但也有一定限时，我可以有偿提供，有意者可联系[e-mail]", vbInformation

    
    With App
        .HelpFile = .Path & "\" & .Title & ".chm"
    End With
    
    Load Form1
    
    Form1.Show
   
End Sub


Public Function GetLogo() As IPictureDisp
    On Error GoTo ErrorHandle
    Set GetLogo = LoadPicture(App.Path & "\bn.bmp")
ErrorHandle:
End Function


Public Sub ShowOptions(ByVal Index As Integer)
    Load Form7
    Form7.TabIndex = Index
    Form7.Show vbModal
End Sub


Public Sub BrowseTo(URL As String)
    Shell "explorer """ & URL & """", vbNormalFocus
End Sub


Public Sub NotImplement()
    MsgBox "Not implement yet!", vbInformation
End Sub