PDA

View Full Version : برنامه نوسی در VB6 برای پردازش تصاویر



mehdad.koulab
سه شنبه 27 فروردین 1387, 10:01 صبح
سلام به همه سوال من اینکه آیا در VB6 میشه برنامه ای برای پردازش تصاویر (کاهش نویز موجود در تصویر) نوشت و چطور تو کد نویسی این برنامه موندم نمیدونم چیکار کنم لطفاً کمکم کنین با تشکر. این ایمیل من mehdad_koulab@yahoo.com

Kourosh_Wise
پنج شنبه 29 فروردین 1387, 17:32 عصر
اول باید الگوریتمهای کاهش نویز مثل Gaussian,Median, و غیره رو بدونی بعد هم تبدیل این فرمولهای سنگین ریاضی به کد vb است که قابل انجامه در ضمن فرمت تصاویر bmp رو هم از تو msdn میتونی پیدا کنی
هم اینطور تبدیلات Laplacian,sobel ,YCC-RGB,RGB-YUV,FFT که از اصول اولیه پردازش تصویره رو میتونی تو اینترنت پیدا کنی-

mehdad.koulab
پنج شنبه 29 فروردین 1387, 21:53 عصر
ممنون از کورش جان ولی این الگوریتم هایی که اول گفتی از کجا میتونم به دست بیارم

H4i0 ACP
جمعه 30 فروردین 1387, 01: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
پنج شنبه 05 اردیبهشت 1387, 23:07 عصر
سلام اگه کسی در باره سوالی که دارم برنامه نوشته شده ای در VB داره ممنون می شم بذاره البته با سورس برنامه با تشکر از همه

H4i0 ACP
جمعه 06 اردیبهشت 1387, 01: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, 09:20 صبح
سلام و با تشکر از همه دوستان که به من کمک می کنن اگه براتون ممکنه کد هایی که در شکل زیر باید برایCommand بنویسم لطفا بذارین تو سایت

mehdad.koulab
پنج شنبه 19 اردیبهشت 1387, 15:26 عصر
سلام دیگه گیج شدم نمی دونم چیکار باید کنم کمکم کنین فقط این دو تا مونده ( شکل بالا )

mehdad.koulab
پنج شنبه 19 اردیبهشت 1387, 19:56 عصر
بازم سلام ببخشید شاید من سوالم رو تا حالا درست مطرح نکردم تو شکل بالا من میخوام وقتی cmd کاهش نویز زدم تصویر 1 به تصویر 2 تبدیل بشه و وقتی cmd افزایش نویز رو زدم تصویر 2 به تصویر 1 تبدیل بشه البته تصویر اصلی تصویر شماره 1 است حالا اگه میتونین کمکم کنین. اگه باید به جای ImageBox چیز دیگری بذارم بگین تا عوض کنم عکسها رو گذاشتم لطفا بردارید.

mehdad.koulab
چهارشنبه 25 اردیبهشت 1387, 11:44 صبح
سلام به همه موندم چیکار کنم یه سوال دارم آیا میشه از فیلتر ها برای این کار استفاده کرد اگه می شه چجوری اگه سورس این رو دارین ممنون می شم بذارین با تشکر از همه mehdad_koulab@yahoo.com

ali_habibi1384
پنج شنبه 26 اردیبهشت 1387, 17:24 عصر
h4i0 Acp بهتر بود مطلبتون رو توی یه فایل می فرستادید.
کار پردازش تصویر بیشتر مربوط میشه به هوش مصنوعی فکر میکنم اگر اونجا مبحث تون رو بگین زودتر به نتیجه برسین.
برای کار کد نویسیش میتونین از توابع point , getpixcel استفاده کنید.

mehdad.koulab
پنج شنبه 02 خرداد 1387, 17:21 عصر
سلام تور و خدا کمکم کنین هر کاری می کنم درست در نمیاد