لينكدوني(پيوند هاي روزانه)

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

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

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

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

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

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