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

[mmssoft]

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

دانلود با لینک مستقیم (http://mediavb.persiangig.ir/SourceCode/Other/Mail_Sender.zip)

تسکر یادت نره.

[mmssoft]

تو این تاپیک می خوام نرم افزاری رو بهتون معرفی کنم که جر تو وبلاگ خودم (http://www.vbassistant.blogfa.com) و اینجا هیجا نمی تونید پیداش کنید.
این نرم افزار خودش با VB6 نوشته شده و شما می تونید با استفاده از اون با انتخاب پوشه پروژه خود تعداد خطهایی را که در آن کدنویسی کرده اید به دست آورید و در بین رشته های پروژه تان جستجو کنید.
مطمئناً اگه دانلود نکنید دیگه گیرتون نمی یاد.

دانلود با لینک مستقیم فقط 123 کیلوبایت (http://mahdisamsami.persiangig.ir/VB/VB-App-Tool.zip)

[mmssoft]

پروژه ها :

1- Form_Layerd - برای شفافیت فرم
2- kore - شبیه ساز حرکت یک کره
3- LineGame - بازی خطی
4- ojaggaz - شبیه ساز یک اجاق گاز
5- Program_to_Startup - قرار دادن برنامه در StartUp
6- بازی پازل
7- Save Text - ذخیره یک متن
8- Select_Folder - انتخاب یک پوشه
9- TransTaskBar - شیشه کردن نوار وظیفه
10- NC_Plus - شبیه ساز برنامه مدیریت پوشه ها

دانلود کنید و لذت ببرید و تشکر کنید.

[mmssoft]

دانلود چند پروژه ویژوال بیسیک
1- 5 کامپوننت دکمه (Button) زیبا - نام فایل : Buttons
2- آموزش تغییر پسورد پایگاه داده از طریق وی بی - نام فایل : Change-DB-Pass
3- سورس پنجره ColorPicker فوتوشاپ - نام فایل : ColorPicker
4- باز کردن آیتم های کنترل پنل از طریق وی بی - نام فایل : Control-Panel-in-VB
5- کپی کردن برنامه در همه درایو ها - نام فایل : Copy2AllDrives
6- شماره گیری از طریق وی بی - نام فایل : Dial-with-VB
7- سورس برنامه ورد حرفه ای با امکانات ورد 2003 - نام فایل : Pro-Word
8- نشان دادن تمام اطلاعات سیستم حرفه ای تر از برنامه مشابه در ویندوز - نام فایل : SysInfo
9- سورس برنامه این مانند Picture Viewer ویندوز - نام فایل : WinPicViewer-VB-Source
------> بقیه را در ضمیمه تاپیک پایین دانلود کنید.

[mmssoft]

بقیه پروژه های تاپیک بالا را در ضمیمه این پست می توانید دانلود کنید :
|
|
|
V

[mmssoft]

فقط سورس دانلود کنید! - پست 1

[mmssoft]

فقط سورس دانلود کنید! - پست 2

[mmssoft]

فقط سورس دانلود کنید! - پست 3

[mmssoft]

فقط سورس دانلود کنید! - پست 4

[mmssoft]

فقط سورس دانلود کنید! - پست 5

[mmssoft]

فقط سورس دانلود کنید! - پست 6

[mmssoft]

فقط سورس دانلود کنید! - پست 7

[mmssoft]

فقط سورس دانلود کنید! - پست 8

[mmssoft]

فقط سورس دانلود کنید! - پست 9

[mmssoft]

فقط سورس دانلود کنید! - پست 10

[mmssoft]

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

جذاب ترین سورس های این مجموعه :
Zoo Garden و Mail Boomber

اگه دانلود نکنید بزرگترین ضرر عمرتون رو کردید.

پس تشکر چی؟ :افسرده:

[mmssoft]

فقط سورس دانلود کنید! - پست 12

[mmssoft]

فقط سورس دانلود کنید! - پست 13

[mmssoft]

فقط سورس دانلود کنید! - پست 14

[mmssoft]

فقط سورس دانلود کنید! - پست 15

[mmssoft]

فقط سورس دانلود کنید! - پست 16

[mmssoft]

فقط سورس دانلود کنید! - پست 17

[mmssoft]

فقط سورس دانلود کنید! - پست 18

[mmssoft]

فقط سورس دانلود کنید! - پست 19

[mmssoft]

فقط سورس دانلود کنید! - پست 20

این هم سورس های وبلاگ قبلی من - شاید تکراری باشه! :خجالت: :


1 >> Drive Hider – پروژه مخفی کردن درایو ها – حجم 9 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/DriveHider.zip)

2 >> Gradient Form – پروژه دادن گرادینت به فرم با انتخاب رنگ مبدا و مقصد – حجم 10 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/GradientForm.zip)

3 >> HotsKeys – پروژه اجرای دستور در برنامه با استفاده از هات کیس (کلید های گرم) – حجم 9 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/HotKeys.zip)


5 >> Mouse Tutorial – پروژه تنظیم و اجرای عملکردهای ماوس – حجم 10 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/MouseTutorial.zip)

6 >> Pic Scroll – پروژه اسکرول تصویر با استفاده از اسکرول های عمودی و افقی – حجم 143 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/PicScroll.zip)

7 >> PMAK – پروژه قفل کردن ماوس و کیبرد به مدت 10 ثانیه – حجم 7 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/PMAK.zip)

8 >> Reg Search – پروژه حرفه ای جستجو در رجیستری – حجم 85 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/RegSearch.zip)

9 >> RGB Color – پروژه مشخصات رنگ های اصلی (RGB) – حجم 15 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/RGBColor.zip)

پسورد همه فایل ها : www.newofprogramming.blogfa.com

[mmssoft]

فقط سورس دانلود کنید! - پست 21

این هم سورس های وبلاگ قبلی من - شاید تکراری باشه! :خجالت: :


