程式設計學習單

2017年3月5日星期日

丙檢第一站

-------------------------------原始程式---------------------------------

-------------------------------執行結果---------------------------------

2017年1月7日星期六

小考奇數偶數卷

'P1-全班平均
'開
'輸入
FileOpen(1, "P1.in", OpenMode.Input)
Dim ans = ""
Dim no() As String
Dim chi(), eng(), mat(), ttlc, ttle, ttlm As Integer
Dim cnt = -1
Do While Not EOF(1)
cnt += 1
'動態宣告
ReDim Preserve no(cnt), chi(cnt), eng(cnt), mat(cnt)
Input(1, no(cnt)) : Input(1, chi(cnt)) : Input(1, eng(cnt)) : Input(1, mat(cnt))
Loop
'關
FileClose()
'處理
For i = 0 To cnt
ttlc += chi(i)
ttle += eng(i)
ttlm += mat(i)
Next
'輸出
'(平均)
Dim avgc, avge, avgm As Single
avgc = ttlc / (cnt + 1)
avge = ttle / (cnt + 1)
avgm = ttlm / (cnt + 1)
For i = 0 To cnt
ans &= no(i) & "," & chi(i) & "," & eng(i) & "," & mat(i) & vbNewLine
Next
ans &= "," & Format(avgc, "##0.0") & "," & Format(avge, "##0.0") & "," & Format(avgm, "##0.0")
Me.TextBox1.Text = ans
My.Computer.FileSystem.WriteAllText("P1-1.out", ans, False)

'P1
'輸入
'開
FileOpen(1, "P1.in", OpenMode.Input)
Dim ans, no As String
Dim chi, eng, mat As Integer
Do While Not EOF(1)
Input(1, no) : Input(1, chi) : Input(1, eng) : Input(1, mat)
Dim avg As Single
avg = chi + eng + mat
ans &= no & "," & Format(avg, "##0.0") → 要寫在裡面
✩ans &= If(EOF(1), "", vbNewLine) → 不可多一行
Loop
'關
FileClose()

Me.TextBox2.Text = ans
My.Computer.FileSystem.WriteAllText("P1.out", ans, False)

'P2
'開
'輸入
FileOpen(1, "P2.in", OpenMode.Input)
Dim ans = ""
Dim n As String
Do Until EOF(1)
Input(1, n)
ans &= Bin(n)
ans &= If(EOF(1), "", vbNewLine)
Loop

'關
FileClose()

'輸出
Me.TextBox3.Text = ans
My.Computer.FileSystem.WriteAllText("P2.out", ans, False)

'P3
'開
'輸入
FileOpen(1, "P3.in", OpenMode.Input)
Dim ans = ""
Dim s As String
Do Until EOF(1)
Input(1, s)
Loop
'關
FileClose()
'處理
Dim i As Integer
For i = 1 To s
For j = 1 To i
ans &= i
Next
ans &= If(i = s, "", vbNewLine)
Next
'輸出
Me.TextBox4.Text = ans
My.Computer.FileSystem.WriteAllText("P3.out", ans, False)

'P4
'輸入
Dim ans = ""
Dim a, b As Integer
a = InputBox("a = ", "P4.求最小公倍數lcm", 0)
b = InputBox("b = ", "P4.求最小公倍數lcm", 0)
ans &= lcm(a, b)
'輸出
Me.TextBox5.Text = ans

'P5
'開
'輸入
FileOpen(1, "P5.in", OpenMode.Input)
Dim ans = ""
Dim a, b As Integer
Do While Not EOF(1)
Input(1, a) : Input(1, b)
ans &= lcm(a, b)
ans &= If(EOF(1), "", vbNewLine)
Loop

'關
FileClose()
'處理
'輸出
Me.TextBox6.Text = ans
My.Computer.FileSystem.WriteAllText("P5.out", ans, False)

'Q1
'開
'輸入
FileOpen(1, "Q1.in", OpenMode.Input)
Dim ans = ""
Dim s As String
Do Until EOF(1)
Input(1, s)
Loop
'關
FileClose()
'處理
Dim i As Integer
For i = 1 To s
For j = 1 To i
ans &= j
Next
ans &= If(i = s, "", vbNewLine)
Next
'輸出
Me.TextBox9.Text = ans
My.Computer.FileSystem.WriteAllText("Q1.out", ans, False)

