2019年5月29日 星期三
2019年5月28日 星期二
陣列排序
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim a(5) As Integer
Dim n, temp As Integer
n = 1
For i = 1 To 5
a(i) = Mid(TextBox1.Text, n, 2)
n = n + 3
Next
Label2.Text = "5個陣列元素以選擇排序法排序,共需4次循環" & vbCrLf
For x = 4 To 1 Step -1
Label2.Text = Label2.Text & "第" & 5 - x & "循環結果為"
For y = 1 To x
If a(y) > a(y + 1) Then
temp = a(y)
a(y) = a(y + 1)
a(y + 1) = temp
End If
Next
For i = 1 To 5
Label2.Text = Label2.Text & a(i) & " "
Next
Label2.Text = Label2.Text & vbCrLf
Next
End Sub
End Class
2019年5月22日 星期三
2019年5月18日 星期六
11800-1060306
Public Class Form1
Dim d(100, 4)
Dim rno As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
rdata()
For i = 1 To rno
If d(i, 4) = "" Then sp1(i)
If d(i, 4) = "" Then sp2(i)
If d(i, 4) = "" Then sp3(i)
Next
wdata()
End Sub
Sub rdata()
FileOpen(1, "C:\940306.sm", OpenMode.Input)
rno = 0
Do While Not EOF(1)
rno += 1
Input(1, d(rno, 1)) : Input(1, d(rno, 2)) : Input(1, d(rno, 3))
Loop
FileClose()
End Sub
Sub sp1(ByVal i)
Dim id = d(i, 1)
If id Like "[A-Z]#########" Then Else d(i, 4) = "FORMAT ERROR"
End Sub
Sub sp2(ByVal i)
Dim D1S = Mid(d(i, 1), 2, 1) & d(i, 3)
If (D1S = "1M") Or (D1S = "2F") Then Else d(i, 4) = "SEX CODE ERROR"
End Sub
Sub sp3(ByVal i)
Dim s26 = "ABCDEFGHJKLMNPQRSTUVXYWZIO"
Dim L1 = Mid(d(i, 1), 1, 1)
Dim X12 = InStr(s26, L1) + 9
Dim x1 = X12 \ 10
Dim x2 = X12 Mod 10
Dim D1 = Mid(d(i, 1), 2, 1)
Dim D2 = Mid(d(i, 1), 3, 1)
Dim D3 = Mid(d(i, 1), 4, 1)
Dim D4 = Mid(d(i, 1), 5, 1)
Dim D5 = Mid(d(i, 1), 6, 1)
Dim D6 = Mid(d(i, 1), 7, 1)
Dim D7 = Mid(d(i, 1), 8, 1)
Dim D8 = Mid(d(i, 1), 9, 1)
Dim D9 = Mid(d(i, 1), 10, 1)
Dim y = x1 + 9 * x2 + 8 * D1 + 7 * D2 + 6 * D3 + 5 * D4 + 4 * D5 + 3 * D6 + 2 * D7 + D8 + D9
If y Mod 10 = 0 Then Else d(i, 4) = "CHECK SUM ERROR"
End Sub
Sub wdata()
DGV.columns.add("ID NO", "ID NO")
DGV.Columns.Add("NAME", "NAME")
DGV.Columns.Add("SEX", "SEX")
DGV.Columns.Add("ERROR", "ERROR")
For i = 1 To rno
DGV.Rows.Add(d(i, 1), d(i, 2), d(i, 3), d(i, 4))
Next
DGV.Sort(DGV.Columns(0), System.ComponentModel.ListSortDirection.Ascending)
DGV.Columns(2).Width = 50
DGV.Columns(3).Width = 150
DGV.AllowUserToAddRows = False
End Sub
End Class
2019年5月13日 星期一
數值轉換 二進位轉十進位
'因十進位轉二進位已張貼過,故不重複貼出。
Public Class Form1
Dim str1 As String
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
Dim a As Integer
Dim tol As Integer
str1 = InputBox("請輸入您想要計算的二進位數值")
For i = 1 To Len(str1)
a = Mid(str1, i, 1)
If a = 1 Then
tol = tol + 2 ^ (Len(str1) - i)
Else
tol = tol
End If
Next
MsgBox(tol)
End Sub
End Class
2019年5月8日 星期三
2019年4月25日 星期四
數值轉換 十進位轉二進位
'純數字轉換系統
Public Class Form1
Dim D2B As String
Dim Dec As Integer
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dec = InputBox("請輸入0~255之間的任意數字")
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
MsgBox(D2B)
End
End Sub
End Class
'將位數補齊為8位數
Public Class Form1
Dim D2B As String
Dim Dec As Integer
Dim supply As String
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dec = InputBox("請輸入0~255之間的任意數字")
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
checkD2B(D2B)
MsgBox(D2B)
End
End Sub
Sub checkD2B(ByRef D2B As String)
'當二進位數字長度小於八位數時,將其數字補齊。
If Len(D2B) < 8 Then
For i = 1 To 8 - Len(D2B)
supply &= "0"
Next
End If
D2B = supply & D2B
End Sub
End Class
Public Class Form1
Dim D2B As String
Dim Dec As Integer
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dec = InputBox("請輸入0~255之間的任意數字")
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
MsgBox(D2B)
End
End Sub
End Class
'將位數補齊為8位數
Public Class Form1
Dim D2B As String
Dim Dec As Integer
Dim supply As String
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dec = InputBox("請輸入0~255之間的任意數字")
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
checkD2B(D2B)
MsgBox(D2B)
End
End Sub
Sub checkD2B(ByRef D2B As String)
'當二進位數字長度小於八位數時,將其數字補齊。
If Len(D2B) < 8 Then
For i = 1 To 8 - Len(D2B)
supply &= "0"
Next
End If
D2B = supply & D2B
End Sub
End Class
2019年4月24日 星期三
2019年4月14日 星期日
判斷輸入的數字是否為質數,並求出該值的所有正負因數。
Public Class Form1
Dim i
Dim str1
Dim str2
Dim ans As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim n As Integer = InputBox("請輸入一個數值")
'求正數因數
For i = 1 To n
If n Mod i = 0 Then
str1 = str1 & i & " "
End If
Next
Dim factor() As String = Split(str1, " ")
Dim factornum As Integer = UBound(factor)
If factornum = 2 Then
ans = "這是一個質數。"
Else
ans = "這是一個合數。"
End If
'求負數因數
Dim factor2() As String = Split(str1, " ")
For i = 0 To UBound(factor2)
factor2(i) = "-" & factor2(i)
str2 &= factor2(i) & " "
Next
str2 = Strings.Left(str2, Len(str2) - 3)
MsgBox(ans & vbCrLf & "這個數字的正因數包含:" & str1 & vbCrLf & "這個數字的負因數包含:" & str2)
End
End Sub
End Class
-------------------
另解:
'UBound函數功能為求出該陣列的個數,因For迴圈從0開始,因此會重複迴圈一次,故,我們可以改為UBound(factor2) - 1,回歸到原陣列個數,如使用這種方式,則可以省去在最後輸出前再進行一次去尾的動作。
Dim factor2() As String = Split(str1, " ")
For i = 0 To UBound(factor2) - 1
factor2(i) = "-" & factor2(i)
str2 &= factor2(i) & " "
Next
訂閱:
文章 (Atom)