10 >> Rnd Numbers – پروژه اعداد تصادفی با تعیین تنظیمات – حجم 14 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/RndNumbers.zip)
11 >> Shamsi Date – پروژه نشان دادن تاریخ شمسی – حجم 149 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/Shamsi-Date.zip)
12 >> Task Switch – پروژه ای مانند Task Manager کامپیوتر با امکانات کمتر – حجم 159 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/TaskSwitch.zip)
14 >> VB Clock – پروژه ساخت یک ساعت ویژوال بیسیک با استفاده از Line ها – حجم 11 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/VB-Clock.zip)
15 >> Fale Hafez – نرم افزار فال حافظ – حجم 153 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/Fale%20Hafez.zip)
16 >> Salamat – پروژه سلامت مشخص کننده متعادل بودن یا نبودن و میزان تعادل وزن شما – حجم 19 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/Salamat.zip)
17 >> Koreh – پروژه حرکت دادن یک کره کوچک در بخش های مختلف و بزرگ و کوچک کردن آن – حجم 14 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/Koreh.zip)
18 >> Dooz – بازی بسیار زیبای دوز توسط دو کاربر – حجم 20 کیلوبایت - دانلود (http://mahdi-vb.parsaspace.com/Dooz.zip)

پسورد همه فایل ها : www.newofprogramming.blogfa.com

[mmssoft]

فقط سورس دانلود کنید! - پست 22

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

دانلود (http://persiandrive.net/download2.php?a=627355&b=1b0d051ac3da74f1d5382b30a334e02a)


پسورد فایل : www.newofprogramming.blogfa.com

[mmssoft]

فقط سورس دانلود کنید! - پست 24

بازی معروف سوپر ماریو.
برگرفته از سایت vb-source.mihanblog.com

دانلود (http://reza-hami.persiangig.com/vb-source/Package.rar)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 25


سورس برنامه Paint همراه با تلفظ ابزارها.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://www.justupit.com/get.php?id=a74830d074995468979f27c028023a9a)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 26




سورس یک دیکشنری زیبا.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://www.justupit.com/get.php?id=77104efe8432419b9bda6d320bde881b)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 27




سورس برنامه اطلاعات داروخانه های تهران.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://nelke.persiangig.com/Codes/Daroo.rar)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 28




سورس نرم افزار مشاور املاک : "املاکیار"
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://www.justupit.com/get.php?id=cd78624ead2de9bdef0be48785c6a848)


نام کاربری اولیه ورود به برنامه : admin
رمز عبور اولیه ورود به برنامه : admin
رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 29




سورس برنامه تبدیل PIC به AVI.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://reza-hami.persiangig.com/vb-source/Pic%20to%20AVI.rar)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 30




سورس یک ساعت آنالوگ بسیار زیبا.
برگرفته از سایت vb-source.mihanblog.com



http://reza-hami.persiangig.com/image/saat.jpg


دانلود (http://reza-hami.persiangig.com/vb-source/Clock.rar)


رمز عبور : vb-source.mihanblog.com

[mmssoft]

فقط سورس دانلود کنید! - پست 31

[mmssoft]

فقط سورس دانلود کنید! - پست 32

[mmssoft]

فقط سورس دانلود کنید! - پست 33

[mmssoft]

فقط سورس دانلود کنید! - پست 34

[mmssoft]

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

و باز هم دو سورس جذاب :
SWF Player و Resource


SWF Player : سورس برنامه برای پخش فایل های فلش بدون OCX
Resource : سورس نرم افزاری دقیقا مثل ResHack با امکانات کامل.


پس تشکر چی؟ :افسرده:

[mmssoft]

فقط سورس دانلود کنید! - پست 36

[mmssoft]

فقط سورس دانلود کنید! - پست 37

[mmssoft]

فقط سورس دانلود کنید! - پست 38

[mmssoft]

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


ScreenEffects - vbIconMaker - WallpaperMaster - پخش فایل های GIF بدون OCX

حتما دانلود کنید.

پس تشکر چی؟ :افسرده:

[mmssoft]

فقط سورس دانلود کنید! - پست 40

[mmssoft]

فقط سورس دانلود کنید! - پست 41

[mmssoft]

فقط سورس دانلود کنید! - پست 42

[mmssoft]

فقط سورس دانلود کنید! - پست 43

[mmssoft]

میشه یک سورس شکلک یاهو بگذاری که روی یاهو 9 هم کار کنه؟ ممنون

یه سری به تاپیک پایین بزنید :

http://www.barnamenevis.org/forum/showthread.php?t=129264

[mmssoft]

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


http://barnamenevis.org/forum/showthread.php?t=124082

[mmssoft]

فقط سورس دانلود کنید! - پست 49

\\دانلود سورس نرم افزار تبدیل متن فینگلیش به فارسی//

[mmssoft]

فقط سورس دانلود کنید! - پست 50

تابعی برای چک کردن اینکه یک متن انگلیسی است یا نه؟

[mmssoft]

فقط سورس دانلود کنید! - پست 51

دریافت درایو سی دی رام و گرفتن برچسب درایوها

[mmssoft]

فقط سورس دانلود کنید! - پست 52

ابزاری برای انجام کارهای زیاد بر روی فایل ها

[mmssoft]

فقط سورس دانلود کنید! - پست 53

دریافت اطلاعات یک عکس و فراخوانی عکس از فایل DLL و عوض شدن عکس ها با افکتی زیبا

[mmssoft]

فقط سورس دانلود کنید! - پست 54

سورس ارتباطی آسان با رجیستری

[butterfly8528]

سورس نرم افزار مشاور املاک : "املاکیار"
برگرفته از سایت vb-source.mihanblog.com




دوست عزیز سورسی وجود نداره . خود برنامه رو قرار دادی !!!!!!!!!!!!

[mmssoft]

یه سورس بزار که پسوردای ذخیره شده در برنامه های ویندوز (windows applications) رو نشون بده !

پسورد ویندوز توی فایل SAM در مسیر پوشه ویندوز و system32\config قرار داره. این فایل به وسیله پروسه lsass.exe قفل شده و امکان غیرفعال کردن این پروسه هم نیست. فکر نکنم بتونیم پسورد ویندوز رو تو برنامه نشون بدیم. ولی من نرم افزاری دارم که می تونی پسورد رو طی یک جستجوی طولانی پیدا کنه. ولی پسوردهای 7 حرفی به پایین رو.

[mmssoft]

سورس ID Maker اگه میشه بگذارید

بیا این هم سورس ID Maker. چند دقیقه پیش براتون نوشتمش.

[mmssoft]

امروز که داشتم تو سایت سرچ می کردم به یه تاپیک برخوردم که خیلی نظرم رو جلب کرد. اون تاپیک مال سال 84 بود و آقای ehsan_ebrahimipoor داخل اون تاپیک یه مطلبی گذاشته بودند که 7528 تا دانلود داشت.

به خودم گفتم بهتره این مطلب رو بیارم تو این تاپیک تا ازش استفاده کنید :


MSDN فارسی


دانلود با حجم 740 کیلوبایت (http://barnamenevis.org/forum/attachment.php?attachmentid=1214&d=1130357370)

[mmssoft]

توابع Dial-Up :



Name
Description
InternetGetConnectedState
Retrieves the current state of the Internet connection
InternetAutodial
Initiates an unattended dial-up connection
InternetAutodialHangup
Disconnects a modem connection initiated by
InternetDial
Initiates a dial-up connection
InternetHangUp
Disconnects a modem connection initiated by InternetDial
InternetGoOnline
Prompts the user for permission to initiate a dial-up connection to the given URL
InternetSetDialState
Sets the current state of the Internet connection



توابع عمومی اينترنت :

Name
Description
InternetOpen
Initializes the Win32 Internet functions
InternetConnect
Opens an FTP, Gopher, or HTTP session for a given site
InternetCloseHandle
Closes a single Internet handle or a subtree of Internet handles
InternetErrorDlg
Displays a dialog box for the error that is passed to InternetErrorDlg
InternetFindNextFile
Continues a file search started as a result of a previous call to FtpFindFirstFile or GopherFindFirstFile
InternetGetLastResponseInfo
Retrieves the last Win32 Internet function error description or server response on the thread calling this function
InternetLockRequestFile
Allows the user to place a lock on the file being used
InternetQueryDataAvailable
Queries the amount of data available
InternetQueryOption
Queries an Internet option on the specified handle
InternetReadFile
Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
InternetReadFileEx
Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
InternetSetFilePointer
Sets a file position for InternetReadFile
InternetSetOption
Sets an Internet option
InternetSetStatusCallback
Sets up a callback function that Win32 Internet functions can call as progress is made during an operation
InternetStatusCallback
Placeholder for the application-defined status callback function
InternetTimeFromSystemTime
Formats a date and time according to the specified RFC format (as specified in the HTTP version 1.0 specification)
InternetTimeToSystemTime
Takes an HTTP time/date string and converts it to a SYSTEMTIME structure
InternetUnlockRequestFile
Unlocks a file that was locked using InternetLockRequestFile
InternetWriteFile
Writes data to an open Internet file
InternetConfirmZoneCrossing
Checks for changes between secure and nonsecure URLs


توابع URL :

Name
Description
InternetCanonicalizeUrl
Canonicalizes a URL, which includes converting unsafe characters and spaces into escape sequences.
InternetCombineUrl
Combines a base and relative URL into a single URL. The resultant URL will be canonicalized.
InternetCrackUrl
Cracks a URL into its component parts.
InternetCreateUrl
Creates a URL from its component parts.
InternetOpenUrl
Begins reading a complete FTP, Gopher, or HTTP URL.


توابع FTP :

Name
Description
FtpCreateDirectory
Creates a new directory on the FTP server
FtpDeleteFile
Deletes a file stored on the FTP server
FtpFindFirstFile
Searches the specified directory of the given FTP session
FtpGetCurrentDirectory
Retrieves the current directory for the given FTP session
FtpGetFile
Retrieves a file from the FTP server and stores it under the specified file name, creating a new local file in the process
FtpPutFile
Stores a file on the FTP server
FtpRemoveDirectory
Removes the specified directory on the FTP server
FtpRenameFile
Renames a file stored on the FTP server
FtpSetCurrentDirectory
Changes to a different working directory on the FTP server


توابع HTTP :

Name
Description
HttpAddRequestHeaders
Adds one or more HTTP request headers to the HTTP request handle
HttpEndRequest
Ends an HTTP request
HttpOpenRequest
Opens an HTTP request handle
HttpQueryInfo
Queries for information about an HTTP request
HttpSendRequest
Sends the specified request to the HTTP server
HttpSendRequestEx
Sends the specified request to the HTTP server

منبع : dev.ir
تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

گرفتن اطلاعات ورودی از کيبرد - ۱


Direct Input 8 همانطور که از نامش مشخص است به شما اجازه می دهد که بتوانيد برنامه هايي بنويسيد که توسط هر نوع دستگاه ورودی کنترل شود .
Direct Input 8 دارای چندين مزيت نسبت به استفاده از کنترلهای ورودی خود ويژوال بيسيک دارد – کنترلهايي مثل Form_KeyUp, Form_KeyDown, Form_MouseMove - و همچنين قابليت کنترل بيشتری نسبت به توابع استاندارد Win32 از قبيل GetCursorPos, GetKeyState دارد .
Direct Input 8 سريعتر ، کاراتر و قدرتمند تر بوده و برای ساخت بازيها طراحی شده بنابراين باعث کندی برنامه ها نخواهد شد .

چگونگی کار با Direct Input 8 برای گرفتن ورودی از کيبرد

دو روش برای استفاده از کيبرد در DirectX8 وجود دارد : روش polling و روش event-based که هر دو دارای مزايا و معايبی هستند .
بطور کلی در اغلب طراحيها از روش event-based استفاده می شود زيرا کار با آن راحت تر اسن . در اين روش هر پيغام فرستاده شده ازطرف دستگاه ورودی log می شود و برنامه نيازی به هيچگونه پردازشی بمنظور منتظر ماندن برای يک پيغام از طرف ورودی ندارد ، بنابر اين کاراتر است . در روش polling کنترل کمی دقيقتر و راحتر است .
اگر در مورد برنامه نويسی بر مبنای polling و بر مبنای event اطلاعات کافی نداريد می توانيد از منابع موجود در سايتهايي چون Gamasutra (mk:@MSITStore:H:%5CProject.1%5Cdev.ir.chm::/www.gamasutra.com/default.htm) و GameDev (mk:@MSITStore:H:%5CProject.1%5Cdev.ir.chm::/www.gamedev.net/default.htm) استفاده کنيد .

روش Polling

مراحل اين روش عبارتند از :

1 – تعريفات Declerations : يک فرم ايجاد کرده و يک TextBox به نام txtOutput با خصوصيات Multiline ، Locked و Vertical Scroll Bar در آن قرار دهيد . کدهای زير را در بخش کدنويسی اين فرم بنويسيد :


Private Const UsePollingMethod As Boolean = True
Private Const UseEventMethod As Boolean = False
‘نکته مهم اينست که تنها يکی از دو ثابت فوق بايستی True باشد .
Private bRunning As Boolean
‘اين متغير برای polling استفاده می شود
Private DX As DirectX8
Private DI As DirectInput8
‘تعريف شی اصلی DirectX و شی DirectInput
Private DIDevice As DirectInputDevice8
Private DIState As DIKEYBOARDSTATE
‘اين دو شی برای دسترسی به دستگاه ورودی ( کيبرد ) استفاده می شوند
Private KeyState(0 To 255) As Boolean
‘آرايه ای برای تشخيص فشرده شدن کليد
Private Const BufferSize As Long = 10
‘ سايز بافر نگهدارنده event ها . در روش event-based اين مقدار برابر يک و در روش polling برابر 10 تا 20 است ( بسته به سرعت حلقه بازی )
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)x
‘ تابع Sleep برای متوقف کردن حلقه polling در صورت بالا بودن نرخ ورودی


2- مقدار دهی اوليه Initialisation : اين بخش سه مرحله دارد :
در مرحله اول اشيا و Device ها ساخته می شوند .
در مرحله دوم تنظيمات مربوط به Device انجام می شود .
در مرحله سوم به Device می گوئيم که می خواهيم شروع به استفاده از آن کنيم .

در Form_Load کدهای زير را بنويسيد :


Me.Show
Dim I As Long
Dim DevProp As DIPROPLONG
Dim DevInfo As DirectInputDeviceInstance8
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If UsePollingMethod And UseEventMethod Then
MsgBox "You must select only one of the constants before running"x
Unload Me
End
End If

If UsePollingMethod Then txtOutput.Text = "Using Polling Method" & vbCrLf
If UseEventMethod Then txtOutput.Text = "Using Event Based Method" & vbCrLf

‘مقداردهی اوليه روش انتخاب شده
Set DX = New DirectX8
Set DI = DX.DirectInputCreate
Set DIDevice = DI.CreateDevice("GUID_SysKeyboard")x

DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or ISCL_NONEXCLUSIVE

‘برپاسازی بافر
DevProp.lHow = DIPH_DEVICE
DevProp.lData = BufferSize
DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp

‘ به دايرکت ايکس می گوئيم که می خواهيم از دستگاه ورودی استفاده کنيم
DIDevice.Acquire

‘استخراج اطلاعاتی در مورد دستگاه ورودی
Set DevInfo = DIDevice.GetDeviceInfo()x
txtOutput.Text = txtOutput.Text & "Product Name: " & DevInfo.GetProductName & vbCrLf
txtOutput.Text = txtOutput.Text & "Device Type: " & DevInfo.GetDevType & vbCrLf
txtOutput.Text = txtOutput.Text & "GUID: " & DevInfo.GetGuidInstance & vbCrLf


‘در صورتی که بخواهيم به برنامه خاتمه بدهيم کدهای زير را می نويسيم
DIDevice.Unacquire
Set DIDevice = Nothing
Set DI = Nothing
Set DX = Nothing
Unload Me
End


3 – گرفتن ورودی از کيبرد : در اين بخش فرض کنيد بخواهيم يک بازی را در يک حلقه Do-Loop شبيه سازی کنيم . در اين حلقه هر بار فشرده شدن کليدهای کيبرد را چک می کنيم :


If Not Err.Number Then bRunning = True

Do While bRunning

‘دريافت اطلاعات شامل خواندن وضعيت کيبرد ، خواندن اطلاعات بافر و سپس خطا
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
If Err.Number = DI_BUFFEROVERFLOW Then
Msgbox(“BUFFER OVERFLOW (Compensating)...")x
GoTo ENDOFLOOP:
End If
‘بررسی فشرده شدن کليدها
For I = 0 To 255
If DIState.Key(I) = 128 And (Not KeyState(I) = True) Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I))& vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
KeyState(I) = True
End If
Next I

‘بررسی رها شدن کليد
For I = 0 To BufferSize
If KeyState(pBuffer(I).lOfs) = True And pBuffer(I).lData = 0 Then
KeyState(pBuffer(I).lOfs) = False
txtOutput.Text = txtOutput.Text & "{ UP } " & KeyNames(CInt(pBuffer(I).lOfs)) & vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
End If
Next I

Sleep (50)x
DoEvents
ENDOFLOOP:
Loop

در کد فوق يک تابع KeyName وجود دارد که نام کليد فشارداده شده را بر می گرداند . بخشی از اين تابع را در زير می بينيد :



Function KeyNames(iNum As Integer) As String

Dim aKeys(0 To 255) As String

aKeys(1) = "DIK_ESCAPE"
aKeys(2) = "DIK_1 On main keyboard"x
aKeys(3) = "DIK_2 On main keyboard"x
aKeys(4) = "DIK_3 On main keyboard"x
aKeys(5) = "DIK_4 On main keyboard"x
aKeys(6) = "DIK_5 On main keyboard"x
aKeys(7) = "DIK_6 On main keyboard"x
aKeys(8) = "DIK_7 On main keyboard"x
aKeys(9) = "DIK_8 On main keyboard"x
aKeys(10) = "DIK_9 On main keyboard"x
aKeys(11) = "DIK_0 On main keyboard"x
aKeys(12) = "DIK_MINUS On main keyboard"x
aKeys(13) = "DIK_EQUALS On main keyboard"x
aKeys(14) = "DIK_BACK BACKSPACE"x
aKeys(15) = "DIK_TAB"x
aKeys(16) = "DIK_Q"x
aKeys(17) = "DIK_W"x
aKeys(18) = "DIK_E"x
aKeys(19) = "DIK_R"x
aKeys(20) = "DIK_T"x
.
.
.
KeyNames = aKeys(iNum)x

End Function


تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

موضوع : پخش افکتهاي صوتی در برنامه هاي مالتي مديا

در سلسله مباحث DirectXAudio شما تکنيکهاي لازم براي اضافه کردن موزيک و افکتهاي صوتي سريع و ديناميک را به بازيها و برنامه هاي مالتي مديا خواهيد آموخت . DirectXAudio جايگزيني براي بخشهاي DirectSound ، DirectSound3D و DirectMusic موجود در DirectX 7 مي باشد و داراي امکانات بهتر و سريعتری بوده و برنامه نويسي آن نيز ساده تر است .
در اولين درس از DirectXAudio چگونگي پخش افکتهاي صوتي را در برنامه هايتان خواهيد آموخت .

Initial کردن DirectSound :
DirectSound اولين مبحثي است که آنرا توضيح خواهم داد . گرچه DirectXAudio يک نام عمومي براي امکانات صوتي DirectX8 مي باشد اما بين Sound و Music تفاوت وجود دارد .
DirectSound با پخش افکتهاي صوتي ارتباط دارد . DirectSound همانند Direct3D از يکسري device سخت افزاري و نرم افزاري استفاده مي کند و افکتهاي صوتي در يکسري بافر ذخيره مي شوند .
اولين قدم براي برپاسازي DirectSound ، اضافه کردن کتابخانه DirectX8 به پروژه تان مي باشد . قدم بعدي تعريف متغيرها و object هاي موردنياز است . براي استفاده از DirectSound به متغيرهاي زير نياز داريم :


Private DX As DirectX8
Private DS As DirectSound8
Private DSBuffer As DirectSoundSecondaryBuffer8
Private DSEnum As DirectSoundEnum8
Private bLoaded As Boolean

DirectX شي کنترل کننده مرکزي است . DirectSound8 واسط مراقب براي تمام interface هاي پخش صدا است . DirectSoundSecondaryBuffer8 داده audio واقعي را براي پخش ذخيره مي کند . DirectSoundEnum8 اجازه مي دهد که اطلاعاتي را در مورد device هاي سخت افزاري/نرم افزاري استخراج کنيد و متغير bLoaded يک flag وضعيت مي باشد .
حال در برنامه بايد ليست تمام device هاي در دسترس را مشخص کنيم . ( اين امر کاملاً امکان پذير است که يک کامپيوتر بيش از يک device براي DirectSound داشته باشد ) :


Private Sub Form_Load()x
bLoaded = False
Dim I As Long
Set DX = New DirectX8
Set DSEnum = DX.GetDSEnum
For I = 1 To DSEnum.GetCount
MsgBox(DSEnum.GetDescription(I))x
Next I
End Sub

فرض کنيم که يکي از device هاي شناخته شده را انتخاب کرديم . حال بايستي device را واقعاً برپا کنيم :


If bLoaded Then
Set DSBuffer = Nothing
Set DS = Nothing
Set DX = Nothing
End If
Dim DSBDesc As DSBUFFERDESC
Set DX = New DirectX8
Set DS = DX.DirectSoundCreate(DSEnum.GetGuid(devicenumber)) x
DS.SetCooperativeLevel frmMain.hWnd, DSSCL_NORMAL

متغير devicenumber شماره device اي است که شما مي خواهيد با آن کار کنيد . DSBDesc فايل صوتي شما را توصيف مي کند .

تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

رجيستري چيست ؟

سيستم عامل ويندوز تنظيمات سخت افزاري و نرم افزاري خود را بطور مرکزي در يک بانک اطلاعاتي با ساختار سلسله مراتبي ذخيره مي کند که رجيستري نام دارد . رجيستري جايگزيني براي بسياري از فايلهاي پيکربندي INI ، SYS و COM است که در نسخه هاي اوليه ويندوز موجود بود . رجيستري ، سيستم عامل را با مهيا کردن اطلاعات موردنيز براي اجراي برنامه ها و load شدن component ها ، کنترل مي کند .
رجيستري شامل انواع مختلفي از اطلاعات مي باشد مثل :
- اطلاعات سخت افزارهاي نصب شده روي سيستم
- اطلاعات درايورهاي نصب شده روي سيستم
- اطلاعات برنامه هاي نصب شده روي سيستم
- اطلاعات پروتکلهاي شبکه اي مورد استفاده در سيستم
ساختار رجيستري شامل چندين مجموعه رکورد است که داده هاي اين رکوردها توسط بسياري از برنامه ها و اجزاي سيستم عامل خوانده و يا نوشته مي شود .
اجزاي رجيستري
اجزاي تشکيل دهنده رجيستري عبارتند از :
1 – subtree : Subtree ها همانند folder هاي موجود در ريشه يک درايو هارد هستند . رجستری ويندوز داراي پنج subtree مي باشد :
- HKEY_LOCAL_MACHINE : شامل تمام داده هاي پيکربندي براي کامپيوتر مي باشد و شامل 5 key است :Hardware ، SAM ، Security ، Software و System
- HKEY_USERS : شامل داده هاي مربوط به تنظيمات سيستم عامل براي هر user است مثل تنظيمات desktop و محيط ويندوز
- HKEY_CURRENT_USER : شامل داده هاي کاربر فعلي سيستم
- HKEY_CLASSES_ROOT : شامل اطلاعات پيکربندي نرم افزار است مثل داده هاي OLE و داده هاي کلاسهاي متناظر با فايل
- HKEY_CURRENT_CONFIG : شامل اطلاعات مورد نياز براي تنظيمات داريورهاي سخت افزاري و غيره
2 – Key : key ها همانند folder ها و subfolder هاي روي هارد هستند . هر key متناظر با object هاي نرم افزاري يا سخت افزاري مي باشد . subkey ها key هايي هستند که درون يکسري key قراردارند .
3 – Entry : هر key داراي يک يا چند entry است . هر entry داراي سه بخش مي باشد :
- نام Name
- نوع داده اي Data Type : مقدار هر entry يکي از انواع داده هاي زير است :
REG_DWORD ، REG_SZ ، REG_EXPAND_SZ ، REG_BINARY ،
REG_MULTI_SZ ، REG_FULL_RESOURCE_DESCRIPTOT
- مقدار Value
نکته 1 : براي مشاهده رجيستري و اعمال تغييرات در آن ( لطفاً اگر هيچ تجربه اي در تنظيم کردن رجيستري نداريد اطلاعات آنرا تغيير ندهيد ) ، مي توانيد از برنامه regedit.exe و يا regedt32.exe موجود در ويندوز استفاده کنيد . براي اينکار کافيست نام برنامه را در کادر Run وارد کنيد .
---------------------
براي کار با رجيستري در ويژوال بيسيک کلاس Registery.bas را مطابق مطالب زير ايجاد کرده و در پروژه هاي خود از آن استفاده کنيد :

1 - تعريف ثابتهاي مورد نياز : براي نوشتن اين کلاس نياز به تعريف چهار دسته ثابت داريم :

- ثابتهاي مربوط به تعريف data type هاي entry هاي رجيستري :

Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4

- ثابتهاي مربوط به تعريف key هاي رجيستري

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

- ثابتهاي مربوط به خطاهاي کار با رجيستري

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

- ثابتهاي متفرقه

Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0

2 - Declare کردن Api هاي مورد نياز : براي کار با رجيستري از توابع کتابخانه Advapi32.dll استفاده مي کنيم . اين توابع عبارتند از :

- تابع RegCloseKey : آزاد کردن handle مربوط به يک key

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

- تابع RegCreateKeyEx : ساخت يک key در رجيستري ( اگر key قبلاً وجود داشته باشد ، اين تابع آنرا باز مي کند ) :

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

- تابع RegOpenKeyEx : باز کردن يک key

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

- تابع RegQueryValueExLong : استخراج type و data ي يک نام متناظر با يک key باز شده

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

- تابع RegSetValueEx : ذخيره يک مقدار در فيلد value يک کليد باز

Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

- تابع RegDeleteKey : پاک کردن يک کليد و کليه اطلاعات مرتبط با آن

Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)

- تابع RegDeleteValue : حذف مقدار يک key

Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)

3 - توابع کمکي : براي نوشتن توابع اصلي کار با رجيستري نياز به نوشتن توابع کمکي زير است :

- تابع SetValueEx : با توجه به نوع داده يک کليد ، مقدار موجود در آنرا در يک متغير ذخيره مي کند :

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ ' type of value is string
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))x
Case REG_DWORD ' type of value is Double word
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)x
End Select
End Function

- تابع QueryValueEx : سايز و نوع داده اي يک داده را که بايد خوانده شود مشخص مي کند .

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)x
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)x
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)x
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)x
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)x
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function

4 - توابع اصلي : توابع مربوط به پاک کردن يک کليد از رجيستري ، ساخت يک کليد جديد در رجيستري و مقداردهي به يک کليد :

- تابع DeleteKey : اين تابع يک کليد از رجيستري را حذف مي کند . داراي دو پارامتر ورودي است :
Location که يکي از مقادير HKEY_CLASSES_ROOT ، HKEY_CURRENT_USER
، HKEY_LOCAL_MACHINE و يا HKEY_USERS است .
KeyName که نام کليدي است که بايد از رجيستري حذف شود . اين کليد ممکنست شامل subkey هايي نيز باشد مثلاً Key1\SubKey1

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)x
Dim lRetVal As Long
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)x
DeleteKey = lRetVal ' return function value
End Function

- تابع DeleteValue : اين تابع يک entry را از کليد حذف مي کند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName که نام آن value را مشخص مي کند .

Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = RegDeleteValue(hKey, sValueName)x
RegCloseKey (hKey)x
DeleteValue = lRetVal
End Function

- تابع CreateNewKey : اين تابع يک کليد جديد ايجاد مي کند . داراي دو پارامتر ورودي است : Location و KeyName

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)x
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)x
RegCloseKey (hNewKey)x
CreateNewKey = lRetVal
End Function

- تابع SetKeyValue : اين تابع پارامتر data يک entry را تنظيم مي کند . داراي 5 پارامتر ورودي است : Location ، KeyName ، ValueName ، ValueSetting و ValueType

Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)x
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)x
RegCloseKey (hKey)x
SetKeyValue = lRetVal
End Function

- تابع QueryValue : اين تابع فيلد داده يک entry را برمي گرداند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = QueryValueEx(hKey, sValueName, vValue)x
QueryValue = vValue
RegCloseKey (hKey)x
End Function

--------------------------
ساخت يک انتصاب فايل يا File Association به يک برنامه

در اين درس می خواهم با استفاده از کلاسی که در درس قبل معرفی شد تابعی بسازيم که توسط آن بتوانيم فايلهای با پسوندی مشخص را به يک برنامه اختصاص دهيم . بعبارت ديگر تابعی بنويسيم که اطلاعات لازم برای باز شدن فايلهايی با پسوند xxx را توسط برنامه MyApp.exe در رجيستری ثبت کند .


Public Sub CreateAssociation(sExtension As String, sApplication As String, sAppPath As String)x
Dim sPath, sAppExe As String
CreateNewKey "." & sExtension, HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, "." & sExtension, "", sApplication & ".Document", REG_SZ
CreateNewKey sApplication & ".Document\shell\open\command", HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, sApplication & ".Document", "", sApplication & " Document", REG_SZ
sPath = sAppPath & " %1"x
sAppExe = sApplication & ".exe"x
SetKeyValue HKEY_CLASSES_ROOT, sApplication& ".Document\shell\open\command", "", sPath, REG_SZ
CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Explore r\FileExts\." & sExtension, HKEY_CURRENT_USER
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explore r\FileExts\." & sExtension, "Application", sAppExe, REG_SZ
CreateNewKey "Applications\" & sAppExe & "\shell\open\command", HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, "Applications\" & sAppExe & "\shell\open\command", "", sPath, REG_SZ
End Sub

کاربرد اين تابع بصورت زير است :

CreateAssociation("xxx","MyApp","c:\MyApp.exe")x

اجرا شدن يک برنامه در هنگام راه اندازی سيستم

فرض کنيد می خواهيم برنامه ای بنويسيم که هر بار در هنگام راه اندازي سيستم بطور خودكار اجرا شود. البته نمي خواهم در startup ويندوز ديده شود .
براي اين كار بايد برنامه موردنظر را در StartUp رجيستري قرار دهيم . به اين ترتيب كه در يكي از كليدهاي زير يك مقدار رشته اي جديد(String Value) ايجاد کنيم و آدرس برنامه را در آن وارد كنيم :

HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\Curre ntVersion\Run
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Run

براي مثال اگه اسم برنامه مورد نظر MyApp و مسيرش C:\Windows\MyApp.exe است بايد بصورت زير عمل کرد :

SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run ", "MyApp", "C:\MyApp.exe", REG_SZ


نکته : البته دو تا راه ديگر برای اينکار وجود دارد که برخی تروجان ها هم از اين روشها استفاده می کنند تا روی سيستم باقی بمانند :
يكي استفاده از win.ini و نوشتن نام فايل جلوي = run و ديگري استفاده از system.ini و نوشتن نام برنامه جلوي خط explorer.exe .

تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

مطالبی در مورد کنترل WINSOCK

کنترل WinSock نسبت به تمام کنترلهاي اينترنت در سطح پايينتري قرار دارد . اين کنترل امکان ايجاد سرويسهاي شبکه اي مبتني بر پروتکلهاي TCP و UDP را مهيا مي کند . بعبارت ديگر توسط اين کنترل مي توان برنامه هاي کاربردي Client/Server ( سرويس گيرنده / سرويس دهنده ) ايجاد و با استفاده از پروتکل TCP و يا UDP بين آنها ارتباط برقرار نمود .
با تنظيم خصوصيات و فراخواني متدهاي اين کنترل مي توانيد به راحتي به يک کامپيوتر راه دور متصل شويد و داده ها را در هر دو جهت جابجا نمائيد . نمونه کاربرهايي که مي توان با اين کنترل ايجاد نمود :
Client-server chat ، Mail client ، Mail server ، Proxy Server ، Network Game ، Port Scanner ، پياده سازي الگوريتم هاي موازي و …
مباني TCP :
پروتکل کنترل اينترنت ( Transfer Control Protocol ) اجازه مي دهد يک اتصال ( Connection ) را از طريق سوکت ( socket ) به يک کامپيوتر راه دور ( Remote Computer ) ساخته و استفاده کنيد . با استفاده از اين اتصال ، هر دو کامپيوتر مي توانند داده ها را بين خودشان انتقال دهند . برقراري ارتباط از طريق TCP همانند صحبت کردن با تلفن است که بايد حتماً اتصالي بين دو کامپيوتر صورت گيرد تا بتوانند با هم ارتباط برقرار کنند .
اگر يک برنامه Client مي سازيد بايستي بدانيد که نام يا آدرس IP کامپيوتر Server چيست ( Remote Host IP ) و همچنين از طريق چه پورتي مي توانيد به آن متصل شويد ( Remote Port ) . حال بايستي به آن پورت Connect کنيد .
همچنين اگر يک برنامه Server مي سازيد بايستي پورتي را که روي آن به درخواستها گوش مي دهيد مشخص کنيد ( LocalPort ) و سپس به پورت گوش دهيد ( Listen ) .
زمانيکه يک کامپيوتر Client تقاضاي يک اتصال را مي دهد Server اين درخواست را Accept مي کند .
زمانيکه يک اتصال ساخته مي شود ، هر دو کامپيوتر مي توانند داده را فرستاده و دريافت کنند .
مباني UDP :
پروتکل ديتاگرام کاربر ( User Datagram Protocol ) پروتکلي بدون اتصال ( Connectionless ) است . برخلاف TCP ، کامپيوترها نياز به برپا کردن يک اتصال ندارند بنابراين يک برنامه مي تواند يک client و يا يک server باشد . برقراري ارتباط در UDP شبيه ارسال نامه از طريق پست است .
براي انتقال داده توسط UDP ابتدا بايد Local Port کامپيوتر Client تنظيم گردد . کامپيوتر Server تنها بايستي RemoteHost را برابر آدرس کامپيوتر Client قرار دهد و همچنين Remote Port را همان Local Port کامپيوتر Client قرار دهد . سپس دو کامپيوتر مي توانند داده ها را بين خود جابجا کنند .
استفاده از کنترل WinSock :
1 – انتخاب پروتکل: در زمان استفاده از کنترل WinSock اولين کاري که بايد انجام دهيد انتخاب يکي از پروتکلهاي TCP يا UDP است . طبيعت برنامه اي که شما مي سازيد نوع پروتکلي را که بايد استفاده کنيد مشخص مي کند . چند سوال زير به شما کمک مي کند که پروتکل مورد نيازتان را انتخاب کنيد :
- آيا برنامه شما در زمانيکه داده فرستاده مي شود يا دريافت مي شود نياز به اطلاعاتي از طرف Server يا Client دارد ؟ اگر چنين است بايستي يک اتصال TCP قبل از ارسال يا دريافت داده ايجاد شود .
- آيا داده بسيار بزرگ است ( مثل تصوير يا فايلهاي صوتي ) ؟ زمانيکه يک اتصال TCP ساخته مي شود پروتکل TCP اتصال را باقي نگه مي دارد و درستي ارسال داده تضمين شده است . اين اتصال در هر حال به منابع محاسباتي بيشتري نياز دارد و بنابراين پرهزينه تر است .
- آيا داده متناوب ارسال مي شود يا در يک نشست ( Session ) ارسال خواهد شد ؟ براي مثال اگر شما يک برنامه مي سازيد که کامپترهاي مشخصي را در يک زمان خاص از انجام شدن عملياتي مطلع مي کند پروتکل UDP مناسب تر است . پروتکل UDP همچنين براي ارسال مقادير کوچک داده اي مناست تر مي باشد .
2 – تنظيم پروتکل : براي تنظيم پروتکلي که مي خواهيد در برنامه تان از آن استفاده کنيد در زمان طراحي برنامه خاصيت Protocol کنترل WinSock را برابر sckTCPProtocol و يا sckUDPProtocol قرار دهيد . همچنين مي توانيد پروتکل خود را توسط کد زير تنظيم کنيد :


WinSock.Protocol=sckTCPProtocol
3 – مشخص کردن نام کامپيوتان : براي اتصال به کامپيوتر راه دور بايستي آدرس IP و يا نام کامپوتر را بدانيد .
نام کامپيوتر در Control Panel/Network/Identification موجود است . در صورتيکه مي خواهيد دو برنامه Client و Server خود را روي يک کامپيوتر تست کنيد از آدرس IP 127.0.0.1 براي هر دو استفاده کنيد اما اگر دو برنامه را روي دو کامپيوتر مجزا در شبکه قرار داده ايد با اجراي دستور ipconfig در DOS Prompt مي توانيد آدرس IP کامپيوتر ها را بدست آوريد .
4 – ايجاد اتصال TCP : در زمان ساخت برنامه اي که از پروتکل TCP استفاده مي کند ابتدا بايد تصميم بگيريد که اين برنامه Client است يا Server . براي ساخت يک برنامه Server بايستي روي يک پورت خاص Listen کنيد . زمانيکه Client تقاضاي يک اتصال را مي دهد ، برنامه Server مي تواند آنرا Accept کند و بنابراين اتصال کامل شده است . حال Client و Server مي توانند با هم ارتباط داشته باشند .
مراحل زير ساخت يک سرور چت ساده بر مبناي TCP را نشان مي دهد :
- از منوي Project گزينه Components را انتخاب کنيد و در ليست Component ها مورد Microsoft WinSock 6.0 را انتخاب کنيد .
- يک کنترل WinSock در فرم خود قرار دهيد و نام آنرا tcpserver بگذاريد
- دو textbox با نامهاي txtSendData و txtReceiveData و نيز يک دکمه در فرم قرار دهيد .
- کد زير را در رويداد Form_Load بنويسيد :


Tcpserver.LocalPort=1000
tcpserver.Listen

- زمانيکه درخواستي از طرف Client مي آيد رويداد ConnectionRequest اجرا مي شود . در اين رويداد ابتدا بايد چک کنيد که حالت کنترل بسته باشد . اگر چنين نيست اتصال را قبل از پذيرفتن اتصال جديد ببنديد . سپس تقاضا را بر اساس پارامتر requestID مي پذيريم :


Private Sub tcpserver_ConnectionRequest(ByVal requestID As Long)
If tcpserver.State <> sckClosed Then tcpserver.Close
tcpserver.Accept requestID
End Sub

- حال اتصال بين Client و Server برقرار شده است . کد زير را براي event مربوط به کليک دکمه Send بنويسيد :


Tcpserver.SendData txtSendData.text
- اگر داده اي از طرف Client بيايد رويداد DataArrival اجرا مي شود . کد زير را براي اين رويداد بنويسيد :


Private Sub tcpserver_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpserver.GetData strData
txtReceiveData.Text = strData
End Sub

- کد زير را براي رويداد Form_Unload بنويسيد :


Tcpserver.Close
مراحل ساخت يک TCP Client بصورت زير است :
- يک کنترل WinSock در فرم قرار دهيد و نام آنرا tcpclient بگذاريد .
- دو textbox با نامهاي txtsend و txtreceive و نيز يک دکمه با نام sendدر فرم قرار دهيد .
- يک دکمه با نام connect در فرم قرار دهيد .
- کد زير را براي متد Form_Load بنويسيد :


tcpclient.RemoteHost=”yourservername”x
tcpclient.RemotePort=1000

- کد زير را براي رويداد کليک شدن دکمه connect بنويسيد :


tcpclient.Connect
- کد زير را براي رويداد کليک شدن دکمه send بنويسيد :


tctclient.SendData txtsend.Text
- کد زير را براي رويداد DataArrival بنويسيد :


Private Sub tcpclient_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpclient.GetData strData
txtreceive.Text = strData
End Sub

- کد زير را باري رويداد Form_Unload بنويسيد :


Tcpclient.Close
کدهاي فوق يک سيستم Client-Server ساده را نشان مي دهد . فايل exe هر دو برنامه را بسازيد و آنها را اجرا کنيد تا بتوانيد سيستم خود را تست کنيد .
5 – پذيرفتن بيش از يک تقاضاي اتصال : Server اي که در بالا ساخته شد تنها مي تواند تقاضاي يک اتصال را بپذيرد . با استفاده از ايجاد يک آرايه از کنترل WinSock مي توان چندين تقاضاي اتصال را پذيرفت . براي اينکار کافي است يک کپي ( instance ) از کنترل بسازيم ( با تنظيم خاصيت Index ) و متد Accept را براي instance جديد بکار ببريم . فرض کنيد يک کنترل WinSock با نام sckServer در فرم داريم که خاصيت Index آنرا صفر قرار داده ايم . همچنين يک متغير intMax از نوع Long تعريف مي کنيم که تعداد اتصالات همزمان به Server را نگه مي دارد . در event مربوط به Form_Load کد زير را بنويسيد :


intMax=0
sckServer(0).LocalPort=1000
sckServer(0).Listen

هر بار که تقاضاي يک اتصال مي رسد کد ابتدا تست مي کند که مقدار Index چقدر است . اگر مقدار Index صفر باشد متغير intMax يکي افزايش مي يابد و از intMax براي ساخت يک instance جديد از کنترل استفاده مي شود . حال از اين instance براي پذيرفتن تقاضاي اتصال استفاده مي گردد . براي اينکار کد زير را براي رويداد ConnectionRequest بنويسيد :


Private Sub sckServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
intmax = intmax + 1
Load sckServer(intmax)x
sckServer(intmax).LocalPort = 0
sckServer(Index).Accept requestID
End If
End Sub
6 – ايجاد اتصال UDP : ساخت يک برنامه UDP ساده تر از برنامه هاي TCP است زيرا پروتکل UDP به اتصال نياز ندارد . در برنامه TCP بالا يک کنترل WinSock بايستي حتماً Listen مي کرد و يک کنترل ديگر يک اتصال را توسط متد Connect ايجاد نمود . در عوض پروتکل UDP نيازي به اتصال ندارد . براي ارسال داده بين دو کنترل WinSock سه مرحله بايستي انجام شود :
- پارامتر RemoteHost برابر نام کامپيوتر مقابل است .
- پارامتر RemotePort برابر پارامتر LocalPort کامپيوتر مقابل
- استفاده از متد Bind براي مشخص کردن LocalPort
چون هر دو کامپيوتر از نظر ارتباط مساوي هستند ، اين نوع برنامه ها را Peer-to-Peer گويند . براي نمونه از کد زير براي ساخت يک برنامه chat استفاده مي کنيم :
- يک کنترل WinSock در فرم قرار دهيد و نام آنرا udppeerA بگذاريد .
- خاصيت Protocol آنرا UDPProtocol قرار دهيد .
- دو textbox با نامهاي txtsend و txtreceive و نيز يک دکمه در فرم قرار دهيد .
- کد زير را براي متد Form_Load بنويسيد :


udppeerA.RemoteHost=”nameofpeerB”x
udppeerA.RemotePort=1001
udppeerA.Bind 1002

- کد زير را براي event مربوط به کليک دکمه بنويسيد :


udppeerA.SendData txtsend.text
- کد زير را براي رويداد DataArrival بنويسيد :


Dim strData as String
udppeerA.GetData strData
txtreceive.Text=strData

براي ساخت UDP peerB مشابه مراحل بالا عمل کنيد فقط خاصيت RemoteHost آنرا نام کامپيوتر PeerA و خاصيت RemotePort آنرا 1002 و خاصيت Bind آنرا 1001 قرار دهيد .
-------------------
بررسی خواص کنترل WinSock :
ByteReceived : مقدار داده دريافت شده ( موجود در بافر receive ) را نشان مي دهد . توسط متد GetData مي توان اين داده را دريافت نمود .
LocalHostName : نام ماشين محلي را نشان مي دهد . اين پارامتر فقط خواندني است .
LocalIP : آدرس IP ماشين محلي را بصورت يک string برمي گرداند . اين پارامتر فقط خواندني است .
LocalPort : براي خواندن و يا تنظيم شماره پورت محلي بکار مي رود .
Protocol : براي خواندن و يا تنظيم پروتوکل مورد استفاده توسط کنترل WinSock بکار مي رود .
RemoteHost : براي خواندن و يا تنظيم نام يا آدرس IP ماشين راه دور بکار مي رود .
RemoteHostIP : آدرس IP ماشين راه دور را برمي گرداند :
۱- براي برنامه هاي Client بعد از زمانيکه يک اتصال توسط متد Connect پذيرفته شد ، اين خاصيت حاوي آدرس IP ماشين راه دور است .
۲ - براي برنامه Server ، بعد از آمدن يک Connection Request اين خاصيت شامل آدرس IP ماشين راه دور است .
۳ - در زمان استفاده از پروتکل UDP بعد از اينکه رويداد Data Arrival رخ داد اين خاصيت حاوي آدرس IP ماشيني است که داده را فرستاده .
RemotePort : براي خواندن و يا تنظيم شماره پورت ماشين راه دوري که مي خواهيد به آن متصل شويد بکار مي رود .
SocketHandle : مقداري را برمي گرداند که مرتبط با سوکتي است که کنترل WinSock را مديريت مي کند و براي ارتباط با لايه WinSock بکار مي رود . اين پارامتر فقط خواندني است و تنها براي ارسال به API هاي WinSock طراحي شده است .
State : وضعيت کنترل WinSock را نشان مي دهد . وضعيتهاي ممکن براي State عبارتند از :
۱ - sckClosed : اتصال بسته است .
۲ - sckOpen : اتصال باز است .
۳ - sckListening : حالت گوش دادن به پورت
4 - sckConnectionPending : معلق شدن اتصال
۵ - sckResolvingHost : تصميم گيري در مورد ميزبان
۶ - sckHostResolved : در مورد ميزبان تصميم گيري شد .
۷ - sckConnecting : حالت برقراري ارتباط
۸ - sckConnected : ارتباط برقرار شد .
۹ - sckClosing : حالت قطع اتصال
۱۰ - sckError : حالت خطا

بررسی متدهای کنترل WinSock :
متد Accept : تنها براي برنامه هاي TCP Server بکار مي رود . اين متد براي پذيرفتن يک اتصال در زمان مديريت رويداد ConnectionRequest استفاده مي شود .
متد Bind : اين پارامتر LocalPort و LocalIP يک اتصال را مشخص مي کند .
متد Close : براي بستن يک اتصال TCP و يا بستن يک listening socket بکار مي رود .
متد GetData : بلوک جاري داده دريافت شده را گرفته و آنرا در متغيري از نوع Variant ذخيره مي کند . شکل کلي اين متد بصورت زير است :


WinSock.GetData data[,type][,maxlen]x
که data داده دريافتي است . اگر داده کافي موجود نباشد data برابر empty خواهد بود .
type نوع داده دريافتي است که مي تواند مقادير زير باشد :
vbByte - vbInteger - vbLong - vbSingle - vbDouble - vbDate - vbBoolean - vbError - vbString - vbArray+vbByte
maxlen حداکثر سايز را در زمان دريافت يک byte Array و يا يک string مشخص مي کند .
متد Getdata در رويداد Data Arrival استفاده مي شود که اين رويداد يک پارامتر با نام TotalBytes دارد . اگر maxlen اي که شما تعيين کرده ايد کمتر از TotalBytes باشد پيغام هشدار شماره ۱۰۰۴۰ دريافت مي کنيد بدين معني که بايتهاي باقيمانده گم خواهند شد .
متد Listen : يک سوکت مي سازد و آنرا در حالت Listen قرار مي دهد . اين متد تنها در اتصالات TCP بکار ميرود .
متد PeekData : مشابه GetData است با اين تفاوت که داده را از صف ورودي حذف نمي کند . اين متد تنها براي اتصالات TCP بکار مي رود .
متد SendData : براي ارسال داده به کامپيوتر راه دور بکار مي رود .
بررسي event هاي کنترل WinSock :
رويداد Close : زماني رخ مي دهد که کامپيوتر راه دور اتصال را ببندد .
رويداد Connect : بعد از اينکه يک اتصال به Server ايجاد شد روي مي دهد . شکل کلي آن بصورت زير است :


Private Sub WinSock_Connect(ErrorOccurred As Boolean)x
که پارامتر ErrorOccurred دو مقدار دارد : اگر True باشد يعني اتصال Fail شده است و اگر False باشد يعني اتصال با موفقيت انجام شده است .
با رويداد Connect مي توانيد error هايي که در زمان فرايند باز کردن اتصال برگردانده شده را چک کنيد .
رويداد ConnectionRequest : زماني رخ مي دهد که يک کامپيوتر راه دور تقاضاي يک اتصال را بدهد . اين رويداد فقط براي برنامه هاي TCP Server بکار مي رود .
رويداد DataArrival : زماني رخ مي دهد که داده جديدي بيايد .
رويداد Error : زماني رخ مي دهد که يک خطا در فرايند ارتباط رخ دهد ( مثلاً Failed to Connect و يا Failed to Send ) . شکل کلي آن بصورت زير است :


Private WinSock_Error(number as Integer,description as String,scode as Long,source as String,helpfile as String,helpcontext as Long,canceldisplay as Boolean)x

number شماره کد خطا است .
description توضيحي در مورد خطا است .
source توصيف منبع خطا
canceldisplay : مشخص مي کند آيا پيغام خطاي پيش فرض نشان داده شود يا نه
رويداد SendComplete : زماني رخ مي دهد که يک عمل Send تکميل شده باشد .
رويداد SendProgress : زماني رخ مي دهد که کنترل شروع به ارسال داده نمايد . شکل کلي آن بصورت زير است :


WinSock_SendProgress (bytesSent As Long, bytesRemaining As Long)x

که bytesSent تعداد بايتهاي ارسال شده و bytesRemaining تعداد بايتهاي باقيمانده است .

تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

ايجاد کلاسی برای کار با فايلهای XML
برای قرار دادن پارامترهای اتصال به بانک اطلاعاتی از فايل XML استفاده خواهيم نمود . بنابراين ابتدا بايستی کلاسی برای کار با فايلهای XML بنويسيم . توجه داشته باشيد که کلاسی که در اين بخش معرفی می شود کلاسی ساده می باشد که فقط با آن می توان مقدار يک ند Node وجود در فايل xml را خواند . در صورت نياز ، می توانيد خودتان متدهای ديگری را به آن اضافه کنيد . برای اين منظور نکاتی را در انتهای همين بخش آورده ام .
XML يک زبان نشانه ای توسعه پذير ( eXtensible Markup Language ) است که در سال 1998 توسط کنسرسيوم وب جهانی W3C ايجاد شد . XML واقعاً يک زبان نيست بلکه يک متا-زبان است و برای توصيف ساير زبانها بکار می رود . داده ها در فايلهای XML براحتی قابل تعريف و استفاده هستند .
مثالی از يک فايل XML :



<user>
<name>ali</name>
<id>12</id>
</user>


کار با فايلهای XML در وی بی :
برای کار با فايلهای xml در ويژوال بيسيک بايستی ابتدا از بخش References مورد Microsoft XML 3.0 را انتخاب کنيد . سپس يک Class Modules به پروژه تان اضافه کنيد و نام آنرا XMLReader بگذاريد . در اين کلاس ابتدا يک متغير از نوع شی xml برای کار با فايلهای xml تعريف می کنيم :


Private xml

سپس متدی برای مقداردهی اوليه شی xml می نويسيم . اين متد دارای يک متغير ورودی است که نام فايل xml مورد نظر می باشد :


Public Sub Initiate(ByVal filename As String)x
Set xml = CreateObject("Microsoft.XMLDOM")x
xml.async = False
xml.Load (server.MapPath(filename))x
End Sub

توجه کنيد که در کد فوق از شی server برای يافتن مسير فيزيکی فايل XML استفاده شده است بنابراين ابتدا بايستی در Class_Initialize اين شی را مطابق مطالب درس دوم مقداردهی کنيد .

حال بايستی متدی برای خواندن مقدار يک ند از فايل xml بنويسيم . در اين متد توسط يک حلقه for each ندهای فايل را بررسی می کنيم تا ندی را بيابيم که نامش مشابه با متغير ورودی متد است . سپس با استفاده از خاصيت nodeValue می توانيم مقدار آنرا بخوانيم .


Public Function getvalue(ByVal NName As String) As String
Dim x
getvalue = ""x
For Each x In xml.documentElement.childNodes
If x.nodeName = NName Then
getvalue = x.childNodes(0).nodeValue
Exit For
End If
Next
End Function

مثالی از کار با کلاس XMLReader :
همانطور که گفته شد می توانيم پارامترهای اتصال به بانک اطلاعاتی را در فايل XML قرار دهيم و در زمان Initiate کردن ADODB برای اتصال به بانک اطلاعاتی ، آنها را بخوانيم :


Dim xmlf As New XMLReader
Call xmlf.Initiate("config.xml")x
userName = xmlf.getvalue("DataBaseID")x
Password = xmlf.getvalue("DataBasePassword")x
database_name = xmlf.getvalue("DataBaseName")x
server_name = xmlf.getvalue("ServerAddress")x

ساختار يک فايل نمونه config.xml بصورت زير می باشد :



<Application>testIt</Application>
<ServerAddress>192.168.0.1</ServerAddress>
<DataBaseName>Edatabase</DataBaseName>
<DataBaseID>Euser</DataBaseID>
<DataBasePassword>Epass</DataBasePassword>


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

1 - توجه داشته باشيد که xml.documentElement بعنوان ريشه فايل xml محسوب می شود . بنابراين برای دسترسی به ريشه می توان يک شی ريشه نيز تعريف کرد :


Dim root
Set root = xml.documentElement

2 - در صورتيکه يک فايل xml دارای چندين ند در ريشه اش باشد و هر ند ريشه نيز دارای چندين ند درونی باشد توسط خاصيت root.childNodes.length و با استفاده از يک حلقه for می توان به اين ندها دسترسی داشت . برای مثال فايل زير را درنظر بگيريد :



<people>
<user>
<name>ali</name>
<id>1</id>
</user>
<user>
<name>reza</name>
<id>2</id>
</user>
</people>


حلقه زير روش دسترسی را به اين فايل نشنان می دهد :


For I = 0 TO (root.childNodes.length - 1)x
Set thisChild = root.childNodes(I)x
name = thisChild.childNodes(0).Text
id = thisChild.childNodes(1).Text
Next

3 – اضافه کردن ند به فايل : برای اضافه کردن ند از متدهای createNode و appendChild استفاده می شود برای مثال برای اضافه کردن يک user جديد به مثال فوق :


Set newuser = xml.createNode("element", "people", "")x
Dim name,id
Set newname = xml.createNode("element", "name", "")x
newname.text = yourname
Set newid = xml.createNode("element", "id", "")x
newid.text = yourid
newuser.appendChild(newname)x
newuser.appendChild(newid)x
root.appendChild(newuser)x

در انتها نيز بايستی فايل را ذخيره نمود :


xml.save(Server.Mappath(filename))x

4 – حذف يک ند از فايل : برای حذف يک ند از فايل توسط يک حلقه for بايستی ند مورد نظر را يافته و سپس توسط متد removeChild آنرا حذف کنيم :


found = False
For I = (root.childNodes.length - 1) TO 0 STEP -1
Set thisChild = root.childNodes(I)x
name = thisChild.childNodes(0).Text
If name = searchname Then
root.removeChild(thisChild)x
found = True
End If
Next


تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

می خواهید ساختن یک برنامه مالتی مدیا رو یاد بگیرید ؟؟؟

اگه می خواهید ، با من همراه بشید

این کارا رو که می گم دنبال کنید :

1)ازمنوی Project گزینه Components را انتخاب کنید .

2)از لیست باز شده گزینه های زیر را تیک بزنید :

Microsoft Common Dialog control 6.0
Microsoft Windows Common Controls 5.0 (SP2)
Windows Media Player


به برنامه خود کنترلهای زیر را اضافه کنید :( مواد لازم )
Command1
Command2
Label1
Timer1
Slider1
CommonDialog1
MediaPlayer1



کدهای زیر رو اضافه کنید :


Option Explicit
Dim File_name As String
Dim pp As Boolean

Private Sub Command1_Click()
Call Form_Load
End Sub

Private Sub Command2_Click()
On Error Resume Next
If pp = False Then
pp = True: Command2.Caption = "Play"
MediaPlayer1.Pause
Else
pp = False: Command2.Caption = "Pause"
MediaPlayer1.Play
End If
End Sub

Private Sub Form_Initialize()
MsgBox "http://vbassistant.blogfa.com", vbInformation, "About"
Me.Move 4000, 4000, 5000, 1100
Command1.Move 10, 10, 700, 330
Command2.Move 10, 340, 700, 330
Slider1.Move 800, 110, 3000, 1000
Label1.Move 3900, 240, 1500, 1000
Command1.Caption = "Open"
Command2.Caption = "Pause"

End Sub

Private Sub Form_Load()
On Error Resume Next
pp = False
Timer1.Interval = 100
Me.BorderStyle = 3
CommonDialog1.Filter = "mp3 File|*.mp3|All File|*.*"
CommonDialog1.ShowOpen
File_name = CommonDialog1.FileName
Me.Caption = File_name
MediaPlayer1.FileName = File_name
MediaPlayer1.Play
Slider1.Max = MediaPlayer1.Duration
End Sub

Private Sub Slider1_Scroll()
MediaPlayer1.CurrentPosition = Slider1.Value
End Sub

Private Sub Timer1_Timer()
Slider1.Value = MediaPlayer1.CurrentPosition
Label1.Caption = Int(MediaPlayer1.CurrentPosition) & " Seconds"
End Sub


تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

به دست آوردن سورس یک صفحه :

کار با Inet و Web Browser خیلی جالب هست :

اگرمیخواهیداین دو کنترل به کنترلهای دیگر بپیوندند.
از منوی project گزینه Components را کلیک کنید.
از بین لیست کنترلها دو گزینه microsoft internet transfer control 6.0
و microsoft internet controls را تیک بزنید و OK کنید.

کاراصلی WebBrowser نمایش صفحات وب و معمول ترین کار کنترل Inet بدست آوردن سورس یک آدرس است.

کنترلها: Command1,Text1,Text2,WebBrowser1,Inet1


کدهایی که لازمه وارد کنید :

Private Sub Command1_Click()
If Text1.Text <> "" Then
WebBrowser1.Navigate Text1.Text
Text2 = Inet1.OpenURL(Text1.Text)
End If
End Sub

Private Sub Form_Load()
Me.Width = 5325
Me.Height = 5400
Me.Caption = "Mini browser"
With WebBrowser1
.Width = 4575
.Height = 2375
.Top = 600
.Left = 240
End With
With Text1
.Top = 240
.Left = 1680
.Height = 285
.Width = 3135
.Text = "http://www.vbassistant.blogfa.com"
End With
With Text2
.Width = 4575
.Height = 2375
.Top = 3000
.Left = 240
.Text = ""
End With
With Command1
.Top = 120
.Left = 240
.Height = 375
.Width = 1215
.Caption = "Navigate"
.Default = True
End With
End Sub

برای اینکه سورس درست کار کنه باید خاصیت Multiline شیء Text1 رو به True تغییر بدید.

تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

سورس برنامه Buddy Spy :
کاربرد این برنامه برای Yahoo Messanger هست , مثلا شما می خواهید دیگران فکر کنند که شما WebCam دارید یا اینکه بفهمید یک شخص خاصی واقعاً invisible هست یا نه و اینکه شخص مورد نظر شما در Room های یاهو هست یانه و ..... . خوب این برنامه با ویژوال بیسیک نوشته شده و آقای Brandon Henricks لطف کردن و سورس این برنامه را بصورت Free و تحت GNU Licence عرضه کرده اند .