'Q2
'開
'輸入
FileOpen(1, "Q2.in", OpenMode.Input)
Dim ans = ""
Dim n As String
Do Until EOF(1)
Input(1, n)
ans &= Quo(n)
ans &= If(EOF(1), "", vbNewLine)
Loop

'關
FileClose()
'輸出
Me.TextBox10.Text = ans
My.Computer.FileSystem.WriteAllText("Q2.out", ans, False)

'Q3
'輸入
Dim ans = ""
Dim a, b As Integer
a = InputBox("a = ", "Ｑ3.求GCD1", 0)
b = InputBox("b = ", "Ｑ3.求GCD1", 0)
ans &= GCD1(a, b)
'輸出
Me.TextBox8.Text = ans

'Q4
'開
'輸入
FileOpen(1, "Q4.in", OpenMode.Input)
Dim ans = ""
Dim a, b As Integer
Do While Not EOF(1)
Input(1, a) : Input(1, b)
ans &= GCD1(a, b)
ans &= If(EOF(1), "", vbNewLine)
Loop

'關
FileClose()
'處理
'輸出
Me.TextBox7.Text = ans
My.Computer.FileSystem.WriteAllText("Q4.out", ans, False)

'Q5
'輸入
'開
FileOpen(1, "Q5.in", OpenMode.Input)
Dim ans, no As String
Dim chi, eng, mat As Integer
Do While Not EOF(1)
Input(1, no) : Input(1, chi) : Input(1, eng) : Input(1, mat)
Dim avg As Single
avg = (chi + eng + mat) / 3
ans &= no & "," & Format(avg, "##0.0")
ans &= If(EOF(1), "", vbNewLine)
Loop
'關
FileClose()

Me.TextBox11.Text = ans
My.Computer.FileSystem.WriteAllText("Q5.out", ans, False)

~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~
Function Bin(n)
If n < 2 Then
Return n
Else
Return Bin(n \ 2) & (n Mod 2)
End If
End Function
'GCD
Function GCD(a, b)
If b = 0 Then
Return a
Else
Return GCD(b, a Mod b)
End If
End Function
'lcm
Function lcm(a, b)
Return a * b / GCD(a, b)
End Function
Function Quo(n)
If n < 4 Then
Return n
Else
Return Quo(n \ 4) & (n Mod 4)
End If
End Function
'GCD1
Function GCD1(a, b)
If b = 0 Then
Return a
Else
Return GCD1(b, a Mod b)
End If
~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~

1230

'a001
'開檔
FileOpen(1, "a001.in", OpenMode.Input)
'輸入
'處理
Dim s, ans As String
Do Until EOF(1) '一直做到檔尾
Input(1, s) '讀一筆
ans &= "hello, " & s & If(EOF(1), "", vbNewLine)
Loop
'關檔
FileClose() '全關
'輸出
Me.TextBox1.Text = ans
My.Computer.FileSystem.WriteAllText("a001.out", ans, False)

'A7. 讀入第 A1 題的輸入檔(A1.in),由大到小排序後,依序將「奇數」輸出到輸出檔(A7.out)。
'開檔
FileOpen(1, "A1.in", OpenMode.Input)
'輸入
'處理
Dim ans = ""
Dim d() As Integer '動態宣告
Dim cnt = -1 '計數器
Do Until EOF(1)
cnt += 1
ReDim Preserve d(cnt) '調整資料大小
Input(1, d(cnt))
Loop
'關檔
FileClose()
Array.Sort(d)
Array.Reverse(d) '反轉
For i = 0 To UBound(d)
ans &= If(d(i) Mod 2 <> 0, d(i) & vbNewLine, "")
Next
'輸出
Me.TextBox2.Text = ans
My.Computer.FileSystem.WriteAllText("A7.out", ans, False)

'A5. 讀入學生成績檔(A5.csv, 不只一筆),計算所有學生的數學平均、計概平均。
'開檔
FileOpen(1, "A5.csv", OpenMode.Input)
'表頭
'輸入
Dim tt1, tt2, tt3, tt4
Input(1, tt1) : Input(1, tt2) : Input(1, tt3) : Input(1, tt4)
Dim no(1000) As String '座號
Dim d(1000, 2) As Single '成績
Dim cnt = -1
Do While Not EOF(1)
cnt += 1
Input(1, no(cnt)) : Input(1, d(cnt, 0)) : Input(1, d(cnt, 1)) : Input(1, d(cnt, 2))
Loop
'關檔
FileClose()
'處理
Dim mathttl As Single = 0, bccttl As Double = 0
For i = 0 To cnt
bccttl += d(i, 0)
mathttl += d(i, 2)
Next
Dim ans = "數學平均,計概平均" & vbNewLine
ans &= Format(mathttl / (cnt + 1), "#0.0") & "," & Format(bccttl / (cnt + 1), "#0.0")
Me.TextBox3.Text = ans
My.Computer.FileSystem.WriteAllText("A5-out.csv", ans, False)

'A4. 利用廻圈控制指令,由輸入檔(A4.in,只有一筆)讀入整數數字,列印從 1 開始直到該數字為止之直角三角形。
'開檔
FileOpen(1, "A4.in", OpenMode.Input)
'輸入
'處理
Dim s As String
Dim ans = ""
Do Until EOF(1)
Input(1, s)
Loop
Dim j As Integer
For j = 1 To s
For i = 1 To j
ans &= i
Next
ans &= vbNewLine
Next
'關檔
FileClose()
'輸出
Me.TextBox4.Text = ans

'A2. 數字轉地支
'開檔
FileOpen(1, "A2.in", OpenMode.Input)
'輸入
'處理
Dim s As String
Dim ans = ""
Do Until EOF(1)
Input(1, s)
ans &= D2Di(s)
Loop
'關檔
FileClose()
'輸出
Me.TextBox5.Text = ans

'B1. 利用廻圈控制指令,由輸入檔(B1.in,只有一筆)讀入整數數字,列印從 1 開始直到該數字為止之直角三角形。
'開檔
FileOpen(1, "B1.in", OpenMode.Input)
'輸入
'處理
Dim s As String
Dim ans = ""
Do Until EOF(1)
Input(1, s)
Loop
Dim j As Integer
For j = 1 To s
For i = 1 To j
ans &= i
Next
ans &= vbNewLine
Next
'關檔
FileClose()
'輸出
Me.TextBox7.Text = ans

'B3. 數字轉天干
'開檔
FileOpen(1, "B3.in", OpenMode.Input)
'處理
Dim s As String
Dim ans = ""
Do Until EOF(1)
Input(1, s)
ans &= D2Ten(s)
Loop
'關檔
FileClose()
'輸出
Me.TextBox6.Text = ans

'A3. 算術運算+檔案
'開檔
FileOpen(1, "A3.in", OpenMode.Input)
'輸入

Dim ans = ""
Dim a(), b() As Integer '動態宣告
Dim cnt = -1 '計數器
Do Until EOF(1)
cnt += 1
ReDim Preserve a(cnt)
ReDim Preserve b(cnt)
Input(1, a(cnt))
Input(1, b(cnt))
Loop
'處理
For i = 0 To UBound(a)
ans &= a(i) \ b(i) & ", " & Math.Abs(a(i) - b(i)) & If(i = UBound(b), "", vbNewLine)
Next
'關檔
FileClose()
'輸出
Me.TextBox8.Text = ans
My.Computer.FileSystem.WriteAllText("A3.out", ans, False)

'A1. 讀入輸入檔(A1.in,內容為 1 至 13 之間的整數若干筆),計算各數字出現的次數。
'開檔
FileOpen(1, "A1.in", OpenMode.Input)
'輸入
Dim ans = ""
Dim a(), b() As Integer '動態宣告
Dim cnt = -1 '計數器
Do Until EOF(1)
cnt += 1
ReDim Preserve a(cnt)
ReDim Preserve b(cnt)
Input(1, a(cnt))
Loop
'處理
For Each p In a '陣列
b(p) += 1
Next
'關檔
FileClose()
'輸出
ans &= RSet("數字", 2) & " " & "次數" & vbNewLine
For i = 1 To 13
ans &= RSet(i, 2) & " " & b(i) & vbNewLine
Next
Me.TextBox9.Text = ans

