📄 msgwin.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Msgwin
BackColor = &H80000010&
BorderStyle = 1 'Fixed Single
Caption = "软宇快讯"
ClientHeight = 6825
ClientLeft = 45
ClientTop = 435
ClientWidth = 4335
Icon = "Msgwin.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 6825
ScaleWidth = 4335
StartUpPosition = 1 '所有者中心
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Msgwin.frx":5D52
Left = 1800
List = "Msgwin.frx":5D74
TabIndex = 10
Text = "宋体"
ToolTipText = "选择来信字体大小"
Top = 6360
Width = 735
End
Begin VB.Frame Frame3
BackColor = &H80000010&
Height = 855
Left = 120
TabIndex = 5
Top = 240
Width = 4095
Begin RichTextLib.RichTextBox Box0
Height = 495
Left = 120
TabIndex = 7
Top = 240
Width = 3855
_ExtentX = 6800
_ExtentY = 873
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 2
Appearance = 0
AutoVerbMenu = -1 'True
TextRTF = $"Msgwin.frx":5D9E
End
End
Begin VB.CommandButton Command1
Caption = "发送"
Height = 375
Left = 120
TabIndex = 4
Top = 6360
Width = 975
End
Begin VB.CommandButton Command2
Caption = "清空内容"
Height = 375
Left = 3240
TabIndex = 3
Top = 6360
Width = 975
End
Begin VB.Frame Frame1
BackColor = &H80000010&
Height = 3735
Left = 120
TabIndex = 1
Top = 960
Width = 4095
Begin RichTextLib.RichTextBox Box1
Height = 3375
Left = 120
TabIndex = 6
Top = 240
Width = 3855
_ExtentX = 6800
_ExtentY = 5953
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 2
Appearance = 0
AutoVerbMenu = -1 'True
TextRTF = $"Msgwin.frx":5E3B
End
End
Begin VB.Frame Frame2
BackColor = &H80000010&
Height = 1575
Left = 120
TabIndex = 0
Top = 4680
Width = 4095
Begin RichTextLib.RichTextBox Box2
Height = 1215
Left = 120
TabIndex = 2
Top = 240
Width = 3855
_ExtentX = 6800
_ExtentY = 2143
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ScrollBars = 2
Appearance = 0
AutoVerbMenu = -1 'True
TextRTF = $"Msgwin.frx":5ED8
End
End
Begin VB.Image Image6
Height = 240
Left = 2160
Picture = "Msgwin.frx":5F75
Top = 0
Width = 1890
End
Begin VB.Image Image4
Height = 240
Left = 240
Picture = "Msgwin.frx":668B
Top = 0
Width = 1950
End
Begin VB.Label Lb1
BackColor = &H80000010&
Height = 375
Left = 0
TabIndex = 9
Top = 0
Width = 495
End
Begin VB.Label Lb2
BackColor = &H80000010&
Height = 375
Left = 3960
TabIndex = 8
Top = 0
Width = 495
End
Begin VB.Image Image5
Height = 675
Left = -480
Picture = "Msgwin.frx":6DB4
Top = 240
Width = 11400
End
Begin VB.Image Image1
Height = 675
Left = -240
Picture = "Msgwin.frx":F78E
Top = 6240
Width = 11400
End
Begin VB.Image Image3
Height = 11400
Left = -480
Picture = "Msgwin.frx":17F5A
Top = 0
Width = 675
End
Begin VB.Image Image2
Height = 11400
Left = 4200
Picture = "Msgwin.frx":2121C
Top = -480
Width = 675
End
Begin VB.Menu Umacon
Caption = "设置(&U)"
Visible = 0 'False
Begin VB.Menu Openme1
Caption = "打开(&O)"
Shortcut = ^O
End
Begin VB.Menu hidemsg1
Caption = "隐身(&Y)"
Shortcut = ^A
End
Begin VB.Menu h1
Caption = "-"
End
Begin VB.Menu Readsa1
Caption = "查看聊天记录(&R)"
Shortcut = ^R
End
Begin VB.Menu Savemsg1
Caption = "保存聊天记录(&S)"
Shortcut = ^S
End
Begin VB.Menu Delsa1
Caption = "清除聊天记录(&D)"
Shortcut = ^D
End
Begin VB.Menu h3
Caption = "-"
End
Begin VB.Menu Recontxt
Caption = "提示内容(&R)"
End
Begin VB.Menu Enmsgs
Caption = "进聊天室(&E)"
End
Begin VB.Menu Exitmsgs
Caption = "退出聊天室(&E)"
End
Begin VB.Menu h4
Caption = "-"
End
Begin VB.Menu Sendbuto
Caption = "发送快捷键""Enter""(&S)"
Shortcut = ^B
End
Begin VB.Menu Cuto
Caption = "取消快捷键""Enter""(&C)"
End
Begin VB.Menu Auak1
Caption = "自动应答(&A)"
End
Begin VB.Menu h2
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出(&X)"
Shortcut = ^Q
End
End
End
Attribute VB_Name = "Msgwin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64 '指向后显示文本长度
End Type
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const wm_lbuttonup = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim T As NOTIFYICONDATA
Public Msg1 As String
Public Msg2 As String
Public Reconstr As String
Public Enmsgstr As String
Public Msgtxt As String
Public Aumsg As String
Private Buto As String
Private Sub Auak1_Click()
Static Samsg As String
If Samsg = "" Then
Samsg = "您好！我有点事情走开一会儿！"
Else
End If
Msgtxt = InputBox("请输入一个自动应答消息！" + vbCrLf + "例如:您好！我有点事情走开一会儿！", "设置自动应答消息", Samsg)
Samsg = Msgtxt
If Msgtxt = "" Then
Aumsg = "Staumsg" '不自动应答
Box0.Text = Box0.Text + "取消自动应答！" + vbCrLf
Else
Aumsg = "Automsg" '自动应答
Box0.Text = Box0.Text + "设置自动应答！" + vbCrLf
End If
End Sub
Private Sub Box0_Change()
With Box0
'.SetFocus '选
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub Delsa1_Click()
On Error GoTo Msgsaerr
Set rs = cn.Execute("Delete * from Data") '清除聊天记录
Msgsa.Box1.Text = ""
MsgBox "聊天记录清除成功！", 64, "提示"
Exit Sub
Msgsaerr:
MsgBox "聊天记录清除失败！", 64, "提示"
End Sub
Private Sub Enmsgs_Click()
Enmsgstr = "Strmsg"
Enmsgs.Enabled = False
Exitmsgs.Enabled = True
Call Eemsgs
Box0.Text = Box0.Text + "聊天室！" + vbCrLf
End Sub
Private Sub Eemsgs()
On Error GoTo er2
If main1.Scmnet1.State = 7 Then
If Enmsgstr = "Strmsg" Then
Msg1 = Box1.Text
Box1.Text = ""
Box1.Text = Msg2
Msg2 = ""
main1.Scmnet1.SendData "Messgif" & "(" & main1.Scmnet1.LocalHostName & ")" & "走进聊天室！" & "(" + Time$ + ")" & vbCrLf & vbCrLf
Else
Msg2 = Box1.Text
Box1.Text = ""
Box1.Text = Msg1
Msg1 = ""
main1.Scmnet1.SendData "Messgif" & "(" & main1.Scmnet1.LocalHostName & ")" & "离开聊天室！" & "(" + Time$ + ")" & vbCrLf & vbCrLf
End If
Else
Enmsgstr = "Exmsg"
End If
Exit Sub
er2:
End Sub
Private Sub Exitmsgs_Click()
Enmsgstr = "Exmsg"
Exitmsgs.Enabled = False
Enmsgs.Enabled = True
Call Eemsgs
Box0.Text = Box0.Text + "VS通信！" + vbCrLf
End Sub
Private Sub Form_Load()
On Error Resume Next
Call Msgdata '打开聊天记录数据
Exitmsgs.Enabled = False
Cuto.Enabled = False
Enmsgstr = "Exmsg"
Buto = "Close Button"
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Msgsaerr
Set rs = cn.Execute("Delete * from Data")
Set rs = cn.Execute("insert into Data (tcp_Data) values ('" & "(" + Date$ + ")" + vbCrLf + Box1.Text & "')") '聊天记录
Msgsaerr:
Aumsg = "Staumsg" '不自动应答
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -