Hi Richard,
FWIW I believe Excel has fantastic under-used capabilities for doing a lot
of things with colour, albeit with a hefty nudge. However I don't think your
objective is one of them, apart from difficulties there are conceptual
problems with some of what you outlined, eg -
1. In XL2003 and earlier the palette is limited to 56 colours, ie you cannot
format more than 56 colours into cells (though about 1500 unique 'simulated
colours can be displayed in cell fill's with use of patterns with help of a
colour-match algorithm).
However Shapes, such as rectangles, can be formatted with any RGB colour.
Shapes can be sized very small and do not need to be constrained to cell
dimensions. 256*256 = 64k shapes will need very good resources to update
processed colours and reformat shape fills.
2. Pixel's RGB attributes comprise three bytes each of 0-255 (well
obviously), they compound to a single Long value 0-16777215. Though you can
put this value in a cell it will need to be split into its components before
you can process the pixel colour.
I don't want to put you off so here's a little starter to read your jpeg
colours into an array and do some simple colour processing. Actually I only
just knocked this up and surprised to get it working in VBA, much easier
with VB and with significantly more capabilities too.
Put an Image control on the Userform
Select Picture in properties and browse to your an image file, eg your jpeg
Ensure AutoSize is set to True and BorderStyle to 0-None
Now assign the same picture file to the Userform's picture and set
PictureSizeMode 0
The Image control is only to get the picture's pixel x/y size, there are
other ways but this simple kludge seems to work. With VBA the picture needs
to be on the form for the API to read it directly into an array (unless
someone knows another way?)
(The picture could be loaded to the Image control and Userform from file at
runtime, but keep it simple for testing)
Run the form, click on it to put an 'Inverse' copy of the image on the form.
'''''''''Userform code
Option Explicit
Private Const BI_RGB = 0
Private Const DIB_RGB_COLORS = 0
Private Type BitmapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BitmapInfo
bmiHeader As BitmapInfoHeader
End Type
Private bmapinfo As BitmapInfo
Private Declare Function SetDIBitsToDevice _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal dx As Long, ByVal dy As Long, _
ByVal SrcX As Long, ByVal SrcY As Long, _
ByVal Scan As Long, ByVal NumScans As Long, _
bits As Any, BitsInfo As BitmapInfo, _
ByVal wUsage As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" _
(ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" _
(ByVal hdc As Long, ByVal nStretchMode As Long) As Long
'Private Declare Function GetStretchBltMode Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" _
(ByVal hdc As Long, ByVal hBitmap As Long, _
ByVal nStartScan As Long, ByVal nNumScans As Long, _
lpBits As Any, lpBI As BitmapInfo, _
ByVal wUsage As Long) As Long
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 Declare Function FindWindowA Lib "user32" _
(ByVal lpClasssName As String, _
ByVal lpWindowName As String) As Long
Dim arrPixels() As Long
Private Sub UserForm_Click()
Test
End Sub
Sub Test()
Dim hdc As Long
Dim hwnd As Long
Dim dx As Long, dy As Long, lRet&
Dim lt As Long, tp As Long
Dim r As Long, c As Long
' assume typical screen res of 96 pixels / 72 points
' (normally best to confirm with API)
dx = Me.Image1.Width * 96 / 72
dy = Me.Image1.Height * 96 / 72
With bmapinfo.bmiHeader
.biSize = 40
.biWidth = dx
.biHeight = dy
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
ReDim arrPixels(1 To dx, 1 To dy)
hwnd = FindWindowA("ThunderDFrame", UserForm1.Caption)
hdc = GetDC(hwnd)
lRet = GetDIBits(hdc, Me.Picture, 0, dy, _
arrPixels(1, 1), bmapinfo, DIB_RGB_COLORS)
' not necessary but maybe get rid of the original picture
' Set Me.Picture = Nothing
' Me.Repaint
For c = LBound(arrPixels, 2) To UBound(arrPixels, 2)
'process the colours
For r = LBound(arrPixels) To UBound(arrPixels)
arrPixels(r, c) = FlipBGR(arrPixels(r, c))
Next
'btw, arrPixels has been assigned with pixel colours in order
'bottom row up, left to right
Next
' put the processed colour array back on the form
lt = 0: tp = 0 ' change to reposition
lRet = SetDIBitsToDevice(hdc, lt, tp, dx, dy, _
0, 0, 0, dy, _
arrPixels(1, 1), bmapinfo, DIB_RGB_COLORS)
ReleaseDC hwnd, hdc
End Sub
Function FlipBGR(nClr As Long) As Long
Dim b&, r&, g&
' note GetDIBits returns long colours in the array in order BGR, not RGB
b = nClr And 255&
g = (nClr And (255& * 256&)) / 256&
r = (nClr And (255& * 256& * 256&)) / 65536
' make inverse or -ve colour
b = 255 - b
g = 255 - g
r = 255 - r
FlipBGR = b + g * 256 + r * 256 * 256
End Function
If this doesn't work debug report back the following -
hwnd, hdc & both instances of lRet. All should return non-zero
If you are relatively new to VBA you have quite a learning curve ahead, good
luck!
Regards,
Peter T
http://www.xcelfiles.com/ImageToXL.html#anchor_82
by
with
seems