Jump to content
Sign in to follow this  
demyz0r

Receber uma imagem em função

Recommended Posts

demyz0r

Boa tarde, 

Eu estou a tentar receber uma imagem numa função, consegui fazer em VB6, mas não sei como se recebe em VBA7, já andei a tentar e até agora nada, alguem sabe?

Deixo um exemplo de VB6, de uma função que encontrei para mudar o contraste de uma imagem que recebe a imagem por parâmetro.

Public Sub ModifyContrast(ByRef SrcPicture As PictureBox, ByRef DstPicture As PictureBox, ByVal Contrast As Long)

    'Contrast uses a very simple formula:
    ' - Positive contrast pushes values away from the midtone (127).
    ' - Negative contrast pushes values toward the midtone (127)
    '
    'Because a universal adjustment is applied to each channel and pixel in the image, we can use a lookup table
    ' to greatly improve performance.
    Dim contrastTable() As Byte
    ReDim contrastTable(0 To 255) As Byte
    
    Dim x As Long, y As Long
    Dim colorCalculation As Long
    
    For x = 0 To 255
        
        'This line contains the formula for basic contrast correction.  We will calculate contrast for each possible input value
        ' (0 to 255) and store it to a table.  Then we can use this table to quickly modify the entire image.
        colorCalculation = x + (((x - 127) * Contrast) \ 100)
        
        'Clamp values to 0, 255
        If colorCalculation > 255 Then
            colorCalculation = 255
        ElseIf colorCalculation < 0 Then
            colorCalculation = 0
        End If
        
        'Store this value in the lookup table
        contrastTable(x) = colorCalculation
        
    Next x
    
    'Use the FastDrawing class to retrieve the image's pixels into a standard VB array
    Dim fDraw As FastDrawing
    Set fDraw = New FastDrawing
    
    Dim imageWidth As Long, imageHeight As Long
    imageWidth = fDraw.GetImageWidth(SrcPicture)
    imageHeight = fDraw.GetImageHeight(DstPicture)
    
    Dim imagePixels() As Byte
    fDraw.GetImageData2D SrcPicture, imagePixels
    
    'Now all we have to do is pass each channel value in the image through our lookup table
    Dim QuickX As Long
    
    For x = 0 To imageWidth - 1
        QuickX = x * 3
    For y = 0 To imageHeight - 1
    
        'Modify each of red, green, and blue
        imagePixels(QuickX, y) = contrastTable(imagePixels(QuickX, y))
        imagePixels(QuickX + 1, y) = contrastTable(imagePixels(QuickX + 1, y))
        imagePixels(QuickX + 2, y) = contrastTable(imagePixels(QuickX + 2, y))
        
    Next y
    Next x

    'Paint the modified pixels onto the destination picture box
    fDraw.SetImageData2D DstPicture, SrcPicture.ScaleWidth, SrcPicture.ScaleHeight, imagePixels
    
End Sub

 

Edited by demyz0r

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.