📄 pagbitmaps.pag
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.PropertyPage pagBitmaps
Caption = "Menu Icons"
ClientHeight = 5136
ClientLeft = 0
ClientTop = 0
ClientWidth = 5472
PaletteMode = 0 'Halftone
ScaleHeight = 5136
ScaleWidth = 5472
Begin VB.CommandButton cmdClear
Caption = "Clear"
Height = 288
Left = 4662
Picture = "pagBitmaps.pgx":0000
TabIndex = 17
Top = 84
Width = 720
End
Begin MSComDlg.CommonDialog comDlg
Left = 2856
Top = 1932
_ExtentX = 699
_ExtentY = 699
_Version = 393216
CancelError = -1 'True
Filter = "Icons And Graphics (*.ico;*.bmp;*.gif;*.jpg)|*.ico;*.bmp;*.gif;*.jpg|All files (*.*)|*.*"
Flags = 4
FontBold = -1 'True
FontItalic = -1 'True
FontStrikeThru = -1 'True
FontUnderLine = -1 'True
End
Begin VB.Frame fraControls
Caption = "Menu Icon"
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 204
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1944
Left = 84
TabIndex = 8
Top = 3108
Width = 3120
Begin VB.ComboBox cobMaskColor
Height = 288
Left = 1092
TabIndex = 12
Top = 1512
Width = 1860
End
Begin VB.ComboBox cobMenus
Height = 288
Left = 1092
TabIndex = 11
Top = 336
Width = 1860
End
Begin VB.PictureBox picBmp
Height = 684
Left = 1092
ScaleHeight = 636
ScaleWidth = 1224
TabIndex = 10
Top = 756
Width = 1272
Begin VB.Image imgBmp
Height = 348
Left = 168
MousePointer = 15 'Size All
Top = 84
Width = 348
End
End
Begin VB.CommandButton cmdOpen
Height = 285
Left = 2436
Picture = "pagBitmaps.pgx":014A
Style = 1 'Graphical
TabIndex = 9
Top = 756
Width = 300
End
Begin VB.Label Label4
Caption = "Menu Item:"
Height = 264
Left = 168
TabIndex = 15
Top = 336
Width = 936
End
Begin VB.Label Label3
Caption = "Mask Color:"
Height = 264
Left = 168
TabIndex = 14
Top = 1512
Width = 1020
End
Begin VB.Label Label2
Caption = "Bitmap:"
Height = 264
Left = 168
TabIndex = 13
Top = 756
Width = 1104
End
End
Begin VB.Frame fraCommon
Caption = "Common"
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 204
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1944
Left = 3360
TabIndex = 3
Top = 3108
Width = 2028
Begin VB.CheckBox chkSystemFont
Caption = "Use system font"
Height = 348
Left = 168
TabIndex = 19
Top = 840
Width = 1692
End
Begin VB.ComboBox cobSize
Height = 288
Left = 168
TabIndex = 6
Top = 1512
Width = 1356
End
Begin VB.CheckBox chkDisabled
Caption = "Select disabled menu items"
Height = 432
Left = 168
TabIndex = 4
Top = 336
Width = 1692
End
Begin VB.Label Label6
Caption = "px"
Height = 264
Left = 1680
TabIndex = 7
Top = 1512
Width = 264
End
Begin VB.Label Label5
Caption = "Bitmap size:"
Height = 264
Left = 168
TabIndex = 5
Top = 1260
Width = 1524
End
End
Begin VB.CommandButton cmdAdd
Height = 285
Left = 3996
Picture = "pagBitmaps.pgx":0294
Style = 1 'Graphical
TabIndex = 2
Top = 84
Width = 300
End
Begin VB.ListBox lstMenus
Height = 2640
IntegralHeight = 0 'False
Left = 84
TabIndex = 1
Top = 420
Width = 5304
End
Begin VB.CommandButton cmdRemove
Height = 285
Left = 4332
Picture = "pagBitmaps.pgx":03DE
Style = 1 'Graphical
TabIndex = 0
Top = 84
Width = 300
End
Begin VB.Label labNum
Height = 264
Left = 1260
TabIndex = 18
Top = 84
Width = 936
End
Begin VB.Label labMenu
Caption = "Menu items:"
Height = 264
Left = 84
TabIndex = 16
Top = 84
Width = 1608
End
End
Attribute VB_Name = "pagBitmaps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'==============================================================================
' pagBitmaps.pag
'
' Subclassing Thunk (SuperClass V2) Project Samples
' Copyright (c) 2002 by Vlad Vissoultchev <wqweto@myrealbox.com>
'
' Office XP menus control property page
'
' Modifications:
'
' 2002-10-28 WQW Initial implementation
'
'==============================================================================
Option Explicit
'==============================================================================
' API
'==============================================================================
Private Const LB_SETTABSTOPS As Long = &H192
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
'==============================================================================
' Constants and member variables
'==============================================================================
Private m_oControl As ctxHookMenu
Private m_cBmps As Collection
Private m_lLoaded As Long
Private m_bInSet As Boolean
Private m_bDrag As Boolean
Private m_sX As Single
Private m_sY As Single
Private m_bModified As Boolean
Private m_bChanged As Boolean
'==============================================================================
' Methods
'==============================================================================
Private Sub pvFillControls()
Dim oCtl As Object
Dim vElem As Variant
Dim lIdx As Long
Dim lTop As Long
Dim lI As Long
Dim sText As String
Dim lItemData As Long
m_bInSet = True
lIdx = lstMenus.ListIndex
lTop = lstMenus.TopIndex
lstMenus.Visible = False
lstMenus.Clear
For Each oCtl In m_oControl.frContainerMenus
sText = vbTab & Replace(oCtl.Caption, vbTab, "\t") & vbTab & pvGetCtlName(oCtl)
lItemData = 0
For lI = 1 To m_cBmps.Count
vElem = m_cBmps(lI)
If vElem(2) = "#" & pvGetCtlName(oCtl) Then
sText = "*" & sText
lItemData = lI
End If
Next
lstMenus.AddItem sText
lstMenus.itemData(lstMenus.NewIndex) = lItemData
Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -