موتور جست و جو با حذف و اضافه كردن و خالي كردن ليست ها و غيره كه مي توانيد نحوه ي جست و جو كردن يه متن يا رشته را در ويژوال بيسيك دريابيد. به شما پيشنهاد مي كنم حتماٌ دانلود كنيد.

Search Engine

 اين برنامه را از اينجا دانلود كنيد.

نظر شما درباره برنامه چيه ؟

خالی کردن تمامی کادرهای متن(Text Box) روی یک فرم

حتما تا کنون بارها صفحات وبی را با چندین فیلد متنی، مثل فرمی برای سفارش آنلاین دیده اید.  

این فرم ها اغلب یک دکمه Clear یا Reset دارند که متنی را که در تک تک فیلدها وجود دارد پاک می کند و شما می توانید دوباره از ابتدا شروع به پر کردن آنها کنید. می توانید همانند این کار را برای فرم های Visual Basucانجام دهید، یعنی همه کنترلهای TextBox روی فرم را خالی کنید تا داده های جدید در آنها وارد شود.

برای انجام این کار، از کلکسیون Controls فرم استفاده کنید. این کلکسیون بازای هر کنترلی که روی فرم قرار دارد، یک عنصر دارد. با چرخیدن در این کلکسیون و با استفاده از کلمه کلیدی TypeOf می توان نوع هر کدام از این کنترلها رامشخص کرد. اگر کنترل Text Box بود، متن آنرا پاک کرد و چنانچه Text Box نبود آنرا نادیده گرفت. در زیر یک روال برای خالی کردن تمامی کنترلهای TextBox روی فرم آمده است: 

Private Sub Command1_Click()
Dim StrControl As Control

For Each StrControl In Controls
   If TypeOf StrControl Is TextBox Then
      StrControl.Text = Empty
   End If
Next
End Sub
 

در ضمن می توانید این تکنیک را به سایر کنترلها نیز بسط دهید. برای مثال کد زیر تمامی کنترلهای Check Box روی فرم را خالی می کند(تیکشان را بر می دارد):

Dim StrControl As Control

For Each StrControl In Controls
  If TypeOf StrControl Is CheckBox Then
    StrControl.Value = False
  End If

اگر متصل باشد تابع مقدار 1 و در غیر این صورت مقدار 0 را بر می گرداند.

دیگه صرف نکرد که سورس اونو واسه دانلود بزارم . این کدها رو تو فرمتون قرار بدید.

Const NETWORK_ALIVE_AOL = &H4
Const NETWORK_ALIVE_LAN = &H1
Const NETWORK_ALIVE_WAN = &H2
Private Declare Function IsNetworkAlive Lib "SENSAPI.DLL" (ByRef lpdwFlags As Long) As Long

Private Sub Command1_Click()
Dim CRes As Long
If IsNetworkAlive(CResult) = 0 Then
MsgBox "Not Connected", vbInformation, "http://homecode.blogfa.com/"
Else
MsgBox "Connected To the Internet", vbInformation, "www.http://homecode.blogfa.com"
End If
End Sub

و یکی دکمه هم روی فرمتون بگذارید که هر وقت روی اون کلیک کردین بهتون بگه متصل است یا نه !!!
 

1- برنامه ای بنویسید که یک نمره را دریافت و بر اساس جدول رتبه بندی نماید.

Dim a As Single

a = Val(Text1.Text)

If a > 20 Or a < 0 Then

Text1 = "Error in number"

Exit Sub

End If

Select Case a

Case Is >= 18

MsgBox "A"

Case Is >= 16

MsgBox "B"

Case Is >= 14

MsgBox "C"

Case Is >= 12

MsgBox "D"

Case Is >= 10

MsgBox "E"

Case Else

MsgBox "F"

End Select

End Sub

2- با دستور If تساوی سه عدد را بررسی کنید.

Private Sub Command1_Click()

Dim a As Integer, b As Integer, c As Integer

a = InputBox("Enter 1st num")

b = InputBox("Enter 2nd num")

c = InputBox("Enter 3rd num")

If a = b And a = c Then

MsgBox "All numbers is equal"

Else: MsgBox "All numbers is not equal"

End If

End Sub

3- برنامه ای بنویسید که سه عدد دریافت و بزرگترین مقدار بین آنها را محاسبه نماید.

Private Sub Command2_Click()

Dim a As Integer, b As Integer, c As Integer, max As Integer

a = InputBox("Enter 1st num")

