Forum Discussion

Manfred_F's avatar
Manfred_F
Regular Contributor
9 years ago

evaluate screen configuration

I want to check the Screen Resolution of  Desktop test Clients.

 

My virtual machine Clients do have a single Screen configuration, whereas Desktop pcs do have two or mors Screens in various layouts (side-by-side/on top).

 

So, the Sys.Desktop.Height/Width does not help.

How can I get there?

  • HKosova's avatar
    HKosova
    9 years ago

    Hi Manfred,

     

    Check the Remarks in Sys.Desktop.Height, specifically the approaches to get single monitor resolution. There's an alternative example that uses the .NET Screen class.

  • Manfred_F's avatar
    Manfred_F
    Regular Contributor

    Ok, found a solution:

     

    Option Explicit

    ' Betriebssystem-Spezifika

    Private Const mcModul = "OS." 

     

    ' ***************** Bildschhirm ******************************************* 

    Function ScreenResolution()

    ' Auflösung Hauptbildschirm

    Const cRoutine = "ScreenResolution"

    Dim Ergebnis

    Dim strComputer, objWMIService, colItems, objItem 

    strComputer = "."

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_DesktopMonitor",,48)

     

    Set Ergebnis = PointAPI_New

    For Each objItem in colItems

    Ergebnis.y = objItem.ScreenHeight

    Ergebnis.x = objItem.ScreenWidth

    Next

     

    Set ScreenResolution = Ergebnis

    End Function 

     

    Function ScreenCount()

    ' Anzahl Bildschirme

    Const cRoutine = "ScreenCount"

    Dim Ergebnis

    Dim strComputer, objWMIService, colItems, objItem 

    strComputer = "Localhost"

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\wmi")

    Set colItems = objWMIService.ExecQuery ("SELECT * FROM WMIMonitorID")

    Ergebnis = colItems.count

     

    ScreenCount = Ergebnis

    End Function 

     

    ' ***************** Bildschhirm ******************************************* 

     

     

    ' ***************** Farben ******************************************* 

     

    Function BackgroundColorAro( _

    myWrp _

    )

    ' Hintergrundfarbe ermitteln als RGB

    Const cRoutine = "BackgroundColorAro"

    Dim ErgebnisAro, TestAro

    Dim myCtrl

    Dim Ix, IxStart, Found

    Set myCtrl = PVA_0.OLS.ControlGet(myWrp)

    ' starte bei Pixel 2 wegen Focus-Rand

    IxStart = 2: Found = False

    Set ErgebnisAro = RgbAro(myWrp, IxStart, IxStart)

    ' maximal bis zur Mitte

    For Ix = IxStart + 1 to myCtrl.Height \ 2

    Set TestAro = RgbAro(myWrp, Ix, Ix)

    If ErgebnisAro.IsEqual(TestAro) Then

    Found = True

    Exit For

    Else

    Set ErgebnisAro = TestAro

    Set TestAro = Nothing

    End If

    Next

    If Not Found Then ErgebnisAro.Clear

    Set BackgroundColorAro = ErgebnisAro

    End Function 

     

     

     

    Private Function RgbAro(myWrp, nvXcoord, nvYcoord)

    '**************************************************?****************************************

    '* FUNCTION: Return_RGB(myCtrl As Object, nvXcoord As Long, nvYcoord As Long)

    '*

    '* PURPOSE: To return a RGB set of values that is the color of the X, Y coordinate of the Window Object

    '*

    '* EXAMPLE: Return_RGB(Sys.Process("MyProcess").VCLObject("frm?Main"), 10, 10) Normal Window object

    '*

    '* The example returns the RGB color of the pixel at the 10,10 coordinate of the Sys.Process("MyProcess").VCLObject("frmMain") object.

    '* The return value is a string that would look like >>> 255,26,0

    '* The '255' is the Red value. 1st position

    '* The '26' is the Green value. 2nd position

    '* The '0' is the Blue value. 3rd position

    '*

    '* Last Update: 02-27-2014 - TEB - Converted to TestComplete script.

    '* 05-01-2009 - TEB - Created

    '*************************************************?*****************************************

    Const cRoutine = "RgbAro"

    Dim tPOS, dcWindow, nvRGB, svTemp

    Dim lRed, lGreen, lBlue

    Dim ResultAro, myCtrl

    Set ResultAro = PVA_0.ArrayClass.CNew

    Set myCtrl = PVA_0.OLS.ControlGet(myWrp)

     

    Set tPOS = PointAPI_New 

    If myCtrl.Exists = True Then 

    ' Move to the X, Y coordinate

    PVA_0.OLS.MouseAction myWrp, "HoverMouse", nvXcoord, nvYcoord, mcModul & cRoutine 

    ' Get the dc of a specific hwnd - the desktop

    dcWindow = mLibAccess.gWin32Api().GetWindowDC(0) 

    ' Get the cursor position relative to the screen.

    tPOS.y = myCtrl.ScreenTop + nvYcoord

    tPOS.x = myCtrl.ScreenLeft + nvXcoord 

    ' Use GetPixel() with the appropriate DC and location

    nvRGB = mLibAccess.gWin32Api().GetPixel(dcWindow, tPOS.x, tPOS.y)

     

    ' HEX to string

    svTemp = Right("000000" & Hex(nvRGB), 6) 

    ' Parse out the individual values

    lRed = CLng("&H" & Right(svTemp, 2))

    lGreen = CLng("&H" & Mid(svTemp, 3, 2))

    lBlue = CLng("&H" & Left(svTemp, 2)) 

    ResultAro.Add lRed

    ResultAro.Add lGreen

    ResultAro.Add lBlue

    'Return the RGB values here

    Else

    Log.Warning "NO COLOR FOUND - Object did not exist", _

    "Window to check= " & myCtrl.Name & vbCr & myCtrl.Fullname & vbCr _

    & myCtrl.Exists & vbCr & mcModul & cRoutine

    End If

    set RgbAro = ResultAro

    End Function

     

    ' ***************** Farben ******************************************* 

     

    Class classPOINTAPI

    ' Used in Function Return_RGB

    Public x

    Public y

    End Class 

     

    Function PointAPI_New

    Set PointAPI_New = New classPOINTAPI

    PointAPI_New.x = 0

    PointAPI_New.y = 0

    End Function 

     

      • HKosova's avatar
        HKosova
        SmartBear Alumni (Retired)

        Hi Manfred,

         

        Check the Remarks in Sys.Desktop.Height, specifically the approaches to get single monitor resolution. There's an alternative example that uses the .NET Screen class.