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 / classlib / desaware / samplev5 / sysinfo / sysinfo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-17  |  17.3 KB  |  481 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. Private Sub Form_Load()
  118.     Dim dl&
  119.     #If Win32 Then
  120.         ' Preload version information
  121.         dl& = GetVersionEx&(myVer)
  122.     #End If
  123.     ListColor.AddItem "COLOR_ACTIVEBORDER"
  124.     ListColor.AddItem "COLOR_ACTIVECAPTION"
  125.     ListColor.AddItem "COLOR_APPWORKSPACE"
  126.     ListColor.AddItem "COLOR_BACKGROUND"
  127.     ListColor.AddItem "COLOR_BTNFACE"
  128.     ListColor.AddItem "COLOR_BTNHIGHLIGHT"
  129.     ListColor.AddItem "COLOR_BTNSHADOW"
  130.     ListColor.AddItem "COLOR_BTNTEXT"
  131.     ListColor.AddItem "COLOR_CAPTIONTEXT"
  132.     ListColor.AddItem "COLOR_GRAYTEXT"
  133.     ListColor.AddItem "COLOR_HIGHLIGHT"
  134.     ListColor.AddItem "COLOR_HIGHLIGHTTEXT"
  135.     ListColor.AddItem "COLOR_INACTIVEBORDER"
  136.     ListColor.AddItem "COLOR_INACTIVECAPTION"
  137.     ListColor.AddItem "COLOR_INACTIVECAPTIONTEXT"
  138.     ListColor.AddItem "COLOR_MENU"
  139.     ListColor.AddItem "COLOR_MENUTEXT"
  140.     ListColor.AddItem "COLOR_SCROLLBAR"
  141.     ListColor.AddItem "COLOR_WINDOW"
  142.     ListColor.AddItem "COLOR_WINDOWFRAME"
  143.     ListColor.AddItem "COLOR_WINDOWTEXT"
  144.     ' These are new for Windows 95. Even though they
  145.     ' are defined for Win32, they will also work on Win16 on Win95!
  146.     ListColor.AddItem "COLOR_3DDKSHADOW"
  147.     ListColor.AddItem "COLOR_3DLIGHT"
  148.     ListColor.AddItem "COLOR_INFOBK"
  149.     ListColor.AddItem "COLOR_INFOTEXT"
  150. End Sub
  151. '   Display in the edit control the name of the key
  152. Private Sub KeyCheck_KeyDown(KeyCode As Integer, Shift As Integer)
  153.     Dim dummy&
  154.     Dim scancode&
  155.     Dim keyname As String * 256
  156.     ' Get the scancode
  157.     scancode& = MapVirtualKey(KeyCode, 0)
  158.     ' Shift the scancode to the high word and get the
  159.     ' key name
  160.     dummy = GetKeyNameText(scancode& * &H10000, keyname, 255)
  161.     KeyCheck.Text = keyname
  162. End Sub
  163. Private Sub KeyCheck_KeyPress(KeyAscii As Integer)
  164.     KeyAscii = 0    ' Ignore keys in this control
  165. End Sub
  166. Private Sub KeyCheck_LostFocus()
  167.     KeyCheck.Text = "Press key to get info"
  168. End Sub
  169. ' Display the selected color in the label control.
  170. Private Sub ListColor_Click()
  171.     Dim colindex%
  172.     Select Case ListColor.ListIndex
  173.         Case 0
  174.             colindex% = COLOR_ACTIVEBORDER
  175.         Case 1
  176.             colindex% = COLOR_ACTIVECAPTION
  177.         Case 2
  178.             colindex% = COLOR_APPWORKSPACE
  179.         Case 3
  180.             colindex% = COLOR_BACKGROUND
  181.         Case 4
  182.             colindex% = COLOR_BTNFACE
  183.         Case 5
  184.             colindex% = COLOR_BTNHIGHLIGHT
  185.         Case 6
  186.             colindex% = COLOR_BTNSHADOW
  187.         Case 7
  188.             colindex% = COLOR_BTNTEXT
  189.         Case 8
  190.             colindex% = COLOR_CAPTIONTEXT
  191.         Case 9
  192.             colindex% = COLOR_GRAYTEXT
  193.         Case 10
  194.             colindex% = COLOR_HIGHLIGHT
  195.         Case 11
  196.             colindex% = COLOR_HIGHLIGHTTEXT
  197.         Case 12
  198.             colindex% = COLOR_INACTIVEBORDER
  199.         Case 13
  200.             colindex% = COLOR_INACTIVECAPTION
  201.         Case 14
  202.             colindex% = COLOR_INACTIVECAPTIONTEXT
  203.         Case 15
  204.             colindex% = COLOR_MENU
  205.         Case 16
  206.             colindex% = COLOR_MENUTEXT
  207.         Case 17
  208.             colindex% = COLOR_SCROLLBAR
  209.         Case 18
  210.             colindex% = COLOR_WINDOW
  211.         Case 19
  212.             colindex% = COLOR_WINDOWFRAME
  213.         Case 20
  214.             colindex% = COLOR_WINDOWTEXT
  215.         Case 21
  216.             colindex% = COLOR_3DDKSHADOW
  217.         Case 22
  218.             colindex% = COLOR_3DLIGHT
  219.         Case 23
  220.             colindex% = COLOR_INFOBK
  221.         Case 24
  222.             colindex% = COLOR_INFOTEXT
  223.     End Select
  224.     LabelColor.BackColor = GetSysColor&(colindex%) And &HFFFFFF
  225. End Sub
  226. Private Sub MenuColors_Click()
  227.     SysInfo.Cls
  228.     ShowColors -1
  229. End Sub
  230. Private Sub MenuFlags_Click()
  231.     Dim flagnum&
  232.     Dim dl&, s$
  233.     Dim vernum&, verword%
  234.     #If Win32 Then
  235.         Dim mySys As SYSTEM_INFO
  236.     #End If
  237.     ShowColors 0
  238.     SysInfo.Cls
  239.     Print
  240.     ' Get the windows flags and version numbers
  241.     #If Win32 Then
  242.         myVer.dwOSVersionInfoSize = 148
  243.         dl& = GetVersionEx&(myVer)
  244.         If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  245.             s$ = " Windows95 "
  246.         ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
  247.             s$ = " Windows NT "
  248.         End If
  249.         Print s$ & myVer.dwMajorVersion & "." & myVer.dwMinorVersion & " Build " & (myVer.dwBuildNumber And &HFFFF&)
  250.         s$ = LPSTRToVBString(myVer.szCSDVersion)
  251.         If Len(s$) > 0 Then Print s$
  252.         GetSystemInfo mySys
  253.         Print " Page size is " & mySys.dwPageSize; " bytes"
  254.         Print " Lowest memory address: &H" & Hex$(mySys.lpMinimumApplicationAddress)
  255.         Print " Highest memory address: &H" & Hex$(mySys.lpMaximumApplicationAddress)
  256.         Print " Number of processors: "; mySys.dwNumberOfProcessors
  257.         Print " Processor: ";
  258.         Select Case mySys.dwProcessorType
  259.             Case PROCESSOR_INTEL_386
  260.                     Print "Intel 386"
  261.             Case PROCESSOR_INTEL_486
  262.                     Print "Intel 486"
  263.             Case PROCESSOR_INTEL_PENTIUM
  264.                     Print "Intel Pentium"
  265.             Case PROCESSOR_MIPS_R4000
  266.                     Print "MIPS R4000"
  267.             Case PROCESSOR_ALPHA_21064
  268.                     Print "Alpha 21064"
  269.         End Select
  270.         
  271.     #Else
  272.         flagnum& = GetWinFlags&()
  273.         vernum& = GetVersion&()
  274.         verword% = CInt(vernum& / &H10000)
  275.             
  276.         Print " Running MS-DOS version "; verword% / 256; "."; verword% And &HFF
  277.         verword% = CInt(vernum& And &HFFFF&)
  278.         Print " Running Windows version "; verword% And &HFF; "."; CInt(verword% / 256)
  279.         
  280.         If flagnum& And WF_80x87 Then Print " 80x87 coprocessor present"
  281.         If flagnum& And WF_CPU086 Then Print " 8086 present"
  282.         If flagnum& And WF_CPU186 Then Print " 80186 present"
  283.         If flagnum& And WF_CPU286 Then Print " 80286 present"
  284.         If flagnum& And WF_CPU386 Then Print " 80386 present"
  285.         If flagnum& And WF_CPU486 Then Print " 80486 present"
  286.         If flagnum& And WF_ENHANCED Then Print " Windows 386-enhanced mode"
  287.     #End If
  288. End Sub
  289. Private Sub MenuFreeSpace_Click()
  290.     ShowColors 0
  291.     SysInfo.Cls
  292.     Print
  293.     ' These functions are obsolete under Win32
  294.     #If Win16 Then
  295.         Print GetFreeSpace&(0); "Bytes free in Global Heap"
  296.         Print GetFreeSystemResources%(GFSR_SYSTEMRESOURCES); "% free system resources."
  297.         Print GetFreeSystemResources%(GFSR_GDIRESOURCES); "% free GDI resources."
  298.         Print GetFreeSystemResources%(GFSR_USERRESOURCES); "% free USER resources."
  299.     #Else
  300.         Print " Refer Chapter 15 examples for information"
  301.         Print " on retrieving memory statistics for Win32"
  302.     #End If
  303. End Sub
  304. ' Display keyboard related iformation.
  305. Private Sub MenuKeyboard_Click()
  306.     Dim cp As CPINFO
  307.     Dim cpAnsi&, cpOEM&
  308.     Dim dl&
  309.     Dim layoutname As String * KL_NAMELENGTH
  310.     Print
  311.     SysInfo.Cls
  312.     #If Win32 Then
  313.         cpAnsi = GetACP()
  314.         cpOEM = GetOEMCP()
  315.         Print " ANSI code page: " & cpAnsi
  316.         dl& = GetCPInfo(cpAnsi, cp)
  317.         Print " Max byte length is " & cp.MaxCharSize
  318.         dl& = GetCPInfo(cpOEM, cp)
  319.         Print " OEM code page: " & cpOEM
  320.         Print " Max byte length is " & cp.MaxCharSize
  321.         dl& = GetKeyboardLayoutName(layoutname)
  322.         Print " Keyboard layout: " & LPSTRToVBString(layoutname)
  323.         dl& = GetKeyboardType(0)
  324.         Select Case dl&
  325.             Case 0
  326.                 Print " PC 83 key keyboard"
  327.             Case 3
  328.                 Print " AT 84 key keyboard"
  329.             Case 4
  330.                 Print " Enhanced 101 or 102 key keyboard"
  331.             Case Else
  332.                 Print " Special keyboard"
  333.         End Select
  334.         dl& = GetKeyboardType(2)
  335.         Print " Keyboard has " & dl & " function keys."
  336.     #Else
  337.         Print " Not implemented under Win16 at this time"
  338.     #End If
  339. End Sub
  340. ' Locale specific information
  341. Private Sub MenuLocale_Click()
  342.     Dim buffer As String * 100
  343.     Dim dl&
  344.     SysInfo.Cls
  345.     #If Win32 Then
  346.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SENGLANGUAGE, buffer, 99)
  347.         Print " Language: " & LPSTRToVBString(buffer)
  348.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SENGCOUNTRY, buffer, 99)
  349.         Print " Country: " & LPSTRToVBString(buffer)
  350.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, buffer, 99)
  351.         Print " Currency Symbol: " & LPSTRToVBString(buffer)
  352.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLONGDATE, buffer, 99)
  353.         Print " Long date format: " & LPSTRToVBString(buffer)
  354.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDAYNAME3, buffer, 99)
  355.         Print " Long name for Wednesday: " & LPSTRToVBString(buffer)
  356.         dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SABBREVDAYNAME3, buffer, 99)
  357.         Print " Abbreviation for Wednesday: " & LPSTRToVBString(buffer)
  358.     #Else
  359.         Print " Not implemented under Win16"
  360.     #End If
  361. End Sub
  362. '   The following is a selection of the system metrics
  363. '   that can be determined - see the reference section
  364. '   under the GetSystemMetrics function for more.
  365. Private Sub MenuMetrics_Click()
  366.     ShowColors 0
  367.     SysInfo.Cls
  368.     Print
  369.     Print " Non sizeable border width,height = "; GetSystemMetrics(SM_CXBORDER); ","; GetSystemMetrics(SM_CYBORDER)
  370.     Print " Caption height = "; GetSystemMetrics(SM_CYCAPTION)
  371.     Print " Cursor width,height = "; GetSystemMetrics(SM_CXCURSOR); ","; GetSystemMetrics(SM_CYCURSOR)
  372.     Print " Icon width,height = "; GetSystemMetrics(SM_CXICON); ","; GetSystemMetrics(SM_CYICON)
  373.     Print " Width,Height of client area of full screen window = "; GetSystemMetrics(SM_CXFULLSCREEN); ","; GetSystemMetrics(SM_CYFULLSCREEN)
  374.     Print " Menu bar height = "; GetSystemMetrics(SM_CYMENU)
  375.     Print " Minimum width,height of window = "; GetSystemMetrics(SM_CXMIN); ","; GetSystemMetrics(SM_CYMIN)
  376.     ' Here is a sample Windows 95 specific metric
  377.     #If Win32 Then
  378.         If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  379.             Print " Small Icon width,height = "; GetSystemMetrics(SM_CXSMICON); ","; GetSystemMetrics(SM_CYSMICON)
  380.         End If
  381.     #End If
  382. End Sub
  383. '   A few examples of the many system parameters that can
  384. '   be set and retreived using the SystemParametersInfo
  385. '   function
  386. Private Sub MenuParameters_Click()
  387.     Dim dummy&
  388.     SysInfo.Cls
  389.     #If Win32 Then
  390.         Dim intval&
  391.     #Else
  392.         Dim intval%
  393.     #End If
  394.     ShowColors 0
  395.     SysInfo.Cls
  396.     Print
  397.     dummy = SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, intval, 0)
  398.     Print " Keyboard Delay is "; intval
  399.     dummy = SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, intval, 0)
  400.     Print " Keyboard Speed is "; intval
  401.     dummy = SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, intval, 0)
  402.     If intval Then Print " Screen Saver is Active"
  403.     dummy = SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, intval, 0)
  404.     Print " Screen Save Delay is "; intval; " seconds"
  405. End Sub
  406. Private Sub MenuTimes_Click()
  407.     Dim curtime&
  408.     ShowColors 0
  409.     SysInfo.Cls
  410.     Print
  411.     Print " Caret blinks every "; GetCaretBlinkTime(); " ms"
  412.     #If Win16 Then
  413.         curtime& = GetCurrentTime()
  414.     #Else
  415.         curtime& = GetTickCount()
  416.     #End If
  417.     Print " It's been "; curtime&; " ms since Windows was started"
  418.     Print " The last Windows message was processed at "; GetMessageTime&(); " ms"
  419.     Print " Two clicks within "; GetDoubleClickTime(); " ms of each other are a double click"
  420.     #If Win16 Then
  421.         Print " Timer resolution is "; GetTimerResolution&(); "microseconds per tick"
  422.     #End If
  423. End Sub
  424. '   Use to show or hide the colors listbox and label
  425. Private Sub ShowColors(bflag%)
  426.     If bflag% Then  ' Show them
  427.         ListColor.Visible = -1
  428.         LabelColor.Visible = -1
  429.     Else    ' Hide them
  430.         ListColor.Visible = 0
  431.         LabelColor.Visible = 0
  432.     End If
  433. End Sub
  434. '   This shows how a custom caret can be used in a text
  435. '   box. Note that an arbitrary bitmap could be used as
  436. '   well (refer to the function reference for the
  437. '   CreateCaret function - also chapter 8 for information
  438. '   on bitmaps).
  439. '   Also note that VB may change the caret back to the
  440. '   default without notice (like when a menu or other
  441. '   application is selected)
  442. Private Sub Text1_GotFocus()
  443.     ' Save the original blink time - it will be used to
  444.     ' restore the original value during the LostFocus event
  445.     OriginalCaretBlinkTime% = GetCaretBlinkTime()
  446.     ' Creat a different shaped caret
  447.     CreateCaret Text1.hwnd, 0, 10, 15
  448.     ' Creating the new caret caused the prior one (the
  449.     ' default for the edit control) to be destroyed and
  450.     ' thus hidden. So we must show the new caret.
  451.     ShowCaret Text1.hwnd
  452.     ' And change to an obnoxiously fast blink time - just
  453.     ' to show how it's done.
  454.     SetCaretBlinkTime 150
  455. End Sub
  456. '   Be sure to set the caret blink time back to its
  457. '   original value when the control loses the focus
  458. Private Sub Text1_LostFocus()
  459.     SetCaretBlinkTime OriginalCaretBlinkTime%
  460. End Sub
  461. '   Update a label field to show the current state
  462. '   of the capslock, numlock and scroll lock keys
  463. Private Sub Timer1_Timer()
  464.     Dim numlock%, scrolllock%, capslock%
  465.     Dim keyarray(256) As Byte
  466.     Dim dl&
  467.     Dim res$
  468.     capslock% = GetKeyState%(VK_CAPITAL)
  469.     numlock% = GetKeyState%(VK_NUMLOCK)
  470.         
  471.     ' Here's another way to do it - take a snapshot
  472.     ' of the entire keyboard
  473.     dl& = GetKeyboardState(keyarray(0))
  474.     scrolllock% = keyarray(VK_SCROLL) ' GetKeyState%(VK_SCROLL)
  475.     ' The low bit indicates the state of the toggle
  476.     If capslock% And 1 Then res$ = res$ + "CAPS  "
  477.     If numlock% And 1 Then res$ = res$ + "NUM  "
  478.     If scrolllock% And 1 Then res$ = res$ + "SCROLL"
  479.     LabelKeyState.Caption = res$
  480. End Sub
  481.