Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub Form_Load()
With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "Processor"
.ColumnHeaders.Add , , "BPS"
.ColumnHeaders.Add , , "Hres"
.ColumnHeaders.Add , , "Vres"
.ColumnHeaders.Add , , "Freq"
.ColumnHeaders.Add , , "Colours"
.ColumnHeaders.Add , , "rf min"
.ColumnHeaders.Add , , "rf max"
.ColumnHeaders.Add , , "Vmode"
.ColumnHeaders.Add , , "Mem"
.View = lvwReport
.Sorted = False
End With
Command1.Caption = "Video Controller Info"
End Sub
Private Sub Command1_Click()
ListView1.ListItems.Clear
Call wmiVideoControllerInfo
Call lvAutosizeControl(ListView1)
End Sub
Private Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
'Size each column based on the maximum of
'wither the ColumnHeader text width, or,
'if the items below it are wider, the
'widest list item in the column
lv.Visible = False
For col2adjust = 0 To lv.ColumnHeaders.Count - 1
Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER)
Next
lv.Visible = True
End Sub
Private Sub wmiVideoControllerInfo()
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim itmx As ListItem
Dim msg As String
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_VideoController")
On Local Error Resume Next
For Each obj In wmiObjSet
Set itmx = ListView1.ListItems.Add(, , obj.VideoProcessor)
itmx.SubItems(1) = obj.CurrentBitsPerPixel
itmx.SubItems(2) = obj.CurrentHorizontalResolution
itmx.SubItems(3) = obj.CurrentVerticalResolution
itmx.SubItems(4) = obj.CurrentRefreshRate
itmx.SubItems(5) = obj.CurrentNumberOfColors
itmx.SubItems(6) = obj.MinRefreshRate
itmx.SubItems(7) = obj.MaxRefreshRate
Select Case obj.CurrentScanMode
Case 1: msg = "other"
Case 2: msg = "unknwn"
Case 3: msg = "intrlcd"
Case 4: msg = "nintrlcd"
End Select
itmx.SubItems(8) = msg
Select Case obj.VideoMemoryType
Case 1: msg = "other"
Case 2: msg = "unknown"
Case 3: msg = "VRAM"
Case 4: msg = "DRAM"
Case 5: msg = "SRAM"
Case 6: msg = "WRAM"
Case 7: msg = "EDO RAM"
Case 8: msg = "Burst Synchronous DRAM"
Case 9: msg = "Pipelined Burst SRAM"
Case 10: msg = "CDRAM"
Case 11: msg = "3DRAM"
Case 12: msg = "SDRAM"
Case 13: msg = "SGRAM"
End Select
itmx.SubItems(9) = msg
Next
End Sub |