b = InputBox("Enter 2nd num")

c = InputBox("Enter 3rd num")

max = IIf(a > b, a, b)

max = IIf(c > max, c, max)

MsgBox max

End Sub

4- عددی را به عنوان ثانیه دریافت کرده و ساعت، دقیقه و ثانیه معادل آن را چاپ کند.

Private Sub Command3_Click()

Dim s As Integer, m As Integer, h As Integer

s = InputBox("Enter seconds")

h = s \ 3600

m = (s Mod 3600) \ 60

s = (s Mod 3600) Mod 60

MsgBox h & ":" & m & ":" & s

End Sub

5- سه عدد از ورودی دریافت، تعیین کند که آیا می توان با این سه عدد یک مثلث

قائم الزاویه تشکیل داد یا خیر.

Private Sub Command4_Click()

Dim a As Integer, b As Integer, c As Integer

a = InputBox("Enter 1st num") ^ 2

b = InputBox("Enter 2nd num") ^ 2

c = InputBox("Enter 3rd num") ^ 2

If a + b = c Or a + c = b Or b + c = a Then

MsgBox "YES"

Else: MsgBox "NO"

End If

End Sub

6- پنج عدد از ورودی گرفته و میانگین آنها را به همراه 5 عدد چاپ نماید.

7- چهار عدد دریافت و کوچکترین عدد را چاپ نماید.

Private Sub Command5_Click()

Dim a As Integer, b As Integer, c As Integer, d As Integer, min As Integer

a = InputBox("Enter 1st num")

b = InputBox("Enter 2nd num")

min = IIf(a > b, b, a)

c = InputBox("Enter 3rd num")

d = InputBox("Enter 4th num")

min = IIf(min > c, IIf(c > d, d, min), IIf(min > d, d, min))

MsgBox min

End Sub

8- ضرایب معادله درجه 2 را بگیرد و رشته های آن را روی فرم چاپ کند.

Private Sub Command6_Click()

Dim a!, b!, c!, x!, x2!, delta!

a = InputBox(Prompt:="Enter a", Default:=4)         'InputBox("Enter a", , 4)

b = InputBox(Prompt:="Enter b", Default:=5)         'InputBox("Enter b", , 5)

c = InputBox(Prompt:="Enter c", Default:=1.5625)    'InputBox("Enter c", , 1.5625)

delta = b ^ 2 - 4 * a * c

Select Case delta

Case Is < 0

MsgBox "There are no solutions"

Case 0

x = -b / 2 * a

MsgBox "There is one solution: " & x

Case Is > 0

x = (-b + Sqr(delta)) / (2 * a)

x2 = (-b - Sqr(delta)) / (2 * a)

MsgBox "There is two solutions: " & x & " and " & x2

End Select

End Sub

9- چهار عدد را خوانده آنها را به صورت نزولی چاپ نماید.

Private Sub Command7_Click()

Cls

Dim a As Integer, b As Integer, c As Integer, d As Integer

a = InputBox("Enter 1st num")

b = InputBox("Enter 2nd num")

c = InputBox("Enter 3rd num")

d = InputBox("Enter 4th num")

If a < b Then a = a + b: b = a - b: a = a - b

If a < c Then a = a + c: c = a - c: a = a - c

If a < d Then a = a + d: d = a - d: a = a - d

If b < c Then b = b + c: c = b - c: b = b - c

If b < d Then b = b + d: d = b - d: b = b - d

If c < d Then c = c + d: d = c - d: c = c - d

Print a; b; c; d

End Sub

10- 5 عدد را خوانده و مجموع بزرگتیرن و کوچکترین آنها را محاسبه و چاپ نماید.

Private Sub Command8_Click()

Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer, min As Integer, max As Integer

n1 = InputBox("Enter 1st num")

n2 = InputBox("Enter 2nd num")

n3 = InputBox("Enter 3rd num")

n4 = InputBox("Enter 4th num")

n5 = InputBox("Enter 5th num")

max = n1

min = n1

If max < n2 Then max = n2

If max < n3 Then max = n3

If max < n4 Then max = n4

If max < n5 Then max = n5

If min > n2 Then min = n2

If min > n3 Then min = n3

If min > n4 Then min = n4

If min > n5 Then min = n5

MsgBox "Max: " & max & " Min: " & min

End Sub

11- سه عدد خوانده و دو عدد کوچکتر را جمع نموده از عدد بزرگتر کم کرده و چاپ نماید.

