There are two main problems with your code:
- Array bounds - In VB6 the number in brackets when you declare an array is the top boundary, not the number of elements. The lower boundary is going to be
0
or1
by default, depending on theOption Base
setting. It is a good practice to always provide both lower and upper bounds. - Image size - you are using
ScaleWidth
of the picturebox which you should not.
First, it is the width of the control, which may not be equal to the width of the contained image.
Second, theScaleWidth
property depends on the parent'sScaleMode
whereas you want it to always give the result in pixels. So you should be usingbmp.ScaleX(bmp.Image.Width, vbHimetric, vbPixels)
instead, which will always give correct width in correct units.
Also, I bet you have not set AutoRedraw
to True
for your picture box - you must, otherwise the below code will do nothing.
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Type ColorRefComponents
Red As Byte
Green As Byte
Blue As Byte
Alpha As Byte
End Type
Private Type ColorRefSolid
Color As Long
End Type
Public Sub White(ByVal bmp As PictureBox)
Dim levelR(0 To 255) As Double
Dim levelG(0 To 255) As Double
Dim levelB(0 To 255) As Double
Dim Color As ColorRefComponents
Dim ColorSolid As ColorRefSolid
Dim WidthInPixels As Long
Dim HeightInPixels As Long
WidthInPixels = bmp.ScaleX(bmp.Image.Width, vbHimetric, vbPixels)
HeightInPixels = bmp.ScaleY(bmp.Image.Height, vbHimetric, vbPixels)
'claculates levels
Dim x As Long, y As Long
For y = 0 To HeightInPixels - 1
For x = 0 To WidthInPixels - 1
ColorSolid.Color = GetPixel(bmp.hdc, x, y)
LSet Color = ColorSolid
levelR(Color.Red) = levelR(Color.Red) + 1
levelG(Color.Green) = levelG(Color.Green) + 1
levelB(Color.Blue) = levelB(Color.Blue) + 1
Next
Next
'calculates probibality
Dim pixelsCount As Double
Dim pR_level(0 To 255) As Double
Dim pG_level(0 To 255) As Double
Dim pB_level(0 To 255) As Double
pixelsCount = WidthInPixels * HeightInPixels
Dim i As Long
For i = 0 To 255
pR_level(i) = levelR(i) / pixelsCount
pG_level(i) = levelG(i) / pixelsCount
pB_level(i) = levelB(i) / pixelsCount
Next
'compute cumulative probabilities
Dim pR_total(0 To 255) As Double
Dim pG_total(0 To 255) As Double
Dim pB_total(0 To 255) As Double
pR_total(0) = pR_level(0)
pG_total(0) = pG_level(0)
pB_total(0) = pB_level(0)
'compute reference black and white levels
For i = 1 To 255
pR_total(i) = pR_total(i - 1) + pR_level(i)
pG_total(i) = pG_total(i - 1) + pG_level(i)
pB_total(i) = pB_total(i - 1) + pB_level(i)
Next
Dim refBR As Long
Dim refWR As Long
Dim refBG As Long
Dim refWG As Long
Dim refBB As Long
Dim refWB As Long
refBR = -1
refWR = -1
refBG = -1
refWG = -1
refBB = -1
refWB = -1
For i = 0 To 255
If refBR = -1 And pR_total(i) > 0.05 Then refBR = i
If refWR = -1 And pR_total(i) > 0.95 Then refWR = i
If refBG = -1 And pG_total(i) > 0.05 Then refBG = i
If refWG = -1 And pG_total(i) > 0.95 Then refWG = i
If refBB = -1 And pB_total(i) > 0.05 Then refBB = i
If refWB = -1 And pB_total(i) > 0.95 Then refWB = i
Next
'calculation level stretching table
Dim gR(0 To 255) As Byte
Dim gG(0 To 255) As Byte
Dim gB(0 To 255) As Byte
For i = 0 To 255
gR(i) = transformLevel(i, refBR, refWR)
gG(i) = transformLevel(i, refBG, refWG)
gB(i) = transformLevel(i, refBB, refWB)
Next
'transform components of source pixels according to the stretching table
For y = 0 To HeightInPixels - 1
For x = 0 To WidthInPixels - 1
ColorSolid.Color = GetPixel(bmp.hdc, x, y)
LSet Color = ColorSolid
Color.Red = gR(Color.Red)
Color.Green = gG(Color.Green)
Color.Blue = gB(Color.Blue)
LSet ColorSolid = Color
SetPixel bmp.hdc, x, y, ColorSolid.Color
Next
Next
bmp.Refresh
End Sub
Private Function transformLevel(ByVal f As Long, ByVal refB As Long, ByVal refW As Long) As Byte
Select Case True
Case f <= refB
transformLevel = 0
Case f >= refW Or refW <= 1
transformLevel = 255
Case Else
'Math.Log(refW) will produce 0 in denominator if refW <= 1, so check
Dim lnRefB As Double
If refB > 0 Then lnRefB = Log(refB) Else lnRefB = 0
Dim G As Double
G = (Log(f) - lnRefB) / (Log(refW) - lnRefB)
transformLevel = 255 * G
End Select
End Function