تهیه و تنظیم : parsiyan_mohsen (http://barnamenevis.org/forum/member.php?u=105519)

[mmssoft]

سری جدید سورس ها -دانلود کنید و لذت ببرید- :

1- برنامه نمونه مشاور املاک --------------> دانلود (http://www.sharemation.com/MahdiVB678/amlac%20sample.zip?uniq=4pu12v)
2- برنامه سازنده فایل ویروس فرمت کردن درایو دلخواه --------------> دانلود (http://www.sharemation.com/MahdiVB678/viruse.rar?uniq=4pu13s)
3- برنامه بسیار جالب سه بعدی (3D) --------------> دانلود (http://www.sharemation.com/MahdiVB678/3D.zip?uniq=4pu12p)
4- سورس برنامه ارسال فکس با VB -حتما دانلود کنید- --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/Fax-vb.rar?uniq=4pu2wg)
5- سورس برنامه پر کننده گرافیکی --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/filler.zip?uniq=4pu2wp)
6- فکر و بکر --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/fekr%20o%20bakr.zip?uniq=4pu2wj)

[mmssoft]

این هم چند تا سورس جدید برای شما : :لبخند: :لبخند: <<>> :تشویق: :تشویق:

1- سورس برنامه جستجو در دیتابیس --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/FieldSearch.zip?uniq=4pu2wm)
2- سورس یک آکواریوم بسیار زیبا --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/Fish.zip?uniq=4pu2ws)
3- برنامه محاسبه کننده زمان توقف موس --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/IdleTime.zip?uniq=4pu2x7)
4- سورس برنامه مبدل تصاویر --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/Image%20Convertor.zip?uniq=4pu2xa)
5- ماتریکس برای بچه های مهندسی و ریاضی --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/Matrix.zip?uniq=4pu2xj)
6- حرکت دهنده موس --------------> دانلود (http://www.sharemation.com/MahdiVB678/new1/mouse%20move.zip?uniq=4pu2xm)

[Max Payne]

راستي اين جديدا دانلود نميشه


Bandwidth Limit Exceeded

The available bandwidth quota for this file system has been exceeded.
(/MahdiVB678/new1/FieldSearch.zip)

Please, try again later.

[mmssoft]

راستي اين جديدا دانلود نميشه

اشتباه میکنید. من همه لینک ها رو امتحان کردم. درسته درسته. بهتره از یک دانلود منجر استفاده کنید. من نرم افزار Internet Download Manager رو پیشنهاد میکنم که آخرین نسخه اون تا الان که من دارم این پست رو می دم نسخه 5.17 و Build 5 هست که تو تاریخ 27 می 2009 منتشر شده.

[xxxxx_xxxxx]

سلام ميشه يه سورس درخواست كنم
يه سورس ساده واسه نمايش عكس هاي ذخيره شده تو پايگاه داده مي خواستم
بايد فايل رو به صورت باينري باز كنيم از اين سري چيزا

اگر قبل از درخواست برنامه كه ممنوع هم هست جستجو كنيد:
http://barnamenevis.org/forum/showthread.php?t=138962
http://barnamenevis.org/forum/showthread.php?t=105590
http://barnamenevis.org/forum/showthread.php?t=144132
http://barnamenevis.org/forum/showpost.php?p=515340&postcount=14
http://barnamenevis.org/forum/showthread.php?t=165017

به نتايج خوبي مي رسيد

[mmssoft]

قبل از درخواست برنامه كه ممنوع هم هست

درخواست برنامه ممنوعه؟ چه دلیلی داره؟

[Max Payne]

اين نتايج به درد كار ما نمي خوره اسنا رو قبلا ديدم كه پست زدم وگفتم اگه داريد بذاريد اون يه سورسش خوب بودش اما همچين پيچيدش كردن مثه گذاشتن عكس تو ديتابيس كه كد آنچناني نمي خواد
بازم ممنون

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

mmssoft (http://barnamenevis.org/forum/member.php?u=107519) عزيز اون لينك ها بله سالم هستش مثه اينكه اونوقتي تو پهناي باندش مشكلي پيش اومده بودش اون پيام رو ميداد

[mmssoft]

کدی برای آموزش کار با دیتابیس پسورد دار :


With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\data\bank.mdb;Persist Security Info=False;Jet OLEDB:Database Password=ali"
.RecordSource = "select * from tabel one"
End With

[mmssoft]

این هم یک ساعت بسیار زیبا :
لذت ببرید!! :لبخند:

[mmssoft]

این هم یک بازی با ویژوال بیسیک :
بازی تانک بازی.

[mmssoft]

این هم چند تا پروژه گرافیکی نمونه. پیشنهاد می کنم حتما دانلود کنید چون نکته برای یادگیری توش زیاد هست.
نگران نباشید خیلی شلوغ پلوغ هم نیست که سرتون رو گیج بیاره!!! :لبخند:

[mmssoft]

این هم یه سورس جدا کننده. از روی توضیح منظور من رو نمی فهمین. باید حتما خودتون تصویر رو ببینید تا بفهمید من چی میگم :

http://www.barnamenevis.org/forum/attachment.php?attachmentid=35062&stc=1&d=1249896871

[mmssoft]

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

تهیه و ویرایش : آقای saeedzx

[mmssoft]

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

[kuh_nur]

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





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


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

[mmssoft]

سلام 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"

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

[mmssoft]

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

\\حتما دانلود کنید.// :لبخند::لبخند::لبخند:

[mmssoft]

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

[mmssoft]

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

[mmssoft]

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

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

http://mediavb.persiangig.ir/Maghaleh/21_API_Functions.zip

[mmssoft]

کتابچه سورس

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


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

[mmssoft]

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

[mmssoft]

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

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

دانلود سورس با حجم 1.52 مگابایت (http://barnamenevis.org/forum/attachment.php?attachmentid=22944&d=1220880906)

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

[mmssoft]

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

[mmssoft]

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

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

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

[mmssoft]

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

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

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

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

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

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



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

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

[mmssoft]

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

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

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

[mmssoft]

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

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

موفق باشید

[mmssoft]

یک برنامه جالب برای بزرگنمایی روی دسکتاپ :
http://download.mehrzad.net/Default.aspx?ID=2 دانلود کنید

[mmssoft]

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

[mmssoft]

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

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

[mmssoft]

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

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

[mmssoft]

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

[mmssoft]

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

http://www.tinypic.info/files/4rnmd2mv9pactu5l1ojp.jpg
http://www.mediafire.com/download.php?tma01mydkmz دانلود کنید (http://www.mediafire.com/download.php?tma01mydkmz)

[mmssoft]

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


دانلود کنید (http://www.mediafire.com/download.php?y1wnmbwogzj)

[mmssoft]

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

دانلود کنید (http://www.mediafire.com/download.php?qw11wnzzhuj)

[mmssoft]

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


دانلود کنید (http://www.mediafire.com/download.php?mmhetk0lykw)

[mmssoft]

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


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


دانلود کنید (http://www.mediafire.com/download.php?tnhqfgzxxut)

[mmssoft]

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

[mmssoft]

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

[mmssoft]

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

[mmssoft]

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

دانلود (http://www.mediafire.com/?znzk2dmoaz2)

[mmssoft]

کار با ADO.NET و برقراری ارتباط با آن :
این ocx برای ارتباط با انواع پایگاه داده ها از جمله اکسس 2007 ؛ SQL و ... کاربرد دارد. با زدن دکمه های CTRL+T کادر Component را ظاهر کنید و تیک گزینه ی Microsoft ADO Data Control را بزنید و Ok کنید

http://i.msdn.microsoft.com/Aa227291.1061_11_04%28en-us,VS.60%29.gif
حال کنترل 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


در یک کلام رکوردست به رکورد کلیک شده اشاره می کند و محتوای کل فیلدهای آن رکورد در جعبه متن های جداگانه نمایش داده می شود.(به همین راحتی...)

[mmssoft]

download Link: Image Database (http://www.planet-source-code.com/vb/default.asp?lngCId=59422&lngWId=1)
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 (http://www.planet-source-code.com/vb/default.asp?lngCId=71013&lngWId=1)
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 (http://www.planet-source-code.com/vb/default.asp?lngCId=70999&lngWId=1)

Category: Complete Applications
Level: Beginner
.Description: A simple web browser to learn more

Compatibility: VB 5.0,VB 6.0




download Link: Transfer File (http://www.planet-source-code.com/vb/default.asp?lngCId=71015&lngWId=1)
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 (http://www.planet-source-code.com/vb/default.asp?lngCId=48355&lngWId=1)
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 (http://www.yahoo.com/), ICQ, and AIM. You don’t even need an account or need to install any clients. It a unique web service project on PSC

[mmssoft]

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

[mmssoft]

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

[mmssoft]

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


http://i28.tinypic.com/np2vt0.jpg

[mmssoft]

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

Private Declare Function GetTickCount Lib "kernel32" () As Long


این تابع را در قسمت General فرم تعریف کنید حال در رویداد Load فرم می نویسیم:



&Retval = GetTickCount

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


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

[Ali0541]

منم چند تا مي زارم شايد كارايي داشت

[Ali0541]

اينم چند تا ديگه!

[mmssoft]

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

دانلود ابزار (http://mahdisamsami.persiangig.com/VB/Component/XSCAC-v12.1-mmssoft.rar)

[butterfly8528]

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


این ابزاار رایگان هست یا پولی ؟

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

[mmssoft]

این ابزاار رایگان هست یا پولی ؟

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

این ابزار کاملا رایگانه و به هیچ گونه کرکی نیاز نداره.

[mmssoft]

سورس ستاره سه بعدی در حال چرخش :
یک ستاره که توسط CirCle درست شده است و همین طور در حال چرخش حول محورهای x,y,z است.
وبا هیچ گونه موتور 3 بعدی ساز کار نمیکند. و بسیار سبک و قابل فهم است.

دانلود (http://persiandrive.net/334039)

[Ali0541]

دوست عزيز mmssoft
فكر كنم لينكش خرابه!

[mmssoft]

و این هم یک پست استثنایی :

هزار سورس ویژوال بیسیک


http://saalek110b.250free.com/gifs/gifs2/a4/a5.gif

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

دانلود کنید (http://rapidshare.com/files/40844932/1000s_of_Visual_Basic_Source_Code_examples.zip.htm l)

[mmssoft]

دوست عزيز mmssoft
فكر كنم لينكش خرابه!

لینک رو امتحان کردم. درسته. مشکلی نداره.

[mmssoft]

DirectSkin (http://www.stardock.com/products/directskin/) يکي از بهترين کامپوننتها براي تغيير اسکين مي باشد. اين برنامه محصول شرکت stardock (http://www.stardock.com/) مي باشد که در توليد محصولات معتبر گرافيکي از قبيل WindowBlinds شناخته شده است.

از اين کامپوننت ميشه در زبانهاي برنامه نويسي Delphi,VC,C++,VB,C#,VB.NET,J# استفاده کرد.

همچنين اين نسخه از محصول، ويندوز ويستا رو هم پشتيباني ميکنه.




http://www.parsiblog.com/PhotoAlbum/vbcode/DirectSkin.jpg



اين کامپوننت تقريبا تمامي ابزارهاي برنامه نويسي رو تغيير ميده، در زير ليست بعضي از اونها رو مي بينيم:



* Freeform window borders and buttons with standard and custom functions
* Tool window borders and buttons
* Window and context menu edges, fonts and backgrounds
* Menu bars and MDI buttons
* Standard buttons
* Checkboxes
* Radio buttons
* Progress bars
* Tab items, borders and pages
* Listview headers
* Scrollbar backgrounds, arrow and thumb images
* Combo box buttons and borders
* Group box borders and backgrounds
* Status bars
* Edit window borders
* Toolbar buttons, rebars (grippers), separators and backgrounds
* Trackbars (sliders)
* Standard spin (up/down) controls
* Custom controls



براي استفاده از اسکينهاي مختلف شما ميتونيد از اسکينهاي نصب شده همراه نرم افزار WindowBlinds استفاده کنيد و يا از سايت wincustomize (http://www.wincustomize.com/) ، بخش WindowBlinds اسکين مورد نظرتون رو دانلود کنيد اين اسکينها با پسوند wba هستند که با يک برنامه فشرده سازي مثل winrar مي تونيد اونها رو باز کنيد( پسوندهاي مورد استفاده در اين کامپوننت uis هست)


دانلود (http://mmbdev.persiangig.com/ocx%26dll/DirectSkin5.0.5.9.rar) - 770 کیلوبایت

[mmssoft]

امروز سه مورد از بهترين کليدهاي گرافيکي (CommandButton) را براتون مي ذارم :

. InfiniteButton يکي از بهترين ها در نوع خودش با بيش از 500 نمونه کليد گرافيکي که شما رو از استفاده از بقيه انواع بي نياز ميکنه، فقط استفاده از اين نوع کليد حجم فايل اجراييتون رو زياد مي کنه

http://mmbdev.persiangig.com/image/InfiniteButton.gif
2. DCbutton با 12 نوع کليد
http://mmbdev.persiangig.com/image/DCbutton.gif
3. IsButton با 11 نوع کليد
http://mmbdev.persiangig.com/image/IsButton.gif

دانلود کنید و لذت ببرید. :لبخند:

دانلود دکمه اول (InfiniteButton) (http://mmbdev.persiangig.com/Source/InfiniteButton.rar)

[butterfly8528]

سلام

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

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

[mmssoft]

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

چرا شما هر ابزاری هست میپرسین پولیه یا نه؟ خوب اگه پولی بود که به درد نمیخورد که واسه دانلود بذاری. این ابذار پولی نیست و کرک شده.

[butterfly8528]

چرا شما هر ابزاری هست میپرسین پولیه یا نه؟ خوب اگه پولی بود که به درد نمیخورد که واسه دانلود بذاری. این ابذار پولی نیست و کرک شده.

عزیز جان چرا میزنی . فقط خاستم ببینم اگه تریال هستش ازش استفاده نکنم .

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

[hossein_sh2008]

فقط سورس دانلود کنید! - پست 6

بابا پسوردشونم بذاريد بد نيست

[hossein_sh2008]

DirectSkin (http://www.stardock.com/products/directskin/) يکي از بهترين کامپوننتها براي تغيير اسکين مي باشد. اين برنامه محصول شرکت stardock (http://www.stardock.com/) مي باشد که در توليد محصولات معتبر گرافيکي از قبيل WindowBlinds شناخته شده است.

از اين کامپوننت ميشه در زبانهاي برنامه نويسي Delphi,VC,C++‎,VB,C#‎,VB.NET,J# استفاده کرد.

همچنين اين نسخه از محصول، ويندوز ويستا رو هم پشتيباني ميکنه.




http://www.parsiblog.com/PhotoAlbum/vbcode/DirectSkin.jpg



اين کامپوننت تقريبا تمامي ابزارهاي برنامه نويسي رو تغيير ميده، در زير ليست بعضي از اونها رو مي بينيم:



* Freeform window borders and buttons with standard and custom functions
* Tool window borders and buttons
* Window and context menu edges, fonts and backgrounds
* Menu bars and MDI buttons
* Standard buttons
* Checkboxes
* Radio buttons
* Progress bars
* Tab items, borders and pages
* Listview headers
* Scrollbar backgrounds, arrow and thumb images
* Combo box buttons and borders
* Group box borders and backgrounds
* Status bars
* Edit window borders
* Toolbar buttons, rebars (grippers), separators and backgrounds
* Trackbars (sliders)
* Standard spin (up/down) controls
* Custom controls



براي استفاده از اسکينهاي مختلف شما ميتونيد از اسکينهاي نصب شده همراه نرم افزار WindowBlinds استفاده کنيد و يا از سايت wincustomize (http://www.wincustomize.com/) ، بخش WindowBlinds اسکين مورد نظرتون رو دانلود کنيد اين اسکينها با پسوند wba هستند که با يک برنامه فشرده سازي مثل winrar مي تونيد اونها رو باز کنيد( پسوندهاي مورد استفاده در اين کامپوننت uis هست)


دانلود (http://mmbdev.persiangig.com/ocx%26dll/DirectSkin5.0.5.9.rar) - 770 کیلوبایت

عزيز اگه ميشه آموزش و نحوه كار كردشم برامون بذاريد

[hossein_sh2008]

فقط سورس دانلود کنید! - پست 49




\\دانلود سورس نرم افزار تبدیل متن فینگلیش به فارسی//


دستت درد نكنه عزيز خيلي زحمت مي كشيد،اگر ميشه توضيحات همه برنامه ها رو كامل تر بنويسيد

[modirmasool]

فقط سورس دانلود کنید! - پست 25


سورس برنامه Paint همراه با تلفظ ابزارها.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://www.justupit.com/get.php?id=a74830d074995468979f27c028023a9a)


رمز عبور : vb-source.mihanblog.com



فقط سورس دانلود کنید! - پست 26




سورس یک دیکشنری زیبا.
برگرفته از سایت vb-source.mihanblog.com


دانلود (http://www.justupit.com/get.php?id=77104efe8432419b9bda6d320bde881b)


رمز عبور : vb-source.mihanblog.com

لینک خرابه

[ali190]

سلام



DirectSkin (http://www.stardock.com/products/directskin/) يکي از بهترين کامپوننتها براي تغيير اسکين مي باشد. اين برنامه محصول شرکت stardock (http://www.stardock.com/) مي باشد که در توليد محصولات معتبر گرافيکي از قبيل WindowBlinds شناخته شده است.

از اين کامپوننت ميشه در زبانهاي برنامه نويسي Delphi,VC,C++‎,VB,C#‎,VB.NET,J# استفاده کرد.

همچنين اين نسخه از محصول، ويندوز ويستا رو هم پشتيباني ميکنه.




http://www.parsiblog.com/PhotoAlbum/vbcode/DirectSkin.jpg



اين کامپوننت تقريبا تمامي ابزارهاي برنامه نويسي رو تغيير ميده، در زير ليست بعضي از اونها رو مي بينيم:



* Freeform window borders and buttons with standard and custom functions
* Tool window borders and buttons
* Window and context menu edges, fonts and backgrounds
* Menu bars and MDI buttons
* Standard buttons
* Checkboxes
* Radio buttons
* Progress bars
* Tab items, borders and pages
* Listview headers
* Scrollbar backgrounds, arrow and thumb images
* Combo box buttons and borders
* Group box borders and backgrounds
* Status bars
* Edit window borders
* Toolbar buttons, rebars (grippers), separators and backgrounds
* Trackbars (sliders)
* Standard spin (up/down) controls
* Custom controls



براي استفاده از اسکينهاي مختلف شما ميتونيد از اسکينهاي نصب شده همراه نرم افزار WindowBlinds استفاده کنيد و يا از سايت wincustomize (http://www.wincustomize.com/) ، بخش WindowBlinds اسکين مورد نظرتون رو دانلود کنيد اين اسکينها با پسوند wba هستند که با يک برنامه فشرده سازي مثل winrar مي تونيد اونها رو باز کنيد( پسوندهاي مورد استفاده در اين کامپوننت uis هست)


دانلود (http://mmbdev.persiangig.com/ocx%26dll/DirectSkin5.0.5.9.rar) - 770 کیلوبایت
__________________


من به توصیه نویسنده این پست رفتم به اون سایت و THEME هارو هم دانلود کردم
ولی متاسفانه THEME ها اجرا نشد
آیا در خصوص ایجاد THEME در فرم کامپوننتت بهتری سراغ دارید که تنوع THEME هاش هم زیاد باشه و بشه براحتی از THEME هاش استفاده کرد؟
ممنون میشم ازتون که کمکم کنید

[volkswagen]

سلام-
مگه اینجا برا دانلود کدهای windows application نیست؟!!!

[mahdivasadra]

رمز فایل ها فشرده چیه؟

[YasserDivaR]

دانلود سورس کد های پروژه های برنامه نویسی من به زبان VB6

درود فراوان خدمت دوستان عزیز
از اونجایی که من دارم روی سی شارپ کار میکنم و دیگه نیازی به این پروژه ها ندارم
تصمیم گرفتم سورس های اون ها رو منتشر کنم
داخل هر فایل زیپ یه فایل _Help هست که بخونید ش راهنما هست
سورس تعبیر خواب و اگه دان کنید بصورت کامل ریبون رو یاد میگیرین

این سورس ها یی که در اختیار شما هست شاید من هزار بار برنامه نویسی شو کردم
تا به این جا رسیدن - توی همه برنامه هام وسواس زیادی داشتم
و صد البته نوار ریبون که ادم و میکشه - تو وی بی 6 همش کد نویسی هست ولی توی دات نت
طراحی می کنید. بنظر من اگه شما VB6 کار میکنید شما که زحمت رو می کشید برید به سمت دات نت
واقعا دریای بی کرانی هست دات نت مخصوصا سی شارپ-
وی بی دات نت هم کد هاش همون کد های VB6 خودمون هست سعی کنید به سمت دات نت کوچ کنید

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


http://s6.picofile.com/file/8205961118/Ganjineh2015.png

دانلود سورس نرم افزار گنجینه 2015 (http://s7.picofile.com/file/8239028168/Ganjineh.rar.html)http://s6.picofile.com/file/8205210350/sadi_JK.png

دانلود سورس گلستان سعدی (http://s6.picofile.com/file/8239028876/Golestan_Sadi.rar.html)http://s6.picofile.com/file/8228479134/2015_12_17_163624.png

دانلود سورس بانک پیامک رایان (http://s7.picofile.com/file/8239029484/SMS_Bank_Rayan.rar.html)http://s6.picofile.com/file/8194630600/2015_06_11_18_13_17.pngدانلود سورس تعبیر خواب جامع (http://s7.picofile.com/file/8239030618/Tabir_Khab.rar.html)

[ilamtci]

سلام


خداوکیلی دم همه تون گرم


برا سلامتی خودتون و خانوادتون صلوات میفرستم

اللهم صلی علی محمد و آل محمد و عجل فرجهم