Управление яркостью и контрастностью изображения в форме Excel с помощью VBA - PullRequest
0 голосов
/ 04 октября 2018

Я использую несколько экземпляров кода закрытой функции ниже для отображения нескольких изображений в форме Excel.Работает нормально.Я могу использовать эти небольшие HTML-контейнеры для размещения изображений в различных местах на форме.Но мне нужно иметь возможность регулировать яркость и контрастность отображаемого изображения.

В прошлом в другом проекте я отображал изображения непосредственно на листе, а затем использовал следующий код для изменения яркости (и аналогично для контраста).Но я не понимаю, как сделать это для этого проекта с изображениями, отображаемыми в форме.Я мог бы действительно использовать некоторую помощь.

Ниже приведен код, используемый в другом проекте для увеличения яркости всех изображений, отображаемых на листе.Аналогичный код используется для уменьшения яркости и увеличения / уменьшения контраста.

Sub BumpContrastUp()
    gvarGlobalContrast = gvarGlobalContrast + 0.05
    Dim shape As Excel.shape
    Dim cnt As Long
    cnt = 0
    For Each shape In ActiveSheet.Shapes
        If shape.Type = msoLinkedPicture Then
            shape.PictureFormat.Contrast = gvarGlobalContrast
        End If
    Next shape
End Sub

Ниже приведен код, используемый для отображения изображений в форме.Несколько HTML-контейнеров (в конце) используются для отображения различных изображений (по одному изображению на контейнер) в форме.Примечание: я вырезал кучу кода и попытался оставить только то, что вам нужно, чтобы увидеть, что происходит.В конце мне нужно изменить яркость и контрастность для picURL1 и picURL2.

Private Sub UserForm_Initialize()
    With frmImageReview
        .Caption = Sheets("Configuration").Range("B2").Value
        .Height = Sheets("Configuration").Range("B3").Value
        .Width = Sheets("Configuration").Range("B4").Value
    End With
        'BUTTONS ---------------------------------------------------
        With frmImageReview.cmdOK
            .Top = Sheets("Configuration").Range("J21").Value
            .Left = Sheets("Configuration").Range("J22").Value
        End With
        With frmImageReview.cmdBrightPlus
            .Top = Sheets("Configuration").Range("J24").Value
            .Left = Sheets("Configuration").Range("J25").Value
        End With
        With frmImageReview.cmdBrightNeg
            .Top = Sheets("Configuration").Range("K24").Value
            .Left = Sheets("Configuration").Range("K25").Value
        End With
        With frmImageReview.cmdContrastPlus
            .Top = Sheets("Configuration").Range("L24").Value
            .Left = Sheets("Configuration").Range("L25").Value
        End With
        With frmImageReview.cmdContrastNeg
            .Top = Sheets("Configuration").Range("M24").Value
            .Left = Sheets("Configuration").Range("M25").Value
        End With
    'HEIGHT/WIDTH FACTORS (for use in setting height/width in web browsers)
    With Sheets("Configuration")
        HWF1 = .Range("B" & IVProw + 6).Value
        HWF2 = .Range("C" & IVProw + 6).Value
    End With

    With WebBrowser1
        .Height = Sheets("Configuration").Range("B" & IVProw + 1).Value
        .Width = Sheets("Configuration").Range("B" & IVProw + 2).Value
        .Top = Sheets("Configuration").Range("B" & IVProw + 3).Value
        .Left = Sheets("Configuration").Range("B" & IVProw + 4).Value
        .Visible = Sheets("Configuration").Range("B" & IVProw + 5).Value
    End With
    With WebBrowser2
        .Height = Sheets("Configuration").Range("C" & IVProw + 1).Value
        .Width = Sheets("Configuration").Range("C" & IVProw + 2).Value
        .Top = Sheets("Configuration").Range("C" & IVProw + 3).Value
        .Left = Sheets("Configuration").Range("C" & IVProw + 4).Value
        .Visible = Sheets("Configuration").Range("C" & IVProw + 5).Value
    End With
    GetImage
    cmdClearForm_Click
End Sub

Private Sub GetImage()
    With Sheets("Configuration")
        displayPath = Sheets("Configuration").Range("B8") 'Local
        CFIb1 = Sheets("Configuration").Range("B" & IVProw + 8).Value
        CFIb2 = Sheets("Configuration").Range("C" & IVProw + 8).Value
    End With
    picURL1 = displayPath & "\" & Sheets("Image URLs").Range(CFIb1 & r + rDiff)
    picURL2 = displayPath & "\" & Sheets("Image URLs").Range(CFIb2 & r + rDiff)
        fnCreateHTML1 (picURL1)
        fnCreateHTML2 (picURL2)
        Me.WebBrowser1.Navigate strPath & "Tmp1.html"
        Me.WebBrowser2.Navigate strPath & "Tmp2.html"
End Sub


'//-----------------------------------------
'// Author    : "Ivan F Moala"
'// Site      : "http://www.xcelfiles.com"
'-------------------------------------------
Private Function fnCreateHTML1(strImgFilePath As String)
    Dim hdl As Long, m_Width1 As Long, m_Height1 As Long
    Dim strAp1 As String

strAp1 = Chr(34)
m_Width1 = WebBrowser1.Width * HWF1
m_Height1 = WebBrowser1.Height * HWF1
hdl = FreeFile

    Open strPath & "Tmp1.html" For Output As #hdl
        Print #hdl, "<HTML>"
        Print #hdl, "<CENTER>"
        Print #hdl, "<BODY"
        Print #hdl, "Scroll = ""YES"""
        Print #hdl, "LEFTMARGIN=0"
        Print #hdl, "TOPMARGIN=0"
        Print #hdl, "</BODY>"
        Print #hdl, "<IMG width= " & m_Width1 & _
                    " height= " & m_Height1 & _
                    " SRC = " & strAp1 & picURL1 & strAp1 & _
                    "; Border = 0>"
        Print #hdl, "</CENTER>"
        Print #hdl, "</HTML>"
    Close hdl
End Function


Private Function fnCreateHTML2(strImgFilePath As String)
    Dim hd2 As Long, m_Width2 As Long, m_Height2 As Long
    Dim strAp2 As String

strAp2 = Chr(34)
m_Width2 = WebBrowser2.Width * HWF2
m_Height2 = WebBrowser2.Height * HWF2
hd2 = FreeFile

    Open strPath & "Tmp2.html" For Output As #hd2
        Print #hd2, "<HTML>"
        Print #hd2, "<CENTER>"
        Print #hd2, "<BODY"
        Print #hd2, "Scroll = ""YES"""
        Print #hd2, "LEFTMARGIN=0"
        Print #hd2, "TOPMARGIN=0"
        Print #hd2, "</BODY>"
        Print #hd2, "<IMG width= " & m_Width2 & _
                    " height= " & m_Height2 & _
                    " SRC = " & strAp2 & picURL2 & strAp2 & _
                    "; Border = 0>"
        Print #hd2, "</CENTER>"
        Print #hd2, "</HTML>"
    Close hd2
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...