View Full Version : برنامه نوسی در VB6 برای پردازش تصاویر
  
mehdad.koulab
سه شنبه 27 فروردین 1387, 11:01 صبح
سلام به همه سوال من اینکه آیا در VB6 میشه برنامه ای برای پردازش تصاویر (کاهش نویز موجود در تصویر) نوشت و چطور تو کد نویسی این برنامه موندم نمیدونم چیکار کنم لطفاً کمکم کنین با تشکر. این ایمیل من mehdad_koulab@yahoo.com
Kourosh_Wise
پنج شنبه 29 فروردین 1387, 18:32 عصر
اول باید الگوریتمهای کاهش  نویز مثل Gaussian,Median, و غیره رو بدونی بعد هم تبدیل این فرمولهای سنگین ریاضی به کد vb  است که قابل انجامه در ضمن فرمت تصاویر bmp رو هم از تو msdn میتونی پیدا کنی
هم اینطور تبدیلات  Laplacian,sobel ,YCC-RGB,RGB-YUV,FFT که از اصول اولیه پردازش تصویره رو میتونی تو اینترنت پیدا کنی-
mehdad.koulab
پنج شنبه 29 فروردین 1387, 22:53 عصر
ممنون از کورش جان ولی این الگوریتم هایی که اول گفتی از کجا میتونم به دست بیارم
H4i0 ACP
جمعه 30 فروردین 1387, 02:01 صبح
اول باید الگوریتمهای کاهش  نویز مثل Gaussian,Median, و غیره رو بدونی بعد هم تبدیل این فرمولهای سنگین ریاضی به کد vb  است که قابل انجامه در ضمن فرمت تصاویر bmp رو هم از تو msdn میتونی پیدا کنی
هم اینطور تبدیلات  Laplacian,sobel ,YCC-RGB,RGB-YUV,FFT که از اصول اولیه پردازش تصویره رو میتونی تو اینترنت پیدا کنی-
------------------------------------------------------------------------------------------------------
سلام دوست عزیز
نوشتن اینجور برنامه ای سخته ولی خیلی حال می ده ............
این کد یه قسمت کوچیک از یه ماژوله پیرامون همین موضوع :
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Type tOffset
   x As Long
   y As Long
   bUse As Boolean
End Type
Private m_cDib As cDIBSection256
Private m_cDibLast As cDIBSection256
Private m_tNeighbourOffset(0 To 8) As tOffset
Private m_lWidth As Long
Private m_lHeight As Long
Private m_lStates As Long
Private m_lInfectionRate As Long
Private m_lWeighting1 As Long
Private m_lWeighting2 As Long
Private m_lColorLight As Long
Private m_lColorDark As Long
Public Property Get ColorDark() As OLE_COLOR
   ColorDark = m_lColorDark
End Property
Public Property Let ColorDark(ByVal lColor As OLE_COLOR)
   m_lColorDark = lColor
   States = m_lStates
End Property
Public Property Get ColorLight() As OLE_COLOR
   ColorLight = m_lColorLight
End Property
Public Property Let ColorLight(ByVal lColor As OLE_COLOR)
   m_lColorLight = lColor
   States = m_lStates
End Property
Public Property Get States() As Long
   States = m_lStates
End Property
Public Property Let States(ByVal lStates As Long)
   
   m_lStates = lStates
   ReDim lColor(0 To States) As Long
   Dim i As Long
   Dim rS As Long, gS As Long, bS As Long
   Dim rE As Long, gE As Long, bE As Long
   rS = m_lColorDark And &HFF&
   gS = (m_lColorDark And &HFF00&) \ &H100&
   bS = (m_lColorDark And &HFF0000) \ &H10000
   rE = m_lColorLight And &HFF&
   gE = (m_lColorLight And &HFF00&) \ &H100&
   bE = (m_lColorLight And &HFF0000) \ &H10000
   For i = 0 To States
      lColor(i) = RGB( _
         rS + (i * (rE - rS)) \ States, _
         gS + (i * (gE - gS)) \ States, _
         bS + (i * (bE - bS)) \ States _
         )
   Next i
   m_cDib.SetPalette lColor
   m_cDibLast.SetPalette lColor
   
End Property
Public Property Get Width() As Long
   Width = m_lWidth
End Property
Public Property Let Width(ByVal lWidth As Long)
   m_lWidth = lWidth
End Property
Public Property Get Height() As Long
   Height = m_lHeight
End Property
Public Property Let Height(ByVal lHeight As Long)
   m_lHeight = lHeight
End Property
Public Sub Init()
   If Not (m_lWidth = m_cDib.Width) Or Not (m_lHeight = m_cDib.Height) Then
      m_cDib.Create m_lWidth, m_lHeight
      m_cDibLast.Create m_lWidth, m_lHeight
   End If
   AddRandom 100
   m_cDibLast.PaintPicture m_cDib.hdc
End Sub
Public Sub Paint( _
      ByVal lHDC As Long, _
      Optional ByVal lLeft As Long = 0, _
      Optional ByVal lTop As Long = 0 _
   )
   m_cDib.PaintPicture lHDC, lLeft, lTop, m_lWidth, m_lHeight
End Sub
Public Sub AddRandom(ByVal lPercent As Long)
Dim tSALast As SAFEARRAY2D
Dim bDibLast() As Byte
Dim x As Long
Dim y As Long
   lPercent = 100 - lPercent
   
   With tSALast
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = m_cDibLast.Height
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = m_cDibLast.BytesPerScanLine()
       .pvData = m_cDibLast.DIBSectionBitsPtr
   End With
   CopyMemory ByVal VarPtrArray(bDibLast()), VarPtr(tSALast), 4
   For x = 0 To m_cDib.Width - 1
      For y = 0 To m_cDib.Height - 1
         If (Rnd * 100 > lPercent) Then
            bDibLast(x, y) = Rnd * m_lStates
         End If
      Next y
   Next x
   CopyMemory ByVal VarPtrArray(bDibLast), 0&, 4
End Sub
Public Sub Step()
Dim x As Long
Dim y As Long
Dim tSALast As SAFEARRAY2D
Dim tSA As SAFEARRAY2D
Dim bDibLast() As Byte
Dim bDibNext() As Byte
Dim lOldStateInc As Long
Dim i As Long
Dim j As Long
Dim lOffset As Long
Dim infectedNeighbours As Long
Dim illNeighbours As Long
Dim neighbouringSickness As Long
Dim newState As Long
   
   With tSALast
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = m_cDibLast.Height
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = m_cDibLast.BytesPerScanLine()
       .pvData = m_cDibLast.DIBSectionBitsPtr
   End With
   CopyMemory ByVal VarPtrArray(bDibLast()), VarPtr(tSALast), 4
   With tSA
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = m_cDib.Height
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = m_cDib.BytesPerScanLine()
       .pvData = m_cDib.DIBSectionBitsPtr
   End With
   CopyMemory ByVal VarPtrArray(bDibNext()), VarPtr(tSA), 4
   For x = 0 To m_cDib.Width - 1
      For y = 0 To m_cDib.Height - 1
         
         infectedNeighbours = 0
         illNeighbours = 0
         neighbouringSickness = bDibLast(x, y)
         
         For lOffset = 0 To 8
            If (m_tNeighbourOffset(lOffset).bUse) Then
            
               i = x + m_tNeighbourOffset(lOffset).x
               If (i < 0) Then i = m_cDib.Width - 1
               If (i >= m_cDib.Width) Then i = 0
               j = y + m_tNeighbourOffset(lOffset).y
               If (j < 0) Then j = m_cDib.Height - 1
               If (j >= m_cDib.Height) Then j = 0
                  
               If (bDibLast(i, j) < m_lStates) Then
                  If (bDibLast(i, j) > 0) Then
                     infectedNeighbours = infectedNeighbours + 1
                  End If
               Else
                  illNeighbours = illNeighbours + 1
               End If
               neighbouringSickness = neighbouringSickness + bDibLast(i, j)
               
            End If
         Next lOffset
         
         If (bDibLast(x, y) > 0) Then
            infectedNeighbours = infectedNeighbours + 1
         End If
         If (bDibLast(x, y) = 0) Then
            bDibNext(x, y) = infectedNeighbours / m_lWeighting1 + illNeighbours / m_lWeighting2
         ElseIf (bDibLast(x, y) > 0 And bDibLast(x, y) < m_lStates) Then
            newState = (neighbouringSickness \ infectedNeighbours) + m_lInfectionRate
            If (newState > m_lStates) Then
               newState = m_lStates
            End If
            bDibNext(x, y) = newState
         ElseIf (bDibLast(x, y) = m_lStates) Then
            bDibNext(x, y) = 0
         End If
         
      Next y
   Next x
   
   m_cDib.PaintPicture m_cDibLast.hdc
   CopyMemory ByVal VarPtrArray(bDibNext), 0&, 4
   CopyMemory ByVal VarPtrArray(bDibLast), 0&, 4
End Sub
Public Property Get InfectionRate() As Long
   InfectionRate = m_lInfectionRate
End Property
Public Property Let InfectionRate(ByVal lRate As Long)
   m_lInfectionRate = lRate
End Property
Public Property Get WeightingParameter1() As Long
   WeightingParameter1 = m_lWeighting1
End Property
Public Property Let WeightingParameter1(ByVal lWeight As Long)
   m_lWeighting1 = lWeight
End Property
Public Property Get WeightingParameter2() As Long
   WeightingParameter2 = m_lWeighting2
End Property
Public Property Let WeightingParameter2(ByVal lWeight As Long)
   m_lWeighting2 = lWeight
