صفحه 2 از 6 اولاول 1234 ... آخرآخر
نمایش نتایج 41 تا 80 از 231

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

  1. #41
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    قسمت دوم :
    ساير عمليات کار با فايل :

    ۱ - حذف فايل : برای حذف يک يا چند فايل از دستور Kill استفاده می شود :
    Kill "C:\Temp\MyFile.txt"x
    Kill "C:\Temp\*.txt"x

    ۲ - انتقال فايل : برای انتقال يک فايل از يک دايرکتوری به دايرکتوری ديگر از دستور Name استفاده می شود . مبدا و مقصد بايستی روی يک درايو باشند . اگر دايرکتوری مبدا و مقصد يکی باشد فايل تغيير نام داده می شود :
    Name "C:\Temp\File1.txt" To "C:\Temp2\File2.txt"x

    ۳ - کپی کردن فايل : برای کپی کردن يک فايل از يک دايرکتوری به دايرکتوری ديگر از دستور FileCopy استفاده می شود :
    FileCopy "\File1.txt\ To "C:\Temp\File2.txt"x

    ۴ - بدست آوردن تاريخ و زمان آخرين تغيير فايل و يا زمان ايجاد فايل : برای اين کار از دستور FileDateTime استفاده می شود . ابتدا بايستی يک متغير از نوع Variant تعريف کرده و سپس توسط اين دستور تاريخ و زمان موردنظر را استخراج کنيم :
    Dim FileInfo As Variant
    FileInfo=FileDateTime("C:\Temp\MyFile.txt")x

    ۵ - استخراج طول فايل : برای بدست آوردن طول يک فايل بر حسب بايت از دستور FileLen استفاده می شود :
    FileSize=FileLen("C:\MyFile.txt")x

    ۶ - تغيير صفت يک فايل : برای تغيير صفت يک فايل از دستور SetAttr استفاده می شود . پارامترهای اين دستور عبارتند از :
    0 : فايل معمولی
    2 : فايل مخفی
    4 : فايل سيستمی

    SetAttr FileNumber,FileAttrib

    مقابله با خطاهای کار با فايل :

    در زمان کار با فايلهای احتمال زيادی وجود دارد که خطا بوجود آيد . بنابراين بايستی در زمان کار با فايلها در صورت ممکن از روتينهای مقابله با خطا استفاده کنيم . شايع ترين خطاهای کار با فايل عبارتند از :

    ۵۲ : شماره يا نام فايل صحيح نيست
    ۵۳ : فايل پيدا نشد
    ۵۴ : حالت فايل صحيح نيست
    ۵۵ : فايل قبلاً باز شده
    ۵۸ : فايل از قبل وجود دارد
    ۵۹ : طول رکورد صحيح نيست
    ۶۱ : ديسک پر است
    ۶۲ : عبور از انتهای فايل
    ۶۳ : شماره رکورد صحيح نيست
    ۷۰ : دسترسی ممنوع است
    ۷۱ : ديسک آماده نيست
    ۷۶ : مسير پيدا نشد

    در هنگام مقابله با خطا بهتراست از يک ساختار Select-Case استفاده کنيد :
    Select Case Err
    Case 71
    MsgBox "Drive is Not Ready"x
    .
    .
    .
    End Select

  2. #42
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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



    Private Function GetCountOfName(strNames() As String, strKeyName As String) As Long

    Dim i As Integer

    Dim iUpperIndex As Integer

    Dim lCounter As Long


    iUpperIndex = UBound(strNames)

    For i = 0 To iUpperIndex

    If Trim(strNames(i)) = Trim(strKeyName) Then

    lCounter = lCounter + 1

    End If

    Next i

    GetCountOfName = lCounter

    End Function

    2-پیدا کردن مقلوب عدد:


    Private Function GetReverseNumber(lInputNumber As Long) As Long

    Dim strTemp As String

    strTemp = CStr(lInputNumber)

    strTemp = StrReverse(strTemp)

    GetReverseNumber = CLng(strTemp)

    End Function

  3. #43
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    ويندوز برای برقراری ارتباط با Internet Service Provide- ISP- شما از طريق مودم و خط تلفن در اتصالات dial-up networking ، از سرويسی خاص به اسم RAS (Remote Access Service) استفاده می کند . اين سرويس دارای يک واسط برنامه نويسی است که RAS API نام دارد . اين واسط شامل مجموعه ای از توابع است که شما می توانيد آنها را در برنامه خود صدا بزنيد . RAS API ابزاری بسيار قدرتمند و قابل انعطاف است همچنين بسيار پيچيده می باشد .
    خوشبختانه برای استفاده راحتتر ، مايکروسافت تعدادی تابع را در مجموعه ای به اسم WinInet API قرار داده تا بتوان از آنها برای برقراری ارتباط و کنترل اتصال استفاده کرد .آشنايي با WinInet API :
    WinInet API مجموعه ای از توابع است که امکان ايجاد و توسعه برنامه های اينترنتی را بصورتی ساده ، سريع و کارآمد برای برنامه نويسان مهيا می کند . با استفاده از اين مجموعه توابع شما می توانيد برنامه هايي بنويسيد که از منابع اينترنتی با استفاده از پروتکلهايي چون HTTP و FTP استفاده کنند . همچنين WinInet به شما اجازه می دهد تا بتوانيد ارتباطی dial-up با يک ISP ايجاد نموده و آنرا کنترل کنيد .
    مزيـت اصلی توابع WinInet آينست که شما نيازی به دانستن ساختار پروتکلهای ارتباطی و نيز برنامه نويسی Socket نخواهيد داشت . بعبارت ديگر WinInet يک واسط سطح بالا را برای کار با منابع اينترنتی ارائه می دهد .

    امکانات Dial-Up موجود در WinInet :
    تا قبل از ارائه اينترنت اکسپلورر ورژن 4 ، WinInet تنها دارای دو تابع dial-up بود :
    تابع InternetAttemptConnect : برای بررسی اينکه آيا يک ارتباط به اينترنت وجود دارد يا نه استفاده می شد . اگر هيچ اتصالی به اينترنت وجود نداشت اين برنامه کادر تبادلی dial-up networking را نمايش می داد و کاربر اجازه داشت تا يک اتصال را برای وصل شدن به اينترنت انتخاب کند .
    تابع InternetCheckConnection : تابع با استفاده از انجام يک دستور ping به url ای که به تابع داده شده ، بررسی می کرد که آيا ارتباطی به اينترنت وجود دارد يا نه .
    اين دو تابع دارای محدوديتهای فراوانی بودند . برای مثال تابع اول نمی تواند بطور اتوماتيک اتصال به اينترنت را برقرار کند و تابع دوم نيز نمی تواند هيچ اطلاعاتی در مورد نوع ارتباط به ما بدهد .
    IE نسخه 4 ، تعدادی تابع جديد برای WinInet معرفی کرد که برخی از آنها عبارتند از :
    تابع InternetGetConnectedState : اطلاعاتی در مورد نوع ارتباط استفاده شده را بيان می کند . برای مثال اين تابع اطلاع می دهد که نوع ارتباط به اينترنت از طريق مودم است يا شبکه LAN و يا از طريق پروکسی .
    تابع InternetAutodial : اين امکان را فراهم می سازد تا يک ارتباط اينترنتی اتوماتيک از طريق مودم را با استفاده از مدخل اتصال پيش فرض که کاربر آنرا در dial-up networking مشخص کرده ايجاد کنيد .
    تابع InternetDial : اين تابع کارآمدتر از تابع InternetAutodial است و کادری را نمايش می دهد که کاربر می تواند نوع مدخل مورد نظر خود برای ارتباط تلفنی با اينترنت را انتخاب کند .
    تابع InternetAutodialHangup : برای قطع کردن اتصالی مودمی که از طريق تابع InternetAutodial برقرار شده استفاده می شود .
    تابع InternetHangUp : برای قطع کردن اتصالی مودمی که از طريق تابع InternetDialبرقرار شده استفاده می شود .
    تابع InternetSetDialState : برای تنظيم کردن وضعيت جاری ارتباط اينترنتی استفاده می شود .

  4. #44
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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

  5. #45
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    بررسی جزئيات توابع Dial-Up موجود در WinInet :
    1 – تابع InternetAutodial : بطور اتوماتيک باعث شماره گيری اتصال پيش فرض اينترنت توسط مودم می شود . اگر اتصال با موفقيت انجام شود تابع مقدار true و در غير اينصورت false بر می گرداند .
    پارامترهای ورودی تابع :
    dwFlags : فلگ کنترل کننده عمليات اتصال می باشد و يکی از مقادير زير را می تواند داشته باشد :
    - INTERNET_AUTODIAL_FORCE_ONLINE
    - INTERNET_AUTODIAL_FORCE_UNATTENDED
    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

    چگونگی declare کردن تابع :
    Public Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
    2 – تابع InternetAutodialHangup : باعث قطع کردن يک اتصال dial-up اتوماتيک می شود . اگر قطع اتصال با موفقيت انجام شود تابع مقدار true و در غير اينصورت false برمی گرداند . تابع دارای يک پارامتر ورودی به اسم dwReserved است که رزرو شده بود و بايستی صفر باشد .
    چگونگی declare کردن تابع :
    Public Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
    3 – تابع InternetDial : يک اتصال به اينترنت را با استفاده از يک ارتباط مودم مقداردهی اوليه می کند . پارامترهای ورودی آن عبارتند از :
    hwndParent : هندل مربوط به پنجره parent
    lpszConnectoid : نام ارتباط dial-up مورد استفاده
    dwFlags : فلگ کنترل اتصال که يکی از مقادير زير را می تواند داشته باشد :
    - INTERNET_AUTODIAL_FORCE_ONLINE
    - INTERNET_AUTODIAL_FORCE_UNATTENDED
    - INTERNET_DIAL_UNATTENDED : اتصال به اينترنت از طريق مودم بدون نمايش واسط کاربر
    lpdwConnection : آدرس داده ای که شامل عدد متناظر با اتصال است .
    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

    چگونگی declare کردن تابع :
    Public Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
    4 – تابع InternetGetConnectedState : اين تابع وضعيت اتصال جاری به اينترنت را بر می گرداند . اگر اتصال برقرار باشد تابع مقدار true و در غير اينصورت false برمی گرداند .
    پارامترهای ورودی تابع عبارتند از :
    lpdwFlags : توصيف وضعيت اتصال . اين پارامتر يکی از مقادير زير را می تواند داشته باشد :
    - INTERNET_CONNECTION_MODEM
    - INTERNET_CONNECTION_LAN
    - INTERNET_CONNECTION_PROXY
    - INTERNET_CONNECTION_MODEM_BUSY
    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

    چگونگی declare کردن تابع :
    Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
    5 – تابع InternetGoOnline : پيغامی به کاربر برای دادن مجوز برای مقداردهی اوليه اتصال به يک URL را می دهد . اگر اينکار موفقيت آميز باشد مقدار true و در غير اينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :
    lpszURL : URL وب سايت مورد نظر برای اتصال
    hwndParent : هندل پنجره parent
    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

    چگونگی declare کردن تابع :
    Public Declare Function InternetGoOnline Lib "wininet.dll" (ByVal lpszURL As String, ByVal hwndParent As Long, ByVal dwReserved As Long) As Long
    6 – تابع InyernetHangUp : به مودم می گويد که اتصال به اينترنت را قطع کند . پارامترهای اين تابع عبارتند از :
    dwConnection : شماره مربوط به اتصالی که می خواهيم آنرا قطع کنيم .
    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

    چگونگی declare کردن تابع :
    Public Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
    7 – تابع InternetSetDialState : تنظيم نمودن وضعيت شماره گيری مودم . اگر تنظيم با موفقيت انجام شود تابع true و در غيراينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :

    lpszConnectoid : نام اتصال dial-up
    dwState : وضعيت مربوط به اتصال dial-up . در حال حاضر اين پارامتر تنها مقدار INTERNET_DIALSTATE_DISCONNECTED را می تواند داشته باشد .

    dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
    چگونگی declare کردن تابع :
    Public Declare Function InternetSetDialState Lib "wininet.dll" (ByVal lpszConnectoid As String, ByVal dwState As Long, ByVal dwReserved As Long) As Long

  6. #46
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    بررسی فلگهای مورد استفاده در توابع dial-up :
    1 – فلگهای تابع InternetDial :
    Public Const INTERNET_DIAL_UNATTENDED = &H8000& '0x8000
    Public Const INTERENT_GOONLINE_REFRESH = &H1 '0x00000001
    Public Const INTERENT_GOONLINE_MASK = &H1 '0x00000001

    2 – فلگهای تابع InternetAutoDial :
    Public Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
    Public Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
    Public Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4


    3 – فلگهای تابع InternetGetConnectedState :
    Public Const INTERNET_CONNECTION_MODEM = 1
    Public Const INTERNET_CONNECTION_LAN = 2
    Public Const INTERNET_CONNECTION_PROXY = 4
    Public Const INTERNET_CONNECTION_MODEM_BUSY = 8

    4 - فلگهای مربوط به dial handler اختصاصی :
    Public Const INTERNET_CUSTOMDIAL_CONNECT = 0
    Public Const INTERNET_CUSTOMDIAL_UNATTENDED = 1
    Public Const INTERNET_CUSTOMDIAL_DISCONNECT = 2

    5 – فلگهای عملياتی پشتيبانی شده برای dial handler اختصاصی :
    Public Const INTERNET_CUSTOMDIAL_SAFE_FOR_UNATTENDED = 1
    Public Const INTERNET_CUSTOMDIAL_WILL_SUPPLY_STATE = 2
    Public Const INTERNET_CUSTOMDIAL_CAN_HANGUP = 4

    6 - وضعيتهای مربوط به InternetSetDialState :
    Public Const INTERNET_DIALSTATE_DISCONNECTED = 1


    در اين بخش که آخرين بخش از مباحث WinInet API است برنامه ای نمونه برای کار با توابع مودمی اين کتابخانه ارائه خواهيم داد :
    برای نوشتن برنامه ای که بتوان از طريق آن با استفاده از مودم به اينترنت متصل شد بصورت زير عمل می کنيم :
    در ابتدا بايستی تابع InternetDial را Declare کنيم :

    Private Declare Function InternetDial Lib "wininet.dll" Alias "InternetDialA" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
    سپس وضعيت شماره گيری را در متغيری به اسم lOption قرار می دهيم . اين متغير می تواند مقادير زير را داشته باشد :
    - DF_FORCE_ONLINE
    - DF_FORCE_UNATTENDED
    - DF_DIAL_FORCE_PROMPT
    - DF_DIAL_UNATTENDED
    حال نام اتصالی را که می خواهيم از آن استفاده شود در متغيری به اسم ConnectionName قرار می دهيم .
    همچنين دو متغير به اسم ConnectionID و RetVal را از نوع long تعريف می کنيم .

    حال تابع InternetDial را بصورت زير صدا می کنيم :
    RetVal = InternetDial(Me.hwnd, ConnectionName, lOption, ConnectionID, 0)
    اگر RetVal مخالف صفر باشد عمل Dial بدرستی انجام شده است .
    برای قطع اتصال فوق بايستی از تابع InternetHangUp استفاده کنيم . برای اينکار ابتدا تابع فوق را Declare می کنيم :
    Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
    سپس اين تابع را بصورت زير فراخوانی می کنيم :
    RetVal = InternetHangUp(ConnectionID, 0)
    برای اينکه مودم را مجبور کنيم تا بطور اتوماتيک از اتصال پيش فرض سيستم برای شماره گيری استفاده کند از تابع InternetAutodial استفاده می کنيم .
    برای اينکار ابتدا تابع را Declare می کنيم :

    Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal hwndParent As Long) As Long
    سپس تابع را بصورت زير فراخوانی می کنيم :
    RetVal = InternetAutodial(ADF_FORCE_UNATTENDED, Me.hwnd)
    اگر RetVal مخالف صفر باشد عمل AutoDial بدرستی انجام شده است .
    برای قطع اتصالی که توسط AutoDial ايجاد شده از تابع InternetAutodialHangup استفاده می کنيم . ابتدا اين تابع را Declare می کنيم :
    Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
    فراخوانی اين تابع بصورت زير است :
    Call InternetAutodialHangup(0)
    برای اينکه بفهيم آيا اتصال به اينترنت وجود دارد يا نه از تابع InternetGetConnectedStateEx استفاده می کنيم . برای اينکار ابتدا تابع را Declare می کنيم :
    Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long
    سپس تابع را بصورت زير فراخوانی می کنيم :
    strConnectionName = Space(256)
    lNameLen = 256
    lPtr = StrPtr(strConnectionName)
    lNameLenPtr = VarPtr(lNameLen)
    RetVal = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0)

    که strConnectionName از نوع String و بقيه متغيرها از نوع Long هستند .
    اگر RetVal مخالف صفر باشد اتصال برقرار است .
    ثابتهايی که در کدهای فوق استفاده شده عبارتند از :
    Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1&
    Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2&
    Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4&

    Private Const INTERNET_DIAL_FORCE_PROMPT = &H2000
    Private Const INTERNET_DIAL_SHOW_OFFLINE = &H4000
    Private Const INTERNET_DIAL_UNATTENDED = &H8000

  7. #47
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    TAPI چيست ؟

    TAPI يا Telephony API يک کتابخانه استاندارد برای کار با مودم و نوشتن برنامه های تلفنی می باشد . برای نمونه می توان از برنامه های Phone Dialer ( شماره گير تلفن ) ، برنامه شبکه سازی تلفنی ( Dialup Networking ) ، برنامه تشخيص پالس مودم برای ضبط اطلاعات وارد شده از طرف کاربران و کاربردهای ديگر در اين زمينه نام برد . اين کتابخانه به شما کمک کمک می کند تا بدون درگير شدن با برنامه نويسی سخت افزار مودم و درايور آن بطور مستقيم بتوانيد برنامه های کاربردیي در اين زمينه بنويسيد .
    مروری بر Microsoft Telephony :

    Telephony امکان مجتمع سازی کامپيوترها با دستگاههای ارتباطی و شبکه ها را فراهم نموده است . معمولاً دستگاه ارتباطی يک مودم و خط ارتباطی نيز شبکه PSTN ( شبکه عمومی تلفن سوئيچينگ ) می باشد . برخی از کاربردهای Telephony عبارتند از :

    ۱ - کنفرانسهای مالتی مديا بصورت Multicast
    ۲ - VoIP
    ۳ - مرکز پاسخ گويي اتوماتيک
    ۴ - تماس تلفنی از طريق کامپيوتر روی شبکه PSTN

    دياگرام زير معماری Microsoft Telephony را نشان می دهد :
    برنامه های TAPI :

    برای نوشتن برنامه های کاربردی با استفاده از TAPI بايستی ابتدا در مورد سطح سرويسی که می خواهيم ارائه دهيم تصميم گيری کنيم . برای مثال برای نوشتن يک برنامه شماره گير تلفن نياز به استفاده کامل از TAPI نيست و می توان از قابليتهای خود ويندوز در اين زمينه استفاده کرد ( Assisted Telephony ) . در بخشهای بعدی در مورد سطوح مختلف سرويس در TAPI بيشتر صحبت خواهم کرد .
    دومين مطلبی که بايد مورد توجه قرار داد اينست که می خواهيم از TAPI 2.x استفاده کنيم يا از TAPI 3.x . تفاوت ايندو آنست که TAPI ورژن ۲ يک API برمبنای C است در حاليکه ورژن ۳ آن بر مبنای تکنولوژی COM می باشد . در بخشهای بعدی مطالب بيشتری در مورد تفاوتهای اين دو نسخه بيان خواهم کرد .
    بخشهای اصلی يک برنامه کامل TAPI عبارتند از :

    ۱ - TAPI Initialization : شامل load کردن TAPI dll ، اتصال به TAPI Server ، مذاکره در مورد ورژن TAPI و برپاسازی سيستم اطلاع رسانی event می باشد .

    ۲ - Session Control : مقداردهی اوليه ، دريافت و کنترل تماسها

    ۳ - Device Control : دريافت و تنظيم اطلاعات دستگاه

    ۴ - Media Control : تشخيص و يا توليد تونها و ارقام ، کنترل stream

    ۵ - TAPI Shutdown : آزاد سازی منابع
    مقداردهی اوليه TAPI :

    عملکرد درست اجزای TAPI نياز به برپاسازی محيط ارتباطی روی کامپيوتر مورد نظر دارد . مراحل اين امر عبارتند از :

    ۱ - نصب TAPI : زمانيکه سخت افزار و يا نرم افزار برای اولين بار به کامپيوتر اضافه می شود انجام می گيرد . جزئيات کار به سيستم عامل و نرم افزار بستگی دارد .

    ۲ - مقداردهی ابتدائی : ساخت اشيا و مسيرهای ارتباطی

    ۳ - مذاکره در مورد ورژن TAPI : برای اطمينان از اينکه اجزای TAPI قادر به تبادل داده ها باشند .

    ۴ - استخراج اطلاعات منابع : بدست آوردن اطلاعاتی در مورد دستگاهی که می توان از آن در برنامه TAPI مورد نظرمان استفاده نمود .

    ۵ - Event notification : برپاسازی سيستم اطلاع رسانی event
    مقداردهی اوليه TAPI در ويژوال بيسيک :

    از منوی Project گزينه References را انتخاب کرده و از ليست مربوطه مورد Microsoft TAPI 3.0 Type Library را انتخاب کنيد .
    حال وارد بخش کد نويسی فرمتان شويد و متغير objTAPI را بصورت زير تعريف کنيد :

    Dim objTapi As TAPI

    سپس در بخش مربوط به Form Load شی objTAPI را بصورت زير ايجاد می کنيم :

    Set objTapi = New TAPI

    همانطور که در بخشهای قبلی گفته شد ، قبل از فراخوانی هر تابع TAPI ابتدا بايستی آنرا مقداردهی اوليه کنيم . برای مقداردهی اوليه کردن شی TAPI عبارت زير را بنويسيد :

    Call objTapi.Initialize

    انتخاب يک آدرس :
    کد زير نشان می دهد که چگونه می توان با استفاده از شی TAPI در ويژوال بيسيک منابع تلفنی در دسترس را برای يک آدرس که بتواند يک مجموعه مشخص از نيازها را مديريت کند ، بررسی کرد .
    توجه داشته باشيد که قبل از انجام اين کار بايستی عمل مقداردهی اوليه TAPI را که در بخش قبل ررسی شد ، انجام دهيد .

    نکته : در کد زير عمل error checking انجام نگرفته است و برای استفاده از کد زير در برنامه های واقعی بايستی بخش بررسی خطا را به آن اضافه کنيد .
    ۱ - تعريف يک شی آدرس و يک شی مجموعه آدرس :

    Dim gobjAddress As ITAddress
    Dim objCollAddresses As ITCollection

    ۲ - تنظيم شی objCollAddress بعنوان يک مجموعه آدرس از شی objTapi :

    Set objCollAddresses = objTapi.Addresses

    ۳ - پيدا کردن آدرسی که بتواند از واسط مورد نظر ما پشتيبانی کند :

    bFound = False
    For indexAddr = 1 To objCollAddresses.Count
    Set objCrtAddress = objCollAddresses.Item(indexAddr)x
    Set objMediaSupport = objCrtAddress
    Set objAddressCapabilities = objCrtAddress

    If objMediaSupport.QueryMediaType( nSelectedType ) x
    bFound = True
    End If

    Set objAddressCapabilities = Nothing
    Set objMediaSupport = Nothing
    Set objCrtAddress = Nothing

    If bFound = True Then Exit For
    Next indexAddr


    در صورتيکه آدرس مورد نظزر پيدا شود برنامه از حلقه خارج شده و gobjAddress يک آدرس قابل استفاده خواهد بود :

    Set gobjAddress = objcollAddresses.Item(indexAddr)x

    انجام Event Handling در TAPI :

    کد زير شامل يک event handler ساده برای TAPI ، رجيستر کردن واسط event ، تنظيم فيلتر event و رجيستر کردن تمام فراخوانيهای دادن اخطار است . هدف اصلی از اين کد اينست که مطمئن شويم بخشی از TAPI که event ها را دريافت می کند پردازشی را قبل از انتقال به بخشهای ديگر انجام دهد .

    تعاريفها :

    Dim WithEvents gobjTapiWithEvents As TAPI
    Attribute gobjTapiWithEvents.VB_VarHelpID = -1
    Dim glRegistrationToken As Long



    Const TAPI3_CALL_EVENTS =TE_CALLMEDIA Or
    TE_CALLNOTIFICATION Or TE_CALLSTATE


    تنظيم eventfilter بصورتيکه تمام event های تعريف شده برای TAPI را بپذيرد :

    objTapi.EventFilter = TAPI3_CALL_EVENTS

    رجيستر کردن event ها :

    Set gobjTapiWithEvents = objTapi
    Dim fOwner As Boolean, fMonitor As Boolean
    Dim lMediaTypes As Long, lCallbackInstance As Long

    fOwner = True
    fOwner = True
    fMonitor = False
    lMediaTypes = TAPIMEDIATYPE_AUDIO
    lCallbackInstance = 1

    glRegistrationToken = gobjTapi.RegisterCallNotifications(gobjAddress,fMo nitor,
    fOwner,lMediaTypes,lCallbackInstance)x

    انتخاب يک ترمينال :

    + قبل از اينکه يک ترمينال را برای برقراری ارتباط انتخاب کنيد بايستی TAPI Initialization و عمل انتخاب آدرس را انجام داده باشيد .

    ابتدا يک متغير از نوع ITBasicCallControl ( واسط کنترل تماس ) تعريف می کنيم :

    Dim objCallControl As ITBasicCallControl
    Set objCallControl = gobjReceivedCallInfo

    سپس يک متغير از نوع ITTerminalSupport ( کوئری از شی آدرس ) تعريف می کنيم :

    Dim objTerminalSupport As ITTerminalSupport
    Set objTerminalSupport = gobjAddress

    سپس متغير ترمينال را تعريف کرده و توسط شی objTerminalSupport يک ترمينال را برای آن استخراج می کنيم :

    Dim objTerminal As ITTerminal
    Set objTerminal = objTerminalSupport.GetDefaultStaticTerminal(lMedia Type, dir)x

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

    Set objTerminalSupport = Nothing

    سپس نياز به تعريف شی objStreamControl برای کنترل ترمينال است :

    Dim objStreamControl As ITStreamControl
    Set objStreamControl = objCallControl

    در صورتيکه اين شی ايجاد شود ، به ازای استريم های موجود در ITCollection امکان ايجاد ترمينال در يک حلقه for بررسی می شود و ترمينال مناسب انتخاب می گردد :

    If Not (objStreamControl Is Nothing) Then
    Dim objITCollStreams As ITCollection

    Set objITCollStreams = objStreamControl.Streams

    Dim nIndex As Long, objCrtStream As ITStream

    For nIndex = 1 To objITCollStreams.Count
    Set objCrtStream = objITCollStreams.Item(nIndex)x
    If objCrtStream.MediaType = lMediaType Then
    If objCrtStream.Direction = dir Then
    Call objCrtStream.SelectTerminal(objTerminal)x
    End If
    End If
    Set objCrtStream = Nothing
    Next nIndex

    Set objITCollStreams = Nothing
    Set objStreamControl = Nothing
    End If


    ايجاد يک تماس ( Make a Call ) :
    + قبل از اين بخش بايستی مراحل TAPI Initialization و عمل انتخاب آدرس انجام شده باشد .
    اين بخش برای ايجاد يک شی تماس ، بررسی و مشخص کردن استريمی که با اين تماس در ارتباط است ، انتخاب و ايجاد ترمينالهای مناسب و کامل کردن ارتباط استفاده می شود .
    قبل TAPI Initialization و عمل انتخاب آدرس و انتخاب ترمينال انجام شده باشد .
    در ابتدا با استفاده از متد CreateCall يک شی تماس ساخته می شود :

    Set gobjCall = gobjOrigAddress.CreateCall(strDestAddress, nSelectedType,lMediaTypes)x

    سپس در اينجا بايستی کدی که در بخش اول اين درس برای انتخاب ترمينال نوشته شد آورده شود :

    }
    Select Terminal Code
    {

    سپس بايستی دستور Connect اجرا شود :

    gobjCall.Connect (False)x

    False بدين معناست که ارتباط بصورت آسنکرون برقرار می شود .
    دريافت يک تماس :

    کد زير برای يافتن و يا ايجاد يک ترمينال مناسب برای دريافت يک تماس بکار می رود . بايستی توجه داشته باشيد که قبل از اجرای کد زير بايستی مراحل مقداردهی اوليه ، انتخاب يک آدرس و رجيسر کردن event ها را انجام دهيد . همچنين در کد زير بايستی مرحله انتخاب ترمينال را نيز انجام دهيد . توجه داشته باشيد که در کد زير متغير pEvent يک اشاره گر برای واسط ITCallNotificationEvent است که توسط TAPI به event Handler داده می شود :

    If TapiEvent = TE_CALLNOTIFICATION Then
    Dim objCallNotificationEvent As ITCallNotificationEvent
    Set objCallNotificationEvent = pEvent
    Dim gobjReceivedCallInfo As ITCallInfo
    Set gobjReceivedCallInfo = objCallNotificationEvent.Call
    Dim objCallControl As ITBasicCallControl
    Set objCallControl = gobjReceivedCallInfo
    objCallControl.Answer
    End If

  8. #48
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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



    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 و GameDev استفاده کنيد .

    روش 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

  9. #49
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    موضوع : کنترل کيبرد با روش Event-Based

    مقداردهی اوليه و مفاهيم اصلی در روش Event-Based مشابه روش Polling است و تنها بايستی ساختار بخش جمع آوری داده و حلقه پردازشی را تغيير دهيم . مراحل کار با روش Event-Based بصورت زير می باشد :

    ۱ - تعاريف و مقداردهی اوليه : در بخش تعاريف دو تعريف جديد بصورت زير داريم :

    Dim hEvent As Long
    Implements DirectXEvent8

    hEvent يک پارامتر هندل برای يک می باشد .
    نکته : زمانی که کليدی فشرده يا رها می شود ، DirectX اين امر با فراخوانی تابعی به اسم DirectXEvent8_DXCallback به برنامه شما اطلاع می دهد . ( اين نوع توابع را Call Back Function گويند ) . اين تابع به برنامه شما می گويد که يک رويداد اتفق افتاده است و بايستی بافرها را چک کند .

    تنها تغييری که در بخش مقداردهی اوليه نياز است ، برپاسازی يک event می باشد :

    If UseEventMethod Then
    hEvent = DX.CreateEvent(frmMain)x
    DIDevice.SetEventNotification hEvent
    End If

    در انتهای برنامه نيز کد زير را برای از بين بردن event اضافه کنيد :

    If hEvent <> 0 Then DX.DestroyEvent hEvent


    ۲ - استفاده از event : برای اين بخش کدهايي را در داخل تابع DirectXEvent8_DXCallback می نويسيم :

    Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)x
    'متغيرهای موردنياز
    Dim I As Long
    Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
    If eventid = hEvent Then
    If DIDevice Is Nothing Then Exit Sub
    'درصورت رخ دادن event داده را از کيبرد می گيريم
    DIDevice.GetDeviceStateKeyboard DIState
    DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
    'چک کردن تمام کليدها برای اينکه متوجه شويم چه اتفاقی افتاده است
    For I = 0 To 255
    'عدد ۱۲۸ نشان دهنده key_down event است .
    If DIState.Key(I) = 128 Then
    If pBuffer(0).lData = 128 Then
    txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I)) & vbCrLf
    End If
    End If
    'کد فوق برای بررسی فشرده شدن يک کليد بود . کد زير رها شدن کليد را بررسی می کند
    If (pBuffer(0).lData = 0 And pBuffer(0).lOfs = I) Then
    txtOutput.Text = txtOutput.Text & "{ UP }" & KeyNames(CInt(I)) & vbCrLf
    End If

    txtOutput.SelStart = Len(txtOutput.Text)x
    Next I
    End If
    End Sub

  10. #50
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    موضوع : کنترل ماوس با DirectX Input



    برای استفاده از ماوس در برنامه های مالتی مديا و بازيها همانند کی برد می توانيم از امکانات دايرکت ايکس استفاده کنيم . روش کنترل ماوس توسط DirectX Input بسيار ساده بوده و مشابه کنترل کيبرد می باشد بنابراين درصورتی که دو درس گذشته را نخوانده اين پيشنهاد می کنم ابتدا آنها را مطالعه کنيد .

    برپاسازی Device :

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

    Private Const mSpeed As Single = 2
    Private Const BufferSize As Long = 10
    Private mPosition As Point

    mSpeed مقدار سرعت حرکت کرسر ماوس را مشخص می کند .
    BufferSize سايز بافر DI می باشد .
    mPosition موقعيت جاری کرسر ماوس را نشان می دهد .

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

    Set DIDevice = DI.CreateDevice("guid_SysMouse")x
    Call DIDevice.SetCommonDataFormat(DIFORMAT_MOUSE)x
    Call DIDevice.SetCooperativeLevel(frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)x

    تفاوت عمده کدهای فوق با کدهای مقداردهی اوليه در بخش کی برد آنست که cooperativelevel تغيير کرده است . در اينجا گفته شده که ما می خواهيم از ماوس بصورت انحصاری در برنامه استفاده کنيم . اين حالت برای برنامه های window-base مناسب نيست و بهترست از آن در بازيهايي که بصورت full screan هستند استفاده کنيد .

    خواندن ورودی از ماوس :

    در اين بخش می توانيد هم از روش polling و هم event-based استفاده کنيد . نکته مهمی که در اينجا وجود دارد آنست که Direct Input فقط حرکت داده شدن ماوس و کليک شدن يک دکمه را به شما اطلاع می دهد و برای تشخيص حالتهای double click و single click خودتان بايستی کد بنويسيد برای مثال اگر فاصله زمانی بين دو کليک کمتر از ۴۰ ميلی ثانيه باشد آنگاه اين يک double click بوده است .
    کد زير حرکت داده شدن ماوس و کليک يکی از سه دکمه آنرا اطلاع می دهد :

    Dim DevData(1 To BufferSize) As DIDEVICEOBJECTDATA
    Dim nEvents As Long
    Dim I As Long
    nEvents = DIDevice.GetDeviceData(DevData, DIGDD_DEFAULT)x
    For I = 1 To nEvents
    Select Case DevData(I).lOfs
    Case DIMOFS_X
    mPosition.x = mPosition.x + (DevData(I).lData * mSpeed)x
    If mPosition.x < 0 Then mPosition.x = 0
    If mPosition.x > frmMain.ScaleWidth Then mPosition.x = frmMain.ScaleWidth
    imgCursor.Top = mPosition.y
    imgCursor.Left = mPosition.x
    lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
    Case DIMOFS_Y
    mPosition.y = mPosition.y + (DevData(I).lData * mSpeed)x
    If mPosition.y < 0 Then mPosition.y = 0
    If mPosition.y > frmMain.ScaleHeight Then mPosition.y = frmMain.ScaleHeight
    imgCursor.Top = mPosition.y
    imgCursor.Left = mPosition.x
    lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
    Case DIMOFS_BUTTON0
    label(2).Caption = "Button 0 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
    Case DIMOFS_BUTTON1
    label(3).Caption = "Button 1 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
    Case DIMOFS_BUTTON2
    label(4).Caption = "Button 2 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
    Case DIMOFS_BUTTON3
    label(5).Caption = "Button 3 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
    End Select
    Next I

    برای استفاده از کد فوق در روش Polling ، بايستی آنرا در يک حلقه Do while-Loop قرار دهيد .
    برای استفاده از کد فوق در روش Event-Based ، بايستی آنرا درون روتين DirectXEvent8_DXCallback قرار دهيد .

  11. #51
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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

    در سلسله مباحث 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 فايل صوتي شما را توصيف مي کند .

  12. #52
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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

    ساخت بافر و play کردن آن :
    تاکنون ما توانستيم DirectSound را initial کنيم . همانطور که می دانيد در تمام component های DirectX داده ها در يکسری بافر ذخيره می شوند . در مورد DirectSound نيز ما يک بافر با نام DirectSoundSecondaryBuffer8 می سازيم و داده های صوتی را در آن قرار می دهيم . برخی پارامتر ها هستند که بايد برای بافر تنظيم شوند مثل : stereo يا mono بودن بافر ، ۸ بيتی يا ۱۶ بيتی بودن بافر ، فرکانس صوتی ( 22khz ، 44khz و غيره ) . اگر اين پارامترها را مشخص نکنيم DirectSound از اطلاعات فايل صوتی استفاده می کند .
    در يک کاربرد ساده ، ما تنها يک بافر صوتی از يک فايل ايجاد می کنيم اما امکان ايجاد چندين بافر بطور همزمان و نيز پخش چندين صدا بطور همزمان نيز وجود دارد :

    DSBDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
    Set DSBuffer = DS.CreateSoundBufferFromFile(App.Path & "\Sample.wav", DSBDesc)x
    MsgBox "SOUND BUFFER CREATED:"x
    MsgBox "Buffer Size: " & DSBDesc.lBufferBytes & "bytes (" & Round(DSBDesc.lBufferBytes / 1024, 3) & "kb)"x
    MsgBox "Buffer Channel Count:" & DSBDesc.fxFormat.nChannelsIIf(DSBDesc.fxFormat.nCh annels = 1, " (Mono)", " (Stereo)")x
    MsgBox "Buffer Bits per channel: " & DSBDesc.fxFormat.nBitsPerSample & " bits"x

    در بالا يک بافر صوتی ايجاد شده و اطلاعات صدا از فايل به بافر load شده است .
    حال بايستی داده صوتی موجود در بافر را play کنيم :
    دستور لازم برای Play کردن بافر بصورت loop :

    DSBuffer.Play DSBPLAY_LOOPING

    دستور لازم برای Play کردن بافر بدون loop :

    DSBuffer.Play DSBPLAY_DEFAULT

    دستورات لازم برای Stop کردن بافر :

    DSBuffer.Stop
    DSBuffer.SetCurrentPosition 0

    دستور لازم برای Pause کردن بافر :

    DSBuffer.Stop

    تنظيم خصوصيات بافر : سه خصوصيت وجود دارد که در مورد بافر تنظيم می شود pannig ، volume و frequency
    محدوده مقادير pannig بين اعداد زير است :
    DSBPAN_LEFT = -10,000
    DSBPAN_CENTER = 0
    DSBPAN_RIGHT = 10,000
    توسط متد SetPan می توان pannig بافر را تنظيم کرد :

    DSBuffer.SetPan yourValue

    DirectSound صدا را تقويت نمی کند بلکه آنرا تضعيف می نمايد بنابراين ماکزيمم volume عبارت است از volume ای که فايل صوتی با آن ضبط شده است . بعبارت ديگر محدود مقادير volume بين اعداد زير است :
    DSBVOLUME_MAX = 0
    DSBVOLUME_MIN = -10000
    توسط متد SetVolume می توان volume بافر را تنظيم کرد :

    DSBuffer.SetVolume yourValue

    محدود فرکانسی DirectSound عبارت است از :
    DSBFREQUENCY_MIN = 100 (hz)x
    DSBFREQUENCY_MAX = 100000 (hz) = 100khz x
    توسط متد SetFrequency می توان فرکانس بافر را تنظيم کرد :

    DSBuffer.SetFrequency yourValue

  13. #53
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    موضوع : پخش موزيک توسط DirectMusic



    در اولين درس از آموزش DirectXAudio با چگونگي پخش افکتهاي صوتي آشنا شديد . اکنون اين توانايي را داريد که يک engine ساده صوتي بنويسيد . در اين بخش مباني پخش موزيک را فرا خواهيد گرفت . پس از اين درس شما مي توانيد يک ماژوال براي پخش موزيکهاي پس زمينه و افکتهاي صوتي براي برنامه هايتان ايجاد کنيد .

    Initil کردن DirectMusic8 :

    قبل از هر کار بايستي ماژول DirectMusic8 را مقداردهي اوليه کنيد . اينکار بصورت زير انجام مي شود :

    Option ExplicitImplements DirectXEvent8
    Private oDX As DirectX8
    Private oDMPerf As DirectMusicPerformance8
    Private oDMLoader As DirectMusicLoader8
    Private oDMSeg As DirectMusicSegment8

    Dim dmParams As DMUS_AUDIOPARAMS
    Set oDX = New DirectX8
    Set oDMPerf = oDX.DirectMusicPerformanceCreate
    Set oDMLoader = oDX.DirectMusicLoaderCreate
    oDMPerf.InitAudio frmMain.hWnd, DMUS_AUDIOF_ALL, dmParams, Nothing, DMUS_APATH_DYNAMIC_STEREO, 128
    oDMPerf.SetMasterAutoDownload True

    شي DirectMusicLoader8 کمک مي کند تا موزيک درون بافر load شود .
    شي DirectMusicSegment8 مموزيکي را که بايد پخش شود ذخيره مي کند .
    کد فوق کافي است يکبار زمانيکه برنامه آغاز مي شود ، اجرا گردد .
    اکنون ما يک واسط مقدار دهي شده از DirectMusic داريم اما قبل از اينکه موزيک را Load کرده و پخش کنيم چگونگي terminate کردن DirectMusic را در زير مي بينيد :

    If ObjPtr(oDMSeg)Then Set oDMSeg = Nothing
    If ObjPtr(oDMLoader)Then Set oDMLoader = Nothing
    If Not (oDMPerf Is Nothing) Then
    oDMPerf.CloseDown
    Set oDMPerf = Nothing
    End If
    If ObjPtr(oDX) Then Set oDX = Nothing


    پيغامها :

    در برخي از component هاي DirectX8 مثل Input , Sound , Music و Play برنامه شما بايستي يک سيستم messaging را برپا کند تا DirectX زمان وقوع برخي رخدادهاي خاص را بشما گزارش دهد . اين مطلب بخصوص زمانيکه يک موزيک را پخش مي کنيد مفيد است براي مثال مي تواند زمان خاتمه يافتن موزيک را به شما اطلاع دهد و آنگاه شما مي توانيد قطعه موزيک بعدي را پخش کنيد .
    پيغامها توسط يک سيستم callback انجام مي شوند . کد زير را در تابع InitDMusic تان پس از initial کردن DirectMusic8 قرار دهيد :

    oDMPerf.AddNotificationType DMUS_NOTIFY_ON_SEGMENT
    hEvent = oDX.CreateEvent(Me)x
    oDMPerf.SetNotificationHandle hEvent

    اولين سطر به DirectMusic مي گويد چه نوع پيغامهايي را مي خواهيد به برنامه تان بفرستد . چندين نوع پيغام وجود دارد :
    DMUS_NOTIFY_ON_SEGMENT = اطلاعات موزيک فعلي ( شروع پخش ، پايان پخش و غيره )
    DMUS_NOTIFY_ON_CHORD = اطلاعات تغيير chord موزيک
    DMUS_NOTIFY_ON_COMMAND = زمانيکه يک event فرماني صدا زده شود .
    DMUS_NOTIFY_ON_MEASUREANDBEAT = اطلاعات beat/measure مربوط به موزيک فعلي
    DMUS_NOTIFY_ON_PERFORMANCE = که event مربوط به سطح performance می باشد .
    DMUS_NOTIFY_ON_RECOMPOSE = که recomposition event می باشد .
    آخرين بخش از پيغام دهي ، تابع اصلي آن مي باشد . همانطور که در بخش Initial کردن DirectMusic ديديد يک توصيف بصورت Implements DirectXEvent8 داشتيم . بخش اصلي تابع callback مربوط به DirectXEvent8 ، شامل يک select case است که بين پيغامهاي مختلف سوئيچ می کند :

    Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)x
    If eventid = hEvent Then
    Dim dmMSG As DMUS_NOTIFICATION_PMSG
    If Not oDMPerf.GetNotificationPMSG(dmMSG) Then
    Else
    Select Case dmMSG.lNotificationOption
    Case DMUS_NOTIFICATION_SEGABORT
    Case DMUS_NOTIFICATION_SEGALMOSTEND
    Case DMUS_NOTIFICATION_SEGEND
    Case DMUS_NOTIFICATION_SEGLOOP
    Case DMUS_NOTIFICATION_SEGSTART
    Case Else
    End Select
    End If
    End If
    End Sub


    پخش موزيک / متوقف کردن موزيک :

    براي پخش يک موزيک ابتدا بايستي آنرا load کنيد . اينکار توسط کد زير انجام مي شود :

    oDMLoader.SetSearchDirectory App.Path & "\"x
    Set oDMSeg = oDMLoader.LoadSegment(App.Path & FILENAME)oDMSeg.SetStandardMidiFile

    DirectMusic تنها چهار نوع فرمت صوتي را مي پذيرد : WAV ، MID ، RMI و SEG .
    براي پخش فايلهاي MP3 بايستي از DirectXShow استفاده کنيد که آنرا در درسهاي بعدي خواهيد ديد .
    اکنون که داده هاي فايل صوتي درون بافر load شد مي توانيد آنرا پخش کنيد :

    oDMSeg.SetRepeats 0
    oDMPerf.PlaySegmentEx oDMSeg, DMUS_SEGF_DEFAULT, 0

    تعداد پخش شدن فايل را با متد SetRepets تنظيم کنيد . اگر اين مقدار صفر باشد ، آهنگ تنها يکبار پخش مي شود و اگر 1- باشد بطور ممتد پخش خواهد شد .
    براي متوقف کردن موزيک از کد زير استفاده کنيد :

    oDMPerf.StopEx oDMSeg, 0, DMUS_SEGF_DEFAULT

    براي تنظيم ميزان صدا از متد SetMasterVolume استقاده کنيد :

    oDMPerf.SetMasterVolume yourvalue

    رنج صدا بين 20+ دسی بل تا 200- دسي بل است .
    براي تنظيم Tempo از متد SetMasterTempo استفاده کنيد :

    oDMPerf.SetMasterTempo yourvalue/ 100

    بطور نرمال tempo برابر 1 مي باشد . عدد 2 سرعت را دو برابر مي کند و عدد 0 موزيک را قطع مي کند .

  14. #54
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    موضوع : ايجاد صدای سه بعدی توسط DirectSound3D



    تاکنون با چگونگي پخش افکتهاي صوتي و موسيقي پس زمينه توسط DirectXAudiuo آشنا شديد . اين مطالب براي کاربردهاي ساده مناسبند اما اينکه فقط ما صداي استريو داشته باشيم کافي نيست و در کاربردهاب حرفه اي بايستي از صداهاي کاملاً سه بعدي استفاده کنيم .
    با استفاده از افکتهاي صوتي سه بعدي مي توانيم صدا را در تمام جهتها براي کاربر شبيه سازي کنيم اما با همه مزاياي صداي سه بعدي ، دو اشکال براي آن وجود دارد : اول اينکه پخش صداي سه بعدي پيچيده تر از پخش صداي عادي است و تنها کارت هاي سخت افزاري جديد بطور کاملاً واقعي از آن پشتيباني مي کنند و دوم اينکه صداي سه بعدي با 4 بلندگو يا بيشتر حاصل مي شود – کيفيت حالت 2 بلندگو بد نيست اما در مقايسه با حالت 4 بلندگو ، بسيار کيفيت صداي سه بعدي پايين است .

    برپاسازي DirectSound3D

    برپاسازي صداي سه بعدي چندان پيچيده نيست اما هر بافر صوتي که براي يک صداي سه بعدي مي سازيد ، يک overhead را به سيستم تان اضافه مي کند . همچنين برخي درايورها هستند که تنها اجازه ايجاد تعداد محدودي بافر سه بعدي را در يک لحظه مي دهند و نيز اغلب درايورها تعداد بافرهاي سه بعدي که مي توان در يک لحظه پخش کرد را محدود مي کنند ( معمولاً 8 تا 16 بافر ) .
    اولين قدم در استفاده از صداي سه بعدي تعريف متغيرها و اشيا زير است :

    Dim DSBuffer As DirectSoundSecondaryBuffer8
    Dim DSBuffer3D As DirectSound3DBuffer8
    Dim DSBListener As DirectSound3DListener8

    تنها دو شي آخر براي شما جديد هستند . شي DirectSound3dBuffer8 يک ارائه سه بعدي از بافرهاي عادي است . ما همچنان از DirectSoundSecondaryBuffer8 براي نگهداري داده صوتي استفاده مي کنيم و از DirectSound3Dbuffer8 براي نگهداري پارامترهاي سه بعدي و تنظيمات سه بعدي استفاده مي کنيم . شي DirectSound3Dlistener8 نيز يک listener است و براي تنظيم کردن سرعت و جهت صدا و برخي پارامترهاي ديگر استفاده مي شود .
    مرحله دوم ، ساخت بافر صوتي است . اين کار در دو بخش انجام مي شود . اول ما يک بافر صوتي نرمال مي سازيم و سپس يک واسط بافر صوتي سه بعدي را از آن بدست مي آوريم :

    If Not (DSBuffer Is Nothing) Then DSBuffer.Stop
    Set DSBuffer = Nothing
    DSBDesc.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_CTRLVOLUME
    Set DSBuffer = DS.CreateSoundBufferFromFile(App.Path & "\blip.wav", DSBDesc)x
    If DSBDesc.fxFormat.nChannels > 1 Then
    MsgBox "You can only use mono (1 channel) sounds with DirectSound3D"x
    End If
    If optLow.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_NO_VIRTUALIZATION
    If optMedium.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_HRTF_LIGHT
    If optHigh.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_HRTF_FULL
    Set DSBuffer = DS.CreateSoundBufferFromFile(App.Path & "\blip.wav", DSBDesc)x
    Set DSBuffer3D = DSBuffer.GetDirectSound3DBuffer()x

    سه نکته است که بايد به آن دقت شود :
    1 – اضافه کردن DSBCAPS_CTRL3D بسيار مهم است . شما اگر اين پارامتر را بکار نبريد ، قادر نخواهيد بود که واسط سه بعدي را بدست آوريد .
    2 – ما بايستي تنها از افکتهاي صوتي Mono ( تک کاناله ) استفاده کنيم زيرا افکت صوتي استريو در صداي سه بعدي معنا ندارد زيرا صدا از يک نقطه در فضاي سه بعدي مي آيد .
    3 – سطح الگوريتم سه بعدي – که در پارامتر DSBDesc.guid3Dalgorhthm آمده . حالت NO VIRTULIZATION تنها از CPU استفاده مي کند و روي تمام سيستم ها کار مي کند اما افکتها مينيمم هستند . حالت HRTF LIGHT هم از CPU و هم سخت افزار کارت صوتي استفاده مي کند و کيفيت بهتري را نسبت به خالت اول ارائه مي دهد . حالت HRTF FULL بهترين حالت است اما در صورتي درست کار مي کند که يک سخت افزار سه بعدي داشته باشيد .
    آخرين پارامتري که بايد تنظيم کنيم شي listener است :

    DSBDesc_2.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_PRIMARYBUFFER
    Set DSBPrimary = DS.CreatePrimarySoundBuffer(DSBDesc_2) x
    Set DSBListener = DSBPrimary.GetDirectSound3Dlistener
    DSBListener.SetOrientation 0#, 0#, 1#, 0#, 1#, 0#, DS3D_IMMEDIATE

    تا اينجا صداي سه بعدي ما آماده است و مي توانيم برخي پخش بافر را مشابه درسهاي قبلي شروع کنيد .
    پارامترهاي اختياري :

    چند پارامتر وجود دارد که مي توان آنها را تغيير داد :
    1 – Volume : عدد 0 بيشترين ميزان صدا و عدد 3000 - کمترين ميزان صدا را دارد :

    If DSBuffer Is Nothing Then Exit Sub
    DSBuffer.SetVolume scrlVolume.Value

    2 – Position : تنظيم محل listener :

    DSBuffer3D.SetPosition Src_X, 0, Src_Y, DS3D_IMMEDIATE
    DSBListener.SetPosition Src_X, 0, Src_Y, DS3D_IMMEDIATE

    3 – Velocity : تنظيم سرعت و جهت منبع صدا :

    DSBuffer3D.SetVelocity X, Y, Z, DS3D_IMMEDIATE
    DSBListener.SetVelocity X, Y, Z, DS3D_IMMEDIATE

    4 – Dppler Effect : انحراف صدا از مسيري که مي پيمايد انحراف سرعت حرکت صدا :

    DSBListener.SetDopplerFactor CSng(scrlDoppler.Value), DS3D_IMMEDIATE

    5 – Rolloff Effect : rolloff چگونگي تضعيف صدا با تغيير فاصله است .

    DSBListener.SetRolloffFactor CSng(scrlRolloff.Value), DS3D_IMMEDIATE

    6 – Distance : ماکزيمم فاصله اي که يک صدا مي تواند شنيده شود :

    DSBuffer3D.SetMaxDistance 250, DS3D_IMMEDIATE
    DSBuffer3D.SetMinDistance 0.01, DS3D_IMMEDIATE

  15. #55
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    رجيستري چيست ؟
    سيستم عامل ويندوز تنظيمات سخت افزاري و نرم افزاري خود را بطور مرکزي در يک بانک اطلاعاتي با ساختار سلسله مراتبي ذخيره مي کند که رجيستري نام دارد . رجيستري جايگزيني براي بسياري از فايلهاي پيکربندي 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 .

  16. #56
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آشنايي با Windows API : واژه API مخفف Application Programming Interface مي باشد . API هاي ويندوز مجموعه اي از توابع از پيش آماده موجود در سيستم عامل هستند که شما مي توانيد آنها را در برنامه هاي خود فراخواني کنيد . اين توابع در چندين کتابخانه DLL ويندوز ذخيره شده اند . براي دسترسي به اين توابع در ويژوال بيسيک ابتدا بايد آنها را برنامه خود declare کنيد . براي مثال :

    Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

    همانطور که مي بينيد مثال فوق يک Declare از تابع sndPlaySound مي باشد که اين تابع در کتابخانه Winmm.dll موجود است . کلمه Alias نشان مي دهد که اين تابع نام ديگري در dll دارد . ساير بخشها مربوط به تعريف پارامترهاي تابع مي باشند که در مورد مثال فوق ، اين تابع دو پارامتر ورودي و يک خروجي از نوع Long دارد .
    پس از Delare کردن API در برنامه مي توانيد از آن استفاده نمائيد .

    ۲ - پخش فايلهاي Wav : تابعي که براي پخش فايلهاي Wav استفاده مي شود تابع sndPlaySound است که در بالا با آن آشنا شديد . پارامتر lpzSoundName نام و مسير فايل Wavو پارامتر uFlags چگونگي پخش فايل را مشخص مي کند . مقادير ممکن اين پارامتر عبارتند از :
    - SND_ASYNC : اجازه مي دهد طوري فايل Wav پخش شود که آنرا بتوان وقفه داد . بعبارت ديگر قادر خواهيد بود فايل Wav تان را هر زمان که بخواهيد پخش کنيد و مطمئن باشيد که حتماً شنيده مي شود .
    - SND_LOOP : فايل Wav را بطور ممتد پخش مي کند .
    - SND_NODEFAULT : اگر فايل Wav پيدا نشود صداي ديگري پخش نخواهد شد ( مثلاً برخي صداهاي default ويندوز )
    - SND_SYNC : در طول پخش فايل Wav کنترل به برنامه داده نمي شود . اين پارامتر در زمانيکه مي خواهيد فايل Wav اي را در پس زمينه برنامه تان پخش کنيد مناسب نمي باشد .
    - SND_NOSTOP : اگر فايل Wav اي قبلاً در حال پخش باشد ، فايل Wav شما آنرا دچار وقفه نمي کند . از اين پارامتر زماني استفاده مي شود که بخواهيم فايل Wav مان هيچوقت در وسط کار قطع نشود .
    اگر بخواهيد از بيش از يکي از اين پارامترها استفاده کنيد توسط Or آنها را ترکيب نمائيد مثال :

    sndPlaySound App.path & "\ding.wav", SND_ASYNC or SND_LOOP


    نکته : براي استفاده از توابع صوتي پيچيده تر بايستي از DirectSound که يکي از اجزاي DirectX مي باشد استفاده کنيد . در مورد DirectSound بعداً صحبت خواهم کرد .

    ۳ - ساخت يک تايمر با دقت بالا : شايد تا بحال از کنترل تايمر موجود در نوار ابزار ويژوال بيسيک استفاده کرده باشيد . اين تايمر داراي دقت حدود ۵۵ ميلي ثانيه است . براي دستيابي به زمانهاي با دقت بالاتر اين کنترل مفيد نخواهد بود .
    تابع GetTickCount يک API موجود در کتابخانه Kernel32.dll است . اين تابع طول زماني را که سيستم شروع به کار کرده است را برحسب ميلي ثانيه برمي گرداند :

    Private Declare Function GetTickCount Lib "kernel32" () As Long
    براي بررسي طي شدن يک مدت زماني خاص شما ابتدا بايد مقدار اين تابع را در يک متغير کمکي مثل TempTime قرار دهيد سپس در يک حلقه Do-Loop بايد اختلاف زمان GetTickCount جديد و زمان TempTime را با مقدار زماني که مي خواهيد سپري شود مقايسه کنيد :

    TempTime = GetTickCount()x
    Do While DesiredTime < GetTickCount() - TempTime
    Do some things'
    Loop

    توسط کد بالا مي توان يک عمليات خاص را براي يک مدت زماني مشخص اجرا کرد .
    کد زير نشان مي دهد که چگونه مي توان دستورات خاصي را در فواصل زماني خاص اجرار کرد :

    ExitFunction = False
    TempTime = GetTickCount()x
    Do While not(ExitFunction)x
    If DesiredTime < GetTickCount() - TempTime then
    Reset the temporary variable'
    TempTime = GetTickCount()x
    Do some things'
    End If
    Loop

    همچنين از تابع GetTickCount مي توان براي benchmark برنامه ها استفاده کرد . بعبارت ديگر مي توان زمان اجراي يکسري دستورات خاص را بدست آورد .

  17. #57
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    مطالبی در مورد کنترل 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 تعداد بايتهاي باقيمانده است .

  18. #58
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    رویداد ها در ویژوال بیسیک
    براي هر عملي که ميخواهيم کاربر در برنامه ما انجام دهد مي بايست در هر رويداد کد خاصي را بنويسيم تا نسبت به رفتار خاصي پاسخگو باشيم اين رويدادها تعيين ميکنند که برنامه ما نسبت به چه اعمالي حساس باشد کليک کردن يا فشردن دکمه اي خاص.
    عمل کليک : تو مثالهاي قبلي وقتي رو Command1 کليک ميکرديم يه عملي انجام ميشد چون ما تو رويداد کليک Command1 اون کدمون رو نوشتيم حالا اگه بخواهيم رويدادهاي ديگه اي هم هستن مثلا KeyDown ويا MouseMove و ... همه اينها بسته به نوعشون در مقابل رفتار کاربر عمل بخصوصي رو انجام ميدن حالا چند تا کد مينويسيم که با رويدادهاي مختلف آشنا بشيم :
    MouseMove:زماني که ماوس رو باتن حرکت کنه Caption باتن عوض ميشه.
    Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Command1.Caption = "Mosee Move !"End Sub
    MouseDown: اگر دکمه فشار داده شود (هنوز دستمان روي دکمه ماوس است دکمه بالا نيامده)
    Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Command1.Caption = "Mosee Down !"End Sub
    MouseUp : دکمه ماوس فشار داده شده و به سمت بالا رها مي شود بعد از عمل MouseDown
    Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Command1.Caption = "Mosee Up !"End Sub
    رويدادهاي KeyDown وKeyPress وKeyUp هم مثل همين ها هستند تنها تفاوت چون نياز به يک دستور شرطي دارند(با يک دستور شرطي مشخص ميکنيم اگر کليد فشرده شده مثلا Ctrl بود چه عملي انجام شود) بعدا که دستورات شرطي رسيديم ميگم .DragDrop و DragOver هم همچنين.+
    ولي حالا ميخواهيم يه برنامه ساده بنويسيم که از کنترل Label استفاده مي شه . يه کنترل ليبل از سمت چپ انتخاب کنين و بندازين تو صفحه فرمتون ! برنامه ما اين کار رو ميکنه -[وقتي ماوس رو ليیل ميره رنگ اون عوض ميشه و Bold هم ميشه مثل همين لينک ها و وقتي هم ماوس رو از روش برمي داريم به حالت اول بر ميگرده ]- خب اول براي رويداد MouseMove اينها رو مينويسيم:
    Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label1.ForeColor = &HFF& Label1.FontBold = TrueEnd Sub
    و در رويداد Form_MouseMove هم اينها رو مينويسيم(همين ها رو کپي و پيست کنين)
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label1.ForeColor = &H80000007 Label1.FontBold = FalseEnd Sub
    حالا برنامه رو اجرا کنين ماوس رو روي ليبل بذارين و از روش بردارين

  19. #59
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آشنایی با BITBIT
    هدف از اين مبحث آموزشي ، آشنايي با تابع BitBlt و برخي ديگر از توابع کتابخانه Win32 GDI براي انجام برخي عمليات گرافيکي مثل double buffering و خواندن sprite از فايل است .
    نکته : sprite به کاراکترهاي متحرکي گفته مي شود که در بازيها وجود دارد .
    اولين چيزي که به آن نياز داريد ايجاد يک فرم است . خاصيت ScaleMode آنرا برابر 3-Pixel قرار دهيد . پيشنهاد مي کنم که هميشه در هنگام استفاده از فرم بهمراه API از pixel براي scalemode استفاده کنيد .
    سپس سايز فرم را به اندازه اي افزايش دهيد تا ScaleWidth برابر 320 و ScaleHeight برابر 256 شود . توجه کنيد که خاصيت HasDC فرم را True قرار دهيد . همچنين از خاصيت AutoRedraw براي فرم استفاده نمي کنيم زيرا مي خواهيم از Double Buffering استفاده کنيم که بسيار سريعتر و کارامدتر مي باشد .
    مرحله بعدي declare کردن API هايي است که به آنها نياز داريم :
    'blitting
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    'code timer
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    'creating buffers / loading sprites
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    'loading sprites
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    'cleanup
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

    سوال : DC چيست ؟ DC و يا بعبارت ديگر Device Context ، hDC يک عدد است که به يک آدرس در حافظه اشاره مي کند که داده اي در آن ذخيره شده است . در هنگام استفاده از BitBlt براي اشاره کردن به آدرسي که داده گرافيکي در آنجا ذخيره شده ، استفاده مي شود .
    در مرحله بعدي نياز به ذخيره آدرسهاي DC داريم که مي سازيم . آدرسهاي DC مقادير Long هستند همچنين آنها را بصورت Public تعريف مي کنيم :
    'our Buffer's DC
    Public myBackBuffer As Long
    Public myBufferBMP As Long
    'The DC of our sprite/graphic
    Public mySprite As Long
    'coordinates of our sprite/graphic on the screen
    Public SpriteX As Long
    Public SpriteY As Long

    حال بايد تابعي بسازيم که تصاوير گرافيکي درون حافظه load کند . نکته مهمي که بايد به آن توجه کنيد اينست که يک device context خودش به تنهايي هيچ داده گرافيکي ندارد و بايستي يک bitmap موجود باشد تا درون آن load شود براي مثال يک فايل bmp يا يک bitmap خالي که از آن بعنوان back buffer استفاده مي کنيد .
    تابعي که خواهيم نوشت يک device context منطبق با صفحه مي سازد سپس فايلهاي گرافيکي مورد نظر را درون device context قرار مي دهد :
    Public Function LoadGraphicDC(sFileName As String) As Long
    'temp variable to hold our DC address
    Dim LoadGraphicDCTEMP As Long
    'create the DC address compatible with
    'the DC of the screen
    LoadGraphicDCTEMP = CreateCompatibleDC(GetDC(0))
    'load the graphic file into the DC...
    SelectObject LoadGraphicDCTEMP, LoadPicture(sFileName)
    'return the address of the file
    LoadGraphicDC = LoadGraphicDCTEMP
    End Function

    سوال : double-buffering چيست ؟ زمانيکه يک محيط گرافيکي مي سازيد تا درون آن چيزي را ترسيم کنيد ، شما sprite ها / گرافيکها / متن را درون حافظه blit مي کنيد ( offscrean ) سپس نتيجه نهايي را روي صفحه blit مي کنيد . اين عمل از لرزش تصوير يا flickering جلوگيري مي کند ( زماني رخ مي دهد که چندين sprite مستقيماً روي صفحه blit شوند ) و بسيار سريعتر از AutoRedraw است .
    قبل از اينکه مثالي براي اين تابع ذکر کنم تابع BitBlt را توضيح خواهم داد :
    BitBlt تابعي از کتابخانه dll “gdi32” است . اين تابع يک انتقال bit-block از داده هاي مرتبط به يک مستطيل از پيکسلها به يک device context مقصد انجام مي دهد . بعبارت ديگر داده هاي گرافيکي را از محيط گرافيکي ( يک bitmap ) به محيط گرافيکي ديگري ( screen يا يک form ) کپي مي کند . فرم کلي اين تابع بصورت زير است :
    Declare Function BitBlt Lib "gdi32" Alias "BitBlt" _
    (ByVal hDestDC As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long

    اولين خط بيان مي کند که ما بوسيله gdi32 DLL به تابع BitBlt دسترسي خواهيم داشت . خطوط ديگر پارامترهايي هستند که اين تابع مي گيرد :
    hDestDC : hDC مربوط به محيط مقصد ( اگر مي خواهيد مقصد يک فرم باشد از form.hDC استفاده کنيد و يا اينکه آدرس يک backbuffer را که ساخته ايد بدهيد )
    x : مختصات افقي محلي که مي خواهيد گرافيک شما ظاهر شود .
    y : مختصات عمدي محلي که مي خواهيد گرافيک شما ظاهر شود .
    nWidth : عرض گرافيک شما
    nHeight : ارتفاع گرافيک شما
    hSrcDC : hDC مربوط به محيط مبدا
    xSrc : افست x . 0 زماني استفاده مي شود که بخواهيد از سمت چپترين گوشه گرافيک مبدا عمل blit را انجام دهيد .
    ySrc : افست y
    dwRop : مد draw اي که در زمان blitting گرافيکتان مي خواهيد استفاده کنيد ( Raster Operations يا ROP ) . اين پارامتر مقادير زير را مي تواند بگيرد :
    - vbSrcCopy : داده تصوير مبدا را مستقيماً در مقصد کپي مي کند .
    - vbSrcPaint : داده هاي تصاوير مبدا و مقصد را با هم OR مي کند ( pseudo-alphablending effect )
    - vbSrcAnd : داده هاي تصاوير مبدا و مقصد را با هم AND مي کند ( pseudo-gamma effect )
    - vbSrcInvert : داده هاي تصاوير مبدا و مقصد را با هم XOR مي کند
    - vbSrcErase : ابتدا داده تصوير مقصد را invert مي کند سپس آنرا با داده تصوير مبدا AND مي کند .
    - vbDstInvert : داده تصوير مقصد را invert مي کند و داده تصوير مبدا را در نظر نمي گيرد .
    - vbNotSrcCopy : داده تصوير مبدا را invert مي کند و آنرا مستقيماً در مقصد کپي مي کند .
    - vbNotSrcErase : داده تصاوير مبدا و مقصد را OR کرده و نتيجه را invert مي کند .

    مثالي از کاربرد BitBlt :
    BitBlt Form1.hDC, PlayerX, PlayerY, 48, 48, picPlayer.hDC, 0, 0, vbSrcCopy

    حال مي خواهيم از BitBlt در يک حلقه استفاده کنيم تا يک image را در فرم حرکت دهيم :
    1 – يک فايل bmp با ابعاد 32x32 بسازيد و با نام sprite1.bmp در دايرکتوري پروژه ذخيره کنيد .
    2 – يک دکمه در فرم قرار دهيد و نام آنرا cmdTest بگذاريد .
    3 – دکمه را در گوشه بالايي فرم و در سمت راست قرار دهيد .
    4 – کد زير را براي event مربوط به کليک شدن دکمه بنويسيد :
    'Timer variables...
    Dim T1 As Long, T2 As Long
    ساخت DC براي backbuffer’
    myBackBuffer = CreateCompatibleDC(GetDC(0))
    ساخت يک سطح bitmap براي DC’
    myBufferBMP = CreateCompatibleBitmap(GetDC(0), 320, 256)
    load کردن سطح bitmap خالي درون buffer’
    SelectObject myBackBuffer, myBufferBMP
    قبل از blit کردن درون بافر بايد آنرا با black پر کنيم’
    BitBlt myBackBuffer, 0, 0, 320, 256, 0, 0, 0, vbWhiteness
    load کردن split توسط تابعي که در بالا نوشتيم’
    mySprite = LoadGraphicDC(App.Path & "\sprite1.bmp")
    cmdTest.Enabled = False
    == شروع حلقه اصلي ==’
    خواندن tickcount جاري’
    T2 = GetTickCount
    Do
    DoEvents
    T1 = GetTickCount
    اگر 15 ميلي ثانيه گذشته بود فريم بعدي شروع شود’
    If (T1 - T2) >= 15 Then
    پاک کردن محل قبلي sprite بوسيله پر کردن آنجا با black ‘
    BitBlt myBackBuffer, SpriteX - 1, SpriteY - 1,32, 32, 0, 0, 0, vbBlackness
    Blit کردن sprite درون back buffer’
    BitBlt myBackBuffer, SpriteX, SpriteY, 32, 32,mySprite, 0, 0, vbSrcPaint
    Blit کردن backbuffer روي فرم’
    BitBlt Me.hdc, 0, 0, 320, 256, myBackBuffer,0, 0, vbSrcCopy
    حرکت دادن sprite روي صفحه’
    SpriteX = SpriteX + 1
    SpriteY = SpriteY + 1
    'update timer
    T2 = GetTickCount
    End If
    Loop Until SpriteX = 320
    سپس بايد يک cleanup code بنويسيد تا حافظه هاي را که براي نگهداري تصاوير گرافيکي و buffer ها استفاده کرده ايد آزاد کنيد :
    Private Sub Form_Unload(Cancel As Integer)
    DeleteObject myBufferBMP
    DeleteDC myBackBuffer
    DeleteDC mySprite
    End
    End Sub

  20. #60
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    ايجاد کلاسی برای کار با فايلهای 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

  21. #61
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    حالا می خواهم واستون آموزش DIRECTX_GRAPHIC رو بزارم ....!!!!!!!!!!!

  22. #62
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزش 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
    DimDispMode as D3DISPLAYMODE


    شي
    D3DISPLAYMODE حالت نمايش را مشخص مي نمايد .

    Dim D3Dwindow as D3DPRESENT_PARAMETERS


    شي فوق مشخص مي کند که
    viewport شما چگونه باشد .
    حال شي اصلي
    DirectX8 را مي سازيم :

    Set Dx=New DirectX8


    سپس شي اصلي ساخت واسط سه بعدي را مي سازيم :

    ()
    set D3D.Dx.Direct3Dcreate


    سپس حالت فعلي نمايش را با دستور زير استخراج مي کنيم :

    D3D.getadapterdisplaymodeD3DADAPTER_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 ساخته شود که يا از طريق سخت افزار و يا نرم افزار تصاوير را رندر نمايد :

    SetD3DDevice=D3Dcreatedevice(D3DADAPTER_DEFAULT
    ,
    D3DDEVTYPE_HAL,
    frmMain.hwnd,D3DCREATE_SOFTWARE_VERTEXPROCESSING,
    D3Dwindow)x,
    endsub


    درصورتي که کارت گرافيک شما امکانات رندر سخت افزاري تصاوير را ندارد از
    D3DDEVTYPE_REF بجاي D3DDEVTYPE_HAL استفاده کنيد .
    حال بايستي روتين
    render را بنويسيم . البته در اين درس تصويري براي رندر نداريم و تنها چگونگي نوشتن اين روتين را بيان خواهم کرد :
    ۱ - ابتدا بايستي device مربوط به رندر ، قبل از کشيدن تصوير در آن پاک شود :

    D3DDevice.clear 0,byval 0,D3DCLEAR_TARGET,&H0,1#,0


    عدد
    hex اي که در دستور فوق آمده رنگ زمينه صفحه را مشخص مي کند
    ۲ - سپس بايستي تصاوير مورد نظر را رندر کنيم . اينکار توسط دستورات زير انجام مي شود :

    D3DDevice.beginscence
    all rendering calls gobetween these two lines '
    D3DDEvice.endscence


    3 - در پايان بايستي صفحه را
    update کنيد :

    D3DDevice.present byval 0,byval 0,0,byval 0


  23. #63
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزش DirectX-Graphic قسمت دوم
    موضوع : بدست آوردن مشخصات و تواناييهاي گرافيکي يک سيستم توسط 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




  24. #64
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزش DirectX-Graphic قسمت سوم
    موضوع : رسم اشکال دو بعدي

    مروري بر 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


  25. #65
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزشDirectX-Graphic قسمت چهارم
    موضوع : آشنايي با برخي اصطلاحات

    1- Mesh : مش ، مجموعه اي از face ها است که يک شي سه بعدي را روي صفحه تشکيل مي دهند .

    ۲ - Face : يک چند ضلعی است که توسط مجموعه ای از نقاط به نام vertex ساخته مي شود .

    ۳ - Vertex : يک نقطه در فضاي سه بعدي است که براي دادن موقعيت ، scale و زاويه يک face استفاده مي شود .

    ۴ - Direct3D از شيي بنام D3DVERTEX براي نمايش يک Vertex استفاده مي کند . براي ساخت face نيز از آرايه اي از vertex ها استفاده مي شود . آرايه هميشه بايستي قابل تقسيم به سه باشد زيرا اشکال از face هاي مثلثي ساخته مي شوند . هنگاميکه اين مثلثها کنار هم گذاشته شوند ، شي سه بعدي را مي سازند . Direct3D از بافري با نام Index Buffer استفاده مي کند که با direct3D مي گويد که با چه ترتيبي vertex ها را رسم نمايد . index ها بايستي هميشه در جهت عقربه هاي ساعت مشخص شوند .


  26. #66
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزشDirectX-Graphic قسمت پنجم
    موضوع : اختصاص بافت 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



  27. #67
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزشDirectX-Graphic قسمت ششم
    موضوع : مفاهيم اوليه رسم اشکال سه بعدي در DirectX 8

    در اين درس با استفاده از Direct3D يک مکعب را رسم مي کنيم . براي اين منظور ابتدا نياز به يک بافر داريم که بتوانيم شکل مورد نظر خود را در آن ذخيره کنيم :


    Dim VBuffer as Direct3DVertexBuffer8


    براي رسم مکعب از vertex هاي سه بعدي استفاده مي کنيم . براي اينکار نياز به تعريف يک تايپ جديد داريم :


    Private Type LITVERTEX
    x as single
    y as single
    z as single
    color as long
    specular as long
    tu as single
    tv as single
    end type


    توصيف گر اين فرمت ، بصورت زير است :


    Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)x


    براي توصيف مکعب در اين درس از روشي غيرکارامد استفاده شده است . به اين ترتيب که از ۳۶ عدد vertex استفاده شده ( در درسهاي بعدي متدهايي معرفي خواهند شد که اجازه مي دهند از ۸ عدد vertex باري توصيف مکعب استفاده کنيد ) .


    Dim cube(35) as LITVERTEX


    سپس بايد يکسري ماتريس سه بعدي تعريف کنيم :
    اولين ماتريس ، matworld است که نشان مي دهد چگونه vertex ها در فضاي سه بعدي قرار گرفته اند . دومين ماتريس ، matview است که نشان مي دهد دوربين ( نقطه ديد ) در کجا قرار گرفته و سومين ماتريس ، matproj است که نشان مي دهد دوربين چگونه دنياي سه بعدي را روي صفحه دو بعدي نشان مي دهد :


    Dim matworld as D3DMATRIX
    Dim matview as D3DMATRIX
    Dim matproj as D3DMATRIX


    در تابع Initialize قبل از ساخت device بايستي چک کنيم که آيا مي توانيم از يک بافر Z شانزده بيتي استفاده کنيم يا نه ؟


    If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then
    D3DWindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer


    حال بايستي متد D3DCreateDevice را اجرا کنيد . سپس بايد سيستم سايه زني vertex را با فرمت vertex مان تنظيم کنيم :


    D3DDevice.SetVertexShader Lit_FVF


    همچنين سيستم نورپردازي را غير فعال مي کنيم :


    D3DDevice.SetRenderState D3DRS_LIGHTING, False


    Direct3D هيچ مثلثي را که در ديد شما نباشد رسم نخواهد کرد . براي متوقف کردن اين امر بايستي حالت culling آنرا متوقف کنيد همچنين vertex ها را بترتيب عقربه هاي ساعت معرفي کنيد :


    D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE


    سپس بايد فرمت بافر Z را فعال سازيد :

    D3DDevice.SetRenderState D3DRS_ZENABLE, 1

  28. #68
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

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


  29. #69
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزشDirectX-Graphic قسمت هشتم
    موضوع : نورپردازي و اختصاص بافت به اشيا سه بعدي
    در اين درس مي خواهيم به مکعب درس قبل بافت اختصاص داده و نيز آنرا با يک منبع نور ، نورپردازي کنيم .
    ابتدا تايپ 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 بودن آنرا نشان مي دهد .


  30. #70
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزش DirectX-Graphic قسمت نهم
    موضوع :‌ترسيم متن دو بعدي در 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


  31. #71
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    آموزشDirectX-Graphic قسمت دهم
    موضوع : ترسيم اشيا سه بعدي با استفاده از شي 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


  32. #72
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    خودم علاقه شدیدی به مبحث های DIRECTX دارم.
    واسه جمع آوری اینها زحمت زیادی کشیدم...
    امیدوارم که برای دوستان گلم و مدیران عزیز قابل قبول باشه.
    اینشاءالله اگه باز هم مطلب جدیدی بود واستون می زارم.

  33. #73

    Thumbs up نقل قول: یه سری آموزش های فوق العاده جالب برای دوستان عزیز

    نقل قول نوشته شده توسط parsiyan_mohsen مشاهده تاپیک
    چگونه می توان هندل ( Handle ) یک Textbox را در یک پنجره بدست آورد ؟
    پاسخ : برای بدست آوردن هندل پنجره برنامه ای که هم اکنون باز است از تابع FindWindow استفاده کنید . نحوه declare کردن آن بصورت زیر است :
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    فرض کنید caption فرم برنامه مورد نظرتان در متغیر strWindowName قرار داشته باشد . با دستور زیر می توانید هندل پنجره آنرا بدست آورید :
    Dim hwndFound As Long
    hwndFound = FindWindow(vbNullString, strWindowName)
    نکته : برای پیدا کردن هندل پنجره برنامه ای که caption آنرا بطور دقیق نمی دانید می توانید از تابع FindWindowLike استفاده کنید .
    حال که هندل پنجره مورد نظرتان را استخراج کردید می توانید با استفاده از تابع FindWindowEx هندل اشیا موجود در آن پنجره را بدست آورید . نحوه declare کردن این تابع بصورت زیر است :
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    این تابع را بصورت زیر استفاده کنید :
    htextbox = FindWindowEx(hwndFound, ByVal 0&, "ThunderRT6TextBox", vbNullString)
    که ThunderRT6Textbox نام کلاس Rich Textbox ها در ویژوال بیسیک 6 است . دستور فوق هندل اولین Textbox موجود در پنجره را به شما بر می گرداند . برای بدست آوردن هندل سایر Textbox ها از حلقه زیر استفاده کنید :
    Dim lChild As Long
    Dim lLast As Long

    Do
    lLast = lChild
    lChild = FindWindowEx(lParent, lChild, "ThunderRT6Textbox", vbNullString)
    Loop While lChild
    سلام
    خسته نباشید
    واقعا از تلاشتون ممنونم

    خوب میتونید از این موضوع یه مثال بزنید؟
    مثلا پیدا کردن هندل ورودی چت یاهو

  34. #74
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    یه تکست بزار و جای strWindowName بنویس text1.text سپس داخل تکسی بنویس :yahoo m....

  35. #75

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

    نقل قول نوشته شده توسط parsiyan_mohsen مشاهده تاپیک
    یه تکست بزار و جای strWindowName بنویس text1.text سپس داخل تکسی بنویس :yahoo m....
    لطفا کمی بیشتر توضیح بدید!

    من تو این مسائل خیلی مبتدی هستم

  36. #76

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

    نقل قول نوشته شده توسط parsiyan_mohsen مشاهده تاپیک
    چگونه می توان هندل ( Handle ) یک Textbox را در یک پنجره بدست آورد ؟
    پاسخ : برای بدست آوردن هندل پنجره برنامه ای که هم اکنون باز است از تابع FindWindow استفاده کنید . نحوه declare کردن آن بصورت زیر است :
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    فرض کنید caption فرم برنامه مورد نظرتان در متغیر strWindowName قرار داشته باشد . با دستور زیر می توانید هندل پنجره آنرا بدست آورید :
    Dim hwndFound As Long
    hwndFound = FindWindow(vbNullString, strWindowName)
    نکته : برای پیدا کردن هندل پنجره برنامه ای که caption آنرا بطور دقیق نمی دانید می توانید از تابع FindWindowLike استفاده کنید .
    حال که هندل پنجره مورد نظرتان را استخراج کردید می توانید با استفاده از تابع FindWindowEx هندل اشیا موجود در آن پنجره را بدست آورید . نحوه declare کردن این تابع بصورت زیر است :
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    این تابع را بصورت زیر استفاده کنید :
    htextbox = FindWindowEx(hwndFound, ByVal 0&, "ThunderRT6TextBox", vbNullString)
    که ThunderRT6Textbox نام کلاس Rich Textbox ها در ویژوال بیسیک 6 است . دستور فوق هندل اولین Textbox موجود در پنجره را به شما بر می گرداند . برای بدست آوردن هندل سایر Textbox ها از حلقه زیر استفاده کنید :
    Dim lChild As Long
    Dim lLast As Long

    Do
    lLast = lChild
    lChild = FindWindowEx(lParent, lChild, "ThunderRT6Textbox", vbNullString)
    Loop While lChild
    ممنونم از راهنمایی هاتون

    لطفا طریقه ی کار با این تابع رو هم یاد بدید (FindWindowLike)
    بسیار ممنونم از زحماتتون

  37. #77
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    دوست عزیز من کاملاً در رابطه باهاش توضیح دادم/...

  38. #78
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    طراحي :
    اين پروژه شامل دو فرم مي باشد كه وظيفه فرم اول دريافت پسورد از كاربر و چك كردن آن با پسورد ذخيره شده در فايل Dll است ، اگر پسوردها يكسان نبودند ، كاربر با پيام I'm Sorry مواجه مي شود و اگر دو پسورد يكسان بودند ، برنامه پس از فرستادن پيام Ok ، فرم دوم را ظاهر مي كند كه در آن كاربر مي تواند پسورد درون فايل Dll را تغيير دهد .
    برنامه نويسي فرم اول :
    در اين فرم از يك شي Text Box و يك شي Command Button استفاده مي كنيم .
    در Command 1 اين قطعه را وارد مي كنيم :
    Private Sub Command1_Click()
    Open "d:\p.dll" For Input As #1
    Input #1, c$
    For i = 1 To Len(c$)
    a = Mid(c$, i, 1)
    r = Asc(a)
    r = r - 70
    d$ = d$ + Chr(r)
    Next
    If d$ = Text1.Text Then
    MsgBox (" Ok Your Password Is Correct ")
    Form2.Show
    Form1.Hide
    Else
    MsgBox (" I'm Sorry , Your Password Is Correct ")
    End If
    Close
    End Sub

    در خط يك برنامه فايل Dll براي خواندن باز مي شود .
    در خط دوم برنامه تمام محتويات فايل Dll در متغير C$ قرار داده مي شود .
    حال با يك حلقه تكرار و استفاده از تابع Mid به تك تك كاراكتر هاي برنامه دسترسي پيدا مي كنيم ، در خطوط بعدي اين كاراكترهاي رشته اي به كد اسكي تبديل شده و از اين كاراكترها 70 عدد كم مي كنيم ( چون در ابتدا 70 تا براي امنيت به كاراكترها اضافه كرده بوديم ) . در آخر حلقه هم ، كدهاي اسكي را به كاراكتر تبديل كرده و در يك متغير رشته اي D$ ذخيره مي كنيم .
    شرط ها هم مطابق بودن يا نا مطابق بودن دو پسورد را چك مي كند .كه اگر يكسان بودند ، پيام Ok را ارسال و فرم دوم را ظاهر مي كند .
    برنامه نويسي فرم دوم :
    ما ، در اين فرم از سه Command button تحت عنوان هاي Change Password ، Sign Out ، Quit و يك Textbox استفاده مي كنيم .
    اصل برنامه ما در دكمه تغيير پسورد است يا Change Password است ، قطعه برنامه زير را در قسمت برنامه نويسي اين Command Button استفاده مي كنيم :
    Private Sub Command1_Click()
    For i = 1 To Len(Text1.Text)
    a = Mid(Text1.Text, i, 1)
    r = Asc(a)
    r = r + 70
    c$ = c$ + Chr(r)
    Next
    Open "d:\p.dll" For Output As #1
    Write #1, c$
    Close
    End Sub

    در اين قطعه كد يك پسورد از ورودي دريافت مي شود و همانطور كه قبلا نيز توضيح داده شد ، پس از اعمال تغييراتي براي حفظ امنيت پسورد در يك فايل Dll ذخيره مي شود .
    قطعه كد كليد Sign Out :
    Private Sub Command2_Click()
    Form1.Show
    Form2.Hide
    End Sub
    قطعه كد كليد Quit :
    Private Sub Command3_Click()
    End
    End Sub

  39. #79
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    چطور ميشه کنترلي نوشت که اگه چند تا از اونها رو توي فرم بندازيم بتونن همديگرو پيدا کنن مثله Raido
    Button
    Dim c As Control
    For Each c In UserControl.Parent.Controls
    If TypeOf c Is UserControl1 Then
    MsgBox c.Name
    ' Put your code here
    End If
    Next

  40. #80
    کاربر دائمی آواتار parsiyan_mohsen
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    شیراز
    پست
    389

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

    ترفــــــــــــــــــــــ ــــــــند :
    اگه موقع اجرای برنامه ها در محیط ویژوال بیسیک برنامه در یک حلقه گیر کرد یا هنگ کرد میتونید با زدن کلید های control + Pause break برنامه رو متوقف کنید.

صفحه 2 از 6 اولاول 1234 ... آخرآخر

برچسب های این تاپیک

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

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