modinit.bas

用vb编的网络聊天程序

Attribute VB_Name = "modInit"
Option Explicit

Private Const gconstrSettings As String = "Settings"

Private Const gconstrAudioDevice As String = "AudioInDriver"
Private Const gconstrVideoDevice As String = "VideoDevice"

Public Function InitGetCurrentAudioDevice() As Long
    InitGetCurrentAudioDevice = GetSetting(App.Title, gconstrSettings, gconstrAudioDevice, -1)
    If InitGetCurrentAudioDevice < -1 Then InitGetCurrentAudioDevice = -1
End Function


Public Function InitGetCurrentVideoDevice() As Long
    InitGetCurrentVideoDevice = GetSetting(App.Title, gconstrSettings, gconstrVideoDevice, -1)
    If InitGetCurrentVideoDevice < -1 Then InitGetCurrentVideoDevice = -1
End Function


Public Function GetVideoCompressor(CodecStr As String) As String

    If IsNumeric(CodecStr) Then
        If Val(CodecStr) = 0 Then
            GetVideoCompressor = "iv50"
        Else
            GetVideoCompressor = CodecStr
        End If
    Else
        
        Dim l As Long
        Dim lo As Long
        Dim lc As Long
        Do
            l = InStr(lo + 1, CodecStr, ",")
            If l <= 0 Then Exit Do
            
            lo = l
            lc = lc + 1
            If lc >= 3 Then Exit Do
        Loop
        
        If lo Then
            l = InStr(lo + 1, CodecStr, ",")
            If l <= 0 Then
                GetVideoCompressor = Mid$(CodecStr, lo + 1)
            Else
                GetVideoCompressor = Mid$(CodecStr, lo + 1, l - lo - 1)
            End If
        ElseIf Len(Trim$(CodecStr)) <= 0 Then
            GetVideoCompressor = "iv50"
        Else
            GetVideoCompressor = CodecStr
        End If
    End If
End Function


Public Sub GetAppSettings()
    On Error GoTo ErrorHandle
    With Form1.UDPSocket1
        Dim s As String
        s = .GetHost(.LocalAddress)
    End With
    gstrMyName = Trim$(GetSetting(App.Title, "Settings", "MyName", s))
    If Len(gstrMyName) <= 0 Then gstrMyName = s
    
    gstrMyEmail = Trim$(GetSetting(App.Title, "Settings", "Email", vbNullString))
    gblnAutoStart = GetSetting(App.Title, "Settings", "AutoStart", False)
    gblnShellIcon = GetSetting(App.Title, "Settings", "ShellIcon", False)
    
    Form1.VidCodec1.OutFormat = GetVideoCompressor(GetSetting(App.Title, "Settings", "VideoCodec", "iv50"))
    Form1.VidCodec1.Quality = GetSetting(App.Title, "Settings", "VideoQuality", 40 * IIf(gblnHighSpeed, 2, 1))
    
    s = GetSetting(App.Title, "Settings", "VideoFormat", "176,144")
    If Len(s) <= 0 Then s = "176,144,24"
    Form1.VidCap1.Format = s
    
    Form1.VideoSend = GetSetting(App.Title, "Settings", "SendVideo", True)
   
    
    Form1.VideoRece = GetSetting(App.Title, "Settings", "ReceVideo", True)
    Form1.AudioSend = GetSetting(App.Title, "Settings", "SendAudio", True)
    
    gblnHighSpeed = GetSetting(App.Title, "Settings", "HighSpeed", False)
    
    s = GetSetting(App.Title, "Settings", "AudioCodec", "gsm")
    Form1.AudCodec1.OutFormat = s
    
    s = GetSetting(App.Title, "Settings", "AudioFormat", "1,1,8000,16")
    Form1.AudCap1.Format = s
    Form1.AudCodec1.InFormat = s
    
    Form1.AudRnd1.Device = GetSetting(App.Title, "Settings", "AudioOutDriver", -1)
    Form1.VideoDevice = GetSetting(App.Title, "Settings", "VideoDriver", -1)
    
    Form1.AudioSendVolume = GetSetting(App.Title, "Settings", "AudioInVolume", 50)
    Form1.AudioReceVolume = GetSetting(App.Title, "Settings", "AudioOutVolume", 50)
    
    Form1.Accept = GetSetting(App.Title, "Settings", "AcceptCall", 0)
    
    Form1.Statusbar = GetSetting(App.Title, "Settings", "Statusbar", True)
    Form1.SetPictureInPicture GetSetting(App.Title, "Settings", "PictureinPicture", False)
    If GetSetting(App.Title, "Settings", "Compact", False) Then
        Form1.SetView 1
    ElseIf GetSetting(App.Title, "Settings", "DataOnly", False) Then
        Form1.SetView 2
    Else
        Form1.SetView 0
    End If
    
    Form1.SetAlwaysonTop GetSetting(App.Title, "Settings", "AlwaysonTop", False)
    
    s = GetSetting(App.Title, "Settings", "Zoom", 100)
    Select Case s
    Case 0, 1, 2, 3
    Case Else
        s = 0
    End Select
    Form1.VideoZoom = s
    
    Dim va As Variant
    va = GetAllSettings(App.Title, "Dials")
    If Not IsArray(va) Then Exit Sub
    
    Dim v As Variant
    For Each v In va
        If Len(v) > 0 Then Form1.Combo1.AddItem v
    Next
    Exit Sub
    
ErrorHandle:
    Resume Next
End Sub


Private Function GetCodecFourCC(VidFormat) As String
    Dim l As Long
    l = InStr(VidFormat, ",")
    If l Then
        GetCodecFourCC = VidFormat
    Else
        GetCodecFourCC = VidFormat
    End If
End Function

Public Sub SetAppSettings()
    On Error GoTo ErrorHandle
    SaveSetting App.Title, "Settings", "MyName", gstrMyName
    SaveSetting App.Title, "Settings", "Email", gstrMyEmail
    SaveSetting App.Title, "Settings", "AutoStart", gblnAutoStart
    SaveSetting App.Title, "Settings", "ShellIcon", gblnShellIcon
    
    SaveSetting App.Title, "Settings", "SendVideo", Form1.VideoSend
    SaveSetting App.Title, "Settings", "ReceVideo", Form1.VideoRece
    SaveSetting App.Title, "Settings", "SendAudio", Form1.AudioSend
    SaveSetting App.Title, "Settings", "HighSpeed", gblnHighSpeed
    
    SaveSetting App.Title, "Settings", "AudioCodec", Form1.AudCodec1.OutFormat
    SaveSetting App.Title, "Settings", "VideoCodec", Form1.VidCodec1.OutFormat
    
    SaveSetting App.Title, "Settings", "VideoFormat", Form1.VidCap1.Format
    
    SaveSetting App.Title, "Settings", "AudioFormat", Form1.AudCap1.Format
    
    SaveSetting App.Title, "Settings", "AudioInDriver", Form1.AudCap1.Device
    SaveSetting App.Title, "Settings", "AudioOutDriver", Form1.AudRnd1.Device
    SaveSetting App.Title, "Settings", "VideoDriver", Form1.VidCap1.Device
    
    SaveSetting App.Title, "Settings", "AudioInVolume", Form1.AudioReceVolume
    SaveSetting App.Title, "Settings", "AudioOutVolume", Form1.AudioSendVolume
    
    SaveSetting App.Title, "Settings", "VideoQuality", Form1.VidCodec1.Quality
    
    SaveSetting App.Title, "Settings", "Statusbar", Form1.Statusbar
    Exit Sub
    
ErrorHandle:
    Resume Next
End Sub


Private Sub ClearDials()
    On Error GoTo ErrorHandle
    DeleteSetting App.Title, "Dials"
ErrorHandle:
End Sub
Public Sub SaveApp()
    ClearDials
    Dim l As Long
    For l = 0 To Form1.Combo1.ListCount - 1
        SaveSetting App.Title, "Dials", Form1.Combo1.List(l), vbNullString
    Next

    SetAppSettings
    
    l = 0
    If Form1.mnuCallDonotDisturb.Checked Then
        l = 1
    ElseIf Form1.mnuAutoAcceptCalls.Checked Then
        l = 2
    End If
    SaveSetting App.Title, "Settings", "AcceptCall", l
    
    SaveSetting App.Title, "Settings", "Statusbar", Form1.mnuViewStatusbar.Checked
    SaveSetting App.Title, "Settings", "PictureinPicture", Form1.mnuViewPictureinPicture.Checked
    SaveSetting App.Title, "Settings", "Compact", Form1.mnuViewCompact.Checked
    SaveSetting App.Title, "Settings", "DataOnly", Form1.mnuViewDataOnly.Checked
    
    SaveSetting App.Title, "Settings", "AlwaysonTop", Form1.mnuViewAlwaysonTop.Checked
    
    For l = 0 To Form1.mnuToolsVideoWindowZooms.Count - 1
        If Form1.mnuToolsVideoWindowZooms(l).Checked Then Exit For
    Next
    SaveSetting App.Title, "Settings", "Zoom", l
End Sub