Một số chương trình thường gặp trong lập trình Visual Basic 6.0

Bài : Viết chương trình tính tổng T = + + … + N, với N số ngun ≥ 0, N=0 T=0 Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim n As Integer Dim i As Integer Dim kq As Integer 'lay gia tri cho n' n = Val(TXTN.Text) kq = 'kiem tra so n nhap vao' If n = Then 'neu n = thi xuat ket qua tong la: 0' kq = Else 'neu n # 0, dung vong lap cong cac gia tri chay tu den n' For i = To n kq = kq + i Next i End If 'xuat ket qua o textbox' txtkq.Text = kq End Sub Bài : Viết chương trình tính tổng T = - + 3- + … (-1)N+1N, với N số ngun ≥ 0, N=0 T=0 Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim n As Integer Dim i As Integer Dim kq As Integer 'gan gia tri cho N' n = (txtn.Text) kq = 'kiem tra N' If n = Then 'neu N = thi gan kq=0 va ket thuc chung trinh'' kq = Else 'nguoc lai n #0 thi lam buoc tinh tiep' 'co the dung vong lap for voi buoc nhay la (step 2) de tinh' 'vong for de tinh tong cac so le tu den n' For i = To n Step kq = kq + i Next i 'vong for tinh hieu cac so chan tu den n' For i = To n Step kq = kq - i Next i End If 'xuat kq o textbox' txtkq.Text = kq End Sub Bài : Viết chương trình nhập số ngun dương có chữ số, viết hình dạng: trăm, chục, đơn vị Ví dụ, nhập vào số : 246, kết cho : Trăm chục Đơn vị Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim n As Integer Dim tr As Integer Dim ch As Integer Dim dv As Integer n = Val(txtn.Text) 'kiem tra n la so co chu so' If n > 99 And n < 1000 Then tr = n \ 100 'lay gia tri chia nguyen cua n cho 100 ta duoc hang tram' ch = (n - tr * 100) \ 10 hang chuc' 'n-tr*100 ta duoc chu so cuoi, lay so chi nguyen cho 10 ta duoc dv = n - tr * 100 - ch * 10 Else 'dua thong bao so n khong phai la so co chu so bang msgbox' MsgBox ("so " & Str(n) & " khong phai la so co chu so" & vbCrLf & "ban hay nhap lai") End If txttram.Text = tr txtchuc.Text = ch txtdv.Text = dv End Sub Private Sub Command1_Click() txta.Text = "" lblkq.Caption = "" txta.SetFocus End Sub Private Sub Command2_Click() End End Sub Bài : Viết chương trình cho phép nhập vào số kiểm tra số có phải số ngun tố hay khơng Giao diện tự thiết kế cho phù hợp Private Sub Command3_Click() Dim a, i 'kiem tra so a, so khong la so ng.to, la so ng.to, so nguyen to la so chi chia het cho va chinh no' a = txta.Text If a = Then lblkq.Caption = "so khong phai la so nguyen to" End If If a = Then lblkq.Caption = "so la so nguyen to" End If If a > Then i=a Do i=i-1 Loop Until a Mod i = If i > Then lblkq.Caption = "so" & Str(a) & " khong phai la so nguyen to" Else lblkq.Caption = "so" & Str(a) & " la so nguyen to" End If End If End Sub Bài : Viết chương trình nhập số tìm số lớn ba số số Giao diện tự thiết kế cho phù hợp Private Sub Command1_Click() Dim a As Integer Dim b As Integer Dim c As Integer Dim max As Integer a = Val(txt1.Text) b = Val(txt2.Text) c = Val(txt3.Text) max = a 'kiem tra max da la so lon nhat chua' If b > max Then max = b If c > max Then max = c txtkq.Text = max End Sub Bài : Viết chương trình cho phép nhập vào (quy định trước) : số hạng đầu tiên, cơng bội cấp số nhân, giao diện tự thiết kế cho phù hợp Cho phép người dùng tìm : a Số hạng b Tổng n số hạng Dim a As Integer Dim d As Integer Private Sub Command1_Click() Dim n As Integer Dim kq As Integer a = Val(txta.Text) d = Val(txtcb.Text) n = Val(txtson.Text) kq = a * (d ^ (n - 1)) 'cong thuc tinh so hang thu n' txtsohang.Text = kq End Sub Private Sub Command2_Click() Dim m As Integer Dim kq As Integer a = Val(txta.Text) d = Val(txtcb.Text) m = txtm.Text 'co the dung cong thuc hoac dung vong lap for de tinh tong nay' kq = For i = To m kq = kq + a * d ^ (i - 1) 'cong thuc tinh tong n so hang dau cua CSN a*((1-d^(n+1))/(1-d))' Next i txtkq.Text = kq txtkq.Text = kq End Sub Bài : Viết chương trình cho phép nhập vào số a b, giao diện tự thiết kế cho phù hợp Tìm a USCLN b Tìm in phân số tối giản a/b (ví dụ a= 6, b = 12 in : a/b = ¾) Dim a, b, c, i, d Public Sub Command1_Click() Dim d As Integer a = Val(txta.Text) b = Val(txtb.Text) 'uoc chung la so lon nhat ma so co the chia het => uoc chung phai nho hon hoac bang so nho nhat so' If b < a Then c=b d=a Else c=a d=b End If i=c Do i=i-1 Loop Until a Mod i = And b Mod i = txtkq.Text = i End Sub Private Sub Command2_Click() 'tim phan so toi gian' txtkq.Text = Str(a / i) & "/" & Str(b / i) End Sub Private Sub Command3_Click() End End Sub Private Sub Command4_Click() txta.Text = "" txtb.Text = "" txtkq.Text = "" txta.SetFocus End Sub Bài : Viết chương cho phép nhập vào mảng A gồm phần tử, thực u cầu sau ( Giao diện tự thiết kế cho phù hợp, tham khảo giao diện bên dưới): Tính tổng mảng Tính giá trị lớn Tính giá trị nhỏ Đếm số lần xuất x (với x nhập từ bàn phím) Dim A(4) As Integer Dim x As Double Private Sub Nhapmang() 'nhap mang, lay tu mang da nhap vao cac o nho' Dim i As Integer For i = To A(i) = Val(Txta(i).Text) Next End Sub Private Function tongmang() As Double 'tinh tong mang' Dim i As Integer Dim Tong As Double Tong = A(0) For i = To Tong = Tong + A(i) Next tongmang = Tong End Function Private Function maxmang() As Double 'tim gia tri lon nhat cua mang' Dim i As Integer Dim max As Double max = A(0) For i = To If max < A(i) Then max = A(i) Next maxmang = max End Function Private Function minmang() As Double 'tim gia tri nho nhat cua mang' Dim i As Integer Dim As Double = A(0) For i = To If > A(i) Then = A(i) Next minmang = End Function Private Function solan() As Double 'dem so lan xuat hien cu so nhap tu ban phim' Dim i As Integer For i = To If x = A(i) Then solan = solan + Next End Function Private Sub Chkpt_Click(Index As Integer) 'neu click vao o dem thi xuat hien mot o de nhap so can dem vao' If (Index = 3) And (Chkpt(3).Value = 1) Then x = InputBox("x = ", "") End Sub Private Sub Cmdtinh_Click() 'xuat ket qua msgbox' Dim s As String Nhapmang For i = To If Chkpt(i).Value = Then Select Case i Case s = "tong = " & tongmang & vbCrLf Case s = s & "max = " & maxmang & vbCrLf Case s = s & "min = " & minmang & vbCrLf Case s = s & "solan = " & solan End Select Dim tg As Integer Dim so As String Dim t Dim bc As Integer Dim uc As Integer Dim k As Integer Dim d As Integer 'in mang nguoc lai' n = "" For i = 10 To Step -1 n = n & " " & Str(a(i)) Next i ' ' 'tim cac so nguyen duong chia het cho 2' m = "" For i = To 10 If a(i) > And a(i) Mod = Then m = m & " " & Str(a(i)) End If Next i If m = "" Then m = "khong co so nao chia het cho 2" ' .' 'tim max' max = a(1) For i = To 10 If a(i) > max Then max = a(i) Next i ' .' 'tim min' = a(1) For i = To 10 If a(i) < Then = a(i) Next i ' ' 'tim so nguyen to' so = "'" For d = To max If d = Then so = so End If If d = Then so = so & " " & Str(2) End If If d > Then i=d Do i=i-1 Loop Until d Mod i = If i > Then so = so Else so = so & " " & Str(d) End If End If Next d ' ' 'tinh max!' t=1 For i = To max t=t*i Next i ' ' 'tim bcll va ucnn cua max va min' i = uc = If = Then uc = Else Do i=i-1 Loop Until Mod i = And max Mod i = uc = i End If If i = Then bc = * max Else bc = * (max / uc) End If ' ' 'dua ket qua man hinh' MsgBox ("mang nguoc voi mang da cho: " & n & vbCrLf & "cac so nguyen chi het cho 2: " & m & vbCrLf & "max la: " & Str(max)) & vbCrLf & "min la: " & Str(min) & vbCrLf & "cac so nguyen to la: " & so & vbCrLf & "max! la: " & Str(t) & vbCrLf & "uoc chung lon nhat la: " & Str(uc) & vbCrLf & "boi chung nho nhat la: " & Str(bc) End Sub Bài 19 : Viết chương trình giải phương trình bậc 2: ax2 + bx + c =0 Với u cầu giao diện sau - Cho phép nhập trực tiếp giá trị a, b, c Cho phép thay đổi giá trị a, b, c (ngun) cuộn In kết giải tương ứng với tất trường hợp Private Sub Cmdgiai_Click() Dim a As Long Dim b As Long Dim d Dim c As Long Dim X Dim Y Dim kl As String a = Val(txta.Text) b = Val(txtb.Text) c = Val(txtc.Text) 'kiem tra cac he so a,b,c If a = And b = And c = Then kl = "p.tr có vô số nghiệm" ElseIf a = And b = And c Then kl = "p.tr vô nghiệm" ElseIf a = o And b Then 'neu a=0 thi ta co phuong trinh bac nhat kl = "p.tr có nghiệm nhất" X = -c / b Y="" d="" End If ' neu a#0 thi ta co phuong trinh bac hai If a Then d = Val(b * b - * a * c) 'tinh delta txtd.Text = d 'kiem tra dieu kien cua delta If d > Then X = (-b - Sqr(d)) / (2 * a) Y = (-b + Sqr(d)) / (2 * a) kl = "p.tr có hai nghiệm phân biêt" ElseIf d = Then X = (-b) / (2 * a) Y=X kl = "p.tr có nghiệm kép" Else X="" Y="" kl = "vô nghiệm" End If End If 'dua kq man hinh txtx.Text = X txty.Text = Y txtkl.Text = kl End Sub Private Sub Cmdend_Click() End 'cau lenh cho nut ket thuc End Sub Private Sub Command1_Click() 'cau lech cho nut nhap lai txta.Text = txtb.Text = txtc.Text = txtd.Text = "" txtkl.Text = "" txtx.Text = "" txty.Text = "" txta.SetFocus End Sub Private Sub txta_Change() ' kiem tra xem a co phai la so khong, neu khong phai thi thong bao loi If Not IsNumeric(txta.Text) Then MsgBox ("ban phai nhap vao mot so") txta.Text = txta.SetFocus End If End Sub Private Sub txtb_Change() 'kiem tra b cho phai la so khong, neu khong phai thi thong bao loi If Not IsNumeric(txtb.Text) Then MsgBox ("ban phai nhap vao mot so, hay nhap lai") txtb.Text = txtb.SetFocus End If End Sub Private Sub txtc_Change() 'kiem tra xem c co phai la so khong, neu khong phai thi thong bao loi If Not IsNumeric(txtc.Text) Then MsgBox ("ban phai nhap vao mot so") txtc.Text = txtc.SetFocus End If End Sub Private Sub vsla_Change() txta.Text = vsla.Value 'lay gia tri cho a tu cuon End Sub Private Sub vslb_Change() txtb.Text = vslb.Value 'lay gia tri cho b tu cuon End Sub Private Sub vslc_Change() txtc.Text = vslc.Value 'lay gia tri cho c tu cuon End Sub Bài 21 : Viết chương trình nhập vào số ngun a, b, Giao diện tự thiết kế cho phù hợp : a Tính tổng số khoảng từ a tới b b Tính tổng số lẻ khoảng từ a tới b Tính tổng số chẵn khoảng từ a tới b Private Sub cmdtinh_Click() Dim a As Integer Dim b As Integer Dim t As Integer Dim ch As Integer Dim le As Integer Dim i As Integer Dim k As Integer Dim j As Integer a = Val(txta.Text) b = Val(txtb.Text) k=a j=b 'kiem tra so a va b so nao lon hon If b < k Then k=b j=a Else k=a j=b End If ' ' t=0 ch = le = For i = k To j t = t + i 'tinh tong tu so nho den so lon If i Mod = Then ch = ch + i 'neu so chia het cho thi gan tong so chan bang so chan cong them so i Else le = le + i 'nguoc lai thi no la so le End If Next i MsgBox ("tong cac so tu " & Str(k) & " den " & Str(j) & " la: " & Str(t) & vbCrLf & "tong cac so chan tu " & Str(k) & " den " & Str(j) & " la: " & Str(ch) & vbCrLf & "tong cac so le tu " & Str(k) & " den " & Str(j) & " la: " & Str(le)) End Sub Bài 22 : Viết chương trình quản lý cơng ty với u cầu: • Họ tên nhân viên nhập vào textbox Ho ten • Chức vụ nhân viên chọn combox Chuc vu • Mỗi chức vụ nhân viên chọn mức lương tương ứng xuất textbox Luong • Khi nhấn nút Nhap, nhân viên nhập vào ListBox Danh sach nhan vien • Xố nhân viên chọn danh sách nút, Xoa Chọn Multiselect= • Tong: tổng lương danh sách Được cập nhật danh sách có thay đổi Private Sub cmdend_Click() End End Sub Private Sub cmdnhap_Click() Static t 'su dung khai bao static cho bien t de bien t co the su dung gia tri cua no cho toikho nao ket thuc chuong trinh, keo dai thoi gian ton tai cua bien t nhieu hon so voi khai bao dim txtluong.Text = (cmbcv.ItemData(cmbcv.ListIndex)) 'thay doi tien luong lua chon chuc vu listen.AddItem (txtten.Text) 'them ten moi vao lisbox listen.ItemData(listen.NewIndex) = cmbcv.ItemData(cmbcv.ListIndex) 'lay gia tri luong cho nguoi moi nhap vao t = t + Val(listen.ItemData(listen.NewIndex)) 'tinh tong luong bang tong luong da co cong voi luong cua nguoi moi them vao txttong.Text = t End Sub Private Sub cmdxoa_Click() 'xoa mot doi tuong lisbox nhan vien txttong.Text = Val(txttong.Text) - Val(listen.ItemData(listen.ListIndex)) 'tong luong se giam di bot mot nguoi khoi lisbox listen.RemoveItem (listen.ListIndex) 'xoa nhan vien khoi lisbox 'chu y: cau lenh tren khong the doi cho nhu: txttong.te o duoi cau lenh listen , doi lai chung trinh se khong chay duoc 'vi neu doi lai thi ten nhan vien se bi mat khoi danh sach nhan vien nen khong on luu lai luong cua nhan vien do, nen khong the tinh tong lluong lai duoc End Sub Bài 23 : Viết chương trình phân tích số ngun dương nhập vào thừa số ngun tố Giao diện tự thiết kế cho phù hợp Private Sub cmdphantich_Click() Dim i As Long, j As Long, n As Long, s As String, u As String n = Val(txtnhap.Text) u = txtnhap.Text s=n&"=" j=2 Do While n > For i = j To n If n Mod i = Then s=s&i n=n/i j=i Exit For 'den day neu n khong chia het cho i nua thi ket thuc vong lap bang lenh exit for End If Next i If n > Then s = s & " x " Loop txtkq.Text = s End Sub Private Sub txtnhap_Change() 'kiem tra nhap vao co phai la so duong hay khong If IsNumeric(txtnhap.Text) = flase Then MsgBox ("ban phai nhap vao so duong' ban hay nhap lai") txtnhap.Text = txtnhap.SetFocus ElseIf Val(txtnhap.Text) [...]... Sub Private Sub vslc_Change() txtc.Text = vslc.Value 'lay gia tri cho c tu thanh cuon End Sub Bài 21 : Viết chương trình nhập vào 2 số ngun a, b, Giao diện tự thiết kế cho phù hợp : a Tính tổng các số trong khoảng từ a tới b b Tính tổng các số lẻ trong khoảng từ a tới b Tính tổng các số chẵn trong khoảng từ a tới b Private Sub cmdtinh_Click() Dim a As Integer Dim b As Integer Dim t As Integer Dim ch... : Viết chương trình nhập vào một câu có khơng q 50 ký tự Giao diện tự thiết kế cho phù hợp a Đếm xem trong câu có bao nhiêu ký tự là số b Tính tổng các chữ số trong câu Private Sub cmddem_Click() Dim a As String Dim n As Integer Dim i As Integer Dim b As String Dim dem As Integer Dim t As Integer a = txtnhap.Text n = Len(a) dem = 0 t=0 For i = 1 To n b = Mid(a, i, 1) 'lay lan luot tung ki tu trong chuoi'... j txtkq.Text = kq End Sub Bài 27 : Viết chương trình đổi một số nhị phân cho trước (nhập vào) sang hệ thập phân Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim a As String Dim t As Integer Dim i As Integer a = txtnhap.Text t=0 For i = 1 To Len(a) t = t * 2 + Val(Mid(a, i, 1)) Next i txtkq.Text = t End Sub Bài 28 : Viết chương trình đổi một số bát phân cho trước (nhập vào) sang hệ... deu bang 0' dem = dem + 1 t = t + Val(b) End If Next i 'in kq ra hop thong bao msgbox' MsgBox ( "trong cau da nhap co: " & Str(dem) & " ki tu so" & vbCrLf & "tong cac ki tu so trong cau la: " & Str(t)) End Sub Bài 14 : Viết chương trình nhập vào một câu, đếm xem trong câu có bao nhiêu chữ hoa, bao nhiêu chữ thường Giao diện tự thiết kế cho phù hợp Private Sub cmddem_Click() Dim a As String Dim n As Integer... " & Str(le)) End Sub Bài 22 : Viết chương trình quản lý một cơng ty với u cầu: • Họ tên nhân viên được nhập vào textbox Ho ten • Chức vụ nhân viên được chọn trong combox Chuc vu • Mỗi khi chức vụ nhân viên được chọn mức lương tương ứng xuất hiện ở textbox Luong • Khi nhấn nút Nhap, nhân viên mới được nhập vào ListBox Danh sach nhan vien • Xố một nhân viên được chọn trong danh sách bằng nút, Xoa Chọn... Viết chương trình đổi một số ngun dương nhập vào ở hệ thập phân sang hệ bát phân Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim a As Integer Dim t As String Dim kq As String Dim i As Integer a = Val(txtnhap.Text) t = "" Do t = t & Str(a Mod 8) a=a\8 Loop Until a = 0 kq = "" For i = Len(t) To 1 Step -1 kq = kq & Mid(t, i, 1) Next i txtkq.Text = kq End Sub Bài 26 : Viết chương trình. .. = thuong + 1 End If Next i lblkq.Caption = "trong cau co: " & Str(hoa) & " ki tu la chu in hoa" & vbCrLf & "trong cau co: " & Str(thuong) & " ki tu thuong" End Sub 'su dung ham UCASE(b) de doi ki tu thuong ra ki tu hoa neu khi doi ra b va ucase(b) bang nhau thi b la ki tu in hoa nguoc lai la chu thuong' Bài 15 : Viết chương trình nhập vào một câu, tìm xem trong câu vừa nhập có chứa chuỗi “em” khơng,... MsgBox ("cau da nhap khong co tu EM, ban hay nhap lai") 'dung ham tim kiem va thay the relace(a, s1, s1) tim trong chuoi a co chuoi s1 thi thay tat ca s1 thanh s2' n = Replace(a, "em", "anh") txtkq.Text = n End Sub Bài 16 : viết chương trình nhập vào một câu bất kỳ, in lại câu đó với mỗi từ trên một dòng Giao diện tự thiết kế cho phù hợp Private Sub cmdtinh_Click() Dim a As String Dim n As String a =... doi lai thi ten nhan vien do se bi mat khoi danh sach nhan vien nen khong on luu lai luong cua nhan vien do, nen khong the tinh tong lluong lai duoc End Sub Bài 23 : Viết chương trình phân tích một số ngun dương nhập vào ra các thừa số ngun tố của nó Giao diện tự thiết kế cho phù hợp Private Sub cmdphantich_Click() Dim i As Long, j As Long, n As Long, s As String, u As String n = Val(txtnhap.Text) u... nhap vao so duong' ban hay nhap lai") txtnhap.Text = 1 txtnhap.SetFocus ElseIf Val(txtnhap.Text)