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