Private Sub Command9_Click()

Dim a As Integer, b As Integer, c As Integer, max As Integer

a = InputBox("Enter 1st num”)

b = InputBox("Enter 2nd num”)

c = InputBox("Enter 3rd num”)

max = IIf(a > b, IIf(a > c, a, c), IIf(b > c, b, c))

Print max - (a + b + c - max) 'maximum - sum of others

End Sub

12- مقدار X را خوانده و بر اساس مقادیر زیرy را محاسبه کرده و نمایش دهد.

 
 
          5 + 2x          x > 0 

Y =    5                  x = 0

          5 – 2x          x < 0

13- شعاع یک کره را خوانده ، مساحت و حجم آنها را محاسبه و نمایش دهد.

Private Sub Command10_Click() '13

Const PI! = 3.1415

Dim v!, s!, r!

r = InputBox("Enter radius")

v = 4 / 3 * PI * r ^ 3

s = 4 * PI * r ^ 2

MsgBox "Volume: " & v & " Surface: " & s & " Radius: " & r

End Sub

14- برنامه ای که 20 عدد را خوانده و مجموع آن ها را محاسبه و چاپ نماید.

Private Sub Command11_Click()

Dim i As Integer, s As Integer

For i = 1 To 20

s = s + InputBox("Enter a num")

Next

MsgBox s

End Sub

15- یک عدد بزرگتر از صفر را خوانده و سپس به تعداد آنها، (یعنی آن عدد) اعداد دیگری را خوانده و مجموع و میانگین را نمایش دهد.

Private Sub Command12_Click()

Dim a!, n As Integer, s As Integer, i As Integer

n = InputBox("Enter number of numers")

For i = 1 To n

s = s + InputBox("Enter a num")

Next

a = s / n

MsgBox "Sum: " & s & " Average: " & a

End Sub

16- ده عدد را گرفته تعیین کند کدام زوج و کدام فرد است.

Private Sub Command13_Click() '16

Cls

Dim i As Integer, n As Integer

For i = 1 To 10

n = InputBox("Enter the num")

Print n; Tab(10); IIf(n Mod 2 = 0, "Even", "Odd")

Next

End Sub

17- مجموع اعداد زوج و فرد 0 تا 100 را محاسبه کرده و جداگانه چاپ کند.

Private Sub Command14_Click()

Dim i As Integer, s As Integer

For i = 0 To 100 Step 2

s = s + i

Next

MsgBox Prompt:=s, Title:="Events"

s = 0

For i = 1 To 100 Step 2

s = s + i

Next

MsgBox Prompt:=s, Title:="Odds"

End Sub

18- 20 عدد را خوانده، بزرگترین و کوچکترین آنها را نمایش دهد.

Private Sub Command15_Click()

Dim min As Integer, max As Integer, n As Integer, i As Integer

For i = 1 To 20

n = InputBox("Enter a num")

If i = 1 Then min = n

If n > max Then max = n

If n < min Then min = n

Next

MsgBox "Max: " & max & " Min: " & min

End Sub

19- برنامه ای بنویسید که عدد چها رقمی فاقد صفر را به همراه تعداد کل آنها نمایش دهد.

Private Sub Command16_Click()

Cls

Dim i As Integer, b As Boolean, t As Integer, c As Integer

For i = 10 To 99

b = True

t = i

Do While t > 0 And b

If t Mod 10 = 0 Then b = False

t = t \ 10

Loop

If b Then

c = c + 1

Print i;

If c Mod 20 = 0 Then Print

End If

Next

MsgBox "Total: " & c

End Sub

20- برنامه ای بنویسید که برای 5 دانش آموز نمره ی پایان ترم، میان ترم، و نمره 3 تکلیف آنها را خوانده، بر اساس 20% تکلیف ، 30 % میان ترم ، 50% پایان ترم ، نمره ی نهایی هذ دانش آموز را محاسبه و نمایش دهد.

21- برنامه ای بنویسید که نمرات (0 تا 20) ، 10 دانش آموز را خوانده و موارد خواسته شده زیر را نمایش دهد.

- معدل کل دانش آموزان

- تعداد دانش آموزان با نمره ی کمتر از 10

- تعداد دانش آموزان با نمره ی از 10 تا 12

- بیشترین معدل

- کمترین معدل

- تعداد افراد بالای 17

Private Sub Command17_Click() '21

Cls

Dim n!, ave!, sum!, min!, max!, u1 As Integer, u2 As Integer, u3 As Integer, i As Integer

For i = 1 To 20

n = InputBox("Enter the mark " & i)

If i = 1 Then min = n

sum = sum + n

If n > max Then max = n

If n < min Then min = n

Select Case n

Case 0 To 9.99

u1 = u1 + 1

Case 10 To 12

u2 = u2 + 1

Case 17.01 To 20

u3 = u3 + 1

End Select

Next

Print "Mean: " & (sum / 20)

Print "Maximum: " & max

Print "Minimum: " & min

Print "Upper than 17: "; u3

Print "10 to 12: "; u2

Print "Under 10: "; u1

End Sub

22- برنامه ای بنویسید که یک عدد را خوانده، اول بودن آن را تعیین نماید و پیغام مناسبی چاپ کند.

Private Sub Command6_Click()

Cls

Dim i As Integer, n As Integer, t As Boolean

n = InputBox("Enter a num:")

t = True

i = 2

Do While i <= n / 2 And t

If n Mod i = 0 Then t = False

i = i + 1

Loop

If t Then

Print "Prim"

Else: Print "not prim"

End If

End sub

 ۲۳-برنامه ای بنویسید که یک عدد را گرفته و فاکتوریل آن را محاسبه و چاپ کند.

Private Sub Command19_Click()

Dim i As Integer, f&

f = 1

For i = 1 To InputBox("Enter a number to reach its single factorial:")

f = f * i

Next

MsgBox f

End Sub

24- برنامه ای بنویسید که برای اعداد 1 تا 10 مجموع اعداد از یک تا آن عدد را نمایش دهد.

Private Sub Command20_Click()

Cls

Dim i As Integer, j As Integer, s As Integer

For i = 1 To 10

s = 0

For j = 1 To i

s = s + j

Next

Print s;

Next

End Sub

25- برنامه ای بنویسید که عدد N را خوانده و مجموع ارقام آن را نشان دهد.

Private Sub Command21_Click() '25

Dim n As Integer, s As Integer

n = InputBox("Enter the num:")

While n > 0

s = s + n Mod 10

n = n \ 10

Wend

MsgBox s

End Sub

26- برنامه ای بنویسید که یک عدد حد اقل چهارقمی مثبت را خوانده، مغلوب آن را نمایش دهد.

Private Sub Command22_Click()

Cls

Dim n As Integer, i As Integer

n = InputBox("Enter the num:")

While n > 0

i = n Mod 10

Print CStr(i);

n = n \ 10

Wend

End Sub

27- برنامه ای بنویسید که یک عدد صحیح مثبت را خوانده جذر آن را نمایش دهد.

Private Sub Command23_Click()

Cls

Dim n As Integer, i As Integer, s As Integer, c As Integer

n = InputBox("Enter a natural number to get its square root (without sqr() function)")

i = 1

While s < n

s = s + i

i = i + 2

c = c + 1

Wend

If s > n Then

Print "Near "; (s / c) - 1

Else: Print "Really "; s / c

End If

'Or use n ^ 0.5 equation

End Sub

28- برنامه ای بنویسید که 20 جمله اول سری فیبوناچی را نمایش دهد.

Private Sub Command24_Click()

Cls

Dim a As Integer, b As Integer, c As Integer, i As Integer

a = 1

For i = 1 To InputBox("Enter number of fibonacci series you want to make", , 20)

c = a + b

Print c

a = b

b = c

Next

End Sub

29- برنامه ای بنویسید که دو عدد صحیح از ورودی خوانده و عمل ضرب را بدون استفاده از عملگر ضرب محاسبه و نمایش دهد.

Private Sub Command25_Click()

Dim a As Integer, b As Integer, i As Integer, m As Integer

a = InputBox("Enter first num")

b = InputBox("Enter second num")

For i = 1 To b

m = m + a

Next

MsgBox a & " * " & b & " = " & m

End Sub

30- برنامه ای بنویسید که رشته ای را از ورودی دریافت کرده و تعداد حروف بزرگ و کوچک آن را نمایش دهد بصورت مجزا.

Private Sub Command1_Click()

Cls

Dim s As String

s = InputBox("")

For i = 1 To Len(s)

Select Case Mid(s, i, 1)

Case "A" To "Z"

u = u + 1

Case "a" To "z"

l = l + 1

End Select

Next

Print "horuf kuchak"; l

Print "horufe bozorg"; u

End Sub