mdfilter.bas

VB实现的串口通信操作界面

          For Y = Y1 + 2 To Y2 - 3
            lngReadColor = lngColor(3, X, Y + Int((Rnd * sngFilterFactor) - 2))
            R = Abs(lngReadColor Mod 256)
            lngReadColor = lngColor(3, X + Int((Rnd * sngFilterFactor) - 2), Y)
            G = Abs((lngReadColor \ 256) Mod 256)
            lngReadColor = lngColor(3, X + Int((Rnd * sngFilterFactor) - 2), _
                                       Y + Int((Rnd * sngFilterFactor) - 2))
            B = Abs((lngReadColor \ 256) \ 256)
            lngWriteColor = RGB(Red:=R, Green:=G, Blue:=B)
            mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                                     intPercentage:=(((X + 3) * 100) \ X2)
          End If
        Next
      Case conFltEmboss
        sngFilterFactor = -128      'increase this abs(value) to get more bright
                                    ' emboss decrease it to get more dark emboss
                                    '             (0 for maximum dark emboss and
                                    '              256 for maximum bright emboss
        RetrieveColorInformation pic:=pic, lngColor:=lngColor, _
                                 X1:=X1, Y1:=Y1, X2:=X2, Y2:=Y2, _
                                 blnShowProgress:=(Not blnSmallArea)
        For X = X1 To X2 - 1
          For Y = Y1 To Y2 - 1
            R = Abs(lngColor(0, X, Y) - lngColor(0, X + 1, Y + 1) + _
                    sngFilterFactor)
            G = Abs(lngColor(1, X, Y) - lngColor(1, X + 1, Y + 1) + _
                    sngFilterFactor)
            B = Abs(lngColor(2, X, Y) - lngColor(2, X + 1, Y + 1) + _
                    sngFilterFactor)
            lngWriteColor = RGB(Red:=R, Green:=G, Blue:=B)
            mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                                     intPercentage:=(((X + 1) * 100) \ X2)
          End If
        Next
      Case conFltGrayBlacknWhite
        sngFilterFactor = 3         'increase this value to get more black colors
                                    '      or decrase it to get more white colors
                                    '                 (limit to 0 for total white
                                    '                     and 32 for total black)
        For X = X1 To X2
          For Y = Y1 To Y2
            lngReadColor = mdlAPI.GetPixel(hdc:=.hdc, X:=X, Y:=Y)
            GetRGBColor lngColor:=lngReadColor, R:=R, G:=G, B:=B
            R = Abs(R * (G - B + G + R)) / 256
            G = Abs(R * (B - G + B + R)) / 256
            B = Abs(G * (B - G + B + R)) / 256
            lngReadColor = RGB(Red:=R, Green:=G, Blue:=B)
            GetRGBColor lngColor:=lngReadColor, R:=R, G:=G, B:=B
            lngReadColor = (R + G + B) / sngFilterFactor
            lngWriteColor = RGB(Red:=lngReadColor, _
                                Green:=lngReadColor, Blue:=lngReadColor)
            mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                                    intPercentage:=((X * 100) \ X2)
          End If
        Next
      Case conFltGrayscale
        sngFilterFactor = 0.32 'increase this value to get more bright grayscale
                               '       or decrease it to get more dark grayscale
                               '                (0 for total black and (256 / 6)
                               '                          for almost total white
        For X = X1 To X2
          For Y = Y1 To Y2
            lngReadColor = mdlAPI.GetPixel(hdc:=.hdc, X:=X, Y:=Y)
            GetRGBColor lngColor:=lngReadColor, R:=R, G:=G, B:=B
            lngTransColor = Abs((R * sngFilterFactor) + _
                                (G * sngFilterFactor) + (B * sngFilterFactor))
            lngWriteColor = RGB(Red:=lngTransColor, _
                                Green:=lngTransColor, Blue:=lngTransColor)
            mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                            intPercentage:=((X * 100) \ X2)
          End If
        Next
      Case conFltReplaceColors
        For X = X1 To X2
          For Y = Y1 To Y2
            lngReadColor = mdlAPI.GetPixel(hdc:=.hdc, X:=X, Y:=Y)
            If lngReadColor = lngReplacedColor Then
              lngWriteColor = lngReplaceWithColor
              mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
            End If
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                                     intPercentage:=((X * 100) \ X2)
          End If
        Next
      Case conFltSharpen, conFltSnow
        Select Case intFilter
          Case conFltSharpen
            sngFilterFactor = 0.5        'increase this value to get more sharp
                                         '     or decrease it to get less sharp
                                         '                (0 for no sharpen and
                                         '               2 for maximum sharpen)
          Case conFltSnow
            sngFilterFactor = 24          'increase this value to get more snow
                                          '     or decrease it to get less snow
                                          '            (4 for minimum snowy and
                                          '               64 for maximum snowy)
        End Select
        RetrieveColorInformation pic:=pic, lngColor:=lngColor, _
                                 X1:=X1, Y1:=Y1, X2:=X2, Y2:=Y2, _
                                 blnShowProgress:=(Not blnSmallArea)
        For X = X1 + 1 To X2
          For Y = Y1 + 1 To Y2
            R = lngColor(0, X, Y) + _
                (sngFilterFactor * _
                 (lngColor(0, X, Y) - lngColor(0, X - 1, Y - 1)))
            G = lngColor(1, X, Y) + _
                (sngFilterFactor * _
                 (lngColor(1, X, Y) - lngColor(1, X - 1, Y - 1)))
            B = lngColor(2, X, Y) + _
                (sngFilterFactor * _
                 (lngColor(2, X, Y) - lngColor(2, X - 1, Y - 1)))
            lngWriteColor = RGB(Abs(R), Abs(G), Abs(B))
            mdlAPI.SetPixel hdc:=.hdc, X:=X, Y:=Y, crColor:=lngWriteColor
          Next
          If Not blnSmallArea Then
            pic.Refresh
            frmPaint.UpdateStatusBar intInfo:=conStFiltering, _
                                     intPercentage:=((X * 100) \ X2)
          End If
        Next
    End Select
    .DrawMode = intDrawMode
    .Refresh
  End With
  Exit Sub

