PDA

View Full Version : مشکل در ویرایش تصویر



ameri110
یک شنبه 06 تیر 1389, 12:03 عصر
سلام
این برنامه رو ببینید
کارش اینه که پیکسل های سیاه تصویر رو سیاه تر می کنه
اما مشکلش اینه که خط بعد نمیره

مصطفی ساتکی
یک شنبه 06 تیر 1389, 12:31 عصر
اما مشکلش اینه که خط بعد نمیره
خط بعد نمی ره یعنی چه .یه خورده واضح تر توضیح بدید .

ameri110
یک شنبه 06 تیر 1389, 13:02 عصر
یک سری پیکسل داریم که در ردیف ها و ستون ها قرار گرفتن
اینبرنامه فقط ردیف اول پیکسل ها رو ویرایش می کنه و سراغ ردیف بعدی نمیره

مصطفی ساتکی
یک شنبه 06 تیر 1389, 14:21 عصر
اینبرنامه فقط ردیف اول پیکسل ها رو ویرایش می کنه و سراغ ردیف بعدی نمیرهعزیز جان اون تکیه کدی که داره این عملیات پیمایش رو انجام میده قرار بده اینجا .این مطلب رو تو پست قبلیت هم گفتی نیاز به تکرار نبود

ameri110
یک شنبه 06 تیر 1389, 14:33 عصر
فایل رو که ضمیمه کردم دیگه

مصطفی ساتکی
یک شنبه 06 تیر 1389, 21:57 عصر
فایل رو که ضمیمه کردم دیگه
سرعت اینترنتم انقدر بالا نیست که دم به دقیقه برای هر چیزی فایا دانلود کنم برای پیشبرد کار خودتون گفتم

ameri110
یک شنبه 06 تیر 1389, 22:34 عصر
226 کیلو بایت بیشتر نیست که
این هم کد:

Private Sub Command1_Click()
Do
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long

'entekhabe pixel
Color = Picture1.Point(txt_x.Text, txt_y.Text)
'-------------------------
'bedast avardane meghdare RGB pixel be komak Module1
R = ExtractR(Color)
G = ExtractG(Color)
B = ExtractB(Color)
txt_R = R
txt_B = B
txt_G = G
'-------------------------
'siah tar kardan e pixel haie siah
If ExtractR(Color) < 200 Then
If ExtractG(Color) < 200 Then
If ExtractB(Color) < 200 Then
Picture2.PSet (txt_x.Text, txt_y.Text), RGB(0, 0, 0)
End If
End If
End If
'-------------------------
'taeene pixele ba'di
If txt_x.Text < Picture1.ScaleWidth Then
txt_x.Text = txt_x.Text + 1
End If
If txt_x.Text = Picture1.ScaleWidth Then
txt_y.Text = txt_y.Text + 1
txt_x.Text = 1
End If
Loop Until txt_y.Text = txt_total_y.Text
End Sub

Private Sub Form_Load()
txt_total_x.Text = Picture1.ScaleWidth
txt_total_y.Text = Picture1.ScaleHeight
End Sub

Private Sub Timer1_Timer()
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long
Color = Picture1.Point(txt_x.Text, txt_y.Text)
R = ExtractR(Color)
G = ExtractG(Color)
B = ExtractB(Color)
txt_R = R
txt_B = B
txt_G = G
If ExtractR(Color) < 200 Then
If ExtractG(Color) < 200 Then
If ExtractB(Color) < 200 Then
Picture1.PSet (txt_x.Text, txt_y.Text), RGB(0, 0, 0)
End If
End If
End If
If txt_x.Text < Picture1.ScaleWidth Then
txt_x.Text = txt_x.Text + 1
End If
If txt_x.Text = Picture1.ScaleWidth Then
txt_y.Text = txt_x.Text + 1
txt_x.Text = 1
End If
End Sub

من بعید میدونم شما آخرش هم جواب بدی

parselearn
دوشنبه 07 تیر 1389, 01:03 صبح
برنامه شما كار ميكنه اما با كمي تغييرات:
1- اضافه كردن دستور DoEvents به داخل دستور Do


Do
DoEvents


2- قرار دادن ScaleMode برابر vbPixels (براي سرعت بيشتر)


Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels


3- تغيير خاصيت AutoRedraw پيك2 به True

اشكالات
1- سرعت پايين (راه حلي ندارم)
2- برنامه بسته نميشه = متغييري را به عنوان شرط خروج از حلقه Do Loop Until قرار دهيد

xxxxx_xxxxx
دوشنبه 07 تیر 1389, 02:02 صبح
برای سرعت پایین برنامه، سعی کنید بجای اینکه مقادیر رو به TextBox ها پاس بدید، از متغیر استفاده کنید. تخصیص مقدار به TextBox ها در اینگونه مواقع بسیاز زمانبر هست.

توابعی که در ماژول نوشته اید را بی جهت فراخوانی نکنید، شما یک بار خروجی این توابع را در سه متغیر R، G و B قرار داده اید، اما باز در هر سه شرط مجدداً آنها را فراخوانی کرده اید که کار بیهوده ای هست و می تونید از همان مقادیر قبلی استفاده کنید.

هر سه تا شرط که پشت سر هم قرار دارند، و تو در تو هستند را به یک IF تبدیل کنید و بین شرط ها از And استفاده کنید.

DoEvents را با یک شرط اجرا کنید، مثلاً هر بار که یک سطر رنگ میشه، یک بار DoEvents اجرا بشه. اگر DoEvents به ازای هر پیکسلی که رسم میشه اجرا بشه، در کاهش سرعت برنامه بسیار اثر گذار هست.

چرا همه این کارها هم داره توی تایمر انجام میشه و هم در داخل حلقه ای که در Command نوشته شده؟!!!

ameri110
دوشنبه 07 تیر 1389, 08:06 صبح
تایمر رو اول برای تست استفاده کرده بودم و الان غیر فعاله

DoEvents را با یک شرط اجرا کنید، مثلاً هر بار که یک سطر رنگ میشه، یک بار DoEvents اجرا بشه. اگر DoEvents به ازای هر پیکسلی که رسم میشه اجرا بشه، در کاهش سرعت برنامه بسیار اثر گذار هست.
متاسفانه این قسمت رو متوجه نشدم
اگه یه مثال بزنید خیلی ممنون میشم

parselearn
دوشنبه 07 تیر 1389, 10:04 صبح
منظور دوستمون اينجاست:
هر بار كه به انتها ميرسه از نظر طولي اين شرط True ميشه



If txt_x.Text >= Picture1.ScaleWidth Then
txt_y.Text = txt_y.Text + 1
txt_x.Text = 1
DoEvents
End If

تاثيرشم خوب بود

ameri110
دوشنبه 07 تیر 1389, 16:31 عصر
خیلی ممنون
سرعتش خیلی عالی شد
اما وقتی برمامه رو مینیممایز می کنم تصویر پاک میشه مثلا وقتی میام تو فایر فاکس بعد می بینم که پیکچر 2 سفید شده
چی کار کنم :افسرده: :متفکر:

parselearn
دوشنبه 07 تیر 1389, 16:39 عصر
3- تغيير خاصيت AutoRedraw پيك2 به True

ameri110
دوشنبه 07 تیر 1389, 17:20 عصر
خیلی ممنون از راهنمایی
با این راهنمایی هایی که کردین تونستم زمان انجام عملیات رو از حدود 36 ثانیه به کمتر از 4 ثانیه برسونم
این هم کدش شاید براتون جالب باشه:

Private Sub Command1_Click()
Do
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long
'entekhabe pixel
Color = Picture1.Point(xval, yval)
'-------------------------
'bedast avardane meghdare RGB pixel be komak Module1
R = ExtractR(Color)
G = ExtractG(Color)
B = ExtractB(Color)
'-------------------------
'siah tar kardan e pixel haie siah
If R < 200 And B < 200 And G < 200 Then
Picture2.PSet (xval, yval), RGB(0, 0, 0)
End If
'-------------------------
'taeene pixele ba'di
If xval < Picture1.ScaleWidth Then
xval = xval + 1
End If
If xval >= Picture1.ScaleWidth Then
yval = yval + 1
xval = 1
DoEvents
If yval = Picture1.ScaleHeight Then
MsgBox ("Finished")
End If
End If
Loop Until yval = Picture1.ScaleHeight
End Sub

Private Sub Form_Load()
Dim xval As Long
Dim yval As Long
Dim txval As Long
Dim tyval As Long
xval = 1
yval = 1
txval = Picture1.ScaleWidth
tyval = Picture1.ScaleHeight
End Sub

parselearn
دوشنبه 07 تیر 1389, 17:33 عصر
شما چند تا اشتباه در كد نويسي داريد

به نظر شما متغير yval در متد Command1_Click با Form_Load يكي هست
نه يكي نيست

متغير داخل Form_Load از نوع Long
متغير داخل Command1_Click از نوع Variant

شما بايد متغير رو در قسمت General تعريف كنيد
(بالاي صفحه كدنويسي)

از متغير txval و tyval استفاده نكرديد

ameri110
دوشنبه 07 تیر 1389, 19:45 عصر
این درسته؟:

Dim xval As Long
Dim yval As Long
Dim txval As Long
Dim tyval As Long

Private Sub Command1_Click()
Do
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long
'entekhabe pixel
Color = Picture1.Point(xval, yval)
'-------------------------
'bedast avardane meghdare RGB pixel be komak Module1
R = ExtractR(Color)
G = ExtractG(Color)
B = ExtractB(Color)
'-------------------------
'siah tar kardan e pixel haie siah
If R < 200 And B < 200 And G < 200 Then
Picture2.PSet (xval, yval), RGB(0, 0, 0)
End If
'-------------------------
'taeene pixele ba'di
If xval < txval Then
xval = xval + 1
End If
If xval >= txval Then
yval = yval + 1
xval = 1
DoEvents
If yval = tyval Then
MsgBox ("Finished")
End If
End If
Loop Until yval = tyval
End Sub

Private Sub Form_Load()
xval = 1
yval = 1
txval = Picture1.ScaleWidth
tyval = Picture1.ScaleHeight
End Sub

parselearn
دوشنبه 07 تیر 1389, 20:15 عصر
بله درسته
مساله ديگر كه يادم رفته بود

متغيرها داخل لوپ تعريف شدند


do
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long

ameri110
دوشنبه 07 تیر 1389, 20:31 عصر
اشالا این دفعه درسته دیگه نه ؟ :لبخند:

Dim xval As Long
Dim yval As Long
Dim txval As Long
Dim tyval As Long
Dim R As Byte, G As Byte, B As Byte
Dim Color As Long

Private Sub Command1_Click()
Do
'entekhabe pixel
Color = Picture1.Point(xval, yval)
'-------------------------
'bedast avardane meghdare RGB pixel be komak Module1
R = ExtractR(Color)
G = ExtractG(Color)
B = ExtractB(Color)
'-------------------------
'siah tar kardan e pixel haie siah
If R < 200 And B < 200 And G < 200 Then
Picture2.PSet (xval, yval), RGB(0, 0, 0)
End If
'-------------------------
'taeene pixele ba'di
If xval < txval Then
xval = xval + 1
End If
If xval >= txval Then
yval = yval + 1
xval = 1
DoEvents
If yval = tyval Then
MsgBox ("Finished")
End If
End If
Loop Until yval = tyval
End Sub

Private Sub Form_Load()
xval = 1
yval = 1
txval = Picture1.ScaleWidth
tyval = Picture1.ScaleHeight
End Sub
آخه نمیدونم چرا قبلا وقتی میوردم بیرون ارور می داد :|
حالا زمان به 3 ثانیه رسید یعنی یک دوازدهم
خیلی ممنون

راستی اگه بشه یه کاری کرد که موس قفل بشه (روی صفحه کلیک نکنه) خیلی خوبه چون اگه کلیک کنم هنگ می کنه
(آپدیت: هنگ نمی کنه :لبخند:)

مصطفی ساتکی
سه شنبه 08 تیر 1389, 07:37 صبح
من بعید میدونم شما آخرش هم جواب بدی دوست عزیز برای اینکار تو زمینه OMR نیازی ندارید که به این صورت brightness تصویر رو کاهش بدید این فاز بعنوان فاز threshold که شما بایستی از روش های استانداری که وجود داره استفاده کنید. این کدی که شما نوشتید نشون میده که تجربتون تو برنامه نویسی خیلی کمه و شما به تمرین زیادی نیاز دارید . شما مقدار مربوط به کنترل ها رو مستقیم در پروسه اصلیتون دریافت می کنید. تو پروسه اصلی کارتون دارید از کنترل image استفاده می کنید . شما بایستی این کار رو تو حافظه انجام بدید و سپس نتیجه کار رو به dc مربوطه کپی کنید. برای اینکار بایستی از روش scanline یا pointer استفاده کنید.در ضمن برای این دست کار توابع setpixel , getpixel به شدت کند هستند و مخصوصاً شما هم که هر بار در پروسه اصلیتون ExtractR و ... رو هم استفاده می کنید و قتی که با pointer کار می کنید نیاز به extract رنگ ها به این صورت ندارید چون برای هر رنگ شما 3 برابر دارید function فراخوانی می کنید این function به صورت inline هم پیاده سازی شده باشه باز هم افت زمان زیادی خواهید داشت د .برای همچین عکسی که شما قرار دارید زمان 3 ثانیه زمان خیلی زیادی که تو این زمان میشه یه صفحه a4 پر نوشته رو OCR کرد

vahid3vahid
چهارشنبه 09 تیر 1389, 11:54 صبح
شما به بزرگی خودت ببخشش!