|
|
'This project needs two pictureboxes
'with a picture loaded in Picture1
Const ILLUMINANT_A = 1
Const HALFTONE = 4
Private Type COLORADJUSTMENT
caSize As Integer
caFlags As Integer
caIlluminantIndex As Integer
caRedGamma As Integer
caGreenGamma As Integer
caBlueGamma As Integer
caReferenceBlack As Integer
caReferenceWhite As Integer
caContrast As Integer
caBrightness As Integer
caColorfulness As Integer
caRedGreenTint As Integer
End Type
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 GetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
Private Declare Function SetColorAdjustment Lib "gdi32" (ByVal hdc As Long, lpca As COLORADJUSTMENT) As Long
Private Declare Function GetStretchBltMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Sub Picture2_Paint()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@allapi.net
'make sure the form and the picture boxes are properly loaded
DoEvents
Dim CA As COLORADJUSTMENT
'retrieve the current color adjustment
GetColorAdjustment Picture2.hdc, CA
'initialize the type
CA.caSize = Len(CA)
'set the brightness to darkest
CA.caBrightness = -100
'set a new illuminant
CA.caIlluminantIndex = ILLUMINANT_A
'check if the current StretchMode is set to HALFTONE
If GetStretchBltMode(Picture2.hdc) <> HALFTONE Then
'if it's not, set it to HALFTONE
SetStretchBltMode Picture2.hdc, HALFTONE
End If
'update the old coloradjustment
SetColorAdjustment Picture2.hdc, CA
'copy the picture from Picture1 to Picture2
StretchBlt Picture2.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
End Sub
|
|
