vb6 ;استخراج عدد منسوب به هر پیکسل از یک تصویر

سلام و بهارتون خوش و خرم...
یک فایل تصویری دارم(تصویر یک قطعه زمین) که هر پیکسل از اون رنگ خاصی داره و هر رنگ عدد خاصی رو نشون میده(این عدد ارتفاع نسبی اون بخش از زمین هستش) چطور میشه تو vb6 مثلا با قرار گرفتن موس روی هر پیکسل,اون عدد خاص رو استخراج کرد؟
 

the_king

مدیرکل انجمن
سلام و بهارتون خوش و خرم...
یک فایل تصویری دارم(تصویر یک قطعه زمین) که هر پیکسل از اون رنگ خاصی داره و هر رنگ عدد خاصی رو نشون میده(این عدد ارتفاع نسبی اون بخش از زمین هستش) چطور میشه تو vb6 مثلا با قرار گرفتن موس روی هر پیکسل,اون عدد خاص رو استخراج کرد؟

رنگ هر نقطه از یک PictureBox رو میشه با تابع Point ای که داخلش قرار داره خواند، مثلا کد زیر رنگ نقطه (0,0) یعنی نقطه
گوشه بالا سمت چپ تصویر را می خواند و در Color قرار می دهد :
کد:
    Dim Color As OLE_COLOR
    Color = Picture1.Point(0, 0)

برای آنکه تشخیص بدهیم که ماوس روی کدام نقطه از تصویر قرار گرفته، می توانید از رخداد MouseMove استفاده کنیم،
مثلا کد زیر زمانی که ماوس روی یک نقطه کاملا سفید از Picture1 قرار گرفت، با پیغامی این مساله را اعلام می کند :

کد:
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Color As OLE_COLOR
    Color = Picture1.Point(X, Y)
    If Color = vbWhite Then
        MsgBox "Pointer is over a white pixel."
    End If
End Sub

کد زیر تمامی نقاط تصویر Picture1 را بررسی می کند و رنگ نقاط قرمز را به آبی تغییر می دهد :
کد:
    Dim X As Long, Y As Long
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        For Y = 0 To .ScaleHeight
            For X = 0 To .ScaleWidth
                If .Point(X, Y) = vbRed Then
                    Picture1.PSet (X, Y), vbBlue
                End If
            Next
        Next
    End With

کد زیر نقاط تصویر Picture1 را از رنگی به سیاه و سفید تبدیل می کند، فرمولی که برای این محاسبه استفاده شده
به کد ITU-R BT.601 شهرت دارد و در بسیاری از کاربرد های گرافیکی و نرم افزار های مربوطه بکار می رود :
کد:
    Dim X As Long, Y As Long
    Dim Color As Long, Grayscale As Long
    Dim Red As Long, Green As Long, Blue As Long
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        For Y = 0 To .ScaleHeight
            For X = 0 To .ScaleWidth
                Color = .Point(X, Y)
                Red = (Color And &HFF&)
                Green = (Color And &HFF00&) \ &H100&
                Blue = (Color And &HFF0000) \ &H10000
                Grayscale = Red * 0.299 + Green * 0.587 + Blue * 0.114
                If Grayscale > 255 Then Grayscale = 255
                Picture1.PSet (X, Y), RGB(Grayscale, Grayscale, Grayscale)
            Next
        Next
    End With
 

جدیدترین ارسال ها

بالا