Source Code:
frmBrightness:
frmBrightness Screenshot
Option Explicit
'Circular Gradient Patterns
'Written by Jeff Lewis, making heavy use of Brightness Demo ©2005 by Tanner "DemonSpectre" Helland
'I downloaded the sample code to display raster graphics from tannerhelland.com,
'as decribed in the writeup below. I kept parts of that program, added my own relatively
'simple methods of generating gradients, and made some related changes to the form to
'make it work for this application.
'Brightness Demo ©2005 by Tanner "DemonSpectre" Helland
'Source code for "Graphics Programming in Visual Basic - Part 3: Advanced API Pixel Routines"
'This simple program demonstrates how to adjust an image's brightness using the API calls of
'GetDIBits and StretchDIBits (I've also included GetBitmapBits and SetBitmapBits
'for reference' sake). This program demonstrates some pretty fast graphics
'routines, but they can be made even faster! Read Tutorial 4 for more information
'about optimizing graphics functions.
'The CG graphic in the picture box is ©1998 by SquareSoft
'(it's from Final Fantasy VIII, if you care)
'For additional cool code, check out the students of game design website at
'http://www.studentsofgamedesign.com
'Listen to sweet original VG music at
'www.tannerhelland.com
'All of the DIB types
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbAlpha As Byte
End Type
Private Type BITMAPINFOHEADER
bmSize As Long
bmWidth As Long
bmHeight As Long
bmPlanes As Integer
bmBitCount As Integer
bmCompression As Long
bmSizeImage As Long
bmXPelsPerMeter As Long
bmYPelsPerMeter As Long
bmClrUsed As Long
bmClrImportant As Long
End Type
Private Type BITMAPINFO
bmHeader As BITMAPINFOHEADER
bmColors(0 To 255) As RGBQUAD
End Type
'The GetObject API call gives us the bitmap variables we need for the other API calls
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
'The GetBitmapBits and SetBitmapBits API calls (use ONLY in 24/32-bit color mode!!)
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
'The magical API DIB function calls (they're 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 StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dWidth As Long, ByVal dHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long, ByVal RasterOp As Long) As Long
'The array that will hold our pixel data
Dim ImageData() As Byte
'Temporary brightness variable
Dim tBrightness As Single
Private Sub ChkAutoRedraw_Click()
'Change the AutoRedraw property of the picture box based on the check box's value
'If ChkAutoRedraw.Value = vbChecked Then Picture1.AutoRedraw = True Else Picture1.AutoRedraw = False
End Sub
Private Sub CmdBrightness_Click()
'Get the text value, convert it to type 'Single,' and send it to the sub
'tBrightness = CSng(Val(TxtBrightness)) / 100
DrawDIBBrightness Picture1, Picture1, tBrightness
End Sub
Private Sub Command1_Click()
DrawRandomCirclesOldMethod Picture1, Picture1, tBrightness
End Sub
Private Sub Command2_Click()
SetImageData Picture1, ImageData()
End Sub
Private Sub Command3_Click()
DrawRandomCircles Picture1, Picture1, tBrightness
End Sub
Private Sub Command4_Click()
DrawThreeCirclesPowerMethod Picture1, Picture1, tBrightness
End Sub
'************************************************************************************************************
'************************************************************************************************************
'Power Method Subroutines
'************************************************************************************************************
'************************************************************************************************************
'A simple subroutine that will change the brightness of a picturebox using DIB sections.
Public Sub DrawThreeCirclesPowerMethod(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
'Coordinate variables
Dim x As Long, y As Long
Dim xTemp As Single
Dim yTemp As Single
Dim red As Integer
Dim green As Integer
Dim blue As Integer
Dim RedTemp As Single
Dim GreenTemp As Single
Dim BlueTemp As Single
Dim RedScalar As Single
Dim RedMag As Single
Dim RedX As Single
Dim RedY As Single
Dim GreenScalar As Single
Dim GreenMag As Single
Dim GreenX As Single
Dim GreenY As Single
Dim BlueScalar As Single
Dim BlueMag As Single
Dim BlueX As Single
Dim BlueY As Single
Dim Dist As Single
Dim Power As Single
Power = TextPowerIndPower.Text
RedScalar = TextPowerIndRScalar.Text ^ Power
RedMag = TextPowerIndRMag.Text
RedX = TextPowerIndRX.Text
RedY = TextPowerIndRY.Text
GreenScalar = TextPowerIndGScalar.Text ^ Power
GreenMag = TextPowerIndGMag.Text
GreenX = TextPowerIndGX.Text
GreenY = TextPowerIndGY.Text
BlueScalar = TextPowerIndBScalar.Text ^ Power
BlueMag = TextPowerIndBMag.Text
BlueX = TextPowerIndBX.Text
BlueY = TextPowerIndBY.Text
'Get the pixel data into our ImageData array
GetImageData SrcPicture, ImageData()
'Temporary width and height variables are faster than accessing the Scale properties over and over again
Dim TempWidth As Long, TempHeight As Long
TempWidth = DstPicture.ScaleWidth - 1
TempHeight = DstPicture.ScaleHeight - 1
'run a loop through the picture to change every pixel
For x = 0 To TempWidth
For y = 0 To TempHeight
xTemp = x
yTemp = y
'Red
Dist = Sqr((xTemp - RedX) * (xTemp - RedX) + (yTemp - RedY) * (yTemp - RedY))
If Dist > 0 Then
RedTemp = RedMag * RedScalar / Dist ^ Power
Else
RedTemp = 255
End If
If RedTemp > 255 Then
RedTemp = 255
ElseIf RedTemp < 0 Then
RedTemp = 0
End If
'Green
Dist = Sqr((xTemp - GreenX) * (xTemp - GreenX) + (yTemp - GreenY) * (yTemp - GreenY))
If Dist > 0 Then
GreenTemp = GreenMag * GreenScalar / Dist ^ Power
Else
GreenTemp = 255
End If
If GreenTemp > 255 Then
GreenTemp = 255
ElseIf GreenTemp < 0 Then
GreenTemp = 0
End If
'Blue
Dist = Sqr((xTemp - BlueX) * (xTemp - BlueX) + (yTemp - BlueY) * (yTemp - BlueY))
If Dist > 0 Then
BlueTemp = BlueMag * BlueScalar / Dist ^ Power
Else
BlueTemp = 255
End If
If BlueTemp > 255 Then
BlueTemp = 255
ElseIf BlueTemp < 0 Then
BlueTemp = 0
End If
red = Int(RedTemp)
green = Int(GreenTemp)
blue = Int(BlueTemp)
'If x < 255 Then
' red = x
'Else
' red = 255
'End If
'If y < 255 Then
' green = y
'Else
' green = 255
'End If
'blue = 0
ImageData(2, x, y) = red 'Change the red
ImageData(1, x, y) = green 'Change the green
ImageData(0, x, y) = blue 'Change the blue
Next y
'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
Next x
'final picture refresh
SetImageData DstPicture, ImageData()
End Sub
'A simple subroutine that will change the brightness of a picturebox using DIB sections.
Public Sub DrawRandomCircles(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
'Coordinate variables
Dim x As Long, y As Long
Dim xTemp As Single
Dim yTemp As Single
Dim red As Integer
Dim green As Integer
Dim blue As Integer
Dim RedTemp As Single
Dim GreenTemp As Single
Dim BlueTemp As Single
Dim RedScalar As Single
Dim RedX As Single
Dim RedY As Single
Dim GreenScalar As Single
Dim GreenX As Single
Dim GreenY As Single
Dim BlueScalar As Single
Dim BlueX As Single
Dim BlueY As Single
Dim NumberPoints As Long
Dim MaxPoints As Long
Dim MinPoints As Long
Dim ctr As Long
Dim MinXLimit As Single
Dim MaxXLimit As Single
Dim MinYLimit As Single
Dim MaxYLimit As Single
Dim MinScalarLimit As Single
Dim MaxScalarLimit As Single
Dim MinMagLimit As Single
Dim MaxMagLimit As Single
Dim TempColor As Single
Dim Dist As Single
Dim Power As Single
Dim Points() As Single
Randomize Timer
MinXLimit = TextPowerMinX.Text
MaxXLimit = TextPowerMaxX.Text
MinYLimit = TextPowerMinY.Text
MaxYLimit = TextPowerMaxY.Text
Power = TextPowerPower.Text
MinScalarLimit = TextPowerMinScalar.Text ^ Power
MaxScalarLimit = TextPowerMaxScalar.Text ^ Power
MinMagLimit = TextPowerMinMag.Text
MaxMagLimit = TextPowerMaxMag.Text
MaxPoints = TextPowerMaxPoints.Text
NumberPoints = (TextPowerMaxPoints.Text - TextPowerMinPoints.Text) * Rnd + TextPowerMinPoints.Text
ReDim Points(NumberPoints, 8) As Single
TextDisplay.Text = "Number Points = " & Str(NumberPoints)
For ctr = 1 To NumberPoints
TextDisplay.Text = TextDisplay.Text & vbCrLf
'X Coord
Points(ctr, 1) = (MaxXLimit - MinXLimit) * Rnd + MinXLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "XCoord " & Str(ctr) & " = " & Str(Points(ctr, 1))
'Y Coord
Points(ctr, 2) = (MaxYLimit - MinYLimit) * Rnd + MinYLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "YCoord " & Str(ctr) & " = " & Str(Points(ctr, 2))
'Red Mag
Points(ctr, 3) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Mag " & Str(ctr) & " = " & Str(Points(ctr, 3))
'Green Mag
Points(ctr, 4) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Mag " & Str(ctr) & " = " & Str(Points(ctr, 4))
'Blue Mag
Points(ctr, 5) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Mag " & Str(ctr) & " = " & Str(Points(ctr, 5))
'Red Scalar
Points(ctr, 6) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Scalar " & Str(ctr) & " = " & Str(Points(ctr, 6))
'Green Scalar
Points(ctr, 7) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Scalar " & Str(ctr) & " = " & Str(Points(ctr, 7))
'Blue Scalar
Points(ctr, 8) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Scalar " & Str(ctr) & " = " & Str(Points(ctr, 8))
Next ctr
'Get the pixel data into our ImageData array
GetImageData SrcPicture, ImageData()
'Temporary width and height variables are faster than accessing the Scale properties over and over again
Dim TempWidth As Long, TempHeight As Long
TempWidth = DstPicture.ScaleWidth - 1
TempHeight = DstPicture.ScaleHeight - 1
'run a loop through the picture to change every pixel
For x = 0 To TempWidth
Text1.Text = Str(x)
DoEvents
For y = 0 To TempHeight
xTemp = x
yTemp = y
RedTemp = 0
GreenTemp = 0
BlueTemp = 0
For ctr = 1 To NumberPoints
'Red
Dist = Sqr((xTemp - Points(ctr, 1)) * (xTemp - Points(ctr, 1)) + (yTemp - Points(ctr, 2)) * (yTemp - Points(ctr, 2)))
If Dist > 0 Then
'Red
TempColor = Points(ctr, 3) * Points(ctr, 6) / Dist ^ Power
RedTemp = RedTemp + TempColor
'Green
TempColor = Points(ctr, 4) * Points(ctr, 7) / Dist ^ Power
GreenTemp = GreenTemp + TempColor
'Blue
TempColor = Points(ctr, 5) * Points(ctr, 8) / Dist ^ Power
BlueTemp = BlueTemp + TempColor
Else
RedTemp = RedTemp + Points(ctr, 3)
GreenTemp = GreenTemp + Points(ctr, 4)
BlueTemp = BlueTemp + Points(ctr, 5)
End If
Next ctr
If RedTemp > 255 Then
RedTemp = 255
End If
If GreenTemp > 255 Then
GreenTemp = 255
End If
If BlueTemp > 255 Then
BlueTemp = 255
End If
red = Int(RedTemp)
green = Int(GreenTemp)
blue = Int(BlueTemp)
ImageData(2, x, y) = red 'Change the red
ImageData(1, x, y) = green 'Change the green
ImageData(0, x, y) = blue 'Change the blue
Next y
'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
If (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
Next x
'final picture refresh
SetImageData DstPicture, ImageData()
End Sub
'************************************************************************************************************
'************************************************************************************************************
'Linear Gradient Subroutines
'************************************************************************************************************
'************************************************************************************************************
'A simple subroutine that will change the brightness of a picturebox using DIB sections.
Public Sub DrawDIBBrightness(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
'Coordinate variables
Dim x As Long, y As Long
Dim xTemp As Single
Dim yTemp As Single
Dim red As Integer
Dim green As Integer
Dim blue As Integer
Dim RedTemp As Single
Dim GreenTemp As Single
Dim BlueTemp As Single
Dim RedScalar As Single
Dim RedMag As Single
Dim RedX As Single
Dim RedY As Single
Dim GreenScalar As Single
Dim GreenMag As Single
Dim GreenX As Single
Dim GreenY As Single
Dim BlueScalar As Single
Dim BlueMag As Single
Dim BlueX As Single
Dim BlueY As Single
RedScalar = TextLinIndRScalar.Text
RedMag = TextLinIndRMag.Text
RedX = TextLinIndRX.Text
RedY = TextLinIndRY.Text
GreenScalar = TextLinIndGScalar.Text
GreenMag = TextLinIndGMag.Text
GreenX = TextLinIndGX.Text
GreenY = TextLinIndGY.Text
BlueScalar = TextLinIndBScalar.Text
BlueMag = TextLinIndBMag.Text
BlueX = TextLinIndBX.Text
BlueY = TextLinIndBY.Text
'Get the pixel data into our ImageData array
GetImageData SrcPicture, ImageData()
'Temporary width and height variables are faster than accessing the Scale properties over and over again
Dim TempWidth As Long, TempHeight As Long
TempWidth = DstPicture.ScaleWidth - 1
TempHeight = DstPicture.ScaleHeight - 1
'run a loop through the picture to change every pixel
For x = 0 To TempWidth
For y = 0 To TempHeight
xTemp = x
yTemp = y
RedTemp = RedMag - RedScalar * ((xTemp - RedX) ^ 2 + (yTemp - RedY) ^ 2) ^ 0.5
GreenTemp = GreenMag - GreenScalar * ((xTemp - GreenX) ^ 2 + (yTemp - GreenY) ^ 2) ^ 0.5
BlueTemp = BlueMag - BlueScalar * ((xTemp - BlueX) ^ 2 + (yTemp - BlueY) ^ 2) ^ 0.5
If RedTemp > 255 Then
RedTemp = 255
ElseIf RedTemp < 0 Then
RedTemp = 0
End If
If GreenTemp > 255 Then
GreenTemp = 255
ElseIf GreenTemp < 0 Then
GreenTemp = 0
End If
If BlueTemp > 255 Then
BlueTemp = 255
ElseIf BlueTemp < 0 Then
BlueTemp = 0
End If
red = Int(RedTemp)
green = Int(GreenTemp)
blue = Int(BlueTemp)
ImageData(2, x, y) = red 'Change the red
ImageData(1, x, y) = green 'Change the green
ImageData(0, x, y) = blue 'Change the blue
Next y
'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
Next x
'final picture refresh
SetImageData DstPicture, ImageData()
End Sub
'A simple subroutine that will change the brightness of a picturebox using DIB sections.
Public Sub DrawRandomCirclesOldMethod(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
'Coordinate variables
Dim x As Long, y As Long
Dim xTemp As Single
Dim yTemp As Single
Dim red As Integer
Dim green As Integer
Dim blue As Integer
Dim RedTemp As Single
Dim GreenTemp As Single
Dim BlueTemp As Single
Dim RedScalar As Single
Dim RedX As Single
Dim RedY As Single
Dim GreenScalar As Single
Dim GreenX As Single
Dim GreenY As Single
Dim BlueScalar As Single
Dim BlueX As Single
Dim BlueY As Single
Dim NumberPoints As Long
Dim MaxPoints As Long
Dim ctr As Long
Dim MinXLimit As Single
Dim MaxXLimit As Single
Dim MinYLimit As Single
Dim MaxYLimit As Single
Dim MinScalarLimit As Single
Dim MaxScalarLimit As Single
Dim MinMagLimit As Single
Dim MaxMagLimit As Single
Dim TempColor As Single
Dim Dist As Single
Dim Points() As Single
Randomize Timer
MinXLimit = TextLinMinx.Text
MaxXLimit = TextLinMaxX.Text
MinYLimit = TextLinMinY.Text
MaxYLimit = TextLinMaxY.Text
MinScalarLimit = TextLinMinScalar.Text
MaxScalarLimit = TextLinMaxScalar.Text
MinMagLimit = TextLinMinMag.Text
MaxMagLimit = TextLinMaxMag.Text
MaxPoints = TextLinMaxPoints.Text
NumberPoints = (TextLinMaxPoints.Text - TextLinMinPoints.Text) * Rnd + TextLinMinPoints.Text
ReDim Points(NumberPoints, 8) As Single
TextDisplay.Text = "Number Points = " & Str(NumberPoints)
For ctr = 1 To NumberPoints
TextDisplay.Text = TextDisplay.Text & vbCrLf
'X Coord
Points(ctr, 1) = (MaxXLimit - MinXLimit) * Rnd + MinXLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "XCoord " & Str(ctr) & " = " & Str(Points(ctr, 1))
'Y Coord
Points(ctr, 2) = (MaxYLimit - MinYLimit) * Rnd + MinYLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "YCoord " & Str(ctr) & " = " & Str(Points(ctr, 2))
'Red Mag
Points(ctr, 3) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Mag " & Str(ctr) & " = " & Str(Points(ctr, 3))
'Green Mag
Points(ctr, 4) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Mag " & Str(ctr) & " = " & Str(Points(ctr, 4))
'Blue Mag
Points(ctr, 5) = (MaxMagLimit - MinMagLimit) * Rnd + MinMagLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Mag " & Str(ctr) & " = " & Str(Points(ctr, 5))
'Red Scalar
Points(ctr, 6) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Red Scalar " & Str(ctr) & " = " & Str(Points(ctr, 6))
'Green Scalar
Points(ctr, 7) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Green Scalar " & Str(ctr) & " = " & Str(Points(ctr, 7))
'Blue Scalar
Points(ctr, 8) = (MaxScalarLimit - MinScalarLimit) * Rnd + MinScalarLimit
TextDisplay.Text = TextDisplay.Text & vbCrLf & "Blue Scalar " & Str(ctr) & " = " & Str(Points(ctr, 8))
Next ctr
'Get the pixel data into our ImageData array
GetImageData SrcPicture, ImageData()
'Temporary width and height variables are faster than accessing the Scale properties over and over again
Dim TempWidth As Long, TempHeight As Long
TempWidth = DstPicture.ScaleWidth - 1
TempHeight = DstPicture.ScaleHeight - 1
'run a loop through the picture to change every pixel
For x = 0 To TempWidth
Text1.Text = Str(x)
DoEvents
For y = 0 To TempHeight
xTemp = x
yTemp = y
RedTemp = 0
GreenTemp = 0
BlueTemp = 0
For ctr = 1 To NumberPoints
Dist = Sqr((xTemp - Points(ctr, 1)) * (xTemp - Points(ctr, 1)) + (yTemp - Points(ctr, 2)) * (yTemp - Points(ctr, 2)))
'Red
TempColor = Points(ctr, 3) - Points(ctr, 6) * Dist
If TempColor < 0 Then
TempColor = 0
End If
RedTemp = RedTemp + TempColor
'Green
TempColor = Points(ctr, 4) - Points(ctr, 7) * Dist
If TempColor < 0 Then
TempColor = 0
End If
GreenTemp = GreenTemp + TempColor
'Blue
TempColor = Points(ctr, 5) - Points(ctr, 8) * Dist
If TempColor < 0 Then
TempColor = 0
End If
BlueTemp = BlueTemp + TempColor
Next ctr
If RedTemp > 255 Then
RedTemp = 255
ElseIf RedTemp < 0 Then
RedTemp = 0
End If
If GreenTemp > 255 Then
GreenTemp = 255
ElseIf GreenTemp < 0 Then
GreenTemp = 0
End If
If BlueTemp > 255 Then
BlueTemp = 255
ElseIf BlueTemp < 0 Then
BlueTemp = 0
End If
red = Int(RedTemp)
green = Int(GreenTemp)
blue = Int(BlueTemp)
'If x < 255 Then
' red = x
'Else
' red = 255
'End If
'If y < 255 Then
' green = y
'Else
' green = 255
'End If
'blue = 0
ImageData(2, x, y) = red 'Change the red
ImageData(1, x, y) = green 'Change the green
ImageData(0, x, y) = blue 'Change the blue
Next y
'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
If (x Mod 25) = 0 Then SetImageData DstPicture, ImageData()
Next x
'final picture refresh
SetImageData DstPicture, ImageData()
End Sub
'************************************************************************************************************
'************************************************************************************************************
'API Subroutines
'************************************************************************************************************
'************************************************************************************************************
'Routine to get an image's pixel information into an array dimensioned (rgb, x, y)
Public Sub GetImageData(ByRef SrcPictureBox As PictureBox, ByRef ImageData() As Byte)
'Declare us some variables of the necessary bitmap types
Dim bm As BITMAP
Dim bmi As BITMAPINFO
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.bmPlanes = 1 'Number of planes (always one for this instance)
bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for this instance)
bmi.bmHeader.bmCompression = 0 'Compression: standard/none or RLE
'Calculate the size of the bitmap type (in bytes)
Dim bmLen As Long
bmLen = Len(bm)
'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
GetObject SrcPictureBox.Image, bmLen, bm
'Build a correctly sized array
ReDim ImageData(0 To 2, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same one we used above)
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from
'SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
GetDIBits SrcPictureBox.hDC, SrcPictureBox.Image, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Sub
'Routine to set an image's pixel information from an array dimensioned (rgb, x, y)
Public Sub SetImageData(ByRef DstPictureBox As PictureBox, ByRef ImageData() As Byte)
'Declare us some variables of the necessary bitmap types
Dim bm As BITMAP
Dim bmi As BITMAPINFO
'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
bmi.bmHeader.bmPlanes = 1 'Number of planes (always one for this instance)
bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for this instance)
bmi.bmHeader.bmCompression = 0 'Compression: standard/none or RLE
'Calculate the size of the bitmap type (in bytes)
Dim bmLen As Long
bmLen = Len(bm)
'Get the picture box information from DstPictureBox and put it into our 'bm' variable
GetObject DstPictureBox.Image, bmLen, bm
'Now that we know the object's size, finish building the temporary header to pass to the StretchDIBits call
'(continuing to use the 'bmi' we used above)
bmi.bmHeader.bmWidth = bm.bmWidth
bmi.bmHeader.bmHeight = bm.bmHeight
'Now that we've built the temporary header, we use StretchDIBits to take the data from the
'ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the
'StretchDIBits call should be on one continuous line)
StretchDIBits DstPictureBox.hDC, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
'Note: Always set AutoRedraw to true when using DIB sections; when AutoRedraw is false
'you will get unpredictable results.
If DstPictureBox.AutoRedraw = True Then
DstPictureBox.Picture = DstPictureBox.Image
DstPictureBox.Refresh
End If
End Sub
'Standardized routine for converting to absolute byte values
Public Sub ByteMe(ByRef TempVar As Long)
If TempVar > 255 Then TempVar = 255: Exit Sub
If TempVar < 0 Then TempVar = 0: Exit Sub
End Sub
'Private Sub CmdBrightnessBB_Click()
' 'Get the text value, convert it to type 'Single,' and send it to the sub
' tBrightness = CSng(Val(TxtBrightness)) / 100
' DrawBitmapBitsBrightness Picture1, Picture1, tBrightness
'End Sub
'A subroutine for changing the brightness of a picturebox IN 24/32-BIT COLOR MODES ONLY!!
Public Sub DrawBitmapBitsBrightness(DstPicture As PictureBox, SrcPicture As PictureBox, ByVal Brightness As Single)
'Coordinate variables
Dim x As Long, y As Long
'Build a look-up table for all possible brightness values
Dim bTable(0 To 255) As Long
Dim TempColor As Long
For x = 0 To 255
'Calculate the brightness for pixel value x
TempColor = Int(CSng(x) * Brightness)
'Make sure that the calculated value is between 0 and 255 (so we don't get an error)
ByteMe TempColor
'Place the corrected value into its array spot
bTable(x) = TempColor
Next x
'Create a bitmap variable and copy the basic information from 'PictureBox.Image' into it
Dim bm As BITMAP
GetObject DstPicture.Image, Len(bm), bm
'Create an array of bytes and fill it with the information from 'bm' (i.e. PictureBox.image)
Dim ImageData() As Byte
ReDim ImageData(0 To (bm.bmBitsPixel \ 8) - 1, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
GetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
'Temporary width and height variables are faster than accessing the Scale properties over and over again
Dim TempWidth As Long, TempHeight As Long
TempWidth = DstPicture.ScaleWidth - 1
TempHeight = DstPicture.ScaleHeight - 1
'run a loop through the picture to change every pixel
For x = 0 To TempWidth
For y = 0 To TempHeight
'Use the values in the look-up table to quickly change the brightness values
'of each color. The look-up table is much faster than doing the math
'over and over for each individual pixel.
ImageData(2, x, y) = bTable(ImageData(2, x, y)) 'Change the red
ImageData(1, x, y) = bTable(ImageData(1, x, y)) 'Change the green
ImageData(0, x, y) = bTable(ImageData(0, x, y)) 'Change the blue
Next y
'refresh the picture box every 25 lines (a nice progress bar effect if AutoRedraw is set)
If DstPicture.AutoRedraw = True And (x Mod 25) = 0 Then
SetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
DstPicture.Picture = DstPicture.Image
DstPicture.Refresh
End If
Next x
'final picture refresh
SetBitmapBits DstPicture.Image, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
DstPicture.Picture = DstPicture.Image
DstPicture.Refresh
End Sub
|