Extracting Colors from Image loaded in userform

  • Thread starter Thread starter emsfeld
  • Start date Start date
E

emsfeld

Hi Guys,

I am new to programming in Excel VBA, so I am quit
unexperienced....Anyways, I would like to extract the colors of pixel
of an image that'd been loaded into an userform. I am kinda stuck o
this and got no clue how to do that. I have been searching the web o
this for three days, but couldnt find anything....

Help would be appreciated a lot

emsfel
 
Hi,

I cant image a way excel could do this with VBA alone, maybe with an
API call, but i wouldn't know where to start, sorry

Ross
 
Hi Emsfeld,
In the UserForm Module:
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 hDC As Long

Private Sub UserForm_Activate()
hDC = GetDC(FindWindow(vbNullString, Me.Caption))
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer _
, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.Caption = "X= " & X & " Y= " & Y
Dim Color As Long
Color = GetPixel(hDC, X * 4 / 3, Y * 4 / 3)
Label2.Caption = "&H" & Hex(Color)
Label3.BackColor = Label2.Caption
End Sub

Regards,
MP
 
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 i
a two dimensional array, so that i can reprint the picture in anothe
imagebox. I am aware of that I can do that by simply loading th
picture into another imagebox, but thats not what i need. I really nee
the pixels and their colorinfo stored in an array....that would b
great!!

Got an idea?

Regards

emsfel
 
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
 
Back
Top