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
