Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SetPixelV Lib "gdi32" _
(ByVal hDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal crColor As Long) As Byte
Private Declare Function GetPixel Lib "gdi32" _
(ByVal hDC As Long, _
ByVal x As Long, _
ByVal y As Long) As Long
Private Sub Command1_Click()
'variables for brightness, colour calculation, positioning
Dim Brightness As Single
Dim NewColour As Long
Dim pixHdc As Long
Dim x As Long, y As Long
Dim r As Integer, g As Integer, b As Integer
'change the brightness to a percent
Brightness = CSng(Val(Text1.Text) / 100)
pixHdc = Picture1.hDC
'run a loop through the picture to change every pixel
For x = 0 To Picture1.ScaleWidth
For y = 0 To Picture1.ScaleHeight
'get the current colour value
NewColour = GetPixel(pixHdc , x, y)
'extract the R,G,B values from the long returned by GetPixel
r = (NewColour Mod 256)
b = (Int(NewColour \ 65536))
g = ((NewColour - (b * 65536) - r) \ 256)
'change the RGB settings to their appropriate brightness
r = r * Brightness
b = b * Brightness
g = g * Brightness
'make sure the new variables aren't too high or too low
If r > 255 Then r = 255
If r < 0 Then r = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
'set the new pixel
SetPixelV pixHdc, x, y, RGB(r, g, b)
'continue through the loop
Next y
'refresh the picture box
'(a nice visual progress effect)
Picture1.Refresh
Next x
'final picture refresh
Picture1.Refresh
End Sub |