📄 xpcontainer.ctl
字号:
VERSION 5.00
Begin VB.UserControl XPContainer
Alignable = -1 'True
AutoRedraw = -1 'True
ClientHeight = 1920
ClientLeft = 0
ClientTop = 0
ClientWidth = 2475
ControlContainer= -1 'True
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
PropertyPages = "XPContainer.ctx":0000
ScaleHeight = 128
ScaleMode = 3 'Pixel
ScaleWidth = 165
ToolboxBitmap = "XPContainer.ctx":0014
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BorderStyle = 0 'None
ClipControls = 0 'False
ForeColor = &H80000008&
Height = 345
Left = 15
ScaleHeight = 23
ScaleMode = 3 'Pixel
ScaleWidth = 161
TabIndex = 0
Top = 15
Width = 2415
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "XPContainer"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 180
Left = 120
TabIndex = 1
Top = 75
Width = 1155
End
End
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
BorderStyle = 0 'None
ClipControls = 0 'False
ForeColor = &H80000008&
Height = 1530
Left = 30
ScaleHeight = 102
ScaleMode = 3 'Pixel
ScaleWidth = 161
TabIndex = 2
Top = 360
Visible = 0 'False
Width = 2415
End
End
Attribute VB_Name = "XPContainer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit
Dim Keystr As String
Dim mhwnd As Long
Private Declare Function OleTranslateColor _
Lib "olepro32.dll" (ByVal OLE_COLOR As Long, _
ByVal HPALETTE As Long, _
pccolorref As Long) As Long
Private Const CLR_INVALID = -1
Private Declare Function LoadLibrary _
Lib "KERNEL32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary _
Lib "KERNEL32" (ByVal hLibModule As Long) As Long
Private m_hMod As Long
Public Enum XPContainerStyles
[Header Visible] = 0
[Header Invisible] = 1
End Enum
Public Enum XPContainerThemes
[XP Blue] = 0
[XP Dark Blue] = 1
[XP Dark Green] = 2
[XP Green] = 3
[XP Light Blue] = 4
[XP Light Green] = 5
[XP Orange] = 6
[XP Pastel Green] = 7
[XP Purple] = 8
[XP Red] = 9
[XP Silver] = 10
[XP Yellow] = 11
End Enum
' Property Variables
Private m_Theme As XPContainerThemes
Private m_Style As XPContainerStyles
Private m_HeaderLightColor As OLE_COLOR
Private m_HeaderDarkColor As OLE_COLOR
Private m_BackLightColor As OLE_COLOR
Private m_BackDarkColor As OLE_COLOR
Private m_BorderColor As OLE_COLOR
Private m_TextColor As OLE_COLOR
Private m_Caption As String
' Default Property Values
Private Const m_def_Theme = 0
Private Const m_def_Style = 0
Private Const m_def_HeaderLightColor = &HF7E0D3
Private Const m_def_HeaderDarkColor = &HEDC5A7
Private Const m_def_BackLightColor = &HFCF4EF
Private Const m_def_BackDarkColor = &HFAE8DC
Private Const m_def_BorderColor = &HDCC1AD
Private Const m_def_TextColor = &H7B2D02
Private Const m_def_Caption = "XPContainer"
Private Sub ApplyTheme()
Select Case m_Theme
Case [XP Blue]
HeaderLightColor = &HF7E0D3
HeaderDarkColor = &HEDC5A7
BackLightColor = &HFCF4EF
BackDarkColor = &HFAE8DC
BorderColor = &HDCC1AD
TextColor = &H7B2D02
Case [XP Dark Blue]
HeaderLightColor = &HECDCD3
HeaderDarkColor = &HDABAA8
BackLightColor = &HF8F2EF
BackDarkColor = &HF1E5DD
BorderColor = &HD6B4A0
TextColor = &H4B2A17
Case [XP Dark Green]
HeaderLightColor = &HD8E5C8
HeaderDarkColor = &HB1CB92
BackLightColor = &HF1F5EB
BackDarkColor = &HE1EBD5
BorderColor = &HAAC688
TextColor = &H213B00
Case [XP Green]
HeaderLightColor = &HE0EAE8
HeaderDarkColor = &HC2D6D1
BackLightColor = &HF4F8F7
BackDarkColor = &HE7EFED
BorderColor = &HBCD3CD
TextColor = &H324741
Case [XP Light Blue]
HeaderLightColor = &HF1E3C8
HeaderDarkColor = &HE4C992
BackLightColor = &HFAF5EB
BackDarkColor = &HF5EAD5
BorderColor = &HE2C488
TextColor = &H553900
Case [XP Light Green]
HeaderLightColor = &HDAF2E3
HeaderDarkColor = &HB5E5C8
BackLightColor = &HF1FAF5
BackDarkColor = &HE3F5EA
BorderColor = &HAEE3C3
TextColor = &H245738
Case [XP Orange]
HeaderLightColor = &HD2E2FD
HeaderDarkColor = &HA7C6FA
BackLightColor = &HEFF5FE
BackDarkColor = &HDDE9FD
BorderColor = &H9FC0FA
TextColor = &H16366D
Case [XP Pastel Green]
HeaderLightColor = &HE3E3D6
HeaderDarkColor = &HC9C9AE
BackLightColor = &HF5F5F0
BackDarkColor = &HEAEAE0
BorderColor = &HC4C4A6
TextColor = &H39391D
Case [XP Purple]
HeaderLightColor = &HEAD7DF
HeaderDarkColor = &HD5B0BF
BackLightColor = &HF7F1F3
BackDarkColor = &HEFE1E6
BorderColor = &HD1A9B9
TextColor = &H46202F
Case [XP Red]
HeaderLightColor = &HD6D2FB
HeaderDarkColor = &HAEA6F8
BackLightColor = &HF0EFFE
BackDarkColor = &HE0DDFC
BorderColor = &HA79EF7
TextColor = &H1D156A
Case [XP Silver]
HeaderLightColor = &HECEAE9
HeaderDarkColor = &HD9D6D3
BackLightColor = &HF8F7F7
BackDarkColor = &HF1EFEE
BorderColor = &HD6D2CF
TextColor = &H4A4744
Case [XP Yellow]
HeaderLightColor = &HE4FAFC
HeaderDarkColor = &HB9EEF4
BackLightColor = &HEEFCFD
BackDarkColor = &HDCF7FA
BorderColor = &H95E1EA
TextColor = &H66D5E1
End Select
End Sub ' wssccc's qq 151884336
Private Function DrawBackground(lLightColor As OLE_COLOR, _
lDarkColor As OLE_COLOR)
On Error GoTo ErrHandler
Dim xx, R1, R2, G1, G2, B1, B2, Rs, Gs, Bs, Rx, Gx, Bx
Dim lColor As Long, lColor2 As Long
lColor = TranslateColor(lLightColor)
lColor2 = TranslateColor(lDarkColor)
R1 = GetRed(lColor): R2 = GetRed(lColor2)
G1 = GetGreen(lColor): G2 = GetGreen(lColor2)
B1 = GetBlue(lColor): B2 = GetBlue(lColor2)
If Style = [Header Visible] Then
Rx = R1: Gx = G1: Bx = B1
Rs = (R1 - R2) / (Picture2.ScaleHeight - 1)
Gs = (G1 - G2) / (Picture2.ScaleHeight - 1)
Bs = (B1 - B2) / (Picture2.ScaleHeight - 1)
For xx = 24 To UserControl.ScaleHeight - 1
UserControl.Line (0, xx)-(Picture2.ScaleWidth, xx), RGB(Rx, Gx, Bx)
Rx = Rx - Rs
Gx = Gx - Gs
Bx = Bx - Bs
Next xx
Else
Rx = R1: Gx = G1: Bx = B1
Rs = (R1 - R2) / (UserControl.ScaleHeight - 1)
Gs = (G1 - G2) / (UserControl.ScaleHeight - 1)
Bs = (B1 - B2) / (UserControl.ScaleHeight - 1)
For xx = 0 To UserControl.ScaleHeight - 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -