📄 改变窗体颜色.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1995
ClientLeft = 165
ClientTop = 450
ClientWidth = 6360
LinkTopic = "Form1"
ScaleHeight = 1995
ScaleWidth = 6360
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "拟改变的颜色配置"
Height = 1665
Left = 1590
TabIndex = 12
Top = 120
Width = 3285
Begin VB.TextBox Text4
Alignment = 1 'Right Justify
Height = 285
Left = 2550
TabIndex = 0
Top = 360
Width = 585
End
Begin VB.TextBox Text5
Alignment = 1 'Right Justify
Height = 285
Left = 2550
TabIndex = 14
Top = 795
Width = 585
End
Begin VB.TextBox Text6
Alignment = 1 'Right Justify
Height = 285
Left = 2550
TabIndex = 13
Top = 1230
Width = 585
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "设置红色数值（0 － 255）："
Height = 180
Left = 120
TabIndex = 17
Top = 420
Width = 2340
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "设置绿色数值（0 － 255）："
Height = 180
Left = 120
TabIndex = 16
Top = 855
Width = 2340
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "设置蓝色数值（0 － 255）："
Height = 180
Left = 120
TabIndex = 15
Top = 1290
Width = 2340
End
End
Begin VB.Frame Frame1
Caption = "原颜色配置"
Height = 1665
Left = 180
TabIndex = 5
Top = 120
Width = 1275
Begin VB.TextBox Text3
Alignment = 2 'Center
Height = 270
Left = 480
Locked = -1 'True
TabIndex = 11
Top = 1230
Width = 525
End
Begin VB.TextBox Text2
Alignment = 2 'Center
Height = 270
Left = 480
Locked = -1 'True
TabIndex = 10
Top = 795
Width = 525
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 270
Left = 480
Locked = -1 'True
TabIndex = 9
Top = 360
Width = 525
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "蓝："
Height = 180
Left = 120
TabIndex = 8
Top = 1260
Width = 360
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "绿："
Height = 180
Left = 120
TabIndex = 7
Top = 825
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "红："
Height = 180
Left = 120
TabIndex = 6
Top = 390
Width = 360
End
End
Begin VB.CommandButton Command4
Caption = "退 出"
Enabled = 0 'False
Height = 345
Left = 4950
TabIndex = 4
Top = 1380
Width = 1155
End
Begin VB.CommandButton Command3
Caption = "重置颜色"
Enabled = 0 'False
Height = 345
Left = 4950
TabIndex = 3
Top = 1005
Width = 1155
End
Begin VB.CommandButton Command2
Caption = "恢复颜色"
Enabled = 0 'False
Height = 345
Left = 4950
TabIndex = 2
Top = 645
Width = 1155
End
Begin VB.CommandButton Command1
BackColor = &H8000000A&
Caption = "改变颜色"
Enabled = 0 'False
Height = 345
Left = 4950
MaskColor = &H00C00000&
TabIndex = 1
Top = 270
Width = 1155
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' API函数声明
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
' 字符常数说明
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Dim OldR As String, OldG As String, OldB As String
' 窗体装入
Private Sub Form_Load()
Dim hKey As Long
Dim I As Integer, N As Integer
Dim K(2) As Integer
Dim ColorStr As String
Dim lValueType As Long, strBuf As String, lDataBufSize As Long
' 读取 ButtonText 的配色方案
' 打开子键
RegOpenKey HKEY_CURRENT_USER, "Control Panel\Colors", hKey
' 读入保存在注册表中的数据
RegQueryValueEx hKey, "ButtonText", 0, lValueType, ByVal 0, lDataBufSize
strBuf = String(lDataBufSize, Chr$(0))
RegQueryValueEx hKey, "ButtonText", 0, 0, ByVal strBuf, lDataBufSize
ColorStr = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
' 分离 R、G、B 字符
For I = 1 To Len(ColorStr)
If Mid(ColorStr, I, 1) = Chr$(32) Then
N = N + 1
K(N) = I
End If
Next I
' 保存及显示原颜色配置数据
OldR = Mid(ColorStr, 1, K(1) - 1)
OldG = Val(Mid(ColorStr, K(1) + 1, K(2) - K(1)))
OldB = Mid(ColorStr, K(2) + 1, 3)
Text1 = OldR: Text2 = OldG: Text3 = OldB
End Sub
' 输入新的配色数据
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Text4 = "" Or Val(Text4) < 0 Or Val(Text4) > 255 Then
Text4 = ""
Text4.SetFocus
Else
Text5.SetFocus
End If
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Text5 = "" Or Val(Text5) < 0 Or Val(Text5) > 255 Then
Text5 = ""
Text5.SetFocus
Else
Text6.SetFocus
End If
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Text6 = "" Or Val(Text6) < 0 Or Val(Text6) > 255 Then
Text6 = ""
Text6.SetFocus
Else
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
End If
End If
End Sub
' 改变颜色
Private Sub Command1_Click()
SetSysColors 1, 18, RGB(Text4, Text5, Text6)
End Sub
' 恢复颜色
Private Sub Command2_Click()
SetSysColors 1, 18, RGB(OldR, OldG, OldB)
End Sub
' 重置颜色
Private Sub Command3_click()
Text4 = "": Text5 = "": Text6 = ""
Text4.SetFocus
Command1.Enabled = False
Command2.Enabled = False
Command4.Enabled = False
End Sub
' 恢复原颜色配置，退出系统
Private Sub Command4_Click()
SetSysColors 1, 18, RGB(OldR, OldG, OldB)
Unload Me
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -