آموزش ویژوال بیسیک

چند تا ترفند کاربردی در Visual Basic 6.0

*******************************
یکی از دوستان اموزش ارسال فایل با winsock رو خواسته بود که نمونش رو گذاشتم
http://www.iranvig.com/modules.php?name=News&file=article&sid=2253

کامپوننت ارسال نامه و ... توسط زبانهای مختلف از جمله VB
http://www.emailarchitect.net/smtpWEpo-5-08.htm
*******************************
این برنامه برای رشته کامپوتر خوبه (منظورم از نظر کاربرد این برنامه است) این برنامه برای یافتن مسیر در گراف با استفاده از الگوریتم دایجسترا هست .رو این برنامه از نظر گرافیکی خیلی خوب کار شده , این برنامه برای کسانی که می خوان کار با Pixel و مسائل مربوط به گرافیک در VB رو یاد بگیرن خوبه

http://matrix007.persiangig.com/vb/Dijkstra.rar

برنامه نمونه اعمال پوسته یا Skin روی فرم
http://mediavb.persiangig.com/ActiveX/Skin%20Form.zip

********************************
تشخیص فشرده شدن کليدهای کيبرد

یکی از دوستان سوال کرده بودند که چگونه می توان کلیدهای کیبرد را حتی وقتی فوکوس روی برنامه ما نیست تشخیص داد مانند دیکشنری ها که مثلاً با CTRL+F12 فعال می شوند و یا Keylogger ها که کلیدهای فشرده شده را ثبت می کنند
من دو روش زیر را برای اینکار پيشنهاد می کنم :

1 - استفاده از یک تابع کتابخانه ای به اسم GetAsyncKeyState موجود در کتابخانه user32.dll . این تابع ، فشرده شدن یا رها شدن یک کلید را تشخیص می دهد . نحوه declare کردن این تابع بصورت زیر است :

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

حال در برنامه تان یک timer قرار داده و در event آن کد زیر را قرار دهید :

For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 Then
Msgbox(Chr(i))
End If
Next

برای مشاهده یک برنامه نمونه به این آدرس مراجعه کنید .
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=36078&lngWId=1

2 - استفاده از قلاب یا Hook : قلاب ، یک ابزار در مکانیزم مدیریت پیغام سیستم ویندوز است که توسط آن برنامه ها می توانند یک روتین را برای مدیریت و پردازش پیغامهای خاصی قبل از اینکه آن پیغامها به برنامه مقصد برسند نصب نمایند . قلابها باعث کندی سیستم می شوند زیرا حجم پردازشی سیستم روی هر پیغام را افزایش می دهند بنابراین بایستی زمانیکه واقعاً به قلاب نیاز دارید آنرا نصب نموده و هر چه زودتر آنرا حذف نمایید . سیستم ویندوز از انواع زیادی از قلابها پشتیبانی می کند که هر کدام امکان دستیابی به پیغامهای خاصی را مهیا می نمایند برای مثال یک برنامه کاربردی می تواند با استفاده از قلاب کیبرد برای مدیریت و پردازش پیغامهای مربوط به آن ( مثل فشرده شدن یک کلید خاص یا رها شدن آن ) استفاده کند .
برای نصب یک قلاب در برنامه از یک تابع کتابخانه ای به اسم SetWindowsHookEx استفاده می شود . این تابع یک قلاب را به زنجیره قلابهای سیستم اضافه می کند . نحوه declare کردن این تابع بصورت زیر است :

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

همچنین برای آزاد کردن یک قلاب و حذف آن از زنجیره قلابها از تابع کتابخانه ای UnhookWindowsHookEx استفاده می گردد . نحوه declare کردن این تابع بصورت زیر است :

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

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

Public Const WH_KEYBOARD = 2

حال بایستی یک تابع پس زمینه یا Callback Function نوشت که به ازای فشرده شدن کیبرد اجرا شود و آدرس آنرا ( با استفاده از کلمه کلیدی Address Of ) بهمراه ثابت فوق به تابع SetWindowsHookEx فرستاد .
*********************************
اموزش Visual basic
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic1.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic2.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic3.pdf
http://www.garmsarnews.com/evisualbasic/visualbasic.pdf

*************************************
این برنامه برای ساختن Setup می باشد که با توجه به حجم کم این برنامه ولی بسیار قوی هست. این برنامه دارای امکانات زیادی می باشد به شما توصیه می کنم که حتماً دانلود کنید .

برای ساختن Setup شما باید بدانید که چه فایل هایی را باید به همراه فایل اجرایی بر روی سیستم هدف نصب کنید , شما برای اینکار می توانید یک بار توسط نرم افزار Package & Deployment Wizard که به همراه ویژوال بیسیک نصب می شود یک setup طراحی کنید , بعد از ساخت Setup یک فابل متنی به نام SETUP.LST در کنار فایل Setup.exe ایجاد می شود که در آن تمام فابل های مورد نیاز ذکر شده .

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

دانلود
http://www.free-hoster.cc/users/matrix/downloads/QSetup.zip

**************************************

استفاده از شی File System Object در ویژوال بیسیک
امروز می خوام درباره شی (File Sysytem Object ) که به FSO هم معروف است مطالبی را خدمت شما دوستان ارائه بدم ,این شی قابلیت کار با Drive , Folder , File , TestStream را دارد یعنی شما می توانید پوشه و یا فایلی را از مسیری به مسیر دیگر کپی و حذف و یا منتقل کنید و هم چنین می توانید پو شه ای را در مسیر مورد نظر ایجاد کنید

برای افزودن این شی به برنامه از منوی Project آیتم Refrencese را انتخاب کنید و از آن آیتم Microsoft Script Runtime را تیک می زنید . اکنون نوبت به تعریف یک متغیر از نوع ّFso می باشد

Dim Fso As New FileSystemObject

در ضمن لازم به ذکر است که App.path مسیر جاری را که برنامه اجرایی در آن قرار دارد را بر می گر داند .

Fso.CopyFile App.Path & "\text.txt", "C:\", True ' True For Ovwerwrite
fso.MoveFile App.Path & "\text.txt", "C:\" ' For Move File Of Current Path to "C:\" Path
fso.DeleteFile "c:\text.txt"

همین عملیات بالا را می توان برای Folder هم اجرا کرد . همان طور که متوجه شده اید این شیء بسیار مهم است و می تواند کاربرد های زیادی برایتان داشته باشد مثلاً من در زیر برنامه ای می نویسم که بتواند فایلی را در پو شه System32 ویندوز کپی کند خوب بر ای اینکه بتوان پوشه ویندوز را پیدا کنیم از یک API استفاده می کنم چون امکان داره ویندوز داخل پوشه هایی غیر از نام Windows باشد این کار بر ای بر نامه هایی که می خواهید فایلی را در پوشه ویندوز کپی کنی دکاربرد دارد مثلاً شما می خواهید فونتی را در پوشه font ویندوز کپی کنید.

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long _
) As Long

Dim fso As New FileSystemObject
Public S As String
Public SysDirectory As Long

Private Sub Command1_Click()
fso.CopyFile App.Path & "\vb.txt", S + "\System32\", True
End Sub

Private Sub Form_Load()
S = Space(255)
'Get the Windows directory
WinDirectory = GetWindowsDirectory(S, 255)
S = Left$(S, WinDirectory)

'#######################################

LblSource.Caption = "Source : " & App.Path & "\vb.txt"
LblDestination.Caption = "Destination : " & S & "\System32\"
End Sub

دانلود برنامه نمونه
https://www.sharemation.com/vbcoder/vb/Copy.zip?uniq=-buiawi
*****************************

چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري کنیم؟
خوب با استفاده از کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کنيد

Private Sub Form_Load()
If App.PrevInstance = True Then
Dim Result As Integer
Result = MsgBox("برنامه در حال اجراست", vbInformation, "Warnnig")
Unload Me
End If
End Sub

******************************
برنامه خاموش کردن Windows با يک کليک
در اين برنامه يک پروژه ساده رو به شما معرفی ميکنم که در اون با يک کليک ساده دکمه ميتوانيد ويندوز رو
خاموش کنيد . برای ساخت اين پروژه مراحل زير را طی کنيد :
۱ - ويژوال بيسيک را باز کنيد
۲ - يک فرم جديد ايجاد کنيد
۳ - از جعبه ابزار ويژوال يک دکمه روی فرم قرار دهيد
۴ - روی دکمه دو بار کليک کرده و دستور زير را در رويداد کليک دکمه تایپ کنيد

Shell ("Shutdown ") ' Shuts computer down

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

' Switches:
l Log off profile
s Shut down computer
r Restart computer
f Force applications to close
t Set a timeout for shutdown
m \\computer name Shut down remote computer
i Show the Shutdown GUI

مثال :

Shell ("Shutdown -s -t 5") ' Shuts computer down after timeout of 5

بعنوان مثال در صورت استفاده از فرمان فوق سيستم بعد از 5 ثانيه خاموش ميشود. دقيقا مطابق کدی
که در ويروس ام اس بلستر استفاده شده با اين تفاوت که مدت انتظار برای خاموش شدن سيستم در
اين ويروس 30 ثانيه است

**************************************
چگونه وقفه ايجاد کنيم : مثلا برای بارگذاری فرم

Sub Pause(interval)
Dim Current
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

*******************************
بيل گيتس : جهاني فكر كنيد؟ محلي عمل كنيد!
*******************************
یک بسته اموزشی کامل که نمیگم چیه و اگه دانلود نکنی از دستت رفته
هر سه بخش رو دانلود کنید و سپس unzip کنید و حجمش کم است

http://www.sharemation.com/MahdiVB678/new2/New.part1.rar?uniq=yvuarx
http://www.sharemation.com/MahdiVB678/new2/New.part2.rar?uniq=yvuarr
http://www.sharemation.com/MahdiVB678/new2/New.part3.rar?uniq=yvuarl

*******************************
تشخیص ادمین بودن کاربر جاری در ویندوز

اگه زمانی خواستید این موضوع رو بفهمید کافیه که از تابع API ی که در shell32 تعریف شده استفاده کنید. صورت کلی این تابع چنین است:

Private Declare Function IsUserAnAdmin Lib "shell32" () As Long

تحت ویندوز 2000 ممکنه که شما خطای با عنوان Can't find DLL entry point دریافت کنید که بهتر است که معرفی تابع را بدین گونه انجام دهید:

Private Declare Function IsUserAnAdmin Lib "shell32" Alias "#680" () As Long

*******************************
DLL ( Dynamic Link Library )
شاید برای شما این سوال مطرح باشد که بعنوان یک برنامه‌نویس حرفه‌ای چگونه می‌توانید با ویژوال بیسیک توابع خود را درون فایلهای DLL بنویسید و در مواقع لزوم آنرا بعنوان توابع API در ویژوال بیسیک یا سایر زبانها مورد استفاده قرار دهید. چیزی که در زبانهایی مانند ویژوال سی و ... راحت قابل دسترس و تولید می‌باشند. چنانچه در خود VB فقط مورد استفاده‌تان باشد که خب از طریق کلاس‌ها قابل پیاده‌سازی است، اما اگر نیاز به این شد تا در نرم‌افزارهایی که امکان ساخت توابع سطح پایین در آنها مقدور نیست مورد استفاده قرار گیرند چه باید کرد؟ بعنوان مثال در نرم‌افزار MultiMedia Builder یا Wise Install Master که امکان صدا زدن توابع API در آنها پیش‌بینی شده است.

حتی کاربرد دیگری که می‌توان برای این تکنیک جست، جهت کم کردن حجم برنامه اصلی و مهندسی‌تر شدن پروژه است. شما ماژول‌های متنوعی از برنامه را درون فایل‌های DLL تعریف کنید و در پروژه و در هنگام لزوم از آن استفاده کنید، چیزی که در اکثر نرم‌افزارهای مهندسی وجود دارد که می‌توان به PlugIn‌ها اشاره کرد. همانند نرم‌افزار Winamp.
برای این منظور شما را با مقاله‌ای در این باب آشنا می‌کنم که امکان بهره‌برداری از آن نیز وجود دارد.
به آدرس http://www.vb-helper.com/howto_make_standard_dll.html مراجعه کنید تا شرح کاملی در اینباره بیابید.
برای نمونه عملی هم این فایل را دانلود کنید.

http://www.vb-helper.com/HowTo/howto_make_standard_dll.zip

*******************************
تبدیل متن به گفتار جالبه Speech SDK 4.0

http://downloads.pcworld.com/pub/new/graphics_and_multimedia/audio/audio_tools/sapi4sdk.exe

*******************************
ضبط صدا به فرمت دلخواه با ویژوال بیسیک

با این برنامه‌ به فرمت دلخواه صدا را ضبط کنید. آن هم به شکلی خیلی ساده.
راه‌های زیادی برای رسیدن به ضبط صدا هست! اما هدف من در اینجا ضبط صدا به فرمت دلخواه است، مثلا mp3 و بدون استفاده از ابزارهای برنامه‌نویسی نظیر ActiveX و ...
ما می‌خواهیم با استفاده از توابع API‌ به این هدف برسیم. توابع در دسترس برای پخش و ضبط صدا عبارتند از mciSendString، mciSendCommand و mciExecute. (برای آشنا شدن با این توابع می‌توانید به سراغ MSDN بروید.)
این توابع هر کدام پیچیدگی خاص خودشان را دارند. مخصوصا اگر قصد ضبط صدا را داشته باشید که باید پارامترهای زیادی را تنظیم کنید که نرخ‌نمونه برداری، تعداد کانال صوتی، بافر و ... را شامل میشوند.
من قصد دارم شما را با تابع mciSendCommand آشنا کنم که با وجود پیچیدگی بیش از حد، استفاده راحت‌تری از آن هم میسر هست و البته به طریقی که آموزش می‌دهم.
بهتر هست با یک مثال شروع کنیم:
شکل کلی این تابع این چنین هست:

Public Declare Function mciSendCommand Lib "winmm.dll" _
Alias "mciSendCommandA" (ByVal wDeviceID As Long, _
ByVal uMessage As Long, _
ByVal dwParam1 As Long, _
ByVal dwParam2 As Any) As Long

پخش فایل صوتی شامل چند مرحله است:
1- باز کردن فایل صوتی
2- دستور پخش
3- بستن فایل (که حتما باید انجام بشه)
باز کردن فایل صوتی خود شامل پارامترهایی است که در ساختار زیر مشخص میشود:

Private Type MCI_OPEN_PARMS
dwCallback As Long
wDeviceID As Long
lpstrDeviceType As String
lpstrElementName As String
lpstrAlias As String
End Type

البته باید ذکر کنم که برخی پارامترها در شرایط خاصی مقدار دهی می‌شوند تا کار مشخصی را انجام دهند (پارامتر سوم، بعدا مثال میآرم)
کد زیر یک فایل صوتی را باز می‌کند و هندل آن را در صورت موفقیت جایی نگه می‌داریم، چون از این به بعد ما با این هندل خیلی کار داریم.
پارامتر آخر از تابع mciSendCommand حاوی ساختار مرتبط با نحوه عمل است.

Dim dwReturn As Long
Dim mciOpenParms As MCI_OPEN_PARMS
'Open a waveform-audio device with filename for play.
mciOpenParms.lpstrDeviceType = "WaveAudio"
mciOpenParms.lpstrElementName = filename dwReturn = mciSendCommand(0, MCI_OPEN, _
MCI_OPEN_ELEMENT Or MCI_OPEN_TYPE, _
mciOpenParms)
If dwReturn Then
MsgBox "Failed to open device; don't close it, just return error."
Exit Sub
End If 'The device opened successfully; get the device ID.
wDeviceID = mciOpenParms.wDeviceID

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

dwReturn = mciSendCommand(wDeviceID, MCI_PLAY, 0, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_PLAY not succed!"
Exit Sub
End If

اگر دقت کنید پارامتر سوم مقدار صفر را داراست. این پارامتر می‌تواند به نحوی مشخص شود که با اجرای دستور پخش، کنترل به برنامه داده شود یا تا زمانی که پخش به اتمام نرسیده برنامه منتظر بماند. و مشخه‌های دیگر.
چون ذکر نکردیم پس کنترل برنامه را در حین پخش در دست می‌گیریم.
و سرانجام با این کد فایل را می‌بندیم:

Dim dwReturn As Long dwReturn = mciSendCommand(wDeviceID, MCI_Close, MCI_WAIT, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_Close not succed!"
Exit Sub
End If

و اما ضبط صدا. برای ضبط باید از ساختار پیچیده زیر استفاده کنیم:

Private Type MCI_WAVE_SET_PARMS
dwCallback As Long
dwTimeFormat As Long
dwAudio As Long
wInput As Long
wOutput As Long
wFormatTag As Integer
wReserved2 As Integer
nChannels As Integer
wReserved3 As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wReserved4 As Integer
wBitsPerSample As Integer
wReserved5 As Integer
End Type

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

.:: CODEC ::.
این کلمه مخفف واژه‌های COmpress/DECompress هست و به زبان ساده‌تر درایوری است که عمل کدسازی و دیکودسازی اطلاعات را انجام می‌دهد، البته برای کاربر محسوس نیست و به نوعی در پشت پرده انجام می‌گیرد.
وقتی شما فایلهای wav را در سیستم پخش می‌کنید، باید codec فایلهای wav در سیستم نصب شده باشد وگرنه قادر به پخش نیستید که البته بهمراه ویندوز این درایورها نصب میشوند.
برای فایلهای mp3 نیز همین قضیه صادق هست و غیره.
برای اینکه بدانید بر روی سیستم شما چه codecهایی نصب شده مراحل زیر را دنبال کنید:

Control Panel -> Sound & Audio Device -> Hardware -> select Audio Codec from list -> click on Properties.

با این توضیحاتی که آمد می‌خواهیم بر اساس یکی از codecهای نصب شده اقدام به ضبط صدا کنیم.
لازم به ذکر است که برخی codecها فقط حاوی بخش پخش هستند و امکان ضبط رو ندارند!
برسیم به هدف اصلی از این صحبت‌ها.

1- Sound Recorder ویندوز رو باز کنید و سپس از منوی File گزینه Save As...‌ را انتخاب کنید.
2- دکمه Change را کلیک کنید تا لیست codec ها ظاهر شود.
3- گزینه Format را با codecی که می‌خواهید تنظیم کنید.
4- OK کنید و بعد نام فایل را مشخص کنید و Save‌ نمائید.

با طی این 4 مرحله شما یک فایل صوتی ساختید که فقط حاوی تنظمیات صدا است. یعنی تمام پارامترهای ساختار MCI_WAVE_SET_PARMS

حالا اگر با تابع mciSendCommand‌ این فایل را باز کنید و اقدام به ضبط صدا نمائید، در واقع دارید به فرمتی که می‌خواهید صدا را ضبط می‌کنید و درگیر تنظیمات خاصی نیستید.
سورسی را که مربوط به همین بخش است، این صحبت‌ها را پیاده‌سازی کرده و نمونه کاملی از ضبط و پخش به فرمت دلخواه را انجام می‌دهد.
و این نکته که دو فایل با پسوند mrf در کنار برنامه هست، در واقع فایل‌های حاوی ساختار هستند(wav)‌ که پسوندشان عوض شده.

برنامه ابتدا لیست تمام فایلهای با پسوند mrf‌ را لیست می‌کند و در هنگام ضبط به همان فرمتی که انتخاب می‌کنید اقدام به ضبط می‌کند.
شما می‌توانید هر ساختاری را که دوست داشتید با Sound Recorder بسازید و با پسوند mrf در کنار برنامه ذخیره کنید و از نزدیک با چگونگی عمل ضبط آشنا شوید.

http://h1.ripway.com/PalizeSoftware/Files/WaveRecordTest.zip

*******************************
معرفی هیستوگرام تصویر و چگونگی تهیه آن

شبیه سازی نمودار هیستوگرام در فتوشاپ
هیستوگرام مشخص کننده میزان روشنایی یا تیرگی تصویر هست.
به عبارتی تعداد پیکسل‌های تصویر ما را در بازه‌ای از دو رنگ تیره(مشکی) و روشن(سفید) مشخص می‌کند، یعنی همان نمودار فراوانی رنگ پیکسل‌ها.
در سطوح حرفه‌ای برای یک عکاس این نمودار حائز اهمیت است، چرا که به روشنی یا تیرگی عکس پی می‌برد. امروزه دوربین‌های دیجیتال سطح بالا قادر هستند تا بعد از شکار عکس، نمودار هیستوگرام آنرا نمایش دهند.
سورس زیر این نمودار را بر اساس همین روش پیاده کرده و هیستوگرام مربوطه را با قابلیت تفکیک کانال‌های قرمز، سبز و آبی به نمایش می‌گذارد

http://h1.ripway.com/PalizeSoftware/Files/Histogram.zip

*******************************
تبدیل به سطوح خاکستری (GrayScale)

امروز برای شما سورسی رو تدارک دیدم که بتونید تصاویر رنگی رو به تصاویر خاکستری (GrayScale) تبدیل کنید.
در واقع تبدیل یک پیکسل رنگی به طرح خاکستری خیلی راحت صورت می‌گیرد.
می‌دونیم که هر رنگ دارای سه مؤلفه قرمز، سبز و آبی است. برای تبدیل به طرح خاکستری کافیه که رنگ قرمز رو در ضریب 0.3، سبز رو در ضریب 0.59 و آبی رو در ضریب 0.11 ضرب کنید.
در آینده شما رو با تکنیک‌های دیگه‌ای در زمینه گرافیک آشنا خواهم کرد. پس چه بهتر که شما بفرمائید در چه زمینه‌هایی مشتاق هستید بدونید

http://h1.ripway.com/PalizeSoftware/Files/GrayScale.rar

*******************************
فایلهای Zip

قابلیت فشرده‌سازی و استخراج فایلهای فشرده (در نوع ZIP) رو به نرم‌افزارهای خود اضافه کنید یه خبر قابل دانلود دارم. فایل زیر که بصورت API مورد استفاده قرار می‌گیره (اصل موضوع همینه که می‌تونید در هر نرم‌افزاری که قابلیت فراخوانی توابع API‌ رو داره بکار بگیرید.) قادره با سرعت بالا (وحشتناک و غیر قابل تصور) اقدام به فشرده‌سازی و استخراج این قبیل فایلها بپردازه.
حتی قادرید مشخص کنید که از چه نوع فشرده‌سازی استفاده کنه. ضمن اینکه قادرید بصورت CallBack‌ پیشرفت کارش رو هم تحویل بگیرید یعنی خیلی برنامه‌نویس رو تحویل گرفته‌اند که این رو هم نوشته‌اند!
نکته آخر اینکه این موضوع رو (با همین عنوان) قبلا در سایت برنامه‌نویس قرار داده بودم و برای دوستانی که ممکنه ندیده باشند، اینجا هم گذاشتم

http://h1.ripway.com/PalizeSoftware/files/bszipdll.zip

*******************************
زیر نظر گرفتن تغییرات یک شاخه یا زیر شاخه

با گوگل دسک‌تاپ کار کردید؟ اگر نه که پیشنهاد می‌کنم حتما یکبار امتحان کنید تا به ارزشش پی ببرید. با برنامه‌هایی که در پشت پرده عمل ایندکس‌گذاری فایلها رو انجام می‌دهند چی، آشنا هستید؟ منظور برنامه‌هایی که کار جستجو رو راحت می‌کنند تا کاربر سریع‌تر به جستجوی فایلها بپردازد. آیا اینگونه برنامه‌ها بطور مداوم باید فایلها و پوشه‌ها رو زیر نظر داشته باشند تا به محض رؤیت تغییر جدید، بانک خود را اصلاح کنند؟ اگر بدین شکل باشد که این کار پردازنده را زیر بار می‌برد، نه؟
حالا اگر این کار در بطن سیستم‌عامل نهفته باشد و به محض تغییر محتویات اعم از ایجاد و حذف فایل، تغییر فایل، تغییر خصلت فایل، اندازه و ... در مسیری به ما اطلاع داده شود، کار ما ساده‌تر شده و بار زیادی هم از روی دوش پردازنده برداشته می‌شود. سورس زیر رو ببینید تا بطور عملی در نحوه استفاده از این قبیل توابع آشنا شوید.

http://h1.ripway.com/PalizeSoftware/Files/watchdir.rar

*******************************
فیلتر کردن بعضی از کلید های صفحه کلید

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim svalid As String
svalid = "0123456789"
If InStr(svalid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
MsgBox "Not valid Keys.please Press 0-9 keys"
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
MsgBox "The form cannot be close.farzad dh."
Dim leftI As Long
Dim rightI As Long
leftI = Form1.Left + 1000
rightI = Form1.Top + 1000
Dim a As New Form1
a.Width = Me.Width
a.Height = Me.Height
a.Left = leftI
a.Top = rightI
a.Show
End Sub
*******************************
یک کار جالب با موس

فقط یک تایمر با زمان 500 روی فرم قرار بدین و این کدها رو داخلش کپی کنید
Dim farzadvb
Dim bestforvb6
Dim temp
Randomize 1000

farzadvb = Rnd(10) * 1000

bestforvb6 = Rnd(10) * 1000

temp = SetCursorPos(farzadvb, bestforvb6)

********************************
چگونه متن داخل يک TextBox را Select کنيم :

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub

*******************************
چگونه مسير نصب ويندوز را پيدا کنيم :

Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function WinDir() As String
Dim Wind As String
Wind = Space(500)
Wind = Left(Wind, GetWindowsDirectory(Wind, Len(Wind)))
WinDir = Wind
End Function

*******************************
یکی از دوستان سوال کرده بودند که "چه جوری میشه برنامه خودشو کپی کنه تو فولدر StartUp ویندوز؟"
خوب شما باید از دستور FileCopy استفاده کنید به این ترتیب:

FileCopy App.Path + "\" + App.EXEName + ".exe", "Windows Drive\Documents and Settings\User Name\Start Menu\Programs\Startup" + "\" + App.EXEName + ".exe" 'Copy Function

در این دستور که دستور کپی میباشد به جای:
Windows Drive درایو ویندوز را قرار دهید

User Name نام کاربر را بنویسید البته میتوانید از کلمه All Users نیز استفاده کنید که مخصوص تمام کاربران میباشد(نتیجه این کار را پس از رستارت میبینید)

در اینجا :

App.Path یعنی از درایو تا فولدر برنامه
App.EXEName یعنی نام فایل برنامه
".exe" به دلیل اینکه پسوند فایل نیز به دستور اضافه شود میباشد

*******************************
ساختن جدول در بانک اطلاعاتی

از منوی project گزینه refrences رو انتخاب کنید - بعد اونجا گزینه Microsoft ActiveX Data Objects 2.0 library پيدا کنيدو تيک بزنيد - Adodc مورد نظرتون رو هم با دیتابیس set کنید - بعد :

Dim db_file As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim NumRec As Integer

Set conn = New ADODB.Connection
conn.ConnectionString = Adodc1.ConnectionString
conn.Open

On Error Resume Next
conn.Execute "DROP TABLE Jadid"
On Error GoTo 0

conn.Execute "CREATE TABLE Jadid(" & "One INTEGER NOT NULL," & "Two VARCHAR(40) NOT NULL," & "Three VARCHAR(40) NOT NULL)"

conn.Execute "INSERT INTO Jadid VALUES (1,'4','7')"
conn.Execute "INSERT INTO Jadid VALUES (2,'5','8')"
conn.Execute "INSERT INTO Jadid VALUES (3,'6','9')"

Set rs = conn.Execute("SELECT COUNT (*) FROM Jadid")
NumRec = rs.Fields(0)

conn.Close

MsgBox "Created ... "

*******************************
کتابچه سورس

يكي از راههاي اينكه شما بتونيد روش كد نويسي رو خوب ياد بگيريد و يا از كدهاي استاندارد و از پيش نوشته شده در برنامه هاتون به خوبي استفاده كنيد اينه كه از كدهاي نوشته شده كتابها استفاده كنيد. به همين دليل هم به دوستان عزيز پيشنهاد مي كنم براي اين منظور به سايت انتشارات Wrox سر بزنن و از هر كتابي كه دلشون ميخواد هر سورسي رو دوست دارن بردارن. شما مي تونيد از كدهاي اونها كه واقعاً با توضيحات خوب نوشته شدن استفاده كنيد. براي اين منظور به این ادرس بروید
http://www.wrox.com/dynamic/books/download.aspx

*******************************
نحوه تولید DLL با ویژوال بیسیک

بعنوان یک زبان برنامه‌نویسی با توسعه سریع، ویژوال بیسیک نظر خیلی از برنامه‌نویسان را از جهت سادگی به خود معطوف کرد. برنامه‌نویسی با ویژوال بیسیک در کمترین زمان صورت می‌گیرد حال آنکه در مقابل زبانهایی چون C و ++C اغلب اوقات به روزها کار مفید نیاز است.
اما بیشترین انتقادی که برنامه‌نویسان از ویژوال بیسیک دارند در این است که قادر به تولید کتابخانه‌های پویا (DLL) نیست. حقیقتا این نظر مورد قبول است که نمی‌توان این نوع فایلها را در کنار فایلهای اجرایی(Exe) یا ActiveX Exe تولید کرد.
در این مقاله ما قصد داریم که نگاه دقیقی به نحوه تولید فایلهای اجرایی در ویژوال بیسیک یندازیم و بعد با طی مراحل ساده‌ای موفق به ایجاد فایلهای DLL بشویم تا از زیر بار این انتقاد نیز رهایی یابیم.
قبلا به این موضوع اشاره شد که فایهای DLL آن دست از برنامه‌هایی هستند که یکبار نوشته می‌شوند و در پروژه‌های بعدی بکرات می‌تواند از آنها استفاده برد. چیزی که هسته ویندور را تشکیل می‌دهد اینگونه فایلها هستند. علاوه بر آن تکنیک‌هایی وجود دارد که شما را قادر می‌سازد تا برنامه‌هایی بنویسید که قادرند خود را بروز برسانند و یا خود ترمیم باشند. بهتر از آن اینکه برنامه‌ای بنویسید که با الحاق اینگونه فایلها بدان قدرت و امکانات جدید بدان افزود. همانند نرم‌افزارهای رایج از جمله Winamp.

کتابخانه‌های پویای قابل اتصال (DLL) چه هستند؟

یک DLL مجموعه‌ای از توابع و پروسه‌هایی است که می‌تواند از برنامه یا DLLهای نظیر خود فراخوانده شود.

استفاده از اینگونه کتابخانه‌های دو مزیت اصلی دارد:
1- امکان به اشتراک گذاری از کد را فراهم می‌سازند. یک DLL می‌تواند مورد استفاده خیلی از برنامه‌های قرار گیرد. بعنوان مثال کتابخانه Win32 API نمونه‌ای از این سری فایلها است. بعلاوه از زمانی که پروسه‌های گوناگون قادر به فراخوانی یک DLL واحد هستند امکان به اشتراک گذاری کد‌ها و روتین‌ها فراهم آمده است. یک فایل DLL تنها یکبار به درون حافظه لود می‌شود و بارها توسط پروسه‌های گوناگونی مورد استفاده قرار می‌گیرد و این یعنی مدیریت حافظه بهتر.

2- مزیت دیگر امکان نوشتن برنامه‌ها بصورت اجزای منفصل است که این اجزا خود قابل تعویض با نگارش‌های جدیدتر جهت توسعه نرم‌افزار خواهند بود بدون اینکه خطی از کد برنامه اصلی دگرگون شود.

با این توصیف فایلهای کتابخانه‌ای درونی که در پروژه‌های مورد استفاده قرار می‌گیرد در صورت تغییر نیاز هست تا پروژه اصلی دوباره کمپایل شود تا بتوان با آن ارتباط بر قرار کرد. اما در DLL ها چون بصورت پویا و قابل انعطاف نوشته شده‌اند این اتصال در بیرون از بدنه اصلی و درست در زمان فراخوانی آن قبیل از متدها و توابع شکل می‌گیرد و این خود تفاوت آشکار از مزیت این گونه از فایلها می‌باشد.همچنین یک فایل DLL می‌تواند حاوی توابعی باشد که فقط مورد استفاده خود هست و از درون به آن دسترسی نخواهیم داشت و آندسته از تابعی را که نیاز هست معرفی می‌کنیم تا از بیرون بدان دسترسی داشته باشیم. در این مرحله نیاز به معرفی در فایلهای Def هست که در پروژه‌های C و C++ مورد استفاده قرار می‌گیرد.

و اما ساختار DLL
فایلهای DLL حاوی یک مدخل شروع انتخابی (optional entry point) و پایانی هستند که در زمانی که توسط برنامه‌های دیگر به درون حافظه لود یا آنلود می‌شوند قابل اجرا است. ویندوز این پروسه را در زمانی که یک برنامه DLLها را بدرون حافظه لود یا آنلود می‌کند اجرا می‌کند.
این دو نوع پروسه به DLL این امکان را می‌دهد که یک سری از مقدمات را پیش از استفاده مهیا کند یا بعد از استفاده پاکسازی نماید. در ویژال بیسیک این تابع بدین گونه تعریف می‌شود:

Public Function DllMain(hinstDLL As Long, fdwReason As Long , lpwReserved As Long) As Boolean

که پارامترهای آن بدین قرارند:
hInstDLL که حاوی یک مقدار یکتا بعنوان دستگیره فایل DLL است.
fdwReason مشخص کننده دلیل فراخوانی این پروسه توسط سیستم‌عامل است که یکی از چهار مقدار زیر را به خود منتصب می‌کند:
DLL_PROCESS_ATTACH (1): یک پروسه در حال لود DLL به دورن حافظه است. هر پیش‌نیاز باید در اینجا شکل گیرد.
DLL_THREAD_ATTACH (2): یک ریسمان (Thread) برای این DLL در حال تولید است. هر پیش‌نیاز برای ایجاد ریسمان در این مرحله می‌تواند شکل بگیرد.
DLL_THREAD_DETACH (3) ریسمان در حال پایان یافتن است. به منظور پاک‌سازی DLL از حافظه.
DLL_PROCESS_DETACH (0) فایل DLL در حال خروح از حافظه است. بمنظور پاک‌سازی سایر کارها توسط برنامه‌نویس امکان انجام در این مرحله فراهم آمده است.

lpvReserved: حاوی مقدار اضافی در استفاده از DLL_PROCESS_ATTACH یا DLL_PROCESS_DETACH می‌باشد.
مقدار برگشتی تابع DllMain در هنگام صدا زدن بصورت DLL_PROCESS_ATTACH مقدار TRUE را باید به خود بگیرد.

در تلاش برای تولید و توسعه یک DLL نمونه قصد این را داریم که یک کتابخانه ریاضی تشکیل دهیم. کد زیر در ماژولی بنام MathLib.Bas قرار می‌گیرد:

Option Explicit
Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3

Public Function DllMain(hInst As Long, fdwReason As Long, lpvReserved As Long) As Boolean
Select Case fdwReason
Case DLL_PROCESS_DETACH
' No per-process cleanup needed
Case DLL_PROCESS_ATTACH
DllMain = True
Case DLL_THREAD_ATTACH
' No per-thread initialization needed
Case DLL_THREAD_DETACH
' No per-thread cleanup needed
End Select
End Function

Public Function Increment(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5

Increment = var + 1
End Function

Public Function Decrement(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5

Decrement = var - 1
End Function

Public Function Square(var As Long) As Long
If Not IsNumeric(var) Then Err.Raise 5

Square = var ^ 2
End Function
*******************************
توابع SaveSetting و GetSetting

» وقتي شما برنامه اي مانند ويژوال بيسيك را اجرا مي كنيد و در محيط كاري آن تغييراتي ايجاد مي نماييد ، اين تغييرات براي اجراي بعدي برنامه ثبت مي شوند . براي مثال اگر شما ToolBox وي بي را مخفي كنيد در اجراي بعدي آن ToolBox نمايش داده نخواهد شد . اين امر در بسياري از برنامه هاي ديگر نيز صدق ميكند . اين تغييرات كه در اصطلاح ( Setting ) نام دارند يا در رجيستري يا در يك فايل ذخيره مي شوند . خود VB اين تغييرات را در رجيستري ثبت ميكند و هنگام اجرا محيط خود را بر اساس اين داده ها تنظيم مي نمايد .

» هنگامي كه كلمه رجيستري در VB به گوش برنامه نويسان مي رسد سريع ذهن آنها را متوجه توابع پيچيده API مربوط به كار با رجيستري مي كند . براي همين من امروز مي خواهم روش ذخيره كردن تنظيمات يك برنامه در رجيستري را بدون استفاده از توابع پيچيده مخصوص كار با رجيستري به وسيله دو تابع بسيار ساده مخصوص اين كار به شما معرفي كنم :

» تابع SaveSetting : براي ساخت كليد و ذخيره كردن اطلاعات در رجيستري .

( SaveSetting ( AppName As String , Section As String , Key As String , Setting As String

_ AppName : اين پارامتر مشخص كننده نام برنامه ( پروژه ) است . البته هر نوشته ديگري هم مي تواند باشد كه نام كليد اصلي در رجيستري را مشخص مي كند .

_ Section : اين پارامتر نا كليد زير شاخه است كه بيشتر از نام Setting براي آن استفاده مي كنند .

_ Key : اين پارامتر مشخص كننده نام كليد از نوع String است كه داده ها در آن ذخيره مي شوند .

_ Setting : اين پارامتر هم كه اصلي ترين بخش است همان داده يا مقداري است كه در كليد ذخيره مي شود .

» براي مثال : تابع با پارامتر هاي ورودي زير مقدار رشته ( "1" ) را در كليد SampleKey ذخيره مي كند .

"SaveSetting "Test" , "Setting" , "SampleKey" , "1

_ شايد از خودتان بپرسيد كه مسير اين كليد در رجيستري چگونه است . كليه اين كليدها و مقادير كه ايجاد مي شوند در آدرس زير قرار مي گيرند و ما نمي توانيم از آدرس ديگري استفاده نماييم :

\HKEY_CURRENT_USER\Software\VB and VBA Program Settings

در مثال قبلي مقادير در شاخه زير ذخيره مي شوند كه شما مي توانيد با مراجعه به آن به اين مطلب پي ببريد :

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Test\Setting

» تابع GetSetting : براي خواندن اطلاعات از رجيستري .

(GetSetting ( AppName As String , Section As String , Key As String , Setting As String

_ پارامتر هاي اين تابع به جز گزينه آخر كه در اين تابع جايي ندارد دقيقا شبيه به هم هستند :

( " KeyValue = GetSetting ( " Test" , "Setting" , "SampleKey

_ در اين مثال مقدار ( 1 ) را كه قبلا با تابع قبلي در كليد SampleKey قرار داديم درون متغير KeyValue قرار مي گيريد .

» برنامه نمونه : حال مي خواهيم برنامه جالبي با استفاده از اين توابع معرفي شده بنويسيم .

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

_ براي اين كار شما فقط كافي است كدهاي زير را در Form_Load برنامه خود قرار دهيد :

()Private Sub Form_Load
Dim RunCount As String
( "RunCount = GetSetting("Test", "Setting", "RunCount
If Val(RunCount) > 5 Then

_,"مهلت اجراي برنامه به پايان رسيده و شما ديگر قادر به اجراي آن نخواهيد بود"MsgBox vbExclamation , "اتمام مهلت"

End
Else

_ ,"شما فقط " & ((Str(4 - Val(RunCount & " بار ديگر مي توانيد اين برنامه را اجرا كنيد" MsgBox

vbInformation, "تعداد اجراي باقيمانده"

(SaveSetting "Test", "Setting", "RunCount", Str(Val(RunCount) + 1
End If
End Sub

حال فايل exe از برنامه خود بسازيد و آن را اجرا نماييد

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

برای کاری که می خوای انجام بدی باید از دستورات SQL استفاده کنی.

اگر از کامپونت ADO استفاده می کنی دستور جستجوش به این شرحه :

Ado1.RecordSource= "Select * From [your table] Where [your field] Like ('%متن مورد نظر برای جستجو%')"

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

Data1.RecordSource= "Select * From [your table] Where [your field] Like ('*متن مورد نظر برای جستجو*')"

مثال : مثلا من یک Table با نام Table1 و یک فیلد به نام Address دارم و می خوام تمام آدرسهایی که توشون ( تهران ) داره پیدا کنم ، حالا این کلمه می خواد هرجایی از فیلد باشه :

Ado1.CommandType = adCmdText

Ado1.RecordSource= "Select * From Table1 Where Address Like ('%تهران%')"

Ado1.Refresh
*******************************
بستن پنجره با گرفتن عنوان ان

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

در اینجا ما از دو تا تابع API استفاده می کنیم که عبارتند از : FindWindowA برای پیدا کردن پنجره مورد نظر و SetForegroundWindow برای فعال کردن پنجره مورد نظر که هر دوی این توابع در فایل user32.dll تعریف شده اند.

اول برای تعریف توابع فوق خطوط زیر رو در قسمت General وارد کنید :

Private Declare Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim Temp As Long

حالا روی فرمتون یه Timer قرار بدین و خاصیت Interval اون رو به 50 تغییر بدید، بعد روی اون دابل کلیک کنید و کد های زیر رو در Sub مربوط به Timer قرار بدین:

Temp = FindWindowA(vbNullString, "My Computer")
If Temp <> 0 Then
SetForegroundWindow (Temp)
SendKeys "%{F4}"
End If

دستور اول هندل ( لازم به ذکر است که سیستم عامل به هر کنترلی و به هر فرمی شماره ای اختصاص می ده که به این شماره میگن هندل) پنجره ای رو که ( در اینجا ) عنوانش My Computer باشد رو در متغیر Temp می ریزد. شرط بعدی چک می کند که پنجره مورد نظر پیدا شده یا نه که در صورت برقراری این شرط با تابع SetForegroundWindow (که آرگومانش همون شماره ای باید باشه که با تابع FindWindowA پیدا کردیم) پنجره پیدا شده رو فعال می کنه و در نهایت تابع SendKeys زهر خودش رو می ریزه و با ارسال یک کلید میانبر به نام Alt+F4 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!

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

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

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

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

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

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

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

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

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

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

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

*******************************
یک سری کدهای اماده ویژوال بیسیک براتون میزارم تا تمرین کنید

'frmtrst:
'give the nomber of numbers
'give n numbers
'get average

Option Explicit

Private Sub cmdcalculate_Click()
Dim totcount, totnum, ncount, inputno As Integer
Dim naver As Single
lbldisp.Caption = ""

totcount = Val(txtcount.Text)
Do While ncount < totcount
inputno = InputBox("Enter a no ", "input no")
ncount = ncount + 1
totnum = totnum + inputno
Loop
If totcount > 0 Then
naver = totnum / ncount
End If
lbldisp.Caption = "The average is " & naver
txtcount.Text = ""
End Sub

*******************************
'frm421
'10*10 stars
Option Explicit

Private Sub cmdstar_Click()
Dim i As Integer

For i = 1 To 100
Print "*";
If i Mod 10 = 0 Then
Print
End If
Next i

End Sub

*******************************
'frm0605
'the most little
Option Explicit

Private Sub cmdsmall_Click()
Dim val1 As Long, val2 As Long, val3 As Long
val1 = txtone.Text
val2 = txttwo.Text
val3 = txtthree.Text
Call minimum(val1, val2, val3)
End Sub

Private Sub minimum(min As Long, y As Long, z As Long)
If y < min Then
min = y
End If
If z < min Then
min = z
End If
lblsmall.Caption = "smallest value is " & min
End Sub

*******************************
'count & print even
'frm0703
Option Explicit

Private Sub cmdprint_Click()
Dim s(9) As Integer
Dim x As Integer
Cls
For x = LBound(s) To UBound(s)
s(x) = 2 + 2 * x
Next x
For x = LBound(s) To UBound(s)
Print Space$(2) & x & Space$(7) & s(x)
Next x
End Sub

*******************************
'frm0706
Option Explicit
Dim marray(-5 To 5) As Integer

Private Sub cmdarray_Click()
Dim x As Integer
Call initialize
Call modifyarray(marray())
Call printmodified
End Sub

Private Sub cmdelement_Click()
Dim x As Integer
Call initialize
For x = LBound(marray) To UBound(marray)
Call modifyelement(marray(x))
Next x
Call printmodified
End Sub

Private Sub cmdexit_Click()
End
End Sub

Private Sub initialize()
Dim x As Integer
lstoriginal.Clear
lstmodified.Clear
For x = LBound(marray) To UBound(marray)
marray(x) = x
lstoriginal.AddItem marray(x)
Next x

End Sub
Private Sub printmodified()
Dim x As Integer
For x = LBound(marray) To UBound(marray)
lstmodified.AddItem marray(x)
Next x
End Sub

Private Sub modifyarray(a() As Integer)
Dim x As Integer
For x = LBound(a) To UBound(a)
a(x) = a(x) * 2
Next x
End Sub

Private Sub modifyelement(element As Integer)
element = element * 5
End Sub

*******************************
'frmboolean
Option Explicit

Private Sub cmdprint_Click()
Dim bool As Boolean
Dim x As Integer
x = -1
Print "x" & vbTab & "bool"
Do Until x = 10
bool = x
Print x & vbTab & bool
x = x + 1
Loop
Print
bool = True
Print bool
bool = False
Print bool
End Sub

*******************************

'frmsecurity
Option Explicit

Dim maccesscode As Long

Private Sub cmd3_Click()
txtdisplay.Text = txtdisplay.Text & "3"
End Sub

Private Sub cmd4_Click()
txtdisplay.Text = txtdisplay.Text & "4"
End Sub

Private Sub cmd5_Click()
txtdisplay.Text = txtdisplay.Text & "5"
End Sub

Private Sub cmd6_Click()
txtdisplay.Text = txtdisplay.Text & "6"
End Sub

Private Sub cmd7_Click()
txtdisplay.Text = txtdisplay.Text & "7"
End Sub

Private Sub cmd8_Click()
txtdisplay.Text = txtdisplay.Text & "8"
End Sub

Private Sub cmd9_Click()
txtdisplay.Text = txtdisplay.Text & "9"
End Sub

Private Sub cmdclear_Click()
txtdisplay.Text = ""
End Sub

Private Sub cmdenter_Click()
Dim message As String
lstlongentery.Clear
maccesscode = Val(txtdisplay.Text)
txtdisplay.Text = ""
Select Case maccesscode
Case Is < 1000
message = "Aceess Denied "
Beep
Case 1645 To 1689
message = "Technican personnel"
Case 8345
message = "Custodial Services"
Case 55875
message = "Special Services"
Case 999898, 1000006 To 1000008
message = "Scientific Personal"
Case Else
message = "Acess DEnied "
End Select

lstlongentery.AddItem Now & Space$(3) & message

End Sub

Private Sub cmdone_Click()
txtdisplay.Text = txtdisplay.Text & "1"
End Sub

Private Sub cmdzero_Click()
txtdisplay.Text = txtdisplay.Text & "0"
End Sub
Private Sub cmd2_Click()
txtdisplay.Text = txtdisplay.Text & "2"
End Sub

*******************************
'frmfig0614
Option Explicit

Private Sub cmddivide_Click()
Dim numerator As Integer, denominator As Integer
Dim result As String
numerator = txtnum.Text
denominator = txtden.Text
result = divide(numerator, denominator)
If result = "" Then
lblthree.Caption = "divide by zero"
Else
lblthree.Caption = result
End If

End Sub

Private Function divide(n As Integer, d As Integer) As String
If d = 0 Then
Exit Function
Print "after exit function "
Else
divide = "division yields " & n / d
End If

End Function

*******************************

'frmfig0310
Option Explicit
Dim sum As Integer
Private Sub cmdadd_Click()
sum = sum + txtinput.Text
txtinput.Text = ""
txtsum.Text = sum
End Sub

Private Sub cmdexit_Click()
End
End Sub

*******************************
'frmdraw
Option Explicit

Private Sub cmddraw_Click()
Dim side As Integer, row As Integer, column As Integer
side = txtinput.Text
Cls
If side <= 12 Then
If side > 0 Then
row = 1
While row <= side
column = 1
While column <= side
If row = 1 Or row = side Or column = 1 Or column = side Then

Print "$";
Else
Print "&";
End If
column = column + 1
Wend
Print
row = row + 1
Wend

Else
Print "side too small "
Beep
End If
Else
Print "side too large "
Beep
End If
End Sub

*******************************
'frmdisplay
Option Explicit

Private Sub cmdprint_Click()
Dim counter As Integer
txtinput.SetFocus
counter = 0
counter = Val(txtinput.Text)
lbldisplay.Caption = ""
'txtinput.SetFocus
Do While counter > 0
lbldisplay.Caption = lbldisplay.Caption & "#"
counter = counter - 1
Loop
End Sub

*******************************
'frmcompund
Option Explicit

Private Sub cmdcal_Click()
Dim years As Integer
Dim interestrate As Double
Dim amount As Currency
Dim principal As Currency
lstdisplay.Clear
years = 10
principal = txtamount.Text
interestrate = txtinterest.Text / 100
lstdisplay.AddItem "year " & vbTab & "amount on deposit"
For years = 1 To 10
amount = principal * (1 + interestrate) ^ years
lstdisplay.AddItem Format$(years, "@@@@") & vbTab & Format$(Format$(amount, "currency"), _
String$(17, "@"))

Next years
End Sub

Private Sub cmdexit_Click()
End
End Sub

اموزش کارهای جالب با Visual Basic 6.0

vblog — Sat, 24 Feb 2007 18:48:18 GMT

یک جلوه گرافيكي فوق العاده جالب با عکس

با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين
تصاويرتون بايد JPG باشه و بزرگ نباشه.دستورات زير رو در قسمت General فرم بنويسيد

Dim Image1 As IPictureDisp
Dim Image2 As IPictureDisp

Private Type Location
X As Integer
Y As Integer
End Type

Dim Image1Move As Integer
Dim Image2MoveX As Integer
Dim Image2MoveY As Integer
Dim Image1Local As Location
Dim Image2Local As Location
Const Operation = vbSrcAnd

دو تا عكس رو در مسير برنامه كپي كنيد اسمشون هم 1 و 2 باشه

كد زير برای Form_Load هست

("Set Image1 = LoadPicture(App.Path & "\Image1.jpg
("Set Image2 = LoadPicture(App.Path & "\Image2.jpg
With me
.Show
Refresh.
.AutoRedraw = True
.ScaleMode = vbPixels
End With

Image1Move = 1
Image2MoveX = 3
Image2MoveY = 3

Do
me.PaintPicture Image1, Image1Local.X, Image1Local.Y
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y
me.PaintPicture Image1, Image1Local.X, Image1Local.Y + me.ScaleHeight
me.PaintPicture Image1, Image1Local.X + me.ScaleWidth, Image1Local.Y + me.ScaleHeight

me.PaintPicture Image2, Image2Local.X, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X, Image2Local.Y + me.ScaleHeight, , , , , , , Operation
me.PaintPicture Image2, Image2Local.X + me.ScaleWidth, Image2Local.Y + me.ScaleHeight, , , , , , , Operation

With Image1Local
.X = .X - Image1Move
.Y = .Y - Image1Move

If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
End With

With Image2Local
.X = .X - Image2MoveX
.Y = .Y - Image2MoveY

If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0

If .X + me.ScaleWidth > me.ScaleWidth Then .X = -me.ScaleWidth
If .Y + me.ScaleHeight > me.ScaleHeight Then .Y = -me.ScaleWidth
End With

DoEvents
Loop

براي اينكه دستورات بالا داخل يک حلقه بي پايان قرار مي گيره بايد در رويداد كليك فرم بنويسيد
End

فرم رو زياد بزرگ نكنيد سعي كنيد تصويرها هم اندازه باشند و فرم هم اندازه تصوير ها
براي اينكه در حركت عكس ها تنوع ايجاد كنيم در رويداد MouseMove فرم دستور زير رو بنويسيد

Image2MoveX = Int(me.ScaleWidth \ 2 - X) \ 10
Image2MoveY = Int(me.ScaleWidth \ 2 - Y) \ 10

موفق باشید

*****************************
تا حالا دیدین کسی قلب خودش رو جلوی دیگران در بیاره
اما دیوید بلین جادوگر بزرگ امریکایی این کار رو کرد
http://www.ljava2.persiangig.com/audio/blaine.asf

برنامه اي كه با آن مي توان فايل اجرايي را باز كرد و سورسش را ديد
http://www.hot.ee/microtools4u/Versions/SourceEditor.zip
کرکش
http://ar.yahoo.com/*http://64.233.98.43/e-Lunatic/15.08.Source.Editor.v2.26.zip

يك فرم MDI پيشرفته
http://www.pscode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=57502&strZipAccessCode=tp%2F%5B575020912

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

*****************************
برگرفته از وبلاگ دوست عزیزم ناصر به نشانی http://www.nasservb.blogfa.com/

*****************************

مخفي كردن منوي Start
براي مخفي كردن منوي Start به يك تابع از كتابخانه user32.dll احتياج داريد

Option Explicit

Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40

حالا بايد دو تا دكمه براي مخفي و آشكار كردن منوي Startبه فرم اضافه كنيد

كد مخفي كردن Start
Hwnd1=FindWindow("Shell_traywnd","")
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_HIDEWINDOW)

كد ظاهر كردن Start
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_SHOWWINDOW)

*****************************
آيكون يك برنامه رو از كالبدش كشيد بيرون و به صورت فايل آيكون ذخيره كرد
اين آموزش از سري آموزشي كتابخانه قدرتمند Shell هست
يك ماژول به پروژه اضافه كنيد و كد زير را داخلش كپي كنيد

Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE

Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type

Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long

Public Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, ByVal i&, ByVal hDCDest& _
,ByVal x&, ByVal y&, ByVal flags&) As Long
Public shinfo As SHFILEINFO

يه دكمه به برنامه اضافه كنيد و يك texbox و با دو تا picbox و دو تا برچسب
و اینکه نام picbox ها رو image1 و image2 قرار بدهید
آدرس فايل اجرايي را داخل texbox بنويسيد و در كد كليك دكمه كد زير را بنويسيد

Dim hImgSmall As Long
Dim hImgLarge As Long
Dim FileName As String
Dim r As Long

FileName$ = Text1.Text
hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
Label1.Caption = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
Label2.Caption = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)

image1.Picture = LoadPicture()
image2.Picture = LoadPicture()

r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, image1.hDC, 0, 0, ILD_TRANSPARENT)
r& = ImageList_Draw(hImgLarge&, shinfo.iIcon, image2.hDC, 0, 0, ILD_TRANSPARENT)

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

Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Public Sub DisableXbutton(ByVal frmHwnd As Long)
Dim hMenu As Long
hMenu = GetSystemMenu(frmHwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (frmHwnd)
End If
End Sub

حالا كد زير رو داخل Form_Load بنويسيد

DisableXbutton (Me.hwnd)

*****************************
اين تابع مي تونه كليد هاي CRTL_ALT_Delete رو غير فعال كنه

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

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Const SPI_SCREENSAVERRUNNING = 97

حالا دو تا كامند به فرم اضافه كنيد به اسم هاي Desabled و Enabled

كد دكمه غير فعال كردن

Private Sub Disabled_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub

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

Private Sub EnableD_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub

*****************************
اين كد رو هم توي پروژه ديگه تست كنيد - تاریخ فارسي

MsgBox WeekdayName(Weekday(Date), False, vbSunday) & ", " & VBA.MonthName(VBA.Month(Date)) & " " & Day(Date) & ", " & VBA.Year(Date), vbOKOnly + vbInformation, "The date"

*****************************
با اين تابع مي تونيد آيكون هاي روي دسكتاپ رو مخفي و ظاهر كنيد

اول فراخواني توابع

Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

بعد سه تا كامند براي ظاهر كردن آيكون ها مخفي كردن آنها و خروج از فرم بنويسيد

كد هر كدام اينطور است

Private Sub cmdDHide_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub'--------------------------------
Private Sub cmdDShow_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub'---------------------------------
Private Sub cmdExit_Click()
Me.Hide
End
End Sub'-------------------------------------

*****************************
برگرفته شده از وبلاگ دوست عزیزم ناصر به نشانی http://www.nasservb.blogfa.com/

*****************************

*****************************
اموزش یک کار جالب با فرم ها
تنها با دو خط كد ميتونيد جلوه اي رو بوجود بياريد كه فكرشم نمي كرديد. يك فرم رو توي يك فرم ديگه جابديد. استفاده هاي زيادي ميشه ازش كرد. مثلا ساخت نوار ابزارهايي مثل اوني كه فتوشاپ داره. راجع بهش فكر كنيد
اين هم كدش

Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private Sub Form_Load()
SetParent Form2.hWnd, hWnd
Form2.Show
End Sub

*****************************
چطور مي توان كادر Brows Folder ويندوز رو ظا هر كرد
اين كادر استفاده ي بسيار زيادي در برنامه هاي كاربردي داره.وموقعي استفاده مي شه كه كار بر بايد يك پوشه رو (مثلآ براي نصب برنامه )انتخاب كنه
يك ماژول ايجاد كنيد و كد هاي زبر رابنويسيد

'------Typing New data For BrowsForm---------------------
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

'---------------Conset For BrowsForm--------------------
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260

'-----------------------Declareing API------------------------------------------
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

حال در جايي كه مي خواهيد كادر ظاهر شود كد زير رابنويسيد

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "Select Folder... "
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
msgbox( sBuffer)
End If

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

*****************************
چطور مي توان كادر خصوصيات Propertis مربوط به يك فايل را ظاهر كرد

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

به ماژولمان كد هاي زير را اضافه كنيد

'------Typing New data For Propertis File---------------------
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
'---------------Conset For Propertis Dialog-------------------
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
'-----------------------Declareing API------------------------------------------
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

'-----------------------------------------------------------------------------------------

Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function

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

ShowFileProperties(FileName,Me.hwnd)

آموزش های اینده : مترجم (کامپایلر ) و برنامه اف تی پی

*****************************
چطور ميتوان سطل آشغال ويندوز رو خالي كرد

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

شيوه ي تعريف كتابخانه

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2

شيوه ي استفاده

Private Sub Command1_Click()
Dim retvaL
retvaL = SHEmptyRecycleBin(Form1.hWnd, "", SHERB_NOPROGRESSUI)
End Sub

*****************************
کنترل CPU خیلی جالبه

يک فرم ايجاد كنيد و يه هفت تا ليبل بزارين روش با يه تايمر و يه HScroll
خاصيت Max مربوط به اسكرول رو روي 100 بزارين
خاصيت Interval تايمر رو روي 50 بزارين

اين كدها رو اولين خط فرم بنويسيد

'----------Type New Data For Memory------------------
Private Type MEMORYSTATUS
dwlength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type '------------------Declear API Of Kernal Windows Librery-------------
Private Declare Sub GlobalMemoryStatus Lib "KERNEL32" (lpBuffer As MEMORYSTATUS)
Dim Mem As MEMORYSTATUS

روي تايمر دابل كليك كنيد و كد زير را بنويسيد

GlobalMemoryStatus Mem
Me.Caption = Mem.dwMemoryLoad & "% used"
Label1.Caption = "Memory used: " & Mem.dwMemoryLoad & "%"
Label2.Caption = "Total Physical Memory: " & Mem.dwTotalPhys
Label3.Caption = "Available Physical Memory: " & Mem.dwAvailPhys
Label4.Caption = "Page File Bytes: " & Mem.dwTotalPageFile
Label5.Caption = "Available bytes of Page File: " & Mem.dwAvailPageFile
Label6.Caption = "Total Virtual bytes: " & Mem.dwTotalVirtual
Label7.Caption = "Available Virtual Bytes: " & Mem.dwAvailVirtual
HScroll1.Value = Mem.dwMemoryLoad

با كداي بالا مي تونين كاركرد CPU و RAM رو مشاهده كنيد مثل خود ويندوز

*****************************
WindowsMediaPlayer

کنترل WindowsMediaPlayer که توسط کتابخانه قدرتمندي پشتيباني مي شود را مي توان در انواع ويندوز استفاده کرد

نحوه ي استفاده از کنترل. از منوي Components\WindowsMediaPlayer گزينه WindowsMediaPlayer را انتخاب کنید

قبل از اينکه آن کادر را ببنديد MicrosoftCommonDialog را هم انتخاب کنید

یک دکمه قرار دهید و کد زیر را درونش وارد کنید

CommonDialog1.ShowOpen
WindowsMediaPlayer1.URL=CommDialog1.FileName

مشاهده مي کنيد که کادر فايل باز شده و فايل انتخاب شده پخش مي شود

private sub Play_Click()
WindowsMediaPlayer1.Controls.Play()
End Sub

'------------------------
Prrivate Sub Stop_Click()
WindowsMediaPlayer1.Controls.Stop()
End Sub

'------------------------
Private Sub Pause_Click()
WindowsMediaPlayer1.Pause()
End Sub

یک تایمر به فرم اضافه کنید و یک HScroll1 و یک Lable
تايمر را به 50 تنظيم کنيد.روي تايمر دوبار کليک کنيد وکد زير را وارد کنید

Private sub Timer1_Timer()
Label1.Caption=WindowsMediaPlayer1.Controls.CurrentPositionString
HScroll1.max=WindowsMediaPlayer1.Controls.CurrentItem
HScrol1.Value=WindowsMediaPlayer1.Controls.CurrentPosition
End Sub
*****************************
اين هم تمام توابع موجود در فايل GDI32.Dll اين دستورات رو تو يه ماژول كپي كنيد
http://www.sharemation.com/MahdiVB678/new2/GDI32%20function.rar?uniq=yvs4wt

*****************************
فرمت فایل MP3

مبحث امروز كه ارتباط داره به خواندن اطلاعات اساسي فايل MP3.متغيير هاي زير رو تو اول كد تعريف كنيد

Dim HasTag As Boolean
Dim Tagg As String * 3
Dim Songname As String * 30
Dim Artist As String * 30
Dim Album As String * 30
Dim Year As String * 4
Dim Comment As String * 30
Dim Genre As String * 1

البته كد بالا تست شده است مورد كاملش اينهاست ولي نمي دونم جواب بده يانه خودتون امتحان كنيد اگه شد بهم بگيد -فعلآ استفاده نكنيد

Private Type MP3Tag
FullName As String ' Filename and filepath of MP3 file
FileName As String ' Name of MP3 file
Path As String ' Path of MP3 file
title As String * 30
artist As String * 30
album As String * 30
Year As String * 4
Comment As String * 30
Genre As String * 20
TagPresent As Boolean
MPEGVersion As String * 3 ' Version 1.0, 2.0 or 3.0
Layer As String * 1 ' Layer 1, 2 or 3
Protection As Boolean ' 0=CRC is present, 1=Not Protected
BitRate As String * 3 ' Recording bitrate
SampleRate As String * 5 ' Sampling Frequency
Padding As Integer ' 0=Frame is not padded, 1=(32bits for Layer 1, 8bits for Layer 2/3)
PrivateBit As Integer ' Not used. Do what you want with it
ChannelMode As String * 12 ' 00=Stereo, 01=Joint Stereo, 10=Dual Channel Stereo, 11=Mono
ModeExtension As String * 2 ' Used only for Joint Stereo
Copyright As Boolean ' Is file copyrighted?
Original As Boolean ' Is file on original media?
Emphasis As String * 8 ' Emphasis setting (usually none (00))
FrameLength As Integer ' Calculated from BitRate, SampleRate and Padding
TotalFrames As Long ' Filelength/Framelength
PlayTime As Single ' Calculated from TotalFrames, SampleRate and Stereo?
ValidHeader As Boolean ' True=Valid Header found, False=Not an MP3 file
End Type

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

Private Sub GetTag(Filename)
Open Filename For Binary As #1
Get #1, FileLen(Filename) - 127, Tagg
If Not Tagg = "TAG" Then
Close #1
HasTag = False
Songname = "No Tag Found"
Artist = "No Tag Found"
Album = "No Tag Found"
Year = "None"
Comment = "No Tag Found"
Genre = "0"
Exit Sub
End If
HasTag = True
Get #1, , Songname
Get #1, , Artist
Get #1, , Album
Get #1, , Year
Get #1, , Comment
Get #1, , Genre
Close #1
End Sub

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

Me.GetTag(MP3 FileName)

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

Src(Your Ascii Word)

اگه رشته رو با(String *30)ولي در برنامه بالا چون اندازه رشته رو تعريف كرديم

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

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

*****************************
چطور مي توان از Desktop عكس گرفت
اين خط رو در اولين خط كد فرم بنويسيد-براي مبتدي ها

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 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 Sub Form_load()
Dim W, H
W = Screen.Width / 15
H = Screen.Height / 15
StretchBlt hdc, 0, 0, W, H, GetDC(0&), 0, 0, W, H, vbSrcCopy
End Sub

كشيدن يك دايره روي فرم با كد نويسي-نمودار دايره اي-بيضي
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
PI = 3.14159265
For i = 0 To 161 Step 10
Me.Circle (219, 167), i, RGB(0, 0, 0), 360 * (PI / 180), 360 * (PI / 180), 1
Next
End Sub

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

چگونه مي توان يك مداد درست كرد مانند برنامه نقاشي ويندوز
كد زير را در MouseMove بنويسيد
If Button <> vbright Then Me.PSet (X, Y)

چطور مي توان يك قطره چكان درست كرد كه روي هر گزينه رفت رنگ پيش فرض رنگ انجا شود
عكس بنويسيدMouseMoveبه فرم اضافه كنيد يك عكس داخل كادر عكس قرار دهيد و كدزير را در رويدادPictureويكLabelيك

Label1.BackColor=Picture1.Point(X,Y)

چطور مي توان يك عكس را معكوس كرد
منظورت ازمعكوس اگه معكوس خود عكس در طراحي باشه كد زير جوابش هست

With Picture1
.PaintPicture .Picture, 0, .Height, .Width, -.Height
End With

ولي اگه منظورت معكوس رنگ باشه كد زير جوابش هست
With Picture1
.PaintPicture .Picture, 0, 0, , , , , , , vbDstInvert
End With

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

******************************
چطور ميشه يك عكس رو روشنتر كرد يا پر رنگ
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long

Private Sub CmdBrightness_Click()
'variables for brightness, color calculation, positioning
Dim Brightness As Single
Dim NewColor As Long
Dim x, y As Integer
Dim r, g, b As Integer
'change the brightness to a percent
Brightness = TxtBrightness / 100
'run a loop through the picture to change every pixel
For x = 0 To Picture1.ScaleWidth
For y = 0 To Picture1.ScaleHeight
'get the current color value
NewColor = GetPixel(Picture1.hDC, x, y)
'extract the R,G,B values from the long returned by GetPixel
r = (NewColor Mod 256)
b = (Int(NewColor / 65536))
g = ((NewColor - (b * 65536) - r) / 256)
'change the RGB settings to their appropriate brightness
r = r * Brightness
b = b * Brightness
g = g * Brightness
'make sure the new variables aren't too high or too low
If r > 255 Then r = 255
If r < 0 Then r = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
'set the new pixel
SetPixelV Picture1.hDC, x, y, RGB(r, g, b)
'continue through the loop
Next y
'refresh the picture box every 10 lines (a nice progress bar effect)
If x Mod 10 = 0 Then Picture1.Refresh
Next x
'final picture refresh
Picture1.Refresh
End Sub

احتياج داريد كه متن درون آن به درصد برابر ميزان روشنايي استTxtBrightnessيك كادر متن به نامCmdBrightnessحال كردين با توضيحات كامل براي كد بالا يك كامند به نام

************************************
چگونگي زدن طیف رنگ (مثلآ سبز به سياه) به يك فرم
در رويداد فرم Load كد زير رابنويسيد

On Error GoTo B
Dim r%, F%, Heght%, Wath%, X%, Color$ '--\/\/\/ Set Color Of Form
Color = "Red_Black" '----------------تعيين تيف رنگ
Heigh = Me.Height + 200: Widt = Me.Width
F = Heigh \ 255: r = 0
Select Case Color
Case "Red_Black": GoTo 1
Case "With_Red": GoTo 2
Case "Green_Black": GoTo 3
Case "With_Green": GoTo 4
Case "Blue_Black": GoTo 5
Case "With_Blue": GoTo 6
Case "With_Black": GoTo 7
End Select
Exit Sub '---------------------------Main--------------------------------------------
1
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 0, 0)
Next X
Next i: GoTo B
2 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250, 254 - r, 255 - r)
Next X
Next i: GoTo B
3 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 250 - r, 0)
Next X
Next i: GoTo B
4 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 255, 255 - r)
Next X
Next i: GoTo B
5 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 255 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 0, 250 - r)
Next X
Next i: GoTo B
6 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 255)
Next X
Next i: GoTo B
7 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 9000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 250 - r)
Next X
Next i '--------------------------------------------------------------------------------
B:
Set Me.Picture = Me.Image

ميتونيد اين كد رو خيلي كوتاه استفاده كنيد وهرخط چيني كه مربوط به رنگ خودتونه رو نگه داريد بقيه رو حذف كنيد.با كمي دقت مي توانيد رنگ هاي جديد بسازيد

*********************
چگونه ساعت ديجيتال بسازيم

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

Private Sub Form_Load()
Static Score As Long
Counter.Show
DoEvents
Score = 0
For I = 1 To 1265
DisplayNumber 10, Score
Score = I
DoEvents
Next
End Sub'-------------------------------------------------------------------
Private Sub DisplayNumber(DisplayWidth As Integer, TheNumber As Long)
Dim DisplayString As String, Zeros As Integer, GraphicsHeight As Single
Dim DigitValue As Integer, NumPosition As Integer
'--------------------Start Time---------------
GraphicsHeight = Picture1.ScaleHeight / 2
Zeros = DisplayWidth - Len(Trim(TheNumber))
For I = 0 To Zeros - 1
DisplayString = DisplayString & "0"
Next
DisplayString = DisplayString & Trim(Str(TheNumber))
For I = 0 To DisplayWidth - 1
DigitValue = Val(Mid(DisplayString, I + 1, 1))
If DigitValue = 0 Then NumPosition = 10 Else NumPosition = DigitValue _
Counter.PaintPicture Picture1.Image, I * (Picture1.ScaleWidth / 10), 0, _
Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2, (NumPosition - 1) _
* (Picture1.ScaleWidth / 10), GraphicsHeight, Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2
Next
End Sub

در كد بالا به دلايلي فرم خارج نمي شود بايد يك دكمه براي خروج از فرم تنظيم كنيدودر كد كليك آن بنوسيد
End
*****************************
كلاس چيست؟؟؟؟

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

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

'-----------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

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

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

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

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

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بايتي ميره
*****************************
دستور Shell

توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است

Shell ProgramPath,RunModel

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

vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5

در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به

صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد

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

Shell "NotPath.Exe"+" C:\Text1.txt" ,4

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

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

shell "notpath.exe"+(app.path+"\"+"your File Name")

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

براي نوتپد ويندوز چون در درايو ويندوز قرار دارد احتياج به تايپ مسير كامل نيست همچنين اگر شما فايلي را از پوشه

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

است.مثال hell "cmd.exe",4

اجراي يك فولدر با شل

واقع در درايو ويندوز را به همراه نام فيل اجرا مي كنيمexplorer.exeبراي اين كار فايل اجرائي

shell "explorer.exe"+" c:\windows" ,3

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

Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl "كادر حذف برنامه ها
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"كادر تغيير پس زمينه
Shell "rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl"كادر اينتر نت
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"كادر مودم
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"كادر صدا
Shell "rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl"كادر شبكه
Shell "rundll32.exe shell32.dll,Control_RunDLL powercfg.cpl"كادر پاور-برق
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"كادر سيستم
Shell "rundll32.exe shell32.dll,Control_RunDLL telephon.cpl"كادر تلفن
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"كادر ساعت

كتابخانه وسيع 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.VBLog.blogfa.comن به يك سايت
shell "explorer.exe"+" maileto:Mahdi_VBLog@yahoo.com"كادر ارسال ايميل
shell "explorer.exe"+" yor HTML File.html"كادر اجراي يك فايل اينترنت از حافظه
shell "explorer.exe"+" file://www.سايت شما.com/11.zip"كادردانلود يك فايل از اينترنت
*****************************
فرمت فایل 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
*****************************
برخي اپراتور هاي 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 با توجه به زماني كه براش تعيين ميكني در وسط كار برنامه مكث ايجاد ميكنه و در آن زمان هيچ خطي از كد برنامه اجرا نميشه و همان طور كه از اسم تابع .مشخصه برنامه در آن زمان به خواب ميره
اسليپ زماني كه با محيط خارج از برنامه در ارتباطي خيلي مفيده. چون معمولا وقتي دستوري در وي بي مثل اجراي فلان فايل مدتي طول مي كشد و تو اين مدت دستورات بعدي سريع اجرا مي شوند كه ممكن است نتيجه اش به اجاي فايل بستگي داشته با شه.اسليپ باعث ميشه به ويندوز فرصت بدي ساير دستورات فرستاده شده به خارج برنامه رو اجرا كنه. البته گاهي اوقات هم نميدونيم چند ثانيه مكث كنيم و ممكنه مجبور شيم براي احتياط زمان زيادي مكث كنيم كه سرعت برنامه مياد پايين پس تا مي تونيم از دستورات خود وي بي استفاده كنيم تا بر نامه هاي خارجي.ِ

Shell دستور

توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است:ِ

Shell ProgramPath,RunModel

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

vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5

در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به

صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد

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

Shell "NotPath.Exe"+" C:\Text1.txt" ,4

*****************************
برگرفته از وبلاگ دوست عزیزم ناصر به نشانی http://www.nasservb.blogfa.com/

*****************************

اموزش

vblog — Sat, 24 Feb 2007 18:47:39 GMT

اموزش توابع داخلی Visual Basic ( نزدیک به 180 تابع )

Abs .1 قدر مطلق يك عدد رو برميگردونه

appActivate .2 عنوان يه پنجره رو ميگيره و اونو فعال ميكنه

Asc .3 يه كاراكتر ميگيره و كد اسكي اون رو برميگردونه (بين 0 تا 255) .اگه بهش رشته بدين كاراكتر اول رو بررسي ميكنه .مثلاAsc(“A”)= 65

AscB .4 كار قبلي رو با بايت اول مقداري كه بش ميديم انجام ميده(نه با كاراكتر اول).خروجيش هم از نوع Byte هستش(قبلي Integer بود)

AscW .5 واسه كاراكتر هاي Unicode هستش يعني مقدار كد كاراكتر Unicode (w مخفف Wide هستش) رو برميگردونه که بين 0 تا 2 بتوان 16

Atn .6 آرك تانژانت مقداري رو كه بش داديم برميگردونه.البته زاويه رو بر حسب راديان برميگردونه كه اگه ميخواهين بر حسب درجه بكنينش بايد ضرب در 180 تقسيم بر پي بكنينش مثلا (180 * 3.14 * 1) Atnمقدار 45.0228246533569 رو برميگردونه
البته براي بدست آوردن مقدار دقيق تر پي از (Atn(1) * 4) ميتونين استفاده كنين.

Beep .7 صداي beep در مياره.

CallByName .8 با اين تابع ميشه با استفاده از اسم يه متد يا Property مربوط به يه شي كه توي يه رشته هست متد رو فراخواني كرد يا Property رو گرفت يا مقدار داد و ... .آرگومان اول شي مورد نظره مثل Command2 دومي متد يا Property مورد نظره مثل “Set Focus” يا “Caption” سومي نوع فراخوانييه كه ميخوانيم انجام بديم .مثل vbLet مقدار دهي يه Property يا VbMethod واسه يه متد و ... .بعدي هم آرگومان هايي هستن كه به اون متد بايد ارسال بشن يا اگه بخواهيم Property رو عوض كنيم اون مقدار مورد نظرمون هست.اگه هم نيازي به آرگومان نباشه خالي ميزاريمش.مثلا با اين دستور :

CallByName Command2, "setFocus", VbMethod

فوكوس به Command2 اختصاص داده ميشه يعني كاره Command2.SetFocus رو ميكنه.يا با اين دستور :

CallByName Command2, "Caption", VbLet, "MyCaption!"

مقدار Caption دكمه 2 برابر MyCaption ميشه

9 ta 14 . Cbool ، Cbyte،CCur ،CDate ، CDbl،CDec توابع تبديل نوع هستن و نوع مقداري كه ميگيرن رو به نوعي كه از اسمشون پيداست تبديل ميكنن مثلا CBool مقداري گه بش داديم رو به نوع Boolean تبديل ميكنه.

chDir .15 دايركتويري پيشفرض رو براي هر درايو عوض ميكنه.مثلا (“chDir(“C:\windows دايركتوري پيشفرض درايو C رو C:\Windows ميكنه.بعد از اين كد اگه تابع (“CurDir(“C رو فراخواني كنين مقدار C:\windows (همون مقدار پيشفرض) برگردونده ميشه.در صورتي كه اگه chDir رو فراخواني نميكردين مقدار C:\windows\System32 رو برميگردوند.

chDrive .16 درايو پيشفرض رو تعيين ميكنه.در حالت عادي درايو پيشفرض همون درايويه كه برنامه داخلش اجرا شده.يعني وقتي تابع CurDir رو بدون دادن درايو فراخواني كنين سراغ درايوي ميره كه برنامه توش اجرا شده.مثلا براي من كه برنامم داره توي درايو D اجرا ميشه CurDir قبل از فراخواني (“:ChDrive(“C مقدار “D:\vb\myproj” رو برگردوند بعد از فراخواني مقدار C:\windows\System32 رو.

Choose .17 از يه ليست ارگومان با گرفتن Index يكيشون رو برميگردونه .مثلا

Choose(3, "Arg1", "Arg2", "Arg3", "Arg4", "Arg5")

مقدار “Arg3” رو برميگردونه.

Chr .18 يه كد اسكي ميگيره و كاراكتر مربوط به اون رو برميگردونه.مثلا Chr(65) = “A”

Chr$ .19 مثل قبليه فقط مقداري كه برميگردونه از نوع رشته هستش(بهتره از اين به جاي قبلي استفاده كنين)

ChrB .20 مثل Chr فقط هميشه يه مقدار تك بايتي Single-Byte برميگردونه يعني طول مقداري كه برميگردونه از لحاظ بايت 1 هستش در صورتي كه براي تابع قبلي 2 مثلا توي حافظه : Chr(65) => 65 00 ولي 65 <=(ChrB(65

ChrW .21 (و ChrW$) واسه كاراكتر هاي Unicode استفاده ميشه.يعني كد يه كاراكتر Unicode (فكر كنم بين 0 تا 2 بتوان 16) رو ميگيره و يه كاراكتر Unicode برميگردونه

CInt .22 تبديل نوع يه مقدار به Integer

Circle .23 واسه رسم يه دايره ، بيضي ، قطاع يا كمان روي فرم هستش.مثلا
Circle(20,20),10,vbred,0,3.141,2 يه كمان با مركز 20و20 و با شعاع 10 با رنگ قرمز از 0 تا پي رو طوري رسم ميكنه كه ارتفاعش 2 برابر عرضش هستش.براي رسم قطاع بايد ارگومان هاي 4 و 5 منفي باشن.واسه رسم داير بعد از vbred نياز نيست مقدار بزارين.واسه رسم بيضي(كامل) آرگومان هاي 4 و 5 رو مقدار ندين در عوض با تغيير دادن آرگومان 6 ميتونين بيضي هاي مختلفي رسم كنين.

Clng .24 واسه تغيير نوع يه مقدار به Long هستش

Cls .25 مثل دستور معادلش توي داس هستش.يعني فرم رو پاك ميكنه.

Command .26 و Command$ اون پارامتر هايي كه به برنامه ارسال شدن رو برميگردونن.مثلا وقتي برنامه رو با دستور
Project1.exe “-hidden” باز كنيم Command برابر “hidden-” ميشه.

Cos .27 كسينويس زاويه اي كه –بر حسب راديان – بهش ميديم رو برميگردونه.

CreateObject .28با گرفتن ClassName يك شي رو درست ميكنه.مثلا

Set fso = CreateObject("Scripting.FileSystemObject")

آبجكت معروف FSO رو دست ميكنه كه خيلي هم توي ASP كاربرد داره.حالا كه اين آبجكت رو ساختين ميتونين ازش استفاده كنين.مثلا واسه بدست آوردن پوشه temp :

MsgBox fso.getspecialfolder(2)

بعد از اينكه كارمون با شي تموم شد بايد حافظه اي كه بش اختصاص پيدا كرده رو آزاد كنيم :

Set FSO = Nothing

CSng .29-30 و CStr واسه تبديل نوع يه مقدار به Single و String هستن.

CDir .31 و CDir$ هم دايركتوري پيشفرض رو برميگردونن(واسه توضيح بيشتر يه سر به chDir بزنين)

CVar .32 واسه تبديل نوع يه مقدار به Var هست

CVDate .33 واسه تبديل يه مقدار(رشته يا عدد) به نوع Date بكار ميره.

CVErr .34 يه شماره خطا يا يه آبجك از نوع ErrObject ميگيره و يه مقدار از نوع Error برميگردونه مثلا : “Cstr(CVErr(13)) = “Error 13
اما اينكه به چه درد ميخوره نميدونم.اينم توضيح : MSDN

The CVErr function in Visual Basic 6.0 returned a Variant of the subtype Error that contained an error number

DateAdd .35 واسه كم يا زياد كردن يه مقدار از يه تاريخ يا ساعت بكار ميره.آرگومان اولي نوع مقداري كه ميخواهيم كم يا زياد كنيم هستش كه بايد يكي از اينا باشه : s ثانيه n دقيقه h ساعت w روزهاي هفته w هفته d روز(مثل 12) y روز از سال(مثل 224) m ماه q يك چهارم سال(فصل) yyyy سال.آرگومان دومي مقداريه كه ميخواهيم اضافه يا كم كنيم مثل 2 1 ... .آرگومان بعدي زمان يا تاريخ مورد نظره.
مثلا (()DateAdd(“m”,3,Date سه ماه به تاريخ فعلي(()Date) اضافه ميكنه و تاريخ جديد رو برميگردونه.

DateDiff .36 براي مقايسه كردن يكي از قسمت هاي 2 مقدار تاريخ هستش.ارگومان اول همون قسمت مورد نظره كه مثل تابع قبلي مقدار دهي ميشه.آرگومان دوم تاريخ1 بعدي تاريخ 2 هستش.مثلا (()DateDiff(“yyyy”,Date(),DateAdd(“yyyy”,3,Date مقدار 3 رو برميگردونه.

DatePart .37 يك قسمت از يك تاريخ ( يا زمان) رو برميگردونه.آرگومان اول مثل 2 تابع قبليه.دومي هم تاريخ مورد نظر.مثلا (()DatePart(“h”,Time الان براي من 17 رو برميگردونه (ساعت 5 بعد از ظهر).

DateSerial .39 روز و ماه و سال رو به عدد ميگيره و تاريخ رو برميگردونه.

DateValue .40 كار قبلي رو ميكنه فقط مقدار رو يكجا(از نوع رشته) ميگيره.مثلx (“DateValue(“2002/09/11 رو ميگيره و تاريخ رو از نوع Date برميگردونه.

Day .41 روز يك تاريخ رو برميگردونه.مثلا (Day(Now عدد 5 رو برميگردونه.

DDB .42

DeleteSetting .43 تنظيماتي كه با تابع SaveSetting توي رجستري ذخيره شده (value ها)رو پاك ميكنه.واسه توضيح بيشتر به SaveSetting مراجع كنين.

Dir .44 فايل ها و فولدر هاي داخل يه فولدر(يا درايو) رو برميگردونه.كه ميشه با مشخص كردن Attribute فايل ها يا فولدر هاي خاص رو بدست آورد.آرگوماني كه ميگيره يه رشتس كه Path مورد نظر هستش كه ميشه توش از كاراكتر هايي مثل * و ؟ هم استفاده كرد.
مثلا ميخواميم همه ي فايل هاي با پسوند .sys رو كه توي درايو C هستن بدست بياريم.
براي اولين بار تابع Dir رو با دادن مقدار “C:\*.sys” فراخواني ميكنيم.مقدار برگشتيش اولين فايل با پسوند bat هست كه توي درايو C (فقط درايو C يعني شامل SubDirectory ها نميشه) پيدا ميكنه.براي بدست آوردن دومين فايل تابع رو بدون دادن مقدار بهش فراخواني ميكنيم ()Dir كه مقدار برگشتيش همون دومين فايل هستش.اين كار رو تا زماني كه مقدار برگشتي "" (رشته ي خالي) نباشه ادامه ميديم.كدش به اين صورت ميشه:

Private Sub CmdPrintDirs_Click()
Dim strPath as String,strDir as String
strPath = "C:\*.sys"
strDir = Dir(strPath)
Do
Print strDir
strDir = Dir()
Loop While strDir <> ""
End Sub

البته اگه Attribute رو درست تعيين نكنين همه فولدر ها و فايل ها برگردونده نميشن.مثلا با قرار دادن اين مقدار :
vbArchive Or vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem
به جاي Attribute ميشه گفت همه فايل ها و فلدر ها (چه سيستم چه معمولي و...) برگردونده ميشن.براي بدست آوردن فقط Directory ها به اين صورت عمل كنين كه به Attribute ، vbDirectoy رو هم اضافه كنين. بعد از اينكه اسم دايركتوري ها رو گفتين باز هم با تابع GetAttr چك كنين كه اسمي كه برگردونده شده حتما Directory هستش :

Private Sub CmdPrintDirs_Click()
Dim strPath As String, strDir As String
strPath = "C:\"
strDir = Dir(strPath, vbDirectory)
Do
If (GetAttr(strPath & strDir) And vbDirectory) = vbDirectory Then
Print strDir
End If
strDir = Dir()
Loop While strDir <> ""
End Sub

اينو نگفتم كه اگه بعد از مسيري كه مشخص كردين اينجا (\:c) چيزي نگذارين همه فايل ها و فولدر هاش در نظر گرفته ميشن.

DoEvents .45 اين تابع رو وقتي دارين توي برنامتون از يك حلقه تكرار كه ممكنه تموم شدنش طول بكشه استفاده ميكنين توي حلقه فراخواني كنين.حالا چكار ميكنه؟
بطور عادي وقتي دارين توي يه حلقه تكرار(يا هر كدي!!) يكسري محاسبات رو انجام ميدين تا زماني كه حلقه تموم نشه برنامتون در مقابل Message هايي كه بش ارسال ميشه عكس العملي انجام نميده و همه عكس العمل ها رو بعد از تموم شدن حلقه انجام ميده و يا اگه شما توي حلقه يه كدمربوط به چاپ كردن يه رشته روي فرم رو نوشته باشين عمل چاپ شدن رو بعد از تمام شدن حلقه مشاهده ميكنين.به قولي تا زمان پايان حلقه برنامه هيچ Event ي انجام نميده(البته اين مساله 100 در 100 هم نيست).تابع DoEvents اين كار رو براتون ميكنه.اين دو كد رو تست كنين :

Private Sub Command1_Click()
Dim i As Long
Do While i < 10000000
i = i + 1
If i < 20 Then List1.AddItem i
Loop
End Sub
Private Sub Command1_Click()
Dim i As Long
Do While i < 10000000
i = i + 1
If i < 20 Then List1.AddItem i
DoEvents
Loop
End Sub

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

46. Environ (و Environ$) اين تابع با گرفتن عدد ها(اينجا index ها) ي بيشتر از 0 و يا رشته ها اطلاعات خاصي از سيستم مثل دايركتوري ويندوز Program Files ، Temp و يا UserName يا تعداد پردازشگر ها و ... رو برميگردونه.با دادن عدد هاي مختلف از 1 به بالا مقدار هاي مختلفش رو ميتونين ببينين.رشته هايي رو هم ميگيره مثل WinDir يا OS يا SystemDrive يا ... كه اين رشته ها رو با استفاده از اعداد ميتونين بدست بيارين :

Private Sub Command1_Click()
Dim strEv As String, i As Integer
i = 1
Do
strEv = Environ(i)
Print strEv
i = i + 1
Loop While strEv <> ""
End Sub

EOF .47 براي كار با فايل هاست كه با دادن شماره اي كه باهاش فايل رو باز كردين ميتونين بفهمين به آخر فايل رسيدين يا نه.

Err .48 آبجكتيه كه اطلاعات مربوط به آخرين خطايي(منظور Runtime Error) كه توي كد اتفاق افتاده رو نگه ميداده.مثلا :
Err.Number شماره خطا Err.Clear پاك كردن خطا (همه اطلاعات در مورد آخرين حذف ميشه و فرض بر اين ميشه كه خطايي اتفاق نيفتاده باشه) Err.Description توضيح خطا Err.Source منبع خطا.Err.Raise هم يه خطا توليد ميكنه!!

Error .49 اگه اين تابع رو برابر يه مقدار قرار نداره باشين كار Err.Raise رو ميكنه با اين فرق كه فقط شماره خطا رو ميگيره(به تعداد آرگومان هايي كه ميگيرن توجه كنين) (در اين حالت ميشه گفت اصلا تابع نيست!) در غير اين صورت توضيح خطايي كه توليد كرده رو هم برميگردونه

Error$ .50 فقط حالت دوم Error هستش

Exp .51 معادلش توي رياضي e x

FileAttr .52 با گرفتن شماره اي كه فايل باش باز شده Attribute هاش رو برميگردونه.مثلا :

Private Sub Command1_Click()
Open "C:\io.sys" For Random As #1
If FileAttr(1) And vbSystem Then
MsgBox "This is a Syetem file!"
End If
Close #1
End Sub

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

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

FileLen .54 آدرس يه فايل رو ميگيره و طولش رو برميگردونه.(به بايت)

Fix .55 يه چيزي شبيه تابع براكت توي رياضي هستش با اين فرض كه اعداد منفي رو رو به بالا گرد ميكنه .مثلا:

Fix(2.1) = 2 و Fix(-2.1) = -2

Filter .56 يه آرايه رشته اي ميگيره و آرايه ي جديدي رو برميگردونه به طوري كه اون آرايه شامل عضو هايي از آرايه ي اول ميشه كه يك رشته ي خاص رو دارا هستن يا دارا نيستن.(تابع 2 حالت داره).آرگومان اول آرايه مورد نظره.دومي رشته ي مورد نظره.سومي اگه False باشه اون عضو هايي كه شامل رشته نيستن انتخاب ميشن و برگردونده ميشن و اگه True باشه عضو هايي كه شامل رشته هستن.بعدي هم نوع مقايسه هست كه توي توضيح تابع InStr درموردش توضيح دادم.اونجا رو ببينين.
مثلا اين آرايه رو تصور كنين :

Dim MainArr(3) As String
MainArr(0) = “Visual Basic”
MainArr(1) = “Visual C++”
MainArr(2) = “W32 Assembly”
MainArr(3) = “Java Script”

حالا ما ميخوايم همه ي اون عضو هايي از MainArr كه كلمه ي Visual داخلشون نيست رو توي يك آرايه ديگه ذخيره كنيم :

Dim NewArr() As String
NewArr = Filter(MainArr,”Visual”,False)

با اين كد عضو هاي آرايه NewArr ، W32 Assembly و Java Script ميشن.اگه به جاي False از True استفاده ميكردين عضو ها Visual Basic و++ Visual C ميشدن.

Format .57 (و Format$)يه تابع پر كاربرده كه كارهاي زيادي در رابطه با رشته ها ميكنه و اگه بخوام همشونو بگم به اندازه اي كه تاحالا نوشتم بايد بنويسم!!در كل يه رشته به عنوان آرگومان اول ميگيره.دومي هم يه رشتس كه Style يا حالت يا همون فرمت اون رشته رو تعيين ميكنه .مثلا ميخواهين با داشتن ثانيه – دقيقه و ساعت،زمان رو با فرمت درست بدست بيارين :

MsgBox (Format("125802", "00:00:00"))

و كار هاي زياد ديگه اي ميشه باش كرد كه بيشتر از اين حال نداريم توضيح بدم.خودتون دنبالش برين ميفهمين... .

FormatCurrency .58 اين تابع يه عدد رو به نوع Currency (نوعي كه توي ويبي براي نگه داشتن مقدار پول بكار ميره) با فرمت دلخواه تبديل ميكنه.آرگومان اول عدد مورد نظره.آرگومان هاي بعدي اختياري هستن: دومي تعداد صفرهايي كه بعد از عدد و نقطه ي آخر اون نشون داده ميشن هستش كه بطور پيشفرض 1-(Default) هستش و براي من 2 تا نشون ميده مثلا 100 رو 100.00 نشون ميده.

آرگومان بعدي مشخص ميكنه كه براي عدد هاي كسري .0 قبل از عدد رو نشون بده يا نه.بعدي مشخص ميكنه كه براي عدد هاي منفي از پرانتز استفاده بشه يا نه.بعدي مشخص ميكنه كه عدد هارو (سه تا سه تا) با كاما گروه بندي كنه يا نه.مثلا 100000 رو 10,000 نشون بده يا نه.يه مثال كلي : FormatCurrency(10000,3,vbTrue,vbTrue,vbTrue)مقدار 10,000.000$ رو برميگردونه.
اين رو هم بگم كه آرگومان هاي 3 ، 4 و 5 به غير از vbTrue و vbFalse مقدار vbUseDefault رو هم ميتونن بگيرن كه اين مقدار به مقدار بيشفرض كه به تنظيم هاي ويندوز بستگي داره ارجاع ميكنه.

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

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

FormatNumber .60 مثل FormatCurreny هستش با 2 تا فرق.يكي اينكه علامت دلار ($) كنار عدد نميگذاره. يكي ديگه اينكه اگه مقدار منفي باشه و آرگومان 3 False ، علامت منفي رو كنار عدد نشون ميده.

FormatPercent .61 مثل قبليه هست با اين فرق كه درصد عددي كه بهش ميديم رو حساب ميكنه.مثلا :

FormatPercent(-10 / 100, 4, vbFalse, vbFalse, vbFalse) = -10.0000%

FreeFile .62 اولين شماره اي كه براي باز كردن فايل ها آماده باشه (آزاد باشه) رو برميگردونه.حداكثر هم 255 فايل ميتونن باز باشن.

FV .63

GetAllSettings .64 اين تابع همه ي تنظيماتي كه توي Section و appName ي كه بش ميديم ذخيره شده رو به صورت يه آرايه 2 بعدي برميگردونه.(بهتره اول SaveSetting رو ببينين) ما اين مقدار رو توي يه متغير از نوع Variant قرار ميديم.به طوري كه (v(0,0 اسم اولين تنظيممون(يا همون اسم Value توي رجيستري يا همون Key توي تابع SaveSetting) هستش و (v(0,1 مقدار اون تنظيم.به همين ترتيب v(1,0) هم اسم دومين تنظيم ميشه... .

GetAttr .65 هم با گرفتن آدرس فايل Attribute هاي اون فايل رو برميگردونه.

GetObject .66 شبيه CreateObject كار ميكنه با اين فرق كه نام فايل رو هم ميتونه بگيره و معمولا براي ارتباط با برنامه هايي بكار ميره كه از قبل اجرا شدن ولي CreateObject يه رابط به instance جديد اون Application ايجاد ميكنه و وقتي استفاده ميشه كه نميدونيم برنامه از قبل اجرا شده يا نه.مثلا ميخواهيم يه شي word رو با CreateObject درست كنيم :

Private Sub Command1_Click()
Dim wApp As Object,wDoc as Object
Set wApp = CreateObject("word.application")
Set wDoc = wApp.Documents.Add
wApp.Selection.Font.Name = "verdana"
wApp.Selection.TypeText "Hello!!"
wDoc.SaveAs "D:\w1.doc"
wDoc.Close
Set wDoc = Nothing
Set wApp = Nothing
End Sub

با اين كد فايل w1.doc توي درايو ِD ساخته ميشه كه محتويايش متن Hello!! هستش.به جاي CreateObject ميشد از GetObject به اين صورت استفاده كرد :

Set wApp = GetObject(, "word.application")

چون ميخواستيم فايل جديدي ايجاد كنيم نياز به دادن آدرس فايل نبود واسه همين فقط آرگومان دوم رو مقدار دهي كرديم.
حالا ميخواهيم توي فايلي كه درست كرديم يه متن تايپ كنيم.اول اون فايل رو با word باز كنين .اينبار از GetObject استفاده ميكنيم :

Private Sub Command1_Click()
Dim wApp As Object
Set wApp = CreateObject("D:\w1.doc").Application
wApp.Documents(1).Application.Selection.TypeText " how are you ?"
Set wApp = Nothing
End Sub

به اين صورت ما تونستيم با GetObject با برنامه Word ارتباط برقرار كنيم.

GetSetting .67 با گرفتن appName و Section و Key ، اطلاعاتي رو كه با تابع SaveSetting توي رجيستري ذخيره شده رو برميگردونه(به توضيح SaveSetting توجه كنين) آرگومان چهارم هم مقداريه كه اگه اطلاعات مورد نظر توي رجيستري پيدا نشد تابع اون رو برميگردونه.

Hex .69 (و Hex$) هم با گرفتن يك عدد معادل اون رو به مبناي 16 برميگردونه مثلا Hex(255) = “FF”

70. Hide فرم رو پنهان ميكنه و واسه نشون دادنش بايد از Show استفاده كنين (اين تابع ها هر دو عضو هاي Form هستن و اگه توي يه ماژول يا كلاس دارين كد مينويسين بايد اسم فرم مورد نظر رو هم بيارين مثلا ()Form1.Hide)

71. Hour زمان رو ميگره و ساعت رو از اون استخراج ميكنه .مثلا Hour ("19:12:03") = 19

72. IIf يك If…Then…Else يك خطي هستش.آرگومان اول همون عبارتيه كه ميخواهيم درستيش رو بررسي كنيم.آرگومان دوم و سوم هم مقدار هاي بازگشتيه تابع هستش.اگه عبارتي كه به تابع داديم درست باشه آرگومان دوم و گرنه آرگومان سوم رو برميگردونه.مثلا

IIf(2+2 = 4, "Yes", "No") = "Yes"

73. IMEStatus توي ويبي 6 وضعيت Input Method Editor رو برميگردونه كه فقط توي ويندوز هاي چيني و كره اي و ژاپني كاربرد داره.

74. InputBox يه Input Box يا همون Prompt رو باز ميكنه و يه ورودي از كاربر ميگيره.آرگومان اول اون متني هستش كه توي Prompt نشون داده ميشه و حتما بايد مقدار دهي بشه ولي آرگومان هاي بعدي اختياري هستن.
دومي Title يا همون عنوان پنجره Prompt هستش.سومي هم متنيه كه به طور پيشفرض توي TextBox ي كه توي InputBox هست نمايش داده ميشه.2 تا آرگومان بعدي هم مختصات پنجره InputBox هستن.آرگومان بعدي (HelpFile) فايل Help ي كه مربوط به اين InputBox هستش.بعدي هم Context اون موضوعيه كه ميخواهين نشون بدين.مقدار برگشتي تابع همون مقداريه كه كاربر وارد ميكنه اگر هم كاربر Cancel رو بزنه مقدار برگشتي يه رشته خاليه (vbNullString).

75. InStr براي جستجوي يك متن توي يك متن ديگه بكار ميره.آرگومان اول جاييه كه جستجو توي رشته از اونجا شروع ميشه. اگه 1 بگذارين جستجو از اولين كاراكتر شروع ميشه ميتونين هم مقداري به اين آرگومان ندين.دومي رشته ي مبدا هستش يعني رشته اي كه ميخواهين توش جستجو كنين.آرگومان بعدي رشته مقصد هست يعني اون متن ي كه ميخواهين جستجوش كنين.آرگومان بعدي هم نوع مقايسه هستش.اگه از vbBinaryCompare استفاده كنين بين حروف كوچك و بزرگ تفاوت گذاشته ميشه و اون ها مساوي حساب نميشن (Case Sensitive) اگه از vbTextCompare استفاده كنين حروف بزرگ و كوچك يكي حساب ميشن. vbDatabaseCompare هم مربوط به Access هستش و كاري بهش نداريم.مثلا InStr(1,”Visual Basic”,”b”,vbTextCompare) مقدار هشت رو برميگردونه در صورتي كه اگه از vbBinaryCompare استفاده كنين يا اصلا اين آرگومان رو مقدار دهي نكنين مقدار 0 نشون داده ميشه.يعني رشته ي مورد نظر پيدا نشد! يا مثلا اگه به جاي 1 از 9 استفاده كنين جستجو از حرف نهم يعني a شروع ميشه و چون حرف b بعد از a (منظور دومين a هستش كه بعد از b قرار داره) قرار نداره تابع b رو پيدا نميكنه و مقدار 0 رو برميگردونه.

اين رو هم بگم كه ويبي به طور پيشفرض Case Sensitive هستش و حروف بزرگ و كوچك مساوي نيستن يعني “VB” <> “Vb” اما اگه كد Option Compare Text رو اول كدها(بالاي فرم يا ماژول) بزارين اين حساسيت ويبي از بين ميره.

76. InStrB مثل قبليه با اين فرق كه واسه داد هاي بايتي كه توي يك رشته قرار گرفتن استفاده ميشه و محل بايت (Byte Position)رو برميگردونه.مثلا چون يه كاراكتر توي رشته ي معمولي 2 بايت حساب ميشه (از لحاظ طول رشته اي 1 هست اما از لحاظ طول بايت 2) مقدار (”InStrB(1,”Visual Basic”,”B برابر 15 هستش.

77. InStrRev مثل InStr هستش با اين فرق كه جستجو رو از آخرين كاراكتر رشته ي كه بش ديديم شروع ميكنه و به اولين كاراكتر ميرسه.(برعكس قبلي)آرگومان اول رشته مبدا دومي رشته ي مقصد و سومي هم شروع جستجو هست كه به طور پيشفرض -1 هستش يعني جستجو از آخرين كاراكتر.آرگومان بعدي هم مثل آرگومان آخر InStr.مثلا (”InStrRev(“VisualBasic”,”a برابر 8 هستش نه 5.ولي ( InStrRev("VisualBasic", "a", 7 برابر 5 هستش چون جستجو از حرف B شروع ميشه و به سمت اولين كاراكتر ميره.

78. Int براكت يك عدد رو برميگردونه.مثلا Int(2.2) = 2 و Int(-2.2) = -3

79. IPmt

80. IRR

81. IsArray هم از اسمش پيداست.يك متغير ميگيره و مشخص ميكنه آرايه هست يا نه.

82. IsDate هم مثل قبليه فقط براي تاريخ يا زمان.

83. IsEmpty براي اينه كه چك كنيم يك مقدار اعلان شده يا نه.مثلا

Dim x as long
Debug.Print IsEmpty(x) ‘False
Debug.Print IsEmpty(y) ‘True
x = Empty
Debug.Print IsEmpty(x) ‘True

84. IsError هم واسه اينه كه چك كنيم يه مقدار از نوع Error هستش يه يا نه.مثلا IsError(Err) = True يا IsError(CVErr(0))= True

85. IsMissing اين تابع براي وقتي به كار ميره كه شما توي يه Function يا Sub كه آرگومان اختياري(Optional)از نوع Variant داره ميخواهين ببينين كه اون آرگومان مقدار دهي شده يا نه.اين مثال رو ببينين:

Private Sub Command1_Click()
MsgBox TestIsMissingFunc()
MsgBox TestIsMissingFunc(2)
MsgBox TestIsMissingFunc(“A”)
End Sub

Private Function TestIsMissingFunc(Optional testArg As Variant) As String
If IsMissing(testArg) Then
TestIsMissingFunc = “You are not passed any value!”
Else
TestIsMissingFunc = “You are passed “ & CStr(testArg)
End If
End Function

مقدارهايي كه با پيغام نشون داده ميشن به اين صورته :

You are not passed any value
You are passed 2
Your are passed A

يعني اگه اون پارامتر اختياري مقدار دهي نشده باشه تابع IsMissing مقدار True رو برميگردونه.اگه پارامتري از نوع غير از Variant بهش بدين همواره مقدار False رو برميگردونه.

86. IsNull واسه اينه كه بفهميم يك مقدارNull هست يا نه. توجه كنين كه Null با خالي بودن يه رشته يا 0 بودن يه عدد فرق داره.مثلا

Deug.Print IsNull(“”) ‘false
Dim S As String
Debug.Print IsNull(S) ‘false
S = “”
Debug.Print IsNull(S) ‘false
S = Null
Debug.Print IsNull(S) ‘True

87. IsNumeric چك ميكنه كه يه مقدار عدد هست يا نه .البته كاري به نوعش نداره و محتوياتش رو بررسي ميكنه مثلا:

Debug.Print IsNumeric(2) ‘true
Debug.Print IsNumeric("2.2") ‘true
Dim v As Variant
v = "$2.2"
Debug.Print IsNumeric(v) ‘true
v = “vb6”
Debug.Print IsNumeric(v) ‘false

88. IsObject هم چك ميكنه يه مقدار از نوع Object هستش يا نه مثلا :

Private Sub Command1_Click()
Debug.Print IsObject(Command1) ‘true
Debug.Print IsObject(Err) ‘true
Dim Obj As Object, v As Variant
Debug.Print IsObject(Obj) ‘true
Debug.Print IsObject(v) ‘false
Set v = Err
Debug.Print IsObject(v) ‘true
Debug.Print IsObject("s") ‘false
End Sub

89. Join يه آرايه از نوع رشته ميگيره و همه مقدار هاي عضو هاي آرايه رو به هم متصل ميكنه و به صورت يه متغير از نوع رشته بيرون ميده.بين هر كدوم از String ها رو هم با كاراكتر دلخواهي كه بهش ميديم قرار ميده(بطور پيشفرض فاصله)
مثلا :

Private Sub Command1_Click()
Dim words(3)
words(0) = "Learning"
words(1) = "VB"
words(2) = "is"
words(3) = "easy"
Debug.Print Join(words, "_") ‘ Learning_VB_is_Easy
End Sub

90. Kill آدرس يه فايل رو ميگيره و اون رو پاك ميكنه.

91. LCase (و LCase$) (مخففLower Case)يك رشته رو ميگيره و همه حروف رو به حروف كوچك تبديل ميكنه و رشته جديد رو برميگردونه مثلا ”LCase(“Visual”)=”visual

92. Left (وLeft$)يك رشته رو ميگيره و به تعداد دلخواه كاراكتر از سمت چپ جدا ميكنه مثلا :

Left("Visual",2) = "Vi"

93. LeftB (و LeftB$) يك رشته رو ميگيره و به تعداد دلخواه بايت از سمت چپ جدا ميكنه.مثلا

LeftB("Visual", 2)="V"

چون هر كاراكتر 2 بايت حساب ميشه.

94. Len يه مقدار ميگيره و طولش رو برميگردونه.براي رشته تعداد كاراكتر ها رو . براي متغير عددي هم تعداد بايتي كه متغيري كه عدد رو شامل ميشه اشغال كرده رو برميگردونه نه تعداد ارقام رو(مگر اينكه قبلش عدد رو به رشته تبديل كنين) مثلا :

Debug.Print Len("visual") ‘8
Dim n As Integer: n = 245
Debug.Print Len(n) ‘2
Debug.Print Len(CStr(n)) ‘3

Dim V As Variant
Debug.Print Len(V) ‘0
Set V = Command1
Debug.Print Len(V) ‘4

95. LenB تعداد بايتي كه يه متغير(يا يك مقدار) اشغال كرده رو برميگردونه.مثلا :

Debug.Print LenB("visual") ‘12
Dim n As Integer: n = 245
Debug.Print LenB(n) ‘2
Debug.Print LenB(CStr(n)) ‘6
Dim V As Variant
Debug.Print LenB(V) ‘0
Set V = Command1
Debug.Print LenB(V) ‘8

96. Line واسه رسم يه خط يا مستطيل روي فرم بكار ميره.آرگومان اول مختصات نقطه شروع و پايان خط و يا مختصات بالا سمت چپ و پايين سمت راست مستطيل هستش.بعدي رنگ خط و مستطيل هستش.بعدي اگه B باشه مستطيل رسم ميشه.اگه BF باشه مستطيل توپر رسم ميشه.اگه هم مقدار دهي نكنينش خط رسم ميشه.مثلا :

Line (0, 0)-(300, 300), vbRed, BF ‘مستطيل توپر قرمز
Line (0, 0)-(300, 300), vbRed ‘خط قرمز

97. Load يه فرم يا Control رو توي حافظه Load ميكنه.

98. LoadPicture يك عكس رو توي حافظه Load ميكنه و مشخصات اون رو توي يك متغير از نوع IPictureDisp برميگردونه.اگه آرگومان اول رشته ي خالي باشه تابع يه عكس خالي برميگردونه.آرگومان هاي بعدي فقط براي فايل هاي آيكن و كرسر هستن:دومي سايز هستش.كه يكي از مقدار هاي زير ميتونه باشه :
vbLPLarge كه اندازه آيكن يا كرسر برابر اندازه آيكن يا كرسر بزرگ پيشفرض سيستم ميشه.
vbLPSmall كه اندازه آيكن يا كرسر برابر اندازه آيكن يا كرسر كوچك پيشفرض سيستم ميشه.
vbLPSmallShell اندازه ايه كه توي قسمت Caption Buttons size setting توي قسمت AppearRance مربوط بهDisplay propertiesتنظيم شده.
vbLPLargShell اندازه ايه كه توي قسمت Icon size setting توي قسمت AppearRance مربوط بهDisplay properties تنظيم شده.
vbLPCustom اندازه بر اساس 2 تا آرگومان x و y تنظيم ميشه.

آرگومان بعدي (ColorDepth) عمق رنگ هستش كه يكي از مقدار هاي زير ميتونه باشه :
vbLPDefault مقدار پيشفرض هستش.

vbLPMonochromeدو رنگ
vbLPVGAColorشونزده رنگ
vbLPColor دويست و پنجاه وشش رنگ

2 تا آرگومان بعدي هم طول و عرض هستن.كه فقط براي وقتي كه آرگومان size برابر vbLPCustom باشه استفاده دارن.
يكباره ديگه هم بگم كه آرگومان هاي 2 به بعد اين تابع فقط واسه فايل هاي آيكون و كرسر هستن.

99. LoadResData اآيدي يك Resouce و نوع اون رو ميگيره و اطلاعاتش رو برميگردونه.مثلا (”LoadResData(101,”CUSTOM
واسه ويرايش Resource هاي برنامه از منوي Add-Ins گزينه ي Add-In Manager رو انتخاب كنين.اونجا توي ليست روي VB6 Resource Editor كليك كنين تا جلوش متن Loaded بياد.OK كنين تا پنجره بسته شه.حالا از منوي Tools گزينه ي Resouce Editor رو انتخاب كنين.توي پنجره اي كه باز ميشه ميتونين Resource هاي مختلف براي برنامتون بسازين...

100. LoadResPicture مثل قبليه منتها واسه Load كردن Picture هستش.چه Icon چه Bitmap و چه Cursor . آرگومان اوليش آيدي Resource هستش .دومي هم يكي از سه نوعي كه گفتم يعني vbResBitmap ، vbResIcon و vbRescCursor .مقداري برگشتيش هم از نوع Picture هستش(IPictureDisp)

101. LoadResString هم واسه لود كردن يه Resource رشته هستش.فقط هم آيدي رو نياز داره.

102. Loc با گرفتن شماره فايل باز شده براي حالت Randomشماره آخرين ركوردي كه نوشته يا خونده شده ، براي حالت Binary مكان آخرين بايتي از فايل(Position) كه خونده يا نوشته شده و براي ترتيبي مكان بايت فعلي در فايل تقسيم بر 128 رو برميگردونه.

103. LOF با گرفتن شماره فايل باز شده طول اون رو برميگردونه.

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

Log(x) / Log(n)

مثلا لگاريتم 8 در مبناي 2 :

Debug.Print Log(8)/Log(2) ‘3

105. LTrim (و LTrim$) يه رشته ميگيره و هرچي Space سمت چپ رشته باشه رو حذف ميكنه و رشته ي جديد رو برميگردونه مثلا :

Debug.Print “ Visual Basic “ ‘ = “Visual Basic “

106. Mid (و$Mid) واسه جدا كردن يك قسمت از يك رشته هستش.آرگومان اول رشته ي مورد نظره.دومي عددي كه جدا كردن از اونجا شروع ميشه و سومي هم طول قسمتيه كه ميخواهيم جدا كنيم و اگه مقدار دهي نكنيمش تابع تا آخر رشته رو در نظر ميگيره:

Debug.Print Mid(“Visual Basic”,3,2) ‘su
Debug.Print Mid(“Visual Basic”,3) ‘sual Basic

107. MidB (و MidB$) مثل قبليه فقط اطلاعات رو بايت به بايت در نظر ميگيره و جدا ميكنه (نه كاراكتر به كاراكتر).فرقش با Mid مثل فرق InStr با InStrB هستش.توي قسمت InStrB بيشتر در اين باره توضيح دادم.

108. Minute يه زمان رو ميگيره دقيقه رو ازش جدا ميكنه.مثلا (”Minute(“02:15:00برابر 15 هستش.

109. MIRR

110. MkDir واسه درست كردن يه Folder به كار ميره كه اگه از قبل وجود داشته باشه تابع Error ميده.

111. Month يه تاريخ ميگيره و ماه رو از اون استخراج ميكنه.(به طور عددي البته) مثلا Month(Date()) = 5

112. MonthName عدد يك ماه رو ميگيره (1 تا 12) و اسم اون ماه رو برميگردونه.اگه آرگومان دومش True باشه اسم رو به صورت خلاصه برميگردونه.مثلا MonthName(10) = Octobr و MonthName(10,True) = Oct

113. Move واسه حركت دادن فرم توي صفحه بكار ميره آرگوما هاش هم مشخص هستن.

114. MsgBox هم يه پيغام توي صفحه نشون ميده.آرگومان اول اجباريه و متن اون پيغام هستش.آرگومان بعدي هم مربوط به Options نشون دادن پيغام مثلا نوع آيكن(vbCritical vbExclamation vbInformation vbQuestion) نوع دكمه ها (vbOKCancel vbYesNoCancel vbOKOnly vbAbortRetryIgnore vbRetryCancel vbYesNo vbMsgBoxHelpButton) دكمه هاي پيشفرض (كه Focus بشون داده ميشه)

تغيير vbMsgBoxRight vbMsgBoxRtlReading) Alignment) نحوه ي نمايش توي صفحه (vbSystemModal vbApplicationModal) هستش.
آرگومان بعدي عنوان پيغام هستش.بعدي فايل Help مربوط به اين پيغام.بعدي هم Context موضوع مورد نظره(توي فايل Help)
مقدار برگشتي تابع هم با توجه به دكمه اي كه كاربر فشار داده يكي از مقدار هاي vbAbort vbRetry vbIgnore vbCancel vbOK vbYes vbNo هستش.

115. NPer

116. NPV

117. Oct (وOct$ ) عدد رو به مبناي هشت ميبره مثلا Oct(8) = 10

118. OLEDrag واسه شروع عمل OLE Drag (مثلا مثل وقتي كه يكسري فايل رو يك فولد به فولدر ديگه ميكشين) براي فرم بكار ميره.اگه قبلش از اسم يه شيي ديگه مثلا يه ليست باكس استفاده كرده باشين –مسلما- عمل واسه اون شي انجام ميشه منظورم اينه كه اين فقط مختص فرم نيست.2 تا فرم بسازين.توي دومي 1 تكست باكس درست كنين خصوصيت OLEDropMode مربوط به TextBox رو Manual قرار بدين.توي فرم اول كد زير رو وارد كنين :

Private Sub Form_Load()
Form2.Show
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
OLEDrag
End Sub

Private Sub Form_OLECompleteDrag(Effect As Long)
MsgBox "Drag completed!"
End Sub

Private Sub Form_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
AllowedEffects = vbDropEffectMove
Data.SetData Me.Caption
End Sub

و توي دومي :

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFText) Then
Text1.Text = Data.GetData(vbCFText)
End If
End Sub

وقتي فرم يك Load ميشه فرم 2 هم نشون داده ميشه.حالا اگه موس رو روي فرم 1 فشار بدين OLEDrag براي فرم فراخواني ميشه و رويداد OLECompleteDrag اتفاق ميفته.طبق كد حالت قابل قبول فقط vbDropEffect)Move) در نظر گرفته ميشه.و اطلاعاتي هم كه بايد از فرم به جاي مقصد انتقال پيدا كنه برابر با متن فرم ميشه كه هر چيزه ديگه اي با فرمت ديگه اي مثل يه فايل هم ميتونه باشه.وقتي بدون اينكه دكمه ي موس رو رها كنين اون رو روي TextBox فرم دوم ببرين رويداد OLEDragDrop براي TextBox اتفاق ميفته.بعد چك ميشه كه اگه فرمت اطلاعات متني بود اطلاعات توي TextBox نشون داده بشه.بعد از رها كردن دكمه ي موس رويداد OLECompleteDrag (تومو شده عمل كشيدن) براي فرم اتفاق ميفته و يك پيغام نشون داده ميشه.

119. PaintPicture واسه رسم كردن يه عكس روي فرم هست.اين تابع مال PictureBox هم هست.
آرگومان اول عكسيه كه بايد رسم بشه كه ميتونه عكسي باشه كه با LoadPicture لود شده.يا عكس توي يك PictureBox(مثلا Picture1.Picture) .آرگومان دوم و سوم مختصات بالا سمت چپ جايي هستن كه قرار عكس اونجا رسم بشه.مثلا اگه 0و0 باشن عكس كاملا توي بالا و سمت چپ فرم قرار ميگيره يا اگه 100و20 باشن عكس با سمت چپ فرم 100 و با بالاي فرم 20 تا (واحدش بر اساس واحد فرم هستش بطور پيشفرض Twip ) آرگومان هاي بعدي طول و عرض عكسي هستن كه قرار چاپ بشه.اگه مقدار دهيشون نكنين عكس با اندازه ي اصليش چاپ ميشه.دو تا آرگومان بعدي جايي از عكس هستن كه عمل رسم شدن بايد از اونجا شروع بشه كه اگه مثلا 100و100 باشن همه ي عكس روي فرم رسم نميشه و از عمل رسم از بالا و سمت چپ فرم با مختصات 100و100 شروع ميشه . دو تا آرگومان بعدي هم مثل قبلي واسه جدا كردن قسمتي از عكس هستن.اين ها طول و عرضي از عكس رو مشخص ميكنن كه قرار رسم بشه.مثل قبلي ها اگه مقدار دهيشون نكنين (با توجه به 2 تا آرگومان قبلي) همه ي قسمت ها در نظر گرفته ميشه.آرگومان آخر هم نحوه ي رسم هست(از نظر رنگ) كه ميتونه يكي از مقدار هاي زير باشه :
vbSrcCopy عكس جديد رو كاملا جايگزين عكس قبلي ميكنه يعني اگه از قبل توي فرم عكسي وجود داشته باشه هيچ
اثري ازش نميمونه.
vbSrcAnd عكس مبدا و مقصد(در صورت وجود) رو AND ميكنه (دو عكس ادغام ميشن)
vbNotSrcErase عكس و مبدا و مقصد(در صورت وجود) رو OR ميكنه و نتيجه رو Invert ميكنه.
vbSrcPaint عكس مبدا و مقصد(در صورت وجود) رو OR ميكنه.
vbDstInvert عكس مقصد (در صورت وجود) رو Invert ميكنه.
vbSrcInvert عكس مبدا و مقصد(در صورت وجود) رو XOR ميكنه.
vbSrcErase عكس مقصد(در صورت وجود) رو Invert (معكوس) ميكنه و با عكس مبدا AND ميكنه.
vbNotSrcCopy عكس مبدا رو Invert ميكنه و كاملا جايگزين عكس مقصد ميكنه.

براي اينكه بهتر متوجه بشين همه رو امتحان كنين.

120. Partition چهار تا عدد به عنوان شروع(Start) ،پايان(Stop) فاصله(Intrerval) و عدد مورد نظر(Number) ميگيره و يك سيري از اعداد به صورت

Start + (n-1) * Interval تا Start + n * Interval -1 …………… Start + (n-1) * Interval تا Stop

تا رسيدن به مقدار Stop ميسازه.مثلا اگه Start=1 , Stop=110 ,Interval=20 اينطوري ميشه :

1…20 21…40 41…60 61…80 81…100 101…110

حالا تابع عددي كه بش داديم(Number) رو بررسي ميكنه كه جزو كدوم يك از اين بازه ها(بازه هاي بسته) هستش.جزو هر كدوم كه بود تابع يه رشته به صورت بالاترين عضو : پايين ترين عضو برميگردونه.مثلا اگه عدد 52 يا 60 باشه تابع مقدار “41:60” رو برميگردونه.اگه عددي كه بش ميديم كمتر از كمترين عضو سري باشه تابع مقدار “ : [Start -1] ” رو برميگردونه مثلا اينجا براي 3- تابع مقدار “ : 0 ” رو برميگردونه و اگه بزرگ تر باشه “[Stop + 1] : ” رو برميگردونه.

121. Pmt

122. Point مختصات يه نقطه از فرم رو ميگيره و رنگ اون نقطه(بر اساس RGB:Red-Green-Blue) رو برميگردونه.

123. PopupMenu يه Popup Menu روي فرم نشون ميده.آرگومان اولي اسم اون منو هست كه اونو توي محيط ويبي ساختين.
دومي Flags يا ميشه گفت Options مربوط به نحوه ي نمايش منو هستش كه يكي (يا چند تا) از اينها ميتونه باشه :

vbPopupMenuRightAlign منو رو سمت راست مختصاتي كه بهش دادين نمايش ميده
vbPopupMenuLeftAlign منو رو سمت چپ مختصاتي كه بهش دادين نمايش ميده(پيشفرض)
vbPopupMenuCenterAlign منو رو وسط مختصاتي كه بهش دادين نمايش ميده
vbPopupMenuLeftButton منو فقط دكمه چپ موس رو تشخيص ميده.(اگه روي گزينه هاش راست كليك كنين اتفاقي نميفته) (پيشفرض)
vbPopupMenuRightButton منو دكمه چپ و راست موس رو تشخيص ميده.

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

Edit (mnuEdit)
Copy (mnuCopy)
Cut (mnuCut)
Delete (mnuDel)
Paste (mnuPaste)

براي نمايش منوي Edit براي وقتي كه روي TextBox كليك ميشه :

Private Sub TextBox1_Click()
Call PopUpMenu(mnuEdit, vbPopupMenuRightAlign Or vbPopupMenuRightButton,,,mnuCopy)
End Sub

كه در اين حالت منوي كپي پيشفرض ميشه.

124. PPmt

125. PrintForm صفحه ي فرمي كه توش تابع فراخواني شده رو واسه چاپ به پرينتر ميبره.

126. PSet واسه رسم نقطه با رنگ داخواه روي فرم بكار ميره.آرگومان اول مختصات نقطه.بعدي هم رنگ هستش مثلا PSet (100,100),vbRed يا Form1.Pset… يا Picture1.PSet..

127. PV

128. QBColor يك عدد بين 0 تا 15 ميگيره و بر اساس اون ها يك رنگ از نوع RGB برميگردونه.
0 براي سياه 1 براي آبي تيره 2 براي سبز تيره 3 براي فسفري تيره 4 براي قرمز تيره 5 براي بنفش 6 براي زرد 7 براي سفيد تيره!(خاكستري كم رنگ) 8 براي خاكستري 9 براي آبي 10 براي سبز .11 براي فسفري 12 براي قرمز 13 براي صورتي 14 براي زرد 15 براي سفيد. مثلا (Form.BackColor = QBColor(9) ‘=vbRed = RGB(255,0,0

129. Randomize واسه اين به كار ميره كه نتايج تابع Rnd() كه واسه بدست آوردن اعداد تصادفي بكار ميره هر دفعه تكراري نباشه.مثلا اين كد رو در نظر بگيرين :

Debug.Print Rnd()
Debug.Print Rnd()
Debug.Print Rnd()
‘Prints :
0.7055475
0.533424
0.5795186

توي يه برنامه اي كه با اين كد من درست كردم هر دفعه كه برنامه اجرا ميشد همين مقدار ها بدست ميومد.واسه جلوگيري از اين كار از Randomize استفاده ميكنيم.

130. Rate

131. Refresh فرم( يا هر آبجك ديگه اي كه متد مربوط بهش باشه) رو Refresh ميكنه.يعني اون شي دوباره رسم ميشه.

132. Replace توي رشته اي كه بهش ميديم يك رشته رو جايگزين يه رشته ي ديگه ميكنه و رشته ي جديد رو برميگردونه.آرگومان اول رشته ي اصليه.دومي رشته اي هستش كه بايد پيدا بشه و رشته ي جديد جايگزينش بشه.رشته ي بعدي رشته ي جديد هستش كه قراره جايگزين بشه.آرگومان بعدي هم جايي هستش كه عمل جايگزيني بايد از اونجا شروع بشه.بعدي حداكثر تعداد جايگزينيه .بعدي هم نوع مقايسه هستش كه توي توضيح تابع InStr در موردش گفتم.مثلا :
Debug.Print Replace(“It’s Visual Basic!”,”a”,”XX”) ‘ It’s VisuXXl BXXsic!
Debug.Print Replace(“It’s Visual Basic!”,”a”,”XX”,7) ‘ It’s Visual BXXsic!
Debug.Print Replace(“It’s Visual Basic!”,”a”,”XX”,,1) ‘ It’s VisuXXl Basic!
Debug.Print Replace(“It’s Visual Basic!”,”A”,”XX”) ‘ It’s Visual Basic!
Debug.Print Replace(“It’s Visual Basic!”,”A”,”XX”,,,vbTextCompare) ‘ It’s VisuXXl BXXsic!

133. Reset هم ي فايل هاي باز شده رو ميبنده.

134. RGB سه مولفه ي قرمز و سبز و آبيه يك رنگ رو ميگيره و اون رو برميگردونه(از نوع Long) مثلا براي رنگ قرمز : (RGB(255,0,0 و يا براي زرد (RGB(255, 255, 0
در ضمن هر آرگومان بايد بين 0 تا 255 باشه.

135. Right (و $Right) برعكس Left عمل ميكنه يعني يه تعداد كاراكتر از سمت راست يك رشته جدا ميكنه.

135. RightB (و $RightB) يك رشته رو ميگيره و به تعداد دلخواه بايت از سمت راست جدا ميكنه.مثلا ”LeftB("Visual", 2)=”l چون هر كاراكتر 2 بايت حساب ميشه.

136. RmDir يك دايركتوري رو حذف ميكنه.توي اون دايركتوري نبايد فولدر يا فايل ديگه اي باشه.

137. Rnd يك عدد تصادفي بين 0 تا 1 (0,1] با سه رقم اعشار از نوع Single برميگردونه مثلا 0.492

138. Round براي يك عدد اعشاري تعداد اعشار دلخواه رو نگه ميداره و بقيه رو حذف ميكنه.مثلا Round(1.2345,2) = 1.23 اينجا 2 تا از ارقام اعشار نگه داشته شدن.

139. RTrim (و $RTrim) يه رشته ميگيره و هرچي Space سمت راست رشته باشه رو حذف ميكنه و رشته ي جديد رو برميگردونه مثلا :
Debug.Print “ Visual Basic “ ‘ = “ Visual Basic“

140. SavePicture يك عكس رو ميگيره و اون رو توي يك فايل ذخيره ميكنه(با فرمت Bitmap) اون عكس ميتونه يك Picture يا Image رسم شده ي يك فرم يا Picture Box باشه.

141. SaveSetting با گرفتن نام برنامه(دلخواه) Setion و Key و يه رشته ه عنوان اطلاعات يا تنظيم مورد نظر ، يك Key توي رجيستري با اسم ]نام برنامه[ درست ميكنه.توي اون يك Key ديگه با اسم [Section] درست ميكنه و توي اون يك Value از نوع رشته (SZ)با اسم [Key] درست ميكنه و مقدار اون رو برابر رشته اي كه بهش داديم (Setting) قرار ميده.كه بعدا با تابع GetSetting و يا GetAllSettings ميتونين به اين اطلاعات دسترسي پيدا كنين.اين اطلاعات توي رجيستري توي شاخه ي :
HKEY_CURRENT_USER\Software\VB and VBA Program Settings

درست ميشن. با توجه به مقدار هايي كه بهشون داديم:
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\[appName]\[Section]

ScaleX .142-3 و ScaleY يه مقدار و 2 تا واحد ميگيرن و واحد مقداري رو كه گرفتن تغيير ميدن مثلا از Pixel به Inch .آرگومان اول همون مقدار مورد نظره مثلا 1000 دومي واحديه كه براي مقدار بايد در نظر گرفته بشه بطور پيشفرض vbHimetric هستش.بعدي واحد خروجيه كه بطور بيشفرض برابر با ScaleMode فرم هستش كه اون هم به طور پيشفرض vbTwips هستش.مثلا اگه بخواهيم ببينيم 10اينچ چند ميليمتره :
ScaleX(10, vbInches, vbMillimeters)

Seek .144 شماره ي فايلي كه باز شده رو ميگيره و براي حالت Random شماره ركورد بعدي (كه قراره نوشته يا خوانده بشه) و براي حالت هاي ديگه شماره بايت بعدي كه قراره نوشته يا خوانده بشه رو برميگردونه كه قبل از اينكه چيزي نوشته يا خونده بشه مقدار يك رو برميگردونه بعد 2 و به همين ترتيب.فرقش هم با Loc همينه.Loc شماره آخرين ركورد يا بايتي كه نوشته يا خوانده شده رو برميگردونه.

145. 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 باشه وقتي كه كليدي به يك پنجره ارسال ميشه تابع منتظر ميشه تا اون پنجره عمليات فشرده شدن كليد رو براي خودش پردازش كنه بعد كنترل به تابع برميگرده.

146. SetAttr آدرس يه فايل رو ميگيره و Attributes مربوط به اون رو تغيير ميده.(مثل سيستم آرشيو نرمان و ...)

147. Focus اين تابع Focus رو به كنترلي كه اين متد از اون فراخواني بشه ميده.اگه قبلش اسم كنترل رو نياريم بطور پيشفرض Focus به فرم ي كه تابع توش فراخواني شده داده ميشه.

148. Sng كار تابع Sign( علامت) توي رياضي رو ميكنه.به اين صورت كه يك عدد ميگيره.اگه عدد بزرگتر از صفر باشه مقدار 1 اگه برابر با صفر باشه مقدار صفر و اگه كوچكتر از صفر باشه مقدار 1- رو برميگردونه.

149. Shell آدرس يه فايل اجرايي رو ميگيره و اون رو اجرا ميكنه و Process ID اون رو برميگردونه.آرگومان اولي آدرس فايل هستش كه ميتونه آدرس كامل باشه يا فقط اسم فايل (براي فايل هايي كه توي پوشه ويندوز يا سيستم يا دايركتوري جاري هستن) .آرگومان دومي هم نوع نمايش اون ها هست كه مشخصه مثلا اگه بخواهيم برنامه توي حالت Maximize باز بشه از vbMaximizedFocus استفاده ميكنيم.

150. Show متد مربوط به فرم هستش كه يك فرم رو لود ميكنه و نشون ميده.آرگومان اول اگه vbModal باشه فرم اول(كه كد توش نوشته شده) تا زماني كه فرم دوم(كه با استفاده از متد Show نشون داده شده) بسته نشه قابل دسترسي نيست و كد بعد توي فرم اجرا نميشه.مثل وقتي كه توي فرم يه MsgBox نشون ميدين؛تا وقتي كه پنجره ي MsgBox رو نبندين فرم غير قابل دسترسه و برنامه به خط بعد نميره.آرگومان بعدي هم فرميه كه به عنوان والد فرمي كه قراره نشون داده بشه در نظر گرفته ميشه و مقدار دهيش هم اختياريه.مثلا

‘ ‘In Form 1 :
Form2.Show vbModal,Form1

151. Sin سينوس زاويه ي داده شده(بر حسب راديان) رو حساب ميكنه.

152. SLN

153. Space(و Space$) يك عدد ميگيره و به تعداد اون عدد Space برميگردونه مثلا Space(4) مقدار “ “ رو برميگردونه.

154. Split يه رشته و يه كاراكتر جدا كننده ميگيره و با توجه به اون كاراكتر كلمه هاي موجود توي اون رشته رو توي يك آرايه رشته اي قرار ميده.مثلا اگه رشته ي “VB Is Easy” و كاراكتر “ “ رو بهش بديم اعضاي آرايه اي كه برميگردونه “VB" ، “Is” و “Easy” هستن.يا اگه “One_Two_Three” و “_” رو بهش بديم اعضاي آرايه “One” ، “Two” و “Three” ميشن.آرگومان اول رشته ي مورد نظره.آرگومان بعدي كاراكتر مورد نظره كه بطور پيشفرض “ “ (Space) در نظر گرفته ميشه.آرگومان بعدي حداكثر تعداد اعضا هستش مثلا اگه براي مثال قبلي اين آرگمان رو 2 ميگذاشتين اعضاي آرايه “One” و “Two” ميشدن(عضو سومي وجود نداشت) آرگومان بعدي هم نوع مقايسه براي كاراكتريه كه بهش ميديم.(توي توضيح تابع InStr در مورد نوع مقايسه توضيح دادم.)

155. Sqr راديكال يك عدد رو ميگيره.مثلا Sqr(9) = 3. .براي جذر گرفتن يك عدد با فرجه بغير از 2 از توان استفاده كنين مثلا اگه بخواهين از 8 با فرجه 3 جذر بگيرين از 8 ^ (1/3) استفاده كنين.

156. Str (و Str$) يه مقدار رو به نوع Str تبديل ميكنه.مثلا “Str(1) = “1

StrComp .157 دو تا رشته رو مقايسه ميكنه.اگه رشته ها برابر بودن مقدار 0 .اگه اولي از دومي بزرگتر بود مقدار1 و اگه دومي از اولي بزرگتر بود مقدار -1 رو برميگردونه.2 تا آرگومان اول 2 تا رشته ي مورد نظر هستن.سومي هم نوع مقايسه دو تا رشته هستش كه توي توضيح تابع Instr درموردش گفتم اما چون به اين تابع بيشتر مربوط ميشه اينجا هم ميگم. اگه از vbBinaryCompare استفاده كنين بين حروف كوچك و بزرگ تفاوت گذاشته ميشه و اون ها مساوي حساب نميشن (Case Sensitive) اگه از vbTextCompare استفاده كنين حروف بزرگ و كوچك يكي حساب ميشن. vbDatabaseCompare هم مربوط به Access هستش و كاري بهش نداريم.مثلا (StrComp(“abCD”,”abcd”,vbBinaryCompare مقدار -1 رو برميگردونه يعني رشته ها با هم مساوي نيستن.در صورتي كه 0= (StrComp(“abCD”,”abcd”,vbTextCompare.

اين رو هم بگم كه ويبي به طور پيشفرض Case Sensitive هستش و حروف بزرگ و كوچك مساوي نيستن يعني “VB” <> “Vb” اما اگه كد Option Compare Text رو اول كدها(بالاي فرم يا ماژول) بزارين اين حساسيت ويبي از بين ميره.

158. StrConv واسه تبديل كردن نوع يك رشته به يك نوع ديگه بكار ميره.آرگومان اول رشته ي مورد نظره .آرگومان بعدي هم نوع جديد هستش.كه يكي از مقدار هاي زير ميتونه باشه :
vbFromUnicode – با اين آرگومان تابع رشته اي كه بش داديم رو Unicode در نظر ميگيره و اون رو به ANSI تبديل ميكنه.
vbHiragana - كاراكتر هاي Katakana ي توي رشته رو به Hiragana تبديل ميكنه.(مربوط به Encoding كره ايه و بدرد ما نميخوره اصلا!)
vbKatakana – برعكس قبلي.
vbLowerCase – همه ي حروف بزرگ توي رشته رو به حروف كوچك تبديل ميكنه.مثلا “Visual Basic” ميشه “visual basic”
vbNarrow – كاراكتر هاي 2 بايتي رو به كاراكتر هاي تك بايتي تبديل ميكنه
vbWide - برعكس قبلي.
vbPopperCase – اولين حروف همه ي كلمه هاي موجود توي رشته(رشته اي كه بعد از فاصله قرار داره) رو به حروف بزرگ تبديل ميكنه.مثلا “Visual basic is easy” رو به “Visual Basic Is Easy” تبديل ميكنه.
vbUnicode - كاراكتر هاي متن رو به كاراكتر هاي Unicode تبديل ميكنه.
vbUpperCase - همه ي حروف كوچك توي رشته رو به حروف بزرگ تبديل ميكنه.مثلا “Visual Basic” ميشه “VISUAL BASIC”

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

159. String (و String$) يك عدد(n) و يه كاراكتر ميگيره و يه رشته كه حاوي n تا از اون كاراكتره برميگردونه .(مثل Space كه n تا فاصله برميگردونه) مثلا ”String(4,”a”) = “aaaa.در ضمن به جاي اون كاراكتر ميتونين كد اسكيش رو هم به تابع بدين مثلا ”String(4,65)=”aaaa.

160. StrReverse يه رشته رو برعكس ميكنه مثلا ”StrReverse(“VisualBasic”) = “cisaBlausiV

161. Switch يك تعداد آرگومان كه تعدادشون بايد زوج باشه ميگيره به طوري كه :
آرگومان هاي فرد( اولي ، سومي ، پنجمي و ...) بايد يك عبارت باشن(يا ميشه گفت عبارت در نظر گرفته ميشن)
آرگومان هاي زوج هم بايد مقدار باشن(يا ميشه گفت مقدار در نظر گرفته ميشن)
تابع مياد به ترتيب تك تك آرگومان هاي فرد رو مورد بررسي قرار ميده.به اولين آرگوماني كه ارزشش درست (True) باشه كه رسيد آرگومان بعد از اون(كه يك مقدار هست) رو برميگردونه.

مثلا فرض كنين شما ميخواهين يك تابعي درست كنين كه يك عدد از 1 تا 5 بگيره و معادل رشته اي اون رو (“One” ، “Two” و ...) رو برگردونه.با استفاده از اين تابع شما ميتونين اينطوري عمل كنين :
Function nToS(Byval n as Integer) As String
If n > 5 Or n < 1 Then Exit Function
nToS = Switch(n=1,”One”,n=2,”Two”,n=3,”Three”,n=4,”Four”,n=5,”Five”)
End Function

كد اين تابع اول چك ميكنه كه عددي كه بهش داده شده بين 1 تا 5 هست يا نه.اگه نبود از تابع خارج ميشه.
اما اگه بود با استفاده از تابع Swich مقدار ها ي مختلفي كه n ميتونه داشته باشه رو چك ميكنه و مقدار معادل رشته اي رو برميگردونه.مثلا nToS(4)=”Four” .

162. SYD

163. Tan اين هم تانژانت يك زاويه (بر حسب راديان) رو برميگردونه.

164. TextHeight يك رشته ميگيره و ارتفاعي رو كه اون رشته اشغال ميكنه رو باتوجه به فونت فرم و واحد فرم(ScaleMode) برميگردونه.مثلا اگه واحد و فونت فرم پيشفرض باشه :
TextHeight(“m”) = TextHeight(“MA”) = 195

يعني اينكه ارتفاعي كه اشغال ميكنه به طول رشته و يا كوچك و بزرگ بودن كاراكتر ها بستگي نداره(كه اين هم بديهيه!)

165. TextWidth كار تابع قبلي رو براي عرض يك رشته انجام ميده.با اين فرق كه همونطور كه ميدونيم با تغيير تعداد كاراكتر يك رشته و يا كوچك و بزرگ بودن كاراكتر ها عرضي كه رشته اشغال ميكنه فرق ميكنه.مثلا
TextWidth(“a”) = 90 ، TextWidth(“A”) = 166 و TextWidth(“Abcd”) = 375

167. TimeSerial ساعت و دقيقه و ثانيه رو ميگيره و زمان رو با نوع Dateبرميگردونه مثلا
Debug.Print TimeSerial(10, 20, 30) ‘ prints 10:20:30 AM

168. TimeValueمثل قبليه با اين فرق كه يه تا مقدار رو يكجا و از نوع رشته ميگيره .مثلا :
Debug.Print TimeValue(“10:20:30”) ‘ prints 10:20:30 AM

169. Trim (و Trim$) يك رشته ميگيره و فاصله هاي اول و آخرش رو حذف ميكنه(كار LTrim و RTrim رو با هم ميكنه) مثلا :
Debug.Print Trim(“ Visual Basic “) ‘prints “Visual Basic”

170. TypeName يك مقدار ميگيره و نوعش رو برميگردونه.اون مقدار ميتونه از هر نوعي باشه.مثلا :

Debug.Print TypeName(Me) ‘ prints Form1
Debug.Print TypeName(Command1) ‘ prints CommandButton
Debug.Print TypeName(“Hello”) ‘ prints String
Debug.Print TypeName(2.2) ‘ prints Double
Debug.Print TypeName(Err) ‘ prints ErrObject

171. UCase (و UCase$) يك رشته ميگيره و همه ي حروف كوچك اون رو به حروف بزرگ تبديل ميكنه مثلا ”!UCase(“Hello!”) = “HELLO.اين تابع برعكس LCase كار ميكنه.

172. Unload يك آبجك رو از حافظه پاك ميكنه.مثلا Unload Form1

173. Val يك رشته ميگيره و عدد هاي سمت چپش رو جدا ميكنه و وقتي به يك كاراكتر غير عددي يا غير نقطه برسه كارش رو ادامه ميده .عددي كه برميگردونه از نوع Double هستش.مثلا
Val(“2 4 7 11 323.23 adas”) = 24711323.23

174. در مورد كار تابع هاي ValidateControls و WhatsThisMode هم چيزي نفهميدم :

MSDN :
ValidateControls: Ensures that the contents of the last control on the form are valid before exiting the form.
WhatsThisMode: Duplicates the functionality of the WhatsThisMode method of a Visual Basic 6.0 form.

175. VarType هم يك مقدار ميگيره و نوع اون رو از نوع vbVarType برميگردونه و فرقش هم با TypeName همينه.مثلا
VarType(2.2) = vbDouble

176. Year يه تاريخ ميگيره و سال اون رو استخراج ميكنه.مثلا
Year(Now()) = 2005

177. ‌ZOrder مختصات Z يك كنترل(به طور پيشفرض فرمي كه توش فراخواني ميشه) رو تعيين ميكنه.مختصات Z تيعيين ميكنه كه كدوم كنترل ها بايد زير بقيه و كدوم بايد روي ديگري باشه.مقدار 0 (مقدار پيشفرض) يه كنترل رو به رو مياره و مقدار 1 به زير ميبره

اموزش Visual Basic 6.0

vblog — Fri, 23 Feb 2007 13:19:18 GMT

معرفی و اموزش چند تابع 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 هست رو روی فرم رسم میکنیم

اموزش Visual Basic 6.0

vblog — Fri, 23 Feb 2007 13:17:09 GMT

مقایسه VB و C++ از نظر سرعت ترجمه
شاید وقتی یک برنامه ی ساده که عملیات سنگینی نداره رو مینویسیم با مشکل سرعت اجرا مواجه نشیم.اما گاهی یکی از بزرگترین مشکل ها همین سرعت اجرا هستش.مثلا یک بازی کامپیوتری 3 بعدی به خاطر اینکه روون باشه و اصلا بشه باش بازی کرد باید تا اونجا که ممکنه سرعت اجرای کد رو بالا برد.

میخوام یک کد ساده رو با VB و با سی بنویسم و کامپایل کنم و اختلاف زمان اجرای این کد روببینیم.
کارش ساده هستش.یه حلفه ی معمولی که 1000 بار تکرار میشه و هر بار 0.00001 به یک مقدار double اضافه میکنه.

*** کد VB ***
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Form_Load()
Dim start_time As Long: start_time = GetTickCount()
Dim i As Double: i = 0
Do While (i < 1000)
i = i + 0.00001
Loop
Dim op_time As Long: op_time = GetTickCount() - start_time
MsgBox "Elapsed time : " & op_time & "ms"
End Sub

*** كد C++ ***
#include "stdafx.h"
#include "windows.h"
#include "stdio.h"
#include "conio.h"
int main(int argc, char* argv[])
{
DWORD start_time = GetTickCount();
double i=0;
while (i < 1000) {
i += 0.00001;
}
DWORD op_time = GetTickCount() - start_time;
printf("Elapsed time : %dms\n",op_time);
getch();
return 0;
}

نتایج :
C++ : 437 میلی ثانیه
VB : 2047 میلی ثانیه
یعنی یه چیزی بیشتر از 5 برابر توی این عملیات سرعت C++ بیشتر هستش.

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

****************************************
برنامه نویسی 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 بزنین

***********************
ادامه امــــــــــــــــــــــــــــــــــــــــوزش

الان میخوام کدی رو بگذارم که باهاش میشه اون 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

****************************
برنامه نویسی 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 استفاده ميشن

***************************
امــــــــــــــــــــــــــــــــــــــــــــوزش Process توسط API
امروز ميخوام در مورد كار با Process ها يكم بنويسم.مخصوصن در مورد بستن Process برنامه ها.

واسه بستن Processيه فايل اجرايي(طبق اين راهي كه من بلدم) :
اول بايد آيدي اون Process رو بدست بياريم.
بعد بايد با تابع OpenProcess يه هندل از اون Process بدست بياريم.
بعد با تابع TerminateProcess اون رو ببنديم .

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

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

فعلا همينو ميگم بعد ميرم سراغ راه بعدي.
واسه ي كاري كه گفتم اول بايد با تابع CreateToolhelp32Snapshot (كه واسه بدست آوردن ليست Process ها و يا heap ها ، Module ها و... ي Process بكار ميره) يه هندل ليست از Process ها بدست بدست بياريم:

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

بعد با تابع Process32First و Process32Next اطلاعاتي در مورد هر كدوم از Process ها مثل نام فايل و ProcessID و ... كه با بقيش فعلا كاري بدست بياريم:

Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long

البته اين روش تا اين مرحله فقط اسم فايل رو به ما ميده مثل (notepad.exe) نه آدرس كامل اون رو كه در مورد بدست آوردن آدرس كامل هم توضيح ميدم.

آرگومان اول تابع CreateToolhelp32Snapshot بستگي به ليستي كه ميخواهيم بدست بياريم داره كه ما اينجا چون ميخواهيم ليست همه ي Process هاي سيستم رو بدست بياريم اون رو Private Const TH32CS_SNAPPROCESS = &H2 ميگذاريم.

آرگومان بعدي هم آيدي Process يه كه ميخواهيم در موردش اطلاعات بدست بياريم كه چون ما اينجا نميخواهيم اطلاعاتي (ليست Module ها و ...) در مورد Process خاصي بدست بياريم (چون هنوز IDيي نداريم) و فعلا ميخواهيم خود ليست Process ها رو بدست بياريم و آرگومان اول رو هم TH32CS_SNAPPROCESS قرار داديم اينجا هرچي بگذاريم فرقي نداره. آرگومان دوم براي وقتيه كه آرگومان اول رو چيز ديگه اي بغير از ايني كه ما الان گذشتيم بگذاريم...(فكر كنم زيادي توضيح دادم!!!!)

حالا براي شروع بدست آوردن اطلاعات مورد نظرمون از Process32First استفاده ميكنيم.آرگومان اول هندليه كه با تابع قبلي بدست آورديم.بعدي يه متغير از نوع PROCESSENTRY32 هستش كه تابع اطلاعات مورد نظر رو توي اين قرار ميده:

CONST MAX_PATH = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

توي اين szExeFile ٬Type اسم فايل ، th32ProcessID هم همون آيدي مورد نظرمونه.با بقيش هم همونطور كه گفتم كاري نداريم.
(آرگومان هاي تابع Process3Next هم طبعا مثل Process32First هستش.)
بعد با يك حلقه تا زماني كه مقدار برگشتي تابع Process32Next صفر نباشه به فراخواني اين تابع ادامه ميديم و توي هر بار فراخواني اطلاعات يكي از Process ها رو بدست مياريم.(وقتي كه تابع صفر برگردونه يعني به انتهاي ليست رسيديم)
بعد از بدست آوردن اطلاعات مورد نظر بايد هندلي كه با تابع CreateToolhelp32Snapshot بدست آورديم رو ببنديم :

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

خوب ميريم سراغ كد :

Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Sub Command1_Click()
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Process.dwSize = Len(Process)
pResult = Process32First(hSnap, Process)
Do While pResult <> 0
List1.AddItem Left$(Process.szExeFile, InStr(1, Process.szExeFile, Chr(0)) - 1) & " : " & Process.th32ProcessID
pResult = Process32Next(hSnap, Process)
Loop
CloseHandle hSnap
End Sub

همه چيزه اين كد رو به غير از 2 چيز كوچيك توضيح دادم.يكي ايكنه براي اينكه ميخواهيم متغير Process كه از نوع PROCESSENTRY32 هستش رو به تابع ارسال كنيم بايد طولش رو توي عضو .dwSize اون قرار بديم.(اين موضوع فقط مال اين تابع و اين نوع نيست...)
بعدي اينكه از نام فايل اون مقدار مورد نظر رو كه ميخواهيم جدا كنيم و كاراكتر هاي (0) رو از اسم فايل جدا كنيم از Left و Instr استفاده كرديم .مثل كاري كه توي پست قبلي توضيح دادم.(قبلا از Replace استفاده ميكردم اما تابلوه كه اين روش سرعتش بيشتره)

خوب تا اينجا فعلا ليست اسم ها و آيدي Process ها رو بدست آورديم.با اين روش و با تابعي كه ميگم ميتونيم برنامه اي اسم فايل اجراييش رو داشته باشيم ببنديم.اما چون ممكنه فايل اجرايي 2 تا برنامه ي جدا 1 اسم داشته باشن ميتونه مشكل پيش بياد و بهتره با استفاده از مسير فايل ها كارمون رو انجام بديم كه هنوز روش بدست آوردن مسير رو نگفتم.
الان روش بستن Process به همين روش رو توضيح ميدم بعد ميرم سراغ بدست آوردن مسير...

همونطور كه اول گفتم بايد با OpenProcess يه هندل از Process ايجاد كنيم :

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

آرگومان اول نوع دسترسي هستش كه ما PROCESS_ALL_ACCESS = &H1F0FFF (همه ي دسترسي ها) رو ميگذاريم و خيال خودمون رو راحت ميكنيم.

آرگومان بعدي رو هم True بگذارين(تاثيري تو كار ما نداره).بعد هم همون آيديه Process هستش . حالا بايد مقدار برگشتي رو به تابع TerminateProcess بديم :

Private Declare Function TerminateProcess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

آرگومان اول همون هندله.دومي رو هم 0 قرار بدين.
حالا ميخواهيم يه برنامه بنوسيم كه هرچي برنامه ي NotePad كه در حال اجراس رو ببنده.(يا هر فايلي كه اسمش notepad.exe باشه ) :

Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID 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 Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) 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 Sub Command1_Click()
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim AppName As String, pID As Long, hProcess As Long

hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Process.dwSize = Len(Process)
pResult = Process32First(hSnap, Process)
Do While pResult <> 0
AppName = Left$(Process.szExeFile, InStr(1, Process.szExeFile, Chr(0)) – 1)
If StrComp(AppName, "notepad.exe", vbTextCompare) = 0 Then 'file name = notepad.exe ?
pID = Process.th32ProcessID
hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
TerminateProcess hProcess, 0
CloseHandle hProcess
End If
pResult = Process32Next(hSnap, Process)

Loop
CloseHandle hSnap
End Sub

در ضمن بعد از اينكه Process رو بستيم هندل رو هم با CloseHandle ميبنديم.

خوب حالا مياييم سراغ بدست آوردن آدرس كامل فايل هاي در حال اجرا.
اگه يادتون باشه واسه بدست آوردن يك ليست از كل Process ها وقتي از تابع CreateToolhelp32Snapshot استفاده كرديم آرگومان اول رو TH32CS_SNAPPROCESS قرار داديم و چون با Process خاصي كار نداشتيم آرگومان دوم رو 0 گذاشتيم.براي اينكه بتونيم اطلاعات ديگه اي از Process ها مانند اطلاعاتModule هايي(dll ها ocx ها و ...) كه Process داره ازشون استفاده ميكنه (و مسير كامل فايل كه اين هم خودش آدرس يكي از همون Module هاست) رو بدست بياريم بايد روي يك Process تمركز كنيم و مثل دفعه قبل نيست كه با يك حلقه اطلاعاتي رو در مورد همه ي Process ها بدست بياريم.براي اين كار بعد از بدست آوردن آيدي هر Process ،آرگومان اول تابع رو Private Const TH32CS_SNAPMODULE = &H8 قرار ميديم و آرگومان دوم رو هم آيدي اون رو.
حالا به جاي استفاده از Process32First و Process32Next از Module32First و Module32Next استفاده ميكنيم:

Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long

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

Private Const MAX_PATH = 260
Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * MAX_PATH
End Type

اوني كه ما باش كار داريم szExePath هستش كه مسير اون Module هستش چون فايلي كه ما ميخواهيم آدرسش رو بدست بياريم هم يكي از همين Module هاست(اولين Module كه توسط تابع Module32First برگردونه ميشه) بنابر اين آدرس همون آدرسيه كه ما دنبالشيم.البته szModule هم فقط اسم Module هستش(بدون مسير)

چون ما اينجا فقط ميخوايم آدرس اولين Module كه همون آدرس فايل Exe هستش رو بدست بياريم و با بقيه Module ها كاري نداريم ديگه واسه Module ها از حلقه استفاده نميكنيم.شما اگه خواستين اين كار رو بكنين فرم كار مثل كد قبيليه كه گذشتم.
كد ما براي بدست آوردن آدرس همه ي فايل هاي در حال اجرا اينطوري ميشه :

Option Explicit
Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPMODULE = &H8
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 260
End Type
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
'Process :
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim pID As Long
'Module :
Dim hSnapM As Long, Module As MODULEENTRY32
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0(
Process.dwSize = Len(Process(
pResult = Process32First(hSnap, Process)
Do While pResult <> 0
pID = Process.th32ProcessID
'
hSnapM = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
Module.dwSize = Len(Module)
Call Module32First(hSnapM, Module)
List1.AddItem Left$(Module.szExePath, InStr(1, Module.szExePath, Chr(0)) – 1)
CloseHandle hSnapM
'
pResult = Process32Next(hSnap, Process)

Loop
CloseHandle hSnap
End Sub

البته با اين روش به دليلي كه نميدونم آدرس كامل يكسري از فايل ها كه تا اونجايي كه چك كردم Process اون ها از نوع System بود و آدرسون هم توي دايركتوريه سيستم(مثل svchost.exe) رو تابع برنميگردونه و فقط اسم اون ها رو برميگردونه!
بگذريم.حالا ميخواهيم برنامه اي كه قبل از اين نوشتيم رو با روش جديدي كه گفتم بنويسيم.يعني بجاي اينكه همه ي فايل هايي كه در حال اجرا هستن و اسمشون notepad.exe هستش رو ببنديم همه ي اونهايي كه آدرسشون c:\windows\systtem32\notepad.exe هست رو ببنديم.كدمون چيز جديدي نداره :

Option Explicit
Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPMODULE = &H8
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 260
End Type
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID 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 Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) 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 Sub Command1_Click()
'Process :
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim pID As Long, hProcess As Long, appPath As String
'Module :
Dim hSnapM As Long, Module As MODULEENTRY32
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Process.dwSize = Len(Process)
pResult = Process32First(hSnap, Process)
Do While pResult <> 0
pID = Process.th32ProcessID
'
hSnapM = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
Module.dwSize = Len(Modul(
Call Module32First(hSnapM, Module)
appPath = Left$(Module.szExePath, InStr(1, Module.szExePath, Chr(0)) – 1)
If StrComp(appPath, "c:\windows\system32\notepad.exe", vbTextCompare) = 0 Then 'file name = notepad.exe
pID = Module.th32ProcessID
hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
TerminateProcess hProcess, 0
CloseHandle hProcess
End If

CloseHandle hSnapM
'
pResult = Process32Next(hSnap, Process)

Loop
CloseHandle hSnap
End Sub

براي تست برنامه فايل notepad.exe رو يكبار از پوشه ي سيستم يبار هم از پوشه ي ويندوز باز كنين.برنامه رو اجرا كنين ميبينين فقط اوني كه توي پوشه ي سيستم هستش بسته ميشه.
اينهايي كه تاحالا گفتم در مورد روش اول بدست آوردن ProcessID بود.راه ديگش همونطور كه اول كار اشاره كردم استفاده از هندل يكي از پنجره هاي برنامه هستش.با اين روش مثلا ميتونين برنامه اي كه موس روش هست رو ببندين.واسه اين كار از تابع 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 تا روش براي اين كار گفتم

*****************************
اموزش برنامه نویسی یک 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

خوب! اينم از اين مبحث.البته توابع مختلفي واسه كار با Console ها هست مثلا واسه رنگي نوشتن و ...

اموزش ویژوال بیسیک

vblog — Sun, 11 Feb 2007 07:26:18 GMT

اینم یک مثال برای اقا حمید که راست به چپ کردن ListView را خواسته بودند
http://www.sharemation.com/MahdiVB678/right%20to%20left%20list%20view%20in%20vb.rar?uniq=6zshb6
فقط ادرس بالا رو در ادرس بار مرورگرت کپی کن و اینتر کن
موفق باشی

سلام دوستان اینم توضیح بعضی فایلهای اساسی ویندوز که خواسته بودید
Ntoskrnl.exe : فایلی است که می توانیم عکس موردنظر را به جای لوگوی ویندوز عوض کنیم
Autoexec.bat : این فایل سیستمی در ویندوزهای 2000 ، me ، xp و 98 مورد استفاده قرار می گیرد . مکان این فایل معمولاً پوشه ی windows می باشد فایل مذکور یک فایل متنی بوده و حاوی فرمانهایی است که در طی عمل راه اندازی سیستم (خصوصاً سیستم عامل های قدیمی تر ) اجرا می شوند
Boot.ini : این فایل سیستمی در ویندوزهای xp ، 2000 استفاده دارد و امکان آن نیز معمولاً پوشه ی windows می باشد . این فایل فهرستی از تمام سیستم عامل های موجود را نشان می دهد و به کاربر اجازه می دهد از میان آنها ، سیستم عاملی را که می خواهد راه اندازی شود را انتخاب کند
Cidaemon.exe : از این فایل سیستمی در ویندوزهای 2000 و xp استفاده می شود مکان این فایل پوشه ی system32 می باشد فایل مذکور معرف microsaft indexing service است و از آن برای به فهرست در آوردن فایل در ویندوزهای 2000 و xp استفاده می شود
سرویسی که این فایل ارائه می دهد indexing service content نام دارد این فایل به کنترل حافظه ی سیستم پرداخته و از استفاده بیش از حد حافظه توسط فایل cidaemon.exe جلوگیری می کند
Cmd.exe : این فایل سیستمی در ویندوزهای xp و 2000 کاربرد دارد . مکان این فایل پوشه ی system32 است . این فایل یک مفسرفرمان 32 بیتی می باشد
Command.com : این فایل سیستمی در ویندوزهای me ,98 استفاده می باشد . این فایل بر روی پوشه ی windows قرار دارد . این فایل یک مفسر فرمان 16 بیتی است
Config.sys : از این فایل در ویندوزهای 2000 ، me ، xpو 98 استفاده می شود . این فایل متنی بر روی پوشه windows قرار دارد و حاوی فرمانهای است که راه اندازها را بارگزاری کرده و پسوندهای اجرایی را در حین راه اندازی سیستم عامل فعال می سازد .
Csrss.exe : این فایل سیستمی در ویندوزهای xp,2000 کاربرد دارد . این فایل در پوشه ی system32 قرار گرفته است . این فایل معرف client server runtime subsystem است و از آن برای برقراری ارتباط ویندوز استفاده می شود
Drvspace.bin : از این فایل سیستمی در ویندوزهای 98 , me استفاده می شود . این فایل در پوشه ی windows قرار گرفته است . این فایل پوسته گرافیکی ویندوز است و ویژگی های مختلفی چون منوی start و نوار وظیفه را فراهم می کند
Io.sys : از این فایل درویندوزهای 2000 ، me ، xpو 98 استفاده می شود . این فایل در پوشه ی windows قرار دارد . این فایل در حقیقت سیستم عامل اولیه ای 16 بیتی است که عمل راه اندازی کامپیوتر را شروع می کند و بخش 32 بیتی ویندوز اجازه می دهد که بالا بیاید
Kernel32.du : این فایل در ویندوزهای 2000 ، xpو 98 کاربرد دارد . مکان این فایل در پوشه ی system32 و یا system است . این فایل سرویسهای هسته ای ویندوز را برای مدیریت حافظه ، منابع سیستم و ... فراهم می کند

برنامه ای برای هک کردن ID و کارت اینترنت که اسمش TAK-ps BETA است
golha.net\ghasem\tak-ps.zip

برنامه ای برای یافتن پسورد ادمین ویندوز XP
http://www.mdvirus.persiangig.com/Hack-%20Admin/XP%20Admin%20Cracker.zip

کامپایل اکسپلویت با VC++
http://nasser-desperado.persiangig.com/video/Compile-exploit-c.rar

برنامه ای برای چک کردن پروفایل
ID خود را بنویسید بعد همه مشخصات پروفایل را نگاه کنید
http://www.mdvirus.persiangig.com/Saftwere%20Yahoo/Get%20ID%20Profile.exe

برنامه ای برای پاک کردن انتی ویروس در سیستم NOD32
http://www.mdvirus.persiangig.com/kill%20%20%20(NOD32)/ANTINOD32.exe

اضافه کردن ایکون به منو
http://iranvig.com/upload/program/userprog/1123311821Project1.zip

سورس دیکشنری
http://iranvig.com/upload/program/userprog/1122546317SkinControl.zip

نشان دادن فونت های سیستم به شکل خودشون در Combo Box
http://iranvig.com/upload/program/userprog/1143060394Font.zip

تبدیل فایل های فلش SWF به SCR ( محافظ صفحه نمايش )
http://iranvig.com/upload/program/userprog/1137787767SWF2SCR.zip

با این کد از صفحه نمایش فیلم بگیرید
http://iranvig.com/upload/program/userprog/1134081859Fi%20a%20acr.zip

این سورس عکس رو به AVI تبديل ميکنه
http://iranvig.com/upload/program/userprog/1133124378PIC2AVI.zip

اين سورس صداي فايل swf رو جدا ميكنه مثل كليپ ها و ...
http://iranvig.com/upload/program/userprog/1131909071SWFs.zip

این سورس فایل های صوتی رو اجرا میکنه مثل MP3 کاربرد زياد داره
http://iranvig.com/upload/program/userprog/1131617424Mp3.zip

ویروس VBLove
امکاناتی مثل مخفی کردن نشانه گر ماوس و مخفی کردن آیکن های Desktop و . . .
http://iranvig.com/upload/program/userprog/1130803460VBLOVE.zip

اين هم يک کد توپ برای بانک اطلاعاتي
وصل شدن به بانک اطلاعاتي با کد نويسي و جستجو و ....
http://iranvig.com/upload/program/userprog/1138481745Anbar2.zip

با این برنامه یک پیغام رو میتونید تو عکس بزارید
یا پیغامی رو که دوست شما تو یه عکس گذاشته رو با این برنامه بخونی
یعنی هر دو باید این برنامه رو داشته باشین
http://iranvig.com/upload/program/userprog/1138481511MS2Pic.zip

یک سورس برای تبدیل FAT32 2 NTFS
http://iranvig.com/upload/program/userprog/1127221140FAT%202%20NTFS.zip

یک برنامه برای ویرایش و تبدیل فرمت انواع عکس
http://www.iranvig.com/upload/program/userprog/1121060957Photo%20Editor%201.0.zip

این برنامه برای ساخت درایو مجازی استفاده می شود
http://www.iranvig.com/upload/program/userprog/1136751292dr.zip

تبدیل عکس به Exe
http://www.iranvig.com/upload/program/userprog/1125514646Picture%20to%20exe.zip

این سورس برای قرار دادن یک قاب زیبا دور یک عکس و گرفتن عکس از فرم به کار میره
http://www.iranvig.com/upload/program/userprog/11252098111.zip

Res فايل ( چند فایل در یک فایل ) اين هم عکس در فايل رس با VB6
http://www.iranvig.com/upload/program/userprog/1124883004Res.Zip

Jpg to Swf
http://www.iranvig.com/upload/program/userprog/1124700167J2S.zip

اين برنامه يک سري اطلاعات سيستم را به شما ميده
مانند : هارد.... و اطلاعات رو به صورت عکس ذخیره میکنه
http://www.iranvig.com/upload/program/userprog/1123438559Infi.zip

ساخت اشیا مثل ( تکست باکس و دکمه و ..... ) با کد نویسی
http://www.iranvig.com/modules.php?name=News&file=log&sid=3029&kind=1

یه ویروس جالب
محدود کردن بعضی از نقاط سیستم
1 - خاموش کردن regedit
- 2 خاموش کردن add\remove
3 - خاموش کردن mmc
4 - خاموش کردن Screen Saver
توصیه میکنم اجرا نکیند
http://www.mina-eilia.persiangig.com/IH@TEYOU.zip
پسوردش هم 12 است

برنامه ای برای فقل کردن پوشه ها
برنامه ای برای مدیرت پوشه ها
این برنامه می تونه پوشه شما رو در حالت disbale , control pannel غيره.... کند
ویژگی های برنامه :گذاشتن پسورد برای برنامه ,خاصيت آيكون روي پوشه ,خاصيت خاموش كردن پوشه
گذاشتن ايكن كنترل پنل بر روي پوشه و خاصيت سطل زباله ويندوز وغيره
http://www.mina-eilia.persiangig.com/LockFolderXP.zip

اموزش ساخت 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

بچه ها در یکی از پست های پایین ( اواسط وبلاگ ) با عنوان ترفند مطالب جدیدی رو نوشتم
چون بچه ها در نظر سنجی بیشتر خواهان اموزش ساخت ویروس بودند
اموزش ساخت ویروس رو گذاشتم و منتظر سری جدید ویروس ها باشید

سلام اقا امیر
اقا امیر فکر میکنم شما باید برنامه خودتون رو به ویندوز بشناسونین تا از این به بعد برنامه شما به جای برنامه پیش فرض ویندوز اجرا بشه که برای این کار ابتدا وارد Folder Option ویندوز شوید و وارد سر برگ File Type شوید و فرمت تصویری مورد نظرتون رو انتخاب کنید و سپس روی دکمه Change کلیک کنید و در پنجره ظاهر شده دکمه Browse رو بزنید و برنامه خودتون رو انتخاب کنید و اگر میخواهید که این کار برای همیشه باشد گزینه Always .... رو در اون پنچره فعال کنید و Ok کنید حالا تصویر مورد نظرتون رو اجرا کنید و نتیجه را به من بگید

جواب اقا حسام عزیز
httpwww.sharemation.comMahdiVB678SocketProgramming.zipuniq=-8v8jiu

خانم ریسی ایمیلتون رو دریافت کردم اینم جوابتون
http://iranvig.com/upload/program/userprog/1138481745Anbar2.zip

جواب یک ناشناس که اموزش فایل های res رو خواسته بودند
http://cuinl.tripod.com/tutorials.htm

جواب اقا حامد عزیز
http://www.sharemation.com/MahdiVB678/new2/pic%20copy.rar?uniq=-goka35

جواب حسین اقا
http://www.sharemation.com/MahdiVB678/new2/amoozeshgah.rar?uniq=-goka2z

جواب اقا امیر عزیز
برای قرار دادن علامت سوال روی نوار عنوان ابتدا باید border style فرم رو در حالت 3 قرار دهی و سپس
در قسمت پایین پنجره خصوصیات خصوصیت What this button رو true کنی و بعد از منوی پروژه گزینه اخر
را انتخاب کنی و یک فایل راهنما که قبلا درست کردی به برنامه اضافه کنی و بعد هر شی که روی فرم قرار
دادی help contex id اون رو به شماره مورد نظر که در فایل راهنتمات طراحی کردی ( که امیدوارم بلد باشی)
که ساخت این فایل ها با برنامه های مخصوصش است که اگه نمیدونستی بگو تا نامشونو بگم و یه توضیح
مختصر بدم .... تغییر بدیو بعد برنامه رو اجرا کنی و روی علامت سوال کلیک و سپس روی شی کلیک کنی
که توضیح درون فایل راهنمات به صورت tool tip اجرا میشود

سوال دوم در مورد اجرای برنامه ها امیر اقا (از دست من ناراحت نشو عزیزم وقت نکردم)
Option Explicit
Dim c As New Shell
Private Sub Form_Load()
' in refrence select microsoft shell control and automasion
Dim a As String
Dim b As String
a = Environ("windir")
b = "\regedit.exe"
b = a + b
MsgBox b
c.Open b
End Sub
براي اجراي هر برنامه فقط قسمت اخر ادرس اونو را مثل من در کدها قرار بده بعد برنامه خودش مسير ويندوز رو تشخيص ميدهد و اجراش مي کند

سوالی در مورد کار با اسکنر و دريافت تصوير از آن در ويژوال بيسيک
بايد از کتابخانه هايی که برای اين منظور ارائه شده اند استفاده کنيد .يکی از اين کتابخانه ها EZ Twain می باشد .برای دريافت dll مربوط به اين کتابخانه و نيز دريافت يک برنامه نمونه کار با اين dll در وي بي اینجا http://www.geocities.com/smigman.geo/mci/eztwain.zip را کليک کنيد

يکی از دوستان در مورد نحوه ايجاد فايلهای exe توسط وِيژوال بيسيک سوال کرده اند
برای ايجاد يک فايل exe توسط برنامه های وي بي بايستی با ساختارهای فايلهای اجرايی آشنا باشيد . برای مثال در مورد Winzip که سوال کرديد چگونه يک Self Extractor می سازد بايد گفت که احتمالاً Winzip يک برنامه اجرايی آماده دارد که يک داده خاص را که در بخش مشخصی از ساختار فايل آن قراردارد extract می کند . در زمان ساخت فايل extractor داده های مربوط به فايلهای zip شما را در فايل اجرايی و در آن محل مشخص بعنوان داده قرار می دهد .
برای آشنايی با ساختار فايلهای اجرايی به کتابهای windows system programming مراجعه کنيد

چگونه برای MP3 Player خودم در وي بي رقص نور مانند Winamp درست کنم ؟
پاسخ : بایستی از ترکیبی از الگوریتم های ریاضی و گرافیکی استفاده کنید . این روشها بسیار متنوع بوده است . اگر در اینترنت کمی بگردید به جواب خواهید رسید.من خودم یه نمونه از اینترنت پیدا کردم

لطفاً در مورد hwnd یا همان هندل فرمها توضیح کامل بدهید .
پاسخ : هر فرم در یک برنامه کاربردی در ویندوز با استفاده از الحاق یک دستگیره یا هندل به آن مشخص می شود . این هندل را با hWnd ( یا HWindow ) نیز نشان می دهیم . برخی توابع کتابخانه ای ویندوز به خاصین هندل فرم جاری بعنوان یک آرگومان نیاز دارند تا عملی را بر روی آن فرم انجام دهند . بعبارت دیگر توسط هندل یک فرم می توان به مشخصات و خصوصیات آن فرم دسترسی داشت . خاصیت هندل فرم در ویژوال بيسيک خاصیتی فقط خواندنی است .
باید توجه داشت که هندل یک فرم با هندل زمینه دستگاه آن متفات است .
زمینه دستگاه یا device context یکی دیگر از مشخصات یک فرم می باشد . در ویندوز هر سطحی که عمل رسم بر روی آن انجام می شود یک زمینه دستگاه نام دارد . برای دسترسی به زمینه دستگاه هر فرم از هندلی به اسم hDC استفاده می شود .

چگونه می توان skin هایی را که با استفاده از وی بی ایجاد می کنیم به سیستممان اضافه کنیم ؟
پاسخ : دوست عزیزی جواب این سوال را داده اند : " شما ميتونيد از برنامه زيبا و توانمند ActiveSkin استفاده کنی که ورژن 4.3 اون رو ميتونی از ZDnet دانلود کنی

چگونه می توان یک فرم را در حالت Always on Top قرار داد ؟
پاسخ : حالت Always on Top حالتی است که در آن همیشه فرم برنامه شما قابل مشاهده در صفحه ویندوز باشد . ( حتی اگر برنامه دیگری انتخاب شده و فعال باشد ) . برای قرار دادن فرم در این حالت از یک API موجود در کتابخانه user32 با نام SetWindowPos استفاده می شود . چگونگی declare کردن این تابع بصورت زیر است ( اين declare را در بالای کدهای مربوط به فرمتان قرار دهيد ) :

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

همچنین ثابتهای زیر را در بالای کدتان تعریف کنید :

Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

یک تایمر با Interval ای برابر 1 در فرمتان قرار دهید و کد زیر را برای متد Timer آن بنویسید تا فرم در این حالت قرار بگیرد :

Dim result As Long
result = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

برای غیر فعال کردن این حالت کد زیر را در برنامه تان بنویسید :

Timer1.Enabled = False
Dim result As Long
result = SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)

برای فعال کردن مجدد این حالت کافیست خاصیت Enabled تایمر را True کنید

چگونه می توان از طریق وي بي با اسکنر ارتباط برقرار نموده و عکس را از آن گرفت و در بانک اطلاعاتی ذخیره نمود .
پاسخ : در مورد بخش آخر سوال که ذخیره عکس در بانک اطلاعاتی می باشد قبلاً مطالبی در این وبلاگ نوشته ام . اما در مورد قسمت اول بایستی از یکسری OCX برای اینکار استفاده کنید مانند Twain Scanning ocx و يا Kodak Image Control ocx

وقتی که یک فرم جهت ورود اطلاعات ساخته می شود باستی از طریق دکمه Tab به فیلدهای بعدی رفت . چگونه می توان کاری کرد که با زدن کلید Enter در هر فیلد به فیلد بعدی رفت ؟
پاسخ : یک روش اینست که در متد KeyPress هر کادر متنی ( یا فیلد ورود اطلاعات ) کدی بنویسید که تشخیص دهد اگر دکمه Enter فشرده شده فوکوس را به فیلد بعدی مورد نظر شما منتقل کند . برای مثال اگر فرض کنید دو کادر متنی با نامهای Text1 و Text2 در فرمتان دارید کد زیر را برای متد KeyPress کادر متنی Text1 بنویسید :

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text2.SetFocus
End Sub

Platform SDK که در سایت Msdn از آن اسم برده می شود چيست ؟ آيا همان سی دی های Msdn است ؟
پاسخ : SDK يا همان source development kit ، شامل يکسری مطلب آموزشی و نمونه کد است که در مورد یک زمینه برنامه نويسی خاص توسط مایکروسافت منتشر می شود . برخی از اين SDK ها قابل دانلود از سايت مايکروسافت ( مثلاً DirectX SDK ) و برخی دیگر فروشی هستند (Windows Driver Model SDK )

پاسخ اقا امیر
http://www.sharemation.com/MahdiVB678/mack%20db.rar?uniq=hz0542
پاسخ اقا محمد
http://www.sharemation.com/MahdiVB678/pass.rar?uniq=hz053q

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

جواب اقا مجتبی عزیزم
قسمت اول : اگر منظورتون ارتباط دادن VB با Access جدول های اونه که بخون :
آشنایی با ابزار مخصوص برقراری ارتباط با پایگاه داده
دو کنترلی که امکان ایجاد این ارتباط را به ما می دهند عبارتند از :

1- Data Control : این کنترل که به طور پیشفرض در جعبه ابزار یا Tool Box وی بی وجود دارد یکی از ابزارهای قدرتمند VB در زمینه کار با پایگاه داده است . در واقع این کنترل نماینده پایگاه داده در VB است و کارهایی از قبیل مدیریت جداول و اندیکس ها و همچنین ایجاد و حذف جدول و رکورد و جستجو و فیلتر سازی و غیره را به عهده دارد . کارایی این کنترل بسیار گسترده و وسیع است و می تواند بهترین انتخاب برای نوشتن برنامه هایی باشد که قرار است فقط روی یک کامپیوتر به طور مستقل اجرا گردند .

2- ADO Objects : این کنترل ابزار دیگری برای ایجاد ارتباط با پایگاه داده است و گستردگی کمتری نسبت به Data Control دارد . از این کنترل معمولا برای ایجاد ارتباط سریع و آسان با پایگاه داده استفاده می شود . همچنین این کنترل توانایی برقراری ارتباط با پایگاه داده واقع در مکانی دیگر با استفاده از سیستم شبکه ای را دارد . ولی این کنترل در جعبه ابزار وجود ندارد و باید به آن اضافه گردد که بعدا خود این کنترل به طور کامل توضیح داده خواهد شد .

برای کار با پایگاه داده فقط ایجاد ارتباط با آن کافی نیست . بلکه ما نیاز داریم که اطلاعات درون جدول ها و رکوردها را مشاهده کنیم و بر روی آنها پردازش انجام دهیم که این کار مستلزم استفاده از ابزارها و کنترل های دیگر است . برای نمونه اگر ما بخواهیم اطلاعات درون یک رکورد که نام یک شخص در آن ذخیره شده است را ببینیم باید آن را توسط یک کنترل که با پیوندی به یکی از کنترل های ایجاد کننده ارتباط با پایگاه داده متصل است به نمایش در آوریم . برای مثال ازکنترل Label استفاده کنیم . حال اگر بخواهیم بر روی این مقدار پردازش هم انجام دهیم باید آن را توسط کنترل Text Box نمایش دهیم چون درون آن را می توانیم ویرایش کنیم.

برای شروع ما با Data Control کار خواهیم کرد.خصوصیت های مهم شی ء Data Control :

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

DataBaseName
این خصوصیت مهمترین خصوصیت کنترل Data به شمار می رود که مسیر و نام پایگاه داده را در خود جای می دهد .

ReadyOnly
این خاصیت مشخص می کند که آیا پایگاه داده میتواند پردازش شود یا باید هیچ تغییری در آن ثبت نشود . که به طور پیشفرض False یعنی قابل پردازش میباشد .

RecordSetType
نوع رکوردست کاری را مشخص می کند که در صورت لزوم توضیح داده خواهدشد .

DataSource
این خصوصیت بعد از تکمیل خصوصیت DataBaseName قابل استفاده است و نام جدول ها و بازجست های ( Query ) موجود در پایگاه داده را به صورت لیست کشویی برای ما نمایش می دهد که ما می توانیم یکی از آنها را انتخاب کنیم .

نکته : در واقع مهمترین مشکل وی بی در کار با پایگاه داده Access این است که اگر شما از کنترل Data برای برقراری ارتباط استفاده کنید و فرمت پایگاه داده شما بالاتر از Access 97 باشد یعنی ( 2000 ، XP ، 2003 ) با خطایی مبنی بر عدم پشتیبانی یا شناسایی مواجه خواهید شد . یا به عبارتی شما در صورتی میتوانید از کنترل Data برای برقراری ارتباط با پایگاه داده Access استفاده نمایید که فرمت پایگاه داده شما Access 97 یا همان ( Office 97 ) باشد . برای حل این مشکل چند راه حل وجود دارد :

راه 1 : از کنترل ADO یا Adodc به جای Data استفاده کنید که این کار در بیشتر مواقع نمی تواند به صرفه باشد .

راه 2 : فرمت پایگاه داده شما Access 97 باشد یعنی باید از برنامه Access موجود در Office 97 استفاده کنید که در این صورت مجبور خواهید بود با ویندوز 98 کار کنید . چون XP قادر به پشتیبانیAccess 97 نخواهد بود .

یک مثـــــــــــــــــــــــــــــــال برای اقا مجتبی : استفاده از کنترل Data
یک پروژه از نوع استاندارد ایجاد نمایید Form1

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

تنظیم خواص DataBaseName و RecordSource : برای این کار خاصیت مربوط به Data1 را با انتخاب پایگاه داده خود تنظیم کنید . برای مثال اگر پایگاه داده شما در C:\Test VB\Test.mdb قرار داشته باشد پس از انتخاب پایگاه داده مورد نظر مقابل خاصیت DataBaseName شما برابر با این آدرس خواهد شد . حال روی خاصیت RecordSource کلیک کنید تا لیست جداول برای شما نمایش داده شود . شما جدول Simple را انتخاب کنید . حال 3 عدد TextBox روی فرم خود قرار دهید و خاصیت های آنها را به صورت زیر تنظیم کنید :

نام کنترل خاصیت DataSource خاصیت DataField

Text1 Data1 ID

Text2 Data1 Name

Text3 Data1 Family

همانطور که در تصویر می بینید با استفاده از کنترل Label می توانید برچسب مربوط به فیلد خود را برای کاربر نمایش دهید تا کاربر درک درستی از برنامه داشته باشد .

همانطور که در تصویر دیده می شود خاصیت Enabled مربوط به TextBox فیلد شماره False است یعنی فقط کاربر قادر به دیدن شماره می باشد و نمی تواند آن را تغییر دهد ، این به این دلیل است که این شماره چون از نوع Autonumber در نظر گرفته شده و برنامه به طور خودکار برای هر رکوردی که ایجاد می شود یک شماره تولید می کند پس کاربر حق تغییر آن را نخواهد داشت مگر در شرایطی خاص .

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

برای این کار تقریبا مانند قبل عمل خواهیم کرد با این تفاوت که نه پایگاه داده خود را برای کنترل Data انتخاب خواهیم کرد و نه خاصیت DataField را برای TextBox های خود . بلکه این کار ها را با کد نویسی انجام خواهیم داد.

نکته : خاصیت DataSource مربوط به TextBox ها را باید در هنگام طراحی تنظیم کنیم . چون امکان تنظیم آن با کد نویسی وجود ندارد .

حال شما در Form_Load برنامه این کد ها را باید بنویسید :

بار کردن پایگاه داده :

"Data1.DatabaseName = "C:\Test VB\Test.mdb

تنظیم جدول مورد نظر :

"Data1.RecordSource = "Simple

تنظیم فیلدها برای TextBox ها :

"Text1.DataField = "ID
"Text2.DataField = "Name
"Text3.DataField = "Family

کد کامل برنامه :

()Private Sub Form_Load
"Data1.DatabaseName = "C:\Test VB\Test.mdb
"Data1.RecordSource = "Simple
Data1.Refresh
"Text1.DataField = "ID
"Text2.DataField = "Name
"Text3.DataField = "Family
End Sub

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

برای یافتن پاسخ قسمت دوم سوالت به وبلاگ اقا ناصر که لینکش رو در پیوند ها گذاشتم برو و اموزش Crack1 رو به روشی که گفته دانلود کن و لذت ببر
موفق باشی

سوال علی اقا:
نکته : میخوام یه ادعا کنم که نمی تونید سوالی کنید که نتونم جواب بدم. امتحان کنید
برنامه اي كه در ورودي پسورد دريافت مي كند و در صورت برابر بودن با پسورد ذخيره شده در فايل Dll موجود در حافظه اجازه ورود به قسمت ديگري از برنامه را دهد
نكته :
1 ) اين برنامه توانايي تغيير پسورد را داشته باشد
2 ) پسوردي را كه از كاربر براي ذخيره كردن دريافت مي كند ، پس از اعمال تغييراتي در آن ، در فايل Dll ذخيره كند ( به نحوي كه اگر شخصي فايل Dll برنامه را باز كرد نتواند پسورد را بخواند )

جواب :
براي ساخت اين چنين برنامه اي بايد با نحوه ايجاد فايل در وي بي آشنا شويم
براي سخت فايل در VB ابتدا فايل را در محلي از هارد ديسك باز كرده ، پس از آن شروع به نوشتن و خواندن در فايل مي كنند .
ما در اين برنامه نياز داريم كه از قبل يك پسورد در اين فايل ذخيره كند ، براي اين چنين كاري از قطعه برنامه زير استفاده مي كنيم :
نكته : اين قطعه برنامه فقط براي ايجاد يك پسورد در فايل مربوطه به كار مي رود و پس از ايجاد اين فايب بايد پاك شود .
Private Sub Form_Load()
N$="ali"
Fir i= 1 to len(n$)
a = Mid(n$, i, 1(
r = Asc(a(
r = r + 70
c$ = c$ + Chr(r(
Next
Open "d:\p.dll" For Output As #1
Write #1, c$
Close
End Sub
همانگونه كه ملاحظه نموديد ، ما پسورد پيش فرض ali را براي اين برنامه انتخاب نموديم و با استفاده از يك حلقه تكرار و تابع Mid به تك تك كاراكتر هاي آن دسترسي پيدا كرديم و در هر دسترسي آن را به كد اسكي آن كاراكتر تبديل نموده و براي ايجاد امنيت به گونه اي كه كسي توان خواندن پسورد را با باز كردن فايل Dll نداشته باشد ، 70 عدد به كد اسكي آن اضافه نموديم و سپس با تابع Chr به يك كاركتر تبديل نموديم ، همانطور كه مي بينيد اين كاراكتر ها جمع شده و در متغير C$ به صورت يك رشته جمع شده اند . در پايان اين قطعه فايلي با استفاده از دستور Open در دايو D ايجاد و باز مي شود و رشته C$ در آن نوشته مي شود . در انتها هم فايل بشته مي شود .
براي ايجاد اين فايل كافي است كه يك بار برنامه را اجرا كنيد .
تذكر : پس از اتمام اين كار اين قطعه برنامه را پاك كنيد .

طراحي :
اين پروژه شامل دو فرم مي باشد كه وظيفه فرم اول دريافت پسورد از كاربر و چك كردن آن با پسورد ذخيره شده در فايل Dll است ، اگر پسوردها يكسان نبودند ، كاربر با پيام I'm Sorry مواجه مي شود و اگر دو پسورد يكسان بودند ، برنامه پس از فرستادن پيام Ok ، فرم دوم را ظاهر مي كند كه در آن كاربر مي تواند پسورد درون فايل Dll را تغيير دهد .

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

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

قطعه كد كليد Sign Out :
Private Sub Command2_Click()
Form1.Show
Form2.Hide
End Sub
قطعه كد كليد Quit :
Private Sub Command3_Click()
End
End Sub

سوال سخت : ( اقا حمیـــــــــــــــــــــــــــــــد )
چطور ميشه کنترلي نوشت که اگه چند تا از اونها رو توي فرم بندازيم بتونن همديگرو پيدا کنن مثله Raido Button

جواب :
Dim c As Control
For Each c In UserControl.Parent.Controls
If TypeOf c Is UserControl1 Then
MsgBox c.Name
' Put your code here
End If
Next

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

اموزش درخواستی

vblog — Sat, 16 Dec 2006 11:59:12 GMT

اموزش مقدماتی کامل برای مبتدیان

http://www.schoolnet.ir/tutorial/vb/

اشاره :
يك بازي كامپيوتري را روي كامپيوترتان اجرا مي‌كنيد. فعلا‌ً كارت گرافيك شما روي اسلا‌تAGP سوار مي‌شود، پردازشگر سلرون داريد و ... پس از چند ماه يا چند سال كامپيوتر جديدي مي‌خريد. اكنون اسلا‌ت كارت گرافيكي شما PCI Express است و يك پردازشگر 64 بيتي داريد. همان بازي را روي اين كامپيوتر هم نصب و اجرامي‌كنيد! شايد به نظر طبيعي ميآيد كه همه چيز بايد همين‌طور باشد. اما چگونه يك بازي روي كامپيوترهايي با تراشه‌ها و سخت‌افزارهاي مختلف و گاه فناوري متفاوت اجرا مي‌شود؟ API‌هاي گرافيكي يا همان رابط‌هاي برنامه‌نويسي، بخش بزرگي از اين مشكل را حل مي‌كنند و امكانات گسترده ديگري را نيز در اختيار برنامه‌نويسان و توسعه‌دهندگان بازي و برنامه‌هاي چندرسانه‌اي قرارمي‌دهند. OpenGL وDirectX، دو مجموعه API گرافيكي و صوتي هستند كه براي آسان‌تر ساختن توسعه بازي‌ها و نرم‌افزارهاي چندرسانه‌اي طراحي شده‌اند.

API گرافيكي چيست؟
API درواقع بين برنامه و سخت‌افزاري كه برنامه روي آن اجرا مي‌شود، نقش يك هماهنگ‌كننده را دارد و مانند پلي ميان سخت‌افزار و نرم‌افزار ارتباط ايجاد‌مي‌كند. يعني برنامه‌نويس كدهايي مي‌نويسد كه داده‌هاي گرافيكي خود را به وسيله دستورهاي استانداردي به درايور API مي‌فرستد نه مستقيماً به خود سخت‌افزار. سپس درايوري كه شركت سازنده سخت‌افزار توليد‌كرده است، اين كداستاندارد توليدشده را به فرمت بومي و ويژه‌اي كه براي آن مدل خاص سخت‌افزار قابل شناسايي است، ترجمه مي‌كند.

Microsoft DirectX
شركت مايكروسافت در سال 1995 DirectX را ساخته و توسعه داده‌است. اين نرم‌افزار شامل مجموعه‌ يكپارچه‌اي از ابزارهاي برنامه‌نويسي است كه به توسعه‌دهندگان امكان مي‌دهد انواع مختلف نرم‌افزارهاي مالتي‌مديا را روي پلتفرم ويندوز توليد كنند. DirectX به برنامه‌اي كه بر پايه آن طراحي شده امكان مي‌دهد به آساني قابليت‌هاي سخت‌افزار كامپيوتر را شناسايي كند و پارامترهاي برنامه را با آن هماهنگ سازد.

DirectX شامل APIهايي است كه دسترسي به بخش‌هاي ويژه‌اي از سخت‌افزار مانند تراشه‌هاي شتاب‌دهنده گرافيك سه‌بعدي و كارت صوتي را ميسرمي‌كند. اين APIها كنترل توابع سطح پايين، يعني نزديك به سخت‌افزار، شامل شتاب‌دهنده گرافيكي دو بعدي، پشتيباني از دستگاه‌هاي ورودي مانند دسته بازي، صفحه‌كليد و ماوس، و كنترل ميكس و خروجي صدا را انجام مي‌دهند.

DirectX 7.0 در سال 1999 با شش كامپوننت عرضه شد كه عبارت بودند از: Direct3D،DirectDraw ،DirectSound ،DirectPlay ،DirectInput و DirectMusic.

در اواخر سال 2000 ميلا‌دي، DirectX 8.0 عرضه شد كه در آن كامپوننت‌هاي DirectSound و DirectMusic با هم ادغام شدند و با نام كامپوننت Direct Audio معرفي شدند.

Direct3D و DirectDraw نيز با هم ادغام شدند و يك كامپوننت با نام DirectX Graphics را ساختند. DirectShow نيز به صورت يك API جداگانه پياده‌سازي شد و به يكي از كامپوننت‌هاي DirectX تبديل گرديد.

DirectX 9.0 در ژانويه سال 2003 عرضه شد. ويژگي‌هاي خاص اين نسخه عبارتند از:

- قابليت‌هاي صوتي جديد در DirectSound
- سخت‌افزار رندركننده ويديويي با شتاب بيشتر
- بهبود قابليت برنامه‌ريزي گرافيكي

APIهاي همه كامپوننت‌هاي DirectX برپايه COM يا Component Object Model هستند. در ادامه به بررسي هفت كامپوننت DirectX 9.0 مي‌پردازيم كه عبارتند از: DirectDraw ،Direct3D ،DirectShow ،DirectSound ،DirectMusic ،DirectInput و DirectPlay.

1- DirectDraw
DirectDraw، كامپوننتي ويژه طراحي دوبعدي است كه به برنامه‌نويس اجازه مي‌دهد مستقيماً به حافظه كارت گرافيك دسترسي يابد، صحنه‌ها و فريم‌ها را با هم تركيب نمايد يا bitmapها را در آنجا ذخيره كند. همچنين، براي برنامه‌ها امكان دسترسي به سخت‌افزارهاي ويژه نمايش را مستقل از نوع سخت‌افزار فراهم مي‌كند.
هر برنامه كاربردي DirectDraw الگوي يكساني دارد كه عبارت است از:

- ايجاد يك شي
- شروع حلقه
- انتقال به مانتيور
- پايان حلقه
- پاك كردن آن شي‌

منظور از واژه <يك شي> مي‌تواند هر تصوير دوبعدي‌اي باشد و منظور از حلقه، حلقه‌اي است كه در برنامه‌نويسي هنگام تكرار منظم دسته‌اي از داده‌ها يا دستورها به كار مي‌بريم. تصوير ايجاد‌شده پس از مدتي پاك مي‌شود و جاي خود را به تصوير ديگري مي‌دهد.

2- Direct3D
اين كامپوننت، دسترسي به توابع رندركننده گرافيك سه‌بعدي تعبيه شده در بيشتر كارت‌هاي گرافيك را فراهم مي‌كند. Direct3D يك API سطح پايين سه‌بعدي است كه به نرم‌افزار امكان مي‌دهد مستقل از سخت‌افزار، با سخت‌افزار شتاب‌دهنده ارتباط برقرار كند. لا‌يه‌اي كه براي توسعه‌دهندگان بازي و گرافيك كامپيوتري امكان طراحي و ساخت بازي‌ها را مستقل از سخت‌افزار كامپيوترها فراهم مي‌كند، لا‌يه‌اي به نام
Hardware Abstraction Layer) HAL) است.

HAL با قابليت‌هايي كه به صورت گسترده در سخت‌افزارهاي گرافيك سه‌بعدي پياده‌سازي شده‌اند ارتباط ايجاد مي‌كند و به سازندگان امكان‌مي‌دهد درايورهايي را توليد كنند كه لا‌يه HAL را به سخت‌افزار پيوند دهد. اين كار باعث مي‌شود برنامه‌هاي كاربردي Direct 3D بدون اين‌كه براي نوع خاصي از قطعه سخت‌افزاري نوشته شده باشد، از ويژگي‌هاي بخش‌هاي خاص آن قطعه سخت‌افزاري بهره‌ببرد. در شكل يك چگونگي ارتباط لا‌يه HAL با سخت‌افزار و نرم‌افزارهاي مرتبط نشان داده شده است.

شكل - چگونگي ارتباط لا‌يه HAL با كارت گرافيك و نرم‌افزارهاي مرتبط
http://www.shabakeh-mag.com/Data/Gallery/s63_gpl_1_s.jpg

همان‌گونه كه در شكل يك، نشان داده شده، نرم‌افزار بازي بالا‌ترين سطح است و پس از آن كامپوننت‌هاي ترسيم دوبعدي و سه بعدي، يعني DirectDraw و Direct3D قرار دارند. لا‌يه HAL يك رابط ميان كامپوننت‌هاي DirectX و كارت گرافيك است.

در سيستم رندر Direct3D، ساختار اشياي سه‌بعدي پيش از آن‌كه شتاب‌دهنده سه‌بعدي، يك صحنه سه‌بعدي را رندر نمايد و آن را به مانيتور منتقل كند، به وسيله CPU پردازش مي‌شود. نسخه ششم كامپوننت Direct3D از قابليت‌هاي كارت‌هاي گرافيك جديدتر پشتيباني مي‌نمايد و در هر گذر، چندين بافت را با هم رندر مي‌كند.

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

مانند anistropic filtering كه عنصر عمق را به trilinear filtering و نقشه برجسته‌سازي مي‌افزايد كه موجب ايجاد شباهت بيشتر بافت‌ها و نيز منابع نور تابيده شده بر سطوح مسطح با نمونه‌هاي واقعي آن‌ها مي‌شود.

نسخه هفتم DirectX نسبت به نسخه‌هاي پيش از خود بيست درصد سريع‌تر و شامل چند ويژگي ديگر بود. مهم‌ترين آن‌ها پشتيباني از تغييرات شتاب سخت‌افزاري و نوردهي (T&L) به وسيله اغلب كارت‌هاي گرافيك سه‌بعدي آن‌زمان به ويژه كارت‌هايي است كه برپايه تراشه‌هاي nVidia Geforce 256 و S3 Savage 2000 ساخته شده‌اند. از زماني كه T&L عرضه شد، وقت‌گيرترين وظيفه CPU هنگام اجراي بازي‌هاي پيشرفته به شتاب‌دهنده سه‌بعدي داده شد و بخش بزرگي از ظرفيت پردازنده اصلي به كارهاي ديگر مانند هوش‌مصنوعي بازي اختصاص داده شد و توسعه‌دهندگان بازي توانستند رندر را با جزئيات بيشتر انجام دهند و جلوه‌هاي ويژه پيچيده‌تري را در بازي‌ها به‌كار ببرند.

3- DirectShow
اين كامپوننت از بسياري از فرمت‌هاي صوتي و ويديويي شامل AVI ،MPEG ،ASF ،WMA/WMV ،DV و MP3 و DirectX پشتيباني مي‌كند و روي ويندوزهاي 98، 2000، اكس‌پي و نرم‌افزار اينترنت اكسپلورر عرضه شده است.DirectShow پروسه كارهاي مالتي‌مديا مانند نمايش فايل ويديويي را به مجموعه‌اي از مراحل كه با نام
filter شناخته مي‌شوند تقسيم مي‌كند.

فيلترها تعدادي pin ورودي و خروجي دارند كه آن‌ها را به هم متصل مي‌كند. طراحي كلي سازوكار اتصال به اين صورت است كه فيلترها مي‌توانند به روش‌هاي مختلف به هم متصل شوند كه هر نوع از اين اتصال‌ها به معني انجام دادن يك كار است و توسعه‌دهندگان نرم‌افزار مي‌توانند افكت‌هاي خود يا فيلترهاي ديگري را به بخشي از اين گراف براي انجام كار ويژه‌اي بيفزايند. گراف فيلتر DirectShow به صورت گسترده در ضبط صدا و فيلم، و ويرايش آن‌ها به كار مي‌رود.

شكل - يك گراف فيلتر كه كار نمايش يك فايل MPEG را نشان مي‌دهد.

در شكل دو، يك گراف نمايش براي فايل فيلمي از نوع MPEG نشان داده شده است. برنامه‌هاي كاربردي DirectShow، براي پردازش داده‌هاي مالتي‌مديا، از اين گراف استفاده مي‌كنند.

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

ولي در برخي مواقع، برنامه كاربردي علا‌وه بر كنترل گراف، دريافت‌كننده يا فرستنده داده نيز هست.

هر گره اين گراف، همانگونه كه گفته شد، يك فيلتر است و كار ويژه خود را انجام مي‌دهد. فيلتر source، داده‌ها را از يك فايل يا URL مي‌خواند. فيلتر Parser، بخش‌هايي از داده‌هاي صوتي و ويديويي را به رمزگشاي مناسب مي‌فرستد. رمزگشاها، داده‌هاي صوتي و ويديويي را رمزگشايي مي‌نمايند يا از حالت فشردگي خارج مي‌كنند.
فيلتر رندركننده، داده‌هاي دريافت شده صوتي و ويديويي از رمزگشا را پخش مي‌كند يا آن‌ها را نمايش مي‌دهد.

4- DirectSound
اين كامپوننت همزمان با ساخت ويندوز 95، زماني كه درايورهاي صوتي از نوع VXD بودند به DirectX افزوده شد. در اين كامپوننت APIهاي ويژه‌اي ايجاد شد كه نويسندگان درايورهاي صوتي مي‌بايست آن‌ها را به محصولا‌ت خود، كه فرمت VXD داشت، مي‌افزودند تا به درستي با DirectSound كار كند.

برنامه‌هاي چندرسانه‌اي با اين كامپوننت به سخت‌افزارهاي صوتي مانند كارت صوتي دسترسي پيدامي‌كنند. از مهم‌ترين ويژگي‌هاي اين API، تركيب صدا و كنترل سطح آن است.

DirectSound همچنين اجازه مي‌دهد چندين برنامه كاربردي، بدون پيش آوردن وقفه، همزمان به كارت صوتي دسترسي داشته باشند. ايجاد افكت‌هاي صوتي از ديگر توانايي‌هاي DirectSound است. پس از سال‌ها توسعه، اكنون DirectSound يك API پخته و كامل است و بسياري قابليت‌هاي ديگر را نيز فراهم مي‌كند؛ مانند قابليت پخش صداهاي چند كاناله با وضوح و دقت بالا‌.

5- DirectMusic
تاكنون بازي‌هايي را تجربه كرده‌ايد كه در تمام مدت يك مرحله، موسيقي يكنواخت و ثابتي دارند؟ بازي‌اي را در نظر بگيريد كه برنامه‌نويسان آن مي‌خواهند يك آهنگ، در تمام مدت، در يك مرحله از آن به صدا دربيايد. با استفاده از برنامه DirectMusic Producer، آن‌ها مي‌توانند در آن مرحله براي آهنگ، يك درجه در نظر بگيرند.

اين درجه مي‌تواند بسته به نوع عملكرد شخصيت بازي، تغيير كند. اگر شخصيت بازي در حال راه رفتن است، آهنگ آرام و هنگامي كه با دشمن خود مبارزه مي‌كند، آهنگ تندتر مي‌شود و يا نوع آهنگ تغيير مي‌كند و هنگامي كه مبارزه تمام مي‌شود، آهنگ دوباره آرام مي‌شود. اين تغييرها بدون ايجاد وقفه، به صورت پويا و بدون دخالت كاربر انجام مي‌شود. چون براساس DirecMusic، آهنگ به صورت شناور و بدون وقفه با نواختن وارياسيون‌هاي مختلف با قابليت واكنش به رويدادهاي بازي توليد مي‌شود.

DirectMusic، با داده‌هاي موسيقي براساس پيام‌هاي حاوي اطلا‌عات كار مي‌كند. يك آهنگ مي‌تواند در داخل سخت‌افزار و با نرم‌افزارهاي آهنگ‌ساز مانند Microsoft ‌Synthesizer ساخته شود. DirectMusic از استانداردهايMIDI و DLS پشتيباني مي‌كند.

6- DirectInput
اين كامپوننت، سازوكار مشتركي را براي دسترسي به بسياري از كنترل‌كننده‌هاي بازي مانند دسته بازي، گيم‌پد، صفحه كليد و ماوس فراهم مي‌آورد. مهم‌ترين تغييري كه هنگام عرضه DirectX8 در DirectInput ايجاد شد، آمدنaction map بود. action map از توابعي مانند راندن يك وسيله يا شليك يك گلوله (كه به‌وسيله دستگاه‌هاي ورودي ايجاد مي‌شود) استفاده مي‌كند. زماني كه يك سخت‌افزار ورودي مانند دسته بازي را مي‌خريد، معمولا ‌ًaction mapنيز براي بسياري از انواع رايج بازي‌ها مانند شبيه‌ساز پرواز، تيراندازي اول شخص و بازي‌هاي مسابقه‌اي در آن پياده‌سازي شده است.

7- DirectPlay
اين كامپوننت امكان بازي چند نفر را در بازي‌هاي چندنفره فراهم مي‌آورد، دسترسي به سرويس‌هاي ارتباطي را آسان مي‌سازد و راهي را براي بازي‌ها فراهم مي‌كند تا مستقل از پروتكل يا نوع سرويس آنلا‌ين با يكديگر در ارتباط باشند. همچنين از پروتكل‌هاي ارتباطي مطمئن پشتيباني‌مي‌كند تا مانع از گم شدن داده‌هاي مهم بازي روي شبكه شود. در واقع DirectPlay به صورت لا‌يه‌اي است كه روي پروتكل‌هاي معمول شبكه مانند IPX ،TCP/IP و ... قرار دارد.

در واقع يك session يا جلسه در DirectPlay يك كانال ارتباطي بين چندين كامپيوتر است. يك برنامه كاربردي پيش از آن‌كه بتواند با سيستم‌هاي ديگر ارتباط برقرار كند، بايد در يك Session يا جلسه باشد. هر جلسه تنها يك ميزبان دارد و آن برنامه كاربردي‌اي است كه آن جلسه را ايجاد كرده‌است. تنها ميزبان مي‌تواند ويژگي‌هاي يك Session را تغيير دهد.

DirectX 9.0
اين كامپوننت، آخرين نسخه DirectX تا پيش از عرضه رسمي ويندوز ويستا است. مهم‌ترين چيزي كه همراه DirectX 9.0 عرضه شد، High-Level Shader Language) HLSL) است. زبان HLSL جايگزين زبان اسمبلي براي نوشتن pixel shaderها و vertex shaderها در DirectX است. پيش از ارائه DirectX 9.0 توسعه‌دهندگان بازي بايدshader‌ها را با استفاده از يك زبان اسمبلي سطح پايين توسعه مي‌دادند. HLSL با فراهم‌آوردن يك محيط برنامه‌نويسي توسعه‌دهنده ساده، توسعه همه بخش‌هاي نرم‌افزار مانند انيميشن و برنامه‌نويسي افكت‌ها را آسان مي‌كند.

HLSL با همه پردازشگرهاي گرافيكي (GPU) سازگار با DirectX كار مي‌كند و به توسعه‌دهندگان امكان مي‌دهد افكت‌هاي بصري را روي گستره وسيع‌تري از پلتفرم‌ها ايجاد كنند؛ بدون اين‌كه نياز داشته باشند به جزئيات سخت‌افزار گرافيكي توجه كنند.

DirectX 9.0 روي ويندوز 95 نصب نمي‌شود. چون بازي‌هايي كه به DirectX 9.0 نياز دارند، به كامپيوترهاي جديدتر و قوي‌تري هم نياز دارند كه ويندوز 98 يا نسخه‌هاي جديدتر روي آن‌ها نصب مي‌شود. تاكنون نسخه‌هاي a ،b و c از DirectX 9.0 ارائه شده است. هر نسخه جديدتر از DirectX داراي امنيت، كارايي و سيستم رفع خطاي بهتري است.

DirectX 10
دوستداران بازي بايد خوشحال باشند از اين‌كه بدانند شركت مايكروسافت DirectX را نيز توليد كرده است و همراه پيش توزيع Direct3D 10 عرضه خواهد شد. همچنين نرم‌افزارMicrosoft Windows Game Explorer نيز عرضه شده‌ كه به برنامه‌نويسان و توسعه‌دهندگان امكان مي‌دهد امكانات بروزكردن خودكار (auto-updating) را به بازي‌هايشان بيفزايند. مايكروسافت مي‌خواهد DirectX 9.0 و DirectX 10 را روي ويندوز ويستا عرضه كند. به گفته Rodolph Balaz از برنامه‌نويسان توسعه‌‌دهنده Direct3D و OpenGL در مايكروسافت، DirectX 10 تنها با سيستم‌عامل‌هاي جديد كار خواهد كرد و در حال حاضر مايكروسافت، برنامه‌اي براي پشتيباني ويندوز اكس‌پي از آن ندارد.

تا زمان نوشته شدن اين مقاله هنوز نسخه رسمي ويندوز ويستا عرضه نشده است. ولي به نظر مي‌آيد اين ويندوز، هم از DirectX 10 و هم از DirectX 9.0 پشتيباني خواهد كرد.

SGL OpenGL
شركت سيليكون گرافيكس(SGI ،OpenGL) را با هدف ساخت يك API براي توسعه برنامه‌هاي گرافيكي دوبعدي و سه بعدي عرضه‌كرده‌است. پيش از ساخته شدن APIهاي گرافيكي مانند OpenGL و DirectX، بسياري از توليدكنندگان سخت‌افزار، كتابخانه‌هاي گرافيكي مختلف و متفاوتي داشتند. به همين دليل پشتيباني از نسخه‌هاي مختلف نرم‌افزارهايشان روي پلتفرم‌هاي سخت‌افزاري مختلف هزينه‌بر و انتقال يك برنامه كاربردي از يك پلتفرم سخت‌افزاري به پلتفرم سخت‌افزاري ديگر بسيار وقت‌گير و سخت بود.

بنابراين SGI نمونه برنامه‌اي را توليد كرد كه توليدكنندگان سخت‌افزار بايد از آن براي توسعه درايورهاي OpenGL در سخت‌افزارهايشان استفاده كنند. اين برنامه به صورت اپن‌سورس ارائه شده‌است. ولي سازندگان اين سخت‌افزارها مي‌توانند قابليت‌هاي گوناگوني را برپايه OpenGL در سخت‌افزارهايشان ايجاد كنند. تصميم‌گيري درباره ايجاد تغييرات در OpenGL را كنسرسيوم ARB اتخاذ مي‌كند.

اين كنسرسيوم شامل اعضاي مهمي همچون اپل، اينتل، آي‌بي‌ام، سان، ATI، دل، nVIDIA، سيليكون‌گرافيكس و3Dlabs است و از سوي شركت‌هاي معتبر ديگري مانند متراكس، S3 ،Xi و Quantum 3D حمايت مي‌شود. توسعه‌دهندگان نرم‌افزار براي استفاده از OpenGL در نرم‌افزارهايشان نيازي به اخذ مجوز ندارند. ولي توليدكنندگان سخت‌افزار براي پياده‌سازي سخت‌افزاري OpenGL نيازمند اخذ مجوز از SGI هستند.

OpenGL چيست؟
در اوايل پيدايش OpenGL، از اين API در كارهاي صنعتي، طراحي وسايل داخلي، مكانيكي و نيز در آناليزهاي علمي و آماري استفاده مي‌شد.

در سال 1996، نويسندگان و توسعه‌دهندگان بازي‌هاي كامپيوتري از نسخه ويندوزي OpenGL براي ساخت بازي‌هاي كامپيوتري استفاده كردند. OpenGL براي پشتيباني از گستره وسيعي از تكنيك‌هاي رندركردن گرافيكي پيشرفته طراحي شده است كه مي‌توان پاره‌اي از آن‌ها را به اين‌صورت نام برد:

نورپردازي: قابليت تحليل ميزان رنگ هنگام تابش مدل‌هاي متفاوت نور به يك سطح از يك يا چند منبع نور مختلف.

سايه‌سازي نرم: قابليت تحليل افكت‌هاي سايه هنگام تابش نور به يك زاويه و ايجاد اختلا‌ف نور خفيف در مقابل آن سطح (مانند نور كمي كه هنگام تابش آفتاب به يك صخره يخي در اطراف آن ايجاد مي‌شود).

حركت محو ومدل‌سازي: توانايي تغيير مكان و اندازه پرسپكتيو يك شي در فضاي سه بعدي.
مجموعه امكانات OpenGL شبيه Direct3D است. ولي API سطح پايين‌تر آن (نزديك‌تر به سطح سخت‌افزار) باعث مي‌شود كنترل خوبي روي عناصر اصلي ايجاد صحنه‌هاي سه بعدي مانند اطلا‌عات سه‌ضلعي‌ها كه سلول‌هاي تشكيل‌دهنده يك مدل سه بعدي هستند داشته باشد.

دو سطح پشتيباني از شتاب‌دهندگي سخت‌افزاري براي OpenGL وجود دارد: installing client driver) ICDs) كه به نوردهي ايجاد تغيير و رستركردن (تبديل يك فريم سه بعدي چند ضلعي ذخيره شده درframe buffer به يك تصوير كامل با بافت‌ها و نشانه‌هاي عمق و نور) شتاب مي‌دهد و mini client server) MCs) كه از رستركردن پشتيباني مي‌كند.

OpenGL 1.4 و OpenGL 1.5 به‌ترتيب در تابستان 2002 و 2003 معرفي شدند كه هر يك امكانات و كاربردهاي بيشتري از نسخه‌هاي پيش از خود داشتند. بزرگ‌ترين آن‌ها OpenGL Shading Language بود؛ زباني ويژه برنامه‌نويسي vertex-shader و pixel-shader كه در صورت نياز به OpenGL الصاق مي‌شد. OpenGLShading Language زباني شد كه به سرعت در سطح گسترده‌اي مورد پشتيباني يونيكس، ويندوز، لينوكس و ديگر سيستم‌عامل‌ها براي توسعه‌دهنده گرافيك‌هاي تعاملي و برنامه‌هاي كاربردي ترسيمي قرار گرفت.

OpenGL 2.0
OpenGL 2.0 آخرين نسخه عرضه شده تا اوايل سال 2006 ميلا‌دي است. OpenGL Shader Language همراه با اين نسخه عرضه شده و بر پايه استاندارد ANSYC طراحي شده است. برخي قابليت‌هاي تازه اين نسخه عبارتند از:

- سايه‌زني قابل برنامه‌ريزي به‌وسيله OpenGL Shader Language و APIهاي آن. قدرت ايجاد Shader و برنامه‌نويسي اشيا، بخش ديگري از تغييرات ايجاد شده در اين نسخه است.

- رندر چندگانه كه به shaderهاي قابل برنامه‌نويسي امكان مي‌دهد در بافرهاي خروجي چندگانه در يك گذر مقادير مختلفي بنويسند.

- بافت‌هاي دو طرفه، با قابليت تعريف كاربرد آن بافت براي سطح جلو و پشت يك مدل اوليه كه كيفيت حجم سايه و كارايي الگويم‌هاي رندر هندسي اشياي سخت را ارتقا مي‌دهد.

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

- بافت‌هاي Non-power-of-two كه براي همه انواع بافت‌ كاربرد دارد كه در نتيجه از بافت‌هاي چهارگوش پشتيباني مي‌نمايد و درعمل حافظه كمتري اشغال مي‌كند.

OpenAL
OpenAL، يك API ديگر است كه براي ايجاد و مديريت صداهاي سه بعدي در بازي‌هاي كامپيوتري و ديگر انواع نرم‌افزارها به صورت يك پروژه مشترك ميان شركت Loki Software و Creative ساخته شده است.

كتابخانه اين API مجموعه‌اي از صداهاي قابل حركت در فضاي سه‌بعدي را مدل‌سازي مي‌كند. عناصر اصلي OpenAL شامل يك شنونده، يك منبع و يك بافر است. ممكن است تعداد زيادي بافر وجودداشته باشد كه شامل داده‌هاي صوتي هستند. هر بافر مي‌تواند به يك يا چند منبع ضميمه شود. هميشه يك عنصر شنونده (براي محتواي صوتي) وجود دارد كه موقعيت مكاني منبع صوتي كه صداي آن شنيده مي‌شود را نشان مي‌دهد. OpenAL در موتورهاي گرافيكي Epic Games Unreal نيز براي ساخت افكت‌هاي صوتي به كار مي‌رود.

OpenGL Performer
OpenGL Performer، رابط برنامه‌نويسي قدرتمند و كاملي است كه توسعه‌دهندگان براي شبيه‌سازي بصري از آن استفاده مي‌كنند. ابزارهاي موجود در آن، توسعه برنامه‌هاي شبيه‌سازي بصري، طراحي بر اساس شبيه‌سازي، واقعيت مجازي، نرم‌افزارهاي علمي، سرگرمي‌هاي تعاملي، برنامه‌هاي ويديويي و طراحي با كامپيوتر را آسان مي‌كند. اين رابط برنامه‌نويسي به برنامه‌نويسان امكان مي‌دهد از قابليت‌هاي سيستم به صورت بهينه استفاده كنند. آخرين نسخه اين نرم‌افزار OpenGL Performer 3.2 است.

OpenGL Volumizer
OpenGL Volumizer، يك API گرافيكي است كه در بخش‌هاي انرژي، توليد، داروسازي و تجارت كاربرد دارد. اين API براي انجام كارهاي تعاملي با كيفيت بالا‌ و بصري نمودن و شبيه‌سازي يك محيط با استفاده از مجموعه بزرگي از داده‌هاي حجمي (داده‌هايي كه مختصات يك شي در فضاي سه بعدي را نشان مي‌دهند) طراحي شده است. براي نمونه در نرم‌افزارهاي پزشكي براي شبيه‌سازي وضعيت بخش خاصي از بدن، از اين نرم‌افزار استفاده مي‌شود. OpenGL Volumizer آخرين نسخه اين API تا اوايل سال 2006 ميلا‌دي است كه بر پايه كتابخانه گرافيكي استانداردOpenGL ساخته شده و شامل رابط كلا‌س ++C و قابل‌استفاده در سيستم‌عامل‌هاي ويندوز و لينوكس 32 بيتي و 64 ‌بيتي است.

OpenGL Multipipe SDK
OpenGL Multipipe SDK يك لا‌يه API است كه مديريت برنامه‌هاي گرافيكي را در زير سيستم‌ها و ساختارهاي گرافيكي چندگانه آسان مي‌كند. برنامه‌هاي كاربردي نوشته شده برپايه اين API به نرمي و رواني، هم روي سيستم‌هاي روميزي تك پردازنده‌اي و هم روي سيستم‌هاي چند پردازنده‌اي با سيستم‌هاي گرافيكي قدرتمند اجرا مي‌شوند.

نتيجه‌گيري‌
همان‌گونه كه بيان شد ارتباط بين برنامه‌ها و سخت‌افزاري كه آن‌را اجرا مي‌كند برعهده API است. سازندگان بزرگ نرم‌افزار و سخت‌افزار API خاصي را براي برنامه‌هاي مالتي‌مديا آماده كرده‌اند كه مطرح ترين آن‌ها DirectX و OpenGL هستند.

برنامه های DirectX در دو حالت اجرا میشند:
1-حالت تمام صفحه (Full Screen Mode)
2-حالت پنجره ای (Windowed Mode)

برنامه امروز در حالت Full Screen اجرا می شود.VB رو اجرا کنید و یه پروژه نوع استاندارد ایجاد کنید.
برای این که بتوانیم از توابع اشیای DirectX استفاده کنیم باید کتابخانه Type Library رو به پروژه اضافه کنیم.
برای این کار بر روی منوی Project کلیک و References رو انتخاب کنید. در پنجره باز شده و در لیست موجود DirectX 7.0 for Visual Basic Library Type را تیک بذارید و OK کنید.

حالا برای اینکه ما بتوانیم از DirectX استفاده کنیم باید یک شیئ از نوع DirectX7 تعریف کنیم. پس در قسمت General فرم یک شیئ از این نوع تعریف کنید.
Dim DX As New DirectX7

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

1-یک شیئ از نوع DirectDraw7

این همون شیئی که به ما کمک میکنه که سطوح رو ایجاد کنیم:

Dim DD As DirectDraw7

2- 2 شیئ از نوع DirectDrawSurface7

این اشیاء سطوحی هستند که ما شکل ها، متون و ... رو بر روی اونها نگارش می کنیم(تخته سیاه)

Dim Primary As DirectDrawSurface7 ‘سطح اصلی
Dim Backbuffer As DirectDrawSurface7 ‘ پشت صحنه

یک متغیر عمومی از نوع Boolean هم تعریف می کنیم. این متغیر مشخص می کنه که تا چه زمانی برنامه باید اجرا بشه:

Dim EndPro As Boolean

حالا ادامه میدیم.

طریقه کار به این صورت که اول ما شیئ DD رو مقداردهی میکنیم. یعنی در حقیقت به DirectX7 میگیم که شیئ DD رو برای ما ایجاد کنه. پس در ادامه (Form_Load) بنویسید:

Set DD = DX.DirectDrawCreate ("")

حالا باید به شیئ DD که از نوع DirectDraw7 هست بگیم که ما میخوایم از کدوم فرم برنامه استفاده کنیم. من فرض کردم که فرم برنامه Form1 هست.همچنین باید به کامپیوتر بفهمونیم که میخوایم برنامه تمام صفحه باشه یا نه. برای اینکار از متد SetCooperativeLevel شیئ DD استفاده می کنیم:

DD.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE

حالا باید رزولوشن صفحه رو تغییر بدیم. فرض کنیم که سیستم شما از حالت 640 * 480 پشتیبانی می کنه. برای اینکار از متد SetDisplayMode شیئ DD استفاده می کنیم:

DD.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT

آرگومان اول عرض، آرگومان دوم Height و آرگومان سوم عمق بیت حالت رو نشون میده.اون یکی ها هم ref و Mode هستند

حالا میخوایم سطوح رو مقداردهی کنیم. کدهای زیر رو به پروژه خود بیفزایید:

Dim ddsd As DDSURFACEDESC2
ddsd.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
ddsd.lBackBufferCount = 1
ddsd.ddscaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE Or DDSCAPS_VIDEOMEMORY

برای اینکه بتونید یه سطح رو ایجاد کنید باید یه شیئ از نوع DDSURFACEDESC2 رو به ان وابسته کنیم.

حالا سطح اصلی (Primary) خودمون رو ایجاد کنیم. این سطح همون سطحی است که کاربر میبینه. (اینکه چه جوری کامپایلر میفهمه که این همون سطح هست برمیگرده به خصوصیات شیئ ddsd از نوع DDSURFACEDESC که بالا مقداردهی کردیم و این شیئ مشخص میکنه که Primary تخته سیاه باشه). با استفاده از متد CreateSurface شیئ DD این سطح رو ایجاد می کنیم. آرگومان این تابع همون شیئ بالاییه) داریم:

Set Primary = DD.CreateSurface(ddsd)

حالا باید سطح BackBuffer رو مقداردهی کنیم. ولی شاید بپرسید ما که Primary رو داریم دیگه این BackBuffer برای چیه؟ باید بگم برای اینکه از پرپر زدن صفحه نمایش جلوگیری کنیم، ما بجای اینکه همه چیز رو مستقیما روی سطح Primary رسم کنیم، میایم و اول روی سطح (BackBuffer) که متصل به Primary هستش رسم می کنیم و صحنه آماده رو منتقل می کنیم به Primary (در حقیقت میتونیم بگیم که BackBuffer چرک نویس ما هست).

پس حالا ما سطح BackBuffer رو متصل به سطح Primary ایجاد می کنیم. داریم:

Dim ddscaps As DDSCAPS2
ddscaps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_VIDEOMEMORY
Set Backbuffer = Primary.GetAttachedSurface(ddscaps)

حالا همه چی آماده است.

در ضمن فکر میکنم همه با نوع داده RECT آشنایی داشته باشند (اگه کسی آشنایی نداره در قسمت نظرات بگه تا من اونو هم توضیح بدم). در دایرکت ایکس برای اینکه بخوایم یه قسمتی از صفحه رو مشخص کنیم از این نوع داده استفاده می کنیم. یه متغیر هم از این نوع تعریف می کنیم تا کل صفحه رو مشخص کنیم. (برای رنگ آمیزی کل سطح و ...) توجه داشته باشید که این نوع داده در کتابخانه DirectX موجود هست و شما نیازی ندارید که مثل برنامه های دیگه این نوع رو تعریف کنید :

Dim rec As RECT
rec.Bottom = 480
rec.Left = 0
rec.Right = 640
rec.Top = 0

اینو به یاد داشته باشید که ما در برنامه هایی که با دارکت ایکس می نویسیم. کل عملیات رو در قالب یه حلقه (معمولا حلقه Do) انجام میدیم. به این صورت که پشت سر هم به طور مداوم صحنه های خودمون رو بر روی سطح ترسیم می کنیم و به Primary منتقل می کنیم. پس در پروژه خویشتن ( و در همان Form_Load، یعنی ادامه کدهای قبلی) بنویسید:

Do While EndPro=False

Backbuffer.BltColorFill rec, 0 ‘پاک کردن صفحه

Backbuffer.SetForeColor RGB(256, 0, 0) ‘ تنظیم رنگ ترسیم

Backbuffer.DrawText 300, 250, “Hello World”, False ‘درج متن

DoEvents ‘توضیح در پایین

Primary.Flip Nothing, DDFLIP_WAIT ‘ انتقال از چرک نویس به پاک نویس

Loop

حالا ببینیم که چیکار کردیم. تا زمانی که مقدار متغیر EndPro نادرست است این عملیات رو انجام میدیم:

برای پاک کردن صفحه هر بار صفحه رو با رنگ سیاه پر میکنیم. متد BltColorFill سطح رو به روش بلیت پر میکنه. یعنی این که در حافظه مقادیر هر پیکسل رو برابر رنگی که بهش میدیم قرار میده(در اینجا این رنگ رو برابر 0 که همون سیاه هست قرار دادیم).

با استفاده از متد SetForeColor رنگ تمام ترسیماتی که انجام میدیم رو عوض می کنیم.(به اصطلاح ForeColor سطح رو تغییر میدیم.)

با استفاده از متد DrawText متن مورد نظرمون رو بر روی صفحه حک می کنیم. دو آرگومان اول مختصات x و y محل درج متن رو مشخص می کنند.

مـــــــهـــــــم : وقتی ما پشت سر هم و بدون وقفه یه کاری رو انجام میدیم، برنامه دیگه چیز دیگه ای رو پردازش نمی کنه. بنابراین ما با این عبارت(DoEvents) به کامپایلر میگیم در هر بار انجام دستورات حلقه، دستورات دیگه ای مانند فشرده شدن کلید، کلیک ماوس و ... رو هم پردازش کنیم. اگه خیلی کنجکاو هستید، بعد از این که پروژه تون رو Save کردید یه بار برنامه رو بدون DoEvents اجرا کنید

حالا صحنه ما آماده است پس اونو میذاریمش جلوی چشم کاربر. این کار با استفاده از متد Flip سطح Primary انجام میشه. (درمورد فلیپ بعدا اگه عمری باقی باشه توضیح میدم.)

هنگامی که متغیر EndPro مقدار Trueبگیره(هنگامی که کاربر قصد خروج دارد)، حلقه شکسته میشه و ما باید برنامه رو به پایان ببریم. پس حافظه ای که به سطوح و اشیاء دیگر اختصاص داده ایم رو آزاد میکنیم:

Set DD = Nothing
Set Primary = Nothing
Set Backbuffer = Nothing
Set DX = Nothing
End

در اینجا Form_Load به پایان میرسه. حالا فقط یه کار مونده. اون هم اینه کا وقتی کاربر کلید Esc رو فشار میده باید برنامه به پایان برسه، یعنی مقدار متغیر EndPro برابر True بشه. پس این خطوط کد رو به پروژه تون اضافه کنید:

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then EndPro=True
End Sub

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

تمرین:
1-برنامه را طوری تغییر دهید که به جای عبارت Hello World نام خودتان را نمایش دهد.
2-برنامه را طوری تغییر دهید که به جای عبارت Hello World ، زمان سیستم را نمایش دهد.
3-کاری کنید که عبارت Hello World در روی صفحه به سمت چپ (یا راست حرکت کند)

DirectX 10 و اهمیت آن در صنعت کامپیوتر های شخصی

توضیح : این گفتگو در تاریخ 19 مهرماه در سایت BootDaily منتشر شده است. در این مصاحبه پرسش ها توسط BD (کوتاه شده عبارت Boot Daily) و پاسخ ها با نام Chris (مدیر بخش گسترش و بازاریابی مایکروسافت) مشخص شده اند. همچنین منظور از DX10 در این مصاحبه DirectX 10 می باشد.

BD : لطفا اهمیت DX10 برای دوست داران بازی ها را در یک جمله توضیح دهید.

Chris : ما در مایکروسافت DirectX 10 را به عنوان بلند ترین جهش در کیفیت و کارایی گرافیک در صنعت کامپیوتر های شخصی از زمان پیدایش DirectX که به زمان ویندوز 95، و تحولی در زمینه بازی های کامپیوتری و تکنولوژی مربوط به آن می دانیم.

BD : و اهمیت آن برای کاربران عادی؟

Chris : بله، DirectX 10 بالاترین کیفیت و کارایی گرافیکی را در پلاتفرم ویندوز را به همراه خواهد داشت که نتیجه آن تجربه ای باورنکردنی و دور از ذهن برای کاربران عادی خواهد بود.

BD : این یک حقیقت است که تعداد زیادی از بازی های معروف و پرطرفدار درحال حاظر بر پایه موتور گرافیکی Doom3 که از OpenGL بهره می گیرد ساخته می شوند. به نظر شما DX10 چه مزیت هایی نسبت به OpenGL برای تولید کنندگان بازی های کامپیوتری به ارمغان می آورد؟

Chris : همانطور که می دانید، ما DirectX 10 را برای ویندوز ویستا و با هدف ارایه دادن یک تجربه باورنکردنی از جزئیات گرافیکی به کاربران و بازیکنان ، تماما از پایه و از صفر ساخته ایم. این نسخه از DirectX نسب به نسخه های قبلی دارای بازده به مراتب بیشتر و در عین حال با ضریب اطمینان و پایداری بیشتر خواهد بود. DirectX 10 به لطف Shader Model 4.0 به طور فوق العاده ای کیفیت و جزئیات باورنکردنی را در اختیار توسعه دهندگان و نهایتا کاربران خواهد گذاشت که از آن جمله توانایی بکارگیری محیط های پیچیده گرافیکی و ترسیم چهره ها به صورت بسیار طبیعی و توانایی نمایش تعداد دلخواه از آیتم ها در صحنه می باشد.

اشاره کردید که بازی های معروف و پرطرفدار بر اساس موتور گرافیکی Doom3 و OpenGL ساخته می شوند، اما به عقیده من تعداد بازی هایی که از DirectX استفاده می کنند به مراتب بیشتر و حتی زیبا تر هستند. بازی هایی زیادی هستند که بر اساس موتور های گرافیکی Unreal و Source و با استفاده از DirectX ساخته می شوند. حتی ID (منظور شرکت ID Software سازنده سری بازی های Doom و Quake است-م) نیز برای منطبق ساختن بازی های خود با کنسول های Xbox و Xbox360 آنها را به DirectX تبدیل می کند.

با این حال، تمامی برنامه هایی که از واسط گرافیکی OpenGL استفاده می کنند قابلیت اجرا در ویندوز ویستا را به شرط پشتیبانی درایور گرافیک و استفاده از وصله (Patch) مناسب، خواهند داشت. به همین خاطر سازندگان و فروشندگان قطعات سخت افزاری ملزم به ارایه ICD یا Installable Client Drivers که امکان استفاده از شتابدهنده گرافیکی را برای پردازش دستورات OpenGL را خواهد داد، هستند

BD : چرا این نسخه از DX10 تنها قابل استفاده در ویندوز ویستا است؟ آیا این نوعی اجبار کاربران برای خرید و ارتقا به ویندوز ویستا نیست؟

DirectX 10 : Chris نیاز به امکانات مشخصی جهت بهره گیری کامل از سخت افزار گرافیکی سیستم دارد که این امکانات و خصیصه ها تنها در سیستم عامل ویندوز ویستا موجود است. ما یک هدف بزرگ را برای دراختیار گذاشتن تجربه گرافیکی جدید به کاربران در نظر گرفته ایم و همانطور که قبلا گفتم، DirectX 10 کاملا از پایه و بدون استفاده از نسخه های قبلی این واسط گرافیکی ساخته شده است و بنابر این هیچگونه سازگاری با نسخه های قبلی از سیستم عامل ویندوز ندارد.

DirectX 10 برپایه مدل جدید درایور تصویر ویندوز ویستا (Windows Vista Display Driver Model یا WDDM) که معرف عصر جدیدی در قابلیت های گرافیکی و افزایش پایداری و ضریب اطمینان درنظر گرفته شده، طراحی شده است. در عین حال ما با انجام تغییراتی در معماری مدل درایور ها سعی در آسان سازی و افزایش پایداری و همچنین سازگاری بیشتر تراشه های گرافیکی با مجموعه دستورات هوش مصنوعی و محاسبات فیزیکی (جدا از تراشه های محاسب فیزیکی) انجام داده ایم که مجموعه این دلایل برای ارایه نشدن این نسخه از DirectX جهت سیستم عامل های قبلی مایکروسافت از جمله ویندوز XP متقاعد کننده به نظر می رسد.

BD : به غیر از رشته های کوتاه تر (Shorter Program Strings)، مزیت اصلی Shader Model 4.0 نسبت به نسخه 3.0 آن برای توسعه دهندگان بازی های کامپیوتری چست؟

Shader Model 4.0 : Chris به توسعه دهندکان اینگونه نرم افزار ها اجازه انجام محاسبات پیچیده بیشتری را در تراشه های گرافیکی (GPU) می دهد. این عمل ضمن کاهش بار پردازش از پردازنده سیستم را که باعث عدم بهره گیری از قدرت کامل تراشه گرافیکی می شود، اجازه انجام محاسبات سنگین مربوط به هوش مصنوعی و نیز افزایش تعداد آیتم ها را در صحنه در اختیار توسعه دهندگان قرار خواهد داد.

در عین حال DirectX 10 به همراه Shader Model 4.0 به لطف پشتیبانی از سایه زن های متحد (Unifyed Shaders) انعطاف پذیری و خلاقیت بسیار بیشتری را در اینگونه توسعه دهندگان قرار خواهد داد.

BD : شرکت های ATI و nVIDIA هردو درحال طراحی و ساخت تراشه های گرافیکی سازگار با DX10 هستند. به نظر شما این تراشه های گرافیکی در مقایسه با کنسول های بازی Xbox 360 و PS3 چگونه عمل خواهد کرد؟

Chris : این موضوع و تلااش این دو شرکت در مورد DirectX 10 بسیار هیجان انگیز است. اما بهتر است این سوال را از خود آنها بپرسید!

BD : به غیر از برتری های DX10 در مورد بازی های کامپیوتری، این نسخه چه نقشی را در برنامه های کاربردی آینده بازی خواهد نمود؟

Chriss : کلا DirectX فراتر از صرفا یک واسط و مجموعه دستورها برای بازی های کامپیوتری است. در گذشته نیز بسیاری از برنامه های کاربردی از CAD/CAM و 3DStudio گرفته تا برنامه های پزشکی و تصویر برداری نیز از مزایای DirectX بهره گرفته اند. با این حال DirectX 10 باز هم نسبت به نسخه های قبلی قطعا امکانات بسیار مناسب تری را در اختیار اینگونه برنامه ها خواهد گذاشت. به یک نکته دقت کنید! ویندوز ویستا از DirectX 10 به عنوان یک مولفه گرافیکی استفاده می کند - پس ویندوز ویستا هم خود یک برنامه کاربردی استفاده کننده از DirectX 10 محسوب می شود!

BD : نحوه تعامل DX10 با کاربرانی که از سخت افزار DX10 استفاده نمی کنند چگونه خواهد بود؟

DirectX 10 : Chriss و ویندوز ویستا کاملا با تمامی برنامه ها و بازی های منطبق با نسخه های قدیمی تر DirectX سازگار هستند. کسانی که در زمان انتشار ویندوز ویستا، سخت افزار منطبق بر DirectX 10 را در اختیار ندارند و یا تهیه نکرده اند، هنوز هم قابلیت اجرای بازی ها و برنامه های برپایه DirectX 10 را خواهند داشت. DirecrX 9 هم در ویندوز ویستا برای این گروه از کاربران در نظر گرفته شده است. با این حال جالب است بدانید کاربرانی که با استفاده از سخت افزار منطبق بر DirectX 10 بازی های DirectX 9 را اجرا کنند شاهد افزایش کیفیت و بازده آن خواهند بود!

درعین حال توسعه دهندگان نیز می توانند با خیالی آسوده به تولید بازی ها و نرم افزار های بر اساس DirectX 9 برای ویندوز ویستا بپردازند.

BD : آیا به نظر شما DX10 نهایت گرافیک در کامپیوتر خواهد بود؟ یعنی با فرض در اختیار داشتن سخت افزار مناسب آیا شاهد تصاویر منطبق بر واقعیت با سرعت نمایش مناسب خواهیم بود؟

Chris : ما به DirectX 10 به عنوان گام بلندی در زمینه گرافیک کامپیوتری می نگریم. مطمنا این نسخه از DirectX تجربه جدید را در اختیار کاربران خواهد گذاشت و با اجازه دادن به توسعه دهندگان برای آشنایی با قابلیت های DirectX 10 این تجارب بهتر و بهتر نیز خواهند شد. اما ما همچنین عقیده داریم که هنوز هم موارد زیادی در این مورد قابل دستیابی هستند و بدست آوردن آنها نیز به زمان بیشتری نیاز دارد. گرافیک در ویندوز و DirectX 10 هنوز هم در راه توسعه و تکامل هستند.

BD : آیا شما در این لحظه در مورد تراشه های DirectX 10 شرکت های ATI و nVIDIA نظری دارید؟ کدام یک را برای خود انتخاب می کنید؟

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

BD : در مورد پیشرفت های صدا در DX10 نیز توضیح دهید. آیا ما میتوانیم با این نسخه صداها را "ببینیم" !؟

Chris : این نسخه از DirectX کماکان روال گذشته را در مورد چگونگی و نحوه تولید صدا ها ( بر پایه XACT cross-platform audio creation tool) را ادامه می دهد. بنابر این برتری عمده ای نسبت به نسخه های قبلی در این نسخه قابل ذکر نیست اما پیشرفت هایی انجام شده است.

BD : ویندوز ویستا چگونه برای اجرای یک بازی یا برنامه با استفاده از DX10 و یا DX9 را با توجه به نوع GPU تصمیم گیری می کند؟

Chris : وقتی روند اجرای یک بازی آغاز می شود، ویندوز ویستا با تشخیص نسخه DirectX به کار رفته در بازی و سخت افزار سیستم، گزینه مناسب را انتخاب خواهد کرد.

BD : گفته می شود که DirectX10 از Geometry Shaders (سایه زن هندسی) استفاده می کند. این قابلیت تا چه حد به روند انجام و تشکیل اشکال هندسی کمک خواهد کرد؟

Geometry Shader : Chris دقیقا در بین سایه زن های پیکسل و راس (Vertex and Pixel) در خط لوله پردازش قرار دارد. می تواند از رئوس و مثلث های ایجاد شده در ترسیم اشکال بعدی، بدون نیاز به پردازش مجدد، استفاده کند. سایه زن هندسی کارهای دیگری نیز انجام میدهد : تقویت تعداد مثلث ها با انتخاب یک یا چند مثلث از قبل پردازش شده و تکرار آنها بدون نیاز به پردازش مجدد، و یا تشکیل مثلث های جدید با ترکیب مثلث های دردسترس، تولید نقطه ها و خط های جدید و یا با استفاده از مثلث های ازقبل پردازش شده، و یا تولید پیکسل های پخش شده (جدا جدا).

انتخاب یک نقطه، تولید یک سری مثلث در اطراف آن و گسترش آن تا تشکیل یک تصویر قابل درک (Sprite) و یا تجزیه یک مثلث به تعداد کوچکتری مثلث و گسترش آن. بیرون انداختن یک راس از مثلث از مجموع مثلث ها و تبدیل آن به یک حجم یا یک چهار ضلعی.

بهترین نقطه در DirectX ترکیب تمامی انواع Shader Model ها در Shader Model 4.0 است که به توسعه دهندگان اجازه خواهد داد انواع Vertex، Pixel و Geometry Shaders ها را در یک مدل بیافرینند.

BD : در مورد محاسبات فیزیک (کنش ها و واکنش های محیط در مقابل تعییرات) چطور؟

Chris : ویندوز ویستا از تمامی انواع محاسبات فیزیکی چه به وسیله پردازنده، تراشه گرافیکی یا پردازنده فیزیک جداگانه پشتیبانی خواهد نمود. با اتکا بر DirectX 10 ویندوز ویستا پلاتفرم قدرتمندی برای انجام محاسبات فیزیکی توسط GPU خواهد بود. پشتیبانی از ویژگی چند تراشه گرافیکی SLI و یا CrossFire و توانایی تقسیم وظایف پردازش تصویر و یا محاسبات فیزیکی بین تراشه های گرافیکی موجود در سیستم از جمله امتیازات سیستم عامل ویستا و DirectX 10 می باشد.

BD : با این وجود پشتیبانی از کارت پردازش فیزیک Ageia به عهده ویندوز ویستا خواهد بود؟ و یا ATI و nVIDIA؟

Chris : واضح است که ساده ترین روش پردازش فیزیک، بهره گیری از پردازنده اصلی سیستم است. در ویندوز ویستا تامین درایور های لازم و پشتیبانی تراشه های پردازش فیزیک (مانند Agiea) بر عهده خود سازندگان آنها خواهد بود.

BD : آیا تیم توسعه و بازار یابی شما اقدامی در جهت موجود بودن محتوای مناسبی مانند بازی های کامیوتری، نرم افزار های سازگار و مختص به ویندوز VISTA در هنگام انتشار آن انجام داده است؟

Chris : بله! در زمان انتشار ما پشتیبانی کاملی از تمام نسخه های موجود بازی ها و نرم افزار ها را در ویندوز ویستا شاهد خواهیم بود. در عین حال علاوه بر 10 عنوانی که قبلا برای انتشار همزمان با ویندوز ویستا اعلام شده بود، عناوین مهم و جذاب دیگری نیز برای انتشار همزمان با ویندوز ویستا پیش بینی کرده ایم. مطمنا این عنواین در همان روزهای اول پیشرفت فوق العاده در نسل بعدی بازی های کامپبوتری و امکانات باورنکردنی ویندوز ویستا و DirectX 10 را به نمایش خواهند گذاشت. ضمنا تعداد تعداد زیادی از عنواین فعلی نیز برای ویندوز ویستا و پشتیبانی آن از پردازنده های چند هسته ای بهینه سازی شده اند.

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

“Alan Wake (Microsoft Game Studios)
“Age of Conan: Hyborian Adventures” (Eidos)
“Company of Heroes” (THQ)
“Crysis” (EA-Partners)
“Flight Simulator X” (Microsoft Game Studios)
“Halo 2 for Windows Vista” (Microsoft Game Studios)
“Hellgate: London” (Namco)
“LEGO Star Wars II: The Original Trilogy” (LucasArts)
“Shadowrun” (Microsoft Game Studios)
“Zoo Tycoon 2: Marine Mania” (Microsoft Game Studios)

BD : از اینکه به سوالات ما و تعداد زیادی از کاربران و دوستداران بازی های کامپیوتری پاسخ دادید متشکرم. به امید موفقیت هرچه بیشتر شما. ما مشتاقانه منتظر عرضه ویندوز ویستا و بازی های جذاب DirectX 10 و سخت افزار های ارایه شده توسط nVIDIA و ATI خواهیم بود.

پروژه های اماده برای تمرین

vblog — Sun, 10 Dec 2006 05:13:18 GMT

ترفنـــــــــــــــــــــــــــد:

برای اینکه بعد از قرار دادن کنترل هاتون نخواید دوباره فونت تک تک اونها رو تغییر بدهید برای این کار قبل از قرار دادن اونها روی فرم ابتدا فونت فرم رو به فونت مورد نظرتون که من Tahoma رو پیشنهاد میکنم تغییر بدهید و سپس هر کنترلی که روی فرم قرار بدهید با فونت فرم یکی میشود

نکتـــــــــــــــــــــــــــــه:

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

نکتـــــــــــــــــــــــــــــه:

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

نکتـــــــــــــــــــــــــــــه:

بعضی مواقع شما نوشته داخل یک کنترل مثل یک Label رو به فارسی تغییر میدهید که این عبارت به درستی نشان داده نخواهد شد که برای رفع این مشکل باید فونت اون کنترل رو به Tahoma تغییر دهید

نکتـــــــــــــــــــــــــــــه:

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

برنامه نمونه مشاور املاک(درخواستی)

دیجیتال

DNS

کدهای اماده برای کار های مختلف

بخش اول ویژوال بیسیک شبیه سازی شده(انگلیسی) بخش دوم بخش سوم

اقای Hacker alone ( درخواستی)

برنامه جالب سه بعدی

فارسی ساز ویژوال بیسیک ( در فایل متنی داخلش توضیح دادم ) بخش اول

پسوردش هم : VBLog.blogfa است حتمــــــــــــــــــــــــا دانلود کنید هر بخش ۱۵۰ کیلو بایت است

بخش دوم بخش سوم بخش چهارم بخش پنجم بخش ششم بخش هفتم بخش هشتم بخش نهم

پنجره شناور (اقا کمال) قسمتی از وی بی

اکواریــــــــــــــــــــــــــــــــم

جالبــــــــــــــــــــــــــــــــه

توابــــــــــــــــــــــــــع

پنجره شفاف

پنجره شفاف 2

محاسبه کننده زمان توقف موس

مبدل تصاویر

جلوه دهنده تصاویر

قفل کننده پوشه ها

ماتریکس برای بچه های مهندسی و ریاضی

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

بک گراند Fifa برای جام جهانی 2010 خودم طراحی کردم

شبیه سازی قسمت معلولین ویندوز

اموزش Active X

سرعت سنج اینترنت خیلی جالبه

جستجو در بین پوشه ها

یک Progress bar کاربردی و جالب

یک بوتر به همراه فایل اجرایش

باز کردن Combo box با زدن اینتر

اعداد مختلط

کپی فایل به همراه نوار پیشرفت

فهرست کشورهای جهان برای شما

متوقف کردن برنامه در تاریخ معین شده

تبدیل Fat32 به Ntfs

دیوار اتش با VB

تبدیل فوریه برای بچه های الکترونیک و ریاضی

تبدیل عکس به متن

برنامه نمونه کار با پورت

پیانو

یک نمونه کوچک از برنامه خودم(وی بی فارسی)(اقا کمال)

اموزش برنامه نویسی Socket Programing

یک نمونه کوچک از برنامه خودم (نوار مرزی)

یافتن متن

تبدیل متن به عکس

تبدیل کدهای وی بی به دلفی

شبیه سازی یک قسمت از Nero ( نمایش طیفی فایل صوتی)

کاوشگر اینترنت

اینها ادامه دارند سر بزنید

پاسخ اقا مهدی عزیز:

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

- 1 ابتدا وارد Run ویندوز شو و عبارت regsvr32 Mswinsck.ocx رو تایپ کن که این کار برای ثبت یک کامپوننت است و ببین مشکل رفع شد

- 2 این فایل رو از پایین دانلود کن و در پوشه System32 ویندوز کپی کن و هنگام کپی yes رو بزن و مرحله اول رو مجددا انجام بده

- 3 اگه باز هم مشکل داشتی فکر کنم مشکل از خود وی بی است پس دوباره وی بی رو نصب کن

دانلود فایل

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

یک دکمه یا کامند باتون رو فرم قرار بدید و این کد ها رو تو فرم کپی کنید

Option Explicit

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

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call ReleaseCapture

Call SendMessage(hWnd, &HA1, 2, 0&)

End Sub

بچه ها از اگه در اخرین ژست عکس پروژه من (وی بی فارسی) نبود برید تو ارشیو و ببینیدش و به عظمت کار پی ببرید

راستی شبیه سازی پاور دی وی دی ۶ هم یادم نرفته دارم روش کار میکنم ( خیلی جالبه)