home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch06 / sysinfo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  17.4 KB  |  483 lines
  1. VERSION 5.00
  2. Begin VB.Form SysInfo 
  3.    BackColor       =   &H00E0E0E0&
  4.    Caption         =   "System Information Viewer"
  5.    ClientHeight    =   3870
  6.    ClientLeft      =   1275
  7.    ClientTop       =   1965
  8.    ClientWidth     =   7365
  9.    BeginProperty Font 
  10.       Name            =   "MS Sans Serif"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    LinkMode        =   1  'Source
  20.    LinkTopic       =   "Form1"
  21.    PaletteMode     =   1  'UseZOrder
  22.    ScaleHeight     =   3870
  23.    ScaleWidth      =   7365
  24.    Begin VB.Timer Timer1 
  25.       Interval        =   250
  26.       Left            =   6120
  27.       Top             =   120
  28.    End
  29.    Begin VB.ListBox ListColor 
  30.       Appearance      =   0  'Flat
  31.       Height          =   2565
  32.       Left            =   240
  33.       TabIndex        =   2
  34.       Top             =   600
  35.       Visible         =   0   'False
  36.       Width           =   3015
  37.    End
  38.    Begin VB.TextBox KeyCheck 
  39.       Height          =   615
  40.       Left            =   5880
  41.       MultiLine       =   -1  'True
  42.       TabIndex        =   0
  43.       Text            =   "SYSINFO.frx":0000
  44.       Top             =   720
  45.       Width           =   1455
  46.    End
  47.    Begin VB.TextBox Text1 
  48.       Height          =   1095
  49.       Left            =   5880
  50.       MultiLine       =   -1  'True
  51.       TabIndex        =   1
  52.       Text            =   "SYSINFO.frx":0016
  53.       Top             =   1440
  54.       Width           =   1335
  55.    End
  56.    Begin VB.Label LabelColor 
  57.       Alignment       =   2  'Center
  58.       Appearance      =   0  'Flat
  59.       BackColor       =   &H00FFFFFF&
  60.       BorderStyle     =   1  'Fixed Single
  61.       Caption         =   "Color"
  62.       ForeColor       =   &H80000008&
  63.       Height          =   315
  64.       Left            =   240
  65.       TabIndex        =   3
  66.       Top             =   120
  67.       Visible         =   0   'False
  68.       Width           =   3015
  69.    End
  70.    Begin VB.Label LabelKeyState 
  71.       Appearance      =   0  'Flat
  72.       BackColor       =   &H80000005&
  73.       BorderStyle     =   1  'Fixed Single
  74.       ForeColor       =   &H80000008&
  75.       Height          =   255
  76.       Left            =   4800
  77.       TabIndex        =   4
  78.       Top             =   3480
  79.       Width           =   2415
  80.    End
  81.    Begin VB.Menu MenuGeneral 
  82.       Caption         =   "General"
  83.       Begin VB.Menu MenuFreeSpace 
  84.          Caption         =   "Free&Space"
  85.       End
  86.       Begin VB.Menu MenuTimes 
  87.          Caption         =   "&Times"
  88.       End
  89.       Begin VB.Menu MenuFlags 
  90.          Caption         =   "&Flags"
  91.       End
  92.    End
  93.    Begin VB.Menu MenuSystem 
  94.       Caption         =   "System"
  95.       Begin VB.Menu MenuColors 
  96.          Caption         =   "&Colors"
  97.       End
  98.       Begin VB.Menu MenuMetrics 
  99.          Caption         =   "&Metrics"
  100.       End
  101.       Begin VB.Menu MenuParameters 
  102.          Caption         =   "&Parameters"
  103.       End
  104.       Begin VB.Menu MenuKeyboard 
  105.          Caption         =   "&Keyboard"
  106.       End
  107.       Begin VB.Menu MenuLocale 
  108.          Caption         =   "&Locale"
  109.       End
  110.    End
  111. Attribute VB_Name = "SysInfo"
  112. Attribute VB_GlobalNameSpace = False
  113. Attribute VB_Creatable = False
  114. Attribute VB_PredeclaredId = True
  115. Attribute VB_Exposed = False
  116. Option Explicit
  117. ' Copyright 
  118.  1997 by Desaware Inc. All Rights Reserved
  119. Private Sub Form_Load()
  120.     Dim dl&
  121.     #If Win32 Then
  122.         ' Preload version information
  123.         dl& = GetVersionEx&(myVer)
  124.     #End If
  125.     ListColor.AddItem "COLOR_ACTIVEBORDER"
  126.     ListColor.AddItem "COLOR_ACTIVECAPTION"
  127.     ListColor.AddItem "COLOR_APPWORKSPACE"
  128.     ListColor.AddItem "COLOR_BACKGROUND"
  129.     ListColor.AddItem "COLOR_BTNFACE"
  130.     ListColor.AddItem "COLOR_BTNHIGHLIGHT"
  131.     ListColor.AddItem "COLOR_BTNSHADOW"
  132.     ListColor.AddItem "COLOR_BTNTEXT"
  133.     ListColor.AddItem "COLOR_CAPTIONTEXT"
  134.     ListColor.AddItem "COLOR_GRAYTEXT"
  135.     ListColor.AddItem "COLOR_HIGHLIGHT"
  136.     ListColor.AddItem "COLOR_HIGHLIGHTTEXT"
  137.     ListColor.AddItem "COLOR_INACTIVEBORDER"
  138.     ListColor.AddItem "COLOR_INACTIVECAPTION"
  139.     ListColor.AddItem "COLOR_INACTIVECAPTIONTEXT"
  140.     ListColor.AddItem "COLOR_MENU"
  141.     ListColor.AddItem "COLOR_MENUTEXT"
  142.     ListColor.AddItem "COLOR_SCROLLBAR"
  143.     ListColor.AddItem "COLOR_WINDOW"
  144.     ListColor.AddItem "COLOR_WINDOWFRAME"
  145.     ListColor.AddItem "COLOR_WINDOWTEXT"
  146.     ' These are new for Windows 95. Even though they
  147.     ' are defined for Win32, they will also work on Win16 on Win95!
  148.     ListColor.AddItem "COLOR_3DDKSHADOW"
  149.     ListColor.AddItem "COLOR_3DLIGHT"
  150.     ListColor.AddItem "COLOR_INFOBK"
  151.     ListColor.AddItem "COLOR_INFOTEXT"
  152. End Sub
  153. '   Display in the edit control the name of the key
  154. Private Sub KeyCheck_KeyDown(KeyCode As Integer, Shift As Integer)
  155.     Dim dummy&
  156.     Dim scancode&
  157.     Dim keyname As String * 256
  158.     ' Get the scancode
  159.     scancode& = MapVirtualKey(KeyCode, 0)
  160.     ' Shift the scancode to the high word and get the
  161.     ' key name
  162.     dummy = GetKeyNameText(scancode& * &H10000, keyname, 255)
  163.     KeyCheck.Text = keyname
  164. End Sub
  165. Private Sub KeyCheck_KeyPress(KeyAscii As Integer)
  166.     KeyAscii = 0    ' Ignore keys in this control
  167. End Sub
  168. Private Sub KeyCheck_LostFocus()
  169.     KeyCheck.Text = "Press key to get info"
  170. End Sub
  171. ' Display the selected color in the label control.
  172. Private Sub ListColor_Click()
  173.     Dim colindex%
  174.     Select Case ListColor.ListIndex
  175.         Case 0
  176.             colindex% = COLOR_ACTIVEBORDER
  177.         Case 1
  178.             colindex% = COLOR_ACTIVECAPTION
  179.         Case 2
  180.             colindex% = COLOR_APPWORKSPACE
  181.         Case 3
  182.             colindex% = COLOR_BACKGROUND
  183.         Case 4
  184.             colindex% = COLOR_BTNFACE
  185.         Case 5
  186.             colindex% = COLOR_BTNHIGHLIGHT
  187.         Case 6
  188.             colindex% = COLOR_BTNSHADOW
  189.         Case 7
  190.             colindex% = COLOR_BTNTEXT
  191.         Case 8
  192.             colindex% = COLOR_CAPTIONTEXT
  193.         Case 9
  194.             colindex% = COLOR_GRAYTEXT
  195.         Case 10
  196.             colindex% = COLOR_HIGHLIGHT
  197.         Case 11
  198.             colindex% = COLOR_HIGHLIGHTTEXT
  199.         Case 12
  200.             colindex% = COLOR_INACTIVEBORDER
  201.         Case 13
  202.             colindex% = COLOR_INACTIVECAPTION
  203.         Case 14
  204.             colindex% = COLOR_INACTIVECAPTIONTEXT
  205.         Case 15
  206.             colindex% = COLOR_MENU
  207.         Case 16
  208.             colindex% = COLOR_MENUTEXT
  209.         Case 17
  210.             colindex% = COLOR_SCROLLBAR
  211.         Case 18
  212.             colindex% = COLOR_WINDOW
  213.         Case 19
  214.             colindex% = COLOR_WINDOWFRAME
  215.         Case 20
  216.             colindex% = COLOR_WINDOWTEXT
  217.         Case 21
  218.             colindex% = COLOR_3DDKSHADOW
  219.         Case 22
  220.             colindex% = COLOR_3DLIGHT
  221.         Case 23
  222.             colindex% = COLOR_INFOBK
  223.         Case 24
  224.             colindex% = COLOR_INFOTEXT
  225.     End Select
  226.     LabelColor.BackColor = GetSysColor&(colindex%) And &HFFFFFF
  227. End Sub
  228. Private Sub MenuColors_Click()
  229.     SysInfo.Cls
  230.     ShowColors -1
  231. End Sub
  232. Private Sub MenuFlags_Click()
  233.     Dim flagnum&
  234.     Dim dl&, s$
  235.     Dim vernum&, verword%
  236.     #If Win32 Then
  237.         Dim mySys As SYSTEM_INFO
  238.     #End If
  239.     ShowColors 0
  240.     SysInfo.Cls
  241.     Print
  242.     ' Get the windows flags and version numbers
  243.     #If Win32 Then
  244.         myVer.dwOSVersionInfoSize = 148
  245.         dl& = GetVersionEx&(myVer)
  246.         If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  247.             s$ = " Windows95 "
  248.         ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
  249.             s$ = " Windows NT "
  250.         End If
  251.         Print s$ & myVer.dwMajorVersion & "." & myVer.dwMinorVersion & " Build " & (myVer.dwBuildNumber And &HFFFF&)
  252.         s$ = LPSTRToVBString(myVer.szCSDVersion)
  253.         If Len(s$) > 0 Then Print s$
  254.         GetSystemInfo mySys
  255.         Print " Page size is " & mySys.dwPageSize; " bytes"
  256.         Print " Lowest memory address: &H" & Hex$(mySys.lpMinimumApplicationAddress)
  257.         Print " Highest memory address: &H" & Hex$(mySys.lpMaximumApplicationAddress)
  258.         Print " Number of processors: "; mySys.dwNumberOfProcessors
  259.         Print " Processor: ";
  260.         Select Case mySys.dwProcessorType
  261.             Case PROCESSOR_INTEL_386
  262.                     Print "Intel 386"
  263.             Case PROCESSOR_INTEL_486
  264.                     Print "Intel 486"
  265.             Case PROCESSOR_INTEL_PENTIUM
  266.                     Print "Intel Pentium"
  267.             Case PROCESSOR_MIPS_R4000
  268.                     Print "MIPS R4000"
  269.             Case PROCESSOR_ALPHA_21064
  270.                     Print "Alpha 21064"
  271.         End Select
  272.         
  273.     #Else
  274.         flagnum& = GetWinFlags&()
  275.         vernum& = GetVersion&()
  276.         verword% = CInt(vernum& / &H10000)
  277.             
  278.         Print " Running MS-DOS version "; verword% / 256; "."; verword% And &HFF
  279.         verword% = CInt(vernum& And &HFFFF&)
  280.         Print " Running Windows version "; verword% And &HFF; "."; CInt(verword% / 256)
  281.         
  282.         If flagnum& And WF_80x87 Then Print " 80x87 coprocessor present"
  283.         If flagnum& And WF_CPU086 Then Print " 8086 present"
  284.         If flagnum& And WF_CPU186 Then Print " 80186 present"
  285.         If flagnum& And WF_CPU286 Then Print " 80286 present"
  286.         If flagnum& And WF_CPU386 Then Print " 80386 present"
  287.         If flagnum& And WF_CPU486 Then Print " 80486 present"
  288.         If flagnum& And WF_ENHANCED Then Print " Windows 386-enhanced mode"
  289.     #End If
  290. End Sub
  291. Private Sub MenuFreeSpace_Click()
  292.     ShowColors 0
  293.     SysInfo.Cls
  294.     Print
  295.     ' These functions are obsolete under Win32
  296.     #If Win16 Then
  297.         Print GetFreeSpace&(0); "Bytes free in Global Heap"
  298.         Print GetFreeSystemResources%(GFSR_SYSTEMRESOURCES); "% free system resources."
  299.         Print GetFreeSystemResources%(GFSR_GDIRESOURCES); "% free GDI resources."
  300.         Print GetFreeSystemResources%(GFSR_USERRESOURCES); "% free USER resources."
  301.     #Else
  302.         Print " Refer Chapter 15 examples for information"
  303.         Print " on retrieving memory statistics for Win32"
  304.     #End If
  305. End Sub
  306. ' Display keyboard related iformation.
  307. Private Sub MenuKeyboard_Click()
  308.     Dim cp As CPINFO
  309.     Dim cpAnsi&, cpOEM&
  310.     Dim dl&
  311.     Dim layoutname As String * KL_NAMELENGTH
  312.     Print
  313.     SysInfo.Cls
  314.     #If Win32 Then
  315.         cpAnsi = GetACP()
  316.         cpOEM = GetOEMCP()
  317.         Print " ANSI code page: " & cpAnsi
  318.         dl& = GetCPInfo(cpAnsi, cp)
  319.         Print " Max byte length is " & cp.MaxCharSize
  320.         dl& = GetCPInfo(cpOEM, cp)
  321.         Print " OEM code page: " & cpOEM
  322.         Print " Max byte length is " & cp.MaxCharSize
  323.         dl& = GetKeyboardLayoutName(layoutname)
  324.         Print " Keyboard layout: " & LPSTRToVBString(layoutname)
  325.         dl& = GetKeyboardType(0)
  326.         Select Case dl&
  327.             Case 0
  328.                 Print " PC 83 key keyboard"
  329.             Case 3
  330.                 Print " AT 84 key keyboard"
  331.             Case 4
  332.                 Print " Enhanced 101 or 102 key keyboard"
  333.             Case Else
  334.                 Print " Special keyboard"
  335.         End Select
  336.         dl& = GetKeyboardType(2)
  337.         Print " Keyboard has " & dl & " function keys."
  338.     #Else
  339.         Print " Not implemented under Win16 at this time"
  340.     #End If
  341. End Sub
  342. ' Locale specific information
  343. Private Sub MenuLocale_Click()
  344.     Dim buffer As String * 100
  345.     Dim dl&
  346.     SysInfo.Cls
  347.     #If Win32 Then
  348.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SENGLANGUAGE, buffer, 99)
  349.         Print " Language: " & LPSTRToVBString(buffer)
  350.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SENGCOUNTRY, buffer, 99)
  351.         Print " Country: " & LPSTRToVBString(buffer)
  352.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, buffer, 99)
  353.         Print " Currency Symbol: " & LPSTRToVBString(buffer)
  354.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLONGDATE, buffer, 99)
  355.         Print " Long date format: " & LPSTRToVBString(buffer)
  356.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDAYNAME3, buffer, 99)
  357.         Print " Long name for Wednesday: " & LPSTRToVBString(buffer)
  358.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SABBREVDAYNAME3, buffer, 99)
  359.         Print " Abbreviation for Wednesday: " & LPSTRToVBString(buffer)
  360.     #Else
  361.         Print " Not implemented under Win16"
  362.     #End If
  363. End Sub
  364. '   The following is a selection of the system metrics
  365. '   that can be determined - see the reference section
  366. '   under the GetSystemMetrics function for more.
  367. Private Sub MenuMetrics_Click()
  368.     ShowColors 0
  369.     SysInfo.Cls
  370.     Print
  371.     Print " Non sizeable border width,height = "; GetSystemMetrics(SM_CXBORDER); ","; GetSystemMetrics(SM_CYBORDER)
  372.     Print " Caption height = "; GetSystemMetrics(SM_CYCAPTION)
  373.     Print " Cursor width,height = "; GetSystemMetrics(SM_CXCURSOR); ","; GetSystemMetrics(SM_CYCURSOR)
  374.     Print " Icon width,height = "; GetSystemMetrics(SM_CXICON); ","; GetSystemMetrics(SM_CYICON)
  375.     Print " Width,Height of client area of full screen window = "; GetSystemMetrics(SM_CXFULLSCREEN); ","; GetSystemMetrics(SM_CYFULLSCREEN)
  376.     Print " Menu bar height = "; GetSystemMetrics(SM_CYMENU)
  377.     Print " Minimum width,height of window = "; GetSystemMetrics(SM_CXMIN); ","; GetSystemMetrics(SM_CYMIN)
  378.     ' Here is a sample Windows 95 specific metric
  379.     #If Win32 Then
  380.         If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  381.             Print " Small Icon width,height = "; GetSystemMetrics(SM_CXSMICON); ","; GetSystemMetrics(SM_CYSMICON)
  382.         End If
  383.     #End If
  384. End Sub
  385. '   A few examples of the many system parameters that can
  386. '   be set and retreived using the SystemParametersInfo
  387. '   function
  388. Private Sub MenuParameters_Click()
  389.     Dim dummy&
  390.     SysInfo.Cls
  391.     #If Win32 Then
  392.         Dim intval&
  393.     #Else
  394.         Dim intval%
  395.     #End If
  396.     ShowColors 0
  397.     SysInfo.Cls
  398.     Print
  399.     dummy = SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, intval, 0)
  400.     Print " Keyboard Delay is "; intval
  401.     dummy = SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, intval, 0)
  402.     Print " Keyboard Speed is "; intval
  403.     dummy = SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, intval, 0)
  404.     If intval Then Print " Screen Saver is Active"
  405.     dummy = SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, intval, 0)
  406.     Print " Screen Save Delay is "; intval; " seconds"
  407. End Sub
  408. Private Sub MenuTimes_Click()
  409.     Dim curtime&
  410.     ShowColors 0
  411.     SysInfo.Cls
  412.     Print
  413.     Print " Caret blinks every "; GetCaretBlinkTime(); " ms"
  414.     #If Win16 Then
  415.         curtime& = GetCurrentTime()
  416.     #Else
  417.         curtime& = GetTickCount()
  418.     #End If
  419.     Print " It's been "; curtime&; " ms since Windows was started"
  420.     Print " The last Windows message was processed at "; GetMessageTime&(); " ms"
  421.     Print " Two clicks within "; GetDoubleClickTime(); " ms of each other are a double click"
  422.     #If Win16 Then
  423.         Print " Timer resolution is "; GetTimerResolution&(); "microseconds per tick"
  424.     #End If
  425. End Sub
  426. '   Use to show or hide the colors listbox and label
  427. Private Sub ShowColors(bflag%)
  428.     If bflag% Then  ' Show them
  429.         ListColor.Visible = -1
  430.         LabelColor.Visible = -1
  431.     Else    ' Hide them
  432.         ListColor.Visible = 0
  433.         LabelColor.Visible = 0
  434.     End If
  435. End Sub
  436. '   This shows how a custom caret can be used in a text
  437. '   box. Note that an arbitrary bitmap could be used as
  438. '   well (refer to the function reference for the
  439. '   CreateCaret function - also chapter 8 for information
  440. '   on bitmaps).
  441. '   Also note that VB may change the caret back to the
  442. '   default without notice (like when a menu or other
  443. '   application is selected)
  444. Private Sub Text1_GotFocus()
  445.     ' Save the original blink time - it will be used to
  446.     ' restore the original value during the LostFocus event
  447.     OriginalCaretBlinkTime% = GetCaretBlinkTime()
  448.     ' Creat a different shaped caret
  449.     CreateCaret Text1.hWnd, 0, 10, 15
  450.     ' Creating the new caret caused the prior one (the
  451.     ' default for the edit control) to be destroyed and
  452.     ' thus hidden. So we must show the new caret.
  453.     ShowCaret Text1.hWnd
  454.     ' And change to an obnoxiously fast blink time - just
  455.     ' to show how it's done.
  456.     SetCaretBlinkTime 150
  457. End Sub
  458. '   Be sure to set the caret blink time back to its
  459. '   original value when the control loses the focus
  460. Private Sub Text1_LostFocus()
  461.     SetCaretBlinkTime OriginalCaretBlinkTime%
  462. End Sub
  463. '   Update a label field to show the current state
  464. '   of the capslock, numlock and scroll lock keys
  465. Private Sub Timer1_Timer()
  466.     Dim numlock%, scrolllock%, capslock%
  467.     Dim keyarray(256) As Byte
  468.     Dim dl&
  469.     Dim res$
  470.     capslock% = GetKeyState%(VK_CAPITAL)
  471.     numlock% = GetKeyState%(VK_NUMLOCK)
  472.         
  473.     ' Here's another way to do it - take a snapshot
  474.     ' of the entire keyboard
  475.     dl& = GetKeyboardState(keyarray(0))
  476.     scrolllock% = keyarray(VK_SCROLL) ' GetKeyState%(VK_SCROLL)
  477.     ' The low bit indicates the state of the toggle
  478.     If capslock% And 1 Then res$ = res$ + "CAPS  "
  479.     If numlock% And 1 Then res$ = res$ + "NUM  "
  480.     If scrolllock% And 1 Then res$ = res$ + "SCROLL"
  481.     LabelKeyState.Caption = res$
  482. End Sub
  483.