Source VB Aplikasi "WinColor"

Pada postingan saya yang terdahulu "Tool Pengganti Warna Windows" telah dijelaskan kegunaannya, yaitu sebagai tool untuk mengganti warna window yang mana tool ini mengambil nilai value yang berada di dalam registry pc.

Postingan berikut ini adalah source dari tool itu sendiri, semoga bermanfaat bagi teman. Silahkan modifikasi dengan imajinasi teman sendiri. Komponent yang harus disiapkan adalah "TextBox" sebanyak 30 biji dan satu buah CommandButton. Berikut adalah listing programnya :

Sub check_Text1()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ActiveBorder = codetan.regread("HKCU\Control Panel\Colors\ActiveBorder")
Text1.Text = ActiveBorder
End Sub

Sub check_Text2()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ActiveTitle = codetan.regread("HKCU\Control Panel\Colors\ActiveTitle")
Text2.Text = ActiveTitle
End Sub

Sub check_Text3()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
AppWorkSpace = codetan.regread("HKCU\Control Panel\Colors\AppWorkSpace")
Text3.Text = AppWorkSpace
End Sub

Sub check_Text4()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Background = codetan.regread("HKCU\Control Panel\Colors\Background")
Text4.Text = Background
End Sub

Sub check_Text5()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonAlternateFace = codetan.regread("HKCU\Control Panel\Colors\ButtonAlternateFace")
Text5.Text = ButtonAlternateFace
End Sub

Sub check_Text6()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonDkShadow = codetan.regread("HKCU\Control Panel\Colors\ButtonDkShadow")
Text6.Text = ButtonDkShadow
End Sub

Sub check_Text7()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonFace = codetan.regread("HKCU\Control Panel\Colors\ButtonFace")
Text7.Text = ButtonFace
End Sub

Sub check_Text8()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonHilight = codetan.regread("HKCU\Control Panel\Colors\ButtonHilight")
Text8.Text = ButtonHilight
End Sub

Sub check_Text9()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Buttonlight = codetan.regread("HKCU\Control Panel\Colors\Buttonlight")
Text9.Text = Buttonlight
End Sub

Sub check_Text10()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonShadow = codetan.regread("HKCU\Control Panel\Colors\ButtonShadow")
Text10.Text = ButtonShadow
End Sub

Sub check_Text11()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
ButtonText = codetan.regread("HKCU\Control Panel\Colors\ButtonText")
Text11.Text = ButtonText
End Sub

Sub check_Text12()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
GradientActiveTitle = codetan.regread("HKCU\Control Panel\Colors\GradientActiveTitle")
Text12.Text = GradientActiveTitle
End Sub

Sub check_Text13()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
GradientInActiveTitle = codetan.regread("HKCU\Control Panel\Colors\GradientInActiveTitle")
Text13.Text = GradientInActiveTitle
End Sub

Sub check_Text14()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
GrayText = codetan.regread("HKCU\Control Panel\Colors\GrayText")
Text14.Text = GrayText
End Sub

Sub check_Text15()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
HotTrackingColor = codetan.regread("HKCU\Control Panel\Colors\HotTrackingColor")
Text15.Text = HotTrackingColor
End Sub

Sub check_Text16()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Hilight = codetan.regread("HKCU\Control Panel\Colors\Hilight")
Text16.Text = Hilight
End Sub

Sub check_Text17()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
HilightText = codetan.regread("HKCU\Control Panel\Colors\HilightText")
Text17.Text = HilightText
End Sub

Sub check_Text18()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
InactiveBorder = codetan.regread("HKCU\Control Panel\Colors\InactiveBorder")
Text18.Text = InactiveBorder
End Sub

Sub check_Text19()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
InactiveTitle = codetan.regread("HKCU\Control Panel\Colors\InactiveTitle")
Text19.Text = InactiveTitle
End Sub

Sub check_Text20()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
InactiveTitleText = codetan.regread("HKCU\Control Panel\Colors\InactiveTitleText")
Text20.Text = InactiveTitleText
End Sub

Sub check_Text21()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
InfoText = codetan.regread("HKCU\Control Panel\Colors\InfoText")
Text21.Text = InfoText
End Sub

Sub check_Text22()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
InfoWindow = codetan.regread("HKCU\Control Panel\Colors\InfoWindow")
Text22.Text = InfoWindow
End Sub

Sub check_Text23()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Menu = codetan.regread("HKCU\Control Panel\Colors\Menu")
Text23.Text = Menu
End Sub

Sub check_Text24()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
MenuBar = codetan.regread("HKCU\Control Panel\Colors\MenuBar")
Text24.Text = MenuBar
End Sub

Sub check_Text25()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
MenuHilight = codetan.regread("HKCU\Control Panel\Colors\MenuHilight")
Text25.Text = MenuHilight
End Sub

Sub check_Text26()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
MenuText = codetan.regread("HKCU\Control Panel\Colors\MenuText")
Text26.Text = MenuText
End Sub

Sub check_Text27()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Scrollbar = codetan.regread("HKCU\Control Panel\Colors\Scrollbar")
Text27.Text = Scrollbar
End Sub

Sub check_Text28()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
TitleText = codetan.regread("HKCU\Control Panel\Colors\TitleText")
Text28.Text = TitleText
End Sub

Sub check_Text29()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
Window = codetan.regread("HKCU\Control Panel\Colors\Window")
Text29.Text = Window
End Sub

Sub check_Text30()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
WindowFrame = codetan.regread("HKCU\Control Panel\Colors\WindowFrame")
Text30.Text = WindowFrame
End Sub

Sub check_Text31()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
WindowText = codetan.regread("HKCU\Control Panel\Colors\WindowText")
Text31.Text = WindowText
End Sub

Private Sub Command1_Click()
On Error Resume Next
Set codetan = CreateObject("WScript.Shell")
codetan.RegWrite "HKCU\Control Panel\Colors\ActiveBorder", Text1, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ActiveTitle", Text2, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\AppWorkSpace", Text3, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Background", Text4, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonAlternateFace", Text5, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonDkShadow", Text6, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonFace", Text7, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonHilight", Text8, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Buttonlight", Text9, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonShadow", Text10, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\ButtonText", Text11, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\GradientActiveTitle", Text12, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\GradientInActiveTitle", Text13, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\GrayText", Text14, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\HotTrackingColor", Text15, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Hilight", Text16, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\HilightText", Text17, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\InactiveBorder", Text18, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\InactiveTitle", Text19, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\InactiveTitleText", Text20, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\InfoText", Text21, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\InfoWindow", Text22, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Menu", Text23, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\MenuBar", Text24, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\MenuHilight", Text25, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\MenuText", Text26, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Scrollbar", Text27, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\TitleText", Text28, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\Window", Text29, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\WindowFrame", Text30, "REG_SZ"
codetan.RegWrite "HKCU\Control Panel\Colors\WindowText", Text31, "REG_SZ"
End Sub

Private Sub Form_Load()
header
check_Text1
check_Text2
check_Text3
check_Text4
check_Text5
check_Text6
check_Text7
check_Text8
check_Text9
check_Text10
check_Text11
check_Text12
check_Text13
check_Text14
check_Text15
check_Text16
check_Text17
check_Text18
check_Text19
check_Text20
check_Text21
check_Text22
check_Text23
check_Text24
check_Text25
check_Text26
check_Text27
check_Text28
check_Text29
check_Text30
check_Text31
End Sub

Sub header()
On Error Resume Next
Me.Caption = " • " & App.Title & " - " & App.CompanyName
End Sub

Untuk hasil yang telah jadi silahkan teman lihat di link ini. Selamat berkarya.