⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 msgwin.frm

📁 星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带
💻 FRM
📖 第 1 页 / 共 2 页
字号:

Shell_NotifyIcon NIM_DELETE, T

End Sub


Private Sub Command1_Click()

On Error GoTo sc

Dim a1 As String

If Box2.Text <> "" Then

If Enmsgstr <> "Strmsg" Then

       main1.Scmnet2.SendData "Msgwins" & "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf

       Box1.Text = Box1.Text + "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf
       
       Box2.Text = ""
       
       Else
       
       main1.Scmnet1.SendData "Messgif" & "(" + Time$ + ")" + main1.Scmnet1.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf
       
       Box1.Text = Box1.Text + "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf

       Box2.Text = ""
       
       End If
       
       a1 = 2
       
       If a1 = 2 Then
       
       Else
       
sc:

If Enmsgstr = "Strmsg" Then
Enmsgstr = "Exmsg"
MsgBox "聊天室可能已关闭!", 64, "提示"
Else

MsgBox "对方可能下了线!", 64, "提示"

End If
       
       End If
       
''''''''''''''''''''''''''
Else

MsgBox "发送的内容不能为空!", 64, "提示"

Box2.Text = ""
       
End If
''''''''''''''''''''''''''''''
       

End Sub

Private Sub Command2_Click()
Box1.Text = ""
End Sub

Private Sub Cuto_Click()

Buto = "Close Button"
Cuto.Enabled = False
Sendbuto.Enabled = True

Box0.Text = Box0.Text + "已取消”Enter“发送快捷键!" + vbCrLf

End Sub

Private Sub Exit_Click()

Shell_NotifyIcon NIM_DELETE, T

Unload Me

End Sub


Private Sub hidemsg1_Click()

On Error Resume Next

''''''''''''''''''''''''''''''''
T.cbSize = Len(T)
    T.hwnd = Msgwin.hwnd
    T.uId = 1&
    T.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    T.ucallbackMessage = WM_MOUSEMOVE
    T.hIcon = Me.Icon
    T.szTip = "软宇网络系统" & vbNullChar

    Shell_NotifyIcon NIM_ADD, T

'''''''''''''''''''''''''''''

Msgwin.Hide

End Sub

Private Sub Openme1_Click()

On Error Resume Next

If Reconstr = "Reinfo" Then
      
      Reconstr = ""
      
      Box0.Text = Box0.Text + "取消提示内容!" + vbCrLf
      
      Else
      
      End If
      
      Reconstr = ""
      
Msgwin.Show

Shell_NotifyIcon NIM_DELETE, T

End Sub

Private Sub Box1_Change()

On Error GoTo fonterr:

Dim font1 As String

font1 = 2

Box1.Font.Size = Combo1.Text

    If font1 = 2 Then
    
    Else
          
fonterr:

Box1.Font.Size = "10"

End If

          With Box1
                  '.SetFocus '选
                  .SelStart = 0
                  .SelLength = Len(.Text)
          End With
          
End Sub

Private Sub Box2_KeyPress(KeyAscii As Integer)

On Error GoTo sc

Dim a1 As String

If KeyAscii = 13 Then

If Buto <> "Use Button" Then GoTo Tobuto

If Box2.Text <> "" Then

If Enmsgstr <> "Strmsg" Then

       main1.Scmnet2.SendData "Msgwins" & "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf

       Box1.Text = Box1.Text + "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf

       Box2.Text = ""
       
        Box2.SetFocus
        SendKeys "{backspace}"
       
       Else
       
       main1.Scmnet1.SendData "Messgif" & "(" + Time$ + ")" + main1.Scmnet1.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf
       
       Box1.Text = Box1.Text + "(" + Time$ + ")" + main1.Scmnet2.LocalHostName + ":" + vbCrLf + Box2.Text + vbCrLf + vbCrLf

       Box2.Text = ""
       
        Box2.SetFocus
        SendKeys "{backspace}"
       
       End If
       
       a1 = 2
       
       If a1 = 2 Then
       
       Else
       
sc:

If Enmsgstr = "Strmsg" Then
Enmsgstr = "Exmsg"
MsgBox "聊天室可能已关闭!", 64, "提示"

'Box2.Text = ""
       
        Box2.SetFocus
        SendKeys "{backspace}"

Else

MsgBox "对方可能下了线!", 64, "提示"

'Box2.Text = ""
       
        Box2.SetFocus
        SendKeys "{backspace}"

End If

    
       End If
       
       ''''''''''''''''''''''''''
Else

MsgBox "发送的内容不能为空!", 64, "提示"

Box2.Text = ""
       
        Box2.SetFocus
        SendKeys "{backspace}"

End If
''''''''''''''''''''''''''''''
     
End If

Tobuto:

End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

 Dim Msg As Long
    Msg = x / Screen.TwipsPerPixelX

    Select Case Msg
    Case WM_LBUTTONDOWN '按下事件
          
     Case WM_LBUTTONDBLCLK '双击事件
     
      On Error Resume Next
      
      If Reconstr = "Reinfo" Then
      
      Reconstr = ""
      
      Box0.Text = Box0.Text + "取消提示内容!" + vbCrLf
      
      Else
      
      End If
      
      Reconstr = ""
      
       Msgwin.Show
       
    Shell_NotifyIcon NIM_DELETE, T
    
    Case wm_lbuttonup '左击后事件
         
    
    Case WM_RBUTTONUP: '右击后事件
        PopupMenu Umacon, 0 Or 2
    End Select
    End Sub


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

On Error Resume Next

Select Case Button

  Case 2

      PopupMenu Umacon, vbPopupMenuLeftAlign '   把文件菜单显示为一个弹出式菜单。
 
End Select

End Sub

Private Sub Frame1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

On Error Resume Next

Select Case Button

  Case 2

      PopupMenu Umacon, vbPopupMenuLeftAlign '   把文件菜单显示为一个弹出式菜单。
 
End Select

End Sub

Private Sub Frame2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

On Error Resume Next

Select Case Button

  Case 2

      PopupMenu Umacon, vbPopupMenuLeftAlign '   把文件菜单显示为一个弹出式菜单。
 
End Select

End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

On Error Resume Next

Select Case Button

  Case 2

      PopupMenu Umacon, vbPopupMenuLeftAlign '   把文件菜单显示为一个弹出式菜单。
 
End Select

End Sub

Private Sub Readsa1_Click()

Msgsa.Show

End Sub

Private Sub Recontxt_Click()

On Error Resume Next

Reconstr = "Reinfo"

Msgwin.Hide


''''''''''''''''''''''''''''''''
T.cbSize = Len(T)
    T.hwnd = Msgwin.hwnd
    T.uId = 1&
    T.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    T.ucallbackMessage = WM_MOUSEMOVE
    T.hIcon = Me.Icon
    T.szTip = "软宇网络系统" & vbNullChar

    Shell_NotifyIcon NIM_ADD, T

'''''''''''''''''''''''''''''

Box0.Text = Box0.Text + "设置提示内容!" + vbCrLf

End Sub

Private Sub Savemsg1_Click()

  On Error GoTo Msgsaerr
  
       Set rs = cn.Execute("Delete * from Data")  '清除聊天记录
       
       Msgsa.Box1.Text = ""

       Set rs = cn.Execute("insert into Data (tcp_Data) values ('" & "(" + Date$ + ")" + vbCrLf + Box1.Text & "')") '聊天记录
       
       Set rs = cn.Execute("select * from Data")
rs.MoveFirst
Do While rs.EOF = False
'if rs.EOF = False Then
a = rs("tcp_Data")
Msgsa.Box1.Text = Msgsa.Box1.Text + vbCrLf + a
rs.MoveNext
'End If
Loop

       MsgBox "聊天记录保存成功!", 64, "提示"

  Exit Sub

Msgsaerr:

      MsgBox "聊天记录保存失败!", 64, "提示"

End Sub

Private Sub Sendbuto_Click()

Buto = "Use Button"
Sendbuto.Enabled = False
Cuto.Enabled = True

Box0.Text = Box0.Text + "已设置”Enter“发送快捷键!" + vbCrLf

End Sub

Public Sub Delt1()

Shell_NotifyIcon NIM_DELETE, T

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -