View Full Version : گرافیک در VB
  
AmirAmiri
شنبه 11 اسفند 1386, 22:55 عصر
مباحث مربوط به گرافیک و ساخت بازی را در این تاپیک مطرح کنید.:چشمک:
AmirAmiri
شنبه 11 اسفند 1386, 22:59 عصر
یک پروژه جدید باز کنید و شی CommandDialog از قسمت Components ها به فرم اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
 
Private Sub Form_Click()
  CommonDialog1.ShowColor
  Red = ConvertToRGB(CommonDialog1.Color, 0)
  Green = ConvertToRGB(CommonDialog1.Color, 1)
  Blue = ConvertToRGB(CommonDialog1.Color, 2)
  Me.Cls
  Print "R = " & Red
  Print "G = " & Green
  Print "B = " & Blue
End Sub
 
Private Sub Form_Load()
  Me.AutoRedraw = True
  CommonDialog1.Flags = 2
End Sub
 
'----------------------------------
 
Public Function ConvertToRGB(ByVal Colors As Long, ByVal Index As Integer) As Long
  Dim Red As Integer, Green As Integer, Blue As Integer
  Dim lngColor As Long
 
  lngColor = Colors
  Red = lngColor Mod &H100 ' &H100 = 256
  Green = (lngColor \ &H100) Mod &H100
  Blue = lngColor \ &H10000 ' &H10000 = 65536 = (256*256)
 
  If Index = 0 Then ConvertToRGB = Red
  If Index = 1 Then ConvertToRGB = Green
  If Index = 2 Then ConvertToRGB = Blue
End Function
 
 
حالا برنامتون رو اجرا کنید و روی فرمتون کلیک کنید و از جعبه متنی که ظاهر میشه یک رنگ انتخاب کنید و Ok کنید تا کد RGB رنگ رو تو فرمتون ببینید. موفق باشید.
 
منبع : http://v-basic.mihanblog.com
AmirAmiri
شنبه 11 اسفند 1386, 23:02 عصر
این کار با استفاده از آموزش بالا (بدست آمورن کد RGB رنگ مورد نظر) انجام میشه به این صورت که رنگ هر پیکسل رو بدست آورده و به هر یک از رنگهای قرمز, سبز و آبی عددی رو اضافه میکنیم تا رنگش روشن تر بشه. بعد از این کار, رنگ بدست اومده رو دقیقاً روی همون پیکسل ترسیم میکنیم.
یک پروژه جدید باز کنید و یک PictureBox و یک CommandButton و یک TextBox به فرمتون اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
 
Dim lngColor As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height
    Picture1.ScaleMode = 3
    Text1.Text = -20
End Sub
Private Sub Picture1_Click()
    On Error Resume Next
    For X = 1 To Picture1.ScaleWidth
        For Y = 1 To Picture1.ScaleHeight
            lngColor = Picture1.Point(X, Y)
            R = ConvertToRGB(lngColor, 0) + Val(Text1.Text)
            G = ConvertToRGB(lngColor, 1) + Val(Text1.Text)
            B = ConvertToRGB(lngColor, 2) + Val(Text1.Text)
            If R < 0 Then R = 0 Else If R > 255 Then R = 255
            If G < 0 Then G = 0 Else If G > 255 Then G = 255
            If B < 0 Then B = 0 Else If B > 255 Then B = 255
            Picture1.PSet (X, Y), RGB(R, G, B)
        Next Y
        DoEvents
    Next X
End Sub
Public Function ConvertToRGB(ByVal Colors As Long, ByVal Index As Integer) As Long
    Dim Red As Integer, Green As Integer, Blue As Integer
    Dim lngColor As Long
    lngColor = Colors
    Red = lngColor Mod &H100
    Green = (lngColor \ &H100) Mod &H100
    Blue = lngColor \ &H10000
    If Index = 0 Then ConvertToRGB = Red
    If Index = 1 Then ConvertToRGB = Green
    If Index = 2 Then ConvertToRGB = Blue
End Function
 
حالا یک عکس برای PictureBox قرار بدید و برنامتون رو اجرا کنید حالا برای تغییر روشنایی تصویر از اعداد مثبت و منفی استفاده کنید و روی PictureBox کلیک کنید. موفق باشید.
AmirAmiri
شنبه 11 اسفند 1386, 23:05 عصر
من برای نوشتن این کد و بدست آوردن راهی برای تاریک یا روشن شدن رنگها چیزی حدود 10 تا 15 ساعت وقت گذاشتم و شکر خدا بالاخره تونستم راه حلش رو بدست بیارم. اونچه که برای من سخت و دشوار بود طیف تمام رنگهای پر رنگ به تاریک (چپ کلیک درون فرم) و همچنین طیف تمام رنگهای پر رنگ به روشن (راست کلیک) بود. یعنی هر چی که به سمت پایین فرم میاییم رنگها تیره تر یا روشن تر بشن. اینم چیزه ساده ای به نظر میرسه امّا اینطور نیست. حالا ممکنه با یک نگاه به کد زیر بگید: بابا اینکه دیگه کاری نداره که...! بلــــــه معمّا چون حل شود آسان شود.
 
اساسه کار این کد چیه؟
 
طیف رنگها به صورت: قرمز » سبز » آبی » قرمز هست. یعنی از قرمز شروع میشه و به سمت سبز حرکت میکنه و بعد، از سبز به سمته آبی و بعد از آبی به سمت قرمز حرکت میکنه.
 
 
همون طور که ملاحظه میکنید، ترسیم هر سطر برنامه، از شش مرحله (Level) تشکیل شده:
 
مرحله اول: اضافه شدن رنگ سبز RGB(R ,+G ,B )
مرحله دوم: کم شدن رنگ قرمز RGB(-R ,G ,B )
مرحله سوم: اضافه شدن رنگ آبی RGB(R ,G ,+B )
مرحله چهام: کم شدن رنگ سبز RGB(R ,-G ,B )
مرحله پنجم: اضافه شدن رنگ قرمز RGB(+R ,G ,B )
مرحله ششم: کم شدن رنگ آبی RGB(R ,G ,-B )
 
اینا مراحل ترسیم یک سطر بودند و چون در هر مرحله 255 رنگ ترسیم میشه پس در تمام سطر باید 1530 رنگ ترسیم بشه (6*255=1530)؛ به همین خاطر من عرض فرم رو 1530 در نظر گرفتم ولی طول فرم رو همون 255 در نظر گرفتم چون رنگهای ما یا تاریک میشن یا روشن میشن و برای اینکار نیاز به 255 رنگ داریم (اعداد کوچکتر = رنگ تاریکتر، اعداد بزرگتر = رنگ روشنتر).
 
یک پروژه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
 
Dim intRGB(3) As Single, intAddNum As Single
Dim intLevel As Integer
Dim intColorLevel1 As Integer, intColorLevel2 As Integer
Private Sub Form_Load()
    Me.DrawWidth = 2
    Me.AutoRedraw = True
    Me.Caption = "Click Me."
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
 
    Me.ScaleWidth = 1530
    Me.ScaleHeight = 255
    'Me.Cls
    intAddNum = 1
    intLevel = 1
 
    If Button = vbLeftButton Then
        intColorLevel1 = 255
        intColorLevel2 = 0
        intRGB(1) = 255
        intRGB(2) = 0
        intRGB(3) = 0
        Y = 0
    ElseIf Button = vbRightButton Then
        intColorLevel1 = 255
        intColorLevel2 = 0
        intRGB(1) = 255
        intRGB(2) = 0
        intRGB(3) = 0
        Y = 255
    End If
 
    For Y = 0 To Me.ScaleHeight
        For X = 0 To Me.ScaleWidth
 
            Select Case intLevel
                Case 1:
                    intRGB(2) = intRGB(2) + intAddNum
                    If intRGB(2) >= intColorLevel1 Then intLevel = 2
                Case 2:
                    intRGB(1) = intRGB(1) – intAddNum
                    If intRGB(1) <= intColorLevel2 Then intRGB(1) = Abs(intRGB(1)): intLevel = 3
                Case 3:
                    intRGB(3) = intRGB(3) + intAddNum
                    If intRGB(3) >= intColorLevel1 Then intLevel = 4
                Case 4:
                    intRGB(2) = intRGB(2) – intAddNum
                    If intRGB(2) <= intColorLevel2 Then intRGB(2) = Abs(intRGB(2)): intLevel = 5
                Case 5:
                    intRGB(1) = intRGB(1) + intAddNum
                    If intRGB(1) >= intColorLevel1 Then intLevel = 6
                Case 6:
                    intRGB(3) = intRGB(3) – intAddNum
                    If intRGB(3) <= intColorLevel2 Then intRGB(3) = Abs(intRGB(3))
            End Select
 
            Me.PSet (X, Y), RGB(intRGB(1), intRGB(2), intRGB(3))
 
        Next X
        DoEvents
 
        If Button = vbLeftButton Then
            intColorLevel1 = intColorLevel1 – 1
            intAddNum = (intColorLevel1 / 256)
            intRGB(1) = intColorLevel1
            intRGB(2) = 0
            intRGB(3) = 0
        ElseIf Button = vbRightButton Then
            intColorLevel2 = intColorLevel2 + 1
            intAddNum = ((255 - intColorLevel2) / 256)
            intRGB(1) = 255
            intRGB(2) = intColorLevel2
            intRGB(3) = intColorLevel2
        End If
        intLevel = 1
        Me.Caption = CStr((Y * 100) \ Me.ScaleHeight) & "%"
    Next Y
    Me.Caption = "Complated."
End Sub
 
 
حالا برنامه و اجرا کنید و تو فرمتون راست کلیک کنید بعد از ترسیم تصویر چپ کلیک کنید تا تفاوت دو تصویر و نتیجه 15 ساعت تلاش منو ببینید، شاید به نظرتون ساده یا بی کاربرد بیاد اما واقعاً اینطور نیست. در ضمن سرعت ترسیم تصویر بستگی به CPU کامپیوتر شما داره، برای من که سریع ترسیم میشه. موفق باشید.
 
منبع : http://v-basic.mihanblog.com
perfeshnal
یک شنبه 12 اسفند 1386, 00:25 صبح
دوست عزیز این چه وضع تاپیک دادنه !!!
Mbt925
یک شنبه 12 اسفند 1386, 00:44 صبح
دوست عزیز ، مطالب رو مستقیم کپی نکنید و اینجا Paste نکنید.
حداقل زحمت ویرایشش رو بکشید.
پست هاتون رو ویرایش کنید ، وگرنه حذف خواهند شد.
AmirAmiri
یک شنبه 12 اسفند 1386, 14:59 عصر
درسته که PictureBox خاصیت Strerch نداره ولی کد نویسی رو برای چی گذاشتن. شما میتونید با استفاده از کد زیر تصویر را در PictureBox به صورت Strerch در بیارید. اینکار با متد PaintPicture انجام میشه.
 
یک پروژه جدید باز کنید و یک PictureBox به فرمتون اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Sub Form_Load()
  Picture1.AutoRedraw = True
  Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height
End Sub
 
حالا تو Picture1 یک عکس قرار بدید (انداره عکس مهم نیست) و برنامه رو اجزا کنید و ببینید که Picture1 به چه زیبایی Stretch شده. همین کارو برای فرمتون هم میتونید انجام بدید.
کد زیر رو به جای کد بالا تو قسمت جنرال فرمتون کپی کنید :
Private Sub Form_Load()
  Me.AutoRedraw = True
  Picture1.Visible = False
End Sub
 
Private Sub Form_Resize()
  Me.PaintPicture Picture1.Picture, 0, 0, Me.Width, Me.Height
End Sub
 
حالا اگه برنامتون رو اجرا کنید میبینید با تغییر اندازه فرمتون اندازه پس زمینه فرم هم تغییر مینکنه و این خیلی به نفع شماست. موفق باشید.
 
منبع : http://v-basic.mihanblog.com
AmirAmiri
یک شنبه 12 اسفند 1386, 15:14 عصر
حالا این که گفتم چی هست؟ مثلاً یه دایره رو در نظر بگیرید که توش خالیه و میخوایم توشو با رنگ آبی پر کنیم، اینجاست که این تابع به دردمون میخوره. این تابع بیشتر بدرد بچه های سوم کامپیوتر که میخوان برنامه Paint بسازن میخوره.
 
یک پروژه جدید باز کنید و دو تا Command Button و دو تا ComboBox به فرمتون اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Dim X As Single, Y As Single
Private Sub Command1_Click()
    Me.Cls
    Me.FillStyle = 1
    R = Me.ScaleWidth / 2
    Me.Circle (X, Y), R, vbRed
    Me.FillStyle = Combo1.ListIndex
