View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
NickHK NickHK is offline
external usenet poster
 
Posts: 4,391
Default ColorIndex of the current application

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

"Peter T" <peter_t@discussions wrote in message
...
Hi Nick,

I'll leave the SendMessage idea for you but I had a quick go with

GetPixel,
with mixed results.

As toolbar controls return cooridantes in pixels relative to top-left of
screen, can get the pixel directly from the desktop. This makes it very
simple but of course will only work if the fill control is visible on the
screen -

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 GetDeviceCaps Lib "gdi32" ( _
' ByVal hdc As Long, ByVal nIndex As Long) As Long
'Private Const POINTS_PER_INCH As Long = 72

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClasssName As String, _
ByVal lpWindowName As String) As Long

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


Function GetFillColorPixel() As Long
'' for this to work the Fill Color control MUST be visible on
'' the screen, not say hidden by the VBE or some dialog or window
Dim x As Long, y As Long, clr As Long
Dim dc As Long
Dim ctr As CommandBarPopup

Set ctr = Application.CommandBars.FindControl(ID:=1691)
'Debug.Print ctr.Caption ' &Fill Color

'left & right returns pixel coordinates from top left of screen
' add an offsets 8 & 16 to the coloured bar
x = ctr.Left + 8
y = ctr.Top + 16

dc = GetDC(0)
clr = GetPixel(dc, x, y)
ReleaseDC 0, dc

GetFillColorPixel = clr

End Function

Sub test3()
Dim clr As Long
clr = GetFillColorPixel
ActiveCell.Interior.Color = clr
MsgBox clr & vbCr & ActiveCell.Interior.ColorIndex
End Sub

The above seems to work fine for me, subject the control being in view.
What I originally had in mind was to get the pixel from its container
toolbar window, which if it works, does not require the control to be
visible on the screen.

Set ctr = Application.CommandBars.FindControl(ID:=1691)
sTlbrName = ctr.Parent.Name
Set cbr = Application.CommandBars(sTlbrName) ' typically "Formatting"
cbr.Visible = True ' required to get it's hwn
hwn = FindWindowA("MsoCommandbar", sTlbrName
dc = getDC(hwn)

Apart from needing the 'cbr.Visible' the toolbar needs to be not docked to
find its window handle, at least for me. Anyway did all that but GetPixel

is
returning -1 for some reason.

Perhaps your SendMessage will be more reliable !

Regards,
Peter T

"NickHK" wrote in message
...
Peter ,
I never tried the SendMessage route, so can't say really.

I thought about the GetPixel way, but considered the SendMessage less
involved - if it works.

If I have time over the weekend I may have a look at both.

NickHK

-------------------- CUT --------------------