08 張維哲

Visual Basic 學習檔案集
1
學生:張維哲
指導老師:劉玉敏

目錄
第一冊:
P.4 : 圓面積計算
P.5 : 三角形面積計算
P.6 : 使用者登入
P.7 : Back Color 屬性
P.8 : FontSize 縮放
P.9 : 身份確認
P.11 : 腦筋急轉彎
P.12 : 聊天室
P.13 : 成績判斷
P.14 : 判斷是否為學生票價
P.15 : 視力檢測
P.16 : 年齡判斷
P.17 : 觀看及別
P.18 : 身體質量指數計算
P.19 : 棒球吉祥物
P.21 : 生日星座
P.23 : 占卜
P.24 : 三角形圖案
P.25 : 成績統計
P.27 : 記憶大考驗
P.28 : 手機費用
P.29 : 電腦術語大考驗
P.30 : 雨量資料
P.31 : 通訊資料建檔
P.32 : 由小到大重新排序數列
P.33 : 循序搜尋法搜尋資料
P.34 : 二分搜尋法搜尋資料
延伸練習:
2

P.35 : 1+2-3+4+5-6…-99
P.36 : 300 內可被 3 整除的數及總和
4/2 上機考:
P.37 : 兩數間隔 5 的和
P.38 : 計算總和
P.39 : 計算 N 階
P.40 : 產生連續學號
P.41 : 隨機產生一組密碼
P.42 : 重新組合
5/7 程式比賽:
P.43 : 數字轉絕對值
P.44 : 數字轉為千分位
P.45 : 找最大與最小
P.46 : 把 1變成0,把0變成1
第二冊:
P.47 : 計算標準體重
P.48 : 簡易售票系統
P.49 : 計算圓面積
P.50 : 計算可加油公升數
P.51 : 將資料顯示在文字方塊內
P.52 : 讀取循序檔
P.53 : 資料的寫入
P.54 : 文字瀏覽器
3

圓面積計算
( 讓使用者輸入圓的半徑,以計算出圓的面積 )
4
(程式碼)
08\I\ch1\P.30

三角形面積計算
(讓使用者輸入三角形的底和高來寄算他的面積)
(程式碼)
5
08\I\ch2\P.75

使用者登入
(利用 InputBox 函數讓使用者在交談窗中輸入名
字,在用 MsgBox 來顯示)
(程式碼)
6
08\I\ch2\P.76

Back Color 屬性
(當使用者用左鍵點一下的時候底色會從原本的
粉紅轉變成黃色)
(程式碼)
7
08\I\ch3\p.91

FontSize 縮放
(讓使用者在按下放大時可將字體變大,按縮小
時可以變小)
(程式碼)
8
08\I\ch3\P.98

身份確認
(在兩個 LostFocus 事件中,分別寫入帳號及密碼
的程式,若者用者輸入錯誤會傳來錯誤的訊息)
9

(程式碼)
10
08\I\ch3\P.106

腦筋急轉彎
(使用一個標籤來顯示題目,當按下揭曉時,在
另一個標籤下顯示解答)
(程式碼)
11
08\I\ch3\P.109

聊天室
(利用 VB 做出一個單人單聊的聊天室)
(程式碼)
12
08\I\ch3\P.111

成績判斷
(判斷 (Score)是否大於 60,如果事就顯示及格,
否則就顯示不及格)
(程式碼)
13
08\I\ch5\P.135

學生票
(判斷是否為學生,如果是,就以 7 折來計算電
影的票價)
(程式碼)
14
08\I\ch5\P.136

視力檢測
(判斷視力是否介於 0.8~1.2 之間,是的話就顯示
正常,否則就顯示需要矯正)
(程式碼)
15
08\I\ch5\P.139

年齡判斷
(依照出生年次來判斷,你目前的年齡是屬於哪
一階層的)
(程式碼)
16
08\I\ch5\P.143

觀看及別
(依照你現在的年齡,去區分你所能觀看的節目)
(程式碼)
17
08\I\ch5\P.144

BMI 計算
(讓使用者輸入身高與體重,來計算使用者的
BMI 值為多少)
(程式碼)
18
08\I\ch5\P.148

棒球吉祥物
(依使用者輸入的職棒隊名,顯示球隊的吉祥
物,如果球隊名輸入錯誤則會跳出錯誤顯示)
19

(程式碼)
20
08\I\ch5\P.159

星座生日
(利用 Select Case 來判斷所輸入月份,在利用
If-Then-Else 判斷日期,並顯示所屬的星座)
21

(程式碼)
22
08\I\ch5\P.167

占卜
(利用 Rnd 來產生一個隨機的籤,並顯示結果)
(程式碼)
23
08\I\ch5\P.168

三角形圖形
(利用 For-Next,執行 10 次回圈內的程式)
(程式碼)
24
08\I\ch6\P.171

成績統計
(使用者利用 For-Next 輸入 5 個成績,勾選其選
項,,其質將顯示在下方文字方塊中)
25

(程式碼)
26
08\I\ch6\P.178

記憶大考驗
(在 While-wend 敘述在表單產生 5 個隨機數字,
並利用 Timer 讓數字在 3 秒後消失)
27
(程式碼)
08\I\ch6\P.189

手機費用
(利用一維陣列來儲存 1~12 月的手機費用)
(程式碼)
28
08\I\ch7\P.222

電腦術語大考驗
(使用 5 個常見的電腦術語,隨機產生,讓使用
者在清單中點選相對應的英文術語)
29
(程式碼)
08\I\ch7\P.226

雨量資料
(利用一維陣列設計一個可以用來輸入及查詢成
績的程式)
(程式碼) 08\I\ch7\P.232
30

通訊資料建檔
(設計一個可供使用者將個人好友通訊資料建檔
的程式)
(程式碼)
31
08\I\ch7\P.238

由小到大重新排序數列
(程式碼)
Private Sub Command1_Click()
Dim a(4)
a(0) = 20: a(1) = 5: a(2) = 30: a(3) = 40: a(4) = 15
Print "排序前的資料為"
For i = 0 To 4
Print a(i) & Space(3);
Next
For i = 1 To (5 - 1)
For j = 0 To (4 - i)
If a(j) > a(j + 1) Then
temp = a(j)
a(j) = a(j + 1)
a(j + 1) = temp
End If
Next j
Next i
Print: Print: Print "排序後的資料為"
For i = 0 To 4
Print a(i) & Space(3);
Next
End Sub
08\I\ch8\P255
32

利用循序搜尋法搜尋資料「15」
(程式碼)
Private Sub Form_Activate()
Dim a(1 To 5) As Integer
a(1) = 5: a(2) = 30: a(3) = 40: a(4) = 15: a(5) = 10
i = 1
Target = 15
Do
If Target = a(i) Then
Print "找到數值 15"
Exit Do
End If
i = i + 1
If i > 5 Then
Print "找不到數值 15"
Exit Do
End If
Loop
End Sub
33
08\I\ch8\P264

利用二分搜尋法搜尋資料「30」
(程式碼)
Private Sub Form_Activate()
Dim A(1 To 6) As Integer
A(1) = 5: A(2) = 10: A(3) = 15: A(4) = 20: A(5) = 30:
A(6) = 40
Target = 30
L = 1: r = 6: result = "找不到"
While L Target Then
r = M - 1
Else
L = M + 1
End If
End If
Wend
MsgBox result & Target
End Sub
34
08\I\ch8\P267

1+2+3-4+5+6….-99=??
(利用 For-Next,再以 If-Then-Else 判斷其是否為
3 的倍數,若是則減掉)
(程式碼)
35
08\I\延伸\01

300 內可被 3 整除的數及總和
(找出為三的倍數並把數放在 List1.AddItem 裡,
並且加其總和)
(程式碼)
36
08\I\延伸\02

兩數間隔 5 的和
(讓使用者輸入兩個數,並計算其兩數值之間間
隔為5的和)
(程式碼)
37
08\I\exam\01

試計算 1 連續加至 91,增量值為 2,但若為
7 的倍數則不加反減,最後將和輸出
(程式碼)
Private Sub Form_Activate()
Dim i As Integer, s As Long
For i = 1 To 91 Step 2
If i Mod 7 = 0 Then
s = s - i
Else
s = s + i
End If
Next i
MsgBox
"1+3+5-7+9+11+13+15+17+19-21+...-91=" & s, ,
"計算總和"
End Sub
38
08\I\exam\02

計算 N 階
(利用 Do-loop 敘述計算 N 階層)
(程式碼)
39
08\I\exam\03

撰寫一個能於 ListBox 中產生連續學
號之程式
(程式碼)
Private Sub Form_Activate()
For i = 65 To 90
For j = 0 To 9
List1.AddItem Chr(i) & "8912" & j
Next j
Next i
End Sub
40
08\I\exam\04

撰寫能隨機產生一組長度為 6,並為數字、大寫
英文字母、小寫英文字母三者隨機混雜的密碼
(程式碼)
Private Sub Command1_Click()
Dim str1 As String, x, i, n As Integer
Randomize: str1 = ""
For i = 1 To 6
n = Int(Rnd() * 3) + 1
Select Case n
Case 1: x = Int(Rnd() * 10): str1 = str1 & x
Case 2: x = Int(Rnd() * 26) + 65: str1 = str1 & Chr(x)
Case 3: x = Int(Rnd() * 26) + 97: str1 = str1 & Chr(x)
End Select
Next i
Text1 = str1
End Sub
41
08\I\exam\05

撰寫一個能將使用者輸入的字串,採先取出
偶數字位元,再取出奇數位字元之順序,將
之重新組合的程式
(程式碼)
Private Sub Form_Activate()
Dim x As String, i As Integer, s As String
x = InputBox("請輸入字串", "重新組合字串")
For i = 2 To Len(x) Step 2
s = s + Mid(x, i, 1)
Next i
For i = 1 To Len(x) Step 2
s = s + Mid(x, i, 1)
Next i
MsgBox x & "重新組合為:" & s, , "重新組合字串"
End Sub
42
08\I\exam\06

數字轉絕對值
(程式碼)
Private Sub Command1_Click()
x = InputBox("請輸入一值", "絕對值")
If Mid(x, 1, 1) = "-" Then x = Right(x, Len(x) - 1)
MsgBox x, , "Result"
End Sub
43
08\I\程式比賽\02

數字轉為千分位
(程式碼)
Private Sub Command1_Click()
x = InputBox("輸入一數字", "三位一撇輸出")
str1 = "": y = 0
For i = Len(x) To 1 Step -1
str1 = Mid(x, i, 1) + str1
y = y + 1
If i > 1 And y Mod 3 = 0 Then str1 = "," +
str1
Next i
MsgBox str1, , "The Result"
End Sub
44
08\I\程式比賽\03

找最大和最小
(讓使用者輸入 3 個任意數,讓程式判斷其最大
質與最小值,並將結果輸出)
45
(程式碼)
08\I\程式比賽\04

把1變成0,把0變成1
(程式碼)
Private Sub Command1_Click()
n = Val(InputBox("請輸入 0 或 1", "輸入"))
n = n - 1
MsgBox Abs(n), , "The Result"
End Sub
Private Sub Command2_Click()
n = Val(InputBox("請輸入 0 或 1", "輸入"))
x = 3 Mod (n + 2)
MsgBox x, , "The Result"
End Sub
Private Sub Command3_Click()
n = Val(InputBox("請輸入 0 或 1", "輸入"))
If n = 1 Then
n = 0
ElseIf n = 0 Then
n = 1
End If
MsgBox n, , "The Result"
End Sub
08\I\程式比賽\06
46

計算標準體重
Sub Cal_sw(S_sex As String, S_ht As Single)
Dim sw As Single, swt As Single
If S_sex = "M" Then
sw = (S_ht - 80) * 0.7
Else
sw = (S_ht - 70) * 0.6
End If
MsgBox "您的標準體重為" & sw, , "計算標準體重"
swt = InputBox("請輸入體重(kg)", "判斷是否過重")
If swt > sw Then
MsgBox "您的體重超出標準體重", , "判斷是否過重"
Else
MsgBox "您的體重未超出標準體重", , "判斷是否過重
End If
End Sub
Private Sub Form_Activate()
Dim ht As Single, sex As String * 1
sex = InputBox("請輸入性別,男生輸入 M,女生輸
入 F", "計算標準體重")
ht = InputBox("請輸入身高(cm):", "計算標準體重")
Call Cal_sw(sex, ht)
End Sub
08\II\ch9\P12
47

Sub cal_price(i As
Integer, j As Integer)
Dim price As Integer,
sum As Integer
Dim area As String
price = 600
Select Case i
Case 0, 2
area = "搖滾 A/C 區"
price = price * 2.5
Case 1
area = "搖滾 B 區"
price = price * 3
Case 3, 5
area = "看台 A/C 區"
price = price * 1.5
Case 4
area = "看台 B 區"
price = price * 2
End Select
簡易售票系統
(程式碼)
48
If j >= 10 Then
sum = j * price * 0.9
Else
sum = j * price
End If
Label3.Caption = j & "張
" & area & "票,總計" &
sum & "元"
End Sub
Private Sub
Command1_Click(Index
As Integer)
Dim count As Integer
count = InputBox("
請輸入所要購買的票數
", "購買票數")
Call cal_price(Index,
count)
End Sub
08\II\ch9\P15

計算圓面積
(程式碼)
Function cal_circle(r As Single) As Single
Const pi = 3.14159
cal_circle = r ^ 2 * pi
End Function
Private Sub Form_Activate()
Dim x As Single
Dim area As Single
x = InputBox("請輸入圓的半徑:", "計算圓面積
")
area = cal_circle(x)
MsgBox "半徑為" & x & "的圓面積 = " & area, ,
"計算圓面積"
End Sub
49
08\II\ch9\P25

計算可加油公升數
Private Sub
Command1_Click()
Dim F_oil As
Integer, F_c As Integer
Dim ml As String
Foil = Combo1.ListIndex
F_c = Int(Text1.Text)
ml = bml(F_oil, F_c)
End Sub
Private Sub Form_Load()
Combo1.AddItem "柴油
"
Combo1.AddItem "92 無
鉛汽油"
Combo1.AddItem "95 無
鉛汽油"
Combo1.AddItem "98 無
鉛汽油"
End Sub
Function bml(F_oil As
(程式碼)
50
Integer, F_c As Integer)
As Integer
Dim money As
Single
Dim tatle As Single
Select Case F_oil
Case 0
money = 18.5
Case 1
money = 23.2
Case 2
money = 23.9
Case 3
money = 25.4
End Select
total = F_c / money
Label4.Caption = "可加"
& Format(total, " #0.## ")
& "公升"
End Function
08\II\ch9\P 35

設計一循序檔並將資料顯示在文字方塊內
(程式碼)
Private Sub Command1_Click()
Dim x As String
Open App.Path & "\data1.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, x
Text1.Text = Text1.Text & x & vbCrLf
Loop
Close
End Sub
Private Sub Command2_Click()
End
End Sub
51
08\II\ch12\P156-1

設計讀取循序檔並將資料顯示在
各欄位文字方塊內
Private Sub
Command1_Click()
Open App.Path &
"\data2.txt" For Input As #1
Command1.Enabled = False
Command2.Enabled = True
If Not EOF(1) Then
Input #1, nam, price, q
Text1.Text = nam
Text2.Text = price
Text3.Text = q
total = price * q
Text4.Text = total
End If
End Sub
Private Sub
Command2_Click()
If Not EOF(1) Then
Input #1, nam, price, q
(程式碼)
52
Text1.Text = nam
Text2.Text = price
Text3.Text = q
total = price * q
Text4.Text = total
Else
Close #1
Command1.Enabled =
True
Command2.Enabled =
False
End If
End Sub
Private Sub
Command3_Click()
Close #1
End
End Sub
08\II\ch12\P156-2

資料的寫入(Put # 敘述)
Private Sub
Command1_Click()
Static i As Integer
i = LOF(file_no) /
Len(student)
i = i + 1
student.no = Text1(0).Text
student.name =
Text1(1).Text
student.score =
Val(Text1(2).Text)
Put file_no, i, student
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Text1(0).SetFocus
End Sub
Private Sub
Command2_Click()
Dim j As Integer
(程式碼)
53
Do While j LOF(file_no)
/ Len(student)
j = j + 1
Text1(0).Text = student.no
Text1(1).Text =
student.name
Text1(2).Text =
student.score
MsgBox "第" & j & "筆資
料", , "檢視紀錄內容"
Loop
End Sub
Private Sub
Form_Activate()
file_no = FreeFile
Open App.Path & "\ran" For
Random As #file_no Len =
Len(student)
End Sub
08\II\ch12\P164

Private Sub
Dir1_Change()
File1.path = Dir1.path
End Sub
Private Sub
Drive1_Change()
Dir1.path = drivel.Drive
End Sub
Private Sub File1_Click()
Dim path As String
Dim aline As String
Dim alldata As String
Dim file_no As Integer
If Right(File1.path, 1)
"\" Then
path = File1.path & "\" &
File1.FileName
文字瀏覽器
(程式碼)
54
Else
path = File1.path &
File1.FileName
End If
file_no = FreeFile
Open path For Input As
#file_no
Do While Not EOF(1)
Line Input #file_no,
aline
alldata = alldata &
aline & vbCrLf
Loop
Text1.Text = alldata
Close #file_no
End Sub
08\II\ch12\P183