صفحه 3 از 4 اولاول 1234 آخرآخر
نمایش نتایج 81 تا 120 از 139

نام تاپیک: فقط سورس دانلود کنید!

  1. #81
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    و این هم سورس سیستم ثبت نام مدرسه.

    تهیه و ویرایش : آقای saeedzx
    فایل های ضمیمه فایل های ضمیمه

  2. #82
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم یه سورس جالب ولی ساده پیشنهاد می کنم حتما دانلود کنید./
    توضیح : وقتی فوکوس میره روی TextBox تمام متن های داخل TextBox انتخاب میشن یا در حالت Selection در میان.
    فایل های ضمیمه فایل های ضمیمه

  3. #83
    کاربر دائمی آواتار kuh_nur
    تاریخ عضویت
    بهمن 1386
    محل زندگی
    C:\Windows\Temp
    پست
    326

    Cool نقل قول: فقط سورس دانلود کنید!

    نقل قول نوشته شده توسط mmssoft مشاهده تاپیک
    این هم یه سورس جالب ولی ساده پیشنهاد می کنم حتما دانلود کنید./
    توضیح : وقتی فوکوس میره روی TextBox تمام متن های داخل TextBox انتخاب میشن یا در حالت Selection در میان.


    text1.setfocus
    sendkeys "{Home}+{End}"

    به نظر شما این ساده تر نیست

  4. #84
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    سلام MMSSOFT عزیز :

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

    پیشاپیش از لطفت متشکرم.
    ممنون و خواهش می کنم. درمورد سوالت باید بگم من حتی یک ذره درباره ارتباط برنامه با شبکه و Wimsock و از این جور چیزها اطلاعات ندارم. ولی شاید بتونید یک دیتابیس رو تو اینرنت آپلود کنید و آدرس اون رو تو بخش DatabaseName دیتا و یا همون آدرس رو توی ConnectionString یک Adodc بذاری و ازش استفاده بکنی. البته من امتحان نکردم.
    برای مثال :
    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"


    یه امتحانی بکن. امتحانش ضرر نداره.

  5. #85
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    و این هم سورس مقایسه تصاویر.
    _______________________________

    \\حتما دانلود کنید.//
    فایل های ضمیمه فایل های ضمیمه

  6. #86
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم سورس یه Screen Saver زیبا و آموزنده./
    \:.امیدوارم خوشتون بیاد.:/
    فایل های ضمیمه فایل های ضمیمه

  7. #87
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم سورس یک بازی زیبا.
    دانلود کنید تا بفهمید چیه. فقط میتونم بگم به توپ مربوط میشه.
    فایل های ضمیمه فایل های ضمیمه

  8. #88
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    و این هم یک فایل PDF آموزشی.
    این فایل رو از وبلاگ دنیای ویژوال بیسیک گرفتم.
    - تو این مقاله سعی شده تا 21 تابع کارآمد API برای استفاده در برنامه های VB6 و نحوه معرفی و استفاده از آنها به طور کامل و صحیح شرح داده شود.

    با تشکر از آقای انگوتی AliMedia

    برای دانلود اینجا را کلیک کنید

  9. #89
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    کتابچه سورس

    يكي از راههاي اينكه شما بتونيد روش كد نويسي رو خوب ياد بگيريد و يا از كدهاي استاندارد و از پيش نوشته شده در برنامه هاتون به خوبي استفاده كنيد اينه كه از كدهاي نوشته شده كتابها استفاده كنيد. به همين دليل هم به دوستان عزيز پيشنهاد مي كنم براي اين منظور به سايت انتشارات Wrox سر بزنن و از هر كتابي كه دلشون ميخواد هر سورسي رو دوست دارن بردارن. شما مي تونيد از كدهاي اونها كه واقعاً با توضيحات خوب نوشته شدن استفاده كنيد. براي اين منظور به این ادرس بروید :

    http://www.wrox.com/dynamic/books/download.aspx

  10. #90
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    نحوه تولید 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

  11. #91
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    در این روش به جای اضافه کردن عکس به بانک فقط ادرس عکس را به بانک می دهیم.
    عکسها در فایلی به نام pic در فایل bin برنامه ذخیره می شود.
    به این ترتیب از سرعت برنامه کاسته نمی شود.
    لطفا از دادن نظرات خود منو محروم نکنید.
    شما برای اینکه این برنامه به خوبی کار کند باید ادرس بانک را تغیر دهید.
    در ضمن اگه یکی از دوستان برای من توضیح دهد که چطور بدون ادرس دهی(منظورم اینه که بانک همراه با برنامه باشه) می توانم به بانک دسترسی داشته باشم ممنون می شم.

    این عکسها قابل حمل می باشند یعنی همراه برنامه می باشند و با تغییر محل برنامه هیچ مشکلی ایجاد نمی شود.
    فقط در صورتی که فایل pic را در فایل bin برنامه حذف یا تغییر بدهید برنامه مشکل پیدا خواهد کرد.

    دانلود سورس با حجم 1.52 مگابایت

    تهیه و تنظیم : mina.net

  12. #92
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    توابع 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

  13. #93
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    بستن پنجره با گرفتن عنوان ان

    اگر کاربر پنجره ای رو که شما تعیین می کنید رو باز کنه برنامه اون فرم رو می بنده.

    در اینجا ما از دو تا تابع 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 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!

  14. #94
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    بدست آوردن IP و نام سيستم ميزبان

    برای امروز قصد دارم يک پروژه ساده را به شما معرفی کنم.

    شما ظرف چند دقيقه ميتوانيد اين پروژه را در ويژوال بيسيک بسازيد.

    ابتدا ويژوال بيسيک را باز کنيد سپس کنترلر های زير را روی فرم قرار دهيد :

    دو عدد TextBox و دو عدد WinSock

    حالا روی فرم دو بار کليک کرده و در رويداد لود فرم کدهای زير را وارد کنيد :


    Text1.Text = Winsock1.LocalIP
    Text2.Text = Winsock2.LocalHostName


    برنامه را اجرا کنيد . اين برنامه آی پی و پورت سيستم ميزبان را در اختيار شما قرار ميدهد.
    لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسيديم
    خدمت شما عرض خواهم کرد که کاربرد اين برنامه در هک سيستم قربانيان چيست

  15. #95
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

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

    چون اکثر توابع مثلثاتی بر حسب رادیان کار می کنند گاهی اوقات نیاز داریم تا زوایا را از در جه به رادیان و بالعکس تبدیل کنیم. برای تبدیل یک زاویه بر حسب رادیان به درجه، آنرا در 180 ضرب کرده و سپس بر عدد پی تقسیم می‌کنیم:

    Degree(x) = x * 180 / Pi
    برای تبدیل یک زاویه بر حسب درجه به رادیان، آنرا در عدد پی ضرب کرده و سپس بر 180 تقسیم می‌کنیم:
    Rad(x) = x * Pi / 180

  16. #96
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين

    تصاويرتون بايد 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


    موفق باشید

  17. #97
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    یک برنامه جالب برای بزرگنمایی روی دسکتاپ :
    برای دانلود اینجا را کلیک کنید دانلود کنید

  18. #98
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم آموزش مخفی کردن 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)

  19. #99
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    آيكون يك برنامه رو از كالبدش كشيد بيرون و به صورت فايل آيكون ذخيره كرد

    اين آموزش از سري آموزشي كتابخانه قدرتمند 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

  20. #100
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    چطور مي شه دكمه بستن پنجره در گوشه فرم رو غير فعال كرد

    شايد غير فعال كرد دكمه هاي تمام صفحه و كمينه رو بلد باشين ولي
    ديگه فرم خاصيت غير فعال كردن دكمه 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)

  21. #101
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    اين تابع مي تونه كليد هاي 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

  22. #102
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم یه سورس جدید برای شما. اسمش هست BinderFile. فکر کنم بشه از رو تصویر همه چیز رو فهمید :
    برای دانلود اینجا را کلیک کنید دانلود کنید

  23. #103
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    این هم یه سورس دیگه. > ساخت 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

  24. #104
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    و این هم یه سورس بسیار به درد بخور. حتما دانلود کنید.
    سورس قرار دادن آیکون در منو با استفاده از توابع API.

    دانلود کنید

  25. #105
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    در اين برنامه شما مي توانيد با مشخص كردن يك كلمه از متن مورد نظر بقيه متن را مشاهده كنيد. مثلا اين يك سايت فوتبال است . http://www.soccerstats.com
    اين برنامه مشخصات جدول را براي شما ليست مي كنه .


    دانلود کنید

  26. #106
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    و این هم یک OCX به درد بخور.

    OCX عکس گرفتن از صفحه نمایش


  27. #107
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    آموزش کامل 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



  28. #108
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    آموزش کامل 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

  29. #109
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    تبدیل کد رنگ 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

  30. #110
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

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

    دانلود

  31. #111
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    کار با 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) - 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
    adoCompany نام کنترل adodc ما هست و (Field(1 اولین فیلد جدول هست که شامل کد شرکتهای تولید کننده ی محصولات می باشد.
    تا به اینجای کار باید زمانی که برنامه را اجرا می کنید تمامی کدهای شرکت در ComboBox قرار بگیرد.
    سپس باید کاری کنیم که با کلیک Combo Box اطلاعات آن شرکت در جعبه متن ها نمایش داده شود جهت انجام این کار کافی است کد زیر را در رویداد کلیک Combo Box بگذاریم:
    Cnt = ComboBox1.ListIndex  
    AdoCompany.Move Cnt

    text1.Text = AdoCompany.Recordset.Fields(2).Value
    text2.Text = AdoCompany.Recordset.Fields(3).Value
    در یک کلام رکوردست به رکورد کلیک شده اشاره می کند و محتوای کل فیلدهای آن رکورد در جعبه متن های جداگانه نمایش داده می شود.(به همین راحتی...)

  32. #112
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    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




  33. #113
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    نرم افزار چت سرور/کلاینت(426 کیلو بایت):
    http://aminf2008.110mb.com/NetManager.zip

  34. #114
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    سورس کد دفترچه تلفن(240 کیلو بایت):
    http://aminf2008.110mb.com/PhoneBook.zip

  35. #115
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    چگونه یک عدد صد رقمی را در سه رقمی با استفاده از آرایه ها ضرب کنیم.
    جواب:
    در حالت عادی ضرب عددی صد رقمی در سه رقمی باعث ایجاد خطای 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



  36. #116
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    تابع زیر مدت زمانی که سیستم روشن است را برمی گرداند:
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    این تابع را در قسمت General فرم تعریف کنید حال در رویداد Load فرم می نویسیم:
      

    &Retval = GetTickCount
    "MsgBox Str$(Fix(Retval / 60000)) + " Minutes you turned On PC

    در بالا مقدار برگشتی تابع تقسیم بر 60000 می شود؛چون تابع بر حسب میلی ثانیه خروجی می دهد.

  37. #117
    کاربر تازه وارد آواتار Ali0541
    تاریخ عضویت
    تیر 1388
    محل زندگی
    دوردست
    سن
    30
    پست
    70

    نقل قول: فقط سورس دانلود کنید!

    منم چند تا مي زارم شايد كارايي داشت
    فایل های ضمیمه فایل های ضمیمه

  38. #118
    کاربر تازه وارد آواتار Ali0541
    تاریخ عضویت
    تیر 1388
    محل زندگی
    دوردست
    سن
    30
    پست
    70

    نقل قول: فقط سورس دانلود کنید!

    اينم چند تا ديگه!
    فایل های ضمیمه فایل های ضمیمه

  39. #119
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    نقل قول: فقط سورس دانلود کنید!

    یک اکتیواکس بسیار جالب و کاربردی. این نسخه، آخرین نسخه از این ابزار میباشد.
    نام : 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 قرار بدید.

    دانلود ابزار

  40. #120
    کاربر دائمی آواتار butterfly8528
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    CLR
    پست
    896

    نقل قول: فقط سورس دانلود کنید!

    یک اکتیواکس بسیار جالب و کاربردی. این نسخه، آخرین نسخه از این ابزار میباشد.
    نام : Xtreame Suite Controls ActiveX Control
    نسخه : 12.0.0
    شرکت سازنده : Codejock
    حجم : 557 کیلوبایت
    این ابزاار رایگان هست یا پولی ؟

    اگه پولی هست کرک شده ؟

صفحه 3 از 4 اولاول 1234 آخرآخر

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •