تبليغاتX
Iranian Technology
 
آموزش برنامه نویسی
 
 
آموزش ویژوال بیسیک و ... برای دیدن تمامی مطالب به آرشیو ماهانه مراجعه کنید
 

امروز از روشی برای اختصاص بافت به اشکال استفاده میکنیم که از سرعت بالاتری نسبت به روش قبل برخورداره .

برای شروع کار شما باید سورس برنامه ی پست قبل رو دانلود کنید و حتمآ مطالب پست قبلی رو خونده باشید . لینک دانلود برنامه ی پست قبلی رو میتونید تو پست قبلی ببنید و دانلود کنید .

بعد از این که این کارا رو انجام دادین برنامه ای رو که دانلود کردین باز کنید و در داخل مدول LoadBitmap و در تابع LoadGLTextures به جای عبارت "C:\Windows\Coffee Bean.bmp" مسیر یه فایل عکس ( با هر فرمتی که دوست دارین ) رو بهش بدین . توجه کنید که باید اندازه ی عکس توانی از ۲ باشه که من پیشنهاد میکنم به عکس ۱۰۲۴*۱۰۲۴ باشه . هدف من از اینکه شما یه عکس با سایز ۱۰۲۴*۱۰۲۴ رو بارگذاری کنید اینه که تفاوت دو روش اختصاص بافت رو بهتر درک کنید و ببنید که چقدر فرق از لحاظ سرعت دارن.
خوب حالا برنامه رو اجرا کنید . می بینید که چند ثانیه ای طول می کشه که برنامه اجرا بشه. البته زمانش به سرعت و قدرت کامپیوتر شما بستگی داره . مثلا با سیستم من حدود
۷ ثانیه طول میکشه.

حالا میریم سر اصل مطلب . قبل از هر کاری با یه برنامه ی ویرایش عکس یه عکس ۱۰۲۴*۱۰۲۴ با فرمت BMP ایجاد کنید بعد کارهای زیر رو انجام بدین :

نمونه برنامه ی پست قبلی رو باز کنید و هر چیزی داخل مدول LoadBitmap هست رو پاک کنید . بعد از اون هم کدهای زیر رو بنویسید :

Global Texture(0) As Long

Public Function  LoadGLTextures() As Boolean

Dim bmFile As BitmapFileHeader
 Dim bmInfo As  BitmapInfoHeader
dim bmRGB() AS RGBQUAD
Dim IntPixelSize as Integer
Dim LngImageSize As Long
Dim bytArrImgData() As Byte

Open "FileName" For Binary As #1

Get #1, , bmFile
Get #1 , , bmInfo

If bmInfo.biBitCount < 24 Then
ReDim bmRGB(bmInfo.biClrUsed)
Get #1 , , bmRGB
End If

intPixelSize = bmInfo.biBitCount \ 8
LngImageSize = bmInfo.biWidth * bmInfo.biHeight * intPixelSize

ReDim bytArrImgData(LngImageSize)

Get #1 , , bytArrImgData()

Close #1

glGenTextures 1 , Texture(0)
glBindTexture  glTexture2D , Texture(0)
glTexParameteri  glTexture2D , tpnTextureMagFilter , GL_LINEAR
glTexParameteri  glTexture2D , tpnTextureMinFilter , GL_LINEAR
glTexImage2D glTexture2D , 0 , 3 , bmInfo.biWidth , bmInfo.biHeight , 0 , tiBGRExt , _  GL_UNSIGNED_BYTE , Texture(0)

LoadGLTextures = True
End Function

 

بعد از اینکه کدهای بالا رو به جای کدهای مدول LoadBitmap نوشتید . در خط 9 شما باید به جای FileName مسیر و نام عکسی که 1024*1024 بود رو بنویسید . بعد از اون هم در داخل فرم برنامتون به کنترل PictureBox رو پاک کنید.
حالا برنامتون رو اجرا کنید ... خوب چقدر فرق کرد ؟

سورس برنامه رو میتونید از اینجا دانلود کنید .

 

در این روش سرعت بیشتره و تنها مشکلی که داره اینه که باید حتمآ فرمت عکس BMP باشه . تازه اونم میشه یه جوری رفع کرد که اگه خواستین بگین تا براتون یه راه چاره ای بزارم .

امروز میخواستم یه مقدار در مورد تکنیک DepthTest صحبت کنم ولی به عقیده ی خودم بهتره این تکنیک رو در پست مربوط به مبحث Blending بزارم تا بهتر بتونید ازش استفاده کنید .

 

خوب میریم سر آموزش های کاربردی و جواب دادن به چند تا از سؤالات شما دوستان :

 

چند تا از دوستان خودم در مدرسه چند تایی سؤال از من داشتن که من فکر کردم جواب سؤالاتشون رو داخل وبلاگ بزارم بهتر باشه تا دیگران هم بهره مند بشن . راستی من خیلی دوست دارم به سؤالات شما دوستان فکر کنم و خودمو امتحان کنم پس اگه سؤالی چیزی دارین حتمآ بگین . نگران نباشید که دیر آپدیت می کنم . اگه توجه کرده باشید من توی تابستون پارسال ( و کلیه ی روزهای غیر از مدرسه ) حداقل دو یا سه روزی یه بار وبلاگمو آپ می کردم . لازمه بدونید من کلاس دوم رشته ی کامپیوتر از هنرستان فنی و حرفه ای نام آوران اراک هستم . (بعد یه عمر خودمو معرفی کردم . نه ؟؟!) اینا گفتم تا بدونید درگیر درس و امتحان ها هستم . تازه امروز که این پست رو گذاشتم فرداش امتحان جغرافی عمومی و استان دارم . خوب مث اینکه زیاد حرف زدم . منو ببخشید .

 

1 – یکی از دوستان گفته بود : من هر کاری میکنم نمی تونم از تکنیک Masking استفاده کنم و هر جا هم جستجو می کنم درست آموزش ندادن .

خوب دوست من تکنیک Masking اینقدر سادست که فکرش هم نمی تونی کنی . فقت سه خط کد میخاد. دوستانی که با تکنیک Masking آشنایی ندارن ---> فرض کنید شما میخواید یه عکس یا تصویر رو روی یه زمینه حرکت بدین . اما می خواین فقط یه قسمت هایی از تصویر نشون داده بشن و بقیه ی قسمت ها حذف بشن. مثلآ دوست دارین با برنامه نویسی تصویر یه نفر رو که زمینه ی اون روشنه به داخل یه منظره بندازین و زمینه اون تصویر رو حذف کنید(یعنی فقط تصویر فرد رو داخل منظره بندازین). امیدوارم با این توضیح دادن من چیزی فهمیده باشین !!!

 

یک روش ساده برای Mask کردن اینه که شما تصویر اصلی رو بردارین و هر جاش رو که نمی خواین به رنگ سفید و جاهایی از تصویر رو که می خواین به رنگ سیاه در بیارید و یه ذخیره از اون بگیرید .

 

مثال : یه پروژه ی جدید از نوع استاندارد باز کنید و روی فرم اون سه تا کنترل PictureBox بزارید . خاصیت ScaleMode همه ی PictureBox ها رو به 3-Pixel تغییر بدین . خاصیت Picture کنترل Picture1  رو برابر عکسی کنید که می خواید قسمت هایی از اون رو حذف کنید . همچنین خاصیت Picture کنترل Picture2 رو برابر آدرس عکسی کنید که خودتون درست کردین و قسمت هایی از عکس اولی رو که نمی خواستین به رنگ سیاه در اوردید . یه CommandButton به فرم اضافه کنید و روش جفت کلیک کنید. حالا بنویسید :

 

Private sub Command1_Click ()       ‘x

Picture3.PaintPicture  Picture2.Image , 0,0,picture2.scalewidth, _
picture2.scaleHeight , , , , , vbMergePaint

Picture3.PaintPicture  Picture1.Image , 0,0,picture1.scalewidth, _
picture1.scaleHeight , , , , , vbSrcAnd

Picture3.Refresh

End Sub

 

به همین سادگی اینم نمونه برنامش از اینجا دانلود کنید.

 

2 – در مورد تابع RtlCopyMemory توضیح بدید و اصلا به چه دردی می خوره :

دوست من این تابع از اسمش معلومه . کارش اینه که مقادیر موجود در آدرس ها مختلف Ram رو با این تابع میشه به آدرس ها ی دیگه کپی کرد. فرض کنید که برنامه ای نوشتید که می خواد یه آرایه ی 100000 عضوی رو به یک آرایه ی دیگه کپی کنه . حتما شما از حلقه ها استفاده می کنید که از سرعت پایینی برخورداره (مثل اینکه یادتون رفته با ویژوال بیسیک برنامه می نویسید). در چنین مواقعی بهتره از این تابع استفاده بشه .

مثال : یه پروژه ی جدید از نوع استاندارد باز کنید . دو تا دکمه یا همون CommandButton روی فرم قرار بدین و از منوی View -> Code رو بزنید. حالا کدهای زیر رو بنویسید :

 

Private Declare Function GetTickCount lib “kernel32” () As Long

Private declare Sub CopyMemory lib “kernel32”  Alias “RtlMoveMemory” (Des As Any , _

Source As Any , ByVal Length As Long)            ‘x

 

Private Sub Command1_Click()      

           

            Dim Array1(10000000) As Long

            Dim Array2(10000000)As Long

            Dim T1 , T2 As Long

            Dim I as Long

 

            T1 = GetTickCount

            For I = 0 to 10000000

                        Array2 (i) = Array1 (i)

            Next

            T2 = GetTickCount

 

            Msgbox “Time Left: “ & t2 – t1

           

End Sub

 

Private sub Command2_Click ()       ‘x

            Dim Array1 (10000000) As Long

            Dim Array2 (10000000) As Long

            Dim T1 , T2 As Long

            Dim L as Long

 

            T1 = GetTickCount

            L = Ubound(Array1) * 4

           

            CopyMemory Array2(0) , Array1(0) , L

 

            T2 = GetTickCount

           

            Msgbox “Time Left: “ & t2 – t1

End Sub

 

در دکمه ی اول (Command1) از روش کپی کردن معمولی استفاده کردیم که فکر کنم نیازی به توضیح نداره . البته تابع GetTickCount تنها کاری که می کنه اینه که ساعت سیستم رو بر حسب میلی ثانیه حساب می کنه وبر می گردونه .

در دکمه ی دوم (Command2) خط های اول تا چهارم برای اعلان متغیر ها بود . در خط 5 زمان کامپیوتر رو داخل متغیر T1 می ریزیم . خط 6 : تابع داخلی Ubound(array) محدوده ی یک آرایه رو بر می گردونه یعنی همون 10000000 رو بر میگردونه . می دونید که داده های از نوع Long چهار بایت فضا لازم دارن . حالا اگه ما تعداد خونه ها ی آرایه رو در4 ضرب کنیم تعداد بایت هایی که این آرایه لازم داره و فضا می گیره مشخص میشه. به عبارتی مقدار فضایی که به وسیله ی این آرایه گرفته می شه از این فرمول به دست میاد : تعداد اعضا (یا اندیس یا هر چیز دیگه) * فضای مورد نیاز برای هر عضو .  در خط بعد تابع CopyMemory رو فراخوانی کردیم. این تابع سه آرگومان داره : آرگومان اول اشاره ای به مقصد داره . آرگومان دوم اشاره ای به مبدأ داره و آرگومان آخر تعداد بایت هایی هستند که می خوان کپی بشن. در خط 8 زمان جاری رو داخل متغیر T2 میریزیم . حالا اگه مقدار T2 رو از T1 کم کنیم زمانی که سپری شده بر حسب میلی ثانیه به دست میاد . خوب حالا برنامه رو اجرا کنید و اول روی Command1 کلیک کنید و صبر کنید تا پیغام نمایش داده بشه . بعد روی Command2 کلیک کنید .

اینم سورس برنامه : دانلود

 

3 – شبیه سازی ابزار Fill برنامه ی Paint or Photoshop در ویژوال بیسیک :

حتما از فوتوشاپ استفاده کردین و با ابزار Fill اون کار کردین در اینجا یه برنامه براتون میزارم که ابزار Fill رو شبیه سازی می کنه .

تابع ExtFloodFill : برای این کار یعنی شبیه سازی ابزار Fill ما می تونیم از این تابع استفاده کنیم .

یه پروژه ی استاندارد باز کنید و خاصیت فرم  ScaleMode = 3  . همچنین خاصیت FillStyle فرم رو به 0 تغیر بدین . بعد از منوی View -> code رو بزنید تا پنجره ی کد ها باز بشه . بعد بنویسید :

 

Private Declare Function ExtFloodFill lib  "gdi32" (byval hDC as long , byVal X as long , _

byVal Y as Long , byVal  LColor as long, byVal dwFlags as Long) As Long

Dim CX as long

Dim Cy As Long

 

Private sub Form_MouseDown(Button as integer , Shift as Integer , X as single , Y as Single) 'x

 

            If button = 1 then

                        Cx =x

                        Cy = y

            Else

                        FillColor = RGB(255,0,0)

                        ExtFloodFill Form1.Hdc , x , y , form1.Point(x,y) , 1

            End if

 

End sub

 

Private sub Form_MouseMove(Button as Integer , Shift as integer , X as single,Y as single)  'x

            If button=1 then

                        Form1.line(cx,cy)-(x,y)

                        Cx=x

                        Cy=y

            Endif

End sub

 

حالا برنامتون رو اجرا کنید و با نگه داشتن کلید چپ ماوس چند تا خط روی فرم بکشین . حالا با کلیک راست می تونید کار Fill رو انجام بدین .

 

4 -  یکی از دوستان نظر داده بود که چطور میشه یه فایل رو از اینترنت با برنامه نویسی دانلود کرد . به وسیله ی کنترل Internet Transfer Control  می شه یه فایل رو از اینترنت دانلود کرد. برای این کار یک پروژه ی استاندارد باز کنید و با زدن کلیدهای Ctrl + T پنجره ی Components رو باز کنید و دنبال Microsoft Internet Trasfer Control 6.0 بگردین و بعد از علامت دار کردن اون OK کنید . در جعبه ابزار روی کنترل Inet دوبار کلیک کنید تا به فرم اضافه بشه . خاصیت Protocol کنترل Inet را به 4-icHTTP تغیر بدین و یک کنترل CommandButton روی فرم بزارین و بعد از جفت کلیک بنویسید :

 

