View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Michel Pierron Michel Pierron is offline
external usenet poster
 
Posts: 214
Default Extracting Colors from Image loaded in userform

Hi emsfeld,
Unfortunately, it is not possible to do that with a control image because
the function GetDC need a handle. You can place the image on the userform
and find each pixel color as follows:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd 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 Sub UserForm_Initialize()
Me.PictureAlignment = 0
End Sub

Sub CommandButton1_Click()
Dim FileToOpen
FileToOpen = Application.GetOpenFilename("All Files, *.*")
TextBox1.Text = FileToOpen
Me.Picture = LoadPicture(FileToOpen)
End Sub

Private Sub CommandButton2_Click()
Dim x1&, y1&, m&, p&, hDC&, wPix&, hPix&
Me.Repaint
ActiveSheet.UsedRange.ClearContents
For x1 = 1 To 4
Cells(1, x1) = Choose(x1, "Pixel", "Y", "X", "Color")
Next
Application.Cursor = xlWait
Application.ScreenUpdating = False
wPix = HiMetricToPoint(Me.Picture.Width)
hPix = HiMetricToPoint(Me.Picture.Height)
hDC = GetDC(FindWindow(vbNullString, Me.Caption))
m = 1
For y1 = 0 To hPix - 1
For x1 = 0 To wPix - 1
m = m + 1: p = p + 1
Cells(m, 1) = p
Cells(m, 2) = y1
Cells(m, 3) = x1
Cells(m, 4) = "&H" & Hex(GetPixel(hDC, x1 * 4 / 3, y1 * 4 / 3))
Next
Next
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

Private Function HiMetricToPoint&(iVal&)
HiMetricToPoint = CLng(iVal * 72 / 2540)
End Function

Regards,
MP

"emsfeld " a écrit dans le message
de ...
Thx Michel,

but thats not quite what i need. What i have done so far is:

Let the client browse for an image and display it in an imagebox:

Sub CommandButton1_Click()

Dim FileToOpen
FileToOpen = Application.GetOpenFilename("All Files, *.*")

TextBox1.Text = FileToOpen
Image1.Picture = LoadPicture(FileToOpen)

End Sub

From there I would like to have the pixels extracted and best stored in
a two dimensional array, so that i can reprint the picture in another
imagebox. I am aware of that I can do that by simply loading the
picture into another imagebox, but thats not what i need. I really need
the pixels and their colorinfo stored in an array....that would be
great!!

Got an idea?

Regards

emsfeld


---
Message posted from http://www.ExcelForum.com/