imprimer une image en negatif

Question

Rober
Bonjour,
je voudrais imprimer une image en couleur dans un picturebox en noir et blanc en negatif et en changeant l'echelle de l'image
Merci de votre aide et soyez indulgeant je debute alors commentez vos explications

cs_EBArtSoft · Answer

voici un code vite fait qui agit a peut pret comme cela :

Option Explicit

Private Type BITMAPINFOHEADER
    biSize          As Long
    biWidth         As Long
    biHeight        As Long
    biPlanes        As Integer
    biBitCount      As Integer
    biCompression   As Long
    biSizeImage     As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed       As Long
    biClrImportant  As Long
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As Any, ByVal un As Long, lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long

Private Sub Command1_Click()
    Dim mBmp    As BITMAPINFOHEADER
    Dim Ratio   As Single
    Dim mX      As Long
    Dim mY      As Long
    Dim mDC     As Long
    Dim mObj    As Long
    Dim mOld    As Long
    Dim mData   As Long
    Dim i       As Long
    Dim j       As Long
    Dim mOfs    As Long
    Dim mMid    As Long
    Dim mClr(3) As Byte

    Ratio = 1
    mX = Picture1.Width
    mY = Picture1.Height
    With mBmp
        .biSize = 40
        .biPlanes = 1
        .biWidth = mX
        .biHeight = mY
        .biBitCount = 24
        .biSizeImage = (((mX * 3) + 3) And &HFFFFFFFC) * mY
    End With
    mDC = CreateCompatibleDC(Me.hdc)
    mObj = CreateDIBSection(mDC, mBmp, 0, mData, 0, 0)
    mOld = SelectObject(mDC, mObj)
    BitBlt mDC, 0, 0, mX, mY, Picture1.hdc, 0, 0, vbSrcCopy
    mOfs = mData
    For j = 0 To (mY - 1)
        For i = 0 To (mX - 1)
            If mOfs > (mData + mBmp.biSizeImage) Then GoTo fin
            RtlMoveMemory mClr(0), ByVal mOfs, 3
            mOfs = mOfs + 3
            mMid = mClr(2)
            mMid = mMid + mClr(1)
            mMid = mMid + mClr(0)
            mMid = mMid / 3
            mMid = 255 - mMid
            PSet (i, mBmp.biHeight - j), RGB(mMid, mMid, mMid)
        Next
        mOfs = mOfs + 1
    Next
    
fin:
    'Pour faire le redimentionnement
    'StretchBlt Me.hdc, 0, 0, mX * Ratio, mY * Ratio, mDC, 0, 0, mX, mY, vbSrcCopy
    
    SelectObject mDC, mOld
    DeleteObject mObj
    DeleteDC mDC
    
End Sub

@+

E.B.

Imprimer une image en negatif

1 réponse

Discussions similaires