End Property
Public Property Get ConsiderNeighbour(ByVal xOffset As Long, ByVal yOffset As Long) As Boolean
Dim i As Long
   For i = 0 To 8
      If (m_tNeighbourOffset(i).x = xOffset) And (m_tNeighbourOffset(i).y = yOffset) Then
         ConsiderNeighbour = m_tNeighbourOffset(i).bUse
         Exit For
      End If
   Next i
End Property
Public Property Let ConsiderNeighbour(ByVal xOffset As Long, ByVal yOffset As Long, ByVal bState As Boolean)
Dim i As Long
Dim iFirstFree As Long
   
   iFirstFree = -1
   For i = 0 To 8
      If (m_tNeighbourOffset(i).x = xOffset) And (m_tNeighbourOffset(i).y = yOffset) Then
         m_tNeighbourOffset(i).bUse = bState
         Exit Property
      Else
         If (m_tNeighbourOffset(i).x = 0) And (m_tNeighbourOffset(i).y = 0) Then
            iFirstFree = i
         End If
      End If
   Next i
   
   With m_tNeighbourOffset(iFirstFree)
      .x = xOffset
      .y = yOffset
      .bUse = bState
   End With
      
End Property
Private Sub Class_Initialize()
   
   m_lColorDark = RGB(22, 32, 64)
   m_lColorLight = RGB(90, 128, 255)
   
   m_lStates = 64
   m_lInfectionRate = 4
   m_lWeighting1 = 2
   m_lWeighting2 = 3
   
   m_lWidth = 256
   m_lHeight = 256
   With m_tNeighbourOffset(0)
      .x = 0
      .y = -1
   End With
   With m_tNeighbourOffset(1)
      .x = -1
      .y = 0
   End With
   With m_tNeighbourOffset(2)
      .x = 1
      .y = 0
   End With
   With m_tNeighbourOffset(3)
      .x = 0
      .y = 1
   End With
   Dim i As Long
   For i = 0 To 8
      m_tNeighbourOffset(i).bUse = (i <= 3)
   Next i
      
   
   Set m_cDib = New cDIBSection256
   Set m_cDibLast = New cDIBSection256
   Init
   States = m_lStates
End Sub
mehdad.koulab
جمعه 06 اردیبهشت 1387, 00:07 صبح
سلام اگه کسی در باره سوالی که دارم برنامه نوشته شده ای در VB داره ممنون می شم بذاره البته با سورس برنامه با تشکر از همه
H4i0 ACP
جمعه 06 اردیبهشت 1387, 02:37 صبح
سلام
ttp://barnamenevis.org/forum/showthread.php?t=103089&page=10 (http://barnamenevis.org/forum/showthread.php?t=103089&page=10)
mehdad.koulab
پنج شنبه 12 اردیبهشت 1387, 10:20 صبح
سلام و با تشکر از همه دوستان که به من کمک می کنن اگه براتون ممکنه کد هایی که در شکل زیر باید برایCommand بنویسم لطفا بذارین تو سایت
mehdad.koulab
پنج شنبه 19 اردیبهشت 1387, 16:26 عصر
سلام دیگه گیج شدم نمی دونم چیکار باید کنم کمکم کنین فقط این دو تا مونده ( شکل بالا )
mehdad.koulab
پنج شنبه 19 اردیبهشت 1387, 20:56 عصر
بازم سلام ببخشید شاید من سوالم رو تا حالا درست مطرح نکردم تو شکل بالا من میخوام وقتی cmd کاهش نویز زدم تصویر 1 به تصویر 2 تبدیل بشه و وقتی cmd افزایش نویز رو زدم تصویر 2 به تصویر 1 تبدیل بشه البته تصویر اصلی تصویر شماره 1 است حالا اگه میتونین کمکم کنین. اگه باید به جای ImageBox چیز دیگری بذارم بگین تا عوض کنم عکسها رو گذاشتم لطفا بردارید.
mehdad.koulab
چهارشنبه 25 اردیبهشت 1387, 12:44 عصر
سلام به همه موندم چیکار کنم یه سوال دارم آیا میشه از فیلتر ها برای این کار استفاده کرد اگه می شه چجوری اگه سورس این رو دارین ممنون می شم بذارین با تشکر از همه mehdad_koulab@yahoo.com
ali_habibi1384
پنج شنبه 26 اردیبهشت 1387, 18:24 عصر
h4i0 Acp بهتر بود مطلبتون رو توی یه فایل می فرستادید.
کار پردازش تصویر بیشتر مربوط میشه به هوش مصنوعی فکر میکنم اگر اونجا مبحث تون رو بگین زودتر به نتیجه برسین.
برای کار کد نویسیش میتونین از توابع point , getpixcel  استفاده کنید.
mehdad.koulab
پنج شنبه 02 خرداد 1387, 18:21 عصر
سلام تور و خدا کمکم کنین هر کاری می کنم درست در نمیاد
 
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.