اموزش پیشرفته ویژوال بیسیک
یک ترفند جالب در وی بی ۶ و سي ++ ۶

چند تا PDF جالب و پیشرفته میزارم
نظراتون رو هم خوندم
تصویر ویژوال بیسیک فارسی من

من دوباره برگشتم

 

+ نوشته شده در  90/06/30ساعت 17:16  توسط مهدی سعادتی  | 

شبیه سازی NC

یه ترفند جالب در visual c++ 6 من تنها وبلاگی هستم که این مطلبو گذاشتم

یک پروژه ATL بسازید

از منوی Insert گزینه New ATL Object ... رو انتخاب کنید

روی همه اشیاء لیست شده کلیک کنید ( چپ به راست و بالا به پایین )

روی قسمت طوسی پنجره دکمه Ctrl بعلاوه دو بار کلیک روی موس را انجام دهید. جالب بود

یه ترفند جالب در visual Basic 6 و من دوباره تنها وبلاگی هستم که این مطلبو گذاشتم

ابتدا از منوی View گزینه Toolbar و سپس customaize رو انتخاب کنید

سپس تب commands رو انتخاب کنید و از لیست زیرین Help رو انتخاب کنید و سپس از لیست روبرو گزینه About microsoft visual basic رو

درگ کنید روی تولبار اصلی برنامه و رهاش کنید و سپس روی او راست کلیک کنید و در قسمت نام عبارت Show VB Credits را وارد کنید و بعد

پنجره customaize رو ببندید و و روی دکمه کلیک کنید و لذت ببرید

بچه ها من پست های پایین تر رو ابدیت کردم

روش یافتن و  جایگذاری متن

من علاقه مورد گروه عکس

ارتباط VB با Flash قسمت اول

ارتباط VB با Flash قسمت دوم

بازی کرم با کیفیت

ویرایشگر متن

فرم های متحرک

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

ویروس برای خاموش کردن ویندوز و ....

عکس گرفتن

خطای دید : چند لحظه به تصویر نگاه کنید وسپس به جای دیگری بنگرید

بازی سفینه سه بعدی

پایان دادن به برنامه ها از روی عنوان

ضبط صدا

Mp3 Player with Skin

فرستادن نامه با فایل الحاقی

ساعت دیجیتالی

پیانو

ویرایشگر صفحات اینترنت

چهره ای روی سطح مریخ

کلکسیون توابع API فارسی

کلکسیون توابع API انگلیسی

بیست و یک تابع API

دفترچه تلفن

تصویر شش بعدی که ذهن ما قادر به درکش نیست

جدید ترین موس با قیمت صد دلار

نحوه شکل گیری فضا

منتظر پروژه های ناب و جالب من باشید که میخوام بترکونم

VBLog.blogfa.com

 

+ نوشته شده در  86/04/08ساعت 15:36  توسط مهدی سعادتی  | 

چند تا ترفند کاربردی در 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
+ نوشته شده در  85/12/07ساعت 15:9  توسط مهدی سعادتی  | 

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


با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين
تصاويرتون بايد 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/

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

 

+ نوشته شده در  85/12/05ساعت 22:19  توسط مهدی سعادتی  | 

اموزش توابع داخلی 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 به زير ميبره
+ نوشته شده در  85/12/05ساعت 22:18  توسط مهدی سعادتی  | 

معرفی و اموزش چند تابع 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 هست رو روی فرم رسم میکنیم
+ نوشته شده در  85/12/04ساعت 16:50  توسط مهدی سعادتی  | 

مقایسه 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 ها هست مثلا واسه رنگي نوشتن و ...
+ نوشته شده در  85/12/04ساعت 16:47  توسط مهدی سعادتی  | 

اینم یک مثال برای اقا حمید که راست به چپ کردن 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 برنامه رو متوقف کنید.
+ نوشته شده در  85/11/22ساعت 10:57  توسط مهدی سعادتی  | 

اموزش مقدماتی کامل برای مبتدیان

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 خواهیم بود.
+ نوشته شده در  85/09/25ساعت 15:29  توسط مهدی سعادتی  | 

ترفنـــــــــــــــــــــــــــد:

برای اینکه بعد از قرار دادن کنترل هاتون نخواید دوباره فونت تک تک اونها رو تغییر بدهید برای این کار قبل از قرار دادن اونها روی فرم ابتدا فونت فرم رو به فونت مورد نظرتون که من Tahoma رو پیشنهاد میکنم تغییر بدهید و سپس هر کنترلی که روی فرم قرار بدهید با فونت فرم یکی میشود

نکتـــــــــــــــــــــــــــــه:

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

نکتـــــــــــــــــــــــــــــه:

برای تغییر اندازه کنترل های روی فرم میتونید ابتدا انها را انتخاب کنید و سپس کلید شیفت رو پایین نگه دارید و با کلید های مکان نما اونها رو تغییر اندازه بدهید

نکتـــــــــــــــــــــــــــــه:

بعضی مواقع شما نوشته داخل یک کنترل مثل یک Label رو به فارسی تغییر میدهید که این عبارت به درستی نشان داده نخواهد شد که برای رفع این مشکل باید فونت اون کنترل رو به Tahoma تغییر دهید

نکتـــــــــــــــــــــــــــــه:

برای اینکه در پنجره خصوصیت اشیاء سریعتر به خصوصیت مورد نظر پرش کنید میتوانید با نگه داشتن کلید کنترل و شیفت و زدن اولین حرف خصوصیت مورد نظر به ان پرش کنید

برنامه نمونه مشاور املاک(درخواستی)

دیجیتال

DNS

کدهای اماده برای کار های مختلف

بخش اول ویژوال بیسیک شبیه سازی شده(انگلیسی)  بخش دوم  بخش سوم

اقای Hacker alone ( درخواستی)

برنامه جالب سه بعدی

فارسی ساز ویژوال بیسیک ( در فایل متنی داخلش توضیح دادم ) بخش اول

پسوردش هم : VBLog.blogfa است حتمــــــــــــــــــــــــا دانلود کنید هر بخش ۱۵۰ کیلو بایت است

بخش دوم  بخش سوم  بخش چهارم  بخش پنجم  بخش ششم  بخش هفتم بخش هشتم بخش نهم

پنجره شناور (اقا کمال) قسمتی از وی بی 

فکس با وی بی

فکر و بکر

جستجوی دیتا بیس

پر کننده گرافیکی

اکواریــــــــــــــــــــــــــــــــم

جالبــــــــــــــــــــــــــــــــه

توابــــــــــــــــــــــــــع

پنجره شفاف

پنجره شفاف 2

محاسبه کننده زمان توقف موس

مبدل تصاویر

جلوه دهنده تصاویر

قفل کننده پوشه ها

ماتریکس برای بچه های مهندسی و ریاضی

حرکت دهنده موس

برش دهنده تصاویر

پین باتون

پینگ

پینگ ای پی

Trace

طیف نما برای کارهای مولتی مدیا جالب

بک گراند 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

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

راستی شبیه سازی پاور دی وی دی ۶ هم یادم نرفته دارم روش کار میکنم ( خیلی جالبه)

 

+ نوشته شده در  85/09/19ساعت 8:44  توسط مهدی سعادتی  | 

مطالب درخواستی
مجبور کردن Common Dialog به ذخیره کردن فایل ها در یک درایو خاص
ابتدا یک فرم خالی درست کنید و یک کنترل Common Dialog روی ان قرار دهید و سپس یک Command Button
کد زیر را در رویداد کلیک کامند باتون قرار دهید
Private Sub Command1_Click()
Call Save_driveA
End Sub
یک TextBox روی فرم قرار دهید
بعد تابع جدیدی به نام Save_DriveA مثل زیر درست کنید
Function Save_DriveA()
Dim x As Integer
Do
commondialog1.Action = 2 ' save file
If UCase(Left(commondialog1.FileName, 1)) <> "A" Then
MsgBox "YOu Must Save File to Drive A only"
Else
Exit Do
End If
DoEvents
Loop
x = FreeFile
Open commondialog1.FileName For Output As #x
Print #x, Text1.Text
Close #x
MsgBox "File has been saved to A"
End Function

ِDoEvents چیست؟
وقتي ما پشت سر هم و بدون وقفه يه کاري رو انجام ميديم برنامه ديگه چيز ديگه اي رو پردازش نمي کنه. بنابراين ما با اين عبارت(DoEvents) به کامپايلر ميگيم در هر بار انجام دستورات حلقه، دستورات ديگه اي مانند فشرده شدن کليد، کليک ماوس و ... رو هم پردازش کنيم.برای امتحانش هم یک برنامه بنویسید که داخلش یک حلقه باشد و یک بار بدون DoEvents اجراش کنید و بار دیگر در یک خط جدید عبارت DoEvents رو تایپ کنید و بعد اجراش کنید.

Randomize Timer چیست؟
فرض کنید که شما میخواهید یک برنامه بنویسید که با هر بار اجرا شدن یا زدن یک دکمه یک عدد تصادفی را خودش انتخاب کند و ادامه ماجرا. خوب حالا با هر بار اجرای برنامه یا زدن دکمه همون اعداد تصادفی که در سری های قبلی ایجاد شده بود تولید میشوند که با قرار دادن عبارت Randomize Timer در ابتدای کدهای برنامه دیگر این مشکل نخواهد بود چون اون عدد تصادفی با ساعت داخلی ماشین انتخاب خواهد شد.

ترفند
شما میتوانید با زدن همزمان کلیدهای کنترل و Space یک منوی فوری در قسمت کد وی بی اجرا کنید که برای ساده کردن کد نویسی کاربرد دارد
مثلا شما یک فرم به نام frmoption دارید که میتوانید در قسمت کد ویندو فقط عبارت frmop را بنویسید و سپس کلیدهای کنترل و space را بزنید که این پنجره عبارت شما را تشخیص خواهد داد و ان را تکمیل خواهد کرد که شما با تمرین میتوانید از ان در جاهای دیگر هم استفاده کنید
کاربرد دیگر : وقتی وارد کد ویندو میشوید این کلیدها را بفشارید و میبینید که تمام توابع داخلی و ... ویژوال بیسیک نمایش داده خواهد شد که Doevents هم میتوان با این روش در بین کدها قرار داد که این هم یکی از توابع داخلی ویژوال بیسیک است
موفق باشید

یک ترفند فوق العاده فوق العاده کاربــــــــــــــــــــردی
این ترفند رو خودم کشف کردم و در اختیار دوستان خوبم میگذارم
با این ترفند خود ویژوال بیسیک 6 به سبک Xp در میاید (دقت کنید گفتم ویژوال بیسیک نه برنامه هاش)
ابتدا یک فایل متنی از نوع Text documents در دسکتاپ خود درست کنید و این کدها را در داخل ان کپی کنید

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">

<assemblyIdentity type="win32" processorArchitecture="*" version="6.0.0.0" name="mash"/>

<description>Enter your Description Here</description>

<dependency>

<dependentAssembly>

<assemblyIdentity

type="win32"

name="Microsoft.Windows.Common-Controls" version="6.0.0.0"

language="*"

processorArchitecture="*"

publicKeyToken="6595b64144ccf1df"

/>

</dependentAssembly>

</dependency>

</assembly>


و سپس ان را با نام vb6.exe.MANIFEST ذخیره کنید اما...
یک نکته : بعد از ذخیره کردن فایل به قسمت my computer بروید و از منوی Tools زیر منوی Folder Option را اجرا کنید و وارد زبانه View شوید و در قسمت پایین علامت عبارت hide Extensions for known file types را بردارید و سپس پنجره را ببندید و به دسکتاپ برگردید و روی نام فایلی که ساخته بودی فقط کلیک کنید و عبارت .txt را از قسمت اخر نام فایل پاک کنید و اینتر کنید خوب حالا قسمت اخر کار که باید این فایل رو در جایی که ویژوال بیسیک را نصب کردید یعنی در Program files\Microsoft Visual Studio\VB98\ کپی کنید حالا ویژوال بیسک رو اجرا کنید و حال کنید با این کار با یک تیر دو نشان زدید که نشان دوم این است که با اجرای هر پروژه ای اون برنامه هم به سبک Xp ( Win Xp مخفف خارجیش را نمیدانم ولی فارسیش یعنی ویندوز تجربه ) در خواهد امد. حالا به هوش و ذکاوت من پی بردید. خدایش من این اموزش را برای پروژه هایی که با ویژوال بیسیک میسازید را قبلا داده بودم که اونا رو به شکل Xp در بیارید ولی به ذهن کدومتون این ترفند رسیده بود
ترفند های دیگری هم بلدم که اگه نظر های درست و حسابی بدید حتما خواهم گذاشت

خودم طراحی

+ نوشته شده در  85/09/18ساعت 21:44  توسط مهدی سعادتی  | 

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

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

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

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

DSBuffer.Play DSBPLAY_LOOPING

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

DSBuffer.Play DSBPLAY_DEFAULT

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

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

DSBuffer.Stop

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

DSBuffer.SetPan yourValue

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

DSBuffer.SetVolume yourValue

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

DSBuffer.SetFrequency yourValue

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

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

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

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

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

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

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

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

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

اولين سطر به DirectMusic مي گويد چه نوع پيغامهايي را مي خواهيد به برنامه تان بفرستد . چندين نوع پيغام وجود دارد :
DMUS_NOTIFY_ON_SEGMENT = اطلاعات موزيک فعلي ( شروع پخش ، پايان پخش و غيره )
DMUS_NOTIFY_ON_CHORD = اطلاعات تغيير chord موزيک
DMUS_NOTIFY_ON_COMMAND = زمانيکه يک event فرماني صدا زده شود .
DMUS_NOTIFY_ON_MEASUREANDBEAT = اطلاعات beat/measure مربوط به موزيک فعلي
DMUS_NOTIFY_ON_PERFORMANCE = که event مربوط به سطح performance می باشد .
DMUS_NOTIFY_ON_RECOMPOSE = که recomposition event می باشد .
آخرين بخش از پيغام دهي ، تابع اصلي آن مي باشد . همانطور که در بخش Initial کردن DirectMusic ديديد يک توصيف بصورت Implements DirectXEvent8 داشتيم . بخش اصلي تابع callback مربوط به DirectXEvent8 ، شامل يک select case است که بين پيغامهاي مختلف سوئيچ می کند :
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)x
If eventid = hEvent Then
Dim dmMSG As DMUS_NOTIFICATION_PMSG
If Not oDMPerf.GetNotificationPMSG(dmMSG) Then
Else
Select Case dmMSG.lNotificationOption
Case DMUS_NOTIFICATION_SEGABORT
Case DMUS_NOTIFICATION_SEGALMOSTEND
Case DMUS_NOTIFICATION_SEGEND
Case DMUS_NOTIFICATION_SEGLOOP
Case DMUS_NOTIFICATION_SEGSTART
Case Else
End Select
End If
End If
End Sub

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

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

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

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

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

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

oDMPerf.StopEx oDMSeg, 0, DMUS_SEGF_DEFAULT

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

oDMPerf.SetMasterVolume yourvalue

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

oDMPerf.SetMasterTempo yourvalue/ 100

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

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

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

برپاسازي DirectSound3D

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

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

تنها دو شي آخر براي شما جديد هستند . شي DirectSound3dBuffer8 يک ارائه سه بعدي از بافرهاي عادي است . ما همچنان از DirectSoundSecondaryBuffer8 براي نگهداري داده صوتي استفاده مي کنيم و از DirectSound3Dbuffer8 براي نگهداري پارامترهاي سه بعدي و تنظيمات سه بعدي استفاده مي کنيم . شي DirectSound3Dlistener8 نيز يک listener است و براي تنظيم کردن سرعت و جهت صدا و برخي پارامترهاي ديگر استفاده مي شود .
مرحله دوم ، ساخت بافر صوتي است . اين کار در دو بخش انجام مي شود . اول ما يک بافر صوتي نرمال مي سازيم و سپس يک واسط بافر صوتي سه بعدي را از آن بدست مي آوريم :
If Not (DSBuffer Is Nothing) Then DSBuffer.Stop
Set DSBuffer = Nothing
DSBDesc.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_CTRLVOLUME
Set DSBuffer = DS.CreateSoundBufferFromFile(App.Path & "\blip.wav", DSBDesc)x
If DSBDesc.fxFormat.nChannels > 1 Then
MsgBox "You can only use mono (1 channel) sounds with DirectSound3D"x
End If
If optLow.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_NO_VIRTUALIZATION
If optMedium.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_HRTF_LIGHT
If optHigh.Value Then DSBDesc.guid3DAlgorithm = GUID_DS3DALG_HRTF_FULL
Set DSBuffer = DS.CreateSoundBufferFromFile(App.Path & "\blip.wav", DSBDesc)x
Set DSBuffer3D = DSBuffer.GetDirectSound3DBuffer()x

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

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

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

چند پارامتر وجود دارد که مي توان آنها را تغيير داد :

1 – Volume : عدد 0 بيشترين ميزان صدا و عدد 3000 - کمترين ميزان صدا را دارد :
If DSBuffer Is Nothing Then Exit Sub
DSBuffer.SetVolume scrlVolume.Value

2 – Position : تنظيم محل listener :
DSBuffer3D.SetPosition Src_X, 0, Src_Y, DS3D_IMMEDIATE
DSBListener.SetPosition Src_X, 0, Src_Y, DS3D_IMMEDIATE

3 – Velocity : تنظيم سرعت و جهت منبع صدا :
DSBuffer3D.SetVelocity X, Y, Z, DS3D_IMMEDIATE
DSBListener.SetVelocity X, Y, Z, DS3D_IMMEDIATE

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

DSBListener.SetDopplerFactor CSng(scrlDoppler.Value), DS3D_IMMEDIATE

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

DSBListener.SetRolloffFactor CSng(scrlRolloff.Value), DS3D_IMMEDIATE
6 – Distance : ماکزيمم فاصله اي که يک صدا مي تواند شنيده شود :

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

رجيستري چيست ؟

سيستم عامل ويندوز تنظيمات سخت افزاري و نرم افزاري خود را بطور مرکزي در يک بانک اطلاعاتي با ساختار سلسله مراتبي ذخيره مي کند که رجيستري نام دارد . رجيستري جايگزيني براي بسياري از فايلهاي پيکربندي INI ، SYS و COM است که در نسخه هاي اوليه ويندوز موجود بود . رجيستري ، سيستم عامل را با مهيا کردن اطلاعات موردنيز براي اجراي برنامه ها و load شدن component ها ، کنترل مي کند .
رجيستري شامل انواع مختلفي از اطلاعات مي باشد مثل :
- اطلاعات سخت افزارهاي نصب شده روي سيستم
- اطلاعات درايورهاي نصب شده روي سيستم
- اطلاعات برنامه هاي نصب شده روي سيستم
- اطلاعات پروتکلهاي شبکه اي مورد استفاده در سيستم
ساختار رجيستري شامل چندين مجموعه رکورد است که داده هاي اين رکوردها توسط بسياري از برنامه ها و اجزاي سيستم عامل خوانده و يا نوشته مي شود .
اجزاي رجيستري
اجزاي تشکيل دهنده رجيستري عبارتند از :
1 – subtree : Subtree ها همانند folder هاي موجود در ريشه يک درايو هارد هستند . رجستری ويندوز داراي پنج subtree مي باشد :
- HKEY_LOCAL_MACHINE : شامل تمام داده هاي پيکربندي براي کامپيوتر مي باشد و شامل 5 key است :Hardware ، SAM ، Security ، Software و System
- HKEY_USERS : شامل داده هاي مربوط به تنظيمات سيستم عامل براي هر user است مثل تنظيمات desktop و محيط ويندوز
- HKEY_CURRENT_USER : شامل داده هاي کاربر فعلي سيستم
- HKEY_CLASSES_ROOT : شامل اطلاعات پيکربندي نرم افزار است مثل داده هاي OLE و داده هاي کلاسهاي متناظر با فايل
- HKEY_CURRENT_CONFIG : شامل اطلاعات مورد نياز براي تنظيمات داريورهاي سخت افزاري و غيره
2 – Key : key ها همانند folder ها و subfolder هاي روي هارد هستند . هر key متناظر با object هاي نرم افزاري يا سخت افزاري مي باشد . subkey ها key هايي هستند که درون يکسري key قراردارند .
3 – Entry : هر key داراي يک يا چند entry است . هر entry داراي سه بخش مي باشد :
- نام Name
- نوع داده اي Data Type : مقدار هر entry يکي از انواع داده هاي زير است :
REG_DWORD ، REG_SZ ، REG_EXPAND_SZ ، REG_BINARY ،
REG_MULTI_SZ ، REG_FULL_RESOURCE_DESCRIPTOT
- مقدار Value
نکته 1 : براي مشاهده رجيستري و اعمال تغييرات در آن ( لطفاً اگر هيچ تجربه اي در تنظيم کردن رجيستري نداريد اطلاعات آنرا تغيير ندهيد ) ، مي توانيد از برنامه regedit.exe و يا regedt32.exe موجود در ويندوز استفاده کنيد . براي اينکار کافيست نام برنامه را در کادر Run وارد کنيد .

براي کار با رجيستري در ويژوال بيسيک کلاس Registery.bas را مطابق مطالب زير ايجاد کرده و در پروژه هاي خود از آن استفاده کنيد :

1 - تعريف ثابتهاي مورد نياز : براي نوشتن اين کلاس نياز به تعريف چهار دسته ثابت داريم :

- ثابتهاي مربوط به تعريف data type هاي entry هاي رجيستري :
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4

- ثابتهاي مربوط به تعريف key هاي رجيستري

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

- ثابتهاي مربوط به خطاهاي کار با رجيستري

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

- ثابتهاي متفرقه

Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0

2 - Declare کردن Api هاي مورد نياز : براي کار با رجيستري از توابع کتابخانه Advapi32.dll استفاده مي کنيم . اين توابع عبارتند از :

- تابع RegCloseKey : آزاد کردن handle مربوط به يک key

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

- تابع RegCreateKeyEx : ساخت يک key در رجيستري ( اگر key قبلاً وجود داشته باشد ، اين تابع آنرا باز مي کند ) :

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

- تابع RegOpenKeyEx : باز کردن يک key

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

- تابع RegQueryValueExLong : استخراج type و data ي يک نام متناظر با يک key باز شده

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long


Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long


Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

- تابع RegSetValueEx : ذخيره يک مقدار در فيلد value يک کليد باز

Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long


Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

- تابع RegDeleteKey : پاک کردن يک کليد و کليه اطلاعات مرتبط با آن

Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)

- تابع RegDeleteValue : حذف مقدار يک key

Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)

3 - توابع کمکي : براي نوشتن توابع اصلي کار با رجيستري نياز به نوشتن توابع کمکي زير است :

- تابع SetValueEx : با توجه به نوع داده يک کليد ، مقدار موجود در آنرا در يک متغير ذخيره مي کند :

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ ' type of value is string
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))x
Case REG_DWORD ' type of value is Double word
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)x
End Select
End Function

- تابع QueryValueEx : سايز و نوع داده اي يک داده را که بايد خوانده شود مشخص مي کند .

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)x
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)x
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)x
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)x
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)x
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function

4 - توابع اصلي : توابع مربوط به پاک کردن يک کليد از رجيستري ، ساخت يک کليد جديد در رجيستري و مقداردهي به يک کليد :

- تابع DeleteKey : اين تابع يک کليد از رجيستري را حذف مي کند . داراي دو پارامتر ورودي است :
Location که يکي از مقادير HKEY_CLASSES_ROOT ، HKEY_CURRENT_USER
، HKEY_LOCAL_MACHINE و يا HKEY_USERS است .
KeyName که نام کليدي است که بايد از رجيستري حذف شود . اين کليد ممکنست شامل subkey هايي نيز باشد مثلاً Key1\SubKey1

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)x
Dim lRetVal As Long
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)x
DeleteKey = lRetVal ' return function value
End Function

- تابع DeleteValue : اين تابع يک entry را از کليد حذف مي کند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName که نام آن value را مشخص مي کند .

Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = RegDeleteValue(hKey, sValueName)x
RegCloseKey (hKey)x
DeleteValue = lRetVal
End Function

- تابع CreateNewKey : اين تابع يک کليد جديد ايجاد مي کند . داراي دو پارامتر ورودي است : Location و KeyName

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)x
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)x
RegCloseKey (hNewKey)x
CreateNewKey = lRetVal
End Function

- تابع SetKeyValue : اين تابع پارامتر data يک entry را تنظيم مي کند . داراي 5 پارامتر ورودي است : Location ، KeyName ، ValueName ، ValueSetting و ValueType

Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)x
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)x
RegCloseKey (hKey)x
SetKeyValue = lRetVal
End Function

- تابع QueryValue : اين تابع فيلد داده يک entry را برمي گرداند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
lRetVal = QueryValueEx(hKey, sValueName, vValue)x
QueryValue = vValue
RegCloseKey (hKey)x
End Function

ساخت يک انتصاب فايل يا File Association به يک برنامه

در اين درس می خواهم با استفاده از کلاسی که در درس قبل معرفی شد تابعی بسازيم که توسط آن بتوانيم فايلهای با پسوندی مشخص را به يک برنامه اختصاص دهيم . بعبارت ديگر تابعی بنويسيم که اطلاعات لازم برای باز شدن فايلهايی با پسوند xxx را توسط برنامه MyApp.exe در رجيستری ثبت کند .


Public Sub CreateAssociation(sExtension As String, sApplication As String, sAppPath As String)x
Dim sPath, sAppExe As String
CreateNewKey "." & sExtension, HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, "." & sExtension, "", sApplication & ".Document", REG_SZ
CreateNewKey sApplication & ".Document\shell\open\command", HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, sApplication & ".Document", "", sApplication & " Document", REG_SZ
sPath = sAppPath & " %1"x
sAppExe = sApplication & ".exe"x
SetKeyValue HKEY_CLASSES_ROOT, sApplication& ".Document\shell\open\command", "", sPath, REG_SZ
CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." & sExtension, HKEY_CURRENT_USER
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." & sExtension, "Application", sAppExe, REG_SZ
CreateNewKey "Applications\" & sAppExe & "\shell\open\command", HKEY_CLASSES_ROOT
SetKeyValue HKEY_CLASSES_ROOT, "Applications\" & sAppExe & "\shell\open\command", "", sPath, REG_SZ
End Sub

کاربرد اين تابع بصورت زير است :

CreateAssociation("xxx","MyApp","c:\MyApp.exe")x

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

فرض کنيد می خواهيم برنامه ای بنويسيم که هر بار در هنگام راه اندازي سيستم بطور خودكار اجرا شود. البته نمي خواهم در startup ويندوز ديده شود .
براي اين كار بايد برنامه موردنظر را در StartUp رجيستري قرار دهيم . به اين ترتيب كه در يكي از كليدهاي زير يك مقدار رشته اي جديد(String Value) ايجاد کنيم و آدرس برنامه را در آن وارد كنيم :

HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run

براي مثال اگه اسم برنامه مورد نظر MyApp و مسيرش C:\Windows\MyApp.exe است بايد بصورت زير عمل کرد :

SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "MyApp", "C:\MyApp.exe", REG_SZ

نکته : البته دو تا راه ديگر برای اينکار وجود دارد که برخی تروجان ها هم از اين روشها استفاده می کنند تا روی سيستم باقی بمانند :
يكي استفاده از win.ini و نوشتن نام فايل جلوي = run و ديگري استفاده از system.ini و نوشتن نام برنامه جلوي خط explorer.exe .

آشنايي با Windows API
قصد دارم در مورد API هاي ويندوز و چگونگي استفاده از آنها در ويژوال بيسيک بطور خلاصه توضيح دهم و همچنين دو مثال پراستفاده را نيز در اين زمينه بيان کنم که عبارتند از چگونگي پخش فايلهاي Wav و ساخت يک تايمر با دقت بالا :

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

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

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

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

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

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

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

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

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

توسط کد بالا مي توان يک عمليات خاص را براي يک مدت زماني مشخص اجرا کرد .
کد زير نشان مي دهد که چگونه مي توان دستورات خاصي را در فواصل زماني خاص اجرار کرد :
ExitFunction = False
TempTime = GetTickCount()x
Do While not(ExitFunction)x
If DesiredTime < GetTickCount() - TempTime then
Reset the temporary variable'
TempTime = GetTickCount()x
Do some things'
End If
Loop

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


مباحث پيشرفته Direct3D
موضوع : ساخت يک موتور گرافيکي سه بعدي

قبل از شروع مباحث جديد برنامه نويسي Direct3D ، با هم مروري بر مباحث قبلي خواهيم داشت .( مباحث قبلي در آرشيو موجود مي باشند
در اين درس با استفاده از مطالب قبلي يک Engine سه بعدي ساخته و از امکانات آن در يک برنامه نمونه استفاده خواهيم کرد .
اين engine داراي دو کلاس است :
1 – کلاس MainD3D
2 – کلاس D3Dobject
در کلاس MainD3D متغيرها و توابع لازم براي ساخت يک device سه بعدي ، تنظيمات ماتريسي ، تابع رندر و غيره موجود مي باشد .
متغيرهاي عمومي اين کلاس عبارتند از :
Public g_DX As New DirectX8
Public g_D3D As Direct3D8
Public g_D3DX As New D3DX8
Public g_D3DDevice As Direct3DDevice8
Public NTextures As Long
روتين ها و توابع اين کلاس عبارتند از :
1 - InitD3D : اين روتين ، اشيا D3D و D3Ddevice را مي سازد و پارامترهاي آنها را تنظيم مي کند .
2 – ApplyCameraChanges : روتين ايجاد ماتريس View
3 – SetupMatrices : روتين ايجاد ماتريس Projection
4 – StartRender : در اين روتين عمليات لازم براي شروع عمل رندر صورت مي گيرد .
5 – RenderObject : اين تابع ، يک شي سه بعدي از نوع کلاس D3Dobject را مي گيرد و بردارهاي مورد نياز و نيز بافت شي را تنظيم مي کند و در پايان شي را ترسيم مي کند .
6 – FinishRender : در اين روتين به عمليات رندر پايان داده مي شود .
7 – Cleanup: روتين از بين بردن اشيا Direct3D
8 – CreateVector : تابع ساخت يک بردار سه بعدي
9 – CreateTextures : روتين ساخت يک بافت جديد
10 – InitTexture: تابع مقداردهي به يک بافت
در کلاس D3Dobject متغيرها و توابع لازم براي ايجاد يک شي سه بعدي و اختصاص بافت به آن موجود مي باشد .
در اين کلاس دو type عمومي تعريف شده است :
1 - NormalVERTEX
2 - TeturedVERTEX
همچنين روتين ها و توابع اين کلاس عبارتند از :
1 – InitObject : تابعي که تنظيمات اوليه vertex ها و بافت شي را انجام مي دهد .
2 – Vertex : روتين ايجاد vertex هاي مورد نياز
3 – GetRenderingMode: تابعي که مد رندر را مشخص مي کند .
و نيز يکسري تابع ساخت vertex نرمال و ساخت vertex داراي بافت و غيره

اين دو کلاس در يک پروژه ويژوال بيسيک قرارداده شده و پروژه با نام D3Dengine.dll کامپايل شده است .
حال با استفاده از اين engine مي خواهيم يک منظره سه بعدي را ايجاد کنيم :
اين منظره شامل سه object است : ديوار ، آسمان و زمين.

ابتدا بايد يک شي از کلاس MainD3D تعريف کنيم :

Dim D3D8Main As MainD3D8

در متد Form Load نيز سه شي Floor ، Sky و Wall را بصورت زير تعريف مي کنيم :

Dim Floor As D3DObject
Dim Sky As D3DObject
Dim Walls As D3Dobject

سپس اين سه شي را به اضافه شي D3D8Main ، ايجاد مي کنيم :

Set D3D8Main = New D3DEngine.MainD3D8
Set Floor = New D3DEngine.D3DObject
Set Sky = New D3DEngine.D3DObject
Set Walls = New D3DEngine.D3Dobject

در ابتدا شي MainD3D را Initial مي کنيم و سپس بافتهاي مورد نيز خود را مي سازيم :

D3D8Main.InitD3D True, Me.hWnd
D3D8Main.CreateTextures 3
D3D8Main.InitTexture 1, App.Path + "\floor.jpg"
D3D8Main.InitTexture 2, App.Path + "\sky.bmp"
D3D8Main.InitTexture 3, App.Path + "\wall.bmp"

حال به سراغ ايجاد و مقداردهي vertex هاي floor مي رويم . floor شامل شش vertex مي باشد و بنابراين دو face مثلثي دارد :

Floor.InitObject 6, 2, TriangleList, True, 1

Floor.Vertex 0, -55, -2, -55, vbWhite, 0, 10
Floor.Vertex 1, 55, -2, -55, vbWhite, 10, 10
Floor.Vertex 2, 55, -2, 55, vbWhite, 10, 0
Floor.Vertex 3, -55, -2, -55, vbWhite, 0, 10
Floor.Vertex 4, 55, -2, 55, vbWhite, 10, 0
Floor.Vertex 5, -55, -2, 55, vbWhite, 0, 0

سپس به سراغ ايجاد و مقداردهي vertex هاي wall مي رويم . wall شامل بيست و چهار vertex مي باشد و بنابراين هشت face مثلثي دارد :

Walls.InitObject 24, 8, TriangleList, True, 3

Walls.Vertex 0, -55, -2, -55, &HBCE8FC, 0, 1
Walls.Vertex 1, 55, -2, -55, &HBCE8FC, 5, 1
Walls.Vertex 2, 55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 3, -55, -2, -55, &HBCE8FC, 0, 1
Walls.Vertex 4, 55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 5, -55, 8, -55, &HBCE8FC, 0, 0

Walls.Vertex 6, -55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 7, 55, -2, 55, &HBCE8FC, 5, 1
Walls.Vertex 8, 55, 8, 55, &HBCE8FC, 5, 0
Walls.Vertex 9, -55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 10, 55, 8, 55, &HBCE8FC, 5, 0
Walls.Vertex 11, -55, 8, 55, &HBCE8FC, 0, 0

Walls.Vertex 12, -55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 13, -55, -2, -55, &HBCE8FC, 5, 1
Walls.Vertex 14, -55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 15, -55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 16, -55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 17, -55, 8, 55, &HBCE8FC, 0, 0

Walls.Vertex 18, 55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 19, 55, -2, -55, &HBCE8FC, 5, 1
Walls.Vertex 20, 55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 21, 55, -2, 55, &HBCE8FC, 0, 1
Walls.Vertex 22, 55, 8, -55, &HBCE8FC, 5, 0
Walls.Vertex 23, 55, 8, 55, &HBCE8FC, 0, 0

حال به سراغ ايجاد و مقداردهي vertex هاي sky مي رويم . sky شامل شش vertex مي باشد و بنابراين دو face مثلثي دارد :

Sky.InitObject 6, 2, TriangleList, True, 2

Sky.Vertex 0, -55, 8, -55, &HBCE8FC, 0, 1
Sky.Vertex 1, 55, 8, -55, &HBCE8FC, 0, 1
Sky.Vertex 2, 55, 8, 55, &HBCE8FC, 0, 1
Sky.Vertex 3, -55, 8, -55, &HBCE8FC, 0, 1
Sky.Vertex 4, 55, 8, 55, &HBCE8FC, 0, 1
Sky.Vertex 5, -55, 8, 55, &HBCE8FC, 0, 1

در پايان تابع رندر را صدا مي کنيم . البته در هر بار عمل رندر کردن ، دوربين يک درجه در صفحه X-Z دوران مي کند تا کل ديوار قابل مشاهده باشد :

Dim Angle As Double
PI = 3.1415
Angle = 0
Do
DoEvents
D3D8Main.StartRender vbBlack
D3D8Main.RenderObject Sky
D3D8Main.RenderObject Floor
D3D8Main.RenderObject Walls
D3D8Main.FinishRender
If Sqr(Angle ^ 2) = 360 Then Angle = 0
Angle = Angle + 1
D3D8Main.CamLookAtX = Sin((Angle * 2 * PI) / 360)
D3D8Main.CamLookAtZ = Cos((Angle * 2 * PI) / 360)
D3D8Main.ApplyCameraChanges
Loop

موضوع : استفاده از object هاي 3D Studio Max در Direct3D
تا بحال ما هر شيي را که مي خواستيم در Direct3D بسازيم خودمان بوسيله کد نويسي آنرا توصيف کرده ايم . ممکنست اين سوال برايتان پيش آمده باشد که بازيهاي تجاري براي توليد کاراکترهاي و اشيا پيچيده سه بعدي چگونه عمل مي کنند ؟
منطقي بنظر نمي رسد که اينگونه مدلهاي پيچيده بصورت کد وارد برنامه شده اند زيرا نياز به هزاران خط برنامه براي هر فريم خواهد بود . بجاي اينکار ما object هاي خود را توسط برنامه هاي ديگري مي سازيم و آنها را در برنامه خودمان load مي کنيم سپس بافتها و material هاي مورد نظر را به آنها اختصاص داده و در پايان آنها را رندر مي کنيم . مزيت ديگر اينکار اينست که شما مي توانيد براحتي فايل object خود را تغيير دهيد و مدلهايي با جزئيات متفاوت براي برنامه خود قرار دهيد .
مراحل ساخت چنين برنامه هايي بصورت زير است :

۱ - ساخت object سه بعدي :
اولين چيزي که بايستي بدانيد داشتن دانش پايه اي از چگونگي مدلسازي سه بعدي است . همچنين نياز به يک نرم افزار مدلسازي مثل 3D Studio Max داريد .

بعد از ساخت مدل خود در Max نياز به يک Convertor داريد تا فايلهاي Max را به فايلهاي Direct3D که با فرمت "X." هستند تبديل کنيد .
Convertor هاي زيادي براي تبديل فايلهاي نرم افزارهاي مدلسازي به فايلهاي "X." وجود دارند که برخي از آنها عبارتند از :
- برنامه PolyTrans3D System Translation
- برنامه Deep Exploration 2.0
- برنامه Quick3D
- برنامه 3DWin
- DirectX Explorer Plugin
- ابزارهاي موجود در DirectX 8.0 SDK که عبارتند از :
برنامه Conv3DS براي تبديل فايلهاي 3DS به فايلهاي X
DX SDK Exporter Plugin براي تبديل فايلهاي 3DS و Max به فايلهاي X
از بين اين برنامه ها و plugin ها من برنامه Deep Exploration را به شما پيشنهاد مي کنم .

2 - Load کردن يک Object ساخته شده :
زمانيکه فايل X شي مورد نظر را ساختيد ، load کردن آن در direct3D ساده است . براي اينکار نياز به يک مش داريم که اطلاعات شي ما را نگهداري کند :

Dim Mesh As D3DXMesh
همچنين براي اختصاص material و texture به شي ، نياز به تعريف متغيرهاي زير داريم :

Dim MeshMaterial As D3DMATERIAL8
Dim MeshTexture As Direct3DTexture8

حال به سراغ بازنويسي روتين InitGeometry مي رويم :
- تعريف متغيرهاي مورد نياز :

Dim mtrlBuffer as D3DXBuffer
Dim TextureFile as String
Dim n as Long

- گرفتن داده هاي شي از فايل X :

Set Mesh=D3DX.LoadMeshFromX app.path&"\"&"yourfilename",D3DMESH_MANAGED,D3DDevice,Nothing,mtrlBuffer,n

- استخراج اطلاعات materiasl شي و تنظيم پارامتر Ambient :

D3DX.BufferGetMaterial mtrlBuffer,0,MeshMaterial
MeshMaterial.Ambient=MeshMaterial.Diffuse

- استخراج نام بافت بکار رفته براي شي :

TextureFile=D3DX.BufferGetTextureName(mtrlBuffer,0)x
- ساخت بافت :

If TextureFile<>"" Then
Set MeshTexture=D3DX.CreateTextureFromFile D3DDevice,app.path&"\"&TextureFile,128,128,D3DX_DEFAULT,0,
D3DFMT_UNKNOWN,D3DPOOL_MANAGED,D3DX_FILTER_LINEAR,D3DX_FILTER_LINEAR,0,Byval 0,Byval 0
End If

۳ - رندر نمودن شي : رندر نمودن شي چندان مشکل نيست اما همچنان بايد ماتريسها و تبديلاتي را که مي خواهيد ، خودتان مديريت کنيد .

D3DDevice.SetMaterial MeshMaterial
D3DDevice.SetTexture 0,MeshTexture
Mesh.DrawSubset 0

موضوع : مباحث تکميلي نورپردازي در Direct3D

در بخش اول آموزش Direct3D با مباني نورپردازي آشنا شديد . در اين درس قصد دارم آن مباحث را کاملتر برايتان مطرح کنم .
نورپردازي يکي از بخشهاي مهم طراحي يک بازي و يا يک انيميشن سه بعدي است . بمنظور پياده سازي نورپردازي يک صحنه ابتدا بايد با تئوري آن آشنا شويد .
تئوري نورپردازي : نورپردازي در Direct3D تخميني از چگونگي عملکرد نور در دنياي واقعي مي باشد . چهار نوع اصلي نور در Direct3D قابل استفاده است ( همچنين شما مي توانيد خودتان انواع جديدي از نور ايجاد کنيد که موضوع ما نيست ) :
۱ - Point Light : توسط يک نقطه در فضاي سه بعدي ايجاد مي شود و داراي سه پارامتر رنگ ، دامنه و تضعيف مي باشد . دامنه يک نور مسافتي است که نور مي تواند طي کند . تضعيف ، مقدار کاهش نور در اثر افزايش مسافت مي باشد . نور نقطه اي در تمام جهات تششع مي کند - شبيه يک لامپ حبابي و يا يک شمع
۲ - Spot Light : داراي يک موقعيت و يک جهت است و تنها نور را در يک جهت خاص مي تاباند - شبيه يک چراغ قوه . اين نور داراي يک زاويه مخروطي و يک دامنه است .
۳ - Directional Light : داراي موقعيت نيست و براي پياده سازي نورهايي که از فاصله بسيار دور مي آيند - مثل خورشيد - مناسب است .
۴ - Ambient Light : اين نور تضمين مي کند که تمام vertex هاي يک صحنه تاريکتر از يک رنگ خاص نباشند .
عملي کردن نورپردازي : ضمن اينکه اغلب کارت هاي گرافيک سه بعدي از نورپردازي پشتيباني مي کنند اما اين نکته بايد مورد توجه قرار گيرد که با افزايش تعداد نور در يک صحنه محاسبات Direct3D بيشتر مي شود و اين باعث کند شدن رندر صحنه خواهد شد و بنابراين کارت هاي گرافيکي سه بعدي نيز داراي يک ماکزيمم تعداد نور هستند - مثلاً ۱۶ نور در GeForce 2 - همچنين توجه داشته باشيد که نورهاي مختلف داراي زمان پردازشي متفاوتي هستند . نور ambient سريعترين زمان پردازشي را دارد ، سپس نورdirectional ، سپس نور point و کندترين آنها Spot Light است .
همچنين نکته ديگري که بايد توجه کنيد دامنه نور است . اگر نور ، يک منطقه بزرگي را پوشش دهد بر تعداد زيادي از vertex ها تاثير مي گذارد و اين باعث افزايش محاسبات مي شود .
نورپردازي Specular - که در درسهاي بعدي در مورد آن صحبت مي کنم و براي ايجاد اشيا درخشان استفاده مي شود - نيز زمان پردازشي زيادي دارد و بهتر است کمتر از آن استفاده شود .
پارامتر ديگري که بايد در نظر بگيريد جزئيات هندسه شما مي باشد . هر چه پيچيدگي صحنه بيشتر باشد ، نورپردازي نيز زمان بيشتري را مصرف مي کند .
سايه زني نيز يک بخش بسيار پيچيده در مدل سازي نور است و محاسبات آن بسيار زمان گير خواهد بود بنابراين Direct3D مستقيماً محاسبات سايه زني را انجام نمي دهد بلکه رنگ نور را بر مبناي جهت هر مثلث scale مي کند بنابراين قسمت پشتي يک شي که رو به نور نيست ، هيچ نوري را دريافت نمي کند .

بردار نرمال : Direct3D هر vertex را بر مبناي بک بردار نرمال نورپردازي مي کند و نوري که يک vertex دريافت مي کند به زاويه بين نور و بردار نرمال آن vertex بستگي دارد . بردار نرمال توسط سه vertex يک face مثلثي ايجاد مي شود و اين بردار نرمال ساخته شده به vertex ها اختصاص مي يابد . بردار نرمال در واقع سمت يک مثلث را مشخص مي کند بنابراين اگر نور پشت مثلث باشد ، مثلث هيچ نوري را دريافت نميکند . بردار نرمال بايستي داراي طول ۱ باشد .
مراحل توليد بردار نرمال يک face مثلثي :
۱ - مطمئن شويد که face در جهت عقربه هاي ساعت ساخته شده است .
۲ - يک بردار از vertex شماره صفر به vertex شماره يک بسازيد .
۳ - يک بردار از vertex شماره صفر به vertex شماره دو بسازيد .
۴ - حاصلضرب برداري ( cross droduct ) اين دو بردار را بدست آوريد .
۵ - نتيجه حاصلضرب را نرمال کنيد .

Private Function GenerateTriangleNormals(p0 As UnlitVertex, p1 As UnlitVertex, p2 As UnlitVertex) As D3DVECTOR
Dim v01 As D3DVECTOR
Dim v02 As D3DVECTOR
Dim vNorm As D3DVECTOR
D3DXVec3Subtract v01, MakeVector(p1.X, p1.Y, p1.Z), MakeVector(p0.X, p0.Y, p0.Z)x
D3DXVec3Subtract v02, MakeVector(p2.X, p2.Y, p2.Z), MakeVector(p0.X, p0.Y, p0.Z)x
D3DXVec3Cross vNorm, v01, v02
D3DXVec3Normalize vNorm, vNorm
GenerateTriangleNormals.X = vNorm.X
GenerateTriangleNormals.Y = vNorm.Y
GenerateTriangleNormals.Z = vNorm.Z
End Function

اگر دو face در يک vertex مشترک باشند ( مثل گوشه دو ديوار ) براي توليد نرمال اين vertex ابتدا نرمال دو face را با روش فوق بدست آوريد سپس دو بردار نرمال را با هم جمع کنيد و در پايان بردار حاصلجمع را نرمال کنيد .

برپاسازي نورپردازي : اولين چيزي که قبل از برپاسازي نورپردازي بايستي اعمال کنيم تغيير ساختار vertex است . براي اينکار بايد پارامتر color را از ساختار vertex حذف و سه پارامتر را براي نگهداري نرمال اضافه کنيم :

Private Type UnlitVertex
X As Single
Y As Single
Z As Single
nx As Single
ny As Single
nz As Single
tu As Single
tv As Single
End Type
Const Unlit_FVF = (D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1)x

همچنين بايد براي تمام vertex هاي شي خود بردار نرمال را محاسبه کنيد براي مثال اگر شي شما يک مکعب است براي هر ۱۲ face آن بردار نرمال را بدست آوريد . در زير من کد لازم براي ساخت نرمال يکي از اين face ها را نوشته ام :

Cube2(0) = CreateVertex(-1, -1, 1, 0, 0, 0, 0, 0)x
Cube2(1) = CreateVertex(1, 1, 1, 0, 0, 0, 1, 1)x
Cube2(2) = CreateVertex(-1, 1, 1, 0, 0, 0, 0, 1)x
vN = GenerateTriangleNormals(Cube2(0), Cube2(1), Cube2(2))x
Cube2(0).nx = vN.X: Cube2(0).ny = vN.Y: Cube2(0).nz = vN.Z
Cube2(1).nx = vN.X: Cube2(1).ny = vN.Y: Cube2(1).nz = vN.Z
Cube2(2).nx = vN.X: Cube2(2).ny = vN.Y: Cube2(2).nz = vN.Z

براي برپا سازي نور ابتدا بايستي يک material به device خود اضافه کنيد :

Dim Mtrl As D3DMATERIAL8, Col As D3DCOLORVALUE
Col.a = 1: Col.r = 1: Col.g = 1: Col.b = 1
Mtrl.Ambient = Col
Mtrl.diffuse = Col
D3DDevice.SetMaterial Mtrl

سپس بايستي طوري device خود را تنظيم کنيد که نور شما را بشناسد - lights يک شي از نوع D3DLight8 است - يکبار که اين خط را بنويسيد مي توانيد از نور استفاده کنيد اما اگر خصوصيات نور را تغيير دهيد بايستي دوباره اين دستور را فراخواني کنيد :

D3DDevice.SetLight 0, Lights

حال بايد نور را روشن کنيد :

D3DDevice.LightEnable 0, 1

و در پايان بايد به Direct3D بگوئيد که نورپردازي را براي شما انجام دهد :

D3DDevice.SetRenderState D3DRS_LIGHTING, 1

چگونگي ايجاد يک نور : براي ايجاد هر يک از ۴ نوع اصلي نور بايد به روشي خاص عمل کنيد :
۱ - نورپردازي Ambient : اين نوع نورپردازي بسيار ساده است و تنها با فراخواني تابع SetRenderState ايجاد مي شود . رنگ ambient يک عدد هگزادسيمال بصورت RRGGBB است :

D3DDevice.SetRenderState D3DRS_AMBIENT, &H202020

۲ - نورپردازي Directional : داراي دو پارامتر رنگ و جهت مي باشد :

Lights.Type = D3DLIGHT_DIRECTIONAL
Lights.diffuse.r = 1
Lights.diffuse.g = 1
Lights.diffuse.b = 1
Lights.Direction = MakeVector(0, -1, 0)x

3 - نورپردازي Point : داراي سه پارامتر موقعيت ، رنگ و تضعيف مي باشد :

Lights.Type = D3DLIGHT_POINT
Lights.position = MakeVector(5, 0, 2)x
Lights.diffuse.b = 1
Lights.Range = 100
Lights.Attenuation1 = 0.05

۴ - نورپردازي Spot : اين نور داراي دو مخروط است که نقاط خارج مخروط اول روشنتر از نقاط داخل آن هستند . دو زاويه براي مخروط وجود دارد - زاويه داخلي theta و زاويه خارجي phi - که برحسب راديان هستند :

Lights.Type = D3DLIGHT_SPOT
Lights.position = MakeVector(-4, 0, 0)x
Lights.Range = 100
Lights.Direction = MakeVector(1, 0, 0)x
Lights.Theta = 30 * (Pi / 180)x
Lights.Phi = 50 * (Pi / 180)x
Lights.diffuse.g = 1
Lights.Attenuation1 = 0.05

موضوع : استفاده از Index Buffer براي ذخيره سازي اشکال سه بعدي

مقدمه : مکعبي که در درسهاي قبلي ساختيم را درنظر بگيريد . با دانشي که اکنون داريد ، دو راه براي ساخت يک مکعب داريم : ۱ - استفاده از 36 عدد vertex براي تعريف face هاي مکعب ۲ - ساخت مکعب با استفاده از يک مدلساز و ذخيره آن با فرمت X
روش اول غيرکارامد است زيرا شما بايستي از تعداد زيادي vertex براي يک شکل بسيار ساده استفاده کنيد . روش دوم مناسب است اما زمانيکه بخواهيم رنگها و بافتها را تغيير دهيم دچار مشکل خواهيم شد . روش جديدي که امروز در مورد آن صحبت مي کنم استفاده ار Index Buffer است .
Index Buffer شامل يکسري عدد integer است که اين اعداد مرجعي براي vertex هاي ذخيره شده در يک Vertex Buffer هستند . براي مثال فرض کنيد يک Vertex Buffer شامل 8 عدد vertex داريم که يک مکعب را براي ما توصيف مي کند . ما مي توانيم يک Index Buffer با ۳۶ عضو بسازيم بطوريکه ترتيب اتصال vertex ها را براي ما مشخص کنند . مثلاً Index هاي ۰ و ۱و ۳ براي مشخص کردن face شماره ۱ مکعب بکار مي روند . بنابراين بجاي استفاده از ۳۶ عدد vertex مي توانيم مکعب را با ۸ عدد vertex و يک Index Buffer بسازيم .
گرچه استفاده از Index Buffer بسيار کارامد است اما چندين محدوديت در استفاده از آن وجود دارد . مهمترين آنها اينست که تمام انديسهايي که يک vertex مشابه را share مي کنند بايستي خصوصيات مشابهي داشته باشند - موقعيت ، رنگ ، بافت و نرمال يکسان - براي مثال نمي توانيد مکعبي بسازيد که هر face آن يک رنگ داشته باشد .

ساخت Index Buffer : ابتدا به متغيرهاي زير نياز داريم :

Dim VBuffer as Direct3DVertexBuffer8
Dim IBuffer as Direct3DIndexBuffer8
Dim Vlist(0 to 7) as LITVERTEX
Dim Ilist(0 to 35) as Integer

تابع InitGeometry بصورت زير بازنويسي مي شود:
۱- توليد هشت vertex براي مکعب :

Vlist(0) = CreateLitVertex(-1, -1, -1, &HFF0000, 0, 0, 0)x
Vlist(1) = CreateLitVertex(-1, 1, -1, &HFF00&, 0, 0, 0)x
Vlist(2) = CreateLitVertex(1, -1, -1, &HFF&, 0, 0, 0)x
Vlist(3) = CreateLitVertex(1, 1, -1, &HFF00FF, 0, 0, 0)x
Vlist(4) = CreateLitVertex(-1, -1, 1, &HFFFF00, 0, 0, 0)x
Vlist(5) = CreateLitVertex(-1, 1, 1, &HFFFF, 0, 0, 0)x
Vlist(6) = CreateLitVertex(1, -1, 1, &HFFCC00, 0, 0, 0)x
Vlist(7) = CreateLitVertex(1, 1, 1, &HFFFFFF, 0, 0, 0)x

۲ - ايجاد Vertex Buffer توسط تابع CreateVertexBuffer :

Set VBuffer = D3DDevice.CreateVertexBuffer(Len(Vlist(0)) * 8, 0, Lit_FVF, D3DPOOL_DEFAULT)x
D3DVertexBuffer8SetData VBuffer, 0, Len(Vlist(0)) * 8, 0, Vlist(0)x

۳ - توليد index ها :
front '
Ilist(0) = 0: Ilist(1) = 1: Ilist(2) = 2
Ilist(3) = 1: Ilist(4) = 3: Ilist(5) = 2
Right '
Ilist(6) = 2: Ilist(7) = 3: Ilist(8) = 6
Ilist(9) = 3: Ilist(10) = 7: Ilist(11) = 6
Back '
Ilist(12) = 6: Ilist(13) = 7: Ilist(14) = 4
Ilist(15) = 7: Ilist(16) = 5: Ilist(17) = 4
Left '
Ilist(18) = 4: Ilist(19) = 5: Ilist(20) = 0
Ilist(21) = 5: Ilist(22) = 1: Ilist(23) = 0
Top '
Ilist(24) = 1: Ilist(25) = 5: Ilist(26) = 3
Ilist(27) = 5: Ilist(28) = 7: Ilist(29) = 3
Bottom '
Ilist(30) = 2: Ilist(31) = 6: Ilist(32) = 0
Ilist(33) = 6: Ilist(34) = 4: Ilist(35) = 0

۴ - ايجاد Index Buffer توسط تابع CreateIndexBuffer :

Set IBuffer = D3DDevice.CreateIndexBuffer(Len(Ilist(0)) * 36, 0, D3DFMT_INDEX16, D3DPOOL_DEFAULT)x
D3DIndexBuffer8SetData IBuffer, 0, Len(Ilist(0)) * 36, 0, Ilist(0)x


تابع Render : براي رندر کردن اين مکعب دو روش وجود دارد :
۱ - استفاده از تابع DrawIndexedPrimitive : در اين روش از VBuffer و IBUffer و آرايه vertex ها استفاده مي شود :

Public Sub Render()x
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(Vlist(0))x
D3DDevice.SetIndices IBuffer, 0
D3DDevice.DrawIndexedPrimitive D3DPT_TRIANGLELIST, 0, 36, 0, 12
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

۲ - استفاده از تابع DrawIndexedPrimitiveUP : در اين روش از آرايه هاي vertex و index استفاده مي شود :

Public Sub Render()x
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.DrawIndexedPrimitiveUP D3DPT_TRIANGLELIST, 0, 8, 12, Ilist(0), D3DFMT_INDEX16, Vlist(0), Len(Vlist(0))x
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

موضوع : Vertex/Mesh Animation
در اين درس در مورد روشهاي ساخت انيميشن در Direct3D صحبت خواهيم کرد . انيميشن در فضاي سه بعدي در حالتهاي مختلفي مي تواند ايجاد شود که بسته به engine گرافيکي شما و ابزارهايي که ايجاد کرده ايد ، دارد . سه روش اصلي ساخت انيميشن وجود دارد که عبارتند از :
- Tween سازي دستي / درون يابي خطي ( manual tweening/linear interpolation )
- درون بابي برداري ( vector interpolation )
- درون يابي بر اساس فريم کليدي ( keyframe interpolation )

1 – روش اول يکي از ساده ترين راههاي ساخت انيميشن است . اين روش در زمانيکه با مدلهاي پيچيده سر و کار داريد مناسب نيست – و يا مدلهايي با تعداد زيادي vertex – اين روش نوعي tween کردن است که از مزيت index buffer ها استفاده مي کند .
درون يابي ، چگونگي تغييرات شيي در طول يک زمان مشخص مي باشد . در درسهاي قبلي شما درون يابي رنگ را روي يک شي ديديد که در آن يک رنگ بطور ملايم به رنگ ديگري تبديل مي شد ( fadeشدن ( . درون يابي خطي نيز مشابه آن است . براي درون يابي خطي از موقعيت A به موقعيت B از فرمول زير استفاده مي شود :
(B*V)+A*(1-V)
که A و B مختصاتهاي مبدا و مقصد هستند و V ضريب درون يابي است که عددي بين صفر و يک مي باشد . اين فرمول مختصات نقطه tween را در هر لحظه مشخص مي کند .
همانطور که مي بينيد بکار بردن اين فرمول براي يک شي با تعداد زيادي vertex بسيار وقت گير بوده و fram rate را پايين مي آورد .
تابع زير دو vertex و يک مقدار ضريب درون يابي را مي گيرد تا نقطه tween را محاسبه کند :

Private Function TweenVertices(Source As LITVERTEX, Dest As LITVERTEX, TweenAmount As Single) As LITVERTEX
TweenVertices.X = (Dest.X * TweenAmount) + Source.X * (1# - TweenAmount)x
TweenVertices.Y = (Dest.Y * TweenAmount) + Source.Y * (1# - TweenAmount)x
TweenVertices.Z = (Dest.Z * TweenAmount) + Source.Z * (1# - TweenAmount)x
TweenVertices.color = Source.color
End Function

اگر شما از vertex هاي UNLIT استفاده کنيد – vertex هايي با بردار نرمال – در اينصورت بايد کد فوق را تغيير دهيد و بايد tween را از نرمال مبدا به نرمال مقصد نيز انجام دهيد .
همانطور که مي بينيد رنگ tween vertex نيز تنظيم شده است . در يک تابع tweening مناسبتر مي توانيد رنگها ، مختصات بافت و مقادير specular را نيز tween کنيد .
محدوديتي که اين روش دارد اينست که خطي است و براي مدل کردن حرکتهاي غير خطي درست کار نمي کند .
حال مي خواهيم از تابع tween استفاده کنيم تا يک مکعب را در يک انيميشن به يک هرم تبديل کنيم . ابتدا سه شي را بصورت زير تعريف مي کنيم :

در ابتداي انيميشن ، شي current cube همان source cube است’
CubeVertices(0) = CreateLitVertex(-1, -1, -1, &HFF0000, 0, 0, 0)x
CubeVertices(1) = CreateLitVertex(-1, 1, -1, &HFF00&, 0, 0, 0)x
CubeVertices(2) = CreateLitVertex(1, -1, -1, &HFF&, 0, 0, 0)x
CubeVertices(3) = CreateLitVertex(1, 1, -1, &HFF00FF, 0, 0, 0)x
CubeVertices(4) = CreateLitVertex(-1, -1, 1, &HFFFF00, 0, 0, 0)x
CubeVertices(5) = CreateLitVertex(-1, 1, 1, &HFFFF, 0, 0, 0)x
CubeVertices(6) = CreateLitVertex(1, -1, 1, &HFFCC00, 0, 0, 0)x
CubeVertices(7) = CreateLitVertex(1, 1, 1, &HFFFFFF, 0, 0, 0)x
مکعب اوليه’
CubeVerticesSource(0) = CreateLitVertex(-1, -1, -1, &HFF0000, 0, 0, 0)x
CubeVerticesSource(1) = CreateLitVertex(-1, 1, -1, &HFF00&, 0, 0, 0)x
CubeVerticesSource(2) = CreateLitVertex(1, -1, -1, &HFF&, 0, 0, 0)x
CubeVerticesSource(3) = CreateLitVertex(1, 1, -1, &HFF00FF, 0, 0, 0)x
CubeVerticesSource(4) = CreateLitVertex(-1, -1, 1, &HFFFF00, 0, 0, 0)x
CubeVerticesSource(5) = CreateLitVertex(-1, 1, 1, &HFFFF, 0, 0, 0)x
CubeVerticesSource(6) = CreateLitVertex(1, -1, 1, &HFFCC00, 0, 0, 0)x
CubeVerticesSource(7) = CreateLitVertex(1, 1, 1, &HFFFFFF, 0, 0, 0)x
هرم مقصد’
CubeVerticesDest(0) = CreateLitVertex(-1, -1, -1, &HFF0000, 0, 0, 0)x
CubeVerticesDest(1) = CreateLitVertex(-0.1, 1, -0.1, &HFF00&, 0, 0, 0)x
CubeVerticesDest(2) = CreateLitVertex(1, -1, -1, &HFF&, 0, 0, 0)x
CubeVerticesDest(3) = CreateLitVertex(0.1, 1, -0.1, &HFF00FF, 0, 0, 0)x
CubeVerticesDest(4) = CreateLitVertex(-1, -1, 1, &HFFFF00, 0, 0, 0)x
CubeVerticesDest(5) = CreateLitVertex(-0.1, 1, 0.1, &HFFFF, 0, 0, 0)x
CubeVerticesDest(6) = CreateLitVertex(1, -1, 1, &HFFCC00, 0, 0, 0)x
CubeVerticesDest(7) = CreateLitVertex(0.1, 1, 0.1, &HFFFFFF, 0, 0, 0)x

حال بايد در يک حلقه با استفاده از تابع twen پيکسلهاي CubeVertices را update کنيم :

Private Sub UpdateAnimation()x
Dim I As Integer
به روز کردن پارامترهاي زمان و جهت'
If AnimTweenDir = True Then
AnimTweenFactor = AnimTweenFactor + (((GetTickCount() - LastTimeTweened) / 1000)*1#)
LastTimeTweened = GetTickCount
If AnimTweenFactor >= 1# Then
AnimTweenFactor = 1#
AnimTweenDir = False
End If
Else
AnimTweenFactor = AnimTweenFactor - (((GetTickCount() - LastTimeTweened) / 1000)*1#)
LastTimeTweened = GetTickCount
If AnimTweenFactor <= 0# Then
AnimTweenFactor = 0#
AnimTweenDir = True
End If
End If
به روز کردن اطلاعات vertex ها '
For I = 0 To 7
CubeVertices(I) = TweenVertices(CubeVerticesSource(I), CubeVerticesDest(I), AnimTweenFactor)x
Next I
به روز کردن بافر vertex’
If D3DVertexBuffer8SetData(VBuffer, 0, Len(CubeVertices(0)) * 8, 0, CubeVertices(0)) = D3DERR_INVALIDCALL Then GoTo Error:
Exit Sub
Error:
Debug.Print “Error occured whilst updating the animation…”x
End Sub

زمان پايه انيميشن توسط عبارت زير تنظيم مي شود :
(((GetTickCount() - LastTimeTweened) / 1000) * 1#)
همانطور که مي دانيد دو نوع انيميشن وجود دارد : انيميشن بر مبناي frame و انيميشن بر مبناي زمان . در انيميشن بر مبناي frame شماره فريم با يک مقدار ثابت در زمان افزايش مي يابد اما اگر اينکار باعث مي شود کيفيت انيميشن در کامپيوترهاي با سرعت متفاوت تغيير کند . بنابراين انيميشن را بر مبناي زمان توليد کرده ايم . انيميشن هاي بر مبناي زمان بجاي " 1 فريم در هر سيکل " ، " 30 فريم در هر ثانيه " هستند

2 – روش دوم از توابع کتابخانه D3DX براي انجام عمل tweening استفاده مي کند و بنابراين بهبودي در سرعت انيميشن نسبت به روش بالا حاصل مي شود . با استفاده از کتابخانه D3DX مي توانيم عمل درون يابي خطي را براي تمام اجزا اصلي يک vertex انجام دهيم . ليست زير توابعي را براي اينکار نشان مي دهد :
- تابع D3DXVec3Lerp : انجام درون يابي براي موقعيت و نرمال :

D3DXVec3Lerp( VOut as D3DVECTOR, V1 as D3DVECTOR, V2 as D3DVECTOR, S as Single)x
- VOut = The result of the interpolation
- V1 = The source coordinates
- V2 = The destination coordinates
- S = The interpolation amount - between, but not limited to, 0.0 - 1.0 scale; where 0 is the source and 1 is the destination


- تابع D3DXColorLerp : انجام درون يابي براي رنگهاي vertex :

D3DXColorLerp( COut as D3DCOLORVALUE, C1 as D3DCOLORVALUE, C2 as D3DCOLORVALUE, S as Single)x
- COut = The resulting colour
- C1 = The source colour
- C2 = The destination colour
- S = The interpolant,

on a 0.0 to 1.0 scale
- تابع D3DXVec2Lerp : انجام درون يابي براي مختصاتهاي دوبعدي :

- VOut = The result of this interpolation
- V1 = The source coordinates
- V2 = The destination coordinates
- S = The interpolant on a 0.0 to 1.0 scale

- تابع D3DXVec3Hermite : توليد يک مسير منحني که از دو نقطه کنترل عبور مي کند :

D3DXVec3Hermite( VOut as D3DVECTOR, V1 as D3DVECTOR, T1 as D3DVECTOR, V2 as D3DVECTOR, T2 as D3DVECTOR, S as Single)x
- VOut = The Result
- V1 = The Source Coordinate
- T1 = The Tangent at the Source coordinate, this is the direction and speed the line will leave the source point.
- V2 = The Destination Coordinate
- T2 = The Tangent at the Destination coordinate, this is the direction and speed the line will enter the destination point.
- S = The Interpolant Value

براي اينکه بتوانيم از کتابخانه D3DX استفاده کنيم بايد توصيف vertex هايمان را تغيير دهيم و بايستي يکسري مقادير ARGB اضافي را به ساختار vertex اضافه کنيم :

Private Type LITVERTEX
X As Single
Y As Single
Z As Single
color As Long
specular As Long
tu As Single
tv As Single
ColorEx As D3DCOLORVALUE
End Type

حال تابع tween را بصورت زير مي نويسيم :

Private Function TweenVertices(Source As LITVERTEX, Dest As LITVERTEX, TweenAmount As Single) As LITVERTEX
Dim vResult As D3DVECTOR
Dim vResult2 As D3DVECTOR2
Tween کردن موقعيت vertex ها ‘
D3DXVec3Lerp vResult, MakeVector(Source.X, Source.Y, Source.Z), MakeVector(Dest.X, Dest.Y, Dest.Z), TweenAmount
TweenVertices.X = vResult.X
TweenVertices.Y = vResult.Y
TweenVertices.Z = vResult.Z
Tween کردن اطلاعات texture ’
D3DXVec2Lerp vResult2, MakeVector2D(Source.tu, Source.tv), MakeVector2D(Dest.tu, Dest.tv), TweenAmount
TweenVertices.tu = vResult2.X
TweenVertices.tv = vResult2.Y
Tween کردن اطلاعات رنگ ‘
D3DXColorLerp TweenVertices.ColorEx, Source.ColorEx, Dest.ColorEx, TweenAmount
With TweenVertices.ColorEx
TweenVertices.color = RGB(.B * 255, .G * 255, .R * 255)x
End With
End Function

نکته اي که بايد به آن توجه کنيد اينست که در تابع فوق براي اشاره به vertex ، يک بردار ساخته شده است ( توسط تابع MakeVector ) .

3 – روش سوم پر استفاده ترين روش انيميشن سازي است . اگر شما انيميشن هاي پيچيده با تعداد زيادي شي در آن داشته باشيد و اگر بخواهيد تغييرات اشيا را در هر فريم ذخيره کنيد ، به حجم بالايي از منابع ذخيره سازي نياز است . بجاي آن ما با استفاده از يکسري فريم کليدي ، فريمهاي مياني را پيش بيني مي کنيم .
براي انجام درون يابي فريم کليدي ، بايستي مقدار vertex را در هر فريم کليدي بدانيم و نيز بدانيم هر فريم کليدي در چه زماني ظاهر مي شود . بنابراين بايد براي هر انيميشن چند فايل را بعنوان فريم کليدي ذخيره کنيم .
در اين درس ما داده هاي کليدي انيميشن را از يکسري فايل load مي کنيم بنابراين تمام ثابتهاي زمان keyframe درون برنامه قرار داده مي شود ( شما مي توانيد خودتان يک ماژول بنويسيد که انيميشن هاي عمومي تر را نيز مديريت کند . اين ماژول بايد قادر باشد که يک فرمت استاندارد فايل را import کند ، اشيا و texture هاي مربوطه را load نمايد و سپس خودش ساخت انيميشن را بطور اتوماتيک انجام دهد و برنامه اصلي فقط روتين render و يا update را فراخواني کند ) . پس از جمع آوري اطلاعات فريم هاي کليدي ، بايد در هر زمان محاسبه کنيم که چه مدتي از شروع انيميشن گذشته است و بنابراين انيميشن در چه موقعيتي قرار دارد . سپس محاسبه مي کنيم که فريم کليدي قبلي و فريم کليدي بعدي چيست همچنين حساب مي کنيم در چه فاصله زماني از ايندو قرار داريم . سرانجام يک درون يابي نرمال را انجام مي دهيم تا اطلاعات فريم جاري بدست آيد و اين اطلاعات را درون يک شي Mesh مي گذاريم و آنرا رندر مي کنيم .
در درسهاي قبلي در مورد load کردن اشيا از يک فايل X صحبت کردم اما در مورد چگونگي گرفتن اطلاعات vertex از يک شي Mesh صحبت نشد . کتابخانه D3DX براي اينکار دو تابع دارد :
- تابع D3DXMeshVertexBuffer8GetData : اطلاعات يک شي D3DXMesh را گرفته و در يک آرايه از D3DVERTEX ذخيره مي کند :

D3DXMeshVertexBuffer8GetData( D3DXMeshobj As Unknown, Offset As Long, Size As Long, Flags As Long, Data As Any) As Long
- D3DXMeshobj As Unknown = A D3DXMESH object that you want to extract the data from.
- Offset As Long = How far into the vertex buffer we want to start reading, 0 is the beginning
- Size As Long = Size of the vertex buffer, this will be Len(D3DVERTEX) * Mesh.GetNumVertices
- Flags As Long = A combination of the CONST_D3DLOCKFLAGS, leave as 0.
- Data As Any = The first element in the array that you want the data to be read into, should be an array of D3DVERTEX vertices
- Return Code As Long = Returns D3D_OK for success, or either of D3DERR_INVALIDCALL or E_INVALIDARG for an error


- تابع D3DXMeshVertexBuffer8SetData : اطلاعات يک بافر vertex را در يک شي D3DXMesh قرار مي دهد :

D3DXMeshVertexBuffer8SetData( D3DXMeshobj As Unknown, Offset As Long, Size As Long, Flags As Long, Data As Any) As Long
- D3DXMeshobj As Unknown = The D3DXMESH object that defines where you want the data to be placed
- Offset As Long = How far into the Destination vertex buffer you want to place the data
- Size As Long = The Size of the buffer in bytes, this will be Len(D3DVERTEX) * Mesh.GetNumVertices
- Flags As Long = A Combination of the CONST_D3DLOCKFLAGS, leave as 0
- Data As Any = The first element in the array of data you want placed in the mesh's vertex buffer
- Return Code As Long = D3D_OK for success or D3DERR_INVALIDCALL or E_INVALIDARG for failure

عمليات انجام انيميشن فريم کليدي بصورت زير است :
- load کردن اشيا از فايلهاي X به درون شي D3DXMesh
- استخراج اطلاعات vertex از اين شي
- انجام درون يابي بين فريمهاي کليدي
- قرار دادن اطلاعات vertex هاي درون يابي در يک شي D3DXMesh
فرض مي کنيم که انيميشن ما هميشه از زمان صفر تا زمان n باشد – برحيب ميلي ثانيه – بنابراين مي توانيم از GetTickCount براي توابع زماني خود استفاده کنيم . همچنين يک ساختار را براي هر فريم کليدي بصورت زير تعريف مي کنيم :

Private Type KeyFrame
شي load شده از يک فايل’ Mesh As D3DXMesh
آرايه material براي هر شي’ MatList() As D3DMATERIAL8
آرايه Texture’ TexList() As Direct3DTexture8
تعداد material ها و texture هايي که استفاده مي کنيم’ nMaterials As Long
داده هاي vertex براي اين فريم کليدي’ VertexList() As D3DVERTEX
موقعيت اين فريم کليدي در انيميشن’ TimeIndex As Long
End Type

حال بايد تابعي بنويسيم که اطلاعات را از يک فايل X استخراج کرده و درون فريم کليدي قرار دهد :

Private Function CreateKeyFrameFromFile(Filename As String, TexturePrefix As String, Time As Long) As KeyFrame

نام فايل X براي شي سه بعدي: Filename ’
پوشه اي که اطلاعات texture اين شي در آن قرار دارد : TexturePrefix ’
انديس زمان براي اين فريم کليدي : Time '

Dim I As Long
Dim XBuffer As D3DXBuffer
Dim TextureFile As String
Dim hResult As Long

'خواندن اطلاعات از فايل ورودي به حافظه

Set CreateKeyFrameFromFile.Mesh = D3DX.LoadMeshFromX(Filename, D3DXMESH_MANAGED, D3DDevice, Nothing, XBuffer, CreateKeyFrameFromFile.nMaterials)x
توليد material ها و texture ها ‘
ReDim CreateKeyFrameFromFile.MatList(CreateKeyFrameFromFile.nMaterials) As D3DMATERIAL8
ReDim CreateKeyFrameFromFile.TexList(CreateKeyFrameFromFile.nMaterials) As Direct3DTexture8
For I = 0 To CreateKeyFrameFromFile.nMaterials - 1
D3DX.BufferGetMaterial XBuffer, I, CreateKeyFrameFromFile.MatList(I)x
CreateKeyFrameFromFile.MatList(I).Ambient = CreateKeyFrameFromFile.MatList (I).diffuse
TextureFile = D3DX.BufferGetTextureName(XBuffer, I)x
If TextureFile <> "" Then
Set CreateKeyFrameFromFile.TexList(I) = D3DX.CreateTextureFromFileEx(D3DDevice, TexturePrefix & TextureFile, D3DX_DEFAULT, D3DX_DEFAULT, D3DX_DEFAULT, 0, D3DFMT_UNKNOWN, D3DPOOL_MANAGED,
D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)x
End If
Next I

استخراج داده هاي vertex’
ReDim CreateKeyFrameFromFile.VertexList(CreateKeyFrameFromFile.Mesh.GetNumVertices) As D3DVERTEX
hResult = D3DXMeshVertexBuffer8GetData(CreateKeyFrameFromFile.Mesh, 0, Len(CreateKeyFrameFromFile.VertexList(0)) * reateKeyFrameFromFile.Mesh.GetNumVertices, 0, CreateKeyFrameFromFile.VertexList(0))
CreateKeyFrameFromFile.TimeIndex = Time
End Function

در تابع Initialize خطوط زير را براي ساخت فريم هاي کليدي اضافه مي کنيم :

nKeyFrames = 4
kfAnimLength = 2500
AnimLastStartAt = GetTickCount()x
ReDim kfAnim(nKeyFrames - 1) As KeyFrame
kfAnim(0) = CreateKeyFrameFromFile(App.Path & "\frame0.x", App.Path & "\", 0)x
kfAnim(1) = CreateKeyFrameFromFile(App.Path & "\frame1.x", App.Path & "\", kfAnimLength * (1 / 3))x
kfAnim(2) = CreateKeyFrameFromFile(App.Path & "\frame2.x", App.Path & "\", kfAnimLength * (2 / 3))x
kfAnim(3) = CreateKeyFrameFromFile(App.Path & "\frame3.x", App.Path & "\", kfAnimLength)x
kfCurrent = CreateKeyFrameFromFile(App.Path & "\frame0.x", App.Path & "\", 0)

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

For I = 0 To nKeyFrames - 2
If CurrentTimeIndex >= kfAnim(I).TimeIndex Then
PrevFrame = I
NextFrame = I + 1
End If
Next I

سپس بايد با توجه به زمان index دو فريم کليدي و زمان جاري ، پارامتر درون يابي را محاسبه کنيم :

sTime = kfAnim(PrevFrame).TimeIndex
eTime = kfAnim(NextFrame).TimeIndex
cTime = CurrentTimeIndex
eTime = eTime - sTime
cTime = cTime - sTime
sTime = sTime - sTime
InterpolateAmount = cTime / eTime

سپس بايد بر اساس اين پارامتر عمل درون يابي را روي داده هاي vertex انجام دهيم :

For I = 0 To kfCurrent.Mesh.GetNumVertices
'درون يابي مختصاتها
D3DXVec3Lerp vTemp3D, MakeVector(kfAnim(PrevFrame).VertexList(I).X, kfAnim(PrevFrame).VertexList(I).Y, _
kfAnim(PrevFrame).VertexList(I).Z), MakeVector(kfAnim(NextFrame).VertexList(I).X, kfAnim(NextFrame).VertexList(I).Y, _
kfAnim(NextFrame).VertexList(I).Z), InterpolateAmount
kfCurrent.VertexList(I).X = vTemp3D.X
kfCurrent.VertexList(I).Y = vTemp3D.Y
kfCurrent.VertexList(I).Z = vTemp3D.Z

'درون يابي نرمالها
D3DXVec3Lerp vTemp3D, MakeVector(kfAnim(PrevFrame).VertexList(I).nx, kfAnim(PrevFrame).VertexList(I).ny, _
kfAnim(PrevFrame).VertexList(I).nz), MakeVector(kfAnim(NextFrame).VertexList(I).nx, kfAnim(NextFrame).VertexList(I).ny, _
kfAnim(NextFrame).VertexList(I).nz), InterpolateAmount
kfCurrent.VertexList(I).nx = vTemp3D.X
kfCurrent.VertexList(I).ny = vTemp3D.Y
kfCurrent.VertexList(I).nz = vTemp3D.Z

'درون يابي اطلاعات بافت
D3DXVec2Lerp vTemp2D, MakeVector2D(kfAnim(PrevFrame).VertexList(I).tu, kfAnim(PrevFrame).VertexList(I).tv), _
MakeVector2D(kfAnim(NextFrame).VertexList(I).tu, kfAnim(NextFrame).VertexList(I).tv), InterpolateAmount
kfCurrent.VertexList(I).tu = vTemp2D.X
kfCurrent.VertexList(I).tv = vTemp2D.Y
Next I

حال بايد داده توليد شده را به فرمت Mesh برگردانيم :

hResult = D3DXMeshVertexBuffer8SetData(kfCurrent.Mesh, 0, Len(kfCurrent.VertexList(0)) * kfCurrent.Mesh.GetNumVertices, 0, kfCurrent.VertexList(0))x

با استفاده از روش فوق مي توانيد هر تعداد فريم کليدي را به انيميشنتان اضافه کنيد . اشکالي که روش فوق دارد اينست که اطلاعات texture براي تمام فريمهاي کليدي جداگانه ذخيره شده است در حاليکه texture در تمام فريمها ثابت است . در درسهاي بعدي از روشي بنام texture pooling استفاده مي کنيم تا تنها يک کپي از texture ها نگهداري کنيم


مقدمه :
کنترل WinSock نسبت به تمام کنترلهاي اينترنت در سطح پايينتري قرار دارد . اين کنترل امکان ايجاد سرويسهاي شبکه اي مبتني بر پروتکلهاي TCP و UDP را مهيا مي کند . بعبارت ديگر توسط اين کنترل مي توان برنامه هاي کاربردي Client/Server ( سرويس گيرنده / سرويس دهنده ) ايجاد و با استفاده از پروتکل TCP و يا UDP بين آنها ارتباط برقرار نمود .
با تنظيم خصوصيات و فراخواني متدهاي اين کنترل مي توانيد به راحتي به يک کامپيوتر راه دور متصل شويد و داده ها را در هر دو جهت جابجا نمائيد . نمونه کاربرهايي که مي توان با اين کنترل ايجاد نمود :
Client-server chat ، Mail client ، Mail server ، Proxy Server ، Network Game ، Port Scanner ، پياده سازي الگوريتم هاي موازي و …
مباني TCP :
پروتکل کنترل اينترنت ( Transfer Control Protocol ) اجازه مي دهد يک اتصال ( Connection ) را از طريق سوکت ( socket ) به يک کامپيوتر راه دور ( Remote Computer ) ساخته و استفاده کنيد . با استفاده از اين اتصال ، هر دو کامپيوتر مي توانند داده ها را بين خودشان انتقال دهند . برقراري ارتباط از طريق TCP همانند صحبت کردن با تلفن است که بايد حتماً اتصالي بين دو کامپيوتر صورت گيرد تا بتوانند با هم ارتباط برقرار کنند .
اگر يک برنامه Client مي سازيد بايستي بدانيد که نام يا آدرس IP کامپيوتر Server چيست ( Remote Host IP ) و همچنين از طريق چه پورتي مي توانيد به آن متصل شويد ( Remote Port ) . حال بايستي به آن پورت Connect کنيد .
همچنين اگر يک برنامه Server مي سازيد بايستي پورتي را که روي آن به درخواستها گوش مي دهيد مشخص کنيد ( LocalPort ) و سپس به پورت گوش دهيد ( Listen ) .
زمانيکه يک کامپيوتر Client تقاضاي يک اتصال را مي دهد Server اين درخواست را Accept مي کند .
زمانيکه يک اتصال ساخته مي شود ، هر دو کامپيوتر مي توانند داده را فرستاده و دريافت کنند .
مباني UDP :
پروتکل ديتاگرام کاربر ( User Datagram Protocol ) پروتکلي بدون اتصال ( Connectionless ) است . برخلاف TCP ، کامپيوترها نياز به برپا کردن يک اتصال ندارند بنابراين يک برنامه مي تواند يک client و يا يک server باشد . برقراري ارتباط در UDP شبيه ارسال نامه از طريق پست است .
براي انتقال داده توسط UDP ابتدا بايد Local Port کامپيوتر Client تنظيم گردد . کامپيوتر Server تنها بايستي RemoteHost را برابر آدرس کامپيوتر Client قرار دهد و همچنين Remote Port را همان Local Port کامپيوتر Client قرار دهد . سپس دو کامپيوتر مي توانند داده ها را بين خود جابجا کنند .
استفاده از کنترل WinSock :
1 – انتخاب پروتکل: در زمان استفاده از کنترل WinSock اولين کاري که بايد انجام دهيد انتخاب يکي از پروتکلهاي TCP يا UDP است . طبيعت برنامه اي که شما مي سازيد نوع پروتکلي را که بايد استفاده کنيد مشخص مي کند . چند سوال زير به شما کمک مي کند که پروتکل مورد نيازتان را انتخاب کنيد :
- آيا برنامه شما در زمانيکه داده فرستاده مي شود يا دريافت مي شود نياز به اطلاعاتي از طرف Server يا Client دارد ؟ اگر چنين است بايستي يک اتصال TCP قبل از ارسال يا دريافت داده ايجاد شود .
- آيا داده بسيار بزرگ است ( مثل تصوير يا فايلهاي صوتي ) ؟ زمانيکه يک اتصال TCP ساخته مي شود پروتکل TCP اتصال را باقي نگه مي دارد و درستي ارسال داده تضمين شده است . اين اتصال در هر حال به منابع محاسباتي بيشتري نياز دارد و بنابراين پرهزينه تر است .
- آيا داده متناوب ارسال مي شود يا در يک نشست ( Session ) ارسال خواهد شد ؟ براي مثال اگر شما يک برنامه مي سازيد که کامپترهاي مشخصي را در يک زمان خاص از انجام شدن عملياتي مطلع مي کند پروتکل UDP مناسب تر است . پروتکل UDP همچنين براي ارسال مقادير کوچک داده اي مناست تر مي باشد .
2 – تنظيم پروتکل : براي تنظيم پروتکلي که مي خواهيد در برنامه تان از آن استفاده کنيد در زمان طراحي برنامه خاصيت Protocol کنترل WinSock را برابر sckTCPProtocol و يا sckUDPProtocol قرار دهيد . همچنين مي توانيد پروتکل خود را توسط کد زير تنظيم کنيد :

WinSock.Protocol=sckTCPProtocol
3 – مشخص کردن نام کامپيوتان : براي اتصال به کامپيوتر راه دور بايستي آدرس IP و يا نام کامپوتر را بدانيد .
نام کامپيوتر در Control Panel/Network/Identification موجود است . در صورتيکه مي خواهيد دو برنامه Client و Server خود را روي يک کامپيوتر تست کنيد از آدرس IP 127.0.0.1 براي هر دو استفاده کنيد اما اگر دو برنامه را روي دو کامپيوتر مجزا در شبکه قرار داده ايد با اجراي دستور ipconfig در DOS Prompt مي توانيد آدرس IP کامپيوتر ها را بدست آوريد .
4 – ايجاد اتصال TCP : در زمان ساخت برنامه اي که از پروتکل TCP استفاده مي کند ابتدا بايد تصميم بگيريد که اين برنامه Client است يا Server . براي ساخت يک برنامه Server بايستي روي يک پورت خاص Listen کنيد . زمانيکه Client تقاضاي يک اتصال را مي دهد ، برنامه Server مي تواند آنرا Accept کند و بنابراين اتصال کامل شده است . حال Client و Server مي توانند با هم ارتباط داشته باشند .
مراحل زير ساخت يک سرور چت ساده بر مبناي TCP را نشان مي دهد :
- از منوي Project گزينه Components را انتخاب کنيد و در ليست Component ها مورد Microsoft WinSock 6.0 را انتخاب کنيد .
- يک کنترل WinSock در فرم خود قرار دهيد و نام آنرا tcpserver بگذاريد
- دو textbox با نامهاي txtSendData و txtReceiveData و نيز يک دکمه در فرم قرار دهيد .
- کد زير را در رويداد Form_Load بنويسيد :

Tcpserver.LocalPort=1000
tcpserver.Listen

- زمانيکه درخواستي از طرف Client مي آيد رويداد ConnectionRequest اجرا مي شود . در اين رويداد ابتدا بايد چک کنيد که حالت کنترل بسته باشد . اگر چنين نيست اتصال را قبل از پذيرفتن اتصال جديد ببنديد . سپس تقاضا را بر اساس پارامتر requestID مي پذيريم :

Private Sub tcpserver_ConnectionRequest(ByVal requestID As Long)
If tcpserver.State <> sckClosed Then tcpserver.Close
tcpserver.Accept requestID
End Sub

- حال اتصال بين Client و Server برقرار شده است . کد زير را براي event مربوط به کليک دکمه Send بنويسيد :

Tcpserver.SendData txtSendData.text
- اگر داده اي از طرف Client بيايد رويداد DataArrival اجرا مي شود . کد زير را براي اين رويداد بنويسيد :

Private Sub tcpserver_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpserver.GetData strData
txtReceiveData.Text = strData
End Sub

- کد زير را براي رويداد Form_Unload بنويسيد :

Tcpserver.Close
مراحل ساخت يک TCP Client بصورت زير است :
- يک کنترل WinSock در فرم قرار دهيد و نام آنرا tcpclient بگذاريد .
- دو textbox با نامهاي txtsend و txtreceive و نيز يک دکمه با نام sendدر فرم قرار دهيد .
- يک دکمه با نام connect در فرم قرار دهيد .
- کد زير را براي متد Form_Load بنويسيد :

tcpclient.RemoteHost=”yourservername”x
tcpclient.RemotePort=1000

- کد زير را براي رويداد کليک شدن دکمه connect بنويسيد :

tcpclient.Connect
- کد زير را براي رويداد کليک شدن دکمه send بنويسيد :

tctclient.SendData txtsend.Text
- کد زير را براي رويداد DataArrival بنويسيد :

Private Sub tcpclient_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpclient.GetData strData
txtreceive.Text = strData
End Sub

- کد زير را باري رويداد Form_Unload بنويسيد :

Tcpclient.Close
کدهاي فوق يک سيستم Client-Server ساده را نشان مي دهد . فايل exe هر دو برنامه را بسازيد و آنها را اجرا کنيد تا بتوانيد سيستم خود را تست کنيد .
5 – پذيرفتن بيش از يک تقاضاي اتصال : Server اي که در بالا ساخته شد تنها مي تواند تقاضاي يک اتصال را بپذيرد . با استفاده از ايجاد يک آرايه از کنترل WinSock مي توان چندين تقاضاي اتصال را پذيرفت . براي اينکار کافي است يک کپي ( instance ) از کنترل بسازيم ( با تنظيم خاصيت Index ) و متد Accept را براي instance جديد بکار ببريم . فرض کنيد يک کنترل WinSock با نام sckServer در فرم داريم که خاصيت Index آنرا صفر قرار داده ايم . همچنين يک متغير intMax از نوع Long تعريف مي کنيم که تعداد اتصالات همزمان به Server را نگه مي دارد . در event مربوط به Form_Load کد زير را بنويسيد :

intMax=0
sckServer(0).LocalPort=1000
sckServer(0).Listen

هر بار که تقاضاي يک اتصال مي رسد کد ابتدا تست مي کند که مقدار Index چقدر است . اگر مقدار Index صفر باشد متغير intMax يکي افزايش مي يابد و از intMax براي ساخت يک instance جديد از کنترل استفاده مي شود . حال از اين instance براي پذيرفتن تقاضاي اتصال استفاده مي گردد . براي اينکار کد زير را براي رويداد ConnectionRequest بنويسيد :

Private Sub sckServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
intmax = intmax + 1
Load sckServer(intmax)x
sckServer(intmax).LocalPort = 0
sckServer(Index).Accept requestID
End If
End Sub
6 – ايجاد اتصال UDP : ساخت يک برنامه UDP ساده تر از برنامه هاي TCP است زيرا پروتکل UDP به اتصال نياز ندارد . در برنامه TCP بالا يک کنترل WinSock بايستي حتماً Listen مي کرد و يک کنترل ديگر يک اتصال را توسط متد Connect ايجاد نمود . در عوض پروتکل UDP نيازي به اتصال ندارد . براي ارسال داده بين دو کنترل WinSock سه مرحله بايستي انجام شود :
- پارامتر RemoteHost برابر نام کامپيوتر مقابل است .
- پارامتر RemotePort برابر پارامتر LocalPort کامپيوتر مقابل
- استفاده از متد Bind براي مشخص کردن LocalPort
چون هر دو کامپيوتر از نظر ارتباط مساوي هستند ، اين نوع برنامه ها را Peer-to-Peer گويند . براي نمونه از کد زير براي ساخت يک برنامه chat استفاده مي کنيم :
- يک کنترل WinSock در فرم قرار دهيد و نام آنرا udppeerA بگذاريد .
- خاصيت Protocol آنرا UDPProtocol قرار دهيد .
- دو textbox با نامهاي txtsend و txtreceive و نيز يک دکمه در فرم قرار دهيد .
- کد زير را براي متد Form_Load بنويسيد :

udppeerA.RemoteHost=”nameofpeerB”x
udppeerA.RemotePort=1001
udppeerA.Bind 1002

- کد زير را براي event مربوط به کليک دکمه بنويسيد :

udppeerA.SendData txtsend.text
- کد زير را براي رويداد DataArrival بنويسيد :

Dim strData as String
udppeerA.GetData strData
txtreceive.Text=strData

براي ساخت UDP peerB مشابه مراحل بالا عمل کنيد فقط خاصيت RemoteHost آنرا نام کامپيوتر PeerA و خاصيت RemotePort آنرا 1002 و خاصيت Bind آنرا 1001 قرار دهيد .


بررسی خواص کنترل WinSock :
ByteReceived : مقدار داده دريافت شده ( موجود در بافر receive ) را نشان مي دهد . توسط متد GetData مي توان اين داده را دريافت نمود .
LocalHostName : نام ماشين محلي را نشان مي دهد . اين پارامتر فقط خواندني است .
LocalIP : آدرس IP ماشين محلي را بصورت يک string برمي گرداند . اين پارامتر فقط خواندني است .
LocalPort : براي خواندن و يا تنظيم شماره پورت محلي بکار مي رود .
Protocol : براي خواندن و يا تنظيم پروتوکل مورد استفاده توسط کنترل WinSock بکار مي رود .
RemoteHost : براي خواندن و يا تنظيم نام يا آدرس IP ماشين راه دور بکار مي رود .
RemoteHostIP : آدرس IP ماشين راه دور را برمي گرداند :
۱- براي برنامه هاي Client بعد از زمانيکه يک اتصال توسط متد Connect پذيرفته شد ، اين خاصيت حاوي آدرس IP ماشين راه دور است .
۲ - براي برنامه Server ، بعد از آمدن يک Connection Request اين خاصيت شامل آدرس IP ماشين راه دور است .
۳ - در زمان استفاده از پروتکل UDP بعد از اينکه رويداد Data Arrival رخ داد اين خاصيت حاوي آدرس IP ماشيني است که داده را فرستاده .
RemotePort : براي خواندن و يا تنظيم شماره پورت ماشين راه دوري که مي خواهيد به آن متصل شويد بکار مي رود .
SocketHandle : مقداري را برمي گرداند که مرتبط با سوکتي است که کنترل WinSock را مديريت مي کند و براي ارتباط با لايه WinSock بکار مي رود . اين پارامتر فقط خواندني است و تنها براي ارسال به API هاي WinSock طراحي شده است .
State : وضعيت کنترل WinSock را نشان مي دهد . وضعيتهاي ممکن براي State عبارتند از :
۱ - sckClosed : اتصال بسته است .
۲ - sckOpen : اتصال باز است .
۳ - sckListening : حالت گوش دادن به پورت
4 - sckConnectionPending : معلق شدن اتصال
۵ - sckResolvingHost : تصميم گيري در مورد ميزبان
۶ - sckHostResolved : در مورد ميزبان تصميم گيري شد .
۷ - sckConnecting : حالت برقراري ارتباط
۸ - sckConnected : ارتباط برقرار شد .
۹ - sckClosing : حالت قطع اتصال
۱۰ - sckError : حالت خطا

بررسی متدهای کنترل WinSock :
متد Accept : تنها براي برنامه هاي TCP Server بکار مي رود . اين متد براي پذيرفتن يک اتصال در زمان مديريت رويداد ConnectionRequest استفاده مي شود .
متد Bind : اين پارامتر LocalPort و LocalIP يک اتصال را مشخص مي کند .
متد Close : براي بستن يک اتصال TCP و يا بستن يک listening socket بکار مي رود .
متد GetData : بلوک جاري داده دريافت شده را گرفته و آنرا در متغيري از نوع Variant ذخيره مي کند . شکل کلي اين متد بصورت زير است :

WinSock.GetData data[,type][,maxlen]x

که data داده دريافتي است . اگر داده کافي موجود نباشد data برابر empty خواهد بود .
type نوع داده دريافتي است که مي تواند مقادير زير باشد :
vbByte - vbInteger - vbLong - vbSingle - vbDouble - vbDate - vbBoolean - vbError - vbString - vbArray+vbByte
maxlen حداکثر سايز را در زمان دريافت يک byte Array و يا يک string مشخص مي کند .
متد Getdata در رويداد Data Arrival استفاده مي شود که اين رويداد يک پارامتر با نام TotalBytes دارد . اگر maxlen اي که شما تعيين کرده ايد کمتر از TotalBytes باشد پيغام هشدار شماره ۱۰۰۴۰ دريافت مي کنيد بدين معني که بايتهاي باقيمانده گم خواهند شد .
متد Listen : يک سوکت مي سازد و آنرا در حالت Listen قرار مي دهد . اين متد تنها در اتصالات TCP بکار ميرود .
متد PeekData : مشابه GetData است با اين تفاوت که داده را از صف ورودي حذف نمي کند . اين متد تنها براي اتصالات TCP بکار مي رود .
متد SendData : براي ارسال داده به کامپيوتر راه دور بکار مي رود .
بررسي event هاي کنترل WinSock :
رويداد Close : زماني رخ مي دهد که کامپيوتر راه دور اتصال را ببندد .
رويداد Connect : بعد از اينکه يک اتصال به Server ايجاد شد روي مي دهد . شکل کلي آن بصورت زير است :

Private Sub WinSock_Connect(ErrorOccurred As Boolean)x

که پارامتر ErrorOccurred دو مقدار دارد : اگر True باشد يعني اتصال Fail شده است و اگر False باشد يعني اتصال با موفقيت انجام شده است .
با رويداد Connect مي توانيد error هايي که در زمان فرايند باز کردن اتصال برگردانده شده را چک کنيد .
رويداد ConnectionRequest : زماني رخ مي دهد که يک کامپيوتر راه دور تقاضاي يک اتصال را بدهد . اين رويداد فقط براي برنامه هاي TCP Server بکار مي رود .
رويداد DataArrival : زماني رخ مي دهد که داده جديدي بيايد .
رويداد Error : زماني رخ مي دهد که يک خطا در فرايند ارتباط رخ دهد ( مثلاً Failed to Connect و يا Failed to Send ) . شکل کلي آن بصورت زير است :

Private WinSock_Error(number as Integer,description as String,scode as Long,source as String,helpfile as String,helpcontext as Long,canceldisplay as Boolean)x

number شماره کد خطا است .
description توضيحي در مورد خطا است .
source توصيف منبع خطا
canceldisplay : مشخص مي کند آيا پيغام خطاي پيش فرض نشان داده شود يا نه
رويداد SendComplete : زماني رخ مي دهد که يک عمل Send تکميل شده باشد .
رويداد SendProgress : زماني رخ مي دهد که کنترل شروع به ارسال داده نمايد . شکل کلي آن بصورت زير است :

WinSock_SendProgress (bytesSent As Long, bytesRemaining As Long)x

که bytesSent تعداد بايتهاي ارسال شده و bytesRemaining تعداد بايتهاي باقيمانده است .

نکته ۱ : براي دريافت جدول خطاهاي WinSock با من تماس بگيريد .
نکته ۲ : موضوع بعدي : آشنايي با الگوريتم Collision Detection در ساخت انيميشن هاي دوبعدي
+ نوشته شده در  85/09/18ساعت 21:43  توسط مهدی سعادتی  | 

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

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

آشنايي با WinInet API :
WinInet API مجموعه ای از توابع است که امکان ايجاد و توسعه برنامه های اينترنتی را بصورتی ساده ، سريع و کارآمد برای برنامه نويسان مهيا می کند . با استفاده از اين مجموعه توابع شما می توانيد برنامه هايي بنويسيد که از منابع اينترنتی با استفاده از پروتکلهايي چون HTTP و FTP استفاده کنند . همچنين WinInet به شما اجازه می دهد تا بتوانيد ارتباطی dial-up با يک ISP ايجاد نموده و آنرا کنترل کنيد .
مزيت اصلی توابع WinInet آينست که شما نيازی به دانستن ساختار پروتکلهای ارتباطی و نيز برنامه نويسی Socket نخواهيد داشت . بعبارت ديگر WinInet يک واسط سطح بالا را برای کار با منابع اينترنتی ارائه می دهد .

امکانات Dial-Up موجود در WinInet :
تا قبل از ارائه اينترنت اکسپلورر ورژن 4 ، WinInet تنها دارای دو تابع dial-up بود :

تابع InternetAttemptConnect : برای بررسی اينکه آيا يک ارتباط به اينترنت وجود دارد يا نه استفاده می شد . اگر هيچ اتصالی به اينترنت وجود نداشت اين برنامه کادر تبادلی dial-up networking را نمايش می داد و کاربر اجازه داشت تا يک اتصال را برای وصل شدن به اينترنت انتخاب کند .

تابع InternetCheckConnection : تابع با استفاده از انجام يک دستور ping به url ای که به تابع داده شده ، بررسی می کرد که آيا ارتباطی به اينترنت وجود دارد يا نه .

اين دو تابع دارای محدوديتهای فراوانی بودند . برای مثال تابع اول نمی تواند بطور اتوماتيک اتصال به اينترنت را برقرار کند و تابع دوم نيز نمی تواند هيچ اطلاعاتی در مورد نوع ارتباط به ما بدهد .

IE نسخه 4 ، تعدادی تابع جديد برای WinInet معرفی کرد که برخی از آنها عبارتند از :

تابع InternetGetConnectedState : اطلاعاتی در مورد نوع ارتباط استفاده شده را بيان می کند . برای مثال اين تابع اطلاع می دهد که نوع ارتباط به اينترنت از طريق مودم است يا شبکه LAN و يا از طريق پروکسی .

تابع InternetAutodial : اين امکان را فراهم می سازد تا يک ارتباط اينترنتی اتوماتيک از طريق مودم را با استفاده از مدخل اتصال پيش فرض که کاربر آنرا در dial-up networking مشخص کرده ايجاد کنيد .

تابع InternetDial : اين تابع کارآمدتر از تابع InternetAutodial است و کادری را نمايش می دهد که کاربر می تواند نوع مدخل مورد نظر خود برای ارتباط تلفنی با اينترنت را انتخاب کند

تابع InternetAutodialHangup : برای قطع کردن اتصالی مودمی که از طريق تابع InternetAutodial برقرار شده استفاده می شود
تابع InternetHangUp : برای قطع کردن اتصالی مودمی که از طريق تابع InternetDialبرقرار شده استفاده می شود
تابع InternetSetDialState : برای تنظيم کردن وضعيت جاری ارتباط اينترنتی استفاده می شود

در قسمت بعدی اين سلسه مباحث جزئيات اين توابع را بررسی کرده و نهايتاً برنامه ای کاربردی برای کار با اين توابع در ويژوال بيسيک ارائه خواهم داد .

اطلاعات بيشتری در مورد WinInet :
در اين بخش ما تنها توابع dial-up موجود در WinInet API را بررسی کرديم اما همانطور که در ابتدا گفته شد WinInet دارای امکانات فراوانی در زمينه کار با اينترنت است . برای آشنايي بيشتر با اين امکانات در زير جداولی ارائه شده که به اختصار امکانات مختلف اين مجموعه تابع را نشان می دهد :

توابع Dial-Up :

Name Description

InternetGetConnectedState

Retrieves the current state of the Internet connection

InternetAutodial

Initiates an unattended dial-up connection

InternetAutodialHangup

Disconnects a modem connection initiated by

InternetDial

Initiates a dial-up connection

InternetHangUp

Disconnects a modem connection initiated by InternetDial

InternetGoOnline

Prompts the user for permission to initiate a dial-up connection to the given URL

InternetSetDialState

Sets the current state of the Internet connection


توابع عمومی اينترنت :

Name Description

InternetOpen

Initializes the Win32 Internet functions

InternetConnect

Opens an FTP, Gopher, or HTTP session for a given site

InternetCloseHandle

Closes a single Internet handle or a subtree of Internet handles

InternetErrorDlg

Displays a dialog box for the error that is passed to InternetErrorDlg

InternetFindNextFile

Continues a file search started as a result of a previous call to FtpFindFirstFile or GopherFindFirstFile

InternetGetLastResponseInfo

Retrieves the last Win32 Internet function error description or server response on the thread calling this function

InternetLockRequestFile

Allows the user to place a lock on the file being used

InternetQueryDataAvailable

Queries the amount of data available

InternetQueryOption

Queries an Internet option on the specified handle

InternetReadFile

Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function

InternetReadFileEx

Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function

InternetSetFilePointer

Sets a file position for InternetReadFile

InternetSetOption

Sets an Internet option

InternetSetStatusCallback

Sets up a callback function that Win32 Internet functions can call as progress is made during an operation

InternetStatusCallback

Placeholder for the application-defined status callback function

InternetTimeFromSystemTime

Formats a date and time according to the specified RFC format (as specified in the HTTP version 1.0 specification)

InternetTimeToSystemTime

Takes an HTTP time/date string and converts it to a SYSTEMTIME structure

InternetUnlockRequestFile

Unlocks a file that was locked using InternetLockRequestFile

InternetWriteFile

Writes data to an open Internet file

InternetConfirmZoneCrossing

Checks for changes between secure and nonsecure URLs


توابع URL :

Name Description

InternetCanonicalizeUrl

Canonicalizes a URL, which includes converting unsafe characters and spaces into escape sequences.

InternetCombineUrl

Combines a base and relative URL into a single URL. The resultant URL will be canonicalized.

InternetCrackUrl

Cracks a URL into its component parts.

InternetCreateUrl

Creates a URL from its component parts.

InternetOpenUrl

Begins reading a complete FTP, Gopher, or HTTP URL.


توابع FTP :

Name Description

FtpCreateDirectory

Creates a new directory on the FTP server

FtpDeleteFile

Deletes a file stored on the FTP server

FtpFindFirstFile

Searches the specified directory of the given FTP session

FtpGetCurrentDirectory

Retrieves the current directory for the given FTP session

FtpGetFile

Retrieves a file from the FTP server and stores it under the specified file name, creating a new local file in the process

FtpPutFile

Stores a file on the FTP server

FtpRemoveDirectory

Removes the specified directory on the FTP server

FtpRenameFile

Renames a file stored on the FTP server

FtpSetCurrentDirectory

Changes to a different working directory on the FTP server


توابع HTTP :
Name Description


HttpAddRequestHeaders

Adds one or more HTTP request headers to the HTTP request handle

HttpEndRequest

Ends an HTTP request

HttpOpenRequest

Opens an HTTP request handle

HttpQueryInfo

Queries for information about an HTTP request

HttpSendRequest

Sends the specified request to the HTTP server

HttpSendRequestEx

Sends the specified request to the HTTP server


بررسی جزئيات توابع Dial-Up موجود در WinInet :

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

چگونگی declare کردن تابع :

Public Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long

2 – تابع InternetAutodialHangup : باعث قطع کردن يک اتصال dial-up اتوماتيک می شود . اگر قطع اتصال با موفقيت انجام شود تابع مقدار true و در غير اينصورت false برمی گرداند . تابع دارای يک پارامتر ورودی به اسم dwReserved است که رزرو شده بود و بايستی صفر باشد .

چگونگی declare کردن تابع :

Public Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long

3 – تابع InternetDial : يک اتصال به اينترنت را با استفاده از يک ارتباط مودم مقداردهی اوليه می کند . پارامترهای ورودی آن عبارتند از :
hwndParent : هندل مربوط به پنجره parent
lpszConnectoid : نام ارتباط dial-up مورد استفاده
dwFlags : فلگ کنترل اتصال که يکی از مقادير زير را می تواند داشته باشد :
- INTERNET_AUTODIAL_FORCE_ONLINE
- INTERNET_AUTODIAL_FORCE_UNATTENDED
- INTERNET_DIAL_UNATTENDED : اتصال به اينترنت از طريق مودم بدون نمايش واسط کاربر
lpdwConnection : آدرس داده ای که شامل عدد متناظر با اتصال است .
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

چگونگی declare کردن تابع :
Public Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long

4 – تابع InternetGetConnectedState : اين تابع وضعيت اتصال جاری به اينترنت را بر می گرداند . اگر اتصال برقرار باشد تابع مقدار true و در غير اينصورت false برمی گرداند .
پارامترهای ورودی تابع عبارتند از :
lpdwFlags : توصيف وضعيت اتصال . اين پارامتر يکی از مقادير زير را می تواند داشته باشد :
- INTERNET_CONNECTION_MODEM
- INTERNET_CONNECTION_LAN
- INTERNET_CONNECTION_PROXY
- INTERNET_CONNECTION_MODEM_BUSY
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

چگونگی declare کردن تابع :

Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

5 – تابع InternetGoOnline : پيغامی به کاربر برای دادن مجوز برای مقداردهی اوليه اتصال به يک URL را می دهد . اگر اينکار موفقيت آميز باشد مقدار true و در غير اينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :
lpszURL : URL وب سايت مورد نظر برای اتصال
hwndParent : هندل پنجره parent
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

چگونگی declare کردن تابع :

Public Declare Function InternetGoOnline Lib "wininet.dll" (ByVal lpszURL As String, ByVal hwndParent As Long, ByVal dwReserved As Long) As Long

6 – تابع InyernetHangUp : به مودم می گويد که اتصال به اينترنت را قطع کند . پارامترهای اين تابع عبارتند از :
dwConnection : شماره مربوط به اتصالی که می خواهيم آنرا قطع کنيم .
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

چگونگی declare کردن تابع :

Public Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long

7 – تابع InternetSetDialState : تنظيم نمودن وضعيت شماره گيری مودم . اگر تنظيم با موفقيت انجام شود تابع true و در غيراينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :


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

dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .

چگونگی declare کردن تابع :

Public Declare Function InternetSetDialState Lib "wininet.dll" (ByVal lpszConnectoid As String, ByVal dwState As Long, ByVal dwReserved As Long) As Long

بررسی فلگهای مورد استفاده در توابع dial-up :

1 – فلگهای تابع InternetDial :
Public Const INTERNET_DIAL_UNATTENDED = &H8000& '0x8000
Public Const INTERENT_GOONLINE_REFRESH = &H1 '0x00000001
Public Const INTERENT_GOONLINE_MASK = &H1 '0x00000001

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


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

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

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

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



در اين بخش که آخرين بخش از مباحث WinInet API است برنامه ای نمونه برای کار با توابع مودمی اين کتابخانه ارائه خواهيم داد :

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

Private Declare Function InternetDial Lib "wininet.dll" Alias "InternetDialA" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long

سپس وضعيت شماره گيری را در متغيری به اسم lOption قرار می دهيم . اين متغير می تواند مقادير زير را داشته باشد :
- DF_FORCE_ONLINE
- DF_FORCE_UNATTENDED
- DF_DIAL_FORCE_PROMPT
- DF_DIAL_UNATTENDED
حال نام اتصالی را که می خواهيم از آن استفاده شود در متغيری به اسم ConnectionName قرار می دهيم .
همچنين دو متغير به اسم ConnectionID و RetVal را از نوع long تعريف می کنيم .

حال تابع InternetDial را بصورت زير صدا می کنيم :
RetVal = InternetDial(Me.hwnd, ConnectionName, lOption, ConnectionID, 0)

اگر RetVal مخالف صفر باشد عمل Dial بدرستی انجام شده است .

برای قطع اتصال فوق بايستی از تابع InternetHangUp استفاده کنيم . برای اينکار ابتدا تابع فوق را Declare می کنيم :

Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long

سپس اين تابع را بصورت زير فراخوانی می کنيم :

RetVal = InternetHangUp(ConnectionID, 0)

برای اينکه مودم را مجبور کنيم تا بطور اتوماتيک از اتصال پيش فرض سيستم برای شماره گيری استفاده کند از تابع InternetAutodial استفاده می کنيم .
برای اينکار ابتدا تابع را Declare می کنيم :

Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal hwndParent As Long) As Long

سپس تابع را بصورت زير فراخوانی می کنيم :

RetVal = InternetAutodial(ADF_FORCE_UNATTENDED, Me.hwnd)

اگر RetVal مخالف صفر باشد عمل AutoDial بدرستی انجام شده است .

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

Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long

فراخوانی اين تابع بصورت زير است :

Call InternetAutodialHangup(0)

برای اينکه بفهيم آيا اتصال به اينترنت وجود دارد يا نه از تابع InternetGetConnectedStateEx استفاده می کنيم . برای اينکار ابتدا تابع را Declare می کنيم :
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long

سپس تابع را بصورت زير فراخوانی می کنيم :

strConnectionName = Space(256)
lNameLen = 256
lPtr = StrPtr(strConnectionName)
lNameLenPtr = VarPtr(lNameLen)
RetVal = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0)
که strConnectionName از نوع String و بقيه متغيرها از نوع Long هستند .

اگر RetVal مخالف صفر باشد اتصال برقرار است .

ثابتهايی که در کدهای فوق استفاده شده عبارتند از :
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1&
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2&
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4&

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



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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Dim objTapi As TAPI

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

Set objTapi = New TAPI

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

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

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

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

Set objCollAddresses = objTapi.Addresses

۳ - پيدا کردن آدرسی که بتواند از واسط مورد نظر ما پشتيبانی کند :
bFound = False
For indexAddr = 1 To objCollAddresses.Count
Set objCrtAddress = objCollAddresses.Item(indexAddr)x
Set objMediaSupport = objCrtAddress
Set objAddressCapabilities = objCrtAddress

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

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

If bFound = True Then Exit For
Next indexAddr

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

Set gobjAddress = objcollAddresses.Item(indexAddr)x

انجام Event Handling در TAPI :

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

تعاريفها :
Dim WithEvents gobjTapiWithEvents As TAPI
Attribute gobjTapiWithEvents.VB_VarHelpID = -1
Dim glRegistrationToken As Long

Const TAPI3_CALL_EVENTS =TE_CALLMEDIA Or
TE_CALLNOTIFICATION Or TE_CALLSTATE

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

objTapi.EventFilter = TAPI3_CALL_EVENTS

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

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

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

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

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

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

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

Dim objCallControl As ITBasicCallControl
Set objCallControl = gobjReceivedCallInfo

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

Dim objTerminalSupport As ITTerminalSupport
Set objTerminalSupport = gobjAddress

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

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

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

Set objTerminalSupport = Nothing

سپس نياز به تعريف شی objStreamControl برای کنترل ترمينال است :
Dim objStreamControl As ITStreamControl
Set objStreamControl = objCallControl

در صورتيکه اين شی ايجاد شود ، به ازای استريم های موجود در ITCollection امکان ايجاد ترمينال در يک حلقه for بررسی می شود و ترمينال مناسب انتخاب می گردد :
If Not (objStreamControl Is Nothing) Then
Dim objITCollStreams As ITCollection

Set objITCollStreams = objStreamControl.Streams

Dim nIndex As Long, objCrtStream As ITStream

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

Set objITCollStreams = Nothing
Set objStreamControl = Nothing
End If

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

سپس در اينجا بايستی کدی که در بخش اول اين درس برای انتخاب ترمينال نوشته شد آورده شود :
}
Select Terminal Code
{
سپس بايستی دستور Connect اجرا شود :
gobjCall.Connect (False)x
False بدين معناست که ارتباط بصورت آسنکرون برقرار می شود .
دريافت يک تماس :

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

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

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

مقدمه
Direct Input 8 همانطور که از نامش مشخص است به شما اجازه می دهد که بتوانيد برنامه هايي بنويسيد که توسط هر نوع دستگاه ورودی کنترل شود .
Direct Input 8 دارای چندين مزيت نسبت به استفاده از کنترلهای ورودی خود ويژوال بيسيک دارد – کنترلهايي مثل Form_KeyUp, Form_KeyDown, Form_MouseMove - و همچنين قابليت کنترل بيشتری نسبت به توابع استاندارد Win32 از قبيل GetCursorPos, GetKeyState دارد .
Direct Input 8 سريعتر ، کاراتر و قدرتمند تر بوده و برای ساخت بازيها طراحی شده بنابراين باعث کندی برنامه ها نخواهد شد .

چگونگی کار با Direct Input 8 برای گرفتن ورودی از کيبرد

دو روش برای استفاده از کيبرد در DirectX8 وجود دارد : روش polling و روش event-based که هر دو دارای مزايا و معايبی هستند .
بطور کلی در اغلب طراحيها از روش event-based استفاده می شود زيرا کار با آن راحت تر اسن . در اين روش هر پيغام فرستاده شده ازطرف دستگاه ورودی log می شود و برنامه نيازی به هيچگونه پردازشی بمنظور منتظر ماندن برای يک پيغام از طرف ورودی ندارد ، بنابر اين کاراتر است . در روش polling کنترل کمی دقيقتر و راحتر است .
اگر در مورد برنامه نويسی بر مبنای polling و بر مبنای event اطلاعات کافی نداريد می توانيد از منابع موجود در سايتهايي چون Gamasutra و GameDev استفاده کنيد .

روش Polling
مراحل اين روش عبارتند از :
1 – تعريفات Declerations : يک فرم ايجاد کرده و يک TextBox به نام txtOutput با خصوصيات Multiline ، Locked و Vertical Scroll Bar در آن قرار دهيد . کدهای زير را در بخش کدنويسی اين فرم بنويسيد :
Private Const UsePollingMethod As Boolean = True
Private Const UseEventMethod As Boolean = False
نکته مهم اينست که تنها يکی از دو ثابت فوق بايستی True باشد .
Private bRunning As Boolean
اين متغير برای polling استفاده می شود
Private DX As DirectX8
Private DI As DirectInput8
تعريف شی اصلی DirectX و شی DirectInput
Private DIDevice As DirectInputDevice8
Private DIState As DIKEYBOARDSTATE
اين دو شی برای دسترسی به دستگاه ورودی ( کيبرد ) استفاده می شوند
Private KeyState(0 To 255) As Boolean
آرايه ای برای تشخيص فشرده شدن کليد
Private Const BufferSize As Long = 10
سايز بافر نگهدارنده event ها . در روش event-based اين مقدار برابر يک و در روش polling برابر 10 تا 20 است ( بسته به سرعت حلقه بازی )
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)x
تابع Sleep برای متوقف کردن حلقه polling در صورت بالا بودن نرخ ورودی

2- مقدار دهی اوليه Initialisation : اين بخش سه مرحله دارد :
در مرحله اول اشيا و Device ها ساخته می شوند .
در مرحله دوم تنظيمات مربوط به Device انجام می شود .
در مرحله سوم به Device می گوئيم که می خواهيم شروع به استفاده از آن کنيم .

در Form_Load کدهای زير را بنويسيد :
Me.Show
Dim I As Long
Dim DevProp As DIPROPLONG
Dim DevInfo As DirectInputDeviceInstance8
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If UsePollingMethod And UseEventMethod Then
MsgBox "You must select only one of the constants before running"x
Unload Me
End
End If

If UsePollingMethod Then txtOutput.Text = "Using Polling Method" & vbCrLf
If UseEventMethod Then txtOutput.Text = "Using Event Based Method" & vbCrLf

مقداردهی اوليه روش انتخاب شده
Set DX = New DirectX8
Set DI = DX.DirectInputCreate
Set DIDevice = DI.CreateDevice("GUID_SysKeyboard")x

DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or ISCL_NONEXCLUSIVE

برپاسازی بافر
DevProp.lHow = DIPH_DEVICE
DevProp.lData = BufferSize
DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp

به دايرکت ايکس می گوئيم که می خواهيم از دستگاه ورودی استفاده کنيم
DIDevice.Acquire
استخراج اطلاعاتی در مورد دستگاه ورودی
Set DevInfo = DIDevice.GetDeviceInfo()x
txtOutput.Text = txtOutput.Text & "Product Name: " & DevInfo.GetProductName & vbCrLf
txtOutput.Text = txtOutput.Text & "Device Type: " & DevInfo.GetDevType & vbCrLf
txtOutput.Text = txtOutput.Text & "GUID: " & DevInfo.GetGuidInstance & vbCrLf

در صورتی که بخواهيم به برنامه خاتمه بدهيم کدهای زير را می نويسيم
DIDevice.Unacquire
Set DIDevice = Nothing
Set DI = Nothing
Set DX = Nothing
Unload Me
End

3 – گرفتن ورودی از کيبرد : در اين بخش فرض کنيد بخواهيم يک بازی را در يک حلقه Do-Loop شبيه سازی کنيم . در اين حلقه هر بار فشرده شدن کليدهای کيبرد را چک می کنيم :

If Not Err.Number Then bRunning = True
Do While bRunning

دريافت اطلاعات شامل خواندن وضعيت کيبرد ، خواندن اطلاعات بافر و سپس خطا
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
If Err.Number = DI_BUFFEROVERFLOW Then
Msgbox(“BUFFER OVERFLOW (Compensating)...")x
GoTo ENDOFLOOP:
End If
‘بررسی فشرده شدن کليدها
For I = 0 To 255
If DIState.Key(I) = 128 And (Not KeyState(I) = True) Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I))& vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
KeyState(I) = True
End If
Next I

‘بررسی رها شدن کليد
For I = 0 To BufferSize
If KeyState(pBuffer(I).lOfs) = True And pBuffer(I).lData = 0 Then
KeyState(pBuffer(I).lOfs) = False
txtOutput.Text = txtOutput.Text & "{ UP } " & KeyNames(CInt(pBuffer(I).lOfs)) & vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
End If
Next I

Sleep (50)x
DoEvents
ENDOFLOOP:
Loop

در کد فوق يک تابع KeyName وجود دارد که نام کليد فشارداده شده را بر می گرداند . بخشی از اين تابع را در زير می بينيد :
Function KeyNames(iNum As Integer) As String

Dim aKeys(0 To 255) As String

aKeys(1) = "DIK_ESCAPE"
aKeys(2) = "DIK_1 On main keyboard"x
aKeys(3) = "DIK_2 On main keyboard"x
aKeys(4) = "DIK_3 On main keyboard"x
aKeys(5) = "DIK_4 On main keyboard"x
aKeys(6) = "DIK_5 On main keyboard"x
aKeys(7) = "DIK_6 On main keyboard"x
aKeys(8) = "DIK_7 On main keyboard"x
aKeys(9) = "DIK_8 On main keyboard"x
aKeys(10) = "DIK_9 On main keyboard"x
aKeys(11) = "DIK_0 On main keyboard"x
aKeys(12) = "DIK_MINUS On main keyboard"x
aKeys(13) = "DIK_EQUALS On main keyboard"x
aKeys(14) = "DIK_BACK BACKSPACE"x
aKeys(15) = "DIK_TAB"x
aKeys(16) = "DIK_Q"x
aKeys(17) = "DIK_W"x
aKeys(18) = "DIK_E"x
aKeys(19) = "DIK_R"x
aKeys(20) = "DIK_T"x
.
.
.
KeyNames = aKeys(iNum)x
End Function

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

۱ - تعاريف و مقداردهی اوليه : در بخش تعاريف دو تعريف جديد بصورت زير داريم :
Dim hEvent As Long
Implements DirectXEvent8

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

تنها تغييری که در بخش مقداردهی اوليه نياز است ، برپاسازی يک event می باشد :
If UseEventMethod Then
hEvent = DX.CreateEvent(frmMain)x
DIDevice.SetEventNotification hEvent
End If

در انتهای برنامه نيز کد زير را برای از بين بردن event اضافه کنيد :
If hEvent <> 0 Then DX.DestroyEvent hEvent

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

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

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

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

برپاسازی Device :

علاوه بر متغيرهايي که در بخش کنترل کيبرد تعريف شد بايستی متغيرهای جديد زير را نيز در ابتدای برنامه تان تعريف کنيد :
Private Const mSpeed As Single = 2
Private Const BufferSize As Long = 10
Private mPosition As Point
mSpeed مقدار سرعت حرکت کرسر ماوس را مشخص می کند .
BufferSize سايز بافر DI می باشد .
mPosition موقعيت جاری کرسر ماوس را نشان می دهد .

در مرحله بعدی بايستی مقداردهي های اوليه لازم را انجام دهيد :
Set DIDevice = DI.CreateDevice("guid_SysMouse")x
Call DIDevice.SetCommonDataFormat(DIFORMAT_MOUSE)x
Call DIDevice.SetCooperativeLevel(frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)x

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

خواندن ورودی از ماوس :
در اين بخش می توانيد هم از روش polling و هم event-based استفاده کنيد . نکته مهمی که در اينجا وجود دارد آنست که Direct Input فقط حرکت داده شدن ماوس و کليک شدن يک دکمه را به شما اطلاع می دهد و برای تشخيص حالتهای double click و single click خودتان بايستی کد بنويسيد برای مثال اگر فاصله زمانی بين دو کليک کمتر از ۴۰ ميلی ثانيه باشد آنگاه اين يک double click بوده است .
کد زير حرکت داده شدن ماوس و کليک يکی از سه دکمه آنرا اطلاع می دهد :
Dim DevData(1 To BufferSize) As DIDEVICEOBJECTDATA
Dim nEvents As Long
Dim I As Long
nEvents = DIDevice.GetDeviceData(DevData, DIGDD_DEFAULT)x
For I = 1 To nEvents
Select Case DevData(I).lOfs
Case DIMOFS_X
mPosition.x = mPosition.x + (DevData(I).lData * mSpeed)x
If mPosition.x < 0 Then mPosition.x = 0
If mPosition.x > frmMain.ScaleWidth Then mPosition.x = frmMain.ScaleWidth
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_Y
mPosition.y = mPosition.y + (DevData(I).lData * mSpeed)x
If mPosition.y < 0 Then mPosition.y = 0
If mPosition.y > frmMain.ScaleHeight Then mPosition.y = frmMain.ScaleHeight
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_BUTTON0
label(2).Caption = "Button 0 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON1
label(3).Caption = "Button 1 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON2
label(4).Caption = "Button 2 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON3
label(5).Caption = "Button 3 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
End Select
Next I

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

آشنايي با کتابخانه Windows Packet Capture

معرفی :
کتابخانه WinPcap يک معماری برای استخراج Packet های TCP/IP و آناليز شبکه در محيطهای ۳۲ بيتی ويندوز می باشد . اين کتابخانه شامل سه بخش است :
۱ - يک فيلتر Packet در سطح هسته سيستم عامل ( Kernel )
۲ - يک کتابخانه dll سطح پايين ( low-level ) با نام packet.dll
۳ - يک کتابخانه مستقل از سيستم عامل و سطح بالا ( high-level ) با نام wpcap.dll
فيلتر packet يک درايور دستگاه ( device driver ) است که به ويندوزهای ۹۵ ، ۹۸ ، ME ، NT و ۲۰۰۰ قابليت استخراج و capture کردن و نيز ارسال داده خام ( raw data ) از يک کارت شبکه را می دهد . همچنين اين امکان را دارد که packet های capture شده را در يک بافر ذخيره کند و يا آنها را فيلتر نمايد .
packet.dll يک API است که بمنظور دسترسی مستقيم به عملکرد درايور packet استفاده می شود . بنابراين packet.dll يک واسط برنامه نويسی مستقل از سیستم عامل های مايکروسافت را مهيا می کند .
Wpcap.dll مجموعه ای از ابزارهای سطح بالای اصلی برای capture را مهيا می کند که اين توابع با کتابخانه libpcap ( کتابخانه capture در سيستم عامل UNIX ) سازگار می باشند . اين توابع اجازه capture کردن packet ها را با روشی مستقل از سخت افزار شبکه و مستقل از سيستم عامل مهيا می کنند


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

مقدمه : در سلسله مباحث DirectXAudio شما تکنيکهاي لازم براي اضافه کردن موزيک و افکتهاي صوتي سريع و ديناميک را به بازيها و برنامه هاي مالتي مديا خواهيد آموخت . DirectXAudio جايگزيني براي بخشهاي DirectSound ، DirectSound3D و DirectMusic موجود در DirectX 7 مي باشد و داراي امکانات بهتر و سريعتری بوده و برنامه نويسي آن نيز ساده تر است .
در اولين درس از DirectXAudio چگونگي پخش افکتهاي صوتي را در برنامه هايتان خواهيد آموخت .

Initial کردن DirectSound :
DirectSound اولين مبحثي است که آنرا توضيح خواهم داد . گرچه DirectXAudio يک نام عمومي براي امکانات صوتي DirectX8 مي باشد اما بين Sound و Music تفاوت وجود دارد .
DirectSound با پخش افکتهاي صوتي ارتباط دارد . DirectSound همانند Direct3D از يکسري device سخت افزاري و نرم افزاري استفاده مي کند و افکتهاي صوتي در يکسري بافر ذخيره مي شوند .
اولين قدم براي برپاسازي DirectSound ، اضافه کردن کتابخانه DirectX8 به پروژه تان مي باشد . قدم بعدي تعريف متغيرها و object هاي موردنياز است . براي استفاده از DirectSound به متغيرهاي زير نياز داريم :

Private DX As DirectX8
Private DS As DirectSound8
Private DSBuffer As DirectSoundSecondaryBuffer8
Private DSEnum As DirectSoundEnum8
Private bLoaded As Boolean

DirectX شي کنترل کننده مرکزي است . DirectSound8 واسط مراقب براي تمام interface هاي پخش صدا است . DirectSoundSecondaryBuffer8 داده audio واقعي را براي پخش ذخيره مي کند . DirectSoundEnum8 اجازه مي دهد که اطلاعاتي را در مورد device هاي سخت افزاري/نرم افزاري استخراج کنيد و متغير bLoaded يک flag وضعيت مي باشد .
حال در برنامه بايد ليست تمام device هاي در دسترس را مشخص کنيم . ( اين امر کاملاً امکان پذير است که يک کامپيوتر بيش از يک device براي DirectSound داشته باشد ) :

Private Sub Form_Load()x
bLoaded = False
Dim I As Long
Set DX = New DirectX8
Set DSEnum = DX.GetDSEnum
For I = 1 To DSEnum.GetCount
MsgBox(DSEnum.GetDescription(I))x
Next I
End Sub

فرض کنيم که يکي از device هاي شناخته شده را انتخاب کرديم . حال بايستي device را واقعاً برپا کنيم :

If bLoaded Then
Set DSBuffer = Nothing
Set DS = Nothing
Set DX = Nothing
End If
Dim DSBDesc As DSBUFFERDESC
Set DX = New DirectX8
Set DS = DX.DirectSoundCreate(DSEnum.GetGuid(devicenumber))x
DS.SetCooperativeLevel frmMain.hWnd, DSSCL_NORMAL

متغير devicenumber شماره device اي است که شما مي خواهيد با آن کار کنيد . DSBDesc فايل صوتي شما را توصيف مي کند .
+ نوشته شده در  85/09/18ساعت 21:42  توسط مهدی سعادتی  | 

قرار دادن متن به صورت عمودی در یک کنترل Text Box
ابتدا یک کنترل Picture Box به فرم اضافه کنید. که به طور پیش فرض Picture1 ایجاد می شود. خصوصیت AuotRedraw کنترل مذبور را به True تنظیم کنید. بعد یک کنترل Text Box به فرم روی کنترل Picture Box اضافه کنید. Text1 به وجود می اید و سپس خصوصیت MultiLine این را به True تنظیم کنید. بعد این کدها را در فرمتون کپی کنید

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
Const WM_USER = &H400
Const EM_GETLINECOUNT = &HBA
Dim numlines As Long

Private Sub Form_Load()
Dim ht As Integer
Text1.Left = 0
Text1.Height = Picture1.Width - 400
Text1.Width = Picture1.TextHeight("A")
Text1.Top = (Picture1.Height - Text1.Height) / 2 + 170
Text1.Visible = True
numlines = 1
End Sub

Private Sub Text1_Change()
Dim ret As Long
Dim ht As Long
ret = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, ByVal 0&)
If ret <> numlines Then
ht = Picture1.TextHeight("A")
Text1.Top = (Picture1.Height - Text1.Height) / 2 + 170
numlines = ret
SendKeys "{PGUP}", True
Text1.SelStart = Len(Text1)
End If
End Sub

پاسخ اقا محمد اسماعیل حسنی
که خواسته بودند نحوه ذخیره متن داخل یک TextBox رو توضیح بدم
یک فرم خالی درست کنید و فقط یک TextBox روی ان قرار دهید و سپس این کدها رو داخل فرم کپی کنید

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Sub Form_Load()
Dim buf As String
buf = Space(255)
GetPrivateProfileString "form1", "textbox1", "10", buf, 255, "c:\testini.ini"
Text1.Text = buf
End Sub

Private Sub Form_Unload(Cancel As Integer)
WritePrivateProfileString "form1", "textbox1", Text1.Text, "c:\testini.ini"
End Sub

و ضمنأ من ویژوال بیسیک فارسی رو با خود ویژوال بیسیک 6 و C++6 نوشتم.

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

اقا کمال برنامه ای رو که خواسته بودید براتون میل کردم.

برنامه درخواستی اقای نفوذگر تنها(Hacker alone)
فقط یک فرم درست کن و این کدها رو توش کپی کن البته شاید...
فعلا چون نمی خواستم منتظرت نگذارم اینو گذاشتم قبلا یه همچین برنامه ای داشتم ولی باورت میشه شاید بیش از نیم ساعت تو هاردم گشتم ولی پیداش نکردم اگه پیداش کردم حتما خبرت میکنم و میزارمش یا شاید هم اگه وقت کردم نوشتمش
Private Const SHFD_CAPACITY_DEFAULT = 0
Private Const SHFD_CAPACITY_360 = 3
Private Const SHFD_CAPACITY_720 = 5
Private Const SHFD_FORMAT_QUICK = 0
Private Const SHFD_FORMAT_FULL = 1

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long

Private Sub Form_Load()
SHFormatDrive Me.hWnd, 2, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK
End Sub

اقا حامد گفته بودن من چه کتابهایی برای یادگیری VB میخونم یاید بگم:
اموزش ویژوال بیسیک در 21 روز
اموزش C++ در 21 روز ( که تا حدودی مرتبط است )
اموزش برنامه نویسی تحت اینترنت با ویژوال بیسیک
211 نکته برای برنامه نویسان ویژوال بیسیک (چکیده MSDN )
500 تابع کاربردی API
و ویژوال بیسیک توسط داییم که استاد کامپیوتر به من فقط معرفی شد که من خودم با پشتکارم یاد گرفتمش و هیچ کلاس اموزشی هم نرفتم

آشنایی با تابع Shell
Function Shell(PathName, [WindowStyle]) As Double
تابع shell مثل run ویندوز برای برنامه نویسی است
PathName : آدرس محل برنامه ای که قرار است اجرا شود
WindowStyle : حالت باز شدن پنجره برنامه می باشد
کاربرد:
مثلا برنامه P.exe را در شاخه "c:\Mahdi\spy" دارید.
فراخوانی برنامه به صورت زیر می باشد .
Call shell "c:\Mahdi\spy\p.exe"

در صورتی که حالات نمایش پنجره را مشخص نکنید . مثل مثال بالا . نمایش پنجره همان نمایش پیش فرض ویندوز می باشد.

استفاده از تایع sendkeys
خوب اینجا می خوام یک کد کاربردی دیگه رو بهتون بگم . این کد باعث می شه که وقتی شما رویداد خاصی رو اجرا مکنید , کلید خاصی از کیبرد اجرا شود یعنی مثلاً اگر شما روی یک Textbox هستید و کلید Enter را فشردید عملی معادل فشردن کلید ..... , Tab ,Delete,Pagedown , F1 ,F2 روی دهد :

Private Sub TextBox_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
+ نوشته شده در  85/09/17ساعت 21:31  توسط مهدی سعادتی  | 

بخش اول : تعاریف مربوط به نمایش درختی

گره ( Node ) : بهترین ایده این است که یک گره را مانند یک شاخه منشعب در یک درخت فرض کنیم. هرگره نشان دهنده یک عضو است. یک گره میتواند هر تعدتد زیر گره را نیز داشته باشد.

برادر ( Subline ) : یک برادر گره دیگری است که در همان انشعاب گره مذکور قرار دارد

فرزندان ( Childern ) : فرزندان به زیر گره های گره جاری گفته میشود. بعضی مواقع به انها فرزند هم گفته میشود.

پدر ( Parent ) : پدر گره ای است که در بالای گره جاری قرار دارد. همه گره ها به جزء گره ریشه دارای پدر می باشند.

بخش دوم : اضافه کردن گره به درخت

در این بخش شما به کنترل های زیر نیاز خواهید داشت:

یک کنترل Tree View که در قسمت کامپوننت و بخش Microsoft Common control 6.0 است و ان را به فرمتان بیافزایید

یک کنترل ImageList که سه تصویر یا 16*16 یا 32*32 باشد که تصاویر را به صورت زیر نام گذاری کنید

//////////////////////

تصویر فولدر بسته با Key >>> Closed

تصویر یک فولدر باز شده با Key >> Open

تصویر یک فایل با key >> Leaf

////////////////////////

کنترل Tree View تعدادی گره را در خود نگه می دارد بنابراین برای اضافه کردن گره به درخت باید یک گره جدید را ابتدا تعریف کنید و سپس ان گره را به مجموعه Tree View اضافه کنید مانند مثال زیر :

Dim nodx As Node

Set nodx = TreeView1.Nodes.Add(, , "Root", "Root Node")

ان را اجرا کنید. شما باید فقط یک عضو را در درخت بنام " Root Node " ببینید. دقت کنید که خاصیت Parent در مثال فوق خالی بود. این مساله برای این است که میخواستیم گره مذکور بالاترین گره یا ریشه باشدو بنابراین نباید هیچ پدری داشته باشد. اجازه بدید تعدادی گره به درختمان اضافه کنیم اما این دفعه تصاویری را نیز به گره هایمان اضافه خواهیم کرد:

Dim nodx As Node

Set TreeView1.ImageList = ImageList1

'Add root Node

Set nodx = TreeView1.Nodes.Add(, , "Root", "Root Node","Closed")

'Expand root node so we can see what's under it

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Create a child node under the root node

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child1", "Child node

1", "Closed")

'Expand this node so we can see what's under it

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Create several more children

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child2", _

"Child node 2", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child3", _

"Child node 3", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child4", _

"Child node 4", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child5", _

"Child node 5", "Leaf")

'Create two child nodes under the first child node of root

Set nodx = TreeView1.Nodes.Add("Child1", tvwChild, "Child1A", _

"Child node 1 A", "Leaf")

Set nodx = TreeView1.Nodes.Add("Child1", tvwChild, "Child1B", _

"Child node 1 B", "Leaf")

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

nodex.expanded=True

کاری که این خط انجام میدهد باز کردن یک گره است بنابراین ما میتوانیم گره های فرزند ان را مشاهده کنیم. ان مانند وقتی است که کاربر روی یک گره کلیک می کند تا خودشان را باز کنند. این کار بوسیله این کد قایل انجام است.ادامه دهید و ان را اجرا کنید. شما خواهید دید که گره ریشه اصلی حالا 5 فرزند در زیر دارد و اولین انها دو فرزند در زیر دارد.

بخش سوم : پیمایش درختی

در اینجا نمونه های برای پیمایش درخت برای پیدا کردن همه گرههای زیر یک گره خاص را اوردهایم. مثال زیر مثال ساده ای است که به شما نشان میدهد چگونه همه گره های زیر یک گره خاص را بدست اورید و متن برچسب انها را نمایش دهید:

Dim nodx As Node

Set TreeView1.ImageList = ImageList1

'Add root Node

Set nodx = TreeView1.Nodes.Add(, , "Root", "Root Node", "Closed")

'Expand root node so we can see what's under it

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Create a child node under the root node

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child1", _

"Child node 1", "Closed")

'Expand this node so we can see what's under it

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Create several more children

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child2", _

"Child node 2", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child3", _

"Child node 3", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child4", _

"Child node 4", "Leaf")

Set nodx = TreeView1.Nodes.Add("Root", tvwChild, "Child5", _

"Child node 5", "Leaf")

'Create two child nodes under the first child node of root

Set nodx = TreeView1.Nodes.Add("Child1", tvwChild, "Child1A", _

"Child node 1 A", "Leaf")

Set nodx = TreeView1.Nodes.Add("Child1", tvwChild, "Child1B", _

"Child node 1 B", "Leaf")

'Loop though each child of the root node

Dim i As Long

'Set nodx to the first child node of root.

Set nodx = TreeView1.Nodes("Root").Child

'Loop though each child nod assigning it to nodx

For i = 1 To TreeView1.Nodes("Root").Children

MsgBox nodx.Text

Set nodx = nodx.Next

Next

فقط بلوک اخر کد در این مثال جدید است. شما میتوانید خاصیت Childern را برای فهمیدن تعداد گره های فرزند یک گره خاص بکار ببرید. خاصیت Children به اولین گره فرزند اشاره میکند و خاصیت Next به گره بعدی نسبت به گره جاری اشاره میکند

بخش چهارم : رویدادها

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

Private Sub Form_Load()

Dim nodx As Node

Set TreeView1.ImageList = ImageList1

'Add Drive

Set nodx = TreeView1.Nodes.Add(, , , "c:", "Closed")

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Add Folder

Set nodx = TreeView1.Nodes.Add(nodx, tvwChild, , "Windows", "Closed")

nodx.ExpandedImage = "Open"

nodx.Expanded = True

'Add Another Folder

Set nodx = TreeView1.Nodes.Add(nodx, tvwChild, , "System", "Closed")

nodx.ExpandedImage = "Open"

nodx.Expanded = True

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

MsgBox Node.FullPath

End Sub

وقتی ما روی یک گره در درخت کلیک میکنیم رویداد Node Click روی میدهد و ان گره ای را که کلیک شده بود را به ما بر میگرداند بنابراین دستکاری ان بسیار اسان است. به نظر شما یز خطرناکی در مثال فوق وجود دارد؟ این صحیح است در اینجا هیچ کلیدی برای هر کدام از گره ها وجود ندارد. کلید اختیاری است. دقت کنید که چون من کلیدی ندارم به جای فقط کلید گره که در تابع add برای اضافه کردن یک گره به درخت استفاده میشود. خود گره را بدست میاورم. این علت ارسال شی Nodx به تابع add می باشد. چون ان واقعا فقط یک اشاره گر به گره قبلی است. شما باید قادر باشید که ذر مثال فوق ببینید که کنترل Tree View بخوبی برای نمایش سیستم فایل کارذمیکند. مانند اکسپلورر در ویندوز خاصیت FiullPath هر چیزی را که ما درباره محل فایل نیاز داریم را به خواهد داد. در اینجا یک مثال از رویدادهای Node Click و collapse و Expand است:

Private Sub Form_Load()

Dim nodx As Node

Dim nodr As Node

'Show Root Lines

TreeView1.LineStyle = tvwRootLines

'Display Checkboxes

TreeView1.Checkboxes = True

'Add Items

Set nodx = TreeView1.Nodes.Add(, , , "Item 1")

Set nodx = TreeView1.Nodes.Add(, , , "Item 2")

Set nodx = TreeView1.Nodes.Add(, , , "Item 3")

Set nodx = TreeView1.Nodes.Add(, , , "Item 4")

Set nodx = TreeView1.Nodes.Add(, , , "Item 5")

nodx.Expanded = True

Set nodr = TreeView1.Nodes.Add(nodx, tvwChild, , "Item 6")

nodr.Expanded = True

Set nodx = TreeView1.Nodes.Add(nodr, tvwChild, , "Item 7")

Set nodx = TreeView1.Nodes.Add(nodr, tvwChild, , "Item 8")

Set nodx = TreeView1.Nodes.Add(nodr, tvwChild, , "Item 9")

Set nodx = TreeView1.Nodes.Add(nodr, tvwChild, , "Item 10")

Set nodx = TreeView1.Nodes.Add(nodr, tvwChild, , "Item 11")

Set nodx = TreeView1.Nodes.Add(, , , "Item 12")

End Sub

Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node)

MsgBox "Colapsing node: " & Node.Text

End Sub

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)

MsgBox "Expanding node: " & Node.Text

End Sub

Private Sub TreeView1_NodeCheck(ByVal Node As MSComctlLib.Node)

If Node.Checked Then

MsgBox "Node " & Node.Text & " was checked"

Else

MsgBox "Node " & Node.Text & " was Unchecked"

End If

End Sub

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

+ نوشته شده در  85/09/16ساعت 22:59  توسط مهدی سعادتی  | 

تاریخچه زبان ویژال بیسیک

با شناختی که از تاریخچه زبان ویژوال بیسیک بدست می آورید راحت تر می توانید از آن استفاده کنید.

شرکت مایکروسافت ویژوال بیسیک را براساس یک زبان برنامه نویسی به نام بیسیک که برای مبتدیان نوشته شده ساخت.

زبان ویژوال بیسیک بیشتر از 35 سال به اشکال مختلف رایج بوده. در واقع طراحان این زبان می خواستند یک زبان برنامه نویسی برای استفاده مبتدیان طراحی کنند.برنامه نویسان جدید می توانند با استفاده ازبیسیک به سرعت به شرع برنامه نویسی های حرفه ای با زبان های cobol .fortran . assembler در مقایسه به بیسیک کار بیشتری نیاز داشت.

طبیعت بصری ویژوال بیسیک

دیدید که ویژال بیسیک چیزی بیشتر از یک زبان برنامه نویسی است. از ویژوال بیسیک در نام آن visual به معنای بصری یا محیط نمایشی است.

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

در اولین بار که برنامه را باز می کنید با پنجره new project روبه رو می شوید در این قسمت نوع فرم خود را انتخاب کرده ماننده activex|standard و....

این پنجره شامل 3 قسمت بوده

New:در این پنجره امکان انتخاب فورم مورد نظر شما امکان پذیر می باشد.

Existing:در این پنجره امکان انتخاب project های مختلف که در مکانهای مختلف ذخیره یا... امکان انتخاب می باشد.

Recent:در این قسمت هر projectرا که ذخیره می کنید به صورت دسته ای جمع می شود حالا یک فایلی

در درایو Dباشد حالا چه در درایو c.

DON.T SHOW THIS DIALOG IN THE FUTURE

این قسمت جلو گیری از باز شدن پینجره NEW PRIJECT می باشد.

HELP:از این قسمت وقتی امکان استفاده می باشد که نرم افزار MSDN را نصب کرده باشید.

معرفی قسمت های بیسیک.

نوار ابزار:TOOLBAR:نوار ابزار VB زیر منو قرار دارد. ویژال بیسیک کلا چهار نوار ابزار دارد:

STANDARD:این نوار ابزار زیر منو ظارهر است و پیش فرض است.

DEBUG:وقتی از ابزارهای رفع اشکال برای ردیابی و اصلاح اشکالات استفاده می کنید. این نوار ابزار ظاهر می شود.

EDIT:این نوار ابزار برای تنظیم کردن اشیاء بر روی فرم می باشد

FORM EDITOR:این نوار ابزار برای تنظیم کردن اشیاء بر روی فرم می باشد.

جعبه ابزار:TOOLBOX:

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

پنجرهPROJECT:در این پنجره فرم های انتخابی شما با هر گروه و هر فرم مشخص شده است.

پنجرهPROPERTISE: این پنجره امکان تنضیمات لازم برای هر شیئی را مشخص می کنید.

توابع ریاضی در ویژال بیسیک

برای نوشتن برنامه های مهندسی ، محاسباتی ، گرافيکی و آماری نياز داريد تا از برخی توابع رياضی استفاده نمائيد . ويژوال بيسيک ۶ دارای مجموعه ای از توابع است که برای انجام محاسبات عددی پيش بينی شده اند . در اين مقاله ابتدا با اين توابع آشنا شده و سپس چگونگی ايجاد ساير توابع رياضی را که در ميان اين مجموعه وجود ندارند خواهيد ديد . در پايان نيز با توابع رياضی موجود در دات نت آشنا می شويد .

توابع رياضی موجود در ويژوال بيسيک

1 تابع Abs (قدرمطلق) : مقدار بدون علامت يک عدد را برمی گرداند .

2 تابع Atn (آرک تانژانت) : خروجی تابع عددی از نوع double است که برابر زاويه ای است که تانژانت آن عدد ورودی تابع است .

3 تابع Cos ( کسينوس ) : خروجی تابع عددی از نوع double است که برابر کسينوس زاويه ورودی است .

4 تابع Exp (توان نمانی) : خروجی تابع عددی از نوع double است که برابر e به توان ورودی تابع است .

5 تابع Int (تابع کف يا تابع جزء صحيح) : نزديکترين عدد صحيح مساوی يا کوچکتر نسبت به عدد ورودی را برمی گرداند .

6 تابع Log (لگاريتم ) : خروجی تابع عددی از نوع double است که برابر لگاريم طبيعی عدد ورودی است ( لگاريتم بر مبنای عددe يا همان Ln )

7 تابع Round ( گرد کردن ) : خروجی تابع عددی از نوع double است که برابر نزديکترين عدد صحيح به مقدار عدد ورودی است .

8 تابع Sgn (علامت) : خروجی تابع عددی از نوع صحيح است که نشان دهنده علامت عدد ورودی است .

9 تابع Sin (سينوس ) : خروجی تابع عددی از نوع double است که برابر سينوس زاويه ورودی است .

10 تابع Sqr (جذر) : خروجی تابع عددی از نوع double است که برابر ريشه دوم يا جذر عدد ورودی است .

11 تابع Tan (تانژانت) : خروجی تابع عددی از نوع double است که برابر با تانژانت زاويه ورودی ( برحسب راديان ) می باشد .

نکته : برای محاسبه توان n ام يک عدد ( n می توان صحيح يا اعشاری باشد ) از اپراتور ^ استفاده نمائيد . برای مثال :

2 ^ 5 = 32

9 ^ 0.5 = 3

4.2 ^ 3.7 = 202.31

چگونگی ايجاد ساير توابع رياضی که در ويژوال بيسيک 6 وجود ندارند

جدول زير چگونگی محاسبه ساير توابع رياضی که در ويژوال بيسيک وجود ندارند را نشان می دهد

سکانت

Sec(X) = 1 / Cos(X)

کسکانت

Cosec(X) = 1 / Sin(X)

کتانژانت

Cotan(X) = 1 / Tan(X)

آرک سينوس

Arcsin(X) = Atn(X / Sqr(1-X * X ))

آرک کسينوس

Arccos(X) = Atn(-X / Sqr(1-X * X)) + 2 * Atn(1)

آرک سکانت

Arcsec(X) = Atn(X / Sqr(X * X - 1)) + Sgn((X) -1) * (2 * Atn(1))

آرک کسکانت

Arccosec(X) = Atn(X / Sqr(X * X - 1)) + (Sgn(X) - 1) * (2 * Atn(1))

آرک کتانژانت

Arccotan(X) = Atn(X) + 2 * Atn(1)

سيونس هيپربوليک

HSin(X) = (Exp(X) - Exp(-X)) / 2

کسينوس هيپربوليک

HCos(X) = (Exp(X) + Exp(-X)) / 2

تانژانت هيپربوليک

HTan(X) = (Exp(X) - Exp(-X)) / (Exp(X) + Exp(-X))

سکانت هيپربوليک

HSec(X) = 2 / (Exp(X) + Exp(-X))

کسکانت هيپربوليک

HCosec(X) = 2 / (Exp(X) - Exp(-X))

کتانژانت هيپربوليک

HCotan(X) = (Exp(X) + Exp(-X)) / (Exp(X) - Exp(-X))

آرک سينوس هيپربوليک

HArcsin(X) = Log(X + Sqr(X * X + 1))

آرک کسينوس هيپربوليک

HArccos(X) = Log(X + Sqr(X * X - 1))

آرک تانژانت هيپربوليک

HArctan(X) = Log((1 + X) / (1 - X)) / 2

آرک سکانت هيپربوليک

HArcsec(X) = Log((Sqr(1-X * X) + 1) / X)

آرک کسکانت هيپربوليک

HArccosec(X) = Log((Sgn(X) * Sqr(X * X + 1) +1) / X)

آرک کتانژانت هيپربوليک

HArccotan(X) = Log((X + 1) / (X - 1)) / 2

لگاريتم بر مبنای N

LogN(X) = Log(X) / Log(N)

اعداد π و e در ويژوال بيسيک

برای استفاده از عدد پی و عدد e در برنامه های خود ثوابت زير را تعريف نمائيد :

Const Pi = 3.14159265358979

Const e = 2.71828182845904

همچنين عدد پی را می توان به صورت زير تعريف کرد :

Pi = 4*Atn(1)

تبديل راديان / درجه

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

Degree(x) =x*180/Pi

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

Rad(x) =x*Pi/180

توابع رياضی و VB.Net

مجموعه توابع رياضی در در ويژوال بيسيک دات نت وجود دارند بسيار قويتر و کاملتر هستند . اين مجموعه توابع در کلاس System.Math موجود می باشند :

** در کلاس Math دو ثابت به اسم E و PI برای نشان دادن پايه لگاريتم طبيعی و عدد پی وجود دارند .

** توابع مثلثاتی : Acos ( آرک کسينوس ) ، Asin ( آرک سينوس) ، Atan ( آرک تانژانت) ، Atan2 ( آرک تانژانت خارج قسمت تقسيم ورودی ها ) ، Cos ( کسينوس ) ، Sin ( سينوس ) ، Tan ( تانژانت )

** توابع عمومی : Abs ( قدرمطلق ) ، BigMul ( حاصلضرب کامل دو عدد 32 بيتی ) ، Ceiling ( تابع سقف ) ، DivRem ( خارج قسمت نقسيم دو عدد ) ، Floor ( تابع کف ) ، IEEERemainder ( باقيمانده نقسيم دو عدد ) ، Max ( ماکزيمم بين دو عدد ) ، Min ( مينيمم بين دو عدد ) ، Round ( تابع گرد کردن ) ، Sign ( تابع علامت ) ، Sqrt ( تابع جذر )

** توابع هيپربوليک : Cosh ( کسينوس هيپربوليک ) ، Sinh ( سينوس هيپربوليک ) ، Tanh ( تانژانت هيپربوليک )

** توابع نمايي و لگاريتمی : Exp ( عدد e به توان مقدار ورودی ) ، Log ( لگاريتم ) ، Log10 ( لگاريتم بر پايه 10 ) ، Pow ( تابع توان )

آشنايي با تابع BitBlt

هدف از اين مبحث آموزشي ، آشنايي با تابع BitBlt و برخي ديگر از توابع کتابخانه Win32 GDI براي انجام برخي عمليات گرافيکي مثل double buffering و خواندن sprite از فايل است .

نکته : sprite به کاراکترهاي متحرکي گفته مي شود که در بازيها وجود دارد .

اولين چيزي که به آن نياز داريد ايجاد يک فرم است . خاصيت ScaleMode آنرا برابر 3-Pixel قرار دهيد . پيشنهاد مي کنم که هميشه در هنگام استفاده از فرم بهمراه API از pixel براي scalemode استفاده کنيد .

سپس سايز فرم را به اندازه اي افزايش دهيد تا ScaleWidth برابر 320 و ScaleHeight برابر 256 شود . توجه کنيد که خاصيت HasDC فرم را True قرار دهيد . همچنين از خاصيت AutoRedraw براي فرم استفاده نمي کنيم زيرا مي خواهيم از Double Buffering استفاده کنيم که بسيار سريعتر و کارامدتر مي باشد .

مرحله بعدي declare کردن API هايي است که به آنها نياز داريم :

'blitting

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

'code timer

Private Declare Function GetTickCount Lib "kernel32" () As Long

'creating buffers / loading sprites

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

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

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

'loading sprites

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

'cleanup

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

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

سوال : DC چيست ؟ DC و يا بعبارت ديگر Device Context ، hDC يک عدد است که به يک آدرس در حافظه اشاره مي کند که داده اي در آن ذخيره شده است . در هنگام استفاده از BitBlt براي اشاره کردن به آدرسي که داده گرافيکي در آنجا ذخيره شده ، استفاده مي شود .

در مرحله بعدي نياز به ذخيره آدرسهاي DC داريم که مي سازيم . آدرسهاي DC مقادير Long هستند همچنين آنها را بصورت Public تعريف مي کنيم :

'our Buffer's DC

Public myBackBuffer As Long

Public myBufferBMP As Long

'The DC of our sprite/graphic

Public mySprite As Long

'coordinates of our sprite/graphic on the screen

Public SpriteX As Long

Public SpriteY As Long

حال بايد تابعي بسازيم که تصاوير گرافيکي درون حافظه load کند . نکته مهمي که بايد به آن توجه کنيد اينست که يک device context خودش به تنهايي هيچ داده گرافيکي ندارد و بايستي يک bitmap موجود باشد تا درون آن load شود براي مثال يک فايل bmp يا يک bitmap خالي که از آن بعنوان back buffer استفاده مي کنيد .

تابعي که خواهيم نوشت يک device context منطبق با صفحه مي سازد سپس فايلهاي گرافيکي مورد نظر را درون device context قرار مي دهد

Public Function LoadGraphicDC(sFileName As String) As Long

'temp variable to hold our DC address

Dim LoadGraphicDCTEMP As Long

'create the DC address compatible with

'the DC of the screen

LoadGraphicDCTEMP = CreateCompatibleDC(GetDC(0))

'load the graphic file into the DC...

SelectObject LoadGraphicDCTEMP, LoadPicture(sFileName)

'return the address of the file

LoadGraphicDC = LoadGraphicDCTEMP

End Function

سوال : double-buffering چيست ؟ زمانيکه يک محيط گرافيکي مي سازيد تا درون آن چيزي را ترسيم کنيد ، شما sprite ها / گرافيکها / متن را درون حافظه blit مي کنيد ( offscrean ) سپس نتيجه نهايي را روي صفحه blit مي کنيد . اين عمل از لرزش تصوير يا flickering جلوگيري مي کند ( زماني رخ مي دهد که چندين sprite مستقيماً روي صفحه blit شوند ) و بسيار سريعتر از AutoRedraw است .

قبل از اينکه مثالي براي اين تابع ذکر کنم تابع BitBlt را توضيح خواهم داد :

BitBlt تابعي از کتابخانه dll “gdi32” است . اين تابع يک انتقال bit-block از داده هاي مرتبط به يک مستطيل از پيکسلها به يک device context مقصد انجام مي دهد . بعبارت ديگر داده هاي گرافيکي را از محيط گرافيکي ( يک bitmap ) به محيط گرافيکي ديگري ( screen يا يک form ) کپي مي کند . فرم کلي اين تابع بصورت زير است :

Declare Function BitBlt Lib "gdi32" Alias "BitBlt" _

(ByVal hDestDC As Long, _

ByVal x As Long, _

ByVal y As Long, _

ByVal nWidth As Long, _

ByVal nHeight As Long, _

ByVal hSrcDC As Long, _

ByVal xSrc As Long, _

ByVal ySrc As Long, _

ByVal dwRop As Long) As Long

اولين خط بيان مي کند که ما بوسيله gdi32 DLL به تابع BitBlt دسترسي خواهيم داشت . خطوط ديگر پارامترهايي هستند که اين تابع مي گيرد :

hDestDC : hDC مربوط به محيط مقصد ( اگر مي خواهيد مقصد يک فرم باشد از form.hDC استفاده کنيد و يا اينکه آدرس يک backbuffer را که ساخته ايد بدهيد )

x : مختصات افقي محلي که مي خواهيد گرافيک شما ظاهر شود .

y : مختصات عمدي محلي که مي خواهيد گرافيک شما ظاهر شود .

nWidth : عرض گرافيک شما

nHeight : ارتفاع گرافيک شما

hSrcDC : hDC مربوط به محيط مبدا

xSrc : افست x . 0 زماني استفاده مي شود که بخواهيد از سمت چپترين گوشه گرافيک مبدا عمل blit را انجام دهيد .

ySrc : افست y

dwRop : مد draw اي که در زمان blitting گرافيکتان مي خواهيد استفاده کنيد ( Raster Operations يا ROP ) . اين پارامتر مقادير زير را مي تواند بگيرد :

- vbSrcCopy : داده تصوير مبدا را مستقيماً در مقصد کپي مي کند .

- vbSrcPaint : داده هاي تصاوير مبدا و مقصد را با هم OR مي کند ( pseudo-alphablending effect )

- vbSrcAnd : داده هاي تصاوير مبدا و مقصد را با هم AND مي کند ( pseudo-gamma effect )

- vbSrcInvert : داده هاي تصاوير مبدا و مقصد را با هم XOR مي کند

- vbSrcErase : ابتدا داده تصوير مقصد را invert مي کند سپس آنرا با داده تصوير مبدا AND مي کند .

- vbDstInvert : داده تصوير مقصد را invert مي کند و داده تصوير مبدا را در نظر نمي گيرد .

- vbNotSrcCopy : داده تصوير مبدا را invert مي کند و آنرا مستقيماً در مقصد کپي مي کند .

- vbNotSrcErase : داده تصاوير مبدا و مقصد را OR کرده و نتيجه را invert مي کند .

مثالي از کاربرد BitBlt :

BitBlt Form1.hDC, PlayerX, PlayerY, 48, 48, picPlayer.hDC, 0, 0, vbSrcCopy

حال مي خواهيم از BitBlt در يک حلقه استفاده کنيم تا يک image را در فرم حرکت دهيم :

1 – يک فايل bmp با ابعاد 32x32 بسازيد و با نام sprite1.bmp در دايرکتوري پروژه ذخيره کنيد .

2 – يک دکمه در فرم قرار دهيد و نام آنرا cmdTest بگذاريد .

3 – دکمه را در گوشه بالايي فرم و در سمت راست قرار دهيد .

4 – کد زير را براي event مربوط به کليک شدن دکمه بنويسيد :

'Timer variables...

Dim T1 As Long, T2 As Long

ساخت DC براي backbuffer

myBackBuffer = CreateCompatibleDC(GetDC(0))

ساخت يک سطح bitmap براي DC

myBufferBMP = CreateCompatibleBitmap(GetDC(0), 320, 256)

load کردن سطح bitmap خالي درون buffer

SelectObject myBackBuffer, myBufferBMP

قبل از blit کردن درون بافر بايد آنرا با black پر کنيم’

BitBlt myBackBuffer, 0, 0, 320, 256, 0, 0, 0, vbWhiteness

load کردن split توسط تابعي که در بالا نوشتيم’

mySprite = LoadGraphicDC(App.Path & "\sprite1.bmp")

cmdTest.Enabled = False

== شروع حلقه اصلي ==’

خواندن tickcount جاري’

T2 = GetTickCount

Do

DoEvents

T1 = GetTickCount

اگر 15 ميلي ثانيه گذشته بود فريم بعدي شروع شود

If (T1 - T2) >= 15 Then

پاک کردن محل قبلي sprite بوسيله پر کردن آنجا با black

BitBlt myBackBuffer, SpriteX - 1, SpriteY - 1,32, 32, 0, 0, 0, vbBlackness

Blit کردن sprite درون back buffer

BitBlt myBackBuffer, SpriteX, SpriteY, 32, 32,mySprite, 0, 0, vbSrcPaint

Blit کردن backbuffer روي فرم’

BitBlt Me.hdc, 0, 0, 320, 256, myBackBuffer,0, 0, vbSrcCopy

حرکت دادن sprite روي صفحه’

SpriteX = SpriteX + 1

SpriteY = SpriteY + 1

'update timer

T2 = GetTickCount

End If

Loop Until SpriteX = 320

سپس بايد يک cleanup code بنويسيد تا حافظه هاي را که براي نگهداري تصاوير گرافيکي و buffer ها استفاده کرده ايد آزاد کنيد :

Private Sub Form_Unload(Cancel As Integer)

DeleteObject myBufferBMP

DeleteDC myBackBuffer

DeleteDC mySprite

End

End Sub

اگه نظرات بیشتر از ۱۵ نشه دیگه ناراحت میشم ها

+ نوشته شده در  85/09/16ساعت 15:47  توسط مهدی سعادتی  | 

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

توضیح : ListView در قسمت component وی بی و در بخش Microsoft common control 6.0 است

یک عدد ListView که اونو فقط روی فرم قرار بدید

یک عدد imageList1 که فقط یک ایکون 16*16 درونش قرار بدید

یک عدد دیگر ImageList2 که فقط یک ایکون 32*32 درونش قرار بدید

بخش اول : اضافه کردن ایتم ها به ListView

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

Dim itmx As ListItem

Set itmx = ListView1.ListItems.Add(, , "Item1")

این همه ان چیزی است که برای یک ایتم ساده به ان احتیاج داریم. کد بالا را به رویداد لود فرم بیافزاید و اجرا کنید. شما میتوانید ان ایتم را در ListView ببینید. اما تا اندازه ای ساده به نظر میرسد. در اینجا هیچ تصویری نمایش داده نشده است. برای نمایش تصاویر در ListView شما باید ان را به یک کنترل Image List (یا چند کنترل Image List) الحاق کنید. برای انجام این کار فقط روی خاصیت Custom کلیک کنید و زمانی که صفحه خواص برای ListView نمایش داده شد روی برگه Image List کلیک کنید. برای گزینه Normal Image List > Image List1 را انتخاب کنید و برای گزینه Small Image List > Image List2 را انتخاب کنیدو سپس خارج شوید. حالا شما تصاویری را خواهید داشت که با اجرای برنامه برای هرکدام از ایتم ها خواهید داشت. بزودی تصاویر بسیاری را خواهیم داشت. برای اینکه هنگام اجرا تصویر شماره 1 از Image List1 و تصویر شماره 1 از Image List2 را نمایش دهیم فقط کافی است کد زیر را بنویسیم :

Dim itmx As ListItem

Set itmx = ListView1.ListItems.Add(, , "Item1",1,1)

حالا برنامه رو اجرا کنید

بخش دوم >> تغییر نما

چندین راه برای نمایش اطلاعات در ListView وجود دارد. مثلا میتوانید به مرورگر ویندوز نگاه کنید که میتوانید نمایش اطلاعات را در ان تغییر دهید . مثلا به شکا نمایش ایکون به شکا بزرگ یا نمایش ایکون به شکل کوچک یا ... برای دیدن هر کدام از حالات مختلف ان را در رویداد لود فرم قرار داده و اجرا کنید

Dim itmx As ListItem

Dim colx As ColumnHeader

'Add a bunch of items

Set itmx = ListView1.ListItems.Add(, , "Item1", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item2", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item3", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item4", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item5", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item6", 1, 1)

Set itmx = ListView1.ListItems.Add(, , "Item7", 1, 1)

'Force window to be shown.

'This is just so you can see what is happening or else the

'messages would come up and the window would not have

'appeared yet

Me.Show

'Set the listview to icon

ListView1.View = lvwIcon

MsgBox ("You are now viewing the list in Icon View")

'Set the listview to small icon

ListView1.View = lvwSmallIcon

MsgBox ("You are now viewing the list in Small Icon View")

'Set the listview to list

ListView1.View = lvwList

MsgBox ("You are now viewing the list in List View")

'Add a column at runtime

'You can do this ahead of time in the controls

'property pages

Set colx = ListView1.ColumnHeaders.Add(, , "Name")

'Set the listview to report

ListView1.View = lvwReport

MsgBox ("You are now viewing the list in Report View")

در اینجا شما فقط باید خواص ListView را تنظیم کنید. ببینید که شما میتوانید نمای هر کدام انها را تغییر دهید

بخش سوم >> کار کردن با ستون ها

ایا بخاطر دارید نمای Report را در مرورگر ویندوز به شکل چی دیدید؟ دران حالت بصورت چند ستونی است و شامل : نام فایل و اندازه و .. است ممکن است مشکل به نظر برسد من به شما اطمینان میدهم که خیلی ساده است

این کدها را اجرا و بررسی کنید که هر کدام بعد از این کد دارای توضیحاتی هستند

Dim itmx As ListItem

Dim colx As ColumnHeader

'Add some columns

Set colx = ListView1.ColumnHeaders.Add(, , "Filename")

Set colx = ListView1.ColumnHeaders.Add(, , "Type")

Set colx = ListView1.ColumnHeaders.Add(, , "Size")

Set colx = ListView1.ColumnHeaders.Add(, , "Date")

'Add an item. The text here is always the

'First Column (Index 0)

Set itmx = ListView1.ListItems.Add(, , "Abstract.exe", 1, 1)

'Here is how we access each of the columns

itmx.SubItems(1) = "Program File"

itmx.SubItems(2) = "15 KB"

itmx.SubItems(3) = "10/10/1999"

'Set the listview to report

ListView1.View = lvwReport

شما می توانید ببینید که ما فقط به اضافه کردن تعدادی از ستونها احتیاج داشتیم مانند مثال قبلی. تفاوتی که در اینجا وجود دارد این است که ما به SubItem ها در یک ListItem دسترسی داریم. وقتی شما ابتدا یک ایتم متن را اضافه کنید ان را در Column(0) دریافت خواهید کرد.سپس برای قرار دادن متن در ستونهای دیگر ما لازم است که متن را به هر کدام از زیر ایتمها انتقال دهیم.برای مثال بالا من خودم را برای اضافه کردن تصاویر به header ستونها دردسر ندادم امل اگر شما از VB6 استفاده میکنید میتوانید این کار را نیز انجام دهید.

بخش چهارم >> رویدادهای ListView

در اینجا دو تا از رویدادهای اصلی که شما هنگام کار با ListView واقعا به انها احتیاج داردید توضیح میدهم. رویدادهای itemClick و ItemCheck.

رویداد ItemClick وقتی روی میدهد که روی لیست ایتمها کلیک شده باشد. این رویداد شی ListItem را که روی ان کلیک شده است را بر میگرداند و بنابراین شما میتوانید با ان هر کاری را که لازم است انجام دهید.پس این کد را به مثال قبلی اضافه کنید

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

MsgBox Item.Text

End Sub

وقتی شما برنامه را اجرا کنید و روی هر کدام از ایتمها در ListView کلیک کنید یک پیغام مبنی حاوی متن ایتمی که روی ان کلیک شده نمایش میدهد

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

ListView1.Checkboxes = True

وقتی شما برنامه را اجرا کنید متوجه خواهید شد که یک جهبه چک در کنار هر کدام از ایتم ها داده شده است. ممکن است تا زمانی که روی ListView کلیک نشود ان را به روز نکند ( به نظر میرسد این یکی از باگهای VB باشد). اما اگر شما مقادیر جعبه چکها را در زمان طراحی تغییر دهید ان را بدرستی نمایش خواهد داد. برای انجام دادن کاری در زمان که کاربر جعبه چکها را تیک میزند و یا تیک را برمیدارد شما باید کد زیر را در رویداد ItemCheck قرار دهید.

Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)

If Item.Checked Then

MsgBox "Box is being checked"

Else

MsgBox "Box is being unchecked"

End If

End Sub

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

در این بخش ما میخواهیم ایتم های را در حالت Report به ListView اضافه کنیم و وقتی که کاربر روی عنوان یکی از ستونها کلیک کرد میخواهیم ایتم های موجود در ListView را بر اساس همان ستون مرتب کنیم. اگر کاربر روی همان ستون دوباره کلیک کرد این مرتب سازی بین حالت صعودی و نزولی تغییر کند. ابتدا نگاهی به کد زیر میاندازیمکه تا اندازه ای واضح است:

Private Sub Form_Load()

Dim itmx As ListItem

Dim colx As ColumnHeader

'Add Some Columns

Set colx = ListView1.ColumnHeaders.Add(, , "Col1")

Set colx = ListView1.ColumnHeaders.Add(, , "Col2")

'Add two items

Set itmx = ListView1.ListItems.Add(, , "ABC")

itmx.SubItems(1) = "XYZ"

Set itmx = ListView1.ListItems.Add(, , "XYZ")

itmx.SubItems(1) = "ABC"

'Set the view to report

ListView1.View = lvwReport

End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As

MSComctlLib.ColumnHeader)

'Check if the Sortkey is the same a the current one

If ListView1.SortKey <> ColumnHeader.Index - 1 Then

'When a column is clicked set the sortkey

'to the columnheader index -1

ListView1.SortKey = ColumnHeader.Index - 1

ListView1.SortOrder = lvwAscending

Else

'If the column is already selected then change the

'sortorder to be the opposite of what is currently

'being used

ListView1.SortOrder = IIf(ListView1.SortOrder = lvwAscending, _

lvwDescending, lvwAscending)

End If

'Set the sorted property to use the new sortkey

'and sort the contents

ListView1.Sorted = True

End Sub

بنابراین وقتی کاربر روی یک ایتم کلیک میکند رویداد Column_Click رخ میدهد که مرجعی به شی ColumnHeader که کلیک شده است برمیگرداند. در این کد ما این را برای دسترسی به خاصیت index برای مقدار دهی SortKey از کنترل ListView بکار برده ایم ( SortKey فقط میگوید ListView چگونه مرتب شود ) وقتی که این کامل شد ما مقدار خاصیت Sorted کنترل ListView را به True مقدار میدهی.این اطمینان حاصل میکند که کنترل مرتب شده است و بوسیله این تغییرات در SortKey منعکس شده و نمایش داده شود. اگر همان ستون دوباره کلیک شد سپس ما نوع مرتب سازی را تغییر میدهیم و ان را برابر عکس روش فعلی قرار میدهیم

بخش ششم >> ذخیره کردن عناوین ستونهای مرتب شده :

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

Private Sub Form_Load()

Dim colx As ColumnHeader

'Let the user reorder the columns

ListView1.AllowColumnReorder = True

'Set view to report

ListView1.View = lvwReport

'Add some columns

Set colx = ListView1.ColumnHeaders.Add(, , "Col1")

Set colx = ListView1.ColumnHeaders.Add(, , "Col2")

Set colx = ListView1.ColumnHeaders.Add(, , "Col3")

Set colx = ListView1.ColumnHeaders.Add(, , "Col4")

Set colx = ListView1.ColumnHeaders.Add(, , "Col5")

Set colx = ListView1.ColumnHeaders.Add(, , "Col6")

'Loop though each ColumnHeader object and set the

'position of it dependent on what the user did

'the last time

For Each colx In ListView1.ColumnHeaders

colx.Position = GetSetting(App.Title, "Settings", "Col" & colx.Index,colx.Index)

colx.Width = GetSetting(App.Title, "Settings", "ColWidth" & colx.Index, colx.Width)

Next

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim colx As ColumnHeader

'Save the Position of each of the ColumnHeader

'Objects so we can load them the next time

'the user starts the program

For Each colx In ListView1.ColumnHeaders

SaveSetting App.Title, "Settings", "Col" & colx.Index,ListView1.ColumnHeaders(colx.Index).Position

SaveSetting App.Title, "Settings", "ColWidth" & colx.Index,ListView1.ColumnHeaders(colx.Index).Width

Next

End Sub

رویداد Unload فرم تا زمانی که همه ColumnHeader ها در کنترل ListView را بدست اورده و مکان و اندازه (عرض) انها را ذخیره کند ادامه پیدا میکند.سپس دفعه بعد که برنامه اجرا شود در رویداد لود فرم این خواص اشاره شده و مقادیر انها را به اشیای ColumnHeader خاص برمی گردانیم.

چند روز دیگه اموزش تری ویو رو میزارم سر بزنید

+ نوشته شده در  85/09/16ساعت 15:38  توسط مهدی سعادتی  | 

اموزش بعدی که عکسشم گذاشتم شبیه سازی Power DVD 6 است حتما سر بزنید

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

خودم برنامه پکیج تصویر

+ نوشته شده در  85/09/12ساعت 17:10  توسط مهدی سعادتی  | 

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

توجه : یه کتاب گرفتم : 211 نکته برای برنامه نویسان ویژوال بیسیک

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

و 4 تا TextBox و 4 تا Label و 2 تا Command به فرم بیافزایید

و بعدش نام TextBox ها رو مثل شکل قرار بدید و نام command1 رو btnSend بزارید

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

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 btnSend_Click()

On Error Resume Next

btnSend.Enabled = False

MsgBox (SendMessage(txtusername.Text, txtpassword.Text, txtNumber.Text, txtMessage.Text))

btnSend.Enabled = True

End Sub

Private Sub Form_Load()

txtusername.Text = "User@host.com"

End Sub

حالا این کدها رو هم تو ماژولتون کپی کنید

 

Public Function SendMessage(username As String, password As String, _

destination As String, message As String)

Dim xmlstring As String

xmlstring = ") & "?> " & _

"<Request xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & " xsi:noNamespaceSchemaLocation=" & Chr(34) & "http://schema.2sms.com/1.0/0410_RequestSendMessage.xsd" & Chr(34) & " Version = " & Chr(34) & "1.0" & Chr(34) & ">" & _

"<Identification>" & _

"<UserID>>" & _

"<Password>" & password & ">" & _

"Identification>" & _

"<Service>" & _

"<ServiceName>SendMessage>" & _

"<ServiceDetail>" & _

"<SingleMessage>" & _

"<Destination>" & destination & ">" & _

"<Text>>" & _

"SingleMessage>" & _

"ServiceDetail>" & _

"Service>" & _

"Request>"

'open connection to server and send

Dim xmlrequest As MSXML2.XMLHTTP

Set xmlrequest = New MSXML2.XMLHTTP

xmlrequest.Open "POST", "http://www.2sms.com/xml/xml.jsp", False

xmlrequest.setRequestHeader "content-type", "text/xml"

xmlrequest.send xmlstring

'get the response back

response = xmlrequest.responseText

'set up DOM to parse

Dim xmlresponse As MSXML2.DOMDocument30

Set xmlresponse = New MSXML2.DOMDocument

xmlresponse.async = False

xmlresponse.resolveExternals = False

xmlresponse.validateOnParse = False

On Error Resume Next

xmlresponse.loadXML response

'pull out relevant variables from response

javaresult = (xmlresponse.getElementsByTagName("Result").Item(0).Text)

errorCode = (xmlresponse.getElementsByTagName("ErrorCode").Item(0).Text)

errorreason = (xmlresponse.getElementsByTagName("ErrorReason").Item(0).Text)

messageid = (xmlresponse.getElementsByTagName("MessageID").Item(0).Text)

If errorCode = "00" Then

SendMessage = javaresult

Else

If errorreason = "" Then

SendMessage = "Message Failed - Unknown Error"

Else

SendMessage = "Message FAILED. (Reason: " & errorreason & ")"

End If

End If

End Function

بچه ها من خودم تست نکردم ولی فکر کنم باید تو یه سایتی ثبت نام کنید

حالا بریم سراغ ولتمتر برای بچه های الکترونیک

یه پروژه استاندارد درست کنید و سپس 2 تا Radio button و 1 دونه Textbox و از قسمت کامپوننت ها

با زدن Ctrl + T ابزار Microsoft Comm Control 6.0 رو انتخاب و در اخر هم یک Command به فرمتون اضافه کنید

Radio 1 = optEnable

Radio 2 = optstop

text = txtVolts

cmd = cmdexit

MSComm = MSComm1

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

Option Explicit

Private fEnable As Boolean

Private Sub cmdExit_Click()

If MSComm1.PortOpen = True Then

MSComm1.PortOpen = False

End If

End

End Sub

Private Sub Form_Load()

MSComm1.InputLen = 0

MSComm1.CommPort = 1

MSComm1.Settings = "9600,N,8,1"

End Sub

Private Sub optEnable_Click()

fEnable = True

Do Until fEnable = False

DoEvents

Dim BytesToRead As Integer

Dim DataIn As Variant

MSComm1.PortOpen = True

BytesToRead = 1

Do

DoEvents

Loop Until MSComm1.InBufferCount = BytesToRead

DataIn = MSComm1.Input

txtVolts.Text = Asc(DataIn) * 0.0196 & " Volts DC"

MSComm1.PortOpen = False

Loop

End Sub

Private Sub optStop_Click()

fEnable = False

End Sub

حالا برنامه رو اجرا کنید و باید از طریق درگاه کام یه ولتاژ دلخواه رو اعمال کنید

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

ابتدا یک فرم درست کنید و بعد دوتا TextBox قرار بدید و این کدها رو تو فرمتون کپی کنید

نکته : اینکه TextBox 1 برای وارد کردن عدد مورد نظر شماست

Private Sub Text1_LostFocus()

Dim isec As Integer

isec = Val(Text1.Text)

Dim breaksec

breaksec = Str$(Int(isec / 60)) & " ÏÞíÞå æ " & Str$(isec Mod 60) & " ËÇäíå"

Text2.Text = breaksec

End Sub

+ نوشته شده در  85/09/12ساعت 17:7  توسط مهدی سعادتی  | 

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

مثلا" Explorer ویندوز یا برنامه Excel یه همچین امکانی رو به برنامه نویسان میدن یا برنامه های دیگه ویندوز … علاوه بر این شما هم میتونید به برنامه های دیگه این جازه رو بدید که از اطلاعات برنامه شما استفاده کنن ... این که میگم اطلاعات منظورم فقط تصویر به صورت عکس و Text هست . چون فقط کنترلهای Label و Textbox و PictureBox از متدها و خواص مربوط به DDE پشتیبانی میکنند .
نکته ای که باید توجه کنید اینه که همیشه اول باید برنامه منبع ( Source ) اجرا شده باشه تا برنامه مقصد ( Distinition )

بتونه با روشهایی که اعلام میکنم ارتباط DDE رو برقرار کنه ..در غیر این صورت برنامه با خطا مواجه میشود .خوب فکر کنم قبل از اینکه متد ها و رویدادها و خواص مختلف مربوط به این ارتباط رو بررسی کنیم بهتر باشه یه مثال رو که ایجاد یک ارتباط ساده رو نشون میده با هم انجام بدیم بعد یکی یکی موارد رو بررسی کنیم .

ابتدا یک پروژه جدید تعریف کنید .... اول میخواهیم فرم و برنامه Server برنامه منبع رو طراحی کنیم
فقط کافیه روی فرم یک textbox مثلا" با نام intxt قرار بدهید ... بعد نام پروژه و نام فیل اجرایی که ساخته میشه رو به مثلا invblog تغییر بدید حالا فقط یک کار مونده که برای برنامه Server انجام بدید .... اون اینکه از قسمت خواص فرم در حالت design خاصیت LinkMode فرم رو به 1-Source تغییر بدهید

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

حالا با هم برنامه مقصد یا Client رو طراحی می کنیم .
اینبار برای برنامه Client تعیین نام پروژه و فایل اجرایی مهم نیست . فقط کافیه که یک textbox روی فرم قرار بدهید و خاصیت LinkTopic عنصر textbox رو به invblog|Form1 تغییر بدهید ... invblog بر اساس نام پروژه یا نام فایل اجرایی است که textbox برنامه مقصد قرار است از آن فرمان بگیرد تعیین میشود و Form1 بر اساس مقدار تعیین شده در خاصیت LinkTopic فرم برنامه منبع ( Server ) تعیین میشود مقدار پیش فرض این خاصیت نام اولیه و پیش فرض فرم برنامه Server است که اگر این مقدار رو در برنامه اول تغییر دادید باید بجای پارامتر دوم خاصیت LinkTopic عنصر textbox در برنامه دوم (Client) قرار دهید.

لازم به تذکر است که این دو پارامتر با علامت | بدون فاصله از هم جدا میشوند

در آخر خاصیت LinkItem عنصر textbox رو با نام textbox برنامه Server که در اینجا intxt است مقدار دهی میکنیم و فقط یک خط Text1.LinkMode = 1 رو برای فرم لود برنامه مینویسیم .

توجه داشته باشید که موقع اجرا حتما" باید اول برنامه Server رو اجرا کنید بعد برنامه Client رو اجرا کنید وگرنه اجرا با مشکل مواجه میشه
حالا با احرای دو تا برنامه میبینید که هرچی تو textbox برنامه invblog تایپ میکنید تو textbox برنامه دوم هم تایپ میشهفقط اگه برنامه رو از روی فایل اجرایی اجرا میکنید نام فایل برنامه Server رو باید حتما ( در این مثال ) invblog قرار بدید وگرنه ارتباطی در کار نخواهد بود .

تو این مثال برای فایل منبع که اصلا کد نویسی نداشتیم و برای فایل مقصد هم که فقط یک خط Text1.LinkMode = 1 رو نوشتیم .... ولی تمامی این خواص که در حالت طراحی فرم تقییر دادیم مثل LinkTopic و .... از طریق کد نویسی هم میتونید انجام بدید .
خوب و اما بررسی دقیقتر خواص و متدهای لازم برای این کار همون طور که در مثال دیدید اولین کاری که باید بکنیم اینه که خاصیت Linkmode فرم برنامه منبع رو 1 قرار بدهیم .کار بعدی که باید انجام بدیم اینه که یه نام مشخص برای برای خاصیت LinkTopic فرم برنامه منبع تعیین کنیم اسم کنترلی که میخوایم با اون ارتباط برقرار کنیم رو هم در خاطر داشته باشیم که بعدا در برنامه مقصد لازمش داریم در مرحله آخر هم پروژه و فایل اجرایی برنامه رو با نام مشخصی ذخیره کنیم و اون نام رو هم به یاد داشته باشیم .

حالا برنامه منبع ما آماده هست باید برنامه دوم ( مقصد ) رو طراحی کنیم :
برای یک ارتباط ساده و اولیه سه تا از خصوصیات کنترلی که میخواهید ارتباط را با آن ایجاد کنید در برنامه مقصد تنضیم میکنید
این سه خصوصیت LinkTopic و LinkItem و Linkmode میباشد و به صورت زیر تعریف میشود .
نام کنترل . LinkTopic = “نام فایل اجرایی برنامه | مشخص شده در فرم برنامه منبع Linktopic "
در اینجا اگر برنامه رو در محیط vb اجرا میکنید و نه از طریق فایل اجرایی" نام فایل اجرایی برنامه " باید به نام فایل پروژه تغییر کند...
نام کنترل . LinkItem = " نام کنترلی ( در برنامه منبع ) که ارتباط باید با آن برقرار شود "

توجه کنید که کنترل میتواند Label و Textbox و PictureBox باشد اگر کنترل PictureBox باشد عکس آن انتقال داده میشود و در غیر این صورت متن منتقل میشود .
بعد از تعیین LinkTopic و LinkItem باید Linkmode تعیین شود .
1 یا 2 یا 3 . LinkeMode = نام کنترل
اگر این مقدار 1 باشد ارتباط و انتقال اطلاعات به صورت اتوماتیک میباشد . یعنی به طور مداوم با تغییر محتویات کنترل تعیین شده اطلاعات آن به کنترل لازمه انتقال داده میشود . یک نمونه از این نوع ارتباط را در مثال اول ملاحضه کردید .
اما اگر مقدار LinkeMode برابر 2 تعیین شده باشد انتقال اطلاعات به طور دستی صورت میگیرد … یعنی ارتباط در این حالت در صورت درست بودن برقرار میشود ولی اطلاعاتی بطور اتوماتیک منتقل نمیشود . در این حالت اطلاعات میتواند با فراخوانی متد LinkRequest منتقل شود .
نام کنترل . LinkRequest
اما حالت سوم LinkeMode با مقدار 3 میباشد .... این حالت هم مانند ارتباط قبلی غیر اتوماتیک میباشد که انتقال اطلاعات
باید از طریق LinkRequest صورت گیرد ... فقط در این حالت میتوان از رویداد Linknotify استفاده کرد

رویدادهای DDE

رویداد LinkNotify
این رویداد وقتی فراخوانی میشود که محتویات کنترل تعیین شده در LinkItem تغییر کرده باشد .یادآوری میشود که برای استفاده از این رویداد باید LinkeMode با مقدار 3 تعیین شده باشد . در واقع این رویداد تغییر محتویات کنترل مورد نظر در برنامه منبع را به برنامه مقصد اعلام میکند !

رویداد LinkClose : این رویداد وقتی فراخوانی میشود که ارتباط وصل شده DDE به هر دلیلی قطع شود ." مثلا یکی از برنامه های منبع یا مقصد بسته شود "

رویداد LinkError
اگر در طی ارتباط DDE Conversation خطایی رخ دهد این رویداد فراخوانی میگردد و شماره خطا به عنوان پارامتر و آرگومان این رویداد ارسال میشود .

رویداد LinkOpen
وقتی که ارتباط DDE مقدار دهی شود و ارتباط برقرار شود این رویداد فراخوانی میشود .

خاصیت LinkTimeOut
مدت زمانی که طول میکشه تا اطلاعات از یک برنامه به یک برنامه دیگه منتقل بشه در کامپیوتر های مختلف متفاوت میباشد
این زمان به حجم داده اطلاعاتی و سرعت کامپیوتر و حافظه آزاد کامپوتر و .... بستگی داره اگر برنامه ای در مدت معین شده در این خاصیت اطلاعات خود را نتواند انتقال دهد برنامه با خطا مواجه میشود .
مقدار پیشفرض این خاصیت 50 است که بع اندازه تقریبا" 5 ثانیه میباشد و مقدار مناسبی برای این خاصیت میباشد

متد LinkPoke:
این متد عکس عمل LinkRequest میباشد و انتقال اطلاعات از کنترل برنامه مقصد به کنترل برنامه منبع را انجام میدهد .
با استفاده از این دستور میتوانید مثلا" متنی را به برنامه دیگر بفرستید و نتیجه را در TextBox برنامه منبع مشاهدا کنید .

متد LinkSend
این دستور اطلاعات کنترل PictureBox را به برنامه مقصد میفرستد ... این دستور همان کار
LinkRequest را انجام میدهد با این تفاوت که در LinkRequest درخواست انتقال اطلاعات از کنترل منبع به مقصد از طرف برنامه مقصد صورت میگیرد ولی در LinkSend درخواست انتقال اطلاعات باز هم از کنترل منبع به مقصد از طرف برنامه منبع صورت میگیرد

متد LinkExecute
این دستور رشته ای را از یک برنامه ( منبع یا مقصد ) به برنامه دیگر میفرستد .... اما چگونه این رشته رو در برنامه دیگر دریافت کنیم ؟ با استفاده ار رویداد LinkExecute در برنامه دیگر
این دستور یک پارامتر ورودی از نوع String دارد که رشته مورد نظر را تعیین میکند

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

Private Sub Command2_Click()
Text1.LinkExecute "www.vblog.blogfa.com"
End Sub

و در برنامه منبع هم کد زیر رو داریم :
Private Sub Form_LinkExecute(CmdStr As String, Cancel As Integer)
Me.Caption = CmdStr
Cancel = False
End Sub

همینطور که میبینید CmdStr رشته ای را در Caption فرم نمایش میدهد که با LinkExecute فرستاده شده بود
در اینجا اگر پارامتر Cancel رو بعد از اینکه مقدار فرستاده شده را دریافت کردیم False نکنیم با خطا 285 مواجه میشویم ...

مشخصه Causes Validation

شايد زمانی که داشتيد روی مشخصات (Properties) مربوط به Text Box نظر می کرديد، مشخصه causes Validation را نيز ديده باشيد که ما در بخش قبل از آن نام نبرديم. اين مشخصه در بسياری از VCLها نيز وجود دارد و دارای کاربرد بسيار زيبايی است که شايد اگر وجود نداشت، برای شبيه سازی آن بوسيله کدنويسی، زمان زيادی را صرف خود می کرد.

فرض کنيد بر روی فرم يک Text Box به نام txtNumber وجود دارد که برای دريافت نمره يک درس دانش آموزی از کاربر، استفاده می شود. ترجيح می دهيم کاربر نتواند اين فرم را save کند (نتواند به سراغ کليد cmdSave برود) مگر اينکه نمره صحيح (که در فاصله صفر تا بيست است،) را وارد نموده باشد. اما مثلاً بتواند روی دکمه cmdCancel برود و فرم را Cancel نمايدو يعنی می خواهيم اگر نمره در دامنه صحيح خود نبود روی برخی ديگر از آنها نرود.
اگر برای رويداد(Event) Validate از txtNumber ، چنين داشته باشيم:

Private Sub txtNumber_Validate (Cancel As Boolean)
IF Val (txtNumber) > 20 then
Cancel = True
End IF
End Sub

Event Procedure فوق می گويد هر وقت که txtNumber ، Validate شد، بررسی کن که آيا نمره کمتر از 20 هست يا خير که اگر نبود، پارامتر Cancel را True نمايد. حال اگر مشخصه Causes Validation از هر کنترلی را True نماييم، در صورتی که Val(txtNumber)>20 باشد، کاربر نمی تواند، آن کنترل را فوکوس دهد. لذا اگر مشخصه مذکور را برای کليد cmd Save برابر True و برای cmdCancel برابر False تغير دهيم، درصورت نبودن نمره در فاصله مناسب، کاربر می تواند عمليات دکمه Cancel را انجام دهد اما عمليات دکمه Save را خير مگر اينکه دوباره Text Box مذکور را با عددی مناسب Validate نمايد.
توجه کنيد که می توانيد برای زيبايی برنامه مذکور برای رويداد Key up از txtNumber نيز چنين داشته باشيم.

Private Sub txtNumber_KeyUp (KeyCode As Integer, shift As Integer)
IF Value (txtNumber)>20 then
txtNumber. Forecolore = VBRed
Else
txtNumber. Forecolore = VBBlack
Evd IF
End Sub

که برای نمايش اينکه با وارد نودن نمره ای به کاربر خطايی رخ داده است، رنگ متن آن را به رنگ قرمز (Red) در می آوريم و در غير اينصورت (يعنی بدون خطا) رنگ متن را به رنگ سياه (Black) در خواهيم آورد.

ذکر چند مشخصه ديگر:
1- اگر برای يک کليد (Command Button)، مشخصه Cancel را به True قرار دهيم، در صورت زدن کليد (Escape) ESC توسط کاربر، رويداد Click از اين کليد روی می دهد.
2- اگر برای يک کليد، مشخصه Default را به True تغيير دهيم، در صورت زدن کليد Enter توسط کاربر، رويداد Click از آن روی خواهد داد.
3- اگر برای يک فرم، رويداد Key Preview را به True تغيير دهيم، هر کليدی را کاربر از صفحه کليد فشار دهد، ابتدا اين کليد به رويداد KeyPress از فرم فرستاده می شود و آنگاه به رويداد Key Press از کنترلی که Focus در اختيار آن است، فرستاده می شود

*********************************
نکاتی در باره توابع ، متغيرها و نحوه استفاده آنها

ارسال متغير بصورت ByRef و ByVal

اگر موقع تعريف يک تابع قبل از نام متغير از عبارت ByRef استفاده نماييم هنگام فراخوانی تابع با قراردادن متغيری در تابع که دارای مقدارميباشد ، پس از محاسبات ، مقدار متغير نيز تغيير ميکند. در ضمن مقدار تابع با آخرين مقدار متغير محاسبه ميگردد:

Function Use_ByRef(ByRef intVar As Integer)
intVar = intVar + 1
Return intVar
End Function

Dim intMyVar As Integer
intMyVar = 1
Response.Write(intMyVar & "-----" & Use_ByRef(intMyVar))

پاسخ : 2-----3

ولی اگر در مثال فوق ازByVal استفاده کنيم ، پس از محاسبات مقدار متغير تغيير نميکند و نيز مقدار تابع با مقدار اوليه متغير محاسبه ميشود:

Function Use_ByVal(ByVal intVar As Integer)
intVar = intVar + 1
Return intVar
End Function

Dim intMyVar As Integer
intMyVar = 1
Response.Write(intMyVar & "-----" & Use_ByVal(intMyVar))

پاسخ : 1-----2

متغير Static

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

اين مورد بر خلاف تعريف متغيير بوسيله دستور Dim است . چون در Dim متغيير بمحض تعريف شدن دوباره ، مقدار قبلي خود را از دست ميدهد.

Function Use_Static()
Static intCount As Integer
intCount = intCount+1
Return intCount
End Function

Response.Write( "
" & Use_Static)
Response.Write( "
" & Use_Static)
Response.Write( "
" & Use_Static)

1 پاسخ :
2
3

تعريف توابع بصورت OverLoads

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

در اينجا راه حل ديگري نيز وجود دارد كه اگر دو يا چند تابع را با يک نام ثابت ولی تعداد يا نوع متغير متفاوت در يک کلاس تعريف نماييم ميتوانيم از هر کدام برحسب نياز استفاده کنيم:

Function Use_OverLoads(ByVal strVar1 As String, ByVal strVar2 As String)As String
Return strVar1 & strVar2
End Function

Function Use_OverLoads (ByVal intVar As Integer) As Integer
Return intVar + intVar
End Function

Response.Write(Use_OverLoads (5))
Response.Write("
" & Use_OverLoads("Over", "Loads"))

10 پاسخ :

OverLoads

*************************
4.برای رایت تو لفت کردن فرمها و هر کنترلی از این تابع استفاده کنیدو برای کنترلی خاص فقط به جای اسم فرم در پایین نام کنترل رو بنویسید

Option explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const WS_EX_LAYOUTRTL = &H400000
Private Const GWL_EXSTYLE = -20

Private sub form_Load()
SetWindowLong form1.hWnd, GWL_EXSTYLE, GetWindowLong(form1.hWnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL
End sub

نکته !!!؟
1.برای بسته نشدن یک فرم میتوانید در رویداد UnLoad فرمتون عبارت Cancel = True رو تایپ کنید

2.برای دیدن عبارات فارسی در محیط کد میتوانید در قسمت تنظیمات برنامه در تب Editor Format فونت رو به Courier New (Arabic) تغییر بدهید

*************************
برای من و شما بعنوان برنامه‌نویس، صحت ورود اطلاعات از سمت کاربر در بیشتر حالات از اهمیت ویژه‌ای برخوردار هست. یه نمونه ساده ورود آدرس پست‌الکترونیکی هست که باید بررسی‌های ویژه‌ای در اون گنجانده بشه. بعنوان مثال آدرسهای زیر همه صحیح هستند:

power@yahoo.com
power@ia.un.ir
power.station@yahoo.com

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

^[a-zA-Z][w.-]*[a-zA-Z0-9]@[a-zA-Z0-9][w.-]*[a-zA-Z0-9].[a-zA-Z][a-zA-Z.]*[a-zA-Z]$

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

سورس زیر نمونه کد تولید شده به زبان C# هست.

using System.Text.RegularExpressions;

// regular expression object
Regex re = new Regex(@"^[a-zA-Z][w.-]*[a-zA-Z0-9]@[a-zA-Z0-9][w.-]*[a-zA-Z0-9].[a-zA-Z][a-zA-Z.]*[a-zA-Z]$");

// Match object
Match m = re.Match("your string");

// found or not
if( m.Success )
{
// found
}
else
{
// not found
}

دانلود
http://www.regexlab.com/download/?/mtracer/MTracer.zip
+ نوشته شده در  85/08/29ساعت 22:38  توسط مهدی سعادتی  |