~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~
'查表
Function D2Di(s)
Dim c() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
Dim ans = ""
'轉地支
For i = 1 To Len(s)
ans &= c(Val(Mid(s, i, 1)))
Next
Return ans
End Function
'查表
Function D2Ten(s)
Dim c() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
Dim ans = ""
'轉天干
For i = 1 To Len(s)
ans &= c(Val(Mid(s, i, 1)))

Next
Return ans
End Function

~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~

1223

'p37.數字轉國字大寫
'輸入
Dim s As String ' = InputBox("數字 = ", "數字轉國字大寫", 0)
Try
s = My.Computer.FileSystem.ReadAllText("p37.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'處理依序剪下每個字元查表轉換
'拆成列
Dim row = Split(s, vbNewLine)
Dim ans = ""
For j = 0 To UBound(row)
ans &= D2C(row(j))
ans &= If(j = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox1.Text = ans

'a001
'讀入資料
Dim fc As String
Try
fc = My.Computer.FileSystem.ReadAllText("a001.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'資料字串拆成列
Dim row = Split(fc, vbNewLine)
'處理
Dim ans = ""
'For Each i In row
'ans &= "hello, " & i & vbNewLine
'Next
For i = 0 To UBound(row)
ans &= "hello, " & row(i) & If(i = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox2.Text = ans
My.Computer.FileSystem.WriteAllText("a001.out", ans, False)

'A3. 算術運算+檔案
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("A3.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
Dim data
For j = 0 To UBound(row)
data = Split(row(j), ",")
Dim a, b As Integer
a = data(0)
b = data(1)
ans &= a \ b & ", " & Math.Abs(a - b) & If(j = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox3.Text = ans
My.Computer.FileSystem.WriteAllText("A3.out", ans, False)

'A2. 數字轉地支
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("A2.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
For j = 0 To UBound(row)
ans &= D2Di(row(j))
ans &= If(j = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox4.Text = ans

'A1
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("A1.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim a(13)
For Each p In row '陣列
a(p) += 1
Next
'輸出
Dim ans = RSet("數字", 2) & " " & "次數" & vbNewLine
For i = 1 To 13
ans &= RSet(i, 2) & " " & a(i) & vbNewLine
Next
Me.TextBox5.Text = ans

'B1
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("B1.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
Dim j As Integer
For j = 1 To s
For i = 1 To j
ans &= i
Next
ans &= vbNewLine
Next
'輸出
Me.TextBox6.Text = ans

'B2
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("B2.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
Dim data
For j = 0 To UBound(row)
data = Split(row(j), ",")
Dim a, b As Integer
a = data(0)
b = data(1)
ans &= a \ b & ", " & a Mod b & If(j = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox7.Text = ans
My.Computer.FileSystem.WriteAllText("B2.out", ans, False)

'B3 數字轉天干
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("B3.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
For j = 0 To UBound(row)
ans &= D2Ten(row(j))
ans &= If(j = UBound(row), "", vbNewLine)
Next
'輸出
Me.TextBox9.Text = ans

'B6
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("B6.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim a(6)
For Each p In row '陣列
a(p) += 1
Next
'輸出
Dim ans = RSet("數字", 2) & " " & "次數" & vbNewLine
For i = 1 To 6
ans &= RSet(i, 2) & " " & a(i) & vbNewLine
Next
Me.TextBox8.Text = ans

'A4
'輸入
Dim s As String
Try
s = My.Computer.FileSystem.ReadAllText("A4.in")
Catch ex As Exception
MsgBox(ex.Message)
End Try
'拆成列
Dim row = Split(s, vbNewLine)
'處理
Dim ans = ""
Dim j As Integer
For j = 1 To s
For i = 1 To j
ans &= i
Next
ans &= vbNewLine
Next
'輸出
Me.TextBox10.Text = ans

~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~

'查表陣列
Function D2C(s)
Dim c() = {"零", "壹", "貳", "參", "肆", "伍", "陸", "柒", "捌", "玖"}
Dim ans = ""
'轉國字
For i = 1 To Len(s)
ans &= c(Val(Mid(s, i, 1)))
Next
Return ans
End Function
'查表
Function D2Di(s)
Dim c() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
Dim ans = ""
'轉地支
For i = 1 To Len(s)
ans &= c(Val(Mid(s, i, 1)))
Next
Return ans
End Function
'查表
Function D2Ten(s)
Dim c() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
Dim ans = ""
'轉天干
For i = 1 To Len(s)
ans &= c(Val(Mid(s, i, 1)))
Next
Return ans
End Function

~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~

2016年12月17日星期六

1216

Public Class Form1
Dim n As Long = 1000
'p80. (遞迴定義)將一個 10 進位的數字換成 n 進位數字(2<=n<=36)。
Dim D, N As Integer
D = InputBox("D = ", "p80. (遞迴定義)將一個 10 進位的數字換成 n 進位數字(2<=n<=36)。", 1)
N = InputBox("N = ", "p80. (遞迴定義)將一個 10 進位的數字換成 n 進位數字(2<=n<=36)。", 1)
Me.TextBox1.Text = D & " = ( " & D2N(D, N) & " )" & N

'Bubble Sort
'產生 1000 data
Dim a(n - 1) As Integer
For i = 0 To UBound(a)
a(i) = Int(Rnd() * 101) '0~100
Next
'Dump a
'排序前
Me.TextBox2.Text = Dump(a)
'Bubble sort
'BubbleSort(a)
Array.Sort(a)

'排序後
Me.TextBox3.Text = Dump(a)
End Sub

'擲骰子100次,計算各點出現次數
Randomize()
Dim a(99) As Integer
For i = 0 To UBound(a)
a(i) = Int(Rnd() * 6) + 1
Next
'計算各點出現次數
Dim s(6)
For Each p In a
s(p) += 1
Next
'印出結果
Dim ans = RSet("點數", 2) & " " & "次數" & vbNewLine
For i = 1 To 6
ans &= RSet(i, 2) & " " & StrDup(s(i), "#") & " " & s(i) & vbNewLine
Next
Me.TextBox4.Text = ans

'丟銅板100次,計算正反出現次數
Randomize()
Dim a(99) As Integer
For i = 0 To UBound(a)
a(i) = Int(Rnd() * 2)
Next
'計算正反出現次數
Dim s(2)
For Each p In a
s(p) += 1
Next
'印出結果
Dim ans = RSet("銅板正反", 2) & " " & "次數" & vbNewLine
For i = 0 To 1
ans &= RSet(i, 2) & " " & StrDup(s(i), "#") & " " & s(i) & vbNewLine
Next
Me.TextBox5.Text = ans

'發牌(1-13)100次,計算各數字出現次數
Randomize()
Dim a(99) As Integer
For i = 0 To UBound(a)
a(i) = Int(Rnd() * 13) + 1
Next
'計算各數字出現次數
Dim s(13)
For Each p In a
s(p) += 1
Next
'印出結果
Dim ans = RSet("數字", 2) & " " & "次數" & vbNewLine
For i = 1 To 13
ans &= RSet(i, 2) & " " & StrDup(s(i), "#") & " " & s(i) & vbNewLine
Next
Me.TextBox6.Text = ans

Module _1110534013
Dim c = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" '字串的查表
Function D2N(D, N)
If N > 36 Or N < 2 Then
Return "error"
ElseIf D < N Then
Return Mid(c, D + 1, 1)
Else
Return D2N(D \ N, N) & Mid(c, (D Mod N) + 1, 1)
End If
End Function
'swap 交換
Sub swap(ByRef x, ByRef y)

Dim t = x
x = y
y = t
End Sub
'Dump array value
Function Dump(a)
Dim ans = ""
For Each p In a
ans &= p & " "
Next
Return ans
End Function
'Bubble sort
Sub BubbleSort(a)
For i = 1 To UBound(a) 'pass 回合
For j = 0 To UBound(a) - i
If a(j) > a(j + 1) Then swap(a(j), a(j + 1))
Next
Next

2016年12月10日星期六

1209

'Q1：己知正整數 n ，求 1+2+3+...+ n 之和
Dim n As Integer
n = InputBox("n = ", "Q1：己知正整數 n ，求 1+2+3+...+ n 之和", 1)
Me.TextBox1.Text = "1 + " & "... +" & n & " = " & sum(n)

'Q1：sumOdd(n)
'奇數
Dim n As Integer
n = InputBox("n = ", "Q1：sumOdd(n)", 1)
n = If(n Mod 2 = 0, n - 1, n)
Me.TextBox2.Text = "從 1 " & "加奇數到 " & n & " = " & sumOdd(n)

'Q1：sumEven(n)
'偶數
Dim n As Integer
n = InputBox("n = ", "Q1：sumEven(n)", 1)
n = If(n Mod 2 = 0, n, n - 1)
Me.TextBox3.Text = "從 1 " & "加偶數到 " & n & " = " & sumEven(n)

'Q2：己知正整數 n ，求 n!
Dim n As Integer
n = InputBox("n = ", "Q2：己知正整數 n ，求 n!", 1)
Me.TextBox4.Text = "1 x " & " ... x " & n & " = " & fac(n)

'Q3: 求兩個正整數 a, b 的最大公因數
Dim a, b As Integer
a = InputBox("a = ", "Q3: 求兩個正整數 a, b 的最大公因數", 1)
b = InputBox("b = ", "Q3: 求兩個正整數 a, b 的最大公因數", 1)
Me.TextBox5.Text = a & " 和 " & b & " 的最大公因數 = " & GCD(a, b)

'Q3: lcm
Dim a, b As Integer
a = InputBox("a = ", "Q3: 求兩個正整數 a, b 的最小公倍數", 1)
b = InputBox("b = ", "Q3: 求兩個正整數 a, b 的最小公倍數", 1)
Me.TextBox6.Text = a & " 和 " & b & " 的最小公倍數 = " & lcm(a, b)

'Q4: 月兔問題與費氏數列
Dim n As Integer
Dim ans = ""
n = InputBox("n = ", "Q4: 月兔問題與費氏數列", 1)
For i = 0 To n
ans &= Fib(i) & If(i <> n, ",", "")
Next
Me.TextBox7.Text = "總對數費氏數列：" & ans

'Q5: 十進位數值轉二進位字串
Dim n As Integer
n = InputBox("n = ", "Q5: 十進位數值轉二進位字串", 0)
Me.TextBox8.Text = n & " 從十進位轉二進位 = " & "(" & Bin(n) & ")" & "2"

'Q5: Quad(n)
Dim n As Integer
n = InputBox("n = ", "Q5: Quad(n)", 0)
Me.TextBox9.Text = n & " 從十進位轉四進位 = " & "(" & Quad(n) & ")" & "4"

Module _1110534013
'Q1：己知正整數 n ，求 1+2+3+...+ n 之和
'recursive 遞迴函數
Function sum(n)
If n <= 1 Then
Return n
Else
Return sum(n - 1) + n
End If
End Function

'Q1：sumOdd(n)
Function sumOdd(n)
If n <= 1 Then
Return n
Else
Return sumOdd(n - 2) + n
End If
End Function

'Q1：sumEven(n)
Function sumEven(n)
If n <= 1 Then
Return n
Else
Return sumEven(n - 2) + n
End If
End Function

'Q2：己知正整數 n ，求 n!
Function fac(n)
If n <= 1 Then
Return n
Else
Return fac(n - 1) * n
End If
End Function

'Q3: 求兩個正整數 a, b 的最大公因數
Function GCD(a, b)
If b = 0 Then
Return a
Else
Return GCD(b, a Mod b)
End If
End Function

✩ 'Q3: lcm
Function lcm(ByVal a,ByVal b)
If b = 0 Then
Return a
Else
Return a * b / GCD(b, a Mod b)
End If
End Function

'Q4: 月兔問題與費氏數列(Fib)
Function Fib(n)
If n <= 1 Then
Return n
Else
Return Fib(n - 1) + Fib(n - 2)
End If
End Function

'Q5: 十進位數值轉二進位字串
Function Bin(n)
If n < 2 Then
Return n
Else
Return Bin(n \ 2) & Bin(n Mod 2)
End If
End Function

✩ 'Q5: Quad(n)
Function Quad(ByVal n)
If n < 4 Then
Return n
Else
Return Quad(n \ 4) & Quad(n Mod 4)
End If
End Function
End Module

1125

Module _1110534013
'取x至小數第n位四捨五入
Function round5(x As Decimal, n As Integer)
Return Int(x * 10 ^ n + 0.5) / 10 ^ n
End Function
End Module

'內建數值函數
Dim ans = ""
ans &= "math.ABS(-2)= " & Math.Abs(-2) & vbNewLine
ans &= "math.ABS(0)= " & Math.Abs(0) & vbNewLine
ans &= "Cint(2.5)= " & CInt(2.5) & vbNewLine
ans &= "Cint(2.51)= " & CInt(2.51) & vbNewLine
ans &= "Cint(3.5)= " & CInt(3.5) & vbNewLine
ans &= "Cint(-7.5)= " & CInt(-7.5) & vbNewLine
ans &= "Int(2.4)= " & Int(2.4) & vbNewLine
ans &= "Int(-2.4)= " & Int(-2.4) & vbNewLine
ans &= "Int(-3.6)= " & Int(-3.6) & vbNewLine
ans &= "Fix(2.4)= " & Fix(2.4) & vbNewLine
ans &= "Fix(-2.4)= " & Fix(-2.4) & vbNewLine
ans &= "Fix(0.3)= " & Fix(0.3) & vbNewLine
ans &= "math.Round(5/3,2)= " & Math.Round(5 / 3, 2) & vbNewLine
ans &= "math.Round(1.665,2)= " & Math.Round(1.665, 2) & vbNewLine
ans &= "math.Ceiling(7.03)= " & Math.Ceiling(7.03) & vbNewLine
ans &= "math.Ceiling(-7.03)= " & Math.Ceiling(-7.03) & vbNewLine
ans &= "math.Floor(7.03)= " & Math.Floor(7.03) & vbNewLine
ans &= "math.Floor(-7.03)= " & Math.Floor(-7.03) & vbNewLine
ans &= "math.Truncate(7.03)= " & Math.Truncate(7.03) & vbNewLine
ans &= "math.Truncate(-7.03)= " & Math.Truncate(-7.03) & vbNewLine
ans &= "math.Sqrt(4)= " & Math.Sqrt(4) & vbNewLine
ans &= "math.Sign(4)= " & Math.Sign(4) & vbNewLine
ans &= "math.Sign(0)= " & Math.Sign(0) & vbNewLine
ans &= "math.Sign(-4)= " & Math.Sign(-4) & vbNewLine
ans &= "math.Log(2)/math.Log(10)= " & Math.Log(2) / Math.Log(10) & vbNewLine
ans &= "math.Exp(1)= " & Math.Exp(1) & vbNewLine
ans &= "math.Pow(2,10)= " & Math.Pow(2, 10) & vbNewLine
ans &= "math.Max(2, 3)= " & Math.Max(2, 3) & vbNewLine
ans &= "math.Min(2, 3)= " & Math.Min(2, 3) & vbNewLine
ans &= "math.Pi= " & Math.PI & vbNewLine
ans &= "math.E= " & Math.E & vbNewLine
ans &= "dim data(10,3) as integer" & vbNewLine
Dim data(10, 3) As Integer
ans &= "UBound(data)= " & UBound(data) & vbNewLine
ans &= "UBound(data,2)= " & UBound(data, 2) & vbNewLine
ans &= "dim data(10,3) as integer" & vbNewLine
ans &= "LBound(data)= " & LBound(data) & vbNewLine
ans &= "LBound(data,2)= " & LBound(data, 2) & vbNewLine
Dim Pi As Single = 3.14159265358979
ans &= "math.Sin(PI/6)= " & Math.Sin(Pi / 6) & vbNewLine

Me.TextBox1.Text = ans

'內建字串函數
Dim ans = ""
ans &= "Chr(65)= " & Chr(65) & vbNewLine
ans &= "Asc(A)= " & Asc("A") & vbNewLine
ans &= "Hex(Asc(王))= " & Hex(Asc("王")) & vbNewLine
ans &= "ChrW(65)= " & ChrW(65) & vbNewLine
ans &= "AscW(A)= " & AscW("A") & vbNewLine
ans &= "Hex(AscW(王))= " & Hex(AscW("王")) & vbNewLine
ans &= "Hex(16)= " & Hex(16) & vbNewLine
ans &= "Oct(16)= " & Oct(16) & vbNewLine
ans &= "Val(123)= " & Val("123") & vbNewLine
ans &= "Val(52A)= " & Val("52A") & vbNewLine
ans &= "Val(xxx)= " & Val("xxx") & vbNewLine
ans &= "Str(23)= " & Str(23) & vbNewLine
ans &= "Str(-43)= " & Str(-43) & vbNewLine
ans &= "Len(ABCDE)= " & Len("ABCDE") & vbNewLine
ans &= "Left(ABCDE,2)= " & Strings.Left("ABCDE", 2) & vbNewLine
ans &= "Right(ABCDE,2)= " & Strings.Right("ABCDE", 2) & vbNewLine
ans &= "Mid(ABCDE,2,3)= " & Mid("ABCDE", 2, 3) & vbNewLine
ans &= "UCase(AbcDe)= " & UCase("AbcDe") & vbNewLine
ans &= "LCase(AbcDe)= " & LCase("AbcDe") & vbNewLine
ans &= "Trim( A B )= " & Trim(" A B ") & vbNewLine
ans &= "LTrim( A B )= " & LTrim(" A B ") & vbNewLine
ans &= "RTrim( A B )= " & RTrim(" A B ") & vbNewLine
ans &= "StrDup(4,A)= " & StrDup(4, "A") & vbNewLine
ans &= "StrReverse(ABCDE)= " & StrReverse("ABCDE") & vbNewLine
ans &= "Rset(2.3, 5)= " & RSet(2.3, 5) & vbNewLine
ans &= "Lset(2.3, 5)= " & LSet(2.3, 5) & vbNewLine
ans &= "InStr(ABCDABCD,D)= " & InStr("ABCDABCD", "D") & vbNewLine
ans &= "InStr(ABCDEF,CC)= " & InStr("ABCDEF", "CC") & vbNewLine
ans &= "InStr(6,ABCDABCD,D)= " & InStr(6, "ABCDABCD", "D") & vbNewLine
ans &= "InStr(6,ABCDABCD,Ab))= " & InStr(6, "ABCDABCD", "Ab") & vbNewLine
ans &= "InStrRev(ABCDABCD,D)= " & InStrRev("ABCDABCD", "D") & vbNewLine
ans &= "InStrRev(ABCDABCD,D,7)= " & InStrRev("ABCDABCD", "D", 7) & vbNewLine
ans &= "Replace(ABCDE,BCD,xxx)= " & Replace("ABCDE", "BCD", "xxx") & vbNewLine
ans &= "Format(Now(), Long Time)= " & Format(Now(), "Long Time") & vbNewLine
ans &= "Format(Now(), Long Date)= " & Format(Now(), "Long Date") & vbNewLine
ans &= "Format(Now(), D)= " & Format(Now(), "D") & vbNewLine
ans &= "Format(5365.6, ##,##0.00)= " & Format(5365.6, "##,##0.00") & vbNewLine
ans &= "Format(534.9, ###0.00)= " & Format(534.9, "###0.00") & vbNewLine
ans &= "Format(2.5, 0.00%)= " & Format(2.5, "0.00%") & vbNewLine
Me.TextBox2.Text = ans

'取x至小數第n位四捨五入
Dim x As Single
Dim n As Integer
x = InputBox("x= ", "取x至小數第n位四捨五入", 0)
n = InputBox("n= ", "取x至小數第n位四捨五入", 0)
Me.TextBox3.Text = "取 " & x & " 至小數第 " & n & " 位四捨五入。" & vbNewLine & "答案為 " & round5(x, n)

'丟銅板100次
Randomize()
Dim ans = ""
For i = 1 To 100
ans &= Int(Rnd() * 2) & vbNewLine
Next

Me.TextBox4.Text = ans

'擲骰子(1-6)100次
Randomize()
Dim ans = ""
For i = 1 To 100
ans &= Int(Rnd() * 6) + 1 & vbNewLine
Next

Me.TextBox5.Text = ans

'翻牌(1-13)100次
Randomize()
Dim ans = ""
For i = 1 To 100
ans &= Int(Rnd() * 13) + 1 & vbNewLine
Next

Me.TextBox6.Text = ans

'ascii
Dim ans = "ascii 字元" & vbNewLine
For i = 32 To 127
ans &= i & vbTab & Chr(i) & vbNewLine
Next
Me.TextBox7.Text = ans

'跑馬燈
Me.Text = Strings.Right(Me.Text, Len(Me.Text) - 1) & Strings.Left(Me.Text, 1)

訂閱：文章 (Atom)

2017年3月5日 星期日