frmmenu.frm
来自「使用VB仿QQ界面开发的ICQ程序,采用C/S结架,实现简单文字聊天.」· FRM 代码 · 共 470 行
FRM
470 行
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmMenu
Caption = "Menu"
ClientHeight = 4425
ClientLeft = 13845
ClientTop = 3300
ClientWidth = 3105
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMenu.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4425
ScaleMode = 0 'User
ScaleWidth = 3110.948
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox MainFrame
BorderStyle = 0 'None
Height = 4215
Left = 120
ScaleHeight = 4215
ScaleWidth = 2295
TabIndex = 3
Top = 120
Width = 2295
Begin VB.Timer tmrTimeout
Enabled = 0 'False
Interval = 1000
Left = 1560
Top = 2520
End
Begin MSWinsockLib.Winsock Winsock1
Left = 1080
Top = 2520
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin TabDlg.SSTab SSTab
Height = 4095
Left = 0
TabIndex = 4
Top = 0
Width = 2295
_ExtentX = 4048
_ExtentY = 7223
_Version = 393216
Style = 1
Tabs = 2
TabsPerRow = 2
TabHeight = 520
TabMaxWidth = 2117
WordWrap = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "Online"
TabPicture(0) = "frmMenu.frx":0CCA
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "TreeView1"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "runlog"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).ControlCount= 2
TabCaption(1) = "List Setup"
TabPicture(1) = "frmMenu.frx":0CE6
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "TreeView2"
Tab(1).Control(1)= "cmdNewBuddy"
Tab(1).Control(1).Enabled= 0 'False
Tab(1).Control(2)= "cmdDelBuddy"
Tab(1).ControlCount= 3
Begin VB.CommandButton cmdNewBuddy
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = -74880
MaskColor = &H00FF00FF&
Picture = "frmMenu.frx":0D02
Style = 1 'Graphical
TabIndex = 6
TabStop = 0 'False
ToolTipText = " Add a new buddy "
Top = 3480
UseMaskColor = -1 'True
Width = 735
End
Begin VB.CommandButton cmdDelBuddy
Caption = "&Remove"
Enabled = 0 'False
Height = 495
Left = -73680
TabIndex = 5
Top = 3480
Width = 855
End
Begin RichTextLib.RichTextBox runlog
Height = 735
Left = 120
TabIndex = 7
Top = 3240
Width = 2055
_ExtentX = 3625
_ExtentY = 1296
_Version = 393217
BorderStyle = 0
ReadOnly = -1 'True
ScrollBars = 2
TextRTF = $"frmMenu.frx":1016
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComctlLib.TreeView TreeView2
Height = 2895
Left = -74880
TabIndex = 8
Top = 480
Width = 2055
_ExtentX = 3625
_ExtentY = 5106
_Version = 393217
HideSelection = 0 'False
Indentation = 353
LineStyle = 1
Style = 6
HotTracking = -1 'True
ImageList = "ImageList1"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComctlLib.TreeView TreeView1
Height = 2655
Left = 120
TabIndex = 9
Top = 480
Width = 2055
_ExtentX = 3625
_ExtentY = 4683
_Version = 393217
HideSelection = 0 'False
Indentation = 353
LabelEdit = 1
LineStyle = 1
Style = 5
HotTracking = -1 'True
ImageList = "ImageList1"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
End
Begin VB.Label lblFile
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件(&F)"
Height = 180
Left = 120
TabIndex = 2
Top = 120
Width = 630
End
Begin VB.Label lblTool
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工具(&T)"
Height = 180
Left = 855
TabIndex = 1
Top = 120
Width = 630
End
Begin VB.Label lblHelp
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "帮助(&H)"
Height = 180
Left = 1575
TabIndex = 0
Top = 120
Width = 630
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuFileLogOut
Caption = "注消(&L)"
End
Begin VB.Menu mnuFileSplit
Caption = "-"
End
Begin VB.Menu mnuFileStatus
Caption = "当前状态&S"
Begin VB.Menu mnuStatusOnline
Caption = "在线(&O)"
Checked = -1 'True
End
Begin VB.Menu mnuStatusAway
Caption = "隐身(&A)"
End
End
Begin VB.Menu mnuStatusSplit
Caption = "-"
End
Begin VB.Menu mnuFileClose
Caption = "退出(&E)"
End
End
Begin VB.Menu mnuPeople
Caption = "工具(&T)"
Begin VB.Menu mnuOptions
Caption = "系统设置(&O)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuAbout
Caption = "关于(&A)"
End
End
Begin VB.Menu mnuSystray
Caption = "&Systray"
Visible = 0 'False
Begin VB.Menu mnuRestore
Caption = "还原 (&R)"
End
Begin VB.Menu mnuSystraySignOff
Caption = "注消 (&L)"
End
Begin VB.Menu mnuSystrayStatus
Caption = "状态 (&S)"
Begin VB.Menu mnuSystrayOnline
Caption = "在线(&O)"
Checked = -1 'True
End
Begin VB.Menu mnuSystrayAway
Caption = "隐身(&A)"
End
End
Begin VB.Menu mnuSystraySep1
Caption = "-"
End
Begin VB.Menu mnuSystrayAbout
Caption = "&About"
End
Begin VB.Menu mnuSystrayExit
Caption = "退出 (&E)"
End
End
Begin VB.Menu mnuBuddyList
Caption = "&BuddyList"
Visible = 0 'False
Begin VB.Menu mnuAddBuddy
Caption = "&Add Buddy"
End
Begin VB.Menu mnuRemBuddy
Caption = "&Remove Buddy"
End
End
End
Attribute VB_Name = "frmMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''Dim Tic As NOTIFYICONDATA
'''Dim rc As Long
''
''
''Private Sub Form_Load()
'' DoSystrayIcon '生成ICO托盘
''End Sub
''
'''----------------------
''Private Sub Form_Terminate()
'' Shell_NotifyIcon NIM_DELETE, Tic
''End Sub
''
'''生成ICO托盘图标.
''Private Sub DoSystrayIcon()
'' Tic.cbSize = Len(Tic)
'' Tic.hWnd = Me.hWnd
'' Tic.uID = vbNull
'' Tic.uFlags = NIF_DOALL
'' Tic.uCallbackMessage = WM_MOUSEMOVE
'' Tic.hIcon = Me.Icon
'' Tic.sTip = "Server" & vbNullChar '显示程序名称
'' rc = Shell_NotifyIcon(NIM_ADD, Tic)
''End Sub
''
'''将菜单项变成托盘菜单.
''Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'' Dim msg As Long
'' Dim sFilter As String
'' msg = x / Screen.TwipsPerPixelX
'' Select Case msg
'' Case WM_RBUTTONUP
'' PopupMenu mnuSystray
'' Case WM_LBUTTONDBLCLK
'' Me.Show
'' 'Me.WindowState = vbNormal
'' End Select
''End Sub
'
''Private Sub Form_Unload(p_intCancel As Integer)
'' On Error GoTo PROC_ERR
''
'' Set frmMenuForm = Nothing
''
''PROC_EXIT:
'' Exit Sub
''PROC_ERR:
'' MsgBox Err.Description
'' Resume PROC_EXIT
''End Sub
'
'Private Sub mnuAbout_Click()
' frmAbout.Show vbModal
'End Sub
'
'Private Sub mnuOptions_Click()
' frmOptions.Show 1
'End Sub
'
'Private Sub mnuRestore_Click()
' Me.Show
' 'Me.WindowState = vbNormal
'End Sub
'
'Private Sub mnuSystrayAway_Click()
' Call mnuStatusAway_Click
'End Sub
'
'Private Sub mnuSystrayExit_Click()
' Call mnuFileClose_Click
'End Sub
'
'Private Sub mnuSystrayOnline_Click()
' Call mnuStatusOnline_Click
'End Sub
'
'Private Sub mnuSystraySignOff_Click()
' Call mnuFileLogOut_Click
'End Sub
'
'Private Sub mnuFileLogOut_Click()
' Call frmClient.FileLogOut
'End Sub
'
'Private Sub mnuFileClose_Click()
' Call frmClient.gEXIT
'End Sub
'
'Private Sub mnuStatusOnline_Click()
' Call frmClient.StatusOnline
'End Sub
'
'Private Sub mnuStatusAway_Click()
' Call frmClient.StatusAway
'End Sub
'
'
'''------Menu-------------
''Private Sub lblFile_Click()
'' PopupMenu frmMenu.mnuFile, , (lblFile.Left), (lblFile.Top + lblFile.Height)
''End Sub
''
''Private Sub lblFile_MouseDown(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblFile.BorderStyle = 1
'' Else
'' lblFile.BorderStyle = 0
'' End If
''End Sub
''
''Private Sub lblFile_MouseUp(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblFile.BorderStyle = 0
'' Else
'' lblFile.BorderStyle = 1
'' End If
''End Sub
''
''Private Sub lblTool_Click()
'' PopupMenu frmMenu.mnuPeople, , (lblTool.Left), (lblTool.Top + lblTool.Height)
''End Sub
''
''Private Sub lblTool_MouseDown(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblTool.BorderStyle = 1
'' Else
'' lblTool.BorderStyle = 0
'' End If
''End Sub
''
''Private Sub lblTool_MouseUp(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblTool.BorderStyle = 0
'' Else
'' lblTool.BorderStyle = 1
'' End If
''End Sub
''
''Private Sub lblHelp_Click()
'' PopupMenu frmMenu.mnuHelp, , (lblHelp.Left), (lblHelp.Top + lblHelp.Height)
''End Sub
''
''Private Sub lblHelp_MouseDown(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblHelp.BorderStyle = 1
'' Else
'' lblHelp.BorderStyle = 0
'' End If
''End Sub
''
''Private Sub lblHelp_MouseUp(p_intButton As Integer, p_intShift As Integer, p_sngX As Single, p_sngY As Single)
'' If p_intButton = 1 Then
'' lblHelp.BorderStyle = 0
'' Else
'' lblHelp.BorderStyle = 1
'' End If
''End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?