Public Function BrightnessBits(ByVal Pic As PictureBox, ByVal Value As Long) As Boolean
    Dim MyhDC As Long
    Dim MyBMIH As BitMapInfoHeader
    Dim MyhDIB As Long
    Dim MyPtr As Long
    Dim hOldMap As Long
    Dim MapData() As Byte
    Dim TempValue As Long
    Dim BrightTable(255) As Byte
    Dim I As Long
    Dim MaxI As Long
     
    With MyBMIH
        .biSize = Len(MyBMIH)
        .biWidth = Pic.ScaleWidth
        .biHeight = Pic.ScaleHeight
        .biPlanes = 1
        .biBitCount = 24
        .biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
    End With
    MyhDC = CreateCompatibleDC(0)
    MyhDIB = CreateDIBSection(MyhDC, MyBMIH, 0, MyPtr, 0, 0)
    If MyhDIB Then
        hOldMap = SelectObject(MyhDC, MyhDIB)
    Else
        DeleteObject MyhDC
        Exit Function
    End If
    
    BitBlt MyhDC, 0, 0, MyBMIH.biWidth, MyBMIH.biHeight, Pic.hDC, 0, 0, vbSrcCopy
    
    MaxI = MyBMIH.biSizeImage - 1
    ReDim MapData(0 To MaxI)
    Debug.Print "GetBitmapBits:", GetBitmapBits(MyhDIB, MyBMIH.biSizeImage, MapData(0))
    
    For I = 0 To 255
        TempValue = I * Value / 100
        If TempValue > 255 Then
            BrightTable(I) = 255
        Else
            BrightTable(I) = TempValue
        End If
    Next I
    
    For I = 0 To MaxI
        MapData(I) = BrightTable(MapData(I))
    Next I
    
    call SetBitmapBits(MyhDIB, MyBMIH.biSizeImage, MapData(0))
    
    BitBlt Pic.hDC, 0, 0, MyBMIH.biWidth, MyBMIH.biHeight, MyhDC, 0, 0, vbSrcCopy
    If hOldMap Then DeleteObject SelectObject(MyhDC, hOldMap)
    DeleteObject MyhDC
    BrightnessBits = True
End FunctionPrivate Sub CmdStart_Click()
    PicView2.Width = PicView1.Width
    PicView2.Height = PicView1.Height
    Me.MousePointer = vbHourglass
    DoEvents
    BitBlt PicView2.hDC, 0, 0, PicView1.ScaleWidth, PicView1.ScaleHeight, PicView1.hDC, 0, 0, vbSrcCopy
    BrightnessBits PicView2, 200
    PicView2.Refresh
    ScrollSize
    Me.MousePointer = vbDefault
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrSave
    CDlgSave.ShowSave
    SavePicture PicView2.Picture, CDlgSave.FileName
    On Error GoTo 0
    Exit Sub
    
ErrSave:
    If Err.Number = cdlCancel Then
    Else
        MsgBox Err.Description, vbCritical, Err.Number
    End If
End SubPicView1,PicView2均为PictureBox ,AutoRedrew为True
保存时出现无效属性值