نكاتي براي برنامه نويسان Visual Basic

[آبجی]

تبديل يك عدد به ساعت ، دقيقه و ثانيه


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

بكارگيري عملگر Mod براي محاسبه دوره هاي زماني سپري شده
عملگر Mod در ويژوال بيسيك ، دو عدد را به هم تقسيم مي كند اما فقط باقيمانده عمل تقسيم را بر مي گرداند . اگر بخواهيد معين كنيد كه عدد 121 ( كل ثانيه هايي كه براي يك رويداد ثبت شده است ) چند دقيقه و ثانيه مي شود ، اين عدد را بر 60 تقسيم مي كنيد (‌ثانيه به ازاي هر دقيقه )‌نتيجه تقسيم عدد 2 و باقيمانده آن نيز 1 خواهد بود . اينك اگر از عملگر Mod ، مجددا بر روي عدد اصلي استفاده كنيد ، عدد 1 را دريافت خواهيد كرد كه همان باقيمانده تقسيم فوق است . اين تبديل ،‌در نهايت عدد 121 را به دو دقيقه و يك ثانيه تبديل مي كند.

برنامه نمونه

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

1- پروژه جديدي در ويژوال بيسيك ايجاد نماييد به طور پيش فرض Form1 ايجاد مي شود.
2- كنترلي از نوع Label به Form1‌ اضافه كنيد . بطور پيش فرض Lable1 ايجاد مي شود. خصوصيت Caption آن را با عبارت "Enter A Value" تنظيم نماييد.
3- سپس كنترلي از نوع Text Box در كنار Label1 اضافه كنيد . بطور پيش فرض Text1 ايجاد مي شود. خصوصيت Text آنرا نيز با Null (خالي) تنظيم نماييد.
4- كد زير را به رويداد LostFocus مربوط به Text1 اضافه نماييد
کد:

Sub Text1_Lostfocus()
Dim Isec as integer
Isec = val(text1.text)
Break*** = Str$(Int(Isec /60 )) & "Minute" & Str$(Isec Mod 60) & " Second "
text2.text = Breaksec
end sub
5- كنترلي از نوع Label در زير Label1 به Form1 اضافه كنيد . به طور پيش فرض Label2 ايجاد مي شود خصوصيت Caption آن را با عبارت "Time Passed " تنظيم نماييد.
6- در كنار Label2 و در زير Text1 , كنترل ديگري از نوع Text box اضافه كنيد به طور پيش فرض Text2 ايجاد مي شود . خاصيت text آن را به مقدار خالي تنظيم نماييد.
8- هنگام اجراي برنامه كاربردي يك مقداد عددي در Textbox اول وارد كنيد . سپس كليد Tab را براي ريختن آن به دومين textbox فشار دهيد . برنامه عدد وارد شده را به رشته اي تبديل مي كند كه اين رشته متناسب با مقدار دقيقه و ثانيه مي باشد.

فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif Convert to H.M.S.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25980&d=1227997893)

[آبجی]

انتخاب اتوماتيك متن داخل يك Text Box هنگامي كه نقطه تمركز برنامه با زدن كليد TAB به اين كنترل منتقل مي شود.



اين كار با استفاده از تابغ GetKeyState امكان پذير است .

برنامه نمونه

جمله Declare زير را به قسمت معرفيهاي عمومي فرم اضافه نماييد
کد:
Public Declare Function GetKeyState Lib "user32" alias "GetKeyState" (Byval NVirtkey As Long ) As Integer
ثابت زير را نيز در قسمت معرفي هاي عمومي مربوط به Form1 وارد كنيد

‍ کد:
Const VK_TAB = &H9
دو كنترل از نوع textbox بر روي فرم قرار دهيد . Text1 و text2 ايجاد مي شود.
كد زير را در رويداد Load مربوط به Form1 وارد نماييد.
کد:

Sun Form_load()
Text1.text = "Press Tab To Select The Text"
Text2.text = ""
Text2.Text = "This is a Paragraph that should be selected. "
end sub
كد زير را در رويداد GetFocus مربوط به text2 وارد نماييد.
کد:

Sub Text2_Getfocus()
Dim X as integer
X = GetKeyState(Vk_Tab)
If Getkeystate(VK_Tab) and -256 then
text2.setfocus
Text2.selstart = 0
Text2.SelLenght = Len(Text2.text)
end if
End sub
پس از اجراي برنامه نقطه تمركز بر روي Textbox اول است كليد TAB را فشار دهيد تا نقطه تمركز به سمت دومين TEXTBOX حر كت كند . در اين حالت متن درون TEXTBOX دوم به صورت اتوماتيك انتخاب مي شود.

فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif Select Text in Textbox.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25981&d=1227998309)

[آبجی]

استخراح فونتهاي صفحه نمايش و چاپگر



برنامه زير سه كنترل List Box را بر روي يك فرم نمايش مي دهد كه فونتهاي چاپگر در اولي فونتهاي صفحه نمايش در دومي و فونتهاي مشترك دو ويسله در سومي ليست شده اند.

پروژه جديد را آغاز كنيد . بطور پيش فرض Form1 ايجاد مي شود.
سه كنترل از نوع List Bpx و در كنار يكديگر به Form 1 ايجاد مي شود .
براي هر سه ليست باكس خصوصيت Sorted را با True تنظيم كنيد.
كد زير را در رويداد load مربوط به Form1‌ وارد كنيد.
کد:

Sub Form_Load()
Dim X as integer
Dim Y As integer
For x = 0 To Screen.Fontcount -1
For Y = 0 To Printer.Fontcount - 1
if screen.fonts(x) = printer.fonts(y) then
list3.additem Printer.Fonts(y)
end if
Next Y
Next X
For X = 0 to Printer.fontcount - 1
List1.additem Printer.Fonts(X)
next x
For X = 0 To Screen.FontCount - 1
List2.additem Screen.fonts (X)
next X
end sub
فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif Printer and Screent Fonts.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25982&d=1227998814)

[آبجی]

تبديل يك سند Word به فرمت RTF



پرو‍ژها جديدي را ايجاد نماييد . به طور پيش فرض Form1 ايجاد مي شود.
كنترلي از نوع Command Button به فرم اضافه كنيد . Command1 به طور پيش فرض ايجاد مي شود.
كد زير را در رويداد Click كنترل مزبور وارد نماييد.



Private Sub Command1_Click()
dim obj as object
Set obt = CreateObject("Word.Basic")
obg.Fileopen "C:\demo.doc"
Obg.FileSaveass "c:\Demo.rtf", 6
Set Obg= Nothing
msgbox "Document Convertedto Rtf Format"
End Sub
توجه : فرض اين برنامه اين است كه شما يك سند ورد با نام demo.doc را در شاخه اصلي درايو C خود ذخيره كرده ايد .

فايل PDF اين آموزش در ضميمه
فایل های ضمیمه http://barnamenevis.org/forum/images/attach/rar.gif Word2RTF.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25983&d=1227999109)

[آبجی]

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

تابع OpenFile كه از توابع API ويندوز مي باشد روش توانمند و مناسبي را براي مشخص كردن اينكه آيا نام يك فايل يا مسير موجود است يا نه ارائه مي كند.

آرگومانهاي تابع OpenFile

Ipfilename
رشته اي شامل نام ، شامل نام مسيري براي آزمايش باشد يا نباشد.
IpReOpenBuff

يك ساختار OFSTRUCT كه بعد از فراخواني شدن تابع OpenFile حاوي اطلاعاتي در مورد فايل است.
WStyle

اين آرگومان ، تركيبي از يك يا چند پرچم (Flag) بوده و نوع عملياتي كه روي فايل اجرا مي شود را مشخص مي كند.

برنامه نمونه

پرو‍ژه جديدي را ايجاد نماييد.
كد زير را به يك ماژول عمومي (Global module) در پروژه اضافه كنيد :
کد:

Public Type OFSTRUCT
cBytes as byte
fFixeddisk as byte
nErrCode as integer
Reserved1 as integer
Reserved2 as integer
szpathname (OFS_MAXPATHNAME) as byte
end type
const of_exist = &H4000
جمله Declare زير را در قسمت معرفيهاي عمومي مربوط به FORM1 اضافه نماييد :
کد:

Declare Function OpenFile Lip "Kernel32" alias "Openfile" (Byval IpFilename as string, Ip Reopenbuff as OFSTRUCT , Byval Wstyle as long ) as long
جمله DIM زير را نيز به قسمت معرفيهاي عمومي FORM1 وارد كنيد :
کد:

Dim wStyle as integer
Dim Buffer as OFSTRUCT
Dim Isthere as long
Dim TestFile As String
كد زير را در رويداد LOAD مربوط به FORM1 وارد كنيد:
کد:

Sub Form_Load()
TestFile = "C:\TestFile.dat"
Isthere = OpenFile(TestFile, Buffer , Of_EXIST)
if isthere < 0 then
GoTo Checkforerror
else
Debug.print " This File Already Exist"
End if
CheckForError:
isthere = buffer.nerrcode
if isthere = 3 then
debug.print "pathname not foung"
end if
end sub
فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif OpenFile.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25984&d=1227999578)

[آبجی]

پخش فايلهاي Wav در ويژوال بيسيك


اين بخش توضيح مي دهد چگونه يك فايل صوتي شكل موجي (.wav) را در ويژوال بيسيك پخش كنيد.

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

پارامتر هاي تابع

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

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

SND_MEMORY
فايل پخش شده در حافظه ذخيره شده است.

SND_NODEFAULT
اگر فايل مشخص شده پيدا نشد تابع بر مي گردد و صوت پيش فرض پخش مي شود.

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

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

برنامه نمونه
پروژه جديدي را ايجاد نماييد.
جملات Declare و Constant زير را به بخش معرفيهاي عمومي FORM1 اضافه كنيد:
کد:

Private Declare Function SndPlaysound Lib "Winmm.dll" alias "sndplaysoundA" (Byval Ipszsoundnamd as string , Byval uFlags as long )as long

Const SND_SYNC = &H0
Const SND_NODEFAUT = &H2
يك CommandButton به فرم خود اضافه كنيد به طور پيش فرض Command1 ايجاد ميشود .
كد زير را در رويداد Click كنترل Command1 وارد كنيد:
کد:

Private Sub Command1_Click ()
Dim X as Long
X = SndPlaySound(C:\Windows\Media\tada.wave", SND_SYNC Or SND_NODEFAULT )
END SUB
برنامه نمونه را با فشار دادن كليد F5 اجرا كنيد . با كليك روي دكمه فرمان ، فايل TADA.WAV پخش ميشود.

فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif Playwave.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=25985&d=1228000101)

[آبجی]

ايجاد فرم شفاف

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

آرگومانهاي تابع

hWnd
يك مقدار صحيح و در بردارنده دستگيره پنجره مي باشد.

nIndex
مقدار صحيحي است كه نوع اطلاعات مورد تنظيم شما را مشخص مي كند . اين مقدار به يكي از حالتهاي زير مي تواند باشد:
GWL_EXSTYLE قالب پينجره افزوده را تنظيم مي كند
GWL_STYLE قالب پنجره حاظر را تنظيم مي كند
GWL_WNDPROC آدرس كار پنجره را مشخص مي كند

dwNewLong
يك مقدار Long و حاوي بيتهاي قالبي است كه به پنجره داده مي شود


برنامه نمونه
پرو‍ژه جديدي را ايجاد نماييد . خصوصيت Picture آن را به فايل نقش بيتي ARCHES.BMP تنظيم نماييد ( اين فايل معمولا در شاخه ويندوز يافته مي شود .)
يك كنترل CommandButton بر روي فروم ايجاد نماييد . خصوصيت Caption آن را با Show Form تنظيم نماييد
كد زير را در رويداد Click دكمه وارد نماييد
کد:

Private Sub Command1_Click()
Form2.show
Emd Sub
فرم ديگري ايجاد كنيد . به طور پيش فرض FORM2 ايجاد مي شود.

جملات Declare و Constant زير را به قسمت معرفيهاي عمومي فرم اضافه نماييد:
کد:

Declare Function SetWindowLong Lin "User32" alias "SetWindowLongA" ( Byval hwnd as long, Byval nIndex as long, Byval dwNewLong as long) as long
Const WS_EX_TRANSPARENT = &H20&
Const GWL_EXSTYLE = (-20)
كد زير را در رويداد Load مربوط به FORM1 وارد كنيد:
کد:

Private Sub Form_Load()
Dim Ret As Long
Ret = SetWindowLong (Form2.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT)
End Sub
برنامه را فشردن كليد F5 اجرا و روي دكمه SHOW FORM كليك كنيد .

فايل PDF اين آموزش در ضميمه

http://barnamenevis.org/forum/images/attach/rar.gif Trans_Form.rar (http://barnamenevis.org/forum/attachment.php?attachmentid=26023&d=1228077489)

[آبجی]

تعیین این که آیا فرمی بارگذاری شده است یا نه

این برنامه نشان می دهد که چگونه از باز شدن فرمی در یک برنامه کاربردی ویژوال بیسیک مطلع شویم .
1- پروژه جدیدی را در ویژوال بیسیک آغاز کنید . بطور پیش فرض Form1 ایجاد می شود.
2- از منوی Insert گزینه Form را انتخاب کنید . Form2 بطور پیش فرض ایجاد می شود.
3- فرمی را نیز به همین طریق باز نمایید . نام پیش فرض آن Form3 خواهد بود.
4- کد زیر را در رویداد load مربوط به Form1 اضافه کنید
view source
print?

1.Private sub Form_Load()
2.Form2.show
3.End Sub



5- کنترلی از نوع Command Button به فرم اول اضافه کنید . نام پیش فرض آن Command1 خواهد شد .
6- کد زیر را در رویداد کلیک دکمه مذبور وارد نمایید:
view source
print?

01.Private Sub Command1_Click()
02.dim X as integer
03.X = IsFormLoaded(Form1)
04.if X Then
05.msgbox "Form 2 is loader
06.End If
07.
08.X = IsFormLoaded(Form3)
09.if X = false then
10.msgbox "Form3 is not loaded"
11.End If
12.End Sub



7- تابع جدیدی به نام IsFormLoaded و به شرح زیر ایجاد نمایید:
view source
print?

01.Function IsFormLoaded(FormToCheck as form) as integer
02.Dim Y as integer
03.For Y = 0 To Forms.Count -1
04.If Forms(y) is FormToCheck Then
05. IsFormLoaded = true
06.Exit Function
07.End if
08.next
09.IsFormLoaded = False
10.End Function



اگر هنگام اجرا شدن برنامه روی دکمه فرمان کلیک کنید . یک پیغام به صورت بازشو روی صفحه نمایش ظاهر شده و پیغام "Form 2 is Loaded " را نشان خواهد داد. روی دکمه Ok کلیک کنید . بلافاصله پیغام دومی ظاهر و پیغام "Form3 Is not Loaded" را نشان خواهد داد.

[آبجی]

تغییر کلید میانبر یک منو در زمان اجرا

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

1- پروژه جدیدی را در ویژوال بیسیک آغاز کنید . بطور پیش فرض Form1 ایجاد می شود.
2- کد زیر را به قسمت معرفیهای عمومی فرم اضافه کنید :
view source
print?

1.Option Explicit
2.Dim ShortCut as String * 1



3- از منوی Tools روی گزینه Menu Editor کلیک کنید تا یک منوی ساده ایجاد شود . در محل Caoption کلمه : File& و در محل مربوط به نام mnuFile را وارد و روی Ok کلیک کنید تا یک ساختار منویی ایجاد شود . سپس به حالت طراحی ویژوال بیسیک برگردید.

4- کد زیر را در رویداد Load مربوط به Form1 وارد کنید.
view source
print?

1.Private Sub Form_Load()
2.Command1.Caption = "Change ShortCut"
3.KeyPreview = True
4.End Sub



5- کد زیر را هم در رویداد KeyDown فرم اضافه نمایید :
view source
print?

1.Private Sub Form_KeyDown (KeyCode As Integer , Shift As Integer)
2.If Shift And 2 <> 2 Then Exit Sub
3.If Keycode = Asc(ShortCut) Then
4.mnuFile_Click
5.End If
6.End Sub



6- کد زیر را در رویداد Click منوی mnuFile وارد کنید :
view source
print?

1.Private Sub mnuFile_Click()
2.MsgBox "Menu Was Selected"
3.End Sub



7- کنترلی از نوع Command Button به فرم اضافه کنید . Command1 بطور پیش فرض ایجاد می شود . خصوصیت Caption آنرا به Change Item تنظیم نمایید.

8- کد زیر را به رویداد Click این دکمه اضافه کنید :
view source
print?

1.Private Sub Command1_Click()
2.ShortCut = "E"
3.mnuFile.Caption = "Fill" & "&" & LCase$(ShortCut)
4.End Sub



با فشاردادن کلید F5 برنامه را اجرا کنید . به منوی بالای فرم توجه کنید . گزینه منو File"" می باشد که زیر حرف F آن خط کشیده شده است . حرف F ، کلید دستیابی به منوی مزبور می باشد . روی دکمه کلیک کنید . گزینه منوی به File تغییر داده می شود منتهی این بار زیر حرف e آن خط کشیده شده است . کلید ترکیبی Ctrl + E را روی ضفحه فشار دهید . یک کادر پیغام باز می شود که مضمون آن به این صورت است : Menu Was Selected

[آبجی]

تلفن زدن داخل برنامه
مواد لازم
یک عدد:command
خصوصیات-----------------
اجراCaption=

یک عدد:text
خصوصیات-----------------
خالیtext=
این کد ها را در قسمت General وارد کنید.
کد:

Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String,ByVal Comment As String) As Long



()Private Sub Command1_Click
tapiRequestMakeCall Text1.Text, "", "", ""
End Sub

[آبجی]

