Hola Raul de ser asi lo mas conveniente puede ser combinar la función de hacerlo con métodos gráficos como lo hiciste vos, pero sobre un lienzo (GdipCreateBitmapFromScan0 + GdipGetImageGraphicsContext) y luego tratarlo como una imagen, puede que se mas optimo ademas no dependerias de la imagen, igualmente te paso una forma de como colorear una imagen tal como decías ya que puede útil a alguien mas.
utilizando GdipBitmapLockBits se puede acceder al array de bits de la imagen y bueno se puden hacer ciento de cosas.
Option Explicit
Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByVal PixelOffsetMode As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipDrawImageRectI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mImage As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
Private Declare Function GdipBitmapUnlockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mLockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapLockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mRect As RECTL, ByVal mFlags As ImageLockMode, ByVal mPixelFormat As Long, ByRef mLockedBitmapData As BitmapData) As Long
Private Declare Function GdipGetImageHeight Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mHeight As Long) As Long
Private Declare Function GdipGetImageWidth Lib "GdiPlus.dll" (ByVal mImage As Long, ByRef mWidth As Long) As Long
Private Type BitmapData
Width As Long
Height As Long
Stride As Long
PixelFormat As Long
Scan0Ptr As Long
ReservedPtr As Long
End Type
Private Type RECTL
Left As Long
Top As Long
Width As Long
Height As Long
End Type
Private Type RGBQUAD
Blue As Byte
Green As Byte
Red As Byte
Alpha As Byte
End Type
Private Enum ImageLockMode
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Const GdiPlusVersion As Long = 1&
Private Const PixelOffsetModeHalf As Long = 4&
Private Const PixelFormat32bppPARGB As Long = &HE200B
Dim GdipToken As Long
Dim m_hImage As Long
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = GdiPlusVersion
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
Private Sub TerminateGDI()
Call GdiplusShutdown(GdipToken)
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.AutoRedraw = True
Me.BackColor = vbWhite
Call InitGDI
Call GdipLoadImageFromFile(StrPtr("C:\Users\Windows\Desktop\Light.png"), m_hImage) '<--cambiar el path de la imagen
BlendToColor m_hImage, vbRed, 100
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Me.BackColor = QBColor(14 * Rnd() + 1)
BlendToColor m_hImage, QBColor(14 * Rnd()), 100
Call Form_Resize
End Sub
Private Sub Form_Resize()
Dim hGraphics As Long
Me.Cls
If GdipCreateFromHDC(Me.hdc, hGraphics) = 0 Then
Call GdipSetPixelOffsetMode(hGraphics, PixelOffsetModeHalf)
Call GdipDrawImageRectI(hGraphics, m_hImage, 0, 0, Me.ScaleWidth, Me.ScaleHeight)
GdipDeleteGraphics hGraphics
End If
DoEvents
End Sub
Private Sub Form_Terminate()
Call GdipDisposeImage(m_hImage)
Call TerminateGDI
End Sub
Public Function BlendToColor(ByVal hImage As Long, ByVal BlendColor As Long, Optional ByVal BlendOpacity As Long = 33) As Boolean
Dim hStatus As Long
Dim bmpData As BitmapData
Dim Rec As RECTL
Dim Data() As RGBQUAD
Dim X As Long, Y As Long
Dim blendR As Long, blendB As Long, blendG As Long
Dim srcPct As Long
If hImage = 0& Then Exit Function
If BlendOpacity < 1 Then ' background color won't be included in calcs; don't waste time
BlendToColor = True
Exit Function
End If
' validate BlendOpacity doesn't exceed max value
If BlendOpacity > 100 Then BlendOpacity = 100
' calculate what percentage of source color will be used
srcPct = (100 - BlendOpacity)
' extract the RGB elements from the BlendColor & premultiply by BlendOpacity
blendR = (BlendColor And &HFF) * BlendOpacity
blendG = ((BlendColor \ &H100&) And &HFF) * BlendOpacity
blendB = ((BlendColor \ &H10000) And &HFF) * BlendOpacity
Call GdipGetImageWidth(hImage, Rec.Width)
Call GdipGetImageHeight(hImage, Rec.Height)
ReDim Data(Rec.Width - 1&, Rec.Height - 1&)
With bmpData
.Scan0Ptr = VarPtr(Data(0&, 0&))
.Stride = 4& * Rec.Width
End With
hStatus = GdipBitmapLockBits(hImage, Rec, ImageLockModeUserInputBuf Or ImageLockModeRead Or ImageLockModeWrite, PixelFormat32bppPARGB, bmpData)
If hStatus <> 0& Then Exit Function
For Y = 0& To Rec.Height - 1&
For X = 0& To Rec.Width - 1&
If Not Data(X, Y).Alpha = 0& Then
Data(X, Y).Red = (((Data(X, Y).Red * srcPct) + blendR) * Data(X, Y).Alpha) \ 25500
Data(X, Y).Green = (((Data(X, Y).Green * srcPct) + blendG) * Data(X, Y).Alpha) \ 25500
Data(X, Y).Blue = (((Data(X, Y).Blue * srcPct) + blendB) * Data(X, Y).Alpha) \ 25500
End If
Next
Next
hStatus = GdipBitmapUnlockBits(hImage, bmpData)
End Function