ErrorHandler:
  ShowErrMessage intErr:=conErrOthers, strErrMessage:=Err.Description
End Sub

' Purpose    : Get each R (red), G (green), B (blue) information color from RGB
'              color lngColor
' Assumptions: -
' Effects    : -
' Inputs     : lngColor
' Return     : R, G, B
Private Sub GetRGBColor(lngColor As Long, ByRef R As Long, _
                        ByRef G As Long, ByRef B As Long)
  On Error GoTo ErrorHandler
  
  R = lngColor Mod 256
  G = (lngColor \ 256) Mod 256
  B = (lngColor \ 256) \ 256
  Exit Sub
  
ErrorHandler:
  ShowErrMessage intErr:=conErrOthers, strErrMessage:=Err.Description
End Sub

' Purpose    : Retrieve every pixels color information in region (X1,Y1)-(X2,Y2)
'              of picture box pic and save the result to lngColor()
' Assumptions: -
' Effects    : -
' Input      : * pic
'              * X1, Y1, X2, Y2
'              * blnAll (condition whether to retrieve all color in once
'                        or seperate it in Red, Green and Blue color information
'              * blnShowProgress (condition whether it needs to refresh for
'                                 every column filtered)
' Return     : lngColor() (three dimensions array to save RGB color (first
'                          dimension: R = 0, G = 1, B = 2, All = 3) of (X,Y)
'                          coordinate (second and third dimensions))
Private Sub RetrieveColorInformation( _
              pic As PictureBox, ByRef lngColor() As Long, _
              Optional X1 As Long = -1, Optional Y1 As Long = -1, _
              Optional X2 As Long = -1, Optional Y2 As Long = -1, _
              Optional blnAll As Boolean = False, _
              Optional blnShowProgress = True _
            )
  Dim R As Long                                                     'current RGB
  Dim G As Long                                                     '      color
  Dim B As Long                                                     'information
  Dim X As Long                                              'current coordinate
  Dim Y As Long                                              '   pixel processed
  
  On Error GoTo ErrorHandler
  
  If (X1 = -1) Or (Y1 = -1) Or (X2 = -1) Or (Y2 = -1) Then
    X1 = 0
    Y1 = 0
    X2 = pic.ScaleWidth
    Y2 = pic.ScaleHeight
  End If
  If blnAll Then
    ReDim lngColor(3, X2, Y2)
  Else
    ReDim lngColor(2, X2, Y2)
  End If
  For X = X1 To X2
    For Y = Y1 To Y2
      If blnAll Then
        lngColor(3, X, Y) = mdlAPI.GetPixel(pic.hdc, X, Y)
      Else
        GetRGBColor lngColor:=mdlAPI.GetPixel(pic.hdc, X, Y), R:=R, G:=G, B:=B
        lngColor(0, X, Y) = R
        lngColor(1, X, Y) = G
        lngColor(2, X, Y) = B
      End If
    Next
    If blnShowProgress Then
      frmPaint.UpdateStatusBar intInfo:=conStRetrieveingColor, _
                               intPercentage:=((X * 100) \ X2)
    End If
  Next
  Exit Sub
  
ErrorHandler:
  ShowErrMessage intErr:=conErrOthers, strErrMessage:=Err.Description
End Sub