evaluate screen configuration

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