Re: ColorIndex of the current application

Actually, just realised that this not really solve the OP request. And may
not always work as expected.
I test some more, but maybe back to the drawing board...

NickHK

"NickHK" <TungCheWah@xxxxxxxxxxx> wrote in message
news:%23gc7sk1pHHA.4632@xxxxxxxxxxxxxxxxxxxxxxx
Peter,
After playing unsuccessfully with the SendMessage approach (seem to be
getting different return value compared to Spy++ on the initial call),
decided on the cheat method.
Whilst still limited to being "in view", it more straight forward that
messing with DCs etc. Quick enough so it's not noticable.

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI) _
As Long

Private Declare Function SetCursorPos Lib "user32" ( _
ByVal X As Long, _
ByVal Y As Long) _
As Long

Private Declare Sub mouse_event Lib "user32" ( _
ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)


Private Const MOUSEEVENTF_ABSOLUTE As Long = &H8000
Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Private Const MOUSEEVENTF_LEFTUP As Long = &H4

Private Const CTR_OFFSET_X As Long = 5
Private Const CTR_OFFSET_Y As Long = 5

Private Sub CommandButton1_Click()
Dim ctr As CommandBarPopup
Dim X As Long, Y As Long
Dim OldCursorPos As POINTAPI
Dim RetVal As Long

Set ctr = Application.CommandBars.FindControl(ID:=1691)

X = ctr.Left + CTR_OFFSET_X
Y = ctr.Top + CTR_OFFSET_Y

RetVal = GetCursorPos(OldCursorPos)

SetCursorPos X, Y

mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0

SetCursorPos OldCursorPos.X, OldCursorPos.Y

End Sub

NickHK

"Peter T" <peter_t@discussions> wrote in message
news:%235mLFEHpHHA.1148@xxxxxxxxxxxxxxxxxxxxxxx
Hi Nick,

That was a nice giant reflection of my toolbar, cool !

Actually shouldn't the coordinates be relative to the top-left of the
containing Window, rather than the screen ?

Indeed. But which window!
When I tried WindowFromPoint it returned either the XLMAIN window or the
MsoCommandBar Window depending on whether or not the commandbar is
currently
docked/not docked, and inconsistently depending on what it had been,
just
for added confusion.

With a bit of fiddling around I managed to verify the window in question
and
then the relevant offsets from top-left corner of the appropriate
window.

Having done all that and working with the correct window and
coordinates,
to
my surprise I still find the fill control needs to be 'in view' to get
its
pixels. I don't understand that at all!

So unless I'm missing something obvious it seems one might just as well
work
with the desktop window and the coordinates returned by the control's
position (absolute desktop x/y pixels). And not much use unless can
guarantee the fill control is not covered!

Just a small thing -

ReleaseDC 0, dc

I guess a typo but the 'O' coerces to the desktop window (which is what
I
was using), but should be the dc returned with GetDC, so in your example
ReleaseDC RetVal, dc

Regards,
Peter T


"NickHK" <TungCheWah@xxxxxxxxxxx> wrote in message
news:uaZY3wCpHHA.4192@xxxxxxxxxxxxxxxxxxxxxxx
Peter,
I tried with:
dc = GetDC(WindowFromPoint(x, y))
clr = GetPixel(dc, x, y)
but I too always get a return value of -1.

I need to read up more on this GDI stuff...
Actually shouldn't the coordinates be relative to the top-left of the
containing Window, rather than the screen ?
This seems to work, so it maybe a case of correcting the x,y value to
pass
to GetPixel.
using FindWindow/FindWindowEx instead of WindowFromPoint will then
mean
the
command bar can be hidden behind anything.

Private Declare Function GetDC Lib "user32" ( _
ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function GetPixel Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As
Long,
ByVal yPoint As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As
Long,
lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Sub CommandButton1_Click()
Dim ctr As CommandBarPopup
Dim x As Long, y As Long
Dim RetVal As Long
Dim WndRect As RECT
Dim i As Long, j As Long
Dim dc As Long
Dim Wid As Long

With Cells
.ClearFormats
.ColumnWidth = 2.1
.RowHeight = 12
End With

Set ctr = Application.CommandBars.FindControl(ID:=1691)

x = ctr.Left
y = ctr.Top

RetVal = WindowFromPoint(x, y)

GetWindowRect RetVal, WndRect
dc = GetDC(RetVal)

With WndRect
Wid = .Bottom - .Top
'x,y values are a little, but for demonstration....
For i = 1 To .Right - .Left
For j = 1 To Wid
Worksheets(3).Range("A1").Offset(i - 1, Wid -
j).Interior.Color
= GetPixel(dc, i, j)
Next
Next

End With

ReleaseDC 0, dc

End Sub

NickHK




.

Quantcast