دادن تم Xp به برنامه
واسه اين كار Notepad رو باز كنين و كد زير رو توش كپي كنيد
کد:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="Name"
type="win32"
/>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>
و بجاي Name در كد بالا نام برنامه تون رو بزارين
فايل را با نام x.exe.MANIFEST ذخيره كنين x همون نام برنامه است
حالا توي VB برين و توي فرم يه ProgressBar بزارين
از برنامه يه نسخه اجرايي بگيرين
حالا كيفش رو ببرين.

[آبجی]

انتقال فایل (MOVE )
کد:

Private Sub Command1_Click()
Name "c:\a.bat" As "D:\h.bat"
End Sub

[آبجی]

کادر باز کردن پوشه (Folder Browse )

در ماوژول :

کد:

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
'***
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
در فرم :
کد:

Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim BrowseInf As BrowseInfo
szTitle = "ÌÓÊÌæí Ú˜Ó"
With BrowseInf
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(BrowseInf)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
'sBuffer value is the directory that the user choose from the dialog.
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text1.Text = sBuffer

End If
End Sub

http://barnamenevis.org/forum/images/statusicon/user_offline.gif http://barnamenevis.org/forum/images/buttons/report.gif (http://barnamenevis.org/forum/report.php?p=865891)

[آبجی]

بازیابی سطر معینی از یک فایل

کد:

Public Function readLine(ByRef strFilePath As String, ByRef nLine _
As Integer) As String

Dim NextLine As String
Dim n As Integer
FileNum = FreeFile
Open strFilePath For Input As FileNum
Do Until EOF(FileNum)
Line Input #FileNum, NextLine
n = n + 1
If n = nLine Then readLine = NextLine
Loop
Close
End Function
Private Sub Command1_Click()

Text1.Text = readLine("d:\a.bat", 3)
End Sub

[آبجی]

پنجره ی غیر قابل حرکت

کد:

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, _
ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const SC_MOVE = &HF010&
Private Const MF_BYCOMMAND = &H0&

Private Sub Command1_Click()
lhSysMenu = GetSystemMenu(Me.hwnd, False)
lRetVal = RemoveMenu(lhSysMenu, SC_MOVE, MF_BYCOMMAND)
End Sub

http://barnamenevis.org/forum/images/statusicon/user_offline.gif http://barnamenevis.org/forum/images/buttons/report.gif (http://barnamenevis.org/forum/report.php?p=869058)

[آبجی]

جستجو با کمک توابع API

کد:

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button, 4 Text Boxes and 1 List Box to your Form.
'At Run-Time, Enter the path that you want to start to search from it to Text1,
'Enter the file pattern to Text2 (like *.* or *.exe), and press the button.
'List1 will be filled with all the matching files, Text3 will display the number of files found,
'And Text4 will display the total size of the files found.
'Insert this code to the module :

Private Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
As Long

Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, _
InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function


'Insert the following code to your form:

Private Function FindFilesAPI(path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
List1.AddItem path & FileName
End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _
& "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function

Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _
" Directories"
Text4.Text = "Size of files found under " & SearchPath & " = " & _
Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub

[آبجی]

ایجاد شاخه

کد:

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@allapi.net
'create the directory 'c:\test\dir\hello\something\apiguide\'
SHCreateDirectoryEx Me.hwnd, "c:\test\dir\hello\something\apiguide\", ByVal 0&
End Sub

[آبجی]

پخش فايل صوتي
راحت ترين روش

كافيه يه Textbox بزارين و دو command Button به صورتي كه دومي كپي اولي باشه و آرايه درست بشه

اين كد ها رو تو جنرال فرمتون كپي كنين
کد:


Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim isPlaying As Boolean
Dim Mp3File As String
Private Sub Command1_Click(Index As Integer)
Mp3File = Chr$(34) + Trim(Text1.Text) + Chr$(34)
Select Case Index
Case 0
mciSendString "open " + Mp3File, 0&, 0&, 0&
mciSendString "play " + Mp3File, "", 0&, 0&
isPlaying = True
Case 1
mciSendString "close " + Mp3File, 0&, 0&, 0&
isPlaying = False
End Select
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Command1(0).Caption = "Start"
Command1(1).Caption = "Stop"
Command2.Caption = "Exit"
End Sub
Private Sub Form_Unload(Cancel As Integer)
If isPlaying = True Then
mciSendString "close " + Mp3File, 0&, 0&, 0&
End If
End Sub


حالا آدرس فايل صوتي رو بنويسين تو Textbox تا واستون اجرا كنه

[آبجی]

و مهم ترین و آخرین نکته درباره ویبی 6 :

http://msdn.microsoft.com/en-us/vbrun/ms788708.aspx