آموزش .برنامه نویسی.نرم افزار های داغ

کد های آماده ویبی

کد زیر می تونید ماوس و کیبورد را به مدت 10 ثانیه قفل کنید
کد زیر را در یک فرم کپی کنید

Private Declare Function BlockInput Lib “user32″ (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib “kernel32″ (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
DoEvents
‘block the mouse and keyboard input
BlockInput True
‘wait 10 seconds before unblocking it
Sleep 10000
‘unblock the mouse and keyboard input
BlockInput False
End Sub

**فراخوانی API فقط با استفاده نام * سورس های رایگان**

با کد زیر دیگه نیاز نیست یه عالمه API به برنامه اضافه فقط کافی نام API را بلد باشید به کد زیر یک نگاه بندازید!

Private Declare Function LoadLibrary Lib “kernel32″ Alias “LoadLibraryA” (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib “kernel32″ (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function CallWindowProc Lib “user32″ Alias “CallWindowProcA” (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long

Private Declare Function FreeLibrary Lib “kernel32″ (ByVal hLibModule As Long) As Long

Private Sub Form_Load()

Dim Libary As Long
Dim PrcAdress As Long
On Error Goto NoApi
‘Load the Libary
Libary = LoadLibrary(”user32″)
‘Find the procedure we want
Procadress = GetProcAddress(Libary, “MessageBoxA”)
‘Call the Api
CallWindowProc Procadress, Me.hWnd, “My Message”, “Api without Declare”, &H0&
‘Unload the libary
FreeLibrary Libary
NoApi:
End Sub

**RGB To Hex To Color با ویژوال بیسیک * دانلود سورس کد**

با کد زیر می تونید رنگهای RGB را به Hex تبدیل کنید و Hex را به رنگ. این کد بدرد کسانی می خوره که از برنامه های یاهو استفاده می کنند. چون رنگ های موجود در یاهو به صورت HEX هست

Public Function rgbtohex(r As Byte, g As Byte, b As Byte)
‘input format = 255,255,255
‘get the r value
If r < 16 Then
hex1 = 0 & Hex(r)
Else

hex1 = Hex(r)

End If

چک کردن فولدر . آیا این فولدر وجود داره یا نه

اینم از کد برای چک کردن فولدر ها امیدوارم نهایت لذت رو برده باشید
یک Command1 به فرم اضافه کنید

Sub Command1_Click ()
f$ = “C:\WINDOWS”
dirFolder = Dir(f$, vbDirectory)
If dirFolder <> “” Then
strmsg = MsgBox(”This folder already exists.”, vbCritical):goto optout
End IF
End Sub

عوض کردن آدرس اینترنی در اینترنت اکسپلورر فقط با دو خط در ویژوال بیسیک

برای اینکار کافی کد زیر رو در یک Commnad1 کپی و پیست کنید به همین آسونی

Set wshshell = CreateObject(”WScript.Shell”)
wshshell.RegWrite “HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Start Page”, “http://www.Micro-TC.Blogfa.com”

|

این کد کارش چک کردن فایل هست که آیا فایلی از قبل وجود داشت یا نه ؟ فکر کنم بدرد کسانی می خوره که کارشون ذخیره فایل های Txt یا عکس هست.

Private Function FileExists(FullFileName As String) As Boolean
On Error Goto MakeF
‘If file does Not exist, there will be an Error
Open FullFileName For Input As #1
Close #1
‘no error, file exists
FileExists = True
Exit Function
MakeF:
‘error, file does Not exist
FileExists = False
Exit Function
End Function

Sub Command1_Click ()
msgbox FileExists
End Sub

پاک کردن یک فولدر با تمام فایل ها و محتویات داخل فولدر

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

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

’so like

Private Sub Command1_Click()

Call delall(”c:\New Folder”)
‘that would delete the c:\New Folder
End Sub

سلام امروز یک کد بسیار ساده برای شما آماده کردم. کد زیر باعث میشه فقط برنامه برای 25 اجرا بشه نه بیشتر یک command1 به فرم اظافه کنید و بعد کد زیر را به برنامه اظافه کنید

Private Sub Form_Load()
‘ the “A” in getsetting and savesetting
‘     can be changed to another letter
retvalue = GetSetting(”A”, “0″, “RunCount”) ‘ this returns the value of the registry edit.
Worm$ = Val(retvalue) + 1 ‘ adds one To the value of the regisrty edit.
SaveSetting “A”, “0″, “RunCount”, Worm$ ‘ saves the new value

If Worm$ < 25 Then ‘put one number higher then it says.
‘ this is the popup to warn the user how
‘     many runs have been executed and how man
‘     y are left.
MsgBox “you have used this program ” & Worm$ & ” Times. Only ” & (25 – Worm$) & ” left.”
End If

‘ this is the statement to check whether
‘     to execute the form load or end program

If Worm$ > 24 Then ‘put one number lower then it says.
MsgBox “you have used this program 25 Times, purchase is now required”, 16, “Sorry”
‘ this would send the user to a website
‘     in their default browser.
Win32Keyword “http://skygazer.net”
Unload Me
End
End If

End Sub

Private Sub Command1_Click()

End
End Sub

خیلی از مردم وقتی تازه با وی بی آشنا میشن بعد از کمی کار کردن می خوان بفهمن که چطوری میشه داده های تو یک لیست بوکس را خواند من امروز یک کد در مورد همین اینجا قرار دادم امیدوارم بدرد کسانی که تازه با وی بی آشنا شدن بخوره
این کد رو بعد از دابل کلیک کردن روی فرم کپی کنید
یک TextBox با نام Text1 به فرم اظافه کنید

For a = 0 To List1.ListCount – 1 ‘Start Loop
List1.Selected(a) = True ‘Select part of list
Text1.Text = Text1.Text & List1.Text & ” ” ‘Add selected part of list To text
Next ‘End Loop

چاپ به صورت باینری در ویژوال بیسیک

دیگه لازم نیست توضیح بدم به کد زیر یک نگاه بندازین

Public Sub PrintBinary(Num As Long)
Dim j&, i&
j = 128
For i = 8 To 1 Step -1
If (Num And j) = 0 Then
Debug.Print “0″;
Else
Debug.Print “1″;
End If
j = j / 2
Next
End Sub

جذاب تر کردن برنامه با استفاده از خصوصیات جدید گرافیکی

ویژوال بیسیک هیمشه به شما اجازه به کار بردن گرافیک در برنامه هایتان برای بهبود کیفیت انها را می دهد و مایکروسافت نیز سازگاری گرافیکی بسیاری از کنترلها را بالا برده است.در ابتدا کنترل ImageList که فایلهای .gif را نیز پشتیبانی می کند.این پیشرفت اساسی می باشد به این علت که تمام کنترلهایی که از گرافیک استفاده می کنند دارای کنترل ImageList می باشند که به ان وابسته می باشد.

کنترل های ListView و TabStrip نیز از خصوصیات جدید می باشد که برای تزیین و اضافه کردن توضیحات با استفاده از تصاویر و ایکون ها به کار می روند.تصویر 2.2 به شما کنترل جدید ListView را نمایش می دهد که شما می توانید تصویر پس زمینه را به محیط برنامه خود اضافه کنید.تصویر پس زمینه می تواند به صورت کاشی(Tiled)،مرکز(Centered) و یا در گوشه ای دیگر قرار گیرد.شما می توانید Check Box را به زیر مجموعه ListItem با قرار دادن خصوصیت چک باکس(CheckBox) ListView به True اضافه نمایید.همچنین شما می توانید نوار های پیمایش ListView را به صورت پهن با قرار دادن خاصیتFlatScrollBar به True تغییر دهید. (در صورتی که شما می خواهید بعضی از پیشرفت های کنترل های ListView را مشاهده کنید می توانید فایل VB6Ch2.zip را که به این مبحث مرتبط است را بار گذاری (Download)نمایید و به پروژه prjListView.vbp مراجعه نمایید.)

جذاب تر کردن برنامه با استفاده از خصوصیات جدید گرافیکی

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

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

رویداد Validate و خصوصیت کنترل Causes Validate

اولین تاثیر بهبود یافته که در مورد کنترل های ذاتی Active X می باشد اضافه کردن رویداد Validate و خصوصیت Causes Validation می باشد. قبل از VB6 اگر شما مجبور بودید از درست نوشتن شدن کلمه ای در جعبه متن اطمینان بیابید شما اکثرا از نوشتن کد در رویداد LostFocus جعبه متن استفاده می کردید.اگر بر خلاف این اتفاق می افتاد شما از روش SetFocus برای نگه داشتن استفاده کننده از ادامه کار او استفاده می کردید.بعضی وقتها ممکن است منطق برنامه نویسی برای استفاده کنندهای برنامه شما سبب بروز بعضی برای انها شود.اگر انها هرگز اطلاعات درستی وارد نکرده باشند ممکن است انها در روی یک کنترل قفل شوند و حتی نتوانند کلید Help را فشار بدهند.رویداد جدید Validate و خصوصیت CauseValidation این مشکلات را بر طرف می نمایند.

لیست 2.1 طرز استفاده از رویداد Validate برای بررسی صحیح بودن اطلاعات موجود در جعبه متن را نشان می دهد.این کد به مثالی که در شکل 2.1 نشان داده شده است ارتباط دارد.در صورتی که کاربر کلمه Cherries را در جعبه متن تایپ نکند نمی تواند به جعبه متن دوم برود اگر چه خصوصیت CauseValidation جعبه متن به مقدار False قرار داده شده است کاربر می تواند انرا به منظور دریافت اطلاعات بیشتر در مورد کلمه صحیح کلیک کند.

استفاده از رویداد CausesValidation

به عبارت Cancel موجود در خط 1 نگاه کنید.ویژوال بیسیک این عبارت را در داخل رویداد Validate قرار داده است.اگر شما مقدار Cancel را True قرار دهید(خط 7) برنامه اجازه انتقال فوکوس را به کنترل دیگر نمی دهد به جز مواردی که خصوصیت CauseValidation به مقدار False قرار داده شده باشد.

لیست 2.1 02LIST01.TXT

01 Private Sub Text1_Validate(Cancel As Boolean)

02 `Make it so that if the user does not

03 `enter the word, “Cherries” in the TextBox

04 `the cursor will be returned this TextBox

05 If Text1.Text <> “Cherries” Then

06 MsgBox “You cannot go on!”

07 Cancel = True

08 End If

09 End Sub

10 Private Sub Command1_Click()

11 Dim strMsg As String

12 Dim strQuote As String

13 strQuote = “”"”

14 `Make an instructional message

15 strMsg = “You must type the word,” & strQuote

16 strMsg = strMsg & “Cherries” & strQuote & ” “

17 strMsg = strMsg & “in the first TextBox.”

18 MsgBox strMsg, vbInformation, “Instructions”

19 `The reason that you can click on this

20 `CommandButton even though the Cancel parameter

21 `of the Validate event handler is set to True

22 `is because the value of CauseValidation

23 `property of this CommandButton is set to false.

24 End Sub

-2-

مشخصات جدید در ویژوال بیسیک 6

· مروری سریع بر ویژوال بیسیک

· بدست اوردن قدرت بیشتر با استفاده از کنترل های بهبود یافته

o رویداد Validate و خصوصیات کنترل Causes validation

o جالب تر کردن برنامه با استفاده از پیشرفتهای گرافیکی

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

o انتخاب تاریخ با کنترل های Monthview و Datetimepicker

o ساختن نوار ابزارهای با قابلیت جابجایی توسط CoolBar

o استفاده از گرافیک با ImageCombo

o کنترل FlatScrollBar

· کار با مشخصات جدید ویژوال بیسیک

o اشیای فایلهای سیستمی

o تابع جدید String

o تهیه صحیح کنترل Dynamic

· یادگیری درمورد ویژوال بیسیک و اینترنت

· دریافت اطلاعاتی در مورد سازگاری های داده های جدید

· نسخه جدید برنامه نویسی شی گرا

مروری سریع بر ویژوال بیسیک

اگر شما تازه با برنامه ویژوال بیسیک اشنا شده اید، عنوان این فصل ممکن است اندکی برای شما گیج کننده باشد.به طور اشکارا اگر شما تاره با این برنامه اشنا شده اید همه چیز برای شما جدید خواهد بود.با وجود این شما نباید این بخش را کنار بگذارید.قسمتهایی برای شما قرار داده شده است، مخصوصا قسمتی که در مورد کنترل های Active X است.و برای کسانی که قبلا با ورژن های قبلی ویژوال بیسیک کار کرده باشند این بخش مهم خواهد بود.

چه چیز حذف شده است؟

به یاد داشته باشید که بعضی از مشخصه های جدید Vb6 از این بحث حذف شده اند.برای درک کامل ان بخشها نمی توان به تنهایی به معرفی انها اکتفا کرد.بسیاری از این مشخصات که در این بخش بیان نشده اند در بخش های بعدی بیان خواهند شد،همچنین تعدادی از انها به همراه اطلاعاتی که همراه محصول می ایند بیان می شوند.

اینکه گفته می شود ویژوال بیسیک مشخصات جدید جالبی دارد، بر هیچ کس پوشیده نیست.ویژوال بیسیک 6 مشخصات جدید جالبی دارد که باور نکردنی نیست زیرا این مشخصات به طور گسترده در بسیاری از قسمت های ویژوال بیسیک قرارداده شده است.کنترل های جدید باعث می شود تا نگاه، احساس و عمل شما نسبت به برنامه های ویژوال بیسیک و افیس 97 و اینترنت اکسپلورر مشابه باشد.

این بخش مشخصات جدیدی از ویژوال بیسیک به شما می دهد.بعضی شامل کار با داده های که ممکن است شامل صدها بلکه هزارها استفاده کننده شود(مانند MS Acess) در اینترنت شود.این نوع از برنامه ها با نام Enterprise Application شناخته می شوند.که معمولا با نسخه Enterprise ویژوال بیسیک نیز نوشته می شوند.این مشخصات جدید Enterprise در این جا اشاره شده است ولی از هدف اصلی این کتاب به دور است.

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

اکثر کنترل هایی که در این بخش توضیح داده شده اند کنترل های ذاتی (Standard) Active X نمی باشند.بنابراین انها باید به پروژه شما از طریق پنجره Components اضافه شوند.(Components را از منوی Project انتخاب کنید)زمانی که شما پنجره Components را باز کردید گزینه Microsoft Windows Common Controls ،Microsoft Windows Common Controls-2 ، و Microsoft Windows Common Controls-3 را از لیست انتخاب کنید

.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 هست رو روی فرم رسم میکنیم

نوشته شده در ۱۲ شهریور ۱۳۹۰ |
نظرات - ۰ |
نظر بدهید

نظرات:

عنوان نظر
متن نظر
نام
ایمیل

آموزش .برنامه نویسی.نرم افزار های داغ

آرشیو وبلاگ

کد های آماده ویبی

کد زیر می تونید ماوس و کیبورد را به مدت 10 ثانیه قفل کنید کد زیر را در یک فرم کپی کنید

فراخوانی API فقط با استفاده نام * سورس های رایگان