|
|
|
|
|
معرفی و اموزش چند تابع API 1.Mouse_event اين تابع واسه شبيه سازی کردن فشرده (یا رها) شدن دکمه های موس هستش: Private Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) آرگومان اول دکمه ای هستش که ميخواهيم شبيه سازيش کنيم و اين مقدار هارو ميشه بهش داد: Private Const MOUSEEVENTF_LEFTDOWN = &H2 دکمه سمت چپ فشرده میشه Private Const MOUSEEVENTF_LEFTUP = &H4 دکمه سمت چپ رها ميشه Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 دکمه وسطی فشرده ميشه Private Const MOUSEEVENTF_MIDDLEUP = &H40 دکمه وسطی رها ميشه Private Const MOUSEEVENTF_RIGHTUP = &H10 دکمه سمت راست فشرده ميشه Private Const MOUSEEVENTF_RIGHTDOWN = &H8 دکمه سمت راست رها ميشه بقيه آرگومان ها رو ۰ قرار بدين حالا عمل فشرده (يا رها) شدن دکمه های موس در جايی که موس قرار داره شبی سازی ميشه: Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Sub Command1_Click() mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 End Sub kb_event.۲ اين تابع واسه شبيه سازی فشرده شدن یا رها کردن دکمه های کیبرد هستش: Private Declare Sub keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) آرگومان اول کلید مورد نظر هستش که توی ویبی میشه از vbkeyA , vbkeyB , ... استفاده کرد.یا میشه از ثابت هایی که توی ای پی آی ویور هست VK_A ... , VK_B , ... استفاده کرد. آرگومان دوم رو 0 بزارین.سومی آگه 0 باشه عمل فشرده شدن و اگه 2 باشه عمل رها شدن کلید بازسازی میشه.چهارمی رو هم 0 قرار بدین: Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Form_Click() keybd_event vbKeyA, 0, 0, 0 End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) MsgBox KeyCode End Sub 3.GetWindowRect این تابع مختصات چهار سمت(چپ راست بالا پایین) یه پنجره رو توی یه متغیر از نوع rect قرار میده: Private Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As RECT) As Long آرگومان اول هندل پنجره مورد نظره.دومی هم یه متغییر از نوع rect هستش که تابع مقدار مورد نظر رو توی اون قرار میده.یه label و یه timer توی فرم بزارین و : Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Type POINTAPI x As Long y As Long End Type Private Sub Form_Load() Timer1.Interval = 10 End Sub Private Sub Timer1_Timer() Dim PAPI As POINTAPI, R As RECT GetCursorPos PAPI GetWindowRect WindowFromPoint(PAPI.x, PAPI.y), R Label1.Caption = "Top : " & R.Top & " Bottom : " & R.Bottom _ & " Left : " & R.Left & " Right : " & R.Right _ & " Height : " & R.Bottom - R.Top & " Width : " & R.Right - R.Left End Sub اول با استفاده از تابع هاي GetCursorPos و WindowFromPoint هندل پنجره ای که کرسر موس روشه رومیگیریم.بعد با تابع مورد نظر مختصات بالا و پایین و چپ و راست ومقدار طول وعرزش رو بدست میاریم. 4.InternetGetConnectedState این تابع مشخص میکنه که کامپیوتر چه طوری به اینترنت متصل شده و یا اصلا متصل شده یا نه: Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long,ByVal dwReserved As Long) As Long آرگومان اول یه متغیر از نوع Long هستش که تابع مقداری که مربوط به نوع ارتباط میشه رو توی این قرار میده.دومی رو هم byval 0& بزارین. وقتی تابع مقدار رو توی متغیر قرار داد باید با if های متعدد نوع ارتباط رو پیدا کنیم.مقدار میتونه یکی (یا چند تا) از اینا باشه: Private Const INTERNET_CONNECTION_MODEM As Long = &H1 MODEM ارتباط از طریق Private Const INTERNET_CONNECTION_LAN As Long = &H2 LAN ارتباط از طریقProxy Private Const INTERNET_CONNECTION_PROXY As Long = &H4 ارتباط دارای پراكسي هستش Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 مودم Busy هستش (؟) Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 کامپیوتر در حالتOffline هستش Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40 کامپیوتر به اینترنت متصل هستش Private Const INTERNET_RAS_INSTALLED As Long = &H10 روی کامپیوتر نصب شدهRas اگه مقدار برگشتی تابع 0 باشه کامپیوتر به اینترنت وصل نیست و اگه 1 باشه وصله. چون ممکنه مقداری که به متغییر داده میشه چند تا از مقدار های بالا باشه (مثلا CONNECTION_CONFIGURED و CONNECTION_MODEM) باید توی If از AND استفاده کنیم و نمیشه از = استفاده کرد: Private Const INTERNET_CONNECTION_LAN As Long = &H2 Private Const INTERNET_CONNECTION_PROXY As Long = &H4 Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40 Private Const INTERNET_RAS_INSTALLED As Long = &H10 Private Sub Form_Load() Dim lpF As Long, MBStr As String If InternetGetConnectedState(lpF, ByVal 0&) = 1 Then If lpF And INTERNET_CONNECTION_CONFIGURED Then MBStr = "Connection to the internet = True ..." & vbNewLine End If If lpF And INTERNET_CONNECTION_MODEM Then MBStr = "By MODEM" & vbNewLine End If If lpF And INTERNET_CONNECTION_LAN Then MBStr = "By LAN" & vbNewLine End If If lpF And INTERNET_CONNECTION_MODEM_BUSY Then MBStr = "MODEM Busy" & vbNewLine End If If lpF And INTERNET_CONNECTION_OFFLINE Then MBStr = "Offline" & vbNewLine End If If lpF And INTERNET_CONNECTION_PROXY Then MBStr = "Proxy" & vbNewLine End If If lpF And INTERNET_RAS_INSTALLED Then MBStr = "Ras Installed" & vbNewLine End I Else MBStr = "Connected to the internet = False" End If MsgBox MBStr End Sub ********************** اموزش روش های 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 *********************** طبق روال چند تا تابع و روش كار با اونارو آموزش ميدم. 1.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 استفاده كردم. اين رو هم بگم كه در زماني كه تابع داره كارشو ميكنه برنامه كار ديگه اي نميتونه بكنه.در ضمن رنگ زمينه رو عوض كردم تا تغيير اندازه دكمه مشخص بشه.ديگه فكر نكنم توضيحي بخواد. 2.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 بجاي اينكه رنگ زمينه واقعي رو برگردونه يه چيز ديگه برميگردونه. 3. 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 اضافي كه با تابع داده شده حذف ميشه. 3.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 ۴. 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 5.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 ********************** ۱.تابع 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 بزارین. 2.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 واسه توضیح در مورد طول متغیر و چرا اینطوریش کردیم به آموزش تابع GetSystemDirectory سر بزنین. 3. 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 بزارین عمل چاپ فقط در صورتی که اجرا میشه که کلید چپ در زمان فشره شدن دکمه فشرده شده باشه نه قبلش. البته در حالت اول برای یک بار فشردن دکمه چپ فقط یک بار عمل چاپ با فشردن دکمه انجام میشه.امتحان کنین تا منظورمو بفهمین. 4.LoadCursorFromFile این تابع اشاره گر یه فایل کرسر (.cur) رو به مامیده که ازش میشه توی تابع SetSystemCursor استفاده کرد.مثالش رو توی تابع بعدی ببینین. Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long 5. 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 پیدا کنین.به امید دیدار. ************************ 1.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 به طور تصادفی بدست میاریم توی خط بعد هم با استفاده از تابع مورد نظر پنجره رو حرکت میدیم. حالا بعد از اجرا کردن برنامه کلید اینتر رو که بزنین برنامه بسته میشه. 2.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 3.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 4.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 ثانیه طول میکشه. *********************** 1.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 Delphi: procedure TForm1.Command1Click(Sender: TObject); begin FlashWindow(form1.Handle,true); end; توی این کد من هندل فرم برنامه خودم رو بش دادم. 2.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 Delphi: procedure TForm1.Timer1Timer(Sender: TObject); begin Form1.Caption := IntToStr(GetForegroundWindow()); end; 3.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 Delphi: procedure TForm1.FormCreate(Sender: TObject); var Buffer : Array[1..MAX_PATH] of char ; var MAX_SIZE : Cardinal; begin MAX_SIZE := sizeof(buffer) -1 ; GetComputerName(@buffer,MAX_SIZE) ; ShowMessage('Computer Name : ' + StrPas(@buffer)); end; 4.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 Delphi: procedure TForm1.FormCreate(Sender: TObject); var buffer : array[1..MAX_PATH] of char; begin GetCurrentDirectoryA(sizeof(buffer),@buffer); ShowMessage('Current Directory : ' + strpas(@buffer)); end; 5.GetDoubleClickTime این تابع هم زمان Double Click که توی کنترل پنل توی قسمت موس مشخص شده رو برمیگردوونه: Private Declare Function GetDoubleClickTime Lib "user32" Alias "GetDoubleClickTime" () As Long هیچ مقداری هم نمیگیره: Private Declare Function GetDoubleClickTime Lib "user32" Alias "GetDoubleClickTime" () As Long Private Sub Form_Load() Msgbox "DoubleClickTime : " & GetDoubleClickTime() End Sub Delphi: procedure TForm1.FormCreate(Sender: TObject); begin ShowMessage('DoubleClickTime : ' + IntToStr(GetDoubleClickTime())); end; *************************** 1.bitblt این تابع واسه گرفتن عکس از یه window هستش.در واقع این تابع یه قسمت یا همه پیکسل های یه پنجره(مبدا) رو داخل یه پنجره دیگه (مقصد) کپی میکنه.ما میتونیم یه picture box که توی برناممون هستش رو مقصد قرار بدیم و بعد از قرار داده شدن تصویر پنجره مبدا توی مقصد با SavePicture عکسی که از پنجره مورد نظر گرفتیم رو ذخیره کنیم: 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 آرگومان اول hDC ی پنجره مقصد هستش.دومی x جایی هستش که میخواهییم رسم شدن روی پنجره مقصد از اونجا شروع بشه سومی هم y جاییه که گفتم.بعدی عرض نقطه ای هستش که میخواهیم عکس تا اونجا گرفته بشه.بعدی طول نقطه ای هستش که گفتم.بعدی hDC ی پنجره ی مقصده.بعدی x نقطه ای هستش که میخواهیم عکس گرفتن از اونجا شروع بشه . بعدی هم y اون نقطه ای هستش که گفتم. آرگومان بعدی هم نوع عکس گرفتن رو نشون میده که مقدار های زیر رو میشه بهش بدیم: Private Const SRCAND = &H8800C6 Private Const SRCCOPY = &HCC0020 Private Const SRCERASE = &H440328 Private Const SRCINVERT = &H660046 Private Const SRCPAINT = &HEE0086 به طور معمول Private Const SRCCOPY = &HCC0020 رو بايد قرار بديم یکی از کارهایی که میشه با این تابع کرد عکس گرفتن ازصقحه مانيتوره .یعنی ما با استفاده از تابع getdc ، hdc ی كل صفحه (چیزی که توی مانیتور داره نشون داده میشه) رو به تابع میدیم و با این کار یه عکس از چیزی که توی مانیتور داره نشون داده میشه عکس میگیریم. یه دکمه و یه PictureBox توي فرم بزارين خصوصيت autoredraw ش رو true كنين و كد زير رو وارد كنين: Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Private Sub Command1_Click() Picture1.Width = Screen.Width Picture1.Height = Screen.Height Me.Hide BitBlt Picture1.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY SavePicture Picture1.Image, "D:\test.bmp" unload me End Sub اول اندازه Picture Box رو برابر با اندازه صفحه مانیتور میکنیم تا بشه از کل صفحه مانیتور عکس گرفت. بعد فرم رو پنهان میکنیم تا عکس خود فرم توی تصویر نیفته. بعد با تابعی که گفتم از صفحه عکس میگیریم.ارگومان اول که hdc ی PictureBox هستش.دومی و سومی رو 0 قرار دادم تا عکس از نقطه 0،0 یعنی از بالا و سمت چپ picturebox شروم به رسم شدن بشه.سومی هم طول و عرض صفحه نمایش هست چون میخواهیم از همه صفحه عکس بگیریم.اونا رو بر 15 تقسیم کردم چون توی ویبی به طور پیشفرض این مقدار ها بر حسب twip به ما داده میشه ولی ما باید بر حسب پیکسل به تابع بدیم.بعدی رو هم که توضیح دادم.2 مقدار بعدی رو هم 0 قرار دادم چون میخوام عکس از نقطه 0و0 صفحه نمایش شروع که گرفتن بشه.بعد از اینکه عکس گرفته شد و توی picturebox قرار گرفت اون رو save میکنیم.بعد هم برنامه بسته میشه. 2.StretchBlt کار این تابع خیلی شبیه قبلی هستش ولی این تابع علاوه بر اینکه میتونه عکس بگیره عکس مورد نظر رو به نسبتی که بش میدیم میتونه کوچیک و یا بزرگ کنه: 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 همونطور که میبینین 2 تا آرگومان دیگه اضافه شده عکسی که گرفته میشه در نهایت طول و عرضش برابر nWidth و nHeight میشه و توی picturebox رسم میشه.یعنی اگه ما عکس رو از کل صفحه نمایش بگیریم و مقدار این 2 آرگومان رو نصف طول و عرض صفحه نمایش قرار بدیم چون عکس باید به این اندازه ها در بیاد کل عکس به نسبت کوچک میشه در صورتی که توی تابع قبلی برای اینکه به این اندازه ها در بیاد فقط قسمتی از عکس نمایش داده میشد نه همش یعنی اونجا همه عکس رسم نمیشد ولی اینجا همه عکس نشون داده میشه ولی با اندازه متفاوت(بر عکس این حالت هم اگه 2 آرگومان رو 2 برابر صفحه نمایش مقاد دهی کنیم اتفاق میفته و عکس بزرگ میشه البته توی این حالت برای اینکه همه عکس رسم بشه باید اندازه PictureBox رو هم 2 برابر صفحه نمایش کنیم) حالا اگه نخواهیم از همه صفحه نمایش(یا کلا پنجره مورد نظر) عکس بگیریم به جای اینکه مثل تابع قبلی nWidth و nHeight رو کم کنیم nSrcWidth و nSrcHeight رو کم میکنیم (باید به عرض و طولی که اول میدیم هم توجه کنین و اوا رو هم کم کنین و اگرنه کار درست انکام نمیشه) در غیر این صورت nSrcWidth و nSrcHeight رو برابر اندازه کل پنجره قرار میدیم . شاید این توضیحایی که دادم یکم گیجتون کرده باشه و درست متوجه نشده باشین.خودتون که یکم با تابع کار کنین میفهمین چی میگم. یه برنامه مینویسیم که عکس رو از صفحه نمایش بگیره ول اندازه اونو 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 3.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 4.این تابع هم کار تابع قبلی رو میکنه با این فرق که متن داخل یه محدوده چهار گوش شکل رسم میشه و میشه مشخص کرد با چه فرمتی(حالتی) این کار انجام بشه: 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 متنی که چاپ شده به اندازه نصف عرض صفحه نمایش هستش و وسطش چاپ میشه. 5.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 قرار گرفتن مثالش رو توی تابع بعد ببینین. 6.Drawicon این تابع 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 هست رو روی فرم رسم میکنیم |
||