و این هم سورس سیستم ثبت نام مدرسه.
تهیه و ویرایش : آقای saeedzx
و این هم سورس سیستم ثبت نام مدرسه.
تهیه و ویرایش : آقای saeedzx
این هم یه سورس جالب ولی ساده پیشنهاد می کنم حتما دانلود کنید./
توضیح : وقتی فوکوس میره روی TextBox تمام متن های داخل TextBox انتخاب میشن یا در حالت Selection در میان.
ممنون و خواهش می کنم. درمورد سوالت باید بگم من حتی یک ذره درباره ارتباط برنامه با شبکه و Wimsock و از این جور چیزها اطلاعات ندارم. ولی شاید بتونید یک دیتابیس رو تو اینرنت آپلود کنید و آدرس اون رو تو بخش DatabaseName دیتا و یا همون آدرس رو توی ConnectionString یک Adodc بذاری و ازش استفاده بکنی. البته من امتحان نکردم.سلام MMSSOFT عزیز :
من یه سورس میخواستم که به دیتابیس موجود در یه سرور یا یه کامپیوتر دیگه تحت اینترنت وصل بشه و بتونم با اون دیتابیس کار کنم و اطلاعاتش رو در دیتاگرید نمایش بدم و ... من دیتابیس اکسس کار میکنم.
پیشاپیش از لطفت متشکرم.
برای مثال :
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "http://space.myhost.com/databse/db1.mdb"
یا برای Data
Data1.DatabaseName = "http://space.myhost.com/databse/db1.mdb"
یه امتحانی بکن. امتحانش ضرر نداره.
و این هم سورس مقایسه تصاویر.
_______________________________
\\حتما دانلود کنید.//
این هم سورس یه Screen Saver زیبا و آموزنده./
\:.امیدوارم خوشتون بیاد.:/
این هم سورس یک بازی زیبا.
دانلود کنید تا بفهمید چیه. فقط میتونم بگم به توپ مربوط میشه.
کتابچه سورس
يكي از راههاي اينكه شما بتونيد روش كد نويسي رو خوب ياد بگيريد و يا از كدهاي استاندارد و از پيش نوشته شده در برنامه هاتون به خوبي استفاده كنيد اينه كه از كدهاي نوشته شده كتابها استفاده كنيد. به همين دليل هم به دوستان عزيز پيشنهاد مي كنم براي اين منظور به سايت انتشارات Wrox سر بزنن و از هر كتابي كه دلشون ميخواد هر سورسي رو دوست دارن بردارن. شما مي تونيد از كدهاي اونها كه واقعاً با توضيحات خوب نوشته شدن استفاده كنيد. براي اين منظور به این ادرس بروید :
http://www.wrox.com/dynamic/books/download.aspx
نحوه تولید DLL با ویژوال بیسیک
بعنوان یک زبان برنامهنویسی با توسعه سریع، ویژوال بیسیک نظر خیلی از برنامهنویسان را از جهت سادگی به خود معطوف کرد. برنامهنویسی با ویژوال بیسیک در کمترین زمان صورت میگیرد حال آنکه در مقابل زبانهایی چون C و ++C اغلب اوقات به روزها کار مفید نیاز است.
اما بیشترین انتقادی که برنامهنویسان از ویژوال بیسیک دارند در این است که قادر به تولید کتابخانههای پویا (DLL) نیست. حقیقتا این نظر مورد قبول است که نمیتوان این نوع فایلها را در کنار فایلهای اجرایی(Exe) یا ActiveX Exe تولید کرد.
در این مقاله ما قصد داریم که نگاه دقیقی به نحوه تولید فایلهای اجرایی در ویژوال بیسیک یندازیم و بعد با طی مراحل سادهای موفق به ایجاد فایلهای DLL بشویم تا از زیر بار این انتقاد نیز رهایی یابیم.
قبلا به این موضوع اشاره شد که فایهای DLL آن دست از برنامههایی هستند که یکبار نوشته میشوند و در پروژههای بعدی بکرات میتواند از آنها استفاده برد. چیزی که هسته ویندور را تشکیل میدهد اینگونه فایلها هستند. علاوه بر آن تکنیکهایی وجود دارد که شما را قادر میسازد تا برنامههایی بنویسید که قادرند خود را بروز برسانند و یا خود ترمیم باشند. بهتر از آن اینکه برنامهای بنویسید که با الحاق اینگونه فایلها بدان قدرت و امکانات جدید بدان افزود. همانند نرمافزارهای رایج از جمله Winamp.
کتابخانههای پویای قابل اتصال (DLL) چه هستند؟
یک DLL مجموعهای از توابع و پروسههایی است که میتواند از برنامه یا DLLهای نظیر خود فراخوانده شود.
استفاده از اینگونه کتابخانههای دو مزیت اصلی دارد:
1- امکان به اشتراک گذاری از کد را فراهم میسازند. یک DLL میتواند مورد استفاده خیلی از برنامههای قرار گیرد. بعنوان مثال کتابخانه Win32 API نمونهای از این سری فایلها است. بعلاوه از زمانی که پروسههای گوناگون قادر به فراخوانی یک DLL واحد هستند امکان به اشتراک گذاری کدها و روتینها فراهم آمده است. یک فایل DLL تنها یکبار به درون حافظه لود میشود و بارها توسط پروسههای گوناگونی مورد استفاده قرار میگیرد و این یعنی مدیریت حافظه بهتر.
2- مزیت دیگر امکان نوشتن برنامهها بصورت اجزای منفصل است که این اجزا خود قابل تعویض با نگارشهای جدیدتر جهت توسعه نرمافزار خواهند بود بدون اینکه خطی از کد برنامه اصلی دگرگون شود.
با این توصیف فایلهای کتابخانهای درونی که در پروژههای مورد استفاده قرار میگیرد در صورت تغییر نیاز هست تا پروژه اصلی دوباره کمپایل شود تا بتوان با آن ارتباط بر قرار کرد. اما در DLL ها چون بصورت پویا و قابل انعطاف نوشته شدهاند این اتصال در بیرون از بدنه اصلی و درست در زمان فراخوانی آن قبیل از متدها و توابع شکل میگیرد و این خود تفاوت آشکار از مزیت این گونه از فایلها میباشد.همچنین یک فایل DLL میتواند حاوی توابعی باشد که فقط مورد استفاده خود هست و از درون به آن دسترسی نخواهیم داشت و آندسته از تابعی را که نیاز هست معرفی میکنیم تا از بیرون بدان دسترسی داشته باشیم. در این مرحله نیاز به معرفی در فایلهای Def هست که در پروژههای C و C++ مورد استفاده قرار میگیرد.
و اما ساختار DLL
فایلهای DLL حاوی یک مدخل شروع انتخابی (optional entry point) و پایانی هستند که در زمانی که توسط برنامههای دیگر به درون حافظه لود یا آنلود میشوند قابل اجرا است. ویندوز این پروسه را در زمانی که یک برنامه DLLها را بدرون حافظه لود یا آنلود میکند اجرا میکند.
این دو نوع پروسه به DLL این امکان را میدهد که یک سری از مقدمات را پیش از استفاده مهیا کند یا بعد از استفاده پاکسازی نماید. در ویژال بیسیک این تابع بدین گونه تعریف میشود:
Public Function DllMain(hinstDLL As Long, fdwReason As Long , lpwReserved As Long) As Boolean
که پارامترهای آن بدین قرارند:
hInstDLL که حاوی یک مقدار یکتا بعنوان دستگیره فایل DLL است.
fdwReason مشخص کننده دلیل فراخوانی این پروسه توسط سیستمعامل است که یکی از چهار مقدار زیر را به خود منتصب میکند:
DLL_PROCESS_ATTACH (1): یک پروسه در حال لود DLL به دورن حافظه است. هر پیشنیاز باید در اینجا شکل گیرد.
DLL_THREAD_ATTACH (2): یک ریسمان (Thread) برای این DLL در حال تولید است. هر پیشنیاز برای ایجاد ریسمان در این مرحله میتواند شکل بگیرد.
DLL_THREAD_DETACH (3) ریسمان در حال پایان یافتن است. به منظور پاکسازی DLL از حافظه.
DLL_PROCESS_DETACH (0) فایل DLL در حال خروح از حافظه است. بمنظور پاکسازی سایر کارها توسط برنامهنویس امکان انجام در این مرحله فراهم آمده است.
lpvReserved: حاوی مقدار اضافی در استفاده از DLL_PROCESS_ATTACH یا DLL_PROCESS_DETACH میباشد.
مقدار برگشتی تابع DllMain در هنگام صدا زدن بصورت DLL_PROCESS_ATTACH مقدار TRUE را باید به خود بگیرد.
در تلاش برای تولید و توسعه یک DLL نمونه قصد این را داریم که یک کتابخانه ریاضی تشکیل دهیم. کد زیر در ماژولی بنام MathLib.Bas قرار میگیرد:
Option Explicit
Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3
Public Function DllMain(hInst As Long, fdwReason As Long, lpvReserved As Long) As Boolean
Select Case fdwReason
Case DLL_PROCESS_DETACH
' No per-process cleanup needed
Case DLL_PROCESS_ATTACH
DllMain = True
Case DLL_THREAD_ATTACH
' No per-thread initialization needed
Case DLL_THREAD_DETACH
' No per-thread cleanup needed
End Select
End Function
Public Function Increment(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5
Increment = var + 1
End Function
Public Function Decrement(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5
Decrement = var - 1
End Function
Public Function Square(var As Long) As Long
If Not IsNumeric(var) Then Err.Raise 5
Square = var ^ 2
End Function
در این روش به جای اضافه کردن عکس به بانک فقط ادرس عکس را به بانک می دهیم.
عکسها در فایلی به نام pic در فایل bin برنامه ذخیره می شود.
به این ترتیب از سرعت برنامه کاسته نمی شود.
لطفا از دادن نظرات خود منو محروم نکنید.
شما برای اینکه این برنامه به خوبی کار کند باید ادرس بانک را تغیر دهید.
در ضمن اگه یکی از دوستان برای من توضیح دهد که چطور بدون ادرس دهی(منظورم اینه که بانک همراه با برنامه باشه) می توانم به بانک دسترسی داشته باشم ممنون می شم.
این عکسها قابل حمل می باشند یعنی همراه برنامه می باشند و با تغییر محل برنامه هیچ مشکلی ایجاد نمی شود.
فقط در صورتی که فایل pic را در فایل bin برنامه حذف یا تغییر بدهید برنامه مشکل پیدا خواهد کرد.
دانلود سورس با حجم 1.52 مگابایت
تهیه و تنظیم : mina.net
توابع SaveSetting و GetSetting
» وقتي شما برنامه اي مانند ويژوال بيسيك را اجرا مي كنيد و در محيط كاري آن تغييراتي ايجاد مي نماييد ، اين تغييرات براي اجراي بعدي برنامه ثبت مي شوند . براي مثال اگر شما ToolBox وي بي را مخفي كنيد در اجراي بعدي آن ToolBox نمايش داده نخواهد شد . اين امر در بسياري از برنامه هاي ديگر نيز صدق ميكند . اين تغييرات كه در اصطلاح ( Setting ) نام دارند يا در رجيستري يا در يك فايل ذخيره مي شوند . خود VB اين تغييرات را در رجيستري ثبت ميكند و هنگام اجرا محيط خود را بر اساس اين داده ها تنظيم مي نمايد .
» هنگامي كه كلمه رجيستري در VB به گوش برنامه نويسان مي رسد سريع ذهن آنها را متوجه توابع پيچيده API مربوط به كار با رجيستري مي كند . براي همين من امروز مي خواهم روش ذخيره كردن تنظيمات يك برنامه در رجيستري را بدون استفاده از توابع پيچيده مخصوص كار با رجيستري به وسيله دو تابع بسيار ساده مخصوص اين كار به شما معرفي كنم :
» تابع SaveSetting : براي ساخت كليد و ذخيره كردن اطلاعات در رجيستري .
( SaveSetting ( AppName As String , Section As String , Key As String , Setting As String
_ AppName : اين پارامتر مشخص كننده نام برنامه ( پروژه ) است . البته هر نوشته ديگري هم مي تواند باشد كه نام كليد اصلي در رجيستري را مشخص مي كند .
_ Section : اين پارامتر نا كليد زير شاخه است كه بيشتر از نام Setting براي آن استفاده مي كنند .
_ Key : اين پارامتر مشخص كننده نام كليد از نوع String است كه داده ها در آن ذخيره مي شوند .
_ Setting : اين پارامتر هم كه اصلي ترين بخش است همان داده يا مقداري است كه در كليد ذخيره مي شود .
» براي مثال : تابع با پارامتر هاي ورودي زير مقدار رشته ( "1" ) را در كليد SampleKey ذخيره مي كند .
"SaveSetting "Test" , "Setting" , "SampleKey" , "1
_ شايد از خودتان بپرسيد كه مسير اين كليد در رجيستري چگونه است . كليه اين كليدها و مقادير كه ايجاد مي شوند در آدرس زير قرار مي گيرند و ما نمي توانيم از آدرس ديگري استفاده نماييم :
\HKEY_CURRENT_USER\Software\VB and VBA Program Settings
در مثال قبلي مقادير در شاخه زير ذخيره مي شوند كه شما مي توانيد با مراجعه به آن به اين مطلب پي ببريد :
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Test\Setting
» تابع GetSetting : براي خواندن اطلاعات از رجيستري .
(GetSetting ( AppName As String , Section As String , Key As String , Setting As String
_ پارامتر هاي اين تابع به جز گزينه آخر كه در اين تابع جايي ندارد دقيقا شبيه به هم هستند :
( " KeyValue = GetSetting ( " Test" , "Setting" , "SampleKey
_ در اين مثال مقدار ( 1 ) را كه قبلا با تابع قبلي در كليد SampleKey قرار داديم درون متغير KeyValue قرار مي گيريد .
» برنامه نمونه : حال مي خواهيم برنامه جالبي با استفاده از اين توابع معرفي شده بنويسيم .
شرح برنامه : مي خواهيم برنامه اي بنويسيم كه داراي تعداد مشخص اجرا باشد . يعني كاربر فقط بتواند پنج بار اين برنامه را اجرا كند و در هر بار اجراي آن پيغامي مبني بر تعداد باقيمانده دفعات اجرا براي كاربر نمايش داده شود و هنگامي كه اين تعداد به پايان رسيد پيغامي نمايش داده شود كه ديگر كاربر نمي تواند اين برنامه را اجرا نمايد . مانند برنامه هايي كه داراي قفل يا به اصطلاح رجيستري هستند .
_ براي اين كار شما فقط كافي است كدهاي زير را در Form_Load برنامه خود قرار دهيد :
()Private Sub Form_Load
Dim RunCount As String
( "RunCount = GetSetting("Test", "Setting", "RunCount
If Val(RunCount) > 5 Then
_,"مهلت اجراي برنامه به پايان رسيده و شما ديگر قادر به اجراي آن نخواهيد بود"MsgBox vbExclamation , "اتمام مهلت"
End
Else
_ ,"شما فقط " & ((Str(4 - Val(RunCount & " بار ديگر مي توانيد اين برنامه را اجرا كنيد" MsgBox
vbInformation, "تعداد اجراي باقيمانده"
(SaveSetting "Test", "Setting", "RunCount", Str(Val(RunCount) + 1
End If
End Sub
حال فايل exe از برنامه خود بسازيد و آن را اجرا نماييد
*******************************
سوال :دستوری می خوام که بتونم يک کلمه را توی يک فيلد بانک اطلاعاتي جستجو کنم نه اينکه اون کلمه اول نوشته باشه . اين کلمه ممکنه وسط هم نوشته شده باشه
برای کاری که می خوای انجام بدی باید از دستورات SQL استفاده کنی.
اگر از کامپونت ADO استفاده می کنی دستور جستجوش به این شرحه :
Ado1.RecordSource= "Select * From [your table] Where [your field] Like ('%متن مورد نظر برای جستجو%')"
ولی اگر از کامپونت Data استفاده می کنی دستورش اینطوری می شه :
Data1.RecordSource= "Select * From [your table] Where [your field] Like ('*متن مورد نظر برای جستجو*')"
مثال : مثلا من یک Table با نام Table1 و یک فیلد به نام Address دارم و می خوام تمام آدرسهایی که توشون ( تهران ) داره پیدا کنم ، حالا این کلمه می خواد هرجایی از فیلد باشه :
Ado1.CommandType = adCmdText
Ado1.RecordSource= "Select * From Table1 Where Address Like ('%تهران%')"
Ado1.Refresh
بستن پنجره با گرفتن عنوان ان
اگر کاربر پنجره ای رو که شما تعیین می کنید رو باز کنه برنامه اون فرم رو می بنده.
در اینجا ما از دو تا تابع API استفاده می کنیم که عبارتند از : FindWindowA برای پیدا کردن پنجره مورد نظر و SetForegroundWindow برای فعال کردن پنجره مورد نظر که هر دوی این توابع در فایل user32.dll تعریف شده اند.
اول برای تعریف توابع فوق خطوط زیر رو در قسمت General وارد کنید :
Private Declare Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim Temp As Long
حالا روی فرمتون یه Timer قرار بدین و خاصیت Interval اون رو به 50 تغییر بدید، بعد روی اون دابل کلیک کنید و کد های زیر رو در Sub مربوط به Timer قرار بدین:
Temp = FindWindowA(vbNullString, "My Computer")
If Temp <> 0 Then
SetForegroundWindow (Temp)
SendKeys "%{F4}"
End If
دستور اول هندل ( لازم به ذکر است که سیستم عامل به هر کنترلی و به هر فرمی شماره ای اختصاص می ده که به این شماره میگن هندل) پنجره ای رو که ( در اینجا ) عنوانش My Computer باشد رو در متغیر Temp می ریزد. شرط بعدی چک می کند که پنجره مورد نظر پیدا شده یا نه که در صورت برقراری این شرط با تابع SetForegroundWindow (که آرگومانش همون شماره ای باید باشه که با تابع FindWindowA پیدا کردیم) پنجره پیدا شده رو فعال می کنه و در نهایت تابع SendKeys زهر خودش رو می ریزه و با ارسال یک کلید میانبر به نام Alt+F4 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!
بدست آوردن IP و نام سيستم ميزبان
برای امروز قصد دارم يک پروژه ساده را به شما معرفی کنم.
شما ظرف چند دقيقه ميتوانيد اين پروژه را در ويژوال بيسيک بسازيد.
ابتدا ويژوال بيسيک را باز کنيد سپس کنترلر های زير را روی فرم قرار دهيد :
دو عدد TextBox و دو عدد WinSock
حالا روی فرم دو بار کليک کرده و در رويداد لود فرم کدهای زير را وارد کنيد :
Text1.Text = Winsock1.LocalIP
Text2.Text = Winsock2.LocalHostName
برنامه را اجرا کنيد . اين برنامه آی پی و پورت سيستم ميزبان را در اختيار شما قرار ميدهد.
لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسيديم
خدمت شما عرض خواهم کرد که کاربرد اين برنامه در هک سيستم قربانيان چيست
تبدیل رادیان به درجه
چون اکثر توابع مثلثاتی بر حسب رادیان کار می کنند گاهی اوقات نیاز داریم تا زوایا را از در جه به رادیان و بالعکس تبدیل کنیم. برای تبدیل یک زاویه بر حسب رادیان به درجه، آنرا در 180 ضرب کرده و سپس بر عدد پی تقسیم میکنیم:
Degree(x) = x * 180 / Pi
برای تبدیل یک زاویه بر حسب درجه به رادیان، آنرا در عدد پی ضرب کرده و سپس بر 180 تقسیم میکنیم:
Rad(x) = x * Pi / 180
با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين
تصاويرتون بايد JPG باشه و بزرگ نباشه.دستورات زير رو در قسمت General فرم بنويسيد
Dim Image1 As IPictureDisp
Dim Image2 As IPictureDisp
Private Type Location
X As Integer
Y As Integer
End Type
Dim Image1Move As Integer
Dim Image2MoveX As Integer
Dim Image2MoveY As Integer
Dim Image1Local As Location
Dim Image2Local As Location
Const Operation = vbSrcAnd
دو تا عكس رو در مسير برنامه كپي كنيد اسمشون هم 1 و 2 باشه
كد زير برای Form_Load هست
("Set Image1 = LoadPicture(App.Path & "\Image1.jpg
("Set Image2 = LoadPicture(App.Path & "\Image2.jpg
With me
.Show
Refresh.
.AutoRedraw = True
.ScaleMode = vbPixels
End With
Image1Move = 1
Image2MoveX = 3
Image2MoveY = 3
Do
me.PaintPicture Image1, Image1Local.X, Image1Local.Y
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y
me.PaintPicture Image1, Image1Local.X, Image1Local.Y + me.ScaleHeight
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y + me.ScaleHeight
me.PaintPicture Image2, Image2Local.X, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X, Image2Local.Y + me.ScaleHeight, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y + me.ScaleHeight, , , , , , , Operation
With Image1Local
.X = .X - Image1Move
.Y = .Y - Image1Move
If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
End With
With Image2Local
.X = .X - Image2MoveX
.Y = .Y - Image2MoveY
If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
If .X + me.ScaleWidth > me.ScaleWidth Then .X = -me.ScaleWidth
If .Y + me.ScaleHeight > me.ScaleHeight Then .Y = -me.ScaleWidth
End With
DoEvents
Loop
براي اينكه دستورات بالا داخل يک حلقه بي پايان قرار مي گيره بايد در رويداد كليك فرم بنويسيد
End
فرم رو زياد بزرگ نكنيد سعي كنيد تصويرها هم اندازه باشند و فرم هم اندازه تصوير ها
براي اينكه در حركت عكس ها تنوع ايجاد كنيم در رويداد MouseMove فرم دستور زير رو بنويسيد
Image2MoveX = Int(me.ScaleWidth \ 2 - X) \ 10
Image2MoveY = Int(me.ScaleWidth \ 2 - Y) \ 10
موفق باشید
این هم آموزش مخفی کردن start :
براي مخفي كردن منوي Start به يك تابع از كتابخانه user32.dll احتياج داريد
Option Explicit
Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
حالا بايد دو تا دكمه براي مخفي و آشكار كردن منوي Startبه فرم اضافه كنيد
كد مخفي كردن Start
Hwnd1=FindWindow("Shell_traywnd","")
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_HIDEWINDOW)
كد ظاهر كردن Start
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_SHOWWINDOW)
آيكون يك برنامه رو از كالبدش كشيد بيرون و به صورت فايل آيكون ذخيره كرد
اين آموزش از سري آموزشي كتابخانه قدرتمند Shell هست
يك ماژول به پروژه اضافه كنيد و كد زير را داخلش كپي كنيد
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long
Public Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, ByVal i&, ByVal hDCDest& _
,ByVal x&, ByVal y&, ByVal flags&) As Long
Public shinfo As SHFILEINFO
يه دكمه به برنامه اضافه كنيد و يك texbox و با دو تا picbox و دو تا برچسب
و اینکه نام picbox ها رو image1 و image2 قرار بدهید
آدرس فايل اجرايي را داخل texbox بنويسيد و در كد كليك دكمه كد زير را بنويسيد
Dim hImgSmall As Long
Dim hImgLarge As Long
Dim FileName As String
Dim r As Long
FileName$ = Text1.Text
hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
Label1.Caption = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
Label2.Caption = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
image1.Picture = LoadPicture()
image2.Picture = LoadPicture()
r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, image1.hDC, 0, 0, ILD_TRANSPARENT)
r& = ImageList_Draw(hImgLarge&, shinfo.iIcon, image2.hDC, 0, 0, ILD_TRANSPARENT
چطور مي شه دكمه بستن پنجره در گوشه فرم رو غير فعال كرد
شايد غير فعال كرد دكمه هاي تمام صفحه و كمينه رو بلد باشين ولي
ديگه فرم خاصيت غير فعال كردن دكمه close رو نداره مگه كنترل بوكس فرم رو
برداريم يا اصلآ فرم رو از نوع بدون منوي بالا وتيتر انتخاب كنيم
ولي با اين كد مي تونين با داشتن تمام كنترل ها فقط دكمه كلوز رو غير فعال كنين
تابع زير رو تعريف كنيد
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Sub DisableXbutton(ByVal frmHwnd As Long)
Dim hMenu As Long
hMenu = GetSystemMenu(frmHwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (frmHwnd)
End If
End Sub
حالا كد زير رو داخل Form_Load بنويسيد
DisableXbutton (Me.hwnd)
اين تابع مي تونه كليد هاي CRTL+ALT+Delete رو غير فعال كنه
البته حتما بايد سريع به حالت قبل برگردونيد چون موندن اين حالت زياد جالب نيست
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
حالا دو تا كامند به فرم اضافه كنيد به اسم هاي Desabled و Enabled
كد دكمه غير فعال كردن
Private Sub Disabled_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub
كد فعال سازي اين كليد ها بهتر است اين كدها را در Unload فرم نيز فراخواني كنيد
Private Sub EnableD_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub
این هم یه سورس جدید برای شما. اسمش هست BinderFile. فکر کنم بشه از رو تصویر همه چیز رو فهمید :
دانلود کنید
این هم یه سورس دیگه. > ساخت PDF به وسیله ویژوال بیسیک (Create PDF in VB Source Code)
توضیحات انگلیسی :
The PDF format is very commonly used. However, its hard to create PDF files in VB. In the past you had to usually resort to buying a third party control. Before you dish out the cash for a control you should check out this sample source code. It uses the mjwPDF class to generate PDFs from within VB for free. This is a simple sample that shows you how to add text to a PDF file, save it, and view it. Its very well commented. The mjwPDF class allows you to do much more than this. Still this source sample gives you a good basic understanding. After seeing this be sure to check out our other PDF sample source code or read our Creating PDF Files in Visual Basic tutorial to see a step by step guide to creating PDF files from Visual Basic
و این هم یه سورس بسیار به درد بخور. حتما دانلود کنید.
سورس قرار دادن آیکون در منو با استفاده از توابع API.
دانلود کنید
در اين برنامه شما مي توانيد با مشخص كردن يك كلمه از متن مورد نظر بقيه متن را مشاهده كنيد. مثلا اين يك سايت فوتبال است . http://www.soccerstats.com
اين برنامه مشخصات جدول را براي شما ليست مي كنه .
دانلود کنید
و این هم یک OCX به درد بخور.
آموزش کامل DirectX-Graphic :
جلسه اول :
DirectX8 ابزاري براي ساخت تصاوير ثابت و متحرک دو بعدي و سه بعدي مي باشد .
براي کار با DirectX8 ابتدا بايستي آنرا روي سيستم خود نصب کنيد . سپس در محيط vb از منوي project گزينه References را انتخاب کنيد . در فرمي که ظاهر مي شود اطمينان حاصل کنيد که گزينه DirectX8 for VB type library فعال باشد .
براي کار با DirectX8 بايستي از تعريف نمودن شي پايه DirectX8 شروع نمود :
Dim Dx as DirectX8
شي Direct3D8 براي کنترل اشيا سه بعدي بکار مي رود :
Dim D3D as Direct3D8
شي Direct3DDevice8 ، سخت افزار مربوط به رندر تصاوير را مشخص مي کند :
Dim D3DDevice as Direct3DDevice8
حال براي شروع کار با Direct3D ، تابع ( ) initialise را تعريف مي کنيم . اگر اينکار درست انجام شود تابع ، مقدار true را برمي گرداند :
public function initialise () as boolean
Dim DispMode as D3DISPLAYMODE
شي D3DISPLAYMODE حالت نمايش را مشخص مي نمايد .
Dim D3Dwindow as D3DPRESENT_PARAMETERS
شي فوق مشخص مي کند که viewport شما چگونه باشد .
حال شي اصلي DirectX8 را مي سازيم :
Set Dx=New DirectX8
سپس شي اصلي ساخت واسط سه بعدي را مي سازيم :
()set D3D.Dx.Direct3Dcreate
سپس حالت فعلي نمايش را با دستور زير استخراج مي کنيم :
D3D.getadapterdisplaymode D3DADAPTER_DEFAULT,dispmode
حال دو حالت براي کار با DirectX داريم :
1 - windowed mode
2 - fullscrean mode
1 - براي کار با حالت پنجره اي ابتدا اين موضوع را به DirectX اطلاع مي دهيم :
D3Dwindow.windowed=1
سپس نوع referesh تصوير را مشخص مي کنيم ( در اينجا چند انتخاب وجود دارد که در صورت نياز به اطلاعات بيشتر با من تماس بگيريد . ) :
D3Dwindow.swapeffect=D3DSWAPEFFECT_COPY_VSYNC
سپس بايستي فرمت بافر نگهدارنده تصاوير را مشخص کنيم :
D3Dwindow.backbufferformat=dispmode.format
2 - براي کار با حالت تمام صفحه ، ابتدا نوع refresh را مشخص کرده سپس تعداد بافر هاي تصوير و سرانجام نوع و سايز بافر را مشخص مي نمائيم :
D3Dwindow.swapeffect=D3DSWAPEFFECT_DISCARD
D3Dwindow.backbuffercount=1
D3Dwindow.backbufferformat=dispmode.format
D3Dwindow.backbufferheight=dispmode.height
D3Dwindow.backbufferwidth=dispmode.width
سپس پنجره نمايش مشخص مي گردد :
D3Dwindow.hdevicewindow=frmMain.hwnd
@حال بايستی يک device ساخته شود که يا از طريق سخت افزار و يا نرم افزار تصاوير را رندر نمايد :
Set D3DDevice=D3Dcreatedevice(D3DADAPTER_DEFAULT
,D3DDEVTYPE_HAL,
frmMain.hwnd,D3DCREATE_SOFTWARE_VERTEXPROCESSING,
D3Dwindow)x,
end sub
درصورتي که کارت گرافيک شما امکانات رندر سخت افزاري تصاوير را ندارد از D3DDEVTYPE_REF بجاي D3DDEVTYPE_HAL استفاده کنيد .
حال بايستي روتين render را بنويسيم . البته در اين درس تصويري براي رندر نداريم و تنها چگونگي نوشتن اين روتين را بيان خواهم کرد :
۱ - ابتدا بايستي device مربوط به رندر ، قبل از کشيدن تصوير در آن پاک شود :
D3DDevice.clear 0,byval 0,D3DCLEAR_TARGET,&H0,1#,0
عدد hex اي که در دستور فوق آمده رنگ زمينه صفحه را مشخص مي کند
۲ - سپس بايستي تصاوير مورد نظر را رندر کنيم . اينکار توسط دستورات زير انجام مي شود :
D3DDevice.beginscence
all rendering calls go between these two lines '
D3DDEvice.endscence
3 - در پايان بايستي صفحه را update کنيد :
D3DDevice.present byval 0,byval 0,0,byval 0
جلسه دوم :
موضوع : بدست آوردن مشخصات و تواناييهاي گرافيکي يک سيستم توسط DirectX-Graphic
1 - شمارش تعداد آداپتورهاي گرافيکي يک سيستم : فرض کنيد متغير nAdapters متغيري از نوع long باشد . همچنين شي D3DADAPTER_IDENTIFIER8 يک ساختار است که اطلاعات مربوط به آداپتور را نگه مي دارد . در اينصورت روتين enumerateAdapters بصورت زير خواهد بود :
Dim adapterinfo as D3DADAPTER_IDENTIFIER8
Private Sub EnumerateAdapters
Dim i as integer
nadapters=D3D.Getadaptercount
براي بدست آوردن جزئيات آداپبورها بصورت زير عمل مي کنيم :
for i=0 to nadapters-1
D3D.GetadapterIdentifier i ,0,adapterinfo
نام اين آداپتور بصورت ليستي از کدهاي اسکي است که بايستي آنها را درون يک string قرار دهيم :
for j=0 to 511
name=name & chr$(adapterinfo.description(j)) x
next j
name=replace(name,chr$(0)," ") x
end sub
بنابراين در متغير name نام آداپتور قرار خواهد گرفت .
۲ - مشخص کردن نوع Rendering : فرض کنيد شي D3DCAPS8 توانايي rendering آداپتور را نشان دهد . در اينصورت روتين EnumerateDevices بصورت زير خواهد بود :
Private EnumerateDevices
On Local Error resume next
Dim Caps as D3DCAPS8
deviceindex=0 'For Example
D3D.Getdevicecaps deviceindex,D3DDEVTYPE_HAL,caps
if err.number=D3DERR_NOTAVAILABLE then
اگر آداپتور امکان رندر سخت افزاري نداشته باشد در اينصورت :
MsgBox("Reference Rasterizer(REF)") x
else
MsgBox("Hardware Acceleration(HAL)+Reference Rasterizer(REF)") x
end if
end sub
3 - شمارش تعداد Mode نمايشي آداپتور :
فرض کنيد در صورت REF بودن امکان رندر ، متغير r=2 و در غيراينصورت r=1
باشد . همچنين شي D3DDISPLAYMODE اطلاعات مدهاي نمايشي را در خود
دارد . همچنين فرض کنيد متغير nModes از نوع longباشد . در اينصورت روتين enumeratedispmodes بصورت زير خواهد بود :
Private Sub EnumerateDispModes(r as Long,n as Long) x
Dim i as integer
Dim mode_tmp as D3DDISPLAYMODE
deviceindex=0 'For Example
nModes=D3D.Getadaptermodecount(deviceindex) x
for i=0 to nModes-1
D3D.EnumAdapterModes(deviceindex,i,mode_tmp) x
ابتدا Mode ها را به دو گروه ۱۶ بيتي و ۳۲ بيتي تقسيم مي کنيم :
if mode_tmp.format=D3DFMT_R8G8B8 or mode_tmp=D3DFMT_X8R8G8B8 or mode_tmp=D3DFMT_A8R8G8B8 then
حال چک مي کنيم که device قابل پذيرش و معتبر است يا نه :
if D3D.checkdevicetype(deviceindex,r,mode_tmp.format, mode_tmp.format,Flase)>=0 then
MsgBox(mode_tmp.width & "X" & mode_tmp.height & "32 Bit
FMT:" & mode_tmp.format ) x & "
end if
else
if D3D.checkdevicetype(deviceindex,r,mode_tmp.format, mode_tmp.format,Flase)>=0 then
MsgBox(mode_tmp.width & "X" & mode_tmp.height & "16 Bit
FMT:" & mode_tmp.format ) x & "
end if
end if
next i
4 - مشخص کردن توانايي هاي آداپتور گرافيکي : فرض کنيد در صورت REF بودن امکان رندر ، متغير r=2 و در غيراينصورت r=1 باشد :
Private Sub EnumerateHardware(r as long) x
Dim caps as D3DCAPS8
D3D.Getdevicecaps deviceindex,r,caps
If Caps.MaxActiveLights = -1 Then
MsgBox "Maximum Active Lights: Unlimited" x
Else
MsgBox "Maximum Active Lights: " & Caps.MaxActiveLights
End If
MsgBox "Maximum Point Vertex size: " & Caps.MaxPointSize
MsgBox "Maximum Texture Size: " & Caps.MaxTextureWidth & "X" & Caps.MaxTextureHeight
MsgBox "Maximum Primatives in one call: " & Caps.MaxPrimitiveCount
If Caps.TextureCaps And D3DPTEXTURECAPS_SQUAREONLY Then
MsgBox "Textures must always be square" x
End If
If Caps.TextureCaps And D3DPTEXTURECAPS_CUBEMAP Then
MsgBox "Device Supports Cube Mapping" x
End If
If Caps.TextureCaps And D3DPTEXTURECAPS_VOLUMEMAP Then
MsgBox "Device Supports Volume Mapping" x
End If
If Caps.DevCaps And D3DDEVCAPS_PUREDEVICE Then
MsgBox "Device supports the Pure Device Option" x
End If
If Caps.DevCaps And D3DDEVCAPS_HWTRANSFORMANDLIGHT Then
MsgBox "Device supports hardware transform and lighting" x
End If
If Caps.DevCaps And D3DDEVCAPS_HWRASTERIZATION Then
MsgBox "Device can use Hardware Rasterization" x
End If
If Caps.Caps2 And D3DCAPS2_CANCALIBRATEGAMMA Then
MsgBox "Device can Calibrate Gamma" x
End If
If Caps.Caps2 And D3DCAPS2_CANRENDERWINDOWED Then
MsgBox "Device can Render in Windowed Mode" x
End If
If Caps.Caps2 And D3DCAPS2_FULLSCREENGAMMA Then
MsgBox "Device can calibrate gamma in fullscreen mode" x
End If
If Caps.RasterCaps And D3DPRASTERCAPS_FOGRANGE Then
MsgBox "Device supports range based fog calculations" x
End If
If Caps.RasterCaps And D3DPRASTERCAPS_ANISOTROPY Then
MsgBox "Device supports Anisotropic Filtering" x
End If
If Caps.RasterCaps And D3DPRASTERCAPS_ZBUFFERLESSHSR Then
MsgBox "Device does not require a Z-Buffer/Depth Buffer" x
End If
جلسه سوم :
موضوع : رسم اشکال دو بعدي
مروري بر object هاي DirectX8
1 - DirectX8 : اين شي ، شي مرکزي براي directX است و به شما امکان دسترسي به توابع و اشيا DirectX را مي دهد .
۲ - Direct3D8 : شي اصلي براي کار با محيط سه بعدي مي باشد . هدف از آن ، ساخت Direct3DDevice8 است و همچنين شامل توابعي براي مشخص کردن توانايي هاي کارت گرافيک است .
۳ - Direct3DDevice8 : اين شي مسئول ساخت بافتها textures ، مديريت نورها در يک صحنه ، مديريت مواد materials و همچنين render صحنه است . در واقع اين شي ، قلب نمايشي کار شماست .
4 - D3DX8 : گر چه هميشه نيازي به استفاده از اين شي نيست ، اما اين شي شامل توابعي براي ساخت برنامه هاي userfriendly تر توسط DirectX است . مثلاً ساخت اشيا سه بعدي ( مثل کره ، مکعب و ... ) ، ساخت بافتها ، ساخت سطوح و غيره
شروع کار براي رسم اشيا دوبعدي
ابتدا ثابت FVF را تعريف مي کنيم . اين ثابت توصيف " فرمت قابل انعطاف نقطه flexible-vertex-format " براي يک vertex دو بعدي انتقال يافته و ساده شده مي باشد .
سپس بايستي يک ساختار براي توصيف اين vertex معرفي کنيم :
Const FVF = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Private Type TLVERTEX
X As Single
Y As Single
Z As Single
rhw As Single
color As Long
specular As Long
tu As Single
tv As Single
End Type
فرض کنيد بخواهيم يک مربع را در صفحه رسم کنيم . براي رسم آن نياز به 4 عدد vertex داريم . بنابراين آرايه TriStrip را از نوع TLVERTEX تعريف ميکنيم :
Dim TriStrip (0 To 3) As TLVERTEX
حال به سراغ تابع initialize که در درس ۱ با آن آشنا شديد مي رويم و دستورات زير را به آن اضافه مي کنيم :
Private Function Initialize as boolean
.
.
.
ابتدا سيستم سايه زني vertex را طوري تنظيم مي کنيم که از FVF استفاده کند .
D3DDevice.SetVertexShader FVF
حال سيستم lighting را براي vertex هاي دو بعدي غير فعال مي کنيم زيرا نيازي به آن نداريم :
D3DDevice.SetRenderState D3DRS_LIGHTING,false
حال بايستي تابع initializeGeometry را اجرا کنيم . اين تابع را در ادامه توضيح خواهم داد . اگر نتيجه اين تابع true باشد دراينصورت initialize به درستي انجام شده است :
if initializeGeometry()=true then initialize=true
end function
تابع initializeGeometry در اين درس ، تابعي ساده است که تنها آرايه Vertex ها را مقدار دهي مي کند . براي رسم يک مربع نياز به مقداردهي ۴ vertex در جهت عقربه هاي ساعت داريم ( اين مربع شامل ۲ مثلث است )
Private Function InitialiseGeometry() As Boolean
On Error GoTo BOut:
color = RGB(200, 100, 0)
TriStrip(0) = CreateTLVertex(100, 100, 0, 1, color, 0, 0, 0)
TriStrip(1) = CreateTLVertex(300, 100, 0, 1, color, 0, 0, 0)
TriStrip(2) = CreateTLVertex(100, 300, 0, 1, color, 0, 0, 0)
TriStrip(3) = CreateTLVertex(300, 300, 0, 1, color, 0, 0, 0)
InitialiseGeometry = True
Exit Function
BOut:
InitialiseGeometry = False
End Function
همانطور که مشاهده مي کنيد براي تعريف vertex از تابع CreateTLVERTEX استفاده شده است . اين تابع صرفاً مقادير ساختار TLVERTEX را مقداردهي مي کند :
Private Function CreateTLVertex(X As Single, Y As Single, Z As Single, rhw As Single, color As Long, specular As Long, tu As Single, tv As Single) As TLVERTEX
نکته : ضمن اينکه شما مي توانيد مقادير اعشاري floating point را براي مختصاتهاي x و y و z بکار ببريد ، Direct3D مختصاتها را با گردکردن آنها تخمين مي زند و بنابراين ممکنست باعث ايجاد نتايج ناخواسته شود .
CreateTLVertex.X = X
CreateTLVertex.Y = Y
CreateTLVertex.Z = Z
CreateTLVertex.rhw = rhw
CreateTLVertex.color = color
CreateTLVertex.specular = specular
CreateTLVertex.tu = tu
CreateTLVertex.tv = tv
End Function
حال بايستي تابع Render را بنويسيم :
Public Sub Render()
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, TriStrip(0), Len(TriStrip(0))x
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
ساختار اصلي براي اجراي توابع فوق بصورت زير است :
--Main part--
Initialize
Do While yourevent=true
Render
DoEvents
Loop
جلسه چهارم :
موضوع : آشنايي با برخي اصطلاحات
1- Mesh : مش ، مجموعه اي از face ها است که يک شي سه بعدي را روي صفحه تشکيل مي دهند .
۲ - Face : يک چند ضلعی است که توسط مجموعه ای از نقاط به نام vertex ساخته مي شود .
۳ - Vertex : يک نقطه در فضاي سه بعدي است که براي دادن موقعيت ، scale و زاويه يک face استفاده مي شود .
۴ - Direct3D از شيي بنام D3DVERTEX براي نمايش يک Vertex استفاده مي کند . براي ساخت face نيز از آرايه اي از vertex ها استفاده مي شود . آرايه هميشه بايستي قابل تقسيم به سه باشد زيرا اشکال از face هاي مثلثي ساخته مي شوند . هنگاميکه اين مثلثها کنار هم گذاشته شوند ، شي سه بعدي را مي سازند . Direct3D از بافري با نام Index Buffer استفاده مي کند که با direct3D مي گويد که با چه ترتيبي vertex ها را رسم نمايد . index ها بايستي هميشه در جهت عقربه هاي ساعت مشخص شوند .
جلسه پنجم :
موضوع : اختصاص بافت Texture به اشکال دو بعدي
در اين درس مي خواهيم يک مربع که داراي بافت مي باشد را رسم کنيم . براي اينکار از کتابخانه کمکي D3DX8 استفاده مي کنيم . همچنين شي Direct3DTexture8 را نيز استفاده مي نمائيم .
Dim D3DX as D3DX8
Dim Texture as Direct3DTexture8
حال بايستي در تابع Initialize بافت مربوطه را از روي يک فايل تصويري load کنيم :
Private Function Initialize as boolean
.
.
.
Set Texture=D3DX8.CreateTextureFromFile(D3DDevice,app. path & yourfilename) x
end function
تابع Render نيز بصورت زير خواهد بود :
Private Sub Render
D3DDevice.clear 0,byval 0,D3DCLEAR_TARGET,0,1#,0
D3DDevice.beginscence
D3DDevice.SetTexture 0,Texture
D3DDevice.DrawprimitiveUP D3DPT_TRIANGLESTRIP,2,Tripstrip(0),len(Tristrip(0) )x
.
.
.
end function
جلسه ششم :
موضوع : مفاهيم اوليه رسم اشکال سه بعدي در DirectX 8
در اين درس با استفاده از Direct3D يک مکعب را رسم مي کنيم . براي اين منظور ابتدا نياز به يک بافر داريم که بتوانيم شکل مورد نظر خود را در آن ذخيره کنيم :
Dim VBuffer as Direct3DVertexBuffer8
براي رسم مکعب از vertex هاي سه بعدي استفاده مي کنيم . براي اينکار نياز به تعريف يک تايپ جديد داريم :
Private Type LITVERTEX
x as single
y as single
z as single
color as long
specular as long
tu as single
tv as single
end type
توصيف گر اين فرمت ، بصورت زير است :
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)x
براي توصيف مکعب در اين درس از روشي غيرکارامد استفاده شده است . به اين ترتيب که از ۳۶ عدد vertex استفاده شده ( در درسهاي بعدي متدهايي معرفي خواهند شد که اجازه مي دهند از ۸ عدد vertex باري توصيف مکعب استفاده کنيد ) .
Dim cube(35) as LITVERTEX
سپس بايد يکسري ماتريس سه بعدي تعريف کنيم :
اولين ماتريس ، matworld است که نشان مي دهد چگونه vertex ها در فضاي سه بعدي قرار گرفته اند . دومين ماتريس ، matview است که نشان مي دهد دوربين ( نقطه ديد ) در کجا قرار گرفته و سومين ماتريس ، matproj است که نشان مي دهد دوربين چگونه دنياي سه بعدي را روي صفحه دو بعدي نشان مي دهد :
Dim matworld as D3DMATRIX
Dim matview as D3DMATRIX
Dim matproj as D3DMATRIX
در تابع Initialize قبل از ساخت device بايستي چک کنيم که آيا مي توانيم از يک بافر Z شانزده بيتي استفاده کنيم يا نه ؟
If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
D3DWindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer
حال بايستي متد D3DCreateDevice را اجرا کنيد . سپس بايد سيستم سايه زني vertex را با فرمت vertex مان تنظيم کنيم :
D3DDevice.SetVertexShader Lit_FVF
همچنين سيستم نورپردازي را غير فعال مي کنيم :
D3DDevice.SetRenderState D3DRS_LIGHTING, False
Direct3D هيچ مثلثي را که در ديد شما نباشد رسم نخواهد کرد . براي متوقف کردن اين امر بايستي حالت culling آنرا متوقف کنيد همچنين vertex ها را بترتيب عقربه هاي ساعت معرفي کنيد :
D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
سپس بايد فرمت بافر Z را فعال سازيد :
D3DDevice.SetRenderState D3DRS_ZENABLE, 1
آموزش کامل DirectX-Graphic :
جلسه هفتم :
تعريف ماترسها
1 - World Matrix : اين ماتريس براي نگهداري تمام vertex هايي که براي رندر فرستاده مي شوند بکار مي رود . مقادير موجود در اين ماتريس ، موقعيت يک vertex را مي تواند تغيير دهد . يکي از کاربردهاي آن انجام دورانrotation ، انتقال transmittion و تغییر اندازه scaling است .
برای ساخت اين ماتريس از دستور زير استفاده می کنيم :
D3DXMatrixIdentify matworld
حال اين ماتريس را براي device مربوطه تاييد مي کنيم :
D3DDevice.SetTransform D3DTS_WORLD,matworld
۲ - View Matrix : اين ماتريس را بعنوان يک دوربين در نظر بگيريد که بوسيله يک نقطه شروع و يک نقطه پاياني مشخص مي شود ( مشابه يک up vector که معمولاً در طول محور y رو به بالاست ) :
D3DXMatrixLookAtLH matView, MakeV(0, 5, 9), MakeV(0, 0, 0),MakeV(0, 1, 0) x
D3DDevice.SetTransform D3DTS_VIEW, matView
تابع MakeV که در اينجا استفاده شده بصورت زير است :
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR
MakeV.x = x
MakeV.y = y
MakeV.z = z
End Function
۳ - Projection Matrix : اين ماتريس مشخص مي کند چه منطقه اي از فضاي جهاني براي رندر کردن visible باشد . همچنين مشخص مي کند چه مقدار مي توانيم بطور افقي ببينيم ( زاويه ديد بزرگتر منجر به ديد بزرگتر مي شود ) :
D3DXMatrixPerspectiveFovLH matProj, pi / 4, 1, 0.1, 500
در دستور فوق از زاويه ديد pi/4 راديان استفاده شده همچنين نسبت 1:1 استفاده شده است . قسمتهاي سوم و چهارم مشخص مي کنند فقط مثلثهايي کشيده شوند که با ابعاد بزرگتر از يکدهم دوربين و کوچکتر از ۵۰۰ برابر دوربين هستند .
حال دستور اختصاص به device را خواهيم داشت :
D3DDevice.SetTransform D3DTS_PROJECTION, matProj
بعد از تعريف ماتريسها بايستي تابع InitializeGeometry را صدا کنيم . در اين تابع از يک ثابت با نام DFC استفاده شده است . اگر DFC=1 باشد مکعب بطور کامل کشيده مي شود و اگر بزرگتر از يک باشد ، face هاي آن جدا از هم ديده خواهند شد . همچنين توجه کنيد که از بافرهاي vertex براي ذخيره داده vertex ها استفاده شده است . ساختار اين تابع بصورت زير خواهد بود :
۱ - پر کردن ساختارهاي vertex
'Front
Cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0)x
Cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0)x
Cube(2) = CreateLitVertex(-1, -1, DFCcolor, 0, 0, 0)x
Cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0)x
Cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0)x
'Back
Cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0)x
Cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)x
Cube(8) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)x
Cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0)x
Cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0)x
Cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0)x
'Right
Cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0)x
Cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)x
Cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)x
Cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0)x
Cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0)x
Cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0)x
'Left
Cube(18) = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0)x
Cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)x
Cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0)x
Cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0)x
Cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0)x
'Top
Cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0)x
Cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0)x
Cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0)x
Cube(27) = CreateLitVertex(1, DFC, 1, cocolor, 0, 0, 0)x
Cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0)x
'Bottom
Cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0)x
Cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)x
Cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)x
Cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0)x
Cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0)x
Cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0)x
2 - ساخت يک بافر vertex خالي با سايز مورد نظر :
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(Cube(0)) * 36, 0, Lit_FVF, D3DPOOL_DEFAULT)x
3 - پر کردن بافر مربوطه با داده ها :
D3DVertexBuffer8SetData VBuffer, 0, Len(Cube(0)) * 36, 0, Cube(0)x
حال به سراغ روتين Render مي رويم :
Public Sub Render
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0 '//Clear the screen black
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(Cube(0))x
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
ساختار اصلي برنامه بصورت زير خواهد بود :
Dim RotateAngle As Single
Dim matTemp As D3DMATRIX '//To hold temporary
call Initialize
Do While bRunning
RotateAngle = RotateAngle + 0.1
If RotateAngle >= 360 Then RotateAngle = RotateAngle - 360
D3DXMatrixIdentity matWorld '//Reset our world matrix
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, RotateAngle * (pi / 180) x
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (pi / 180) x
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matWorld
Render
DoEvents
Loop
جلسه هشتم :
موضوع : نورپردازي و اختصاص بافت به اشيا سه بعدي
در اين درس مي خواهيم به مکعب درس قبل بافت اختصاص داده و نيز آنرا با يک منبع نور ، نورپردازي کنيم .
ابتدا تايپ vertex ها را بصورت زير تعريف مي کنيم :
Private Type UnlitVertex
X As Single
Y As Single
Z As Single
nx As Single
ny As Single
nz As Single
tu As Single
tv As Single
End Type
توصيفگر اين فرمت بصورت زير خواهد بود :
Const Unlit_FVF = (D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1)
همچنين مکعب ما توسط ارايه زير مشخص مي شود :
Dim Cube2(35) As UnlitVertex
دو ثابت pi و rad را نيز بصورت زير تعريف مي کنيم :
Const pi As Single = 3.141592
Const Rad = pi / 180
براي اختصاص بافت به مکعب ، از شي Direct3DTexture8 استفاده مي شود :
Dim CubeTexture As Direct3DTexture8
براي نورپردازي ، از شي D3DLIGHT8 استفاده مي شود :
Dim Lights As D3DLIGHT8
تغييرات مورد نياز در تابع Initialize
بعد از ساخت شي D3DDevice در اين تابع ، پارامترهاي آنرا بصورت زير تنظيم مي کنيم :
D3DDevice.SetVertexShader Unlit_FVF
D3DDevice.SetRenderState D3DRS_LIGHTING, 1
D3DDevice.SetRenderState D3DRS_ZENABLE, 1
D3DDevice.SetRenderState D3DRS_AMBIENT, &H202020
مقدار ambient يک کد هگزا RRGGBB است .
بعد از دستورات فوق ماتريسهاي matworld ، matview و matproj مطابق مطابل درس قبل تعريف مي شوند . پس از آن بايستي بافت مکعب را از درون فايل تصويري مورد نظرتان load کنيد :
Set CubeTexture = D3DX.CreateTextureFromFileEx(D3DDevice, yourfilename, 128, 128, D3DX_DEFAULT, 0, DispMode.Format, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)x
حال بايستي تابع InitializeGeometry صدا زده شود و سپس تابع SetupLights فراخواني شوند . ابتدا به توضيح تابع InitializeGeometry مي پردازيم :
Private Function InitialiseGeometry() As Boolean
ابتدا يک بردار نرمال تعريف مي کنيم :
Dim vN As D3DVECTOR
سپس آرايه cube2 را با مقادير عددي پر مي کنيم . نرمالهاي تمام vertex ها را ابتدا با بردار
[0,0,0 ] تعريف مي کنيم . اين مقدا بعداً تغيير خواهد کرد :
Cube2(0) = CreateVertex(-1, -1, 1, 0, 0, 0, 0, 0)
Cube2(1) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
Cube2(2) = CreateVertex(-1, 1, 1, 0, 0, 0, 0, 1)
vN = GenerateTriangleNormals(Cube2(0), Cube2(1), Cube2(2))
Cube2(0).nx = vN.X: Cube2(0).ny = vN.Y: Cube2(0).nz = vN.Z
Cube2(1).nx = vN.X: Cube2(1).ny = vN.Y: Cube2(1).nz = vN.Z
Cube2(2).nx = vN.X: Cube2(2).ny = vN.Y: Cube2(2).nz = vN.Z
Cube2(3) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
Cube2(4) = CreateVertex(-1, -1, 1, 0, 0, 0, 0, 0)
Cube2(5) = CreateVertex(1, -1, 1, 0, 0, 0, 1, 0)
vN = GenerateTriangleNormals(Cube2(3), Cube2(4), Cube2(5))
Cube2(3).nx = vN.X: Cube2(3).ny = vN.Y: Cube2(3).nz = vN.Z
Cube2(4).nx = vN.X: Cube2(4).ny = vN.Y: Cube2(4).nz = vN.Z
Cube2(5).nx = vN.X: Cube2(5).ny = vN.Y: Cube2(5).nz = vN.Z
'Back
Cube2(6) = CreateVertex(-1, 1, -1, 0, 0, 0, 0, 1)
Cube2(7) = CreateVertex(1, 1, -1, 0, 0, 0, 1, 1)
Cube2(8) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
vN = GenerateTriangleNormals(Cube2(6), Cube2(7), Cube2(8))
Cube2(6).nx = vN.X: Cube2(6).ny = vN.Y: Cube2(6).nz = vN.Z
Cube2(7).nx = vN.X: Cube2(7).ny = vN.Y: Cube2(7).nz = vN.Z
Cube2(8).nx = vN.X: Cube2(8).ny = vN.Y: Cube2(8).nz = vN.Z
Cube2(9) = CreateVertex(1, -1, -1, 0, 0, 0, 1, 0)
Cube2(10) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
Cube2(11) = CreateVertex(1, 1, -1, 0, 0, 0, 1, 1)
vN = GenerateTriangleNormals(Cube2(9), Cube2(10), Cube2(11))
Cube2(9).nx = vN.X: Cube2(9).ny = vN.Y: Cube2(9).nz = vN.Z
Cube2(10).nx = vN.X: Cube2(10).ny = vN.Y: Cube2(10).nz = vN.Z
Cube2(11).nx = vN.X: Cube2(11).ny = vN.Y: Cube2(11).nz = vN.Z
'Right
Cube2(12) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
Cube2(13) = CreateVertex(-1, 1, 1, 0, 0, 0, 1, 1)
Cube2(14) = CreateVertex(-1, 1, -1, 0, 0, 0, 1, 0)
vN = GenerateTriangleNormals(Cube2(12), Cube2(13), Cube2(14))
Cube2(12).nx = vN.X: Cube2(12).ny = vN.Y: Cube2(12).nz = vN.Z
Cube2(13).nx = vN.X: Cube2(13).ny = vN.Y: Cube2(13).nz = vN.Z
Cube2(14).nx = vN.X: Cube2(14).ny = vN.Y: Cube2(14).nz = vN.Z
Cube2(15) = CreateVertex(-1, 1, 1, 0, 0, 0, 1, 1)
Cube2(16) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
Cube2(17) = CreateVertex(-1, -1, 1, 0, 0, 0, 0, 1)
vN = GenerateTriangleNormals(Cube2(15), Cube2(16), Cube2(17))
Cube2(15).nx = vN.X: Cube2(15).ny = vN.Y: Cube2(15).nz = vN.Z
Cube2(16).nx = vN.X: Cube2(16).ny = vN.Y: Cube2(16).nz = vN.Z
Cube2(17).nx = vN.X: Cube2(17).ny = vN.Y: Cube2(17).nz = vN.Z
'Left
Cube2(18) = CreateVertex(1, 1, -1, 0, 0, 0, 1, 0)
Cube2(19) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
Cube2(20) = CreateVertex(1, -1, -1, 0, 0, 0, 0, 0)
vN = GenerateTriangleNormals(Cube2(18), Cube2(19), Cube2(20))
Cube2(18).nx = vN.X: Cube2(18).ny = vN.Y: Cube2(18).nz = vN.Z
Cube2(19).nx = vN.X: Cube2(19).ny = vN.Y: Cube2(19).nz = vN.Z
Cube2(20).nx = vN.X: Cube2(20).ny = vN.Y: Cube2(20).nz = vN.Z
Cube2(21) = CreateVertex(1, -1, 1, 0, 0, 0, 0, 1)
Cube2(22) = CreateVertex(1, -1, -1, 0, 0, 0, 0, 0)
Cube2(23) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
vN = GenerateTriangleNormals(Cube2(21), Cube2(22), Cube2(23))
Cube2(21).nx = vN.X: Cube2(21).ny = vN.Y: Cube2(21).nz = vN.Z
Cube2(22).nx = vN.X: Cube2(22).ny = vN.Y: Cube2(22).nz = vN.Z
Cube2(23).nx = vN.X: Cube2(23).ny = vN.Y: Cube2(23).nz = vN.Z
'Top
Cube2(24) = CreateVertex(-1, 1, 1, 0, 0, 0, 0, 1)
Cube2(25) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
Cube2(26) = CreateVertex(-1, 1, -1, 0, 0, 0, 0, 0)
vN = GenerateTriangleNormals(Cube2(24), Cube2(25), Cube2(26))
Cube2(24).nx = vN.X: Cube2(24).ny = vN.Y: Cube2(24).nz = vN.Z
Cube2(25).nx = vN.X: Cube2(25).ny = vN.Y: Cube2(25).nz = vN.Z
Cube2(26).nx = vN.X: Cube2(26).ny = vN.Y: Cube2(26).nz = vN.Z
Cube2(27) = CreateVertex(1, 1, -1, 0, 0, 0, 1, 0)
Cube2(28) = CreateVertex(-1, 1, -1, 0, 0, 0, 0, 0)
Cube2(29) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)
vN = GenerateTriangleNormals(Cube2(27), Cube2(28), Cube2(29))
Cube2(27).nx = vN.X: Cube2(27).ny = vN.Y: Cube2(27).nz = vN.Z
Cube2(28).nx = vN.X: Cube2(28).ny = vN.Y: Cube2(28).nz = vN.Z
Cube2(29).nx = vN.X: Cube2(29).ny = vN.Y: Cube2(29).nz = vN.Z
'Top
Cube2(30) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
Cube2(31) = CreateVertex(1, -1, 1, 0, 0, 0, 1, 1)
Cube2(32) = CreateVertex(-1, -1, 1, 0, 0, 0, 0, 1)
vN = GenerateTriangleNormals(Cube2(30), Cube2(31), Cube2(32))
Cube2(30).nx = vN.X: Cube2(30).ny = vN.Y: Cube2(30).nz = vN.Z
Cube2(31).nx = vN.X: Cube2(31).ny = vN.Y: Cube2(31).nz = vN.Z
Cube2(32).nx = vN.X: Cube2(32).ny = vN.Y: Cube2(32).nz = vN.Z
Cube2(33) = CreateVertex(1, -1, 1, 0, 0, 0, 1, 1)
Cube2(34) = CreateVertex(-1, -1, -1, 0, 0, 0, 0, 0)
Cube2(35) = CreateVertex(1, -1, -1, 0, 0, 0, 1, 0)
vN = GenerateTriangleNormals(Cube2(33), Cube2(34), Cube2(35))
Cube2(33).nx = vN.X: Cube2(33).ny = vN.Y: Cube2(33).nz = vN.Z
Cube2(34).nx = vN.X: Cube2(34).ny = vN.Y: Cube2(34).nz = vN.Z
Cube2(35).nx = vN.X: Cube2(35).ny = vN.Y: Cube2(35).nz = vN.Z
سپس يک بافر vertex خالي با ساير موردنظر مي سازيم :
Set VBuffer = D3DDevice.CreateVertexBuffer(Len(Cube2(0)) * 36, 0, Unlit_FVF, D3DPOOL_DEFAULT)x
سپس اين بافر vertex ساخته شده را با داده هاي cube2 پر مي کنيم :
D3DVertexBuffer8SetData VBuffer, 0, Len(Cube2(0)) * 36, 0, Cube2(0)x
در دستورات فوق تابعي با نام GenerateTraingleNormals استفاده شده است . اين تابع دو بردار را از روي سه vertex داده شده با آن مي سازد و سپس ضرب برداري ايندو را حساب مي کند و سپس بردار حاصله را نرمال مي نمايد :
Private Function GenerateTriangleNormals(p0 As UnlitVertex, p1 As UnlitVertex, p2 As UnlitVertex) As D3DVECTOR
Dim v01 As D3DVECTOR 'Vector from points 0 to 1
Dim v02 As D3DVECTOR 'Vector from points 0 to 2
Dim vNorm As D3DVECTOR 'The final vector
'Create the vectors from points 0 to 1 and 0 to 2
D3DXVec3Subtract v01, MakeVector(p1.X, p1.Y, p1.Z), MakeVector(p0.X, p0.Y, p0.Z)
D3DXVec3Subtract v02, MakeVector(p2.X, p2.Y, p2.Z), MakeVector(p0.X, p0.Y, p0.Z)
'Get the cross product
D3DXVec3Cross vNorm, v01, v02
'Normalize this vector
D3DXVec3Normalize vNorm, vNorm
'Return the value
GenerateTriangleNormals.X = vNorm.X
GenerateTriangleNormals.Y = vNorm.Y
GenerateTriangleNormals.Z = vNorm.Z
End Function
حال به توضيح تابع SetupLights مي پردازيم . در اين تابع دو شي D3DMATERIAL8 و D3DCOLORVALUE استفاده شده است :
Private Function SetupLights() As Boolean
Dim Mtrl As D3DMATERIAL8, Col As D3DCOLORVALUE
Col.a = 1: Col.r = 1: Col.g = 1: Col.b = 1
Mtrl.Ambient = Col
Mtrl.diffuse = Col
D3DDevice.SetMaterial Mtrl
Lights.Type = D3DLIGHT_DIRECTIONAL
Lights.diffuse.r = 1
Lights.diffuse.g = 1
Lights.diffuse.b = 1
Lights.Direction = MakeVector(1, -1, 0)
D3DDevice.SetLight 0, Lights
SetupLights = True
End Function
تابع Render بصورت زير است :
Public Sub Render()
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0 '//Clear the screen black
D3DDevice.BeginScene
'Draw the cube
D3DDevice.SetTexture 0, CubeTexture
D3DDevice.SetStreamSource 0, VBuffer, Len(Cube2(0))
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
ساختار اصلي برنامه بصورت زير است :
Call Initialise
Do While bRunning
RotateAngle = RotateAngle + 0.1
If RotateAngle >= 360 Then RotateAngle = RotateAngle - 360
D3DXMatrixIdentity matWorld
D3DXMatrixIdentity matTemp
D3DXMatrixRotationX matTemp, RotateAngle * (pi / 180)
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationY matTemp, RotateAngle * (pi / 180)
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DXMatrixIdentity matTemp
D3DXMatrixRotationZ matTemp, RotateAngle * (pi / 180)
D3DXMatrixMultiply matWorld, matWorld, matTemp
D3DDevice.SetTransform D3DTS_WORLD, matWorld
D3DDevice.LightEnable 0, 0 خاموش کردن light
D3DDevice.LightEnable 0, 1 روشن کردن light
Render
DoEvents
Loop
در متد D3DDevice.LightEnable پارامتر اول شماره منبع نور و پارمتر دوم enable بودن آنرا نشان مي دهد .
جلسه نهم :
موضوع :ترسيم متن دو بعدي در DirectX
در اين درس روش ترسيم متن با دو نوع فونت را نشان خواهم داد :
براي رسم يک متن با فونت تعريف شده در سيستم از شي D3DXFont استفاده مي کنيم :
Dim MainFont as D3DXFont
Dim MainFontDesc as IFont
Dim TextRect as RECT
Dim fnt as new stdFont
در حاليکه براي ايجاد يک متن با فونت custom ابتدا يک texture تعريف مي کنيم :
Dim fntTex as Direct3DTexture8
همچنين براي ترسيم هر کاراکتر يک آرايه vertex اي را از نوع TLVERTEX تعريف مي نمائيم :
Dim vertchar(3) as TLVERTEX
حال به سراغ تابع Initialize مي رويم . در اين تابع ابتدا دستورات مربوط به ايجاد اشيا D3D و D3Dx را قرا دهيد سپس دستورات مربوط به اختصاص آداپتور و نيز ايجاد شي D3DDevice را انجام مي دهيم . حال دستورات تنظيم shader و rendering را مي آوريم :
D3DDevice.SetVertexShader TL_FVF
D3DDevice.SetRenderState D3DRS_LIGHTING, False
سپس تنظيمات پارامترهاي transparency براي rendering را انجام مي دهيم :
D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True
حال بايستي textureرا طوري ----- کنيم که در زمان stretch شدن يا squash شدن بهتر بنظر برسد :
D3DDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
D3DDevice.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
حال ----- Z را فعال مي کنيم :
D3DDevice.SetRenderState D3DRS_ZENABLE, 1
سپس ماتريسهاي world ، view و projection را تنظيم مي کنيم :
D3DXMatrixIdentity matWorld
D3DDevice.SetTransform D3DTS_WORLD, matWorld
D3DXMatrixLookAtLH matView, MakeVector(0, 9, -9), MakeVector(0, 0, 0), MakeVector(0, 1, 0)
D3DDevice.SetTransform D3DTS_VIEW, matView
D3DXMatrixPerspectiveFovLH matProj, pi / 4, 1, 0.1, 500
D3DDevice.SetTransform D3DTS_PROJECTION, matProj
حال به بخش تنظيم پارامترهاي فونت مي رسيم . در مورد فونت دو بعدي عادي :
fnt.Name = "Verdana"x
fnt.Size = 18
fnt.Bold = True
Set MainFontDesc = fnt
Set MainFont = D3DX.CreateFont(D3DDevice, MainFontDesc.hFont)x
و در مورد فونت custom :
Set fntTex = D3DX.CreateTextureFromFileEx(D3DDevice, yourfilename, 256, 128, D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_POINT, &HFF00FF00, ByVal 0, ByVal 0)x
end function
روتين Render بصورت زير خواهد بود :
Public Sub Render()x
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
براي رندر متن با فونت عادي بصورت زير عمل مي کنيم :
TextRect.Top = 440
TextRect.Left = 1
TextRect.bottom = 480
TextRect.Right = 640
D3DX.DrawText MainFont, &HFFCCCCFF, "Current Frame Rate: " & FPS_Current, TextRect, DT_TOP Or DT_CENTER
براي رندر متن با فونت custom بصورت زير عمل مي کنيم :
RenderStringFromCustomFont_2D "Hamed Sheidaian", 1, 1, 16, 16
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
همانطور که مشاهده مي کنيد از روتيني با نام RenderStringFromCustomFont_2D استفاده شده است :
Private Sub RenderStringFromCustomFont_2D(strText As String, startX As Single, StartY As Single, Height As Integer, Width As Integer)x
Dim I As Integer
Dim CharX As Integer, CharY As Integer
Dim Char As String
Dim LinearEntry As Integer
If Len(strText) = 0 Then Exit Sub
For I = 1 To Len(strText)x
1 - ابتدا بايستي مختصات texture را انتخاب کنيم . براي اينکار بايستي هر entry را در texture جدا کنيم :
Char = Mid$(strText, I, 1)x
If Asc(Char) >= 65 And Asc(Char) <= 90 Then
LinearEntry = Asc(Char) - 65
ElseIf Asc(Char) >= 97 And Asc(Char) <= 122 Then
LinearEntry = Asc(Char) - 71
ElseIf Asc(Char) >= 48 And Asc(Char) <= 57 Then
LinearEntry = Asc(Char) + 4
ElseIf Char = " " Then
LinearEntry = 63
ElseIf Char = "." Then
LinearEntry = 62
ElseIf Char = ";" Then
LinearEntry = 66
ElseIf Char = "/" Then
LinearEntry = 64
ElseIf Char = "," Then
LinearEntry = 65
End If
بعد از مقداردهي LinearEntry بايستي مختصات grid کاراکتر را پردازش کنيم :
If LinearEntry <= 15 Then
CharY = 0
CharX = LinearEntry
End If
If LinearEntry >= 16 And LinearEntry <= 31 Then
CharY = 1
CharX = LinearEntry - 16
End If
If LinearEntry >= 32 And LinearEntry <= 47 Then
CharY = 2
CharX = LinearEntry - 32
End If
If LinearEntry >= 48 And LinearEntry <= 63 Then
CharY = 3
CharX = LinearEntry - 48
End If
If LinearEntry >= 64 And LinearEntry <= 79 Then
CharY = 4
CharX = LinearEntry - 64
End If
۲ - حال بايستي vertex هاي مورد نياز براي رسم کاراکتر را توليد کنيم :
vertChar(0) = CreateTLVertex(startX + (Width * I), StartY, 0, 1, &HFFFFF
(F,0,(1/16)*CharX,(1/8)*CharY
vertChar(1) = CreateTLVertex(startX + (Width * I) + Width, StartY, 0, 1, &HFFFFF
(F, 0,((1 / 16) * CharX) + (1 / 16), (1 / 8) * CharY
vertChar(2) = CreateTLVertex(startX + (Width * I), StartY + Height, 0, 1, &HFFFFF
((F, 0, (1 / 16) * CharX, ((1 / 8) * CharY) + (1 / 8
vertChar(3) = CreateTLVertex(startX + (Width * I) + Width, StartY + Height, 0, 1, HFFFFFF, 0, ((1 / 16) * CharX) + (1 / 16), ((1 / 8) * CharY) + (1 / 8))x
۳ - رندر vertex ها :
D3DDevice.SetTexture 0, fntTex
D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, vertChar(0), Len(vertChar(0))x
Next I
End Sub
جلسه دهم (پایان)
موضوع : ترسيم اشيا سه بعدي با استفاده از شي Mesh
شي Mesh که جزو اشيا D3DX مي باشد امکان ترسيم اشيا سه بعدي پايه و همچنين ترسيم مش هاي custom دلخواه را به شما مي دهد . در اين درس از شي Mesh براي ترسيم يک کره ( sphere ) استفاده مي کنيم . ابتدا متغير sphere را بصورت زير تعريف کنيد :
Dim sphere as D3DXMesh
همچنين براي نورپردازي و اختصاص material به کره به متغيرهاي زير نياز داريم :
Dim d3dLight As D3DLIGHT8
Dim material As D3DMATERIAL8
Dim Col As D3DCOLORVALUE
در تابع Initial پس از ساخت اشيا D3D و D3DX و D3DDevice بايستي پارامترهاي رنگ ، نورپردازي و اختصاص ماده ( material ) به کره را بصورت زير تنظيم کنيد :
Col.a = 1
Col.b = 1
Col.g = 1
Col.r = 1
d3dLight.Type = D3DLIGHT_DIRECTIONAL
d3dLight.diffuse = Col
d3dLight.Direction = vec(-1, -1, -1)x
نورپردازي از نوع جهت دار با رنگ col و بردار جهت (1-,1-,1-) است .
نکته :
رنگ ambient رنگي است که هنگاميکه جسم در سايه باشد به خود مي گيرد . بعبارت ديگر اين رنگ را جسم وقتي که در معرض يک نور ambient باشد از خود منعکس مي کند .
رنگ diffuse رنگي است که هنگاميکه جسم در معرض نور مستقيم قرار بگيرد از خود منعکس مي کند .
material.Ambient = Col
material.diffuse = Col
d3dDevice.SetMaterial material
d3dDevice.SetLight 0, d3dLight
d3dDevice.LightEnable 0, 1
سپس بايستي پارامترهاي rendering را تنظيم کنيد :
d3dDevice.SetRenderState D3DRS_LIGHTING, 1
d3dDevice.SetRenderState D3DRS_ZENABLE, 1
d3dDevice.SetRenderState D3DRS_LIGHTING, 1
d3dDevice.SetRenderState D3DRS_ZENABLE, 1
d3dDevice.SetRenderState D3DRS_SHADEMODE, D3DSHADE_GOURAUD
d3dDevice.SetRenderState D3DRS_AMBIENT, &H202020
d3dDevice.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
d3dDevice.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
حال بايستي شي sphere را بسازيم :
Set Sphere = d3dx.CreateSphere(d3dDevice, 2, 1000, 20, Nothing)x
که ۲ شعاع کره و ۱۰۰۰ تعداد slice هايي است که کره با آن ساخته مي شود .
سپس بردارهاي نقطه ديد و مکان دوربين و رنگ زمينه را تنظيم کنيد ( viewpoint و camerapoint از نوع D3DVECTOR هستند ) .
ViewPoint = vec(0, 0, 0)
CameraPoint = vec(4, 4, 4)
BackColor = &H404040
در روتين Render ابتدا ماتريسها و بردارهاي صحنه را تنظيم مي کنيم :
D3DXMatrixIdentity matWorld
d3dDevice.SetTransform D3DTS_WORLD, matWorld
D3DXMatrixRotationY matView, Rotation
D3DXMatrixLookAtLH matTemp, CameraPoint, ViewPoint, vec(0, 1, 0)
D3DXMatrixMultiply matView, matView, matTemp
d3dDevice.SetTransform D3DTS_VIEW, matView
D3DXMatrixPerspectiveFovLH matProj, pi / 4, 1, 0.1, 500
d3dDevice.SetTransform D3DTS_PROJECTION, matProj
در پايان نيز شروع به رندر صحنه مي کنيم :
d3dDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, BackColor, 1, 0
d3dDevice.BeginScene
Sphere.DrawSubset 0
d3dDevice.EndScene
d3dDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
تبدیل کد رنگ vb به html :
ویژوال بیسیک کد رنگ را به صورت BBGGRR ذخیره می کند ؛ ما باید قالب رنگ را به RRGGBB# تبدیل کنیم ؛ یعنی جای کد رنگ قرمز با آبی باید عوض شود. تابع زیر اینکار را انجام می دهد:
Function VB2HTMLColor(color As Long) As String
Dim aux As String
aux = Right("00000" & Hex(color), 6)
VB2HTMLColor = "#" & Right(aux, 2) & Mid(aux, 3, 2) & Left(aux, 2)
End Function
این هم سورس کد نرم افزار ویرایشگر متن برای دوستان عزیز :
دانلود
کار با ADO.NET و برقراری ارتباط با آن :
این ocx برای ارتباط با انواع پایگاه داده ها از جمله اکسس 2007 ؛ SQL و ... کاربرد دارد. با زدن دکمه های CTRL+T کادر Component را ظاهر کنید و تیک گزینه ی Microsoft ADO Data Control را بزنید و Ok کنید
حال کنترل adodc در قسمت جعبه ابزار قرار گرفته است یک شی از کنترل مذکور بر روی فرم قرار دهید. در بخش Properties مربوط به adodc در قسمت Connection String روی دکمه ی سمت راست آن کلیک کنید سپس بعد از ظاهر شدن کادر روی Build کلیک کنید.اکنون باید کادر Data Link Property ظاهر شود حال با توجه به بانک اطلاعاتی که دارید گزینه ای را انتخاب کنید به طور مثال برای SQL گزینه ی Microsoft OLE DB Provider for SQL Server را انتخاب کنید و Next کنید در بخش ServerName نام سرور SQL را وارد کنید و در پائین آن گزینه ی Use Windows NT Integrated Security را انتخاب کنید و در پائین آن نام بانک اطلاعاتی SQL را انتخاب کنید روی Test Connection کلیک کنید تا از انجام صحیح دستورالعمل ها اطمینان حاصل کنید و کادر تائید ظاهر شود.(اتصال برقرار شد)
یک سوالی رو یکی از دوستان در رابطه با بانک اطلاعاتی پرسیده بودند که زمانی از Combobox گزینه ای انتخاب می شود تمامی اطلاعات مربوطه در جعبه متن ها نمایش داده شود:::
با فرض اینکه ما ارتباطمان را با بانک اطلاعاتی برقرار کردیم کد زیر را در رویداد Load فرم می نویسیم:
Max = Val(AdoCompany.Recordset.RecordCount) - 1adoCompany نام کنترل adodc ما هست و (Field(1 اولین فیلد جدول هست که شامل کد شرکتهای تولید کننده ی محصولات می باشد.
For i = 0 To Max
ComboBox1.AddItem CStr(AdoCompany.Recordset.Fields(1).Value)
AdoCompany.Recordset.MoveNext
Next i
If Max >= 0 Then ComboBox1.ListIndex = 0
تا به اینجای کار باید زمانی که برنامه را اجرا می کنید تمامی کدهای شرکت در ComboBox قرار بگیرد.
سپس باید کاری کنیم که با کلیک Combo Box اطلاعات آن شرکت در جعبه متن ها نمایش داده شود جهت انجام این کار کافی است کد زیر را در رویداد کلیک Combo Box بگذاریم:
Cnt = ComboBox1.ListIndex
AdoCompany.Move Cntدر یک کلام رکوردست به رکورد کلیک شده اشاره می کند و محتوای کل فیلدهای آن رکورد در جعبه متن های جداگانه نمایش داده می شود.(به همین راحتی...)
text1.Text = AdoCompany.Recordset.Fields(2).Valuetext2.Text = AdoCompany.Recordset.Fields(3).Value
download Link: Image Database
Category: Complete Applications
Level: Advanced
.Description: Collects and stores all your images into a single MDB database
Compatibility: VB 6.0
download Link: My Help
Category: Complete Applications
Level: Advanced
Description: Compile help files from scratch using a tree structure and side rich text box for the topic contents
Compatibility: VB 6.0
download Link: A Simple Web Browser
Category: Complete Applications
Level: Beginner
.Description: A simple web browser to learn more
Compatibility: VB 5.0,VB 6.0
download Link: Transfer File
Category: Complete Applications
Level: Beginner
Description: filetransfer ,with api sock
Compatibility: VB 5.0,VB 6.0
download Link: Send Message To Yahoo,MSN,...s
Category: Complete Applications
Level: Advanced
Description: This code allows you to sends a real-time alert message to any user of the 4 major Instant Messaging networks MSN, Yahoo, ICQ, and AIM. You don’t even need an account or need to install any clients. It a unique web service project on PSC
نرم افزار چت سرور/کلاینت(426 کیلو بایت):
http://aminf2008.110mb.com/NetManager.zip
سورس کد دفترچه تلفن(240 کیلو بایت):
http://aminf2008.110mb.com/PhoneBook.zip
چگونه یک عدد صد رقمی را در سه رقمی با استفاده از آرایه ها ضرب کنیم.
جواب:
در حالت عادی ضرب عددی صد رقمی در سه رقمی باعث ایجاد خطای Over Flow می گردد. جهت برطرف نمودن این مشکل ما از الگوریتم زیر استفاده می نمائیم.
ابتدا باید عدد 100 رقمی و 3 رقمی گرفته شود سپس ارقام آن به طور جداگانه در خانه های آرایه قرار گیرد. سپس عملیات ضرب را آغاز می کنیم.
Option Base 1 ' باعث می شود اندیس آرایه از یک شروع شود
F=false
Help2[1]=0
Help3[1]=0
Help3[2]=0
I=0
Temp=Val(InputBox("Enter First Number: ")) ' عدد صد رقمی را وارد کنید
Do While temp>0
I=i+1
Hundred[i]=Temp mod 10
Temp=Temp\10
Loop
Indx=0
Temp=Val(InputBox("Enter Second Number: ")) 'عدد سه رقمی را وارد کنید
Do While Indx<=3
Indx=Indx+1
Three[Indx]=Temp mod 10
Temp=Temp\10
Loop
For k=1 to 3
For j=1 to i
If overf=true then
Temp=(Three[k]*Hundred[j])+sec
Overf=false
Else:
Temp=Three[k]*Hundred[j]
End if
Select case k
Case 1:
If (Temp>9) and (j
Help1[j]=Temp mod 10
Sec=temp\10
Overf=True
Else if (Temp>9) and (j=i) then
Help1[j]=temp mod 10
Help1[j+1]=temp\10
Overf=false
Else
Help1[j]=temp
End If
Case 2:
If (Temp>9) and (j
Help2[j+1]=Temp mod 10
Sec=Temp\10
Overf=true
Else if (Temp>9) and (j=i) then
Help2[j+1]=Temp mod 10
Help2[j+2]=Temp\10
Overf=False
Else
Help2[j+1]=Temp
End If
Case 3:
If (Temp>9) and (j< SPAN>
Help3[j+2]=Temp mod 10
Sec=Temp\10
Overf=True
Else if (Temp>9) And (j=i) then
Help3[j+2]=Temp mod10
Help3[j+3]=Temp\10
Overf=False
LP=J+3
Else
Help3[j+2]=Temp
End if
End Select
Next j
Next k
For z=1 to LP
If (overf=true) then
Temp=(Help1[z]+Help2[z]+Help3[z])+Sec)
Else
Temp=(Help1[z]+Help2[z]+Help3[z])
End if
If (Temp>9) and (z=LP) then
Final[z]=Temp mod 10
Final[z+1]=Temp\10
Else
Final[z]=Temp
Overf=False
End if
Next z
تابع زیر مدت زمانی که سیستم روشن است را برمی گرداند:Private Declare Function GetTickCount Lib "kernel32" () As Long
این تابع را در قسمت General فرم تعریف کنید حال در رویداد Load فرم می نویسیم:
&Retval = GetTickCount"MsgBox Str$(Fix(Retval / 60000)) + " Minutes you turned On PC
در بالا مقدار برگشتی تابع تقسیم بر 60000 می شود؛چون تابع بر حسب میلی ثانیه خروجی می دهد.
منم چند تا مي زارم شايد كارايي داشت
اينم چند تا ديگه!
یک اکتیواکس بسیار جالب و کاربردی. این نسخه، آخرین نسخه از این ابزار میباشد.
نام : Xtreame Suite Controls ActiveX Control
نسخه : 12.0.0
شرکت سازنده : Codejock
حجم : 557 کیلوبایت
----------------------------------------------------------------------------------------
ابزارهای این اکتیواکس : Button - RadioButton - CheckBox - GroupBox - FlatEdit - Label - ListBox - ComboBox - Resizer - TabControl - PopUpContro - TabControlPage و ... .
» برای اینکه Interface ابزارهای فوق شکل تم ویندوز کاربر شود باید خاصیت UseVisualStyle اونها رو True قرار بدید.
دانلود ابزار
این ابزاار رایگان هست یا پولی ؟یک اکتیواکس بسیار جالب و کاربردی. این نسخه، آخرین نسخه از این ابزار میباشد.
نام : Xtreame Suite Controls ActiveX Control
نسخه : 12.0.0
شرکت سازنده : Codejock
حجم : 557 کیلوبایت
اگه پولی هست کرک شده ؟