Private sub Command1_Click()     'x

            Dim StrData as string

           

            Inet1.Cancel

            strData = Inet1.OpenURL(http://www.google.com/ , icString)

 

            open "C:\aa.htm" for Binary as #1

                        Put #1 , , strData

            Close #1

End Sub

 

بعد از اجرای برنامه هر وقت که روی Command1 کلیک بشه سایت google در مسیر C:\aa.htm دخیره می شه .

 

از اینجا به بعد آموزش هستن ------>

 

5 – ایجاد منوهای چند ستونی و عریض : شاید تا حالا شده برنامه ای نوشتید که تعداد ایتم های منو زیاد بوده با استفاده از یک روش ساده شما می تونید منوهای خودتون رو چند ستونه کنید .

یه پروژه ی استاندارد باز کنید و با زدن کلیدهای Ctrl + E پنجره ی ویرایش منو رو باز کنید . در قسمت Caption بنویسید File و در قسمت  Name کلمه ی mnuFile رو وارد کنید . حالا روی دکمه ی Next کلیک کنید . در کنار دکمه ی Next چند تا دکمه وجود داره . روی دکمه ای که جهت راست ( دکمه با عنوان à) رو

کلیک کنید .حالا در قسمت Caption بنویسید A و درقسمت Name بنویسید mnuFileA . دوباره روی دکمه Next  کلیک کنید و در قسمت Caption حرف B و در قسمت Name کلمه ی mnuFileB رو وارد کنید . بعد هم OK کنید . با این کارها یک منو به نام File به نوار منوی فرمتون اضافه می شه که داری دو زیر منو هست.

ما می خوایم کاری بکنیم که ایتم A در یک ستون و آیتم B در ستون بعدی نمایش داده بشه .

یک عدد CommandButton به فرم اضافه کنید و بعد از جفت کلیک روی اون بنویسید :

 

Private Declare Function GetMenu Lib "user32" Alias "GetMenu" (ByVal hwnd As Long) As Long

Private Declare Function GetSubMenu Lib "user32" Alias "GetSubMenu" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function GetMenuItemID Lib "user32" Alias "GetMenuItemID" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long

 

Private sub Command1_Click()        'x

            Dim hMenu as long

            Dim hSubMenu as Long

            Dim ItemID as long

           

            hMenu = GetMenu(Form1.Hwnd)

            hSubMenu = GetSubMenu(hMenu , 0)

            ItemID = GetMenuItemID(hSubMenu , 1)

            ModifyMenu  hSubMenu , 1 , 1024 or 64 , ItemID , "B"

End sub

 

برنامه رو اجرا کنید و روی منوی File کلیک کنید بعد روی Command1 کلیک کنید . حالا رویFile کلیک کنید!

فکر نکنم نیازی به توضیح بیشتر داشته باشه ولی اگه خوستین بگین براتون توضیح بدم .

 

6 – پخش کردن فایل های MP3 در برنامه با استفاده از Media Player : برای پخش کردن تمامی فایل هایی که Windows Media Player قادر به پخش اونا باشه .

یه پروژه ی جدید از نوع استاندارد باز کنید و از منوی Project -> References رو کلیک کنید تا پنجره ی Refrences باز بشه . بعد در قسمت Available References به دنبال Windows Media Player بگردید و بعد از علامت دار کردن اون OK کنید .

توجه : ممکنه در قسمت Available References دوتا Windows Media Player وجود داشته باشه که شما باید Windows Media Player مربوط به فایل msdxm.ocx رو علامت دار کنید . یا اصلآ جفتشو علامت دار کنید .

دو تا CommandButton روی فرم بزارین و از منوی View -> Code رو بزنید تا پنجره ی کدها باز بشه بعد :

 

Dim MP as New MediaPlayer.MediaPlayer

 

Private sub Command1_Click()        'x

            MP.Open  "C:\FileName.MP3"

End Sub

Private Sub Command2_Click()       'x

            MP.Stop

End Sub

 

به همین سادگی شما می تونید فایل ها ی MP3 , DAT , Wav , WMA , WMV و ... رو پخش کنید.

 

7 – ساده ترین راه کار با ریجستری : برای کار با ریجستری ساده ترین راه استفاده از شی WScript است .
یه پروژه ی جدید از نوع استاندارد باز کنید و از منوی
Project -> References را بزنید . بعد در پنجره ای که باز شد به دنبال Windows Script Host Object Model بگردید و بعد از علامت دار کردن OK کنید.

روی فرم برنامه یک عدد CommandButton قرار دهید و بعد از جفت کلیک روی اون بنویسید :

 

Private sub Command1_Click ()       'x

            Dim objReg as New WshShell

           

            objReg.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\TestVB" , "This is a Test!"

End sub

 

بعد از اجرای برنامه و کلیک کردن روی Command1 یک مقدار در ریجستری در مسیر HKEY_LOCAL_MACHINE\Software\Microsoft\ با نام TestVB و مقدار This is a Test! ساخته می شود .

علاوه بر ساختن یا اضافه کردن یک مقدار در ریجستری می توان یک مقدار را از آن پاک و یا از آن خواند . برای مثال اگر کد زیر را جایگزین قطعه کد بالا کنید داده ی TestVB پاک می شه .

 

Private sub Command1_Click ()       'x

           

            Dim objReg as New WshShell
            objReg.regWrite " HKEY_LOCAL_MACHINE\Software\Microsoft\TestVB"

 

End Sub

 

یا اگه به جای کد بالا کد پایین رو بنویسید مقداری که داخل TestVB ذخیره شده رو نمایش میده.

 

Private sub Command1_Click ()   'x

 

            Dim objReg as New WshShell

            Dim StrVal as String

            strVal = objReg.RegRead ("HKEY_LOCAL_MACHINE\Software\Microsoft\TestVB")

            MsgBox  StrVal

 

End Sub

 

خوب فکر کنم دیگه برای امروز کافی باشه . از این به بعد سعی می کنم بعد از هر پست چند تا آموزش کاربردی و ترفند هم بزارم. نظر یادتون نره ها  . دوباره بی معرفتی نکنین.

فعلآ .

 |+| نوشته شده در  چهارشنبه پانزدهم خرداد 1387ساعت 17:27  توسط علی  | 
 
  بالا  

Free Counter