نمایش نتایج 1 تا 1 از 1

نام تاپیک: در مورد کدها راهنماییم کنین

  1. #1
    کاربر دائمی آواتار mehdad.koulab
    تاریخ عضویت
    فروردین 1387
    محل زندگی
    تبریز
    پست
    345

    در مورد کدها راهنماییم کنین

    سلام دوستان در مورد کدهای زیر که درمورد فیلتر پردازش تصویر است یه توضیحی به من بدین. دقیق نمیدونم چیکار میکنن. اگه حوصلتون نکشید اینجا بخونین فایلرو گذاشتم. با تشکر

    Option Explicit
    Public Enum enmFilter
    conFltBlacknWhite = 0
    conFltBlur = 1
    conFltBrightness = 2
    conFltCrease = 3
    conFltDarkness = 4
    conFltDiffuse = 5
    conFltEmboss = 6
    conFltGrayBlacknWhite = 7
    conFltGrayscale = 8
    conFltInvertColors = 9
    conFltReplaceColors = 10
    conFltSharpen = 11
    conFltSnow = 12
    conFltWave = 13
    End Enum
    'Properties for "replace color" filter
    Public lngReplacedColor As Long
    Public lngReplaceWithColor As Long
    Public Sub ApplyFilter(intFilter As enmFilter, ByRef pic As PictureBox, _
    Optional X1 As Long = -1, Optional Y1 As Long = -1, _
    Optional X2 As Long = -1, Optional Y2 As Long = -1)
    Dim blnSmallArea As Boolean 'Condition whether the filter operation
    ' only be applied to small area
    Dim intDrawMode As Integer 'to keep current draw mode value
    Dim lngColor() As Long 'three dimensions array to save RGB color (first
    ' dimension: R = 0, G = 1, B = 2) of
    ' (X,Y) coordinate (second and third dimensions)
    Dim lngReadColor As Long 'current color readed
    Dim lngTransColor As Long 'color transformation factor
    Dim lngWriteColor As Long 'current color written
    Dim R As Long 'current RGB
    Dim G As Long ' color
    Dim B As Long 'information
    Dim sngFilterFactor As Single
    Dim X As Long 'current coordinate
    Dim Y As Long ' pixel processed



    If (X1 = -1) And (Y1 = -1) And (X2 = -1) And (Y2 = -1) Then
    X1 = 0
    Y1 = 0
    X2 = pic.ScaleWidth
    Y2 = pic.ScaleHeight
    End If
    blnSmallArea = (((X2 - X1) * (Y2 - Y1)) < (16 * 16))
    With pic
    intDrawMode = .DrawMode
    .DrawMode = vbCopyPen
    Select Case intFilter
    Case conFltBlacknWhite
    sngFilterFactor = 192 'increase this value to get more black colors
    ' than white colors or decrease it to get
    ' more white colors than black colors
    ' 0 for total white and 256 for total black)
    For X = X1 To X2
    For Y = Y1 To Y2
    lngReadColor = mdlAPI.GetPixel(hDC:=.hDC, X:=X, Y:=Y)
    R = lngReadColor Mod 256
    If (R >= sngFilterFactor) Then
    lngWriteColor = vbWhite
    Else
    G = (lngReadColor \ 256) Mod 256
    If (G >= sngFilterFactor) Then
    lngWriteColor = vbWhite
    Else
    B = (lngReadColor \ 256) \ 256
    If (B >= sngFilterFactor) Then
    lngWriteColor = vbWhite
    Else
    lngWriteColor = vbBlack
    End If
    End If
    End If
    mdlAPI.SetPixel hDC:=.hDC, X:=X, Y:=Y, crColor:=lngWriteColor
    Next
    If Not blnSmallArea Then
    pic.Refresh

    End If
    Next
    Case conFltBlur
    sngFilterFactor = 10 'decrease this value to get more bright blur
    ' or increase it to get more dark blur
    ' (limit to 0 for total white and
    ' 256 for total black
    RetrieveColorInformation pic:=pic, lngColor:=lngColor, _
    X1:=X1, Y1:=Y1, X2:=X2, Y2:=Y2, _
    blnShowProgress:=(Not blnSmallArea)
    For X = X1 + 1 To X2 - 1
    For Y = Y1 + 1 To Y2 - 1
    R = lngColor(0, X - 1, Y - 1) + lngColor(0, X, Y - 1) + _
    lngColor(0, X + 1, Y - 1) + lngColor(0, X - 1, Y) + _
    lngColor(0, X, Y) + lngColor(0, X + 1, Y) + _
    lngColor(0, X - 1, Y + 1) + lngColor(0, X, Y + 1) + _
    lngColor(0, X + 1, Y + 1)
    G = lngColor(1, X - 1, Y - 1) + lngColor(1, X, Y - 1) + _
    lngColor(1, X + 1, Y - 1) + lngColor(1, X - 1, Y) + _
    lngColor(1, X, Y) + lngColor(1, X + 1, Y) + _
    lngColor(1, X - 1, Y + 1) + lngColor(1, X, Y + 1) + _
    lngColor(1, X + 1, Y + 1)
    B = lngColor(2, X - 1, Y - 1) + lngColor(2, X, Y - 1) + _
    lngColor(2, X + 1, Y - 1) + lngColor(2, X - 1, Y) + _
    lngColor(2, X, Y) + lngColor(2, X + 1, Y) + _
    lngColor(2, X - 1, Y + 1) + lngColor(2, X, Y + 1) + _
    lngColor(2, X + 1, Y + 1)
    lngWriteColor = RGB(Abs(R / sngFilterFactor), _
    Abs(G / sngFilterFactor), _
    Abs(B / sngFilterFactor))
    mdlAPI.SetPixel hDC:=.hDC, X:=X, Y:=Y, crColor:=lngWriteColor
    Next
    If Not blnSmallArea Then
    pic.Refresh

    End If
    Next
    Case conFltBrightness, conFltDarkness
    Select Case intFilter
    Case conFltBrightness
    If Not blnSmallArea Then
    sngFilterFactor = 32 'decrease this value to make more bright or
    ' increase it to make less bright
    ' (limit to 0 for total white and
    ' 256 for no brightness)
    Else
    sngFilterFactor = 2
    End If
    Case conFltDarkness
    If Not blnSmallArea Then
    sngFilterFactor = -32 'decrease this value to make more dark or
    ' increase it to make less dark
    ' (-256 for inverting colors and
    ' limit to for no darkness)
    Else
    sngFilterFactor = -2
    End If
    End Select
    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
    lngWriteColor = RGB(Abs(R + sngFilterFactor), _
    Abs(G + sngFilterFactor), _
    Abs(B + sngFilterFactor))
    mdlAPI.SetPixel hDC:=.hDC, X:=X, Y:=Y, crColor:=lngWriteColor

    Next
    If Not blnSmallArea Then
    pic.Refresh

    End If
    Next
    Case conFltCrease, conFltWave
    Select Case intFilter
    Case conFltCrease
    sngFilterFactor = 512 'decrease this value to get more crease or
    ' increase it to get less crease
    ' (64 for maximum crease and
    ' 65536 for no crease)
    Case conFltWave
    sngFilterFactor = 4 'increase this value to get more wave or
    ' decrease it to get less wave
    ' (0 for no wave and 16 for maximum wave)
    End Select
    RetrieveColorInformation pic:=pic, lngColor:=lngColor, _
    X1:=X1, Y1:=Y1, X2:=X2, Y2:=Y2, blnAll:=True, _
    blnShowProgress:=(Not blnSmallArea)
    For X = X1 To X2
    For Y = Y1 To Y2
    lngWriteColor = lngColor(3, X, Y)
    mdlAPI.SetPixel hDC:=.hDC, X:=X, _
    Y:=(Sin(X) * sngFilterFactor) + (Y), _
    crColor:=lngWriteColor
    Next
    If Not blnSmallArea Then
    pic.Refresh

    End If
    Next
    Case conFltDiffuse
    sngFilterFactor = 5
    RetrieveColorInformation pic:=pic, lngColor:=lngColor, _
    X1:=X1, Y1:=Y1, X2:=X2, Y2:=Y2, blnAll:=True, _
    blnShowProgress:=(Not blnSmallArea)
    For X = X1 + 2 To X2 - 3
    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

    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

    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

    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

    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

    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

    End If
    Next
    End Select
    .DrawMode = intDrawMode
    .Refresh
    End With
    Exit Sub
    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)


    R = lngColor Mod 256
    G = (lngColor \ 256) Mod 256
    B = (lngColor \ 256) \ 256
    Exit Sub
    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



    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

    End If
    Next
    Exit Sub

    End Sub
    فایل های ضمیمه فایل های ضمیمه




قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •