📄 frmgroup.frm
字号:
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 9
Left = 3360
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 30
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 8
Left = 3000
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 29
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 7
Left = 2640
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 28
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 6
Left = 2280
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 27
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 5
Left = 1920
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 26
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 4
Left = 1560
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 25
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 3
Left = 1200
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 24
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 2
Left = 840
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 23
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 1
Left = 480
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 22
Top = 240
Width = 375
End
Begin VB.PictureBox FacePic
Appearance = 0 'Flat
BackColor = &H80000009&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Index = 0
Left = 120
ScaleHeight = 375
ScaleWidth = 375
TabIndex = 21
Top = 240
Width = 375
End
Begin VB.ComboBox Combo4
Height = 300
Left = 3840
TabIndex = 20
Text = "表情"
Top = 2520
Width = 975
End
Begin VB.CommandButton cmdFace
Caption = "插入"
Height = 255
Left = 3840
TabIndex = 19
Top = 2880
Width = 975
End
Begin VB.CommandButton cmd_PIC_Dn
Caption = "下一页"
Height = 255
Left = 3840
TabIndex = 18
Top = 2160
Width = 975
End
Begin VB.CommandButton cmd_PIC_UP
Caption = "上一页"
Height = 255
Left = 3840
TabIndex = 17
Top = 1800
Width = 975
End
End
Begin VB.ComboBox Combo1
Height = 300
Left = 5400
TabIndex = 7
Text = "回复"
Top = 5160
Width = 975
End
Begin VB.ListBox List1
Height = 6900
Left = 6480
TabIndex = 1
Top = 360
Width = 2655
End
Begin VB.Frame Frame3
BackColor = &H80000009&
Caption = "用户列表："
Height = 375
Left = 6480
TabIndex = 6
Top = 120
Width = 2655
End
Begin VB.TextBox SendMsg
Height = 1815
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 5520
Width = 6375
End
Begin RichTextLib.RichTextBox RichTextBox
Height = 5055
Index = 0
Left = 0
TabIndex = 3
Top = 120
Width = 6375
_ExtentX = 11245
_ExtentY = 8916
_Version = 393217
ReadOnly = -1 'True
ScrollBars = 2
AutoVerbMenu = -1 'True
TextRTF = $"frmGroup.frx":00E4
End
Begin RichTextLib.RichTextBox RichTextBox
Height = 1095
Index = 1
Left = 4080
TabIndex = 4
Top = 6120
Width = 2175
_ExtentX = 3836
_ExtentY = 1931
_Version = 393217
TextRTF = $"frmGroup.frx":0181
End
Begin VB.Menu menuPOP
Caption = "menuPOP"
Begin VB.Menu menuPOPrefresh
Caption = "刷新"
End
Begin VB.Menu menuPOPlock
Caption = "点穴"
End
Begin VB.Menu menuPOPunlock
Caption = "解穴"
End
Begin VB.Menu menuPOPinfo
Caption = "资料"
End
End
End
Attribute VB_Name = "frmGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim Focus As Boolean
Dim ToUser As String
Dim MyB As String
Dim MyI As String
Dim MyU As String
Dim MyColor As String
Dim MyFont As String
Dim MySize As String
Dim MyFace As String
Dim MyFacePic As Long
Private Sub Cmd_B_Click()
If MyB = "" Then
MyB = "[#B]"
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelBold = True
Else
MyB = ""
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelBold = False
End If
End Sub
Private Sub Cmd_I_Click()
If MyI = "" Then
MyI = "[#I]"
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelItalic = True
Else
MyI = ""
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelItalic = False
End If
End Sub
Private Sub cmd_PIC_Dn_Click()
MyFacePic = MyFacePic + 52
cmd_PIC_UP.Enabled = True
Call PictureLoad
End Sub
Private Sub cmd_PIC_Up_Click()
MyFacePic = MyFacePic - 52
If MyFacePic <= 0 Then MyFacePic = 0: cmd_PIC_UP.Enabled = False: cmd_PIC_Dn.Enabled = True
Call PictureLoad
End Sub
Private Sub Cmd_U_Click()
If MyU = "" Then
MyU = "[#U]"
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelUnderline = True
Else
MyU = ""
RichTextBox(2).SelStart = 0
RichTextBox(2).SelLength = Len(RichTextBox(2).Text)
RichTextBox(2).SelUnderline = False
End If
End Sub
Private Sub CmdClear_Click()
RichTextBox(0).Text = ""
End Sub
Private Sub CmdFace_Click()
Dim savetime As Double
SendMsg.Text = SendMsg.Text & "[#END][#STAR]" & MyFace & "[#END][#STAR]"
SendMsg.Text = Replace(SendMsg.Text, "[#END][#STAR][#FACE=", "[#/")
SendMsg.Text = Replace(SendMsg.Text, "][#END][#STAR]", "/]")
End Sub
Private Sub PictureLoad()
Dim i As Long
For i = 0 To 51
If frmMain.FileExists(App.Path & "\face\" & Trim(Str(i + MyFacePic)) & ".gif") = True Then
FacePic(i).Picture = LoadPicture(App.Path & "\face\" & Trim(Str(i + MyFacePic)) & ".gif")
Else
FacePic(i).Picture = LoadPicture("")
cmd_PIC_Dn.Enabled = False
End If
Next
End Sub
Private Sub cmdLoadFace_Click()
Frame1.Visible = Not Frame1.Visible
If Frame1.Visible = True Then
Frame2.Visible = False
On Error GoTo errtime
Call PictureLoad
GoTo exitsub
errtime:
MkDir App.Path & "\face"
MsgBox "请下载表情文件到FACE目录中!", , "Hello,Baidu."
exitsub:
End If
End Sub
Private Sub cmdLoadFont_Click()
Frame2.Visible = Not Frame2.Visible
If Frame2.Visible = True Then Frame1.Visible = False
End Sub
Private Sub cmdSendMsg_Click()
Dim tmpTalk As String
On Error GoTo exitsub2
If soundKey = 1 Then Call frmMain.BeBe(0)
If SendMsg.Text = "" Then MsgBox "内容不能为空", , "Hello,Baidu.": Exit Sub
If ToUser = "系统管理员" Then MsgBox "发信息不成功", , "Hello,Baidu.": Exit Sub
tmpTalk = Replace(SendMsg.Text, vbCrLf, "</br>")
tmpTalk = "[#STAR]" & tmpTalk & "</br>[#END]"
tmpTalk = Replace(tmpTalk, "[#/", "[#END][#STAR][#FACE=")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -