📄 msgwin.frm
字号:
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 + -