End Sub
Private Sub Command2_Click()
    Me.FillColor = Combo2.ItemData(Combo2.ListIndex)
    Me.FillStyle = Combo1.ListIndex
    ExtFloodFill Me.hdc, X, Y, Me.Point(X, Y), 1
End Sub
Private Sub Form_Load()
    Me.Width = 5000
    Me.Height = 7000
    Me.AutoRedraw = True
    Command1.Caption = "Draw Circle"
    Command1.Move 0, 0, 1000, 350
    Command2.Caption = "FloodFill"
    Command2.Move 1100, 0, 1000, 350
    Combo1.Move 2200, 0, 1800
    Combo1.List(0) = "0 - Solid"
    Combo1.List(1) = "1 - Transparent"
    Combo1.List(2) = "2 - Horizontal Line"
    Combo1.List(3) = "3 - Vertical Line"
    Combo1.List(4) = "4 - Upward Diagonal"
    Combo1.List(5) = "5 - Downward Giagonal"
    Combo1.List(6) = "6 - Cross"
    Combo1.List(7) = "7 - Diagonal Cross"
    Combo1.ListIndex = 0
    Combo2.Move 4000, 0, 800
    Combo2.List(0) = "Red"
    Combo2.ItemData(0) = vbRed
    Combo2.List(1) = "Green"
    Combo2.ItemData(1) = vbGreen
    Combo2.List(2) = "Blue"
    Combo2.ItemData(2) = vbBlue
    Combo2.List(3) = "Yellow"
    Combo2.ItemData(3) = vbYellow
    Combo2.ListIndex = 1
    Me.ScaleMode = 2
    Me.FillColor = vbGreen
    X = Me.ScaleWidth / 2
    Y = Me.ScaleHeight / 2
End Sub
 
حالا برنامه رو اجرا کنید و نتیجه رو ببینید. موفق باشید.
 
منبع : http://v-basic.mihanblog.com
AmirAmiri
یک شنبه 12 اسفند 1386, 23:38 عصر
اینم سورس برنامه Paint که خیلی کامله (خودم نوشتم).
این قدر بی خیر نباشید حداقل یک تشکر بکنید.
 
منبع : http://v-basic.mihanblog.com
علی خدایاری
دوشنبه 13 اسفند 1386, 00:43 صبح
یک کلاس مناسب برای جایگزینی با OLE_COLOR برای پروژه های بزرگ.
البته اصلا چیز قابل داری نیست:خجالت:. دوستان لطفا تست کنن تا اگه مشکلی بود رفع بشه
AmirAmiri
دوشنبه 13 اسفند 1386, 23:09 عصر
یعنی هیچ کسی در مورد گرافیک یا ساخت بازی چیزی بلد نیست؟
پس باید این تاپیک رو تعطیل کنیم؟
بابا یکی بیاد اینجا یه آموزشی چیزی بنویسه به خدا خیلی مبحثه جالبی میشه هــــــــــــاا...
AmirAmiri
دوشنبه 13 اسفند 1386, 23:18 عصر
اینم یه بازی.:تشویق:
این بازیه هواپیماست که باید اونو با کلیک بزنید تا منفجر بشه جالبه دانلودش کنید ضرر نمیکنید (خودم نوشتمش) هواپیما به صورت متحرک هست و پس از هر مرحله سرعت هواپیما بیشتر میشه و همچنین اندازه اون هم کوچکتر میشه.:متفکر:
تشکر کنیــــــــــــــد....
Mbt925
سه شنبه 14 اسفند 1386, 14:52 عصر
دوست عزیز خیلی خوبه که شما فعال هستید.
بازی هاتون رو توی تاپیک مربوط به بازی ها معرفی کنید.
http://barnamenevis.org/forum/showthread.php?t=91274&page=11
علی خدایاری
چهارشنبه 29 اسفند 1386, 00:00 صبح
جناب AmirAmiri
تو را من چشم در راهم!
اوبالیت به بو
چهارشنبه 29 اسفند 1386, 00:20 صبح
برنامه خوبیه!!
اوبالیت به بو
چهارشنبه 29 اسفند 1386, 00:22 صبح
اینم برنامه خوبیه
 
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.