صفحه 3 از 6 اولاول 12345 ... آخرآخر
نمایش نتایج 81 تا 120 از 231

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

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

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

    اموزش ساخت loading... برای شما
    اول یک متغیر درست می کنیم
    Dim i As Integer

    روی فرم کلیک می کنیم
    Private Sub Form_Activate 
    startup.Enabled = True
    End Sub

    بعد دو کلید ctrl+t با هم فشار می هیم
    شما باید این گزینه microsoft windows common controls 6.0 را فعال کنید بعد ok کنید
    و یک ProgressBar1 را به فرم اضافه کنید
    و بعد یه timer درست می کنیم با نام startup
    و بعد در قسمت خصوصیات timer
    enbale=false
    interval =170
    left =6360
    top=5160 قرار میدهیم
    روی timer در فرم دوبار کلیک می کنیم و این کد را وارد می کنیم
    Private Sub STARTRUN_Timer 
    If i = 99 Then
    Unload Me
    STARTup.Enabled = False
    End If
    i = i + 1
    ProgressBar1.Value = ProgressBar1.Value + 1
    End Sub

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

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

    اموزش برنامه نویسی یک Consol توسط API

    ميخوام در مورد درست كردن يه برنامه Console توي ويژوال بيسيك با API توضيح بدم(البته خيلي مختصر).خود ويبي امكان درست كردن Console Application رو نداره.

    درسته كه برنامه هاي Console ي كه توي Windows32 درست ميكنيم ظاهرا خيلي فرقي با برنامه هاي تحت داس ندارن اما در محيط داس قابل اجرا نيستن و فقط توي محيط ويندوز ميشه ازشون استفاده كرد.

    كارهايي كه كلا بايد انجام بديم اينه كه اول يه instance از پنجره ي كنسول درست كنيم و قسمتي از حافظه رو به كنسول مورد نظرمون اختصاص بديم...يه هندل واسه نوشتن،يه هندل واسه خواندن و يه هندل براي دستگيري خطا درست كنيم و عمل خواندن و نوشتن رو توي كنسول انجام بديم.وقتي اعمال خواندن و نوشتن اطلاعات (تبادل اطلاعات متني بين برنامه و كاربر كه تنها كاريه كه يه كنسول ميتونه بكنه!) تموم شد طبيعتا برنامه كنسول ما بايد تموم بشه پس اون رو ميبنديم و حافظه اي كه بش اختصاص داده شده رو آزاد ميكنيم.

    پس براي اولين مرحله تابع AllocConsole رو فراخواني ميكنيم :

    Private Declare Function AllocConsole Lib "kernel32" Alias "AllocConsole" () As Long

    كه آرگوماني هم نداره.
    آخرين مرحله هم آزاد كردن كنسول هست كه از تابع FreeConsole استفاده ميشه :

    Private Declare Function FreeConsole Lib "kernel32" Alias "FreeConsole" () As Long

    حالا براي مثال ما فقط ميخواهيم با لود شدن فرم يك كنسول رو نشون بديم و با كليك كردن روي دكمه اون رو ببنديم قبل از اينکه اين کد رو توی پروژتون وارد کنين بخاطر مشکلاتی که ممکنه پيش بياد و ويژوال بيسيک ناگهانی بسته بشه(اند ضدحال) و هنگ کنه و اينا اگه به جای اينکه واسه اجرای برنامه از ديباگ استفاده کنين ٬ فايل Exe درست کنين و اونو اجرا کنين بهتره:

    Private Declare Function FreeConsole Lib "kernel32" () As Long
    Private Declare Function AllocConsole Lib "kernel32" () As Long

    Private Sub Command1_Click()
    FreeConsole
    End Sub

    Private Sub Form_Load()
    AllocConsole
    End Sub

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

    Private Declare Function GetStdHandle Lib "kernel32" Alias "GetStdHandle" (ByVal nStdHandle As Long) As Long

    اين تابع 1 آرگومان ميگيره كه يكي از اين ها ميتونه باشه :

    STD_ERROR_HANDLE دستگيره براي خطا
    STD_INPUT_HANDLE دستگيره براي خواندن
    STD_OUTPUT_HANDLE دستگيره براي نوشتن

    بعد از ايجاد هندل براي نوشتن توي كنسول از تابع WriteConsole استفاده ميشه:

    Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long

    آرگومان اول همون هندل براي نوشتنه.دومي متني كه ميخواهيم چاپ بشه.بعدي تعداد كاراكتريه كه ميخواهيم چاپ بشه كه ما به طور پيشفرض طول متني كه ميخواهيم چاپ بشه رو ميگذاريم.2 تا آرگومان بعدي رو هم vbNull قرار بدين.

    حالا همون برنامه ي قبلي رو طوري تغيير ميديم كه وقتي پنجره ي كنسول نشون داده شد يك متن چاپ بشه :

    Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
    Private Declare Function AllocConsole Lib "kernel32" () As Long
    Private Declare Function FreeConsole Lib "kernel32" () As Long
    Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
    Private Const STD_ERROR_HANDLE = -12&
    Private Const STD_INPUT_HANDLE = -10&
    Private Const STD_OUTPUT_HANDLE = -11&

    Dim whandle As Long
    Private Sub Command1_Click()
    FreeConsole
    End Sub

    Private Sub Form_Load()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE)
    SendOutPut "This is a w32 console application!"
    End Sub
    Sub SendOutPut(strOutPut As String)
    WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
    End Sub

    توي اين كد من براي نوشتن يه تابع جدا درست كردم.در ضمن به چگونگي ارسال متن به تابع توجه كنين.

    حالا ميريم سراغ خوندن.اول با همون تابع GetSTDHandle و دادن آرگومان STD_INPUT_HANDLEيه هندل واسه خواندن درست ميكنيم.بعد با تابع ReadConsole يه متن رو ميخونيم:

    Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long

    آرگومان اول هندل ايجاد شدس.دومي يه متغير هستش كه متن خونده شده توش قرار ميگيره.سومي حداكثر تعداد كاراكتريه كه ميخواهيم خونده بشه و طبيعتا از طول متغيري كه به عنوان آرگومان دوم به تابع داديم نبايد بيشتر باشه.2 تاي ديگه رو هم vbNull بزارين.

    حالا برنامه رو طوري تغيير ميديم كه توي اون پنجره ي كنسول يه متن رو بخونه.بعد از خوندن متن يه پيغام كه حاوي متن هستش نشون داده بشه:

    Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
    Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
    Private Declare Function AllocConsole Lib "kernel32" () As Long
    Private Declare Function FreeConsole Lib "kernel32" () As Long
    Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
    Private Const STD_ERROR_HANDLE = -12&
    Private Const STD_INPUT_HANDLE = -10&
    Private Const STD_OUTPUT_HANDLE = -11&

    Dim whandle As Long
    Dim rhandle As Long
    Dim Result As String
    Private Sub Form_Load()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE(
    rhandle = GetStdHandle(STD_INPUT_HANDLE(
    SendOutPut "This is a w32 console application! , Enter a text :" & vbCrLf
    Result = GetinPut
    MsgBox Result,vbSystemModal
    FreeConsole
    End Sub
    Sub SendOutPut(strOutPut As String(
    WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
    End Sub
    Function GetinPut() As String
    Dim strInput As String * 256
    ReadConsole rhandle, ByVal strInput, Len(strInput), vbNull, vbNull
    GetinPut = Left(strInput, InStr(strInput,Chr(0)) - 3)
    End Function

    چون ما نميدونيم مقداري كه كاربر وارد ميكنه طولش چقدره يه مقدار پيشفرض در نظر ميگيريم(اينجا 256) كه اين مقدار رو به دلخواه ميتونيم تغيير بديم.
    باز هم به چگونگي ارسال متغير -ي كه متن توش قرار ميگيره- كه به تابع ارسال ميشه توجه كنين.
    البته متني كه خونده ميشه كاراكتر هاي اضافه داره.همونطور كه گفتم چون ما طول رشته اي كه كاربر ميخواد وارد كنه رو نميدونيم يه طول پيشفرض در نظر گرفتيم و رشته رو از يه كاراكتر خاص پر كرديم مثلا از كاراكتر نال (كد اسكي 0) .علاوه بر اين كاراكتر ها 2 تا كاراكتر اضافه ي ديگه هم به آخر وردوي اضافه ميشن.يكي كاراكتر با كد اسكي 13 و بعدي 10 (همون Newline و Return و يا vbCrLf) مثلا اگه اول كار رشته اي كه به تابع داديم مقدارش توي حافظه اين بوده :

    00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00

    و وروديه كاربر متن API بوده باشه رشته بعد از خوندن ميشه:

    65 80 73 13 10 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00

    كه ما با يه Left و ۳InStr تا كاراكتر اول رو جدا ميكنيم.

    حالا با تركيب عمل خوندن و نوشتن يه برنامه مينويسيم كه يكي از سه مقدار C B A رو بگيره و در مقابل مقدار گرفته شده به ترتيب زمان ، تاريخ و يا هر دو رو چاپ كنه.اگه مقدار وارد شده چيزه ديگه اي بود، برنامه بسته بشه.
    در ضمن اينجا ديگه از فرم استفاده نميكنيم چون ميخواهيم برنامه مثل يه Console واقعي بشه.پس فرم رو حذف كنيد و يه Module به پروژه اضافه كنين و كد زير رو توي Module وارد كنين :

    Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
    Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
    Private Declare Function AllocConsole Lib "kernel32" () As Long
    Private Declare Function FreeConsole Lib "kernel32" () As Long
    Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
    Private Const STD_ERROR_HANDLE = -12&
    Private Const STD_INPUT_HANDLE = -10&
    Private Const STD_OUTPUT_HANDLE = -11&

    Dim whandle As Long
    Dim rhandle As Long
    Dim Result As String
    Private Sub Main()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE)
    rhandle = GetStdHandle(STD_INPUT_HANDLE)
    SendOutPut "Press one of the following keys,any other key to exit :" & vbCrLf & _
    "A to get time" & vbCrLf & _
    "B to get date" & vbCrLf & _
    "C to get both" & vbCrLf
    While True
    Result = UCase(GetinPut)
    Select Case Result
    Case "A"
    SendOutPut "Time is " & CStr(Time) & vbCrLf
    Case "B"
    SendOutPut "Date is " & CStr(Date) & vbCrLf
    Case "C"
    SendOutPut "Now is " & CStr(Now) & vbCrLf
    Case Else
    FreeConsole
    End
    End Select
    Wend
    End Sub
    Sub SendOutPut(strOutPut As String)
    WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
    End Sub
    Function GetinPut() As String
    Dim strInput As String * 256
    ReadConsole rhandle, ByVal strInput, Len(strInput), vbNull, vbNull
    GetinPut = Left(strInput, InStr(strInput, Chr(0)) - 3)
    End Function

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

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

    با اين روش مثلا ميتونين برنامه اي كه موس روش هست رو ببندين.واسه اين كار از تابع GetWindowThreadProcessId استفاده ميكنيم تا آيديه Process رو بدست بياريم :

    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

    آرگومان اول هندل مورد نظر هست.دومي هم يك متغير از نوع Long كه تابع آيديه Process رو توش قرار ميده .(مقدار برگشتي هم آيديه Thread هستش كه كاري باش نداريم)
    بعد از بدست آوردن آيديه Process رو بدست آورديم مثل قبل عمل ميكنيم و برنامه مورد نظر رو ميبنديم.
    ميخواهيم برنامه اي بنوسيم كه وقتي روي يك دكمه فشار داده ميشه برنامه اي كه موس روشه بسته بشه.واسه اين كار با تابع هاي GetCursorPos و WindowFromPoint كه قبلا در موردشون گفتم(به آرشيو مراجعه كنين) هندل پنجره اي كه موس روشه رو بدست مياريم و با روشي كه گفتم ميبنديمش :

    Option Explicit
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Type POINTAPI
    x As Long
    y As Long
    End Type
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    Private Sub Command1_Click()
    Dim wHandle As Long, PAPI As POINTAPI, pID As Long, hProcess As Long
    GetCursorPos PAPI
    wHandle = WindowFromPoint(PAPI.x, PAPI.y)
    GetWindowThreadProcessId wHandle, pID
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
    TerminateProcess hProcess, 0
    CloseHandle hProcess
    End Sub

    توي اين كد چون بايد موس روي برنامه اي باشه كه بايد بسته بشه با خود موس نميتونين روي دكمه كليك كنين چون برنامه ي خودتون بسته ميشه!!! Focus رو بهش بدين و با Enter كردن اونو فشار بدين!!!!! :پي

    توي اين پست روش هايي واسه بستن Processبرنامه ها رو گفتم.هدف من از گفتن اين مطلب ها فقط راه بستن Process نبود..با بدست آوردن ProcessID كارهاي زيادي در مورد Process ها و Thread ها و .. ميشه كرد كه اينجا 2 تا روش براي اين كار گفتم

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

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

    حالا بريم سراغ نوشتن تابع كنترل پيغام ها.
    توي محيط اسمبلي يا مثلا C++‎ Visual سيستم كلي كد نويسي و كنترل پيغام ها توسط به تابع (Window Prodedure)هستش و اگه شما توي اين محيط ها بخواهين پيغام هاي فرستاده شده رو كنترل كنين كارتون خيلي راحته چون عملا دارين كد مربوط به كنترل پيغام ها رو ميبينين.اما توي محيط ويژوال بيسيك اين عمليات از برنامه نويس پنهان شده و شما فقط يكسري Event هاي از پيش تعيين شده مثل OnClick يا OnMouseDown يا ... رو ميبينين و دسترسي به پيغام هاي ديگه ندارين.اما حالا بايد چكار كرد؟
    اگه ميخواهين يك بازي درست و حسابي درست كنين بهتره همين الان بيخيال ويبي شين و برين سراغ Visual C++‎. اما براي ويبي هم راه هايي پيدا ميشه :

    يك راهش استفاده از توابع Hook و راه ديگش هم استفاده از تابع SetWindowLong هستش.اينجا من از روش دوم استفاده ميكنم اما صرفا قصد ندارم در مورد كنترل كردن پيغام هاي پنجره توضيح بدم و اين كار رو ميگذارم واسه يه پست ديگه.
    اول با استفاده از تابع SetWindowLong تابع مربوط به كنترل پيغام ها رو كه بايد توي يك ماژول هم باشه مشخص ميكنيم:

    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

    و در همين حين آدرس تابع قبلي رو هم از تابع ميگيريم چون بعد از اينكه كارمون تموم شد ميخوايم وضعيت رو به حالت عادي برگردونيم. بعد يه تابع به صورت زير براي كنترل پيغام ها درست ميكنيم :

    Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

    'Control messages here ...

    End Function

    تابع CallWindowProc رو هم براي اين استفاده ميكنيم كه پيغامي كه فرستاده ميشه رو به تابع كنترل اصلي(قبلي) هم بفرستيم و بعد كار كنترل پيغام هايي كه توسط تابع اصلي قابل كنترل نيستن رو انجام ميديم.

    بعد هم دوباره با تابع SetWindowLong آدرس قبلي رو براي كنترل پيغام ها تعيين ميكنيم :

    SetWindowLong Form1.hwnd, GWL_WNDPROC, PrevProc

    براي مثال كد كلي ما براي كنترل پيغام هايي كه به از جوي استيك(1) براي فشرده شدن دكمه ها ارسال ميشه به اين صورت ميشه :

    توي فرم 2 تا دكمه (يكي براي شروع و يكي براي پايان) بگذارين و اين كد رو وارد كنين :

    Private Sub Command1_Click()
    joySetCapture Form1.hwnd, JOYSTICKID1, 100, False
    start
    End Sub

    Private Sub Command2_Click()
    joyReleaseCapture JOYSTICKID1
    finish
    End Sub

    و توي يك ماژول هم اين رو بگذارين :

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Declare Function joySetCapture Lib "winmm.dll" (ByVal hwnd As Long, ByVal uID As Long, ByVal uPeriod As Long, ByVal bChanged As Long) As Long
    Public Declare Function joyReleaseCapture Lib "winmm.dll" (ByVal id As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Const GWL_WNDPROC = (-4)
    Public Const WM_KEYDOWN = &H100
    Public Const JOY_BUTTON1 = &H1
    Public Const JOY_BUTTON3 = &H4
    Public Const JOY_BUTTON2 = &H2
    Public Const JOY_BUTTON4 = &H8
    Public Const JOY_BUTTON1CHG = &H100
    Public Const JOY_BUTTON2CHG = &H200
    Public Const JOY_BUTTON3CHG = &H400
    Public Const JOY_BUTTON4CHG = &H800
    Public Const JOYSTICKID1 = 0
    Public Const JOYSTICKID2 = 1
    Dim PrevProc As Long
    Public Const MM_JOY1BUTTONDOWN = &H3B5
    Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = MM_JOY1BUTTONDOWN Then
    Form1.Print
    Form1.Print "Joystick(1),Button down event occured : "
    Form1.Print "Button changed : ";
    If wParam And JOY_BUTTON1CHG Then
    Form1.Print "one"
    ElseIf wParam And JOY_BUTTON2CHG Then
    Form1.Print "two"
    ElseIf wParam And JOY_BUTTON3CHG Then
    Form1.Print "three"
    ElseIf wParam And JOY_BUTTON4CHG Then
    Form1.Print "four"
    End If
    Form1.Print "Button(s) are pressed : ";
    If wParam And JOY_BUTTON1 Then Form1.Print "one ";
    If wParam And JOY_BUTTON2 Then Form1.Print "two ";
    If wParam And JOY_BUTTON3 Then Form1.Print "three ";
    If wParam And JOY_BUTTON4 Then Form1.Print "four "
    Form1.Print
    Form1.Print "X : " & Get_LoWord(lParam) & " Y : " & Get_HiWord(lParam)
    End If
    End Function
    Public Sub start()
    PrevProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    End Sub
    Public Sub finish()
    Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, PrevProc)
    End Sub
    Function Get_LoWord(ByRef dword As Long) As Integer
    CopyMemory Get_LoWord, ByVal VarPtr(dword), 2
    End Function
    Public Function Get_HiWord(ByRef dword As Long) As Integer
    CopyMemory Get_HiWord, ByVal VarPtr(dword) + 2, 2
    End Function

    در ضمن 2 تا تابع آخر هم براي بدست آوردن دو بايت بالايي و دوبايت پاييني lParam استفاده ميشن

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

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

    برنامه نویسی APi : كار با Joy Stice با API

    اولين تابعي كه ميخوام در موردش توضيح بدم تابع joyGetNumDevs هستش :

    Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long

    كه تعداد جوي استيك هايي كه درايور ساپورت ميكنه رو برميگردونه.براي من 16 هستش.
    براي بدست آوردن اطلاعات در مورد جوي استيك از تابع joyGetDevCaps استفاده ميشه :

    Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long

    آرگومان اول آيدي جوي استيك هستش كه ميتونه يكي از اين 2 مقدار باشه :

    Private Const JOYSTICKID1 = 0
    Private Const JOYSTICKID2 = 1

    آرگومان دومي متغيري از نوع JOYCAPS هستش كه مشخصات جوي استيك رو تابع درون اين قرار ميده:

    Private Type JOYCAPS
    wMid As Integer
    'مربوط به مايكروسافت ميشه MM_MICROSOFT آيدي توليدي كه جوي استيك رو توليد كرده مثلا
    wPid As Integer
    'آيدي محصول(جوي استيك)
    szPname As String * MAXPNAMELEN
    'اسم جوي استيك
    wXmin As Integer
    wXmax As Integer
    wYmin As Integer
    wYmax As Integer
    wZmin As Integer
    wZmax As Integer
    'x,y,z حداقل و حداكثر مختصات جوي استيك توي جهت هاي مختلف
    wNumButtons As Integer
    'تعداد دكمه هاي جوي استيك
    wPeriodMin As Integer
    wPeriodMax As Integer
    ' (Polling frequency) حداقل و حداكثر تعداد پيغام هايي كه جوي استيك ميتونه توي 1 صدم ثانيه به برنامه ارسال كنه
    End Type

    البته اين ساختار چند تا متغير ديگه هم آخرش داره اما ايني كه من توي API Viewer ديدم نداشت منم ديگه بيخيال بقيش شدم...

    آرگومان بعدي هم طول اين متغير هستش.
    مقدار برگشتي تابع هم نشون ميده كه درست كار كرده يا نه :

    JOYERR_NOERROR 'هيچ خطايي اتفاق نيفتاده
    MMSYSERR_NODRIVER '(:Pدرايور جوي استيك آماده نيست(اشكال از فرستندس
    MMSYSERR_INVALPARAM 'پارامتر هايي كه به تابع ارسال شده مشكل دارن

    بعد از فراخواني تابع بايد برين سراغ متغيري كه به تابع ارسال شده و اطلاعات مورد نظر رو دريافت كنين:

    Option Explicit
    Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
    Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long
    Private Const JOYSTICKID1 = 0
    Private Const JOYSTICKID2 = 1
    Private Const JOYERR_NOERROR = (0) ' no error
    Private Const MMSYSERR_BASE = 0
    Private Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11) ' invalid parameter passed
    Private Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6) ' no device driver present
    Private Const MAXPNAMELEN = 32 ' max product name length (including NULL)


    Private Type JOYCAPS
    wMid As Integer
    wPid As Integer
    szPname As String * MAXPNAMELEN
    wXmin As Integer
    wXmax As Integer
    wYmin As Integer
    wYmax As Integer
    wZmin As Integer
    wZmax As Integer
    wNumButtons As Integer
    wPeriodMin As Integer
    wPeriodMax As Integer
    End Type
    Dim JC As JOYCAPS
    Private Sub Form_Load()
    Me.AutoRedraw = True
    Print "Number of joys supported : " & joyGetNumDevs
    Dim jResult As Long
    jResult = joyGetDevCaps(JOYSTICKID1, JC, Len(JC))
    If (jResult = JOYERR_NOERROR) Then 'succeed
    Print "Product name : " & Left$(JC.szPname, InStr(1, JC.szPname, Chr(0)) - 1)
    Print "Manufacture id : " & JC.wMid
    Print "Number of buttons : " & JC.wNumButtons
    Print "Period max : " & JC.wPeriodMax
    Print "Period min : " & JC.wPeriodMin
    Print "Product id : " & JC.wPid
    Print "X max : " & JC.wXmax
    Print "X min : " & JC.wXmin
    Print "Y max : " & JC.wYmax
    Print "Y min : " & JC.wYmin
    Print "Z max : " & JC.wZmax
    Print "Z min : " & JC.wZmin
    Else
    If (jResult = MMSYSERR_NODRIVER) Then
    Print "Error : Driver is not ready!"
    ElseIf (jResult = MMSYSERR_INVALPARAM) Then
    Print "Error : Invalid parameter(s)"
    Else
    Print "Error : Unknown error"
    End If
    End If
    End Sub

    تابع بعدي joyGetPos هستش كه براي بدست آوردن وضعيت مكان و دكمه هاي جوي استيك بكار ميره :

    Private Declare Function joyGetPos Lib "winmm.dll" Alias "joyGetPos" (ByVal uJoyID As Long, pji As JOYINFO) As Long

    آرگومان اول همون آيدي جوي استيك هستش كه در موردش گفتم.دومي هم يه متغير از نوع JOYINFO هستش كه وضعيت حوي استيك توش قرار ميگيره :

    Private Type JOYINFO
    wXpos As Long
    wYpos As Long
    wZpos As Long
    wButtons As Long
    End Type

    سه تا متغير اولي كه مشخصه.مربوط به طول و عرض و ارتفاع هستن.دومي هم مربوط به وضعيت دكمه هاست :

    JOY_BUTTON1 'دكمه اول فشرده شده
    JOY_BUTTON2 'دكمه ي دوم فشرده شده
    JOY_BUTTON3 'دكمه ي سوم فشرده شده
    JOY_BUTTON4 'دكمه ي چهارم فشرده شده

    مقدار برگشتي هم مثل تابع قبل هستش با اين فرق كه اگه مقدار JOYERR_UNPLUGGED برگشت بشه يعني اينكه جوي استيك به سيستم connect نشده:

    Option Explicit
    Private Type JOYINFO
    wXpos As Long
    wYpos As Long
    wZpos As Long
    wButtons As Long
    End Type
    Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
    Private Const JOYSTICKID1 = 0
    Private Const JOYSTICKID2 = 1
    Private Const JOYERR_NOERROR = (0) ' no error
    Private Const MMSYSERR_BASE = 0
    Private Const MMSYSERR_INVALPARAM = (MMSYSERR_BASE + 11) ' invalid parameter passed
    Private Const MMSYSERR_NODRIVER = (MMSYSERR_BASE + 6) ' no device driver present
    Private Const JOYERR_BASE = 160
    Private Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7) ' joystick is unplugged


    Private Sub Form_Load()
    Dim JI As JOYINFO
    Dim jResult As Long
    Me.AutoRedraw = True
    jResult = joyGetPos(JOYSTICKID1, JI)
    If (jResult = JOYERR_NOERROR) Then
    Print "X : " & JI.wXpos
    Print "Y : " & JI.wYpos
    Print "Z : " & JI.wZpos
    Print "Button : " & JI.wButtons
    Else
    If (jResult = MMSYSERR_NODRIVER) Then
    Print "Error : Driver is not ready!"
    ElseIf (jResult = MMSYSERR_INVALPARAM) Then
    Print "Error : Invalid parameter(s)"
    ElseIf (jResult = JOYERR_UNPLUGGED) Then
    Print "Error : Joystick is not connected!"
    Else
    Print "Error : Unknown error"
    End If
    End If
    End Sub

    تابع بعدي joyGetPosEx هستش كه كار تابع قبلي رو به صورت گستره تري انجام ميده و براي كار كردن با دستگاه هاي پيشرفته مثل دسته هايي كه دكمه زياد دارن يا كلاه ها يا ... بكار ميره.اگه ميخواهين با يه جوي استيك معمولي كار كنين برين سراغ تابع قبلي:

    Private Declare Function joyGetPosEx Lib "winmm.dll" Alias "joyGetPosEx" (ByVal uJoyID As Long, pji As JOYINFOEX) As Long

    آرگومان اول آيدي جوي استيك و دومي هم يه متغير از نوع JOYINFOEX هستش :

    Private Type JOYINFOEX
    dwSize As Long 'طول ساختار كه بايد قبل از ارسال به تابع مقدار دهيش كنين
    dwFlags As Long ' ي كه با مقدار دهي كردنش بايد مشخص كنيم چه اطلاعاتي رو تابع براي ما برگردونهflag
    dwXpos As Long ' xموقيعت
    dwYpos As Long ' y موقيعت
    dwZpos As Long ' z موقيعت
    dwRpos As Long ' بعد ديد چهارم
    dwUpos As Long ' بعد ديد پنجم
    dwVpos As Long ' بعد ديد ششم
    dwButtons As Long ' وضعيت دكمه ها
    dwButtonNumber As Long ' تعداد دكمه هايي كه فشرده شدن
    dwPOV As Long ' زاويه ديد
    dwReserved1 As Long ' رزور شده
    dwReserved2 As Long ' رزرو شده
    End Type

    چيزي كه در مورد اين ساختار بايد توجه كنين Flags هستش كه با دادن مقدار هاي مختلف بايد به تابع گفت كه در چه مورد اطلاعات ميخواهيم كه مقاديري كه بش ميشه داد خيلي زياده و ديگه من بيخيالش ميشم توي MSDN انواع مقدار ها با توضيحاتشون هست...
    كار بااين تابع هم مثل كدي قبلي هستش فقط همونطور كه گفتم بايد قبل از ارسال متغير به تابع مقدار dwSize رو برابر طول متغير قرار بدين :

    JI.dwSize = Len(JI)

    مقدار برگشتي هم مثل قبليه فقط اگه MMSYSERR_BADDEVICEID باشه يعني اينكه آيدي جوي استيك غير قابل قبول هستش... .

    حالا ميريم سراغ اصل كاري يعني capture كردن جوي استيك .

    كلا روش كلي براي اين كه يك جوي استيك رو كنترل كنيم و بفهميم كي حركت ميكنه يا دكمه هاش فشرده ميشه اينه كه با دادن هندل پنجره به تابع joySetCapture پيغام هايي كه به پنجره مياد رو كنترل كنيم.در واقع تابع joySetCapture باعث ميشه هنگام هر گونه رويداد توسط جوي استيك(يا بطور متناوب) يك پيغام به پنجره اي كه هندلش رو به تابع داديم ارسال بشه و با توجه به تابعي كه ما براي كنترل پنجره نوشتيم ميتونيم نوع رويداد و مشخصات رويداد رو مشخص كنيم.اگه قسمت Messages ها ي اين وبلاگ رو نخوندين بد نيست اول اون رو بخونين تا بهتر اين قضيه رو متوجه بشين.
    پيغام هايي كه توسط جوي استيك به پنجره مورد نظر ارسال ميشه :

    MM_JOY1BUTTONDOWN

    اين پيغام وقتي ارسال ميشه كه يكي از دكمه هاي جوي استيك اول فشرده بشه.همونطور كه ميدونين وقتي يه پيغام به يه پنجره ارسال ميشه 2 تا مقدار هم به عنوان wParam و lParam به پنجره ارسال ميشن.در اين حالت مقدار wParam نشون ميده كه وضعيت كدوم يكي از دكمه هاي جوي استيك تغيير كرده :

    JOY_BUTTON1CHG 'دكمه ي اول
    JOY_BUTTON2CHG 'دكمه ي دوم
    JOY_BUTTON3CHG 'دكمه ي سوم
    JOY_BUTTON4CHG 'دكمه ي چهارم

    و كدوم دكمه ها فشرده شدن(2 سري مقدار بصورت تركيبي بكارميرن) :

    JOY_BUTTON1 'دكمه ي اول
    JOY_BUTTON2 'دكمه ي دوم
    JOY_BUTTON3 'دكمه ي سوم
    JOY_BUTTON4 'دكمه ي چهارم

    و توي lParam هم مختصات x و y جوي استيك قرار داره.به اين صورت كه توي دوبايت پاييني مختصات x و توي 2 بايت بالايي y

    MM_JOY1BUTTONUP

    مثل قبلي فقط براي رها شدن دكمه ي جوي استيك اول

    MM_JOY1MOVE

    اين پيغام وقتي ارسال ميشه كه جوي استيك اول حركت كنه
    مقدار wParam دكمه هايي كه فشرده شدن رو نشون ميده :

    JOY_BUTTON1 'دكمه ي اول
    JOY_BUTTON2 'دكمه ي دوم
    JOY_BUTTON3 'دكمه ي سوم
    JOY_BUTTON4 'دكمه ي چهارم

    مقدار lParam مثل قبلي هستش.

    MM_JOY1ZMOVE

    اين پيغام وقتي ارسال ميشه كه جوي استيك توي محور z ها مكانش تغيير كنه.
    مقدار wParam مثل قبلي هستش و توي 2 بايت بالايي lParam هم مختصات z جوي استيك قرار ميگيره.

    MM_JOY2BUTTONDOWN

    مثل قبلي فقط براي جوي استيك دوم

    MM_JOY2BUTTONUP

    مثل قبلي فقط براي جوي استيك دوم

    MM_JOY2MOVE

    مثل قبلي فقط براي جوي استيك دوم

    MM_JOY2ZMOVE

    مثل قبلي فقط براي جوي استيك دوم

    حالا ميريم سراغ خود تابع ها:

    با تابع joySetThreshold ميشه تعيين كرد كه براي فرستادن پيغام به پنجره حداقل مكان جوي استيك چقدر تغيير كنه.يعني ما به با اين تابع به تابع joySetCapture ميگين كه تا وقتي كه جوي استيك اينقدر تغيير مكان نداده پيغام هاي مربوط به حركت (MM_JOY1MOVE, MM_JOY1ZMOVE, MM_JOY2MOVE, or MM_JOY2ZMOVE) رو براي پنجره ي ما نفرسته:

    Private Declare Function joySetThreshold Lib "winmm.dll" Alias "joySetThreshold" (ByVal id As Long, ByVal uThreshold As Long) As Long

    آرگومان اول آيدي جوي استيك و دومي مقدار مورد نظر هستش.مقدار برگشتيش هم مثل تابع joyGetDevCaps هستش

    تابع joyGetThreshold هم مثل قبلي هستش با اين تفاوت كه براي گرفتن مقدار Threshold استفاده ميشه:

    Private Declare Function joyGetThreshold Lib "winmm.dll" Alias "joyGetThreshold" (ByVal id As Long, lpuThreshold As Long) As Long

    حالا ميريم سراغ تابع اصل كاري يعني joySetCapture كه توضيح كليش رو دادم :

    Private Declare Function joySetCapture Lib "winmm.dll" Alias "joySetCapture" (ByVal hwnd As Long, ByVal uID As Long, ByVal uPeriod As Long, ByVal bChanged As Long) As Long

    آرگومان اول هندل پنجره ي مورد نظر هستش.دومي آيدي جوي استيك سومي همون تعدادي هستش كه اول كار با تابع joyGetDevCaps مقدار حداقل و حداكثرش رو بدست آورديم يعني حداقل و حداكثر تعداد پيغام هايي كه جوي استيك ميتونه توي 1 صدم ثانيه به برنامه ارسال كنه (Polling frequency).

    آرگومان آخر هم اگه True باشه تابع پيغام هاي حركتي رو فقط وقتي ارسال ميكنه كه تغيير حركت موس بيشتر از مقدار Threshold ي باشه كه با تابع joySetThreshold تنظيم كرديم.اگه False باشه به طور متناوب و بسته به مقدار Polling frequency تابع به پنجره ي ما پيغام ارسال ميكنه.در واقع اگه مقدار Threshold رو تنظيم كردين اين رو True بگذارين و گر نه False.

    اگه كار تابع موفقيت آميز باشه مقدار برگشتي JOYERR_NOERROR هستش. در غير اين صورت :

    MMSYSERR_NODRIVER 'درايور جوي استيك آماده نيست
    JOYERR_NOCANDO 'يه مشكلي تو كار هستش(اينطور كه مايكروسافت گفته مثلا تايمر ويندوز فراهم نيست
    JOYERR_UNPLUGGED 'نشده Connect جوي استيك به سيسيتم

    اين رو هم بگم كه اگه از قبل تابع joySetCapture رو فراخواني كرده باشين و بخواهين دوباره فراخوانيش كنين تابع كار نميكنه.قبل از فراخواني دوباره بايد تابع joyReleaseCapture رو فراخواني كنين :

    Private Declare Function joyReleaseCapture Lib "winmm.dll" Alias "joyReleaseCapture" (ByVal id As Long) As Long

    در واقع وقتي كه ميخواهين تابع joySetCapture بيخيال پنجره ي شما بشه و ديگه كاري با جوي استيك ندارين و نميخواهين كنترلش كنين اين تابع رو بايد فراخواني كنين.آرگومانش هم همون آيدي جوي استيك هستش.

    حالا بريم سراغ نوشتن تابع كنترل پيغام ها.
    توي محيط اسمبلي يا مثلا C++‎ Visual سيستم كلي كد نويسي و كنترل پيغام ها توسط به تابع (Window Prodedure)هستش و اگه شما توي اين محيط ها بخواهين پيغام هاي فرستاده شده رو كنترل كنين كارتون خيلي راحته چون عملا دارين كد مربوط به كنترل پيغام ها رو ميبينين.اما توي محيط ويژوال بيسيك اين عمليات از برنامه نويس پنهان شده و شما فقط يكسري Event هاي از پيش تعيين شده مثل OnClick يا OnMouseDown يا ... رو ميبينين و دسترسي به پيغام هاي ديگه ندارين.اما حالا بايد چكار كرد؟
    اگه ميخواهين يك بازي درست و حسابي درست كنين بهتره همين الان بيخيال ويبي شين و برين سراغ Visual C++‎. اما براي ويبي هم راه هايي پيدا ميشه :

    يك راهش استفاده از توابع Hook و راه ديگش هم استفاده از تابع SetWindowLong هستش.اينجا من از روش دوم استفاده ميكنم اما صرفا قصد ندارم در مورد كنترل كردن پيغام هاي پنجره توضيح بدم و اين كار رو ميگذارم واسه يه پست ديگه.
    اول با استفاده از تابع SetWindowLong تابع مربوط به كنترل پيغام ها رو كه بايد توي يك ماژول هم باشه مشخص ميكنيم:

    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

    و در همين حين آدرس تابع قبلي رو هم از تابع ميگيريم چون بعد از اينكه كارمون تموم شد ميخوايم وضعيت رو به حالت عادي برگردونيم. بعد يه تابع به صورت زير براي كنترل پيغام ها درست ميكنيم :

    Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

    'Control messages here ...

    End Function

    تابع CallWindowProc رو هم براي اين استفاده ميكنيم كه پيغامي كه فرستاده ميشه رو به تابع كنترل اصلي(قبلي) هم بفرستيم و بعد كار كنترل پيغام هايي كه توسط تابع اصلي قابل كنترل نيستن رو انجام ميديم.

    بعد هم دوباره با تابع SetWindowLong آدرس قبلي رو براي كنترل پيغام ها تعيين ميكنيم :

    SetWindowLong Form1.hwnd, GWL_WNDPROC, PrevProc

    براي مثال كد كلي ما براي كنترل پيغام هايي كه به از جوي استيك(1) براي فشرده شدن دكمه ها ارسال ميشه به اين صورت ميشه :

    توي فرم 2 تا دكمه (يكي براي شروع و يكي براي پايان) بگذارين و اين كد رو وارد كنين :

    Private Sub Command1_Click()
    joySetCapture Form1.hwnd, JOYSTICKID1, 100, False
    start
    End Sub

    Private Sub Command2_Click()
    joyReleaseCapture JOYSTICKID1
    finish
    End Sub

    و توي يك ماژول هم اين رو بگذارين :

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Declare Function joySetCapture Lib "winmm.dll" (ByVal hwnd As Long, ByVal uID As Long, ByVal uPeriod As Long, ByVal bChanged As Long) As Long
    Public Declare Function joyReleaseCapture Lib "winmm.dll" (ByVal id As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Const GWL_WNDPROC = (-4)
    Public Const WM_KEYDOWN = &H100
    Public Const JOY_BUTTON1 = &H1
    Public Const JOY_BUTTON3 = &H4
    Public Const JOY_BUTTON2 = &H2
    Public Const JOY_BUTTON4 = &H8
    Public Const JOY_BUTTON1CHG = &H100
    Public Const JOY_BUTTON2CHG = &H200
    Public Const JOY_BUTTON3CHG = &H400
    Public Const JOY_BUTTON4CHG = &H800
    Public Const JOYSTICKID1 = 0
    Public Const JOYSTICKID2 = 1
    Dim PrevProc As Long
    Public Const MM_JOY1BUTTONDOWN = &H3B5
    Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = MM_JOY1BUTTONDOWN Then
    Form1.Print
    Form1.Print "Joystick(1),Button down event occured : "
    Form1.Print "Button changed : ";
    If wParam And JOY_BUTTON1CHG Then
    Form1.Print "one"
    ElseIf wParam And JOY_BUTTON2CHG Then
    Form1.Print "two"
    ElseIf wParam And JOY_BUTTON3CHG Then
    Form1.Print "three"
    ElseIf wParam And JOY_BUTTON4CHG Then
    Form1.Print "four"
    End If
    Form1.Print "Button(s) are pressed : ";
    If wParam And JOY_BUTTON1 Then Form1.Print "one ";
    If wParam And JOY_BUTTON2 Then Form1.Print "two ";
    If wParam And JOY_BUTTON3 Then Form1.Print "three ";
    If wParam And JOY_BUTTON4 Then Form1.Print "four "
    Form1.Print
    Form1.Print "X : " & Get_LoWord(lParam) & " Y : " & Get_HiWord(lParam)
    End If
    End Function
    Public Sub start()
    PrevProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    End Sub
    Public Sub finish()
    Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, PrevProc)
    End Sub
    Function Get_LoWord(ByRef dword As Long) As Integer
    CopyMemory Get_LoWord, ByVal VarPtr(dword), 2
    End Function
    Public Function Get_HiWord(ByRef dword As Long) As Integer
    CopyMemory Get_HiWord, ByVal VarPtr(dword) + 2, 2
    End Function

    در ضمن 2 تا تابع آخر هم براي بدست آوردن دو بايت بالايي و دوبايت پاييني lParam استفاده ميشن

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

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

    الان میخوام کدی رو بگذارم که باهاش میشه اون Bitmap رو توی یک فایل با فرمت .bmp ذخیره کرد.

    وقتی قبلا تابع BitBlt رو توضیح میدادم روش عکس گرفتن از صفحه ی نمایش(Screen Shot) رو توی ویبی و با استفاده از فرم گفتم.توی اون روش با این تابع اول محتویات صفحه ی نمایش توی فرم کپی میشد و بلافاصله با تابع داخلی ویبی یعنی SavePicture اون عکس توی فایل ذخیره میشد.حالا میخواییم بدون استفاده از اون فرم و درواقع با Bitmap ی که خودمون توی حافظه درست کردیم اون عکس رو بگیریم و save کنیم.یه قسمت از کد مثل پست قبله با این فرق که دیگه ما اصلا با فرم کاری نداریم و با صفحه ی نمایش کار داریم واسه همین بجای اینکه فرم رو بستر قرار بدیم و از HDC ش برای تابع CreateCompatableDC استفاده کنیم ایندفه با تابع CreateDC یک Device Context درست میکنیم و ازش استفاده میکنیم و آخر سر هم Delete ش میکنیم.برای ساختن یک Device Context از صفحه ی نمایش و گرفتن یک هندل از اون کافیه آرگومان اول تابع(Driver Name) رو “DISPLAY” قرار بدین و بقیه رو نال (Byval 0&) . بعد از اون با BitBlt محتویات رو توی Bitmap ی که ساختیم کپی میکنیم و اون رو توی فایل Save میکنیم

    Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
    Private Const BI_bitfields = 3&
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Const FILE_BEGIN = 0
    Private Const FILE_CURRENT = 1
    Private Const DIB_RGB_COLORS = 0 ' color table in RGBs

    Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
    End Type

    Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
    End Type

    Private Type BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
    End Type

    Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(256) As RGBQUAD
    End Type

    Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
    End Type

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
    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 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
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long

    Private Sub Form_Load()
    Dim retval As Long
    retval = ScreenShot
    If (retval) Then
    MsgBox "Error (" & retval & ")"
    Else
    MsgBox "Succeed!", vbInformation
    End If
    Unload Me
    End Sub

    Private Function ScreenShot()
    Dim scrWidth As Long, scrHeight As Long
    Dim hScreenDC As Long, hCmpDC As Long, hBmp As Long
    scrWidth = Screen.Width / 15
    scrHeight = Screen.Height / 15
    hScreenDC = CreateDC("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
    hCmpDC = CreateCompatibleDC(hScreenDC)
    hBmp = CreateCompatibleBitmap(hScreenDC, scrWidth, scrHeight)
    Call SelectObject(hCmpDC, hBmp)
    BitBlt hCmpDC, 0, 0, scrWidth, scrHeight, hScreenDC, 0, 0, SRCCOPY
    Call BitmapToFile(hBmp, hCmpDC, Screen.Height / 15, "d:\mm.bmp")
    DeleteObject (hBmp)
    DeleteDC (hCmpDC)
    DeleteDC (hScreenDC)
    End Function

    Private Function BitmapToFile(hBmp As Long, hCmpDC As Long, nHeight As Long, FileName As String) As Long
    Dim BInfo As BITMAPINFO
    BInfo.bmiHeader.biSize = 40
    If (GetDIBits(hCmpDC, hBmp, 0, nHeight, ByVal 0&, BInfo, DIB_RGB_COLORS) = 0) Then
    BitmapToFile = 1
    Exit Function
    End If
    Dim BBits() As Byte
    ReDim BBits(0 To BInfo.bmiHeader.biSizeImage - 1) As Byte
    If (GetDIBits(hCmpDC, hBmp, 0, nHeight, BBits(0), BInfo, DIB_RGB_COLORS) = 0) Then
    BitmapToFile = 2
    Exit Function
    End If
    Dim BFheader As BITMAPFILEHEADER
    BFheader.bfType = 19778
    BFheader.bfReserved1 = 0
    BFheader.bfReserved2 = 0
    Dim hFile As Long: Dim SA As SECURITY_ATTRIBUTES
    hFile = CreateFile(FileName, GENERIC_WRITE, 0, SA, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
    If (hFile = -1) Then
    BitmapToFile = 3
    Exit Function
    End If
    Dim bWritten As Long
    WriteFile hFile, BFheader, Len(BFheader), bWritten, ByVal 0&
    WriteFile hFile, BInfo.bmiHeader, 40, bWritten, ByVal 0&
    Dim nPalette As Long
    If (BInfo.bmiHeader.biClrUsed) Then
    nPalette = lbinfo.bmiHeader.biClrUsed
    Else
    If (BInfo.bmiHeader.biCompression = BI_bitfields) Then
    nPalette = 3
    Else
    nPalette = IIf(BInfo.bmiHeader.biBitCount <= 8, 2 ^ BInfo.bmiHeader.biBitCount, 0)
    End If
    End If
    If (nPalette) Then
    WriteFile hFile, BInfo.bmiColors(0), nPalette * 4, bWritten, ByVal 0&
    End If
    BFheader.bfOffBits = SetFilePointer(hFile, 0, 0, FILE_CURRENT)
    WriteFile hFile, BBits(0), BInfo.bmiHeader.biSizeImage, bWritten, ByVal 0&
    BFheader.bfSize = SetFilePointer(hFile, 0, 0, FILE_CURRENT)
    Call SetFilePointer(hFile, 0, 0, FILE_BEGIN)
    WriteFile hFile, BFheader.bfType, Len(BFheader.bfType), bWritten, ByVal 0&
    Call ReverseWriteLong(hFile, bWritten, BFheader.bfSize)
    WriteFile hFile, BFheader.bfReserved1, 2, bWritten, ByVal 0&
    WriteFile hFile, BFheader.bfReserved2, 2, bWritten, ByVal 0&
    Call ReverseWriteLong(hFile, bWritten, BFheader.bfOffBits)
    closefile:
    CloseHandle (hFile)
    BitmapToFile = 0
    End Function

    Private Sub ReverseWriteLong(hFile As Long, ByRef bWritten As Long, ByVal DWORD As Long)
    WriteFile hFile, loWord(DWORD), 2, bWritten, ByVal 0&
    WriteFile hFile, hiWord(DWORD), 2, bWritten, ByVal 0&
    End Sub

    Private Function hiWord(ByVal DWORD As Long) As Integer
    Dim hWord As Integer
    Call CopyMemory(hWord, ByVal (VarPtr(DWORD) + 2), 2)
    hiWord = hWord
    End Function

    Private Function loWord(ByVal DWORD As Long) As Integer
    Dim lWord As Integer
    Call CopyMemory(lWord, ByVal (VarPtr(DWORD)), 2)
    loWord = lWord
    End Function

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

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

    برنامه نویسی API : ساخت یک Bitmap در حافظه و كار با آن
    فرض كنين در VB يا مثلا در ++C ميخواهين يكسري عمليات گرافيكي مثل رسم خط ِاشكال مختلف و يا يك عكس و غيره رو انجام بدين و نتيجه رو روي پنجره ي اصلي نشون بدين.ميدونين هر پنجره يه DC يا Device Context داره و با استفاده از هندل اون یعنی hDC ی پنجره ی اصلی میشه روش عملیات گرافیکی رو انجام داد که عملیات همزمان روی پنجره ظاهر میشن.ولی مساله اینه که اگه پنجره رو تکون بدیم و یا پنجره ی دیگه ای روی پنجره مون بیاد محتویات ما تا زمانی که دوباره رسم بشن پاک میشن.توی VB ما واسه رفع این مشکل میتونیم AutoRedraw ی فرممون رو True کنیم ولی در یک برنامه ی Win32 ی معمولی مثل++C یا اسمبلی این طور نیست.در ضمن شاید ما بخواههیم توی VB هم اول کلیه عملیاتمون رو انجام بدیم و بعد روی فرم رسمشون کنیم و یا اصلا چند جا واسه رسم داشته باشیم و هر موقع خواستیم یکدوم رو نشون بدیم.کاری که با استفاده مستقیم از hDC فرم امکان پذیر نیست.
    حالا راه حل چیه؟
    ما میاییم یه بخش از حافظه رو به عنوان جایی که میخواهیم عملیاتمون رو انجام بدیم در نظر میگیریم و هر چیزی میخواهیم توی اون ناحیه انجام میدیم و بعد نتیجه رو روی پنجره نمایش میدیم. تغییراتی که روی حافظه میدیم تا وقتی ما نخواهییم روی پنجره ی اصلی نمایش داده نمیشن.و هربار که مثلا با اومدن یک پنجره روی پنجرمون,محتویاتی که روی پنجره درج شده پاک شدن دوبار تصویر رو روی پنجره رسم میکنیم.در واقع ما از یک واسطه برای رسم روی پنجره استفاده میکنیم تا اطلاعات تصویر رو هیچوقت از دست ندیم.
    خوب! حالا با چه کدی ؟
    ما میخواهیم یک بخش از حافظه رو به عنوان یک Bitmap در نظر بگیریم و عملیات گرافیکی رو روش انجام بدیم.واسه اینکار از تابع CreateCompatibleBitmap استفاده میکنیم و یک Bitmap سازگار با پنجره ی مورد نظرمون درست میکنیم :

    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

    آرگومان اول hDC ی پنجره ایه که میخواهیم رسم نهایی رو روش انجام بدیم.و آرگومان های بعدی هم طول و عرض Bitmap مورد نظرمون هست.در واقع این تابع یک Bitmap با طول و عرض معین برای ما در حافظه درست میکنه و هندلش رو برگشت میده.

    مرحله ی بعدی اینکه که ما باید یکHandle Device Context برای این بیت مپ داشته باشیم تا بتونیم از طریق اون عملیات رسم رو انجام بدیم.واسه ساختن اون از CreateCompatibleDC استفاده میکنیم :

    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

    که آرگومان هم hDC ی پنجره ی مورد نظره.
    حالا باید Bitmap ی که ساختیم رو به hDC ی جدیدمون وصل کنیم.واسه این کار از SelectObject استفاده میکنیم :

    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

    در واقع با این کار هر گونه عملیاتی که روی hDC ی جدید انجام بشه روی Bitmap ما اعمال میشه.یادتون باشه بعد از هر Select کردن, وقتی دیگه نیازی نبود از DeleteObject استفاده میکنیم و ارتباط این 2 تا رو قطع و حافظه رو آزاد میکنیم :

    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

    حالا بعد از Select کردن میتونین هر عملیاتی مانند رسم خط,متن,مستطیل و ... رو روی hDC ی جدید اعمال کنین و نتیجه روی Bitmap ما اعمال میشه.در مورد این رسم ها بعدا توضیح میدم.

    بعد از اون فقط میمونه انتقال مداومBitmap از حافظه روی صفحه ی پنجرمون بعد از هر تغییر توی پنجره.
    توی یک W32 Application توی C++‎ یا ASM این کار رو توی Procedure اصلی و با گرفتن پیغام WM_PAINT باید انجام داد.البته بین 2 تابع BeginPaint و EndPaint :

    Private Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long


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

    Private Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long

    این تابع رو هم بعد از عملیات رسم فراخوانی میکنیم.آرگومان اول هندل پنجره و دومی هم همون متغیری که موقع فراخوانی BeginPaint استفاده کردیم.

    ولی توی ویژوال بیسیک لازم به استفاده از این 2 تابع نیست فقط باید AutoRedraw ی فرم False باشه.
    عملیات انتقال رو توی روال Form_Paint انجام میدیم.در واقع بعد از هر تغییر توی محیط پنجره,روال Form_Paint خود به خود فراخوانی میشه و ما دوباره Bitmap رو از حافظه روی فرم کپی میکنیم تا تغییری توی چیزی که رسم کرده بودیم ایجاد نشه.

    واسه این کار از تابع هایی مثل BitBlt , StrechBlt و TransparetBlt میشه استفاده کرد که ساده ترینشون BitBlt هستش که قبلا در موردش گفتم,برای کپی کردن محتویات یک DC روی یک DC ی دیگست.کاری که الان میخواهیم بکنیم. یعنی محتویات DC ی جدیدمون که به Bitmap ی که ساختیم متصل هست رو توی فرم کپی کنیم.

    این یک کد نمونه که کل کاری که تاحالا در موردش نوشتم رو انجام میده و یک Bitmap خالی 100x100 رو که چون خالیه رنگش مشکیه رو روی فرم رسم میکنه.چون هنوز روش کار با تابع هایی واسه رسم اشکال و ... نگفتم اینجا هم چیزی رسم نمیشه و فقط یک صفحه ی سیاهه:


    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 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
    Private Type PAINTSTRUCT
    hdc As Long
    fErase As Long
    rcPaint As RECT
    fRestore As Long
    fIncUpdate As Long
    rgbReserved(32) As Byte
    End Type

    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

    Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source


    Dim hCmpDC As Long, hBmp As Long


    Private Sub Form_Load()

    hCmpDC = CreateCompatibleDC(Me.hdc)
    hBmp = CreateCompatibleBitmap(Me.hdc, 100, 100)
    Call SelectObject(hCmpDC, hBmp)

    End Sub

    Private Sub Form_Paint()

    Dim ps As PAINTSTRUCT
    If (hCmpDC) Then
    Call BitBlt(Me.hdc, 0, 0, 100, 100, hCmpDC, 0, 0, SRCCOPY)
    End If

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

    DeleteObject (hBmp)
    DeleteDC (hCmpDC)

    End Sub

    البته بهتره بعد از فراخوانی تابع های CreateCompatibleDC/Bitmap چک کنیم که اگه تابع ها با موفقیت کار نکردن برنامه رو متوقف یا مسیرش رو عوض کنیم. این رو از مقدار برگشتی میشه فهمید کافیه یه سر به MSDN بزنین

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

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

    ایا میدانید ...
    تعداد خطوط برنامه نویسی شده در ویندوز 95 تعداد 11.2 میلیون خط بوده است در حالیكه در ویندوز ویستا ، حداقل 50 میلیون خط برنامه وجود دارد. برای تولید ویندوز 95 دقیقا 200 برنامه نویس مشغول به كار بودند و در ویندوز ویستا 2000 برنامه نویس به صورت همزمان مشغول به كار بوده‌اند.

    منبع : مایکروسافت

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

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

    این تابع hDc ی یه پنجره و اشاره گر یه آیکون رو میگیره و اون رو توی پنجره رسم میکنه:

    Private Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

    آرگومان اول hdc ی پنجره مقصد هستش.دومی X نقطه شروع رسم و بعدی Y اون نقطه هستش.بعدی هم اشاره گر آیکون مورد نظره.
    ُخصوصیت AutoRedraw فرم رو True کنین و کد زیر رو وارد کنین:

    Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Sub Form_Load()
    Dim strpath As String, Buffer As String * 255, Cnt As Long
    GetSystemDirectory Buffer, 255
    strpath = Replace(Buffer, Chr(0), "") & "\Shell32.dll"
    '///
    Call DrawIcon(Me.hdc, 0, 0, ExtractIcon(0, ByVal strpath, 20))
    End Sub

    اول با تابع getsystemdirectory محل پوشه سیستم و بعد محل فایل Shell32.dll رو پیدا میکنیم.بعد هم آیکونی که Index ش 20 هست رو روی فرم رسم میکنیم

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

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

    با عرض پوزش اسم تابع بالایی Drawicon است
    --------------------------------------------------------------------------------------------------
    ExtracIcon

    اين تابع يه اشاره گر از آیکونی که توی یه فایل (اغلبا .dll) قرار گرفته بر میگردونه که از با استفاده از این اشاره گر میشه تابع رو روی یه پنجره رسم کرد(و ذخیرش کرد) :

    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

    آرگومان اول رو 0 قرار بدین.دومی آدرس فایل مورد نظره.سومی هم Index آیکونی هستش که توی فایل قرار گرفته.(آیکون هایی که به این صورت توی فایل ها قرار میگیرن دارای یه Index هستن)
    یکسری از ایکون های ویندوز توی فایل [WinDrive]:\Windows\System\Shell32.dll قرار گرفتن
    مثالش رو توی تابع بعد ببینین

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

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

    TextOut
    این تابع واسه چاپ کردن یه متن روی یه پنجره بکار میره:

    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

    آرگومان اول hdc ی پنجره مورد نظره.دومی و سومی هم x و y ی مختصات نقطه ای هستش که مخواهیم متن چاپ بشه و اینجا نقطه 0 و 0 بالا سمت چپ پنجره مورد نظره بعدي هم متن مورد نظره بعدی .تعدد کاراکتری هستش که میخواهیم از متنی که به تابع دادیم از سمت چپ جدا بشه و چاب بشه که معمولا چون میخواهیم همه متن چاپ بشه باید این مقدار برار طول متن باشه.در ضمن متن با فونت و رنگ زمینه پنجره ای که hdc ش رو به تابع دادیم رسم میشه:

    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Private Sub Command1_Click()
    Dim strText As String, Cnt As Long
    strText = "API : Application programming interface... |"
    For Cnt = 0 To 2
    TextOut GetDC(0), 20 * Cnt * 20, Screen.Height / 30, ByVal strText, Len(strText)
    Next
    End Sub

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

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

    این تابع هم کار تابع قبلی رو میکنه با این فرق که متن داخل یه محدوده چهار گوش شکل رسم میشه و میشه مشخص کرد با چه فرمتی(حالتی) این کار انجام بشه:

    Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

    آرگومان های اول و دوم و سوم رو قبلا توضیح دادم.چهارمی هم یه متغیر از نوع rect که محدوده چهار گوش رو مشخص میکنه.پنجمی هم نوع چاپ شده هستش که مقدار هایی مثل این هارو میشه به تابع داد :

    Private Const DT_BOTTOM = &H8 متن در پایین محدوده rect چاپ میشه
    Private Const DT_CENTER = &H1 متن در وسط محدوده rect چاپ میشه
    Private Const DT_LEFT = &H0 متن در سمت چپ محدوده rect چاپ میشه
    Private Const DT_RIGHT = &H2 متن سمت راست محدوده rect چاپ میشه

    به کد زیر توجه کنین:

    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Const DT_CENTER = &H1
    Private Sub Command1_Click()
    Dim strText As String, R As RECT
    R.Bottom = 200
    R.Top = 0
    R.Left = 0
    R.Right = Screen.Width / 15
    strText = "Applicatrion Programming Interface"
    DrawText GetDC(0), ByVal strText, Len(strText), R, &H1
    End Sub

    توی این کد توی محدوده rect نقطه بالا و چپ 0 و 0 قرار داده شده (گوشه سمت چپ پنجره) و قسمت پایین rect 200 و سمت راست اون به اندازه عرض صفحه نمایش قرار داده شده
    و فرمت هم Center (مرکز) قرار داده شده بنابراین وقتی تابع رو فرخوانی میکنیم y ی چیزی که چاپ شده 0 هستش و چون ما فرمت رو مرکز قرار دادیم x متنی که چاپ شده به اندازه نصف عرض صفحه نمایش هستش و وسطش چاپ میشه.

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

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

    یه برنامه مینویسیم که عکس رو از صفحه نمایش بگیره ول اندازه اونو 2 برابر کنه و اونو ذخیره کنه.یه دکمه و یه PictureBox بزارین و خصوصيت autoredraw ش رو true كنين :

    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
    Private Sub Command1_Click()
    Picture1.AutoRedraw = True
    Picture1.Width = Screen.Width * 2
    Picture1.Height = Screen.Height * 2
    Me.Hide
    StretchBlt Picture1.hdc, 0, 0, Screen.Width / 7.5, Screen.Height / 7.5, GetDC(0), 0, 0, Screen.Width / 15, Screen.Height / 15, SRCCOPY
    Me.Show
    SavePicture Picture1.Image, "D:\test.bmp"
    End Sub

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

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

    GetCurrentDirectory

    این تابع آدرس پوشه ای که برنامه جاری توش داره اجرا میشه رو برمیگردونه.یعنی کار App.path رو انجام میده:

    Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectory" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

    روش مقدار دادن آرگومان هاش هم شبیه تابع قبلیه فقط جای اونا عوض شده یعنی آرگومان اول برای تعداد کاراکتر
    اول و آرگومان دوم یه متغییر واسه قرار دادن آدرس توی اون:

    Private Declare Function GetCurrentDirectoryA Lib "kernel32" Alias "GetCurrentDirectory" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

    Private Sub Form_Load()
    Dim buffer As String * 255
    GetCurrentDirectoryA 255,Buffer
    MsgBox "Current Directory : '" & Replace(buffer, Chr(0), "") & "'"
    End Sub

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

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

    GetComputerName

    این تابع نام کامپیوتری که برنامه داره توش اجرا میشه رو برمیگردونه.این اسم رو میتونین توی قسمت
    System Properties (راست کلیک روی My Computer ؛ رفتن به Properties ) توی قسمت Computer Name ببینین.

    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

    آرگومان اول یه متغیر هست که تابع نام مورد نظر رو توی این قرار میده و طولش باید از قبل تعیین شده باشه.آرگومان دوم هم مشخص میکنه که چند کاراکتر اول نام کامپیوتر توی متغیر قرار بگیره.این عدد باید با طور متغیر برابر باشه یا کوچکتر.بهتره جفتشون رو 255 قرار بدین.:

    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

    Private Sub Form_Load()
    Dim buffer As String * 255
    GetComputerName buffer, 255
    MsgBox "Computer name : '" & Replace(buffer, Chr(0), "") & "'"
    End Sub

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

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

    GetForeGroundWindow
    این تابع هندل فرم فعال(که رنگ نوار عنوانش با بقیه فرق داره و معمولا آبیه) رو برمیگردونه:

    Private Declare Function GetForegroundWindow Lib "user32" () As Long

    هیچ مقداری هم نیاز نیست بش بدیم.یه تایمر توی فرم بزارین و Interval ش رو 1 بزارین:

    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Sub Timer1_Timer()
    Me.Caption = GetForegroundWindow()
    End Sub

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

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

    FlashWindow

    این تابع واسه آبی کردن و بعد به رنگ معمولی در آوردن (میشه گفت نور انداختن) عنوان و اسم یه (پنجره)فرم توی TaskBar بکار میره .شاید منظورمو نفهمیده باشین.ازش استفاده کنین تا بفهمین:

    Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

    آرگومان اول هندل پنجره مورد نظر هست.
    آرگومان دوم رو 1 قرار بدین (اگه صفر قرار بدین عمل مورد نظر–اگر در حال انجام باشه- متوقف میشه)
    یه دکمه توی فرم بزارین:

    Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

    Private sub Command1_Click()
    FlashWindow Me.hWnd , 1
    End Sub

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

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

    .BlockInput
    این تابع بعد از فراخوانیش موس و کیبرد رو قفل میکنه یعنی دیگه کلید هایی که میزنین بر پنجره ها اثر نداره و موس رو که تکون میدین کرسرش حرکت نمیکنه:

    Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

    مقداری که میگیره اگه 0 باشه عمل قفل شدن متوقف میشه و اگه 1 باشه موس و کیبرد قفل میشه.اگه با این تابع موس و کیبرد رو قفل کردین یه فکری هم به فکر آزاد کردن موس و کیبرد باشین :
    یه تایمر توی فرم بزارین :

    Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

    Private Sub Form_Load()
    Timer1.Interval = 5000
    BlockInput True
    End Sub
    Private Sub Timer1_Timer()
    BlockInput False
    End Sub

    با این کد عمل قفل شدن 5 ثانیه طول میکشه.

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

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

    Sleep
    این تابع برنامه ای که تابع توش فراخوانی شده رو توی زمانی که بش میدیم متوقف میکنه
    آرگومانی که میگیره زمان مورد نظره که بر حسب میلی ثانیه هستش.
    یه دکمه توی فرم بزارین :

    Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

    Private Sub Command1_Click()
    Sleep 2000 '2000 ms = 2 s
    End Sub

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

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

    .CreateDirectory
    این تابع واسه ساختن Folder بکار میره :

    Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

    آرگومان اول مسر پوشه ای که میخواهیم بسازیم هستش
    دومی هم یه متغییر از نوع SECURITY_ATTRIBUTES که نیازی به مقدار دهی کردنش هم نیست

    Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
    End Type

    برای مثال :

    Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
    Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
    End Type

    Dim SA as SECURITY_ATTRIBUTES
    Private Sub Form_Load()
    Createdirectory "D:\APItest",SA
    End Sub

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

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

    .SetWindowPos
    این تابع واسه تغییر مکان و تغییر اندازه Window ها بکار میره و چند تا کاره دیگه هم میکنه:

    Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

    مقدار اولی که میگیره هندل پنجره هستش.دومی طرز قرار گیفتن پنجره در محور z هستش.مثلا بالاتر از پنجره های دیگه قرار بگیره یا پایین تر و ... .مقدار هایی که این میگیره:

    Private Const HWND_BOTTOM = 1
    Private Const HWND_BROADCAST = &HFFFF&
    Private Const HWND_DESKTOP = 0
    Private Const HWND_NOTOPMOST = -2
    Private Const HWND_TOP = 0
    Private Const HWND_TOPMOST = -1

    هر کدوم از اینارو بزارین ببینین چی میشه . مثلا topmost بالای پنجره های دیگه جتی اونایی که از قبل
    Top بودن قرار میگیره.

    مقدار سومی و چهارم هم x و y مختصات پنجره هستش که نسبت به پنجره parent (مادر) ش هستش به طوری که بالا و سمت چپ پنجره ء مادر نقطه (0 ، 0 ) حساب میشه.مقدار بعدی هم عرض و طول پنجره مورد نظر هستش.
    حالا اگه نخواهیم همه این خصوصیات پنجره رو تغییر بدیم نمیشه مثل ویبی اونا رو مقدار دهی نکنیم.بعضی از مواقع میشه از Byval 0& استفاده کرد اما در مورد این تابع واسه اینکه نخواهیم همه خصوصیاتش رو تغییر بدیم باید آرگومان آخر رو مقدار دهی کنیم.بعضی از مقدار هایی که این میگیره :

    Private Const SWP_NOMOVE = &H2 پنچره تغییر مکان نمیده
    Private Const SWP_NOACTIVATE = &H10 پنجره فعال نمیشه
    Private Const SWP_NOSIZE = &H1 پنجره تغییر اندازه نمیده
    Private Const SWP_NOZORDER = &H4 جای پنجره در محور z عوض نمیشه
    Private Const SWP_NOREDRAW = &H8 پنجره دوباره رسم نمیشه

    یه تایمر و یه دکمه توی فرم بزارین و کد زیر رو وارد کنین:

    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Const SWP_NOSIZE = &H1
    Private Const SWP_NOZORDER = &H4
    Dim x As Integer, y As Integer

    Private Sub Form_Paint()
    Command1.SetFocus
    Timer1.Interval = 100
    End Sub

    Private Sub timer1_timer()
    x = Int(800 * Rnd())
    y = Int(600 * Rnd())
    SetWindowPos Me.hwnd, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER
    End Sub
    Private Sub command1_click()
    Unload Me
    End Sub

    اول focus رو به دکمه میدیم بعد .Interval مربوط به تایمر رو مقدار دهی میکنیم.توی Private Sub timer1_timer هم یه x و y
    به طور تصادفی بدست میاریم توی خط بعد هم با استفاده از تابع مورد نظر پنجره رو حرکت میدیم.
    حالا بعد از اجرا کردن برنامه کلید اینتر رو که بزنین برنامه بسته میشه.

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

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

    SetSystemCursor
    با این تابع میشه کرسر سیستم رو تعیین کرد.این تابع اول یه اشاره گر از کرسر مورد نظر ما میخواد که ما این رو با استفاده از تابع LoadCursorFromFile میگیریم آرگوما دوم رو هم Private Const OCR_NORMAL = 32512 قرار بدین(مقدار های دیگه رو میتونین توی API Viewer ببینین).یه دکمه توی فرم بزارین:

    Private Declare Function SetSystemCursor Lib "user32" Alias "SetSystemCursor" (ByVal hcur As Long, ByVal id As Long) As Long
    Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
    Private Const OCR_NORMAL = 32512

    Private Sub Command1_Click()
    Dim hc as long
    hc = LoadCursorFromFile("D:\c.cur")
    SetSystemCursor hc,32512
    End Sub

    فایلهای با پسوند .cur که با ویژوال بیسیک نصب شدن رو توی شاخه …\COMMON\GRAPHICS\CURSORS پیدا کنین.به امید دیدار.

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

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

    LoadCursorFromFile
    این تابع اشاره گر یه فایل کرسر (.cur) رو به مامیده که ازش میشه توی تابع SetSystemCursor استفاده کرد.مثالش رو توی تابع بعدی ببینین.

    Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long

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

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

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

    Private Const VK_LEFT = &H25

    مربوط به کلید چپ هست.کلیه مقدار ها رو میتونین توی API Viewer پیدا کینین.مقدار برگشتی تابع مشخص میکنه که کلید مور د نظر فشرده شده یا نه .یه دکمه توی فرم بزارین:

    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Const VK_LEFT = &H25

    Private Sub Command1_Click()
    If GetAsyncKeyState(VK_LEFT) Then
    Print "<--"
    End if
    End Sub

    در ضمن اگه شما مقدار &H8000 رو هم توی شرط If بزارین عمل چاپ فقط در صورتی که اجرا میشه که کلید چپ در زمان فشره شدن دکمه فشرده شده باشه نه قبلش.
    البته در حالت اول برای یک بار فشردن دکمه چپ فقط یک بار عمل چاپ با فشردن دکمه انجام میشه.امتحان کنین تا منظورمو بفهمین

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

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

    GetClassName
    این تابع هندل یه پنجره رو میگیره و ClassName ش رو برمیردونه.آرگومان اول هندل پنجره.آرگومان دوم یه متغیر که نام کلاس توش قرار میگیره طول این متغییر باید تعیین شده باشه.سومی هم یه عدد مثل n که وقتی به تابع داده میشه تابع n-1 کاراکتر اول نام کلاس رو داخل متغییر قرار میده.(البته مطمین نستم شایدم n کاراکتر اول رو برگردونه.خودم امتحان کردم n-1 کاراکتر اول رو قرار داد)این عدد رو 255 قرار بدین خیال خودتونو راحت کنین.

    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

    Private Sub Command1_Click()
    Dim ipCName as String * 255
    GetClassname Me.hWnd,ipCName,255
    Msgbox Replace(ipCName,chr(0),"")
    End Sub

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

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

    تابع PlaySound
    این تابع واسه پخش کردن یه فایل با فرمت wav از توی speaker هاست.آرگومان اول آدرس فایل و دومی و سومی باید 1 باشه.یه دکمه توی فرم بزارین و کد زیر رو وارد کنین:

    Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
    Private Sub Command1_Click()
    PlaySound "D:\File.wav",1,1
    End Sub

    که باید به جای D:\File.wav آدرس یه فایل با پسوند wav بزارین.

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

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

    SetForegroundWindow اين تابع هندل يم پنجره رو ميگيره و اونو فعال ميكنه:

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

    با استفاده از تابع GetCursorPos مكان موس رو ميگيريم و با استفاده از از تابع WindowFromPoint بوسيله مختصات هندل رو ميگيريم و به تابع ميديم(يه تايمر توي فرم بزارين):

    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
    Private Type POINTAPI
    x As Long
    y As Long
    End Type
    Dim PAPI As POINTAPI,phWnd as long

    Private Sub Form_Load()
    Timer1.Interval = 100
    End Sub

    Private Sub Timer1_Timer()
    GetCursorPos PAPI
    phWnd = WindowFromPoint(PAPI.x, PAPI.y)
    SetForeGroundWindow phWnd
    End Sub

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

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

    GetSystemDirectory
    اين تابع براي گرفتن آدرس پوشه سيستم بكار ميره مثلا در ويندوز 98 اگه ويندوز در درايو C نصب شده باشه محل اغلبا"
    C:\Windows\System هست.
    اين تابع به اين صورته:

    Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

    مقدار اول يه متغير از نوع String هست كه بايد به تابع بديم تا مسير رو توي اون قرار بده.و دومي رو 255 قرار بدين.اين مقدار
    نشون ميده كه تابع حداكثر چند كاراكتر اول مسير رو برگردونه.چون طول اين مسير به ندرت 255 ميشه ما اين عدد رو بش ميديم.يه نكته رو توجه كنين كه اين تابع مقدار 255 كاراكتر(كه خودمون مشخص كرديم) رو داخل متغييري كه بش داديم قرار ميده كه كاراكتر هاي اول رو مسير پوشه سيستم و بقيه رو با كاراكتر 0 پر ميكنه.بنابراين ما بايد طور متغير كه در عادي 0 هست رو به 255 تغيير بديم و گرنه چون تابع ميخواد مقدار رو درون تابع جا بده و تابع جا نداره(طولش 0 هستش) اشكال ايجاد ميشه و برنامه ما بسته ميشه.همن اين ها به اين علت هستش كه تابع طول متغير ما رو تغيير نميده(ولي در خود ويبي اگر يه مقداري رو به يه متغير از نوع String بديم طول متغيير خودكار اضافه ميشه.)
    براي اينكه ما طول متغير رو براي اين تابع به مقدار 255 كاراكتر تغيير بديم 2 كار ميتونيم بكنيم.يكي از اين روشه:
    Dim sysPath as string * 255
    توي اين روش طول متغير با استفاده از 255 كاراكتر تغيير ميكنه.(با استفاده از كاراكتر 0‌)
    يا اينكه يه مقدار با طول 255 به متغيير ميديم:

    Dim sysPath as String
    sysPath = String(255," ")

    حالا تابع رو فراخواني ميكنيم:

    Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Sub Form_Load()
    Dim sysPath as String * 255
    GetSystemDirectory sysPath,255
    Msgbox Replace(sysPath,chr(0),"")
    End Sub

    در خط يكي مونده به آخر با استفاده از تابع Replace مقدار كاراكتر 0 اضافي كه با تابع داده شده حذف ميشه.

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

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

    GetWindowsDirectory
    اين تابع مسير پوشه ويندوز رو برميگردونه و روش كار باش مشابه قبلي هست :

    Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Sub Form_Load()
    Dim winPath as String * 255
    GetWindowsDirectory winPath,255
    Msgbox Replace(winPath,chr(0),"")
    End Sub

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

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

    GetTempPath
    اين تابع هم مسير پوشه Temp رو به ما ميده و يه فرق كوچيك با قبليه داره . جاي آرگومان هاش عوض شده:

    Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nSize As Long,ByVal pBuffer As String) As Long
    Private Sub Form_Load()
    Dim tmpPath as String * 255
    GetTempPath 255,tmpPath
    Msgbox Replace(tmpPath,chr(0),"")
    End Sub

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

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

    GetBkColor : اين تابع BackColor يا رنگ زمينه پنجره اي كه hDC ش رو بش داديم برميگردونه:

    Private Declare Function GetBkColor Lib "gdi32" Alias "GetBkColor" (ByVal hdc As Long) As Long

    براي مثال Hdc فرم خودمون رو بش ميديم و مقدار بازگشتيشو با BACKcOLOR فرممون مقايسه ميكنيم(1 دكمه توي فرم بزارين):

    Private Declare Function GetBkColor Lib "gdi32" Alias "GetBkColor" (ByVal hdc As Long) As Long
    Private Sub Form_Load()
    Me.BackColor=VbBlue
    End sub
    Private Sub Command1_Click()
    Dim BKcolor as Long
    BKcolor = GetBkColor(Me.hdc)
    If BKcolor = Me.BackColor Then
    Msgbox "Good!",vbinformation
    Else
    Msgbox "Wrong!!",vbCritical
    End If
    End Sub

    توجه كنين كه من در Private Sub Form_Load() رنگ زمينه فرم رو از حالت پيشفرض خارج كردم و يه رنگ معمولي بش دادم اين به اين دليل بود كه فرم در حالت پيشفرض داراي رنگ زمينه VbFaceButton (يه رنگ سيستمي) هست و براي همين هم خصوصيت Me.BackColor بجاي اينكه رنگ زمينه واقعي رو برگردونه يه چيز ديگه برميگردونه.

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

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

    AnimateWindow
    اين تابع رو بايد در حالتي كه يه پنجره هنوز رسم نشده(يا Hide هست و ...) و يا قبل از پنهان شدن هست بايد فراخواني كرد
    بعد از فراخواني تابع پنجره در حالتهاي مختلف به صورت انيميت رسم ميشه يا پنهان ميشه.مثلا از سمت چپ طولش افزايش پيدا ميكنه تا كاملا رسم بشه.اين تابع توي API Viewer نيست:

    Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean

    ثابت هاي مورد نياز:

    Const AW_HOR_POSITIVE = &H1
    Const AW_HOR_NEGATIVE = &H2
    Const AW_VER_POSITIVE = &H4
    Const AW_VER_NEGATIVE = &H8
    Const AW_CENTER = &H10
    Const AW_HIDE = &H10000
    Const AW_ACTIVATE = &H20000
    Const AW_SLIDE = &H40000
    Const AW_BLEND = &H80000

    اين تابع 3 تا مقدار به صورت byVal ميگيره.اول هندل پنجره مورد نظر.دومي زماني كه ميخواهيم عمل رسم انجام بشه سومي هم روش رسم هست كه بايد ثابت ها را به اين بديم.بعضي از مقادير (آخر) رو ميشه از طريق Or با هم استفاده كرد.
    موقتي كه ميخواهيم يك پنجره از حالت رسم شده به حالت پنهان بره بايد مقدار AW_HIDE رو هم به پارامتر آخر (با استفاده از Or) اضافه كنيد.كارهايي كه اين ثابت ها ميكنن:

    AW_HOR_POSITIVE پنجره از چپ به راست رسم يا پاك ميشه
    AW_HOR_POSITIVE پنجره از راست به چپ رسم يا پاك ميشه
    AW_VER_POSITIVE پنجره از بالا به پايين رسم يا پاك ميشه
    AW_VER_NEGATIVE پنجره از پايين به بالا رسم يا پاك ميشه
    AW_CENTER پنجره از مركز باز ميشه يا بالعكس
    AW_ACTIVATE پنجره رو فعال ميكنه

    بقيه رو هم درست نفهميدم شما هم امتحان كنين.
    يه مثال ميزنم.2 تا دكمه داخل فرم درست كنين و كد زير رو وارد كنين:

    Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
    Const AW_HOR_POSITIVE = &H1
    Const AW_HOR_NEGATIVE = &H2
    Const AW_VER_POSITIVE = &H4
    Const AW_VER_NEGATIVE = &H8
    Const AW_CENTER = &H10
    Const AW_HIDE = &H10000
    Const AW_ACTIVATE = &H20000
    Const AW_SLIDE = &H40000
    Const AW_BLEND = &H80000
    Private Sub Form_Load()
    Me.BackColor = vbBlue
    AnimateWindow Me.hwnd, 1000, AW_HOR_POSITIVE Or AW_VER_NEGATIVE
    Me.Cls
    End Sub
    Private Sub Command1_Click()
    If Command2.Visible = True Then
    AnimateWindow Command2.hwnd, 1000, AW_CENTER Or AW_HIDE: Command2.Visible = False
    Else
    AnimateWindow Command2.hwnd, 1000, AW_CENTER: Command2.Visible = True
    End If
    End Sub

    براي اينكه بعد از رسم تغيير رنگ هاي(احتمالي) ايجاد شده از بين بره(صفحه پاك بشه) از Me.Cls استفاده كردم.
    اين رو هم بگم كه در زماني كه تابع داره كارشو ميكنه برنامه كار ديگه اي نميتونه بكنه.در ضمن رنگ زمينه رو عوض كردم تا تغيير اندازه دكمه مشخص بشه.ديگه فكر نكنم توضيحي بخواد.

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

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

    اموزش روش های Shut Down

    براي Shut Down كردن سيستم از تابعExitWindowEx استفاده ميشه :

    Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

    پارامتر اول يكي از مقدار هاي زير ميتونه باشه :

    Const EWX_LOGOFF = 0
    Const EWX_SHUTDOWN = 1
    Const EWX_REBOOT = 2
    Const EWX_FORCE = 4

    همش به غير از آخري واضحه.آخري با هر كدوم از بقيه كه تركيب بشه (با Or ) موجب ميشه كه ويندوز برنامه ها رو مجبور به بستن كنه.پارامتر دوم رو هم VbNullString قرار بدين
    .مثال :

    Private Sub Command1_Click()
    ExitWindowsEx EWX_SHUTDOWN or EWX_FORCE, VbNULLString
    End Sub

    توي ويندوز XP اين روش كار نميكنه.براي شات دانون كردن ويندوز بايد از فايل ShutDown.Exe كه توي دايركتوري سيستم هست استفاده كرد.اين فايل واسه Shut Down كردن چند تا پارامتر ميتونه بگيره كه يكيش رو حتما بايد بش بدين :

    -I

    يه واسط كاربري نشون ميده كه توي اون كاربر Options ها رو مشخص ميكنه و بعد OK ميكنه تا سيستم خاموش بشه و اگه اين رو استفاده كردين ديگه نياز به پارامتر ديكه اي نيست .البته اين پارامتر اصلا به كار ما نمياد.ما ميخواهيم به طور اتوماتيك سيستم رو Shut Down كنيم.

    -l

    سيستم Logoff ميشه

    -s

    سيستم Shutdown ميشه.(توي قسمت هاي قبلي هرجا گفتم Shut Down منظورم Restart , Shutdown , Logoff بود)

    -r

    سيستم Restart ميشه.

    -a

    اگه سيستم در حال Shut Down شدن باشه ،اين كار لغو (abort)ميشه.

    -t [Seconds]

    اين براي زمان بكار ميره.يعني اينكه اگه از اين پارامتر استفاده كنين بايد بعدش يه عدد كه معرف ثانيه هستش بنويسين كه اگه اين كارو بكنين يه پنجره مثل اين نشون داده ميشه و سيستم بعد از زماني كه شما تعيين كردين Shut Down ميشه:

    -c "[This is a comment] "

    اگه از پارامتر t استفاده كرده باشين با اين پارامتر (c) ميتونين توي قسمت Message يه پيغام براي كاربر نشون بدين مثل ايني كه من گذاشتم (This is a comment) در ضمن طول اين پيغام حداكثر بايد 127 كاراكتر باشه.


    -f

    مثل مقدار EWX_FORCE توي تابع ExitWindowsEx عمل ميكنه يعني اگه ازش استفاده كنين ويندوز برنامه ها رو مجبور به بستن ميكنه.
    حالا ما براي Shut Down كردن بايد اين فايل رو با پارامتر ها باز كنيم.از تابع Shell استفاده ميكنيم :
    2 تا دكمه يكي cmdShutDown و يكي ديگه cmdAbort درست كنين :

    Private Sub cmdShutDown_Click()
    Shell "Shutdown.exe -r –t 30 –f –c " & """" & "This is a comment" & """"
    End Sub
    Private Sub cmdAbort_Click()
    Shell "Shutdown.exe –a"
    End Sub

    وقتي دكمه cmdShutDown رو بزنين يه پنجره مثل پنجره اي كه عكسش رو گذاشتم ظاهر ميشه و شمارش معكوس از 30 شروع ميشه.اگه به 30 برسه ويندوز رستارت ميشه.اگه دكمه cmdAbort رو بزنين پنجره ي Shut Down بسته ميشه.
    حالا يه كد واسه رستارت در همون لحظه :

    Private Sub cmdShutDown_Click()
    If MsgBox("Are you sure? ",VbCritical + VbYesNo) = VbYes Then
    Shell "ShutDown.exe –r –f –t 0"
    End If
    End Sub

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

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

    SendKeys يك يا چند كاركتر يا دكمه هاي كيبرد رو به پنجره ي فعال ارسال ميكنه درست مثل اينكه دكمه هاي كيبرد فشار داده شده باشن.2 تا آرگومان ميگيره كه دومي اختياريه.آرگومان اولي كاراكتر هايي هستن كه ميخواهيم ارسال كنيم مثلا “vb” .واسه دكمه هاي خاص كيبرد مثل HOME ها DELETE و ... بايد اون ها رو توي آكلاد قرار بدين مثلا :
    براي insert از “{INSERT}” يا “{INS}” استفاده ميشه.
    براي end از “{END}” استفاده ميشه.
    براي delete از “{DELETE}” يا “{DEL}” استفاده ميشه.
    براي page down از “{PGDN}” استفاده ميشه.
    براي page up از “{PGUP}” استفاده ميشه.
    براي home از “{HOME}” استفاده ميشه.
    براي علامت چپ از “{LEFT}” استفاده ميشه.
    براي علامت بالا از “{UP}” استفاده ميشه.
    براي علامت راست از “{RIGHT}” استفاده ميشه.
    براي علامت پايين از “{DOWN}” استفاده ميشه.
    براي print screen از “{PRTSC}” استفاده ميشه.
    براي scroll lock از “{SCROLLLOCK}” استفاده ميشه.
    براي break از “{BREAK}” استفاده ميشه.
    براي back space از “{BACKSPACE}” يا“{BS}” يا “{BKSP}” استفاده ميشه.
    براي enter از “{ENTER}” يا "~" (بدون آكلاد) استفاده ميشه.
    براي F1 ، F2 و... هم از “{F1}” ، “{F2}” و ... استفاده ميشه.
    براي escape از “{ESC}” استفاده ميشه.
    براي tab از “{TAB}” استفاده ميشه.
    براي caps lock از “CAPSLOCK” استفاده ميشه.

    واسه نگه داشتنه شدن كليد هاي Control و Alt و Shift به ترتيب از ^ ، % ، + استفاده كنين.مثلا براي كنترل بعلاوه ي v از “^v” استفاده كنين.اگه ميخواهين يكي ازين دكمه ها واسه مجموعه اي از كليد ها مورد استفاده قرار بگيره از پرانتز استفاده كنين مثلا براي كنترل بعلاوه ي vb از “^(vb)” استفاده كنين.براي استفاده همزمان از چند تا ازين كليد ها هم اون ها رو پشت سر هم استفاده كنين مثلا براي شيفت بعلاوه ي كنترل بعلاوه v از “+^v” استفاده كنين.اين كار رو براي دكمه هاي HOME و INSERT و ... هم ميتونين بكنين.مثلا كنترل بعلاوه يHOME ميشه “^{HOME}” .

    آرگومان دوم از نوع Boolean هستش كه بطور پيشفرض False هستش.اگه True باشه وقتي كه كليدي به يك پنجره ارسال ميشه تابع منتظر ميشه تا اون پنجره عمليات فشرده شدن كليد رو براي خودش پردازش كنه بعد كنترل به تابع برميگرده.

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

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

    FormatDateTime اين تابع واسه تغيير فرمت زمان و تاريخ به كار ميره.آرگومان اول تاريخ يا زمان مورد نظره .دومي هم فرمت مورد نظر.مقدار بازگشتي با توجه به نوع فرمت و نوع مقداري كه بش داديم فرق ميكنه :

    FormatDateTime(Now(), vbGeneralDate) = 10/5/2005 10:49:07 PM

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

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

    برخي اپراتور هاي Visual Basic

    Type Of اپراتور

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

    TypeOf ControlName Is ControlType

    مثال:كنترلي از نوع فايل بوكس رابه تايع زير مي فرستيم يراي تعيين عضو انتخاب شده

    Private Function GetSelectItem(LST as Contol) as String
    if TypeOf lst is listbox then
    GetselectItem=Lst.text:Exit Function
    else :GetselectItem=Lst.FileName:Exit Sub
    End if

    در خط يك تابع با آرگومان يك ليست از نوع كنترل تعريف مي شود خروجي تايپ آف به صورت يك منو مانند تعريف متغيير هنگام كد نويسي ظاهر مي شود كه شما مي توانيد نو ع كنترل خود را از داخل آن انتخاب كنيد.توجه كنيد بين تايپ و آف نبايد فاصله بيفتد واگر نه با خطاي كامپايل مواجه مي شويد.

    DoEvents اپراتور

    اين اپراتور براي ارجاع تمام عملييات به سي پي يو براي انجام مي باشد.اكثرآ از اين اپراتور براي مواقعي استفاده مي گردد كه يك عمليات وقتگير در حال انجام است مانند اعمال افكت روي تصوير و حلقه هاي تكرار طولاني. اين اپراتور در درون حلقه قرار گرفته و كامپايل نمي شود مانند رهنمود ها در پاسكال عمل مي كندوبه سي پي يو مي گويد تمام كارهيت را به صورت يكسان انجام بده واز اولويت ها صرف نظر كن .در برنامه هايي كه يك عمليات در درون يك حلقه هر دور انجام مي شود آكثرآ باعث هنك كردن آن برنامه تا پايان عمليات مي شود.چون برنامه بين واكنش به تكان خوردن موس -جابه جاكردن برنامه يا بزرگ و كوچك كردن برنامه وپردازش روي عمليات مورد نظر(مثلآ كپي فايل)عمليياتي كه داراي اولويت پردازش است را انتخاب مي كند.اين اپراتور در چنين مواقعي بسيار مفيد است وباعث مي شود كاربر گمان نكند كه برنامه هنك كرده و آن را ببندد.مثال:ِ

    For i=0 to list1.listCount -1
    if list1.list(i)<>"" then call Copy(list1.list(i),App.path+"\")
    DoEvents
    Next

    در خط اول حلقه اي از صفر تا تعداد اعناصر موجود در ليست اغازمي شودو در هر درو فايل درون ليست در صورت وجود كپي مي شود .اگر فايل هاي مازياد باشد DoEventsو اپراتور را ننويسيم حتمآ برنامه ما هنك مي كند.بايد ياد آور شد استفاده نابجا و بيش از اندازه اين اپراتور موجب كاهش سرعت برنامه مي شود.ِالبته

    استفاده مي كنندSleepبه نام APIباعث كاركرد زياد وشديد سي پي يو مي شود وبرخي ترجيح مي دهند از آن استفاده نكنند ويه جاي ان از يك

    فرق مي كند. اسليپ باعث ميشود سي پي يو تمام كار هاي در حال اجرا را رها كند وبه مدت زماني كه جلويDoEventsبايد گفت كاركرد اسليپ به طور كلي با

    آن نوشته مي شود به استراحت بپردازد.ِ

    sleep با توجه به زماني كه براش تعيين ميكني در وسط كار برنامه مكث ايجاد ميكنه و در آن زمان هيچ خطي از كد برنامه اجرا نميشه و همان طور كه از اسم تابع .مشخصه برنامه در آن زمان به خواب ميره
    اسليپ زماني كه با محيط خارج از برنامه در ارتباطي خيلي مفيده. چون معمولا وقتي دستوري در وي بي مثل اجراي فلان فايل مدتي طول مي كشد و تو اين مدت دستورات بعدي سريع اجرا مي شوند كه ممكن است نتيجه اش به اجاي فايل بستگي داشته با شه.اسليپ باعث ميشه به ويندوز فرصت بدي ساير دستورات فرستاده شده به خارج برنامه رو اجرا كنه. البته گاهي اوقات هم نميدونيم چند ثانيه مكث كنيم و ممكنه مجبور شيم براي احتياط زمان زيادي مكث كنيم كه سرعت برنامه مياد پايين پس تا مي تونيم از دستورات خود وي بي استفاده كنيم تا بر نامه هاي خارجي.ِ

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

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

    فرمت فایل M3U
    چگونه یک فایل PlayList با پسوند M3U بسازیم

    گاهي وقتي عده ي زيادي فايل را در مدیا پلير يا وينمپ باز مي كنيم يك گزينه به نام SavePlaylist
    مي بينيم كه براي ذخيره كردن آن ليست در يك فايل استفاده مي شود.اگر يك برنامه ي پخش صوت يا تصوير باكنترل مديا پلير نيز بنويسيد براي پخش هم زمان چندين فايل به مشكل برخواهيد خورد .درچنين مواقعي مي توانيم با ذخيره ليست در يك فايل ام تري يو وباز كردن آن در كنترل مديا پلير چندين فايل را با هم پخش كرد .شايد شما بتوانيد فايل هايتان را مستقيمآ به ليست مديا پلير احتياج به دانستن فرمت فايل ام تري يو داريدPlayListاضافه كنيد ولي باز هم براي ذخيره

    با اين تابع اين كار را انجام دهيد

    Public Sub SaveList(OutPath As String,Lst as ListBox)
    On Error Resume Next '--------------------------------------------------
    Dim T3 As String, T2, strans As String, L As Single, i As Integer
    T3 = "": T2 = ""
    If Lst.List(1) = "" Then
    strans = MsgBox("File Not Found!", vbCritical)
    Exit Sub '------------------------------------------------------
    End If
    If UCase(Right(OutPath, 3)) <> "M3U" Then Exit Sub
    Open OutPath For Output As #1
    Print #1, "#EXTM3U:"
    For i = 1 To Lst.ListCount '----------------------------
    Print #1, "#EXTNIF:"
    Print #1, Lst.List(i)
    Next i '------------------------------------------------------
    Close #1
    End Sub

    حال براي زخيره كردن فايل هاي صوتي و تصويري موجود در يك ليست تنها به دستور زير نياز داريد

    SaveList "C:\1.M3U",List1

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

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

    كتابخانه وسيع Shell

    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal_ lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal_ nShowCmd As Long) As Long

    كد هاي زير را هر جا استفاده كنيد جواب مي دهدالبته بهد از اينكه كد بالا را در اولين خط فرم نوشتيد

    Shell "arp"
    Shell "drvspace"
    Shell "drwatson"
    Shell "explorer"براي my document
    Shell "freecell"
    Shell "ftp"براي تنظيم اف تي پي
    Shell "ipconfig"كادر آي پي
    Shell "mplayer"مديا پلير
    Shell "mshearts"
    Shell "nbtstat"
    Shell "netstat"
    Shell "calc"ماشين حساب
    Shell "notepad"نوت پد
    Shell "packager"
    Shell "pbrush"نقاشي
    Shell "ping"
    Shell "regedit"ريجيستري
    Shell "route"روت
    Shell "scandskw"اسكن ديسك
    Shell "scanregw"اسكن رگ
    Shell "setdebug"كخك تري تنظيم ويندوز
    Shell "sigverif"
    Shell "cdplayer"سي دي پلير
    Shell "sndrec32"ضبط صدا
    Shell "sndvol32"تنظيم ولوم صدا
    Shell "sol"همون سول
    Shell "taskman"وضعيت سي پي يو
    Shell "telnet"تلفن
    Shell "vcmui"
    Shell "winfile"
    Shell "winipcfg"
    Shell "winmine"
    Shell "winrep"
    Shell "charmap"كاراكتر مپ
    Shell "winver"
    Shell "write"وورد پد
    Shell "wscript"
    Shell "cleanmgr"كلنر پاك كننده اشغال درايو
    Shell "control"كنترل پنل
    Shell "cvt1"
    Shell "defrag"دفراگمنت
    Shell "drvspace" فضاي خالي ديسك

    اجراي فايل اينترنت با Shell
    shell "Explorer.exe"+" http://www.parsiyanpc.iranblog.com.comن به يك سايت
    shell "explorer.exe"+" maileto:parsiyan-pc@yahoo.com"كادر ارسال ايميل
    shell "explorer.exe"+" yor HTML File.html"كادر اجراي يك فايل اينترنت از حافظه
    shell "explorer.exe"+" file://www.سايت شما.com/11.zip"كادردانلود يك فايل از اينترنت

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

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

    تنظيم ابعاد نمايش ويندوز براي يك برنامه اختصاصي

    برنامه هاي سه بعدي از فضا نمي آيند توسط همين وي بي -دلفي واكثرآ سي پلاس پلاس طراحي مي شن وقتي يك بازي سه بعدي روباز مي كنيم ويك دفعه يك صفحه با گرافيكي كه تا حالا نديديم يه صورت زيبا بالا مي آد اكثر ما -بيشتر خودم- خيلي كف ميكنيم كه اين برنامه ها چطور ساخته مي شن-با چي ساخته مي شن

    امروز مي خوام تنظيم ابعاد صفحه نمايش ويندوز رو با ابعاد دلخواه خودمون بگم كه گام اول طراحي سه بعديه اگه بشه شايد مراحل بعديش رو هم بزارم روي سايت كه مونده به ياري شما .بانظراتتون و خدا با توفيقش

    ابتدا متغيير هاي اول فرم

    Dim Dx As New DirectX7
    Dim Dd As DirectDraw4
    Dim clip As DirectDrawClipper

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

    تا كد هاتون اجرا بشه روي فرم دابل كلاك كنيد و كد زير رو بنويسيد

    Set Dd = Dx.DirectDraw4Create("")
    Set clip = Dd.CreateClipper(0)
    clip.SetHWnd Me.hWnd
    ' screen mode
    Dd.SetDisplayMode 800, 600, 32, 0, DDSDM_DEFAULT

    بااين كد صفحه نمايش به مد 800*600و حالت 32بايتي ميره

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

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

    كلاس چيست؟؟؟؟

    كلاس يك مجموعه اي از كدهاست كه شبيه به يك كنترل هستند فقط شكل ظاهري و طراحي ندارند
    كلاس ها شي هستند - يعني خاصيت دارند -كلاس ها مي توانند داخل خود پردازه يا تابع محلي وسراسري داشته باشند
    كلاس به چه دردي مي خورد-كلاسها از تكرار كدها جلو گيري مي كنند -كلاس ها خوانايي برنامه را افزايش مي دهندوغيره
    كلاس ها مي توانند به صورت خودكار خود را مقدار دهي كنند-يك ماژول كلاس ايجاد كنيد وكدهاي زير را در آن كپي كنيد

    تعريف يك خاصيت در كلاس

    '-----------Set Property Information---------

    Public Poperty Let CWidth( Value As Integer)
    CWidth=Value
    End Property

    '------------Get Property Information--------------

    Public Property Get CWidth() As Integer
    CWidth=CForm.Width
    End Property

    دستور اول خاصيت را مقدار دهي مي كند با مقداري كه كار بر فرستاده
    دستور دوم براي دادن مقدار براي كابر است .البته هر كدام از اين دستورات را مي توان به صورت محلي استفاده كرد
    وي بي با كلاس ها مانند يك نوع جديد رفتار مي كند يعني شما براي استفاده از يك كلاس در سطح فرم بايد يك متغير از
    نوع كلاس تعريف كنيد .تعرف يك متغيير محلي در سطح فرم

    Private CForm As Form

    تمام متغيير ها وتوابع وپردازه ها وحتي نام خود كلاس را با سي آغاز كنيد تا معلوم شود مربوط به يك كلاس است
    تعرف يك پردازه سراسري در كلاس

    Private Sub CSetInfo(Frm As Form)
    Set Form=Frm
    End Sub

    اگر تمام كدها بالا را درست در يك ماژول كلاس كپي كنيد اكنون نوبت استفاده از كدهاي بالاست
    در خط اول فرم يك متغيير از نوع نام كلاس تعريف كنيد.بدين صورت

    Dim Calss As Class1
    Private Sub Form_Resiz()
    Me.Caption="Form1.Width: "& Class.With
    End Sub

صفحه 3 از 6 اولاول 12345 ... آخرآخر

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

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

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