System Color

'System Colors



Private Declare Function SetSysColors
Lib "user32" _

(ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long

Private Declare Function GetSysColor
Lib "user32" _

(ByVal nIndex As Long) As Long



Const COLOR_SCROLLBAR = 0            
'The Scrollbar colour

Const COLOR_BACKGROUND = 1        'Colour of the background with no wallpaper

Const COLOR_ACTIVECAPTION = 2    
'Caption of Active Window

Const COLOR_INACTIVECAPTION = 3
'Caption of Inactive window

Const COLOR_MENU = 4                        
'Menu

Const COLOR_WINDOW = 5                  
'Windows background

Const COLOR_WINDOWFRAME = 6     
'Window frame

Const COLOR_MENUTEXT = 7               
'Window Text

Const COLOR_WINDOWTEXT = 8         
'3D dark shadow (Win95)

Const COLOR_CAPTIONTEXT = 9          'Text in window caption

Const COLOR_ACTIVEBORDER = 10     
'Border of active window

Const COLOR_INACTIVEBORDER = 11          
'Border of inactive window

Const COLOR_APPWORKSPACE = 12            
'Background of MDI desktop

Const COLOR_HIGHLIGHT = 13                       
'Selected item background

Const COLOR_HIGHLIGHTTEXT = 14              
'Selected menu item

Const COLOR_BTNFACE = 15                           
'Button

Const COLOR_BTNSHADOW = 16                    
'3D shading of button

Const COLOR_GRAYTEXT = 17                          'Grey text, of zero if dithering is used

Const COLOR_BTNTEXT = 18                            
'Button text

Const COLOR_INACTIVECAPTIONTEXT = 19
'Text of inactive window

Const COLOR_BTNHIGHLIGHT = 20                '3D highlight of button

Const COLOR_2NDACTIVECAPTION = 27    
'Win98 only: 2nd active window color

Const COLOR_2NDINACTIVECAPTION = 28
'Win98 only: 2nd inactive window color



Private Sub Form_Load()

col& = GetSysColor(COLOR_ACTIVECAPTION)

'Change the active caption's color to red

t& = SetSysColors(1, COLOR_ACTIVECAPTION, RGB(255, 0, 0))

MsgBox "The old title bar color was" + Str$(col&) + " and is now" +
_

Str$(GetSysColor(COLOR_ACTIVECAPTION))

End Sub



 

Sound Beep

'Sound Beep

Private Declare Function Beep
Lib "kernel32" _

(ByVal dwFreq As Long,
ByVal dwDuration As Long)
As Long



Private Sub Form_Activate()

    Dim Cnt As Long

    For Cnt = 0 To
5000 Step 10

        'play a tone of Cnt Hertz, for 10 milliseconds

        Beep Cnt, 10

        Me.Caption = Cnt

        DoEvents

    Next Cnt

End Sub



'Sound Message Beep

Private Declare Function MessageBeep
Lib "user32" _

(ByVal wType As Long)
As Long

 

Private Sub Form_Load()

    Dim Cnt As Byte

    'Beep 100 times

    For Cnt = 1 To 100

        MessageBeep 0

    Next Cnt

End Sub

Sleep

'Sleep



Private Declare Sub Sleep
Lib "kernel32" (ByVal dwMilliseconds As Long)



Private Sub Form_Load()

'sleep for 10 second

Sleep 10000

End Sub



Private Declare Function SleepEx
Lib "kernel32" _

(ByVal dwMilliseconds As Long,
ByVal bAlertable As Long) As Long



Private Sub Form_Load()

'Sleep 3 seconds

SleepEx 3000, False

End Sub



 

Shell Execute

'Shell Execute

Private Declare Function ShellExecute
Lib "shell32.dll"
Alias _

"ShellExecuteA" (ByVal hwnd
As Long, ByVal lpOperation
As String, _

ByVal lpFile As String,
ByVal lpParameters As String, _

ByVal lpDirectory As String,
ByVal nShowCmd As Long)
As Long



Const SW_SHOWNORMAL = 1



Private Sub Form_Load()

'Visit my Blog

ShellExecute Me.hwnd, vbNullString, "http:\\RockessAlpha.blogspot.com", _

vbNullString, "C:\", SW_SHOWNORMAL

End Sub



 

Shell About Me

'About ME



Private Declare Function ShellAbout
Lib "shell32.dll" Alias
_

"ShellAboutA" (ByVal hWnd As Long, ByVal szApp
As String, _

ByVal szOtherStuff As String, ByVal hIcon As Long) As Long



Private Sub Form_Load()

'Show an about window

ShellAbout Me.hWnd, "About RockessAlpha.blogspot.com", _

"Created by Rockess Alpha", ByVal 0&

End Sub



 

Get System Time Adjustment

'Get System Time Adjustment



Private Declare Function GetSystemTimeAdjustment
Lib "kernel32" _

(lpTimeAdjustment As Long, lpTimeIncrement As Long, _

lpTimeAdjustmentDisabled As Boolean) As Long



Private Sub Form_Load()

Dim RetAdd As Long, RetInterval As Long, RetAdjust
As Boolean

GetSystemTimeAdjustment RetAdd, RetInterval, RetAdjust



If RetAdjust Then

MsgBox "Periodic time adjustment is disabled!", _

vbInformation

Else

MsgBox "Every " + CStr(RetInterval) + _

"x100 nanoseconds, the computer adds " + CStr(RetAdd) + _

"x100 nanoseconds to your time-of-day clock.", _

vbInformation

End If



End Sub



 

Set Time

'Set Time



Private Declare Sub SetSystemTime
Lib "kernel32" _

(lpSystemTime As SYSTEMTIME)



Private Type SYSTEMTIME

    wYear As Integer

    wMonth As Integer

    wDayOfWeek As Integer

    wDay As Integer

    wHour As Integer

    wMinute As Integer

    wSecond As Integer

    wMilliseconds As Integer

End Type



Private Sub Form_Load()

Dim lpSystemTime As
SYSTEMTIME

lpSystemTime.wYear = 2009

lpSystemTime.wMonth = 1

lpSystemTime.wDayOfWeek = -1

lpSystemTime.wDay = 13

lpSystemTime.wHour = 8

lpSystemTime.wMinute = 13

lpSystemTime.wSecond = 8

lpSystemTime.wMilliseconds = 0

'set the new time

SetSystemTime lpSystemTime

End Sub