您可能會喜歡......

2019年5月29日 星期三

Microbit_0529

點我進入

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日 星期三

Microbit-(阿瓦隆)數字接收並判斷任務成功或失敗

點我進入

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

20190518 漢口國中會考服務


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日 星期三

Microbit_貪食蛇





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


2019年4月24日 星期三

107學年度台中市國中技藝競賽商管職群競賽_服務證明


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