2010年11月18日 星期四

婚前婚後大不同~ 好厲害的畫家

 

圖畫就是上圖轉來轉去的這一張ㄚ^^noname.gif

image

婚前婚後大不同~ 好厲害的畫家 @ Tony!(一鳴)~分享,成長,學習 ~ :: 痞客邦 PIXNET ::

等候5秒

image

Imports System
Imports System.Threading

Module Module1
    '修改此參數可改變等候時間數, 下面例子為5秒
    Dim waitN As New TimeSpan(0, 0, 5)
    Sub Main()
        Dim newThread As New Thread(AddressOf Waiting)
        newThread.Start()
        Console.WriteLine("開始...")
        If newThread.Join(TimeSpan.op_Addition(waitN, waitN)) Then
            Console.WriteLine("5秒時間到!")
        End If
        Console.ReadKey()
    End Sub

    Sub Waiting()
        Thread.Sleep(waitN)
    End Sub
End Module

修改自: http://webcache.googleusercontent.com/search?q=cache:1MwDSgUyYj8J:msdn.microsoft.com/zh-tw/library/274eh01d(VS.80).aspx+vb.new+threading+sleep&cd=1&hl=zh-TW&ct=clnk&gl=tw

Thread.Sleep 方法 (TimeSpan) (System.Threading)

 

如何搭配 Sleep 方法來使用 TimeSpan 值的作法。

Visual Basic

Imports System
Imports System.Threading

Public Class Test

Shared waitTime As New TimeSpan(0, 0, 1)

<MTAThread> _
Shared Sub Main()
Dim newThread As New Thread(AddressOf Work)
newThread.Start()

If newThread.Join( _
TimeSpan.op_Addition(waitTime, waitTime)) Then

Console.WriteLine("New thread terminated.")
Else
Console.WriteLine("Join timed out.")
End If
End Sub

Shared Sub Work()
Thread.Sleep(waitTime)
End Sub

End Class



Thread.Sleep 方法 (TimeSpan) (System.Threading)

2010年11月16日 星期二

'Dictionary Sample 2

'Dictionary Sample 2
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim dict1 As New Dictionary(Of String, String)

        dict1.Add("A", "優")
        dict1.Add("B", "佳")
        dict1.Add("C", "可")
        dict1.Add("D", "差")

        str1 = str1 & vbNewLine
        'KeyValuePair
        For Each kvp As KeyValuePair(Of String, String) In dict1
            str1 = str1 & kvp.Key & Space(3) & kvp.Value & vbNewLine
        Next kvp

        'assign value
        dict1("D") = "劣"

        'ValueCollection
        Dim valueColl As Dictionary(Of String, String).ValueCollection = dict1.Values
        str1 = str1 & vbNewLine
        For Each s As String In valueColl
            str1 = str1 & "Value = " & s & vbNewLine
        Next s

        'KeyCollection
        Dim keyColl As Dictionary(Of String, String).KeyCollection = dict1.Keys

        str1 = str1 & vbNewLine
        For Each s As String In keyColl
            str1 = str1 & "Key = " & s & vbNewLine
        Next s

        'Query
        str1 = str1 & vbNewLine
        str1 = str1 & dict1("C") & vbNewLine

        'Remove
        str1 = str1 & vbNewLine & "Remove(""C"")"

        dict1.Remove("C")

        'ContainsKey
        str1 = str1 & vbNewLine
        If Not dict1.ContainsKey("C") Then
            str1 = str1 & "Key ""C"" is not found."
        End If
        MsgBox(str1)
    End Sub
End Class

VB 2008 Dictionary Sample

'Dictionary Sample
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim dict1 As New Dictionary(Of Integer, String)

        dict1.Add(0, "優")
        dict1.Add(1, "佳")
        dict1.Add(2, "可")
        dict1.Add(3, "差")

        str1 = str1 & vbNewLine
        'KeyValuePair
        For Each kvp As KeyValuePair(Of Integer, String) In dict1
            str1 = str1 & kvp.Key & Space(3) & kvp.Value & vbNewLine
        Next kvp

        'assign value
        dict1(3) = "劣"

        'ValueCollection
        Dim valueColl As Dictionary(Of Integer, String).ValueCollection = dict1.Values
        str1 = str1 & vbNewLine
        For Each s As String In valueColl
            str1 = str1 & "Value = " & s & vbNewLine
        Next s

        'KeyCollection
        Dim keyColl As Dictionary(Of Integer, String).KeyCollection = dict1.Keys

        str1 = str1 & vbNewLine
        For Each s As String In keyColl
            str1 = str1 & "Key = " & s & vbNewLine
        Next s

        'Query
        str1 = str1 & vbNewLine
        str1 = str1 & dict1(2) & vbNewLine

        'Remove
        str1 = str1 & vbNewLine & "Remove(2)"

        dict1.Remove(2)

        'ContainsKey
        str1 = str1 & vbNewLine
        If Not dict1.ContainsKey(2) Then
            str1 = str1 & "Key ""2"" is not found."
        End If
        MsgBox(str1)
    End Sub
End Class

Learning

集合初始設定 (Visual Basic)

 

Dim days = New Dictionary(Of Integer, String)

days.Add(0, "Sunday")

days.Add(1, "Monday")

集合初始設定式概觀 (Visual Basic)

2010年11月11日 星期四

乙丙級術科評分系統暨Word VBA實務應用教師研習

image
乙丙級術科評分系統暨Word VBA實務應用教師研習

2010年11月5日 星期五

二進位列舉應用

'二進位列舉應用
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim str2 = ""
        Dim a() = {0, 1}
        Dim e1, e2, e3, e4
        For Each e4 In a
            For Each e3 In a
                For Each e2 In a
                    For Each e1 In a
                        str1 = str1 & e4 & e3 & e2 & e1 & vbNewLine
                        str2 = str2 & IIf(e4 = 1, "(肉)", "肉") & IIf(e3 = 1, "(菜)", "菜") & IIf(e2 = 1, "(蛋)", "蛋") & IIf(e1 = 1, "(果)", "果") & vbNewLine
                    Next
                Next
            Next
        Next
        MsgBox(str1 & vbNewLine & str2)
        End
    End Sub
End Class

二進位列舉

'二進位列舉
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim a() = {0, 1}
        Dim e1, e2, e3, e4
        For Each e4 In a
            For Each e3 In a
                For Each e2 In a
                    For Each e1 In a
                        str1 = str1 & e4 & e3 & e2 & e1 & vbNewLine
                    Next
                Next
            Next
        Next
        MsgBox(str1)
    End Sub
End Class

2010年10月29日 星期五

【嘉南區】術科評分系統暨Word VBA實務應用教學研習

 

活動名稱
【嘉南區】術科評分系統暨Word VBA實務應用教學研習

活動簡介
透過術科評分系統教師培訓研習,讓參與研習的老師減輕人工批閱乙丙級電腦軟體應用術科的工作負荷。除此之外,藉由實際的操作與講解分享如何以Word VBA開發評分系統,進而提昇教師專業教學能力及檢定成果,與促進落實證照取得全面化。

活動類別
研討會

區域別
南區

主辦單位
高苑科技大學資訊管理系

協辦單位
碁峰資訊股份有限公司

開始研習日期
2010/11/13

結束研習日期
2010/11/13

研習地點
高苑科大-資訊大樓資403室

研習地址
高雄縣路竹鄉中山路1821號

參加對象
一、現職合格專任之公私立科技大學、技術學院、專科學校講師以上教師或專業技術教師及現職合格專任之高級職業學校(含高中附設職業類科與綜合高中專門學程)
二、目前已任教電腦軟體應用乙級或丙級課程或是下學期即將規劃教授相關課程之教師。
三、對Word VBA或評分系統有興趣之現職教師。

主講人
吳進北老師、林文恭老師

活動行程
08:45~09:00 報到
09:00~09:30 丙級軟體應用術科自動評分系統建置及應用(環境建置及評分作業講解與實作)
09:30~10:00 乙級軟體應用術科自動評分系統建置及應用(環境建置及評分作業講解與實作)
10:10~11:00 成績自動收集作業環境之建置及使用說明(個別成績如何自動收集彙總至Excel工作表講解與實作)
11:10~12:00 Word VBA 簡介(Word VBA快速上手)
12:00~13:00 中午用餐
13:10~15:00 評分系統實作
15:10~17:40 乙丙級軟體應用術科評分系統實作(自動評分系統、成績自動收集作業實作演練)
17:40~18:00 綜合研討

報名開始日期
2010/10/25

報名結束日期
2010/11/8

聯絡人姓名
楊佳穎

聯絡人電話
(02)2788-2408分機:854

其他說明
一、 敬請各校惠予參加本研習教師公差假。
二、 本研習活動教師可免費報名參加。
三、 上課教師可自行自備隨身碟,以便儲存資料之用。
四、 本研習由主辦學校提供8小時之研習證書。

相關資訊網址
交通路線圖

報名表
我要報名

【嘉南區】術科評分系統暨Word VBA實務應用教學研習

【高屏區】術科評分系統暨Word VBA實務應用教學研習

 

活動名稱
【高屏區】術科評分系統暨Word VBA實務應用教學研習

活動簡介
透過術科評分系統教師培訓研習,讓參與研習的老師減輕人工批閱乙丙級電腦軟體應用術科的工作負荷。除此之外,藉由實際的操作與講解分享如何以Word VBA開發評分系統,進而提昇教師專業教學能力及檢定成果,與促進落實證照取得全面化。

活動類別
研討會

區域別
南區

主辦單位
美和科技大學--健康產業資訊科技系

協辦單位
碁峰資訊股份有限公司

開始研習日期
2010/11/20

結束研習日期
2010/11/20

研習地點
美和科技大學傍興樓五樓D514多媒體電腦室

研習地址
屏東縣內埔鄉美和村屏光路23號

參加對象
一、現職合格專任之公私立科技大學、技術學院、專科學校講師以上教師或專業技術教師及現職合格專任之高級職業學校(含高中附設職業類科與綜合高中專門學程)
二、目前已任教電腦軟體應用乙級或丙級課程或是下學期即將規劃教授相關課程之教師。
三、對Word VBA或評分系統有興趣之現職教師。

主講人
吳進北老師、林文恭老師

活動行程
08:45~09:00 報到
09:00~09:30 丙級軟體應用術科自動評分系統建置及應用(環境建置及評分作業講解與實作)
09:30~10:00 乙級軟體應用術科自動評分系統建置及應用(環境建置及評分作業講解與實作)
10:10~11:00 成績自動收集作業環境之建置及使用說明(個別成績如何自動收集彙總至Excel工作表講解與實作)
11:10~12:00 Word VBA 簡介(Word VBA快速上手)
12:00~13:00 中午用餐
13:10~15:00 評分系統實作
15:10~17:40 乙丙級軟體應用術科評分系統實作(自動評分系統、成績自動收集作業實作演練)
17:40~18:00 綜合研討

報名開始日期
2010/10/25

報名結束日期
2010/11/12

聯絡人姓名
楊佳穎

聯絡人電話
(02)2788-2408分機:854

其他說明
一、敬請各校惠予參加本研習教師公差假。
二、本研習活動教師可免費報名參加。
三、上課教師可自行自備隨身碟,以便儲存資料之用。
四、本研習由主辦學校提供8小時之研習證書。

相關資訊網址
交通路線圖

報名表
我要報名

【高屏區】術科評分系統暨Word VBA實務應用教學研習

2010年10月19日 星期二

雙向排序

'雙向排序
Public Class Form1
    Dim counter = 0
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '雙向排序 - 一次取得剩餘未處理部份的最大最小值
        Dim n() = {9, 8, 7, 6, 5, 4, 3, 2, 10, 1}
        Dim i1 = 0
        Dim i2 = n.Length - 1
        While i1 < i2
            Dim j1 = i1 + 1
            Dim j2 = i2 - 1
            While j1 <= n.Length - 1
                If n(i1) > n(j1) Then
                    change(n(i1), n(j1))
                End If
                If n(i2) < n(j2) Then
                    change(n(i2), n(j2))
                End If
                j1 = j1 + 1
                j2 = j2 - 1
            End While
            i1 = i1 + 1
            i2 = i2 - 1
        End While
        Dim str1 = ""
        For i = 0 To n.Length - 1
            str1 = str1 & n(i) & Space(3)
        Next
        str1 = str1 & vbNewLine & "交換:" & counter & "次 " & vbNewLine
        '單向排序
        counter = 0
        Dim n1() = {9, 8, 7, 6, 5, 4, 3, 2, 10, 1}
        Dim f1 = 0
        While f1 <= n.Length - 1 - 1
            Dim g1 = f1 + 1
            While g1 <= n.Length - 1
                If n1(f1) > n1(g1) Then
                    change(n1(f1), n1(g1))
                End If
                g1 = g1 + 1
            End While
            f1 = f1 + 1
        End While
        For i = 0 To n.Length - 1
            str1 = str1 & n1(i) & Space(3)
        Next
        str1 = str1 & vbNewLine & "交換:" & counter & "次 " & vbNewLine
        MsgBox(str1)
        End
    End Sub
    Sub change(ByRef x, ByRef y)
        Dim t = x
        x = y
        y = t
        counter = counter + 1
    End Sub
End Class

2010年10月18日 星期一

遞迴版插入排序

'遞迴版插入排序
Public Class Form1
    Dim a() = {9, 1, 8, 7, 6, 5, 4, 10, 3, 2}
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Call rsort(1, a)
        For i = 0 To a.Length - 1
            str1 = str1 & a(i) & Space(3)
        Next
        MsgBox(str1)
        End
    End Sub
    Sub rsort(ByVal n, ByRef a)
        If n = a.length Then
            Return
        Else
            Dim p = a(n)
            Dim j = 0
            While a(j) < p
                j = j + 1
            End While
            For k = n To j + 1 Step -1
                a(k) = a(k - 1)
            Next
            a(j) = p
            rsort(n + 1, a)
        End If
    End Sub
End Class

插入排序

Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a() = {9, 1, 8, 7, 6, 5, 4, 10, 3, 2}
        For i = 1 To a.Length - 1
            Dim p = a(i)
            Dim j = 0
            While a(j) < p
                j = j + 1
            End While
            For k = i To j + 1 Step -1
                a(k) = a(k - 1)
            Next
            a(j) = p
        Next
        End
    End Sub

2010年10月13日 星期三

窮舉例

'窮舉例
'以1,2,3三個數字, 可重覆方式組成7
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '最佳解
        Dim n = 7
        Dim a() = {3, 2, 1}
        Dim ansStr = ""
        Dim i = 0
        While n > 0
            While n >= a(i)
                n = n - a(i)
                ansStr = ansStr & a(i)
            End While
            i = i + 1
        End While
        MsgBox(ansStr)
        '所有解
        n = 7
        Dim k(a.Length - 1) As Integer
        For i = 0 To a.Length - 1
            k(i) = n \ a(i)
        Next
        Dim str1 = ""
        Dim str2 = ""
        Dim j1, j2, j3
        Dim z = 0
        For j3 = 0 To k(0)
            For j2 = 0 To k(1)
                For j1 = 0 To k(2)
                    If 3 * j3 + 2 * j2 + 1 * j1 = n Then
                        z = z + 1
                        str1 = "解" & z & " --> " & " 3:" & j3 & " 2:" & j2 & " 1:" & j1
                        str2 = str2 & str1 & vbTab
                        If z Mod 5 = 0 Then str2 = str2 & vbNewLine
                    End If
                Next
            Next
        Next
        MsgBox(str2)
        End
    End Sub
End Class

2010年10月6日 星期三

Joseph Problem

'Joseph Problem
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim aL As New ArrayList
        Dim aLB As New ArrayList
        Dim aStr = "123456789ABCDE"
        For i = 1 To aStr.Length
            aL.Add(Mid(aStr, i, 1))
        Next
        Dim k = 3
        Dim ic = 0 + k - 1
        While aL.Count > 1
            ic = ic Mod aL.Count
            aLB.Add(aL.Item(ic))
            aL.RemoveAt(ic)
            ic = ic + k - 1
        End While
        MsgBox(aL.Item(0))
    End Sub
End Class

2010年9月17日 星期五

'魔術矩陣

'魔術矩陣
' 68  81  94 107 120   1  14  27  40  53  66
' 80  93 106 119  11  13  26  39  52  65  67
' 92 105 118  10  12  25  38  51  64  77  79
'104 117   9  22  24  37  50  63  76  78  91
'116   8  21  23  36  49  62  75  88  90 103
'  7  20  33  35  48  61  74  87  89 102 115
' 19  32  34  47  60  73  86  99 101 114   6
' 31  44  46  59  72  85  98 100 113   5  18
' 43  45  58  71  84  97 110 112   4  17  30
' 55  57  70  83  96 109 111   3  16  29  42
' 56  69  82  95 108 121   2  15  28  41  54
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim m = 11
        Dim a(m - 1, m - 1)
        For i = 0 To m - 1
            For j = 0 To m - 1
                a(i, j) = 0
            Next
        Next
        Dim x = m \ 2, y = 0
        Dim k = 1
        a(x, y) = k
        k = k + 1
        While k <= m * m
            Dim xb = x
            Dim yb = y
            x = (x + 1) Mod m
            y = (y - 1 + m) Mod m
            If a(x, y) = 0 Then
                a(x, y) = k
                k = k + 1
            Else
                x = xb
                y = yb
                y = (y + 1) Mod m
                a(x, y) = k
                k = k + 1
            End If
        End While
        For y = 0 To m - 1
            For x = 0 To m - 1
                'str1 = str1 & a(x, y) & vbTab
                str1 = str1 & format1(a(x, y)) & vbTab
            Next
            str1 = str1 & vbNewLine
        Next
        MsgBox(str1)
        My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\Test.txt", str1, False)
        End
    End Sub
    Function format1(ByVal n)
        If n < 10 Then Return Space(2) & n
        If n < 100 Then Return Space(1) & n
        Return n
    End Function
End Class

2010年9月10日 星期五

93q6

Public Class Form1
    Private Sub Form1_Load(ByVal sender1 As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i, j
        Dim str2 = ""
        Dim str1 = ""
        Dim a(51, 51)
        a(1, 0) = 0 : a(1, 1) = 1 : a(1, 2) = 0
        a(2, 0) = 0 : a(2, 1) = 1 : a(2, 2) = 2 : a(2, 3) = 1 : a(2, 4) = 0
        str1 = 1
        str2 = str2 & str1 & vbNewLine
        str1 = 1 & ", " & 2 & ", " & 1
        str2 = str2 & str1 & vbNewLine
        For j = 3 To 10
            str1 = ""
            a(j, 1) = 1
            str1 = str1 & 1 & ", "
            For i = 2 To j
                a(j, i) = a(j - 1, i - 1) + a(j - 1, i)
                str1 = str1 & a(j, i) & ", "
            Next
            a(j, i) = 1
            str1 = str1 & 1
            str2 = str2 & str1 & vbNewLine
        Next j
        MsgBox(str2)
    End Sub
End Class

2010年7月31日 星期六

2010年3月29日 星期一

大數除法

'大數除法
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a = "1234567890123456788999999"
        Dim b = "12345678901234567890"
        Dim q = 0
        While a.Length > b.Length Or a.Length = b.Length And a >= b
            q = q + 1
            a = bigSub(a, b)
        End While
        MsgBox(q)
        End
    End Sub
    Function bigSub(ByVal n1, ByVal n2)
        Dim a(100)
        Dim b(100)
        Dim d(100)

        Dim i1 = 0
        For i = n1.Length - 1 To 0 Step -1
            a(i1) = Val(n1.Chars(i))
            i1 = i1 + 1
        Next

        Dim i2 = 0
        For i = n2.Length - 1 To 0 Step -1
            b(i2) = Val(n2.Chars(i))
            i2 = i2 + 1
        Next

        Dim imax = IIf(i1 > i2, i1, i2)

        Dim c = 0
        For i = 0 To imax
            If a(i) - c >= b(i) Then
                d(i) = a(i) - b(i) - c
                c = 0
            Else
                d(i) = a(i) - b(i) - c + 10
                c = 1
            End If
        Next

        Dim str = ""
        For i = 0 To imax
            str = d(i) & str
        Next

        While Microsoft.VisualBasic.Left(str, 1) = "0"
            str = Microsoft.VisualBasic.Right(str, str.Length - 1)
        End While
        Return (str)
    End Function
End Class


大數乘法

'大數乘法
Public Class Form1
    '12345*45678=563894910
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a(300)
        Dim b(300)
        Dim c(600)
        Dim aStr = "12345"
        Dim bStr = "45678"
        Dim i
        Dim ia = 0
        For i = aStr.Length - 1 To 0 Step -1
            a(ia) = aStr.Chars(i)
            ia = ia + 1
        Next
        Dim ib = 0
        For i = bStr.Length - 1 To 0 Step -1
            b(ib) = bStr.Chars(i)
            ib = ib + 1
        Next

        Dim j
        For i = 0 To 300
            For j = 0 To 300
                c(i + j) = c(i + j) + Val(a(i)) * Val(b(j))
            Next
        Next
        For i = 0 To 300 - 1
            If c(i) >= 10 Then
                c(i + 1) = c(i + 1) + c(i) \ 10
                c(i) = c(i) Mod 10
            End If
        Next

        Dim str = ""
        For i = 0 To 300
            str = c(i) & str
        Next

        While Microsoft.VisualBasic.Left(str, 1) = "0"
            str = Microsoft.VisualBasic.Right(str, str.ToString.Length - 1)
        End While
        MsgBox(str)
    End Sub
End Class


大數相減

'大數相減
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n1 = "10000000000000001"
        Dim n2 = "100000000000000000000"
        Dim isNeg = False
        If n1.Length < n2.Length Or n1.Length = n2.Length And Val(Microsoft.VisualBasic.Left(n1, 1)) < Val(Microsoft.VisualBasic.Left(n2, 1)) Then
            isNeg = True
            Dim tem = n1
            n1 = n2
            n2 = tem
        End If

        Dim a(100)
        Dim b(100)
        Dim d(100)

        Dim i1 = 0
        For i = n1.Length - 1 To 0 Step -1
            a(i1) = Val(n1.Chars(i))
            i1 = i1 + 1
        Next

        i1 = 0
        For i = n2.Length - 1 To 0 Step -1
            b(i1) = Val(n2.Chars(i))
            i1 = i1 + 1
        Next

        Dim c = 0
        For i = 0 To 100
            If a(i) - c >= b(i) Then
                d(i) = a(i) - b(i) - c
                c = 0
            Else
                d(i) = a(i) - b(i) - c + 10
                c = 1
            End If
        Next

        Dim str = ""
        For i = 0 To 100
            str = d(i) & str
        Next

        While Microsoft.VisualBasic.Left(str, 1) = "0"
            str = Microsoft.VisualBasic.Right(str, str.Length - 1)
        End While
        If isNeg = True Then str = "-" & str
        MsgBox(str)
        End
    End Sub
End Class

大數相加

'大數相加
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n1 = "1234567890"
        Dim n2 = "12345678901200000"
        Dim a(100)
        Dim b(100)
        Dim d(100)

        Dim i1 = 0
        For i = n1.Length - 1 To 0 Step -1
            a(i1) = Val(n1.Chars(i))
            i1 = i1 + 1
        Next

        i1 = 0
        For i = n2.Length - 1 To 0 Step -1
            b(i1) = Val(n2.Chars(i))
            i1 = i1 + 1
        Next

        Dim c = 0
        For i = 0 To 100
            d(i) = a(i) + b(i) + c
            If d(i) >= 10 Then
                c = 1
                d(i) = d(i) - 10
            Else
                c = 0
            End If
        Next

        Dim str = ""
        For i = 0 To 100
            str = d(i) & str
        Next

        While Microsoft.VisualBasic.Left(str, 1) = "0"
            str = Microsoft.VisualBasic.Right(str, str.Length - 1)
        End While
        MsgBox(str)
        'MsgBox(str & " -- " & (Val(n1) + Val(n2)) & " -- " & Val(str) - (Val(n1) + Val(n2)))
        End
    End Sub
End Class


2010年3月10日 星期三

累計不連續上網秒數自動關瀏覽器

imageimage
Import s System.Text
Imports System.IO.Ports
Public Class Form1
    Dim proc As System.Diagnostics.Process
    Dim accSec As Integer
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer2.Enabled = True
        Timer2.Interval = 1000
        Me.Text = "累計不連續上網秒數自動關瀏覽器"
        Label1.Text = "打開IE瀏覽器後,計時器會自動起動"
    End Sub

2010年3月9日 星期二

程式管理

image

Public Class Form1
    Dim proc As System.Diagnostics.Process
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Timer1.Interval = 5000
        Timer1.Enabled = True
        Me.Hide()
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If CheckBox1.Checked = True Then
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like "*iexplore*" Then proc.Kill()
            Next
        End If
        If CheckBox2.Checked = True Then
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like "*mspaint*" Then proc.Kill()
            Next
        End If
        If CheckBox3.Checked = True Then
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like "*calc*" Then proc.Kill()
            Next
        End If

        If TextBox1.Text <> "" Then
            Dim proc1 = "*" & TextBox1.Text & "*"
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like proc1 Then proc.Kill()
            Next
        End If

        If TextBox2.Text <> "" Then
            Dim proc1 = "*" & TextBox2.Text & "*"
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like proc1 Then proc.Kill()
            Next
        End If

        If TextBox3.Text <> "" Then
            Dim proc1 = "*" & TextBox3.Text & "*"
            For Each proc In System.Diagnostics.Process.GetProcesses
                If proc.ProcessName Like proc1 Then proc.Kill()
            Next
        End If
    End Sub
End Class

lotto

image

Public Class Form1
    Dim cn(42)
    Dim rn(42)
    Dim aM
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim i
        ReDim cn(42)
        For i = 1 To 42
            cn(i) = i
        Next
        For i = 1 To 6
            Dim s = Int(Rnd() * 42 + 1)
            Dim t = cn(i)
            cn(i) = cn(s)
            cn(s) = t
        Next

        ReDim Preserve cn(6)
        Array.Sort(cn)

        TextBox1.Text = cn(1)
        TextBox2.Text = cn(2)
        TextBox3.Text = cn(3)
        TextBox4.Text = cn(4)
        TextBox5.Text = cn(5)
        TextBox6.Text = cn(6)

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim i
        ReDim rn(42)
        For i = 1 To 42
            rn(i) = i
        Next
        For i = 1 To 6
            Dim s = Int(Rnd() * 42 + 1)
            Dim t = rn(i)
            rn(i) = rn(s)
            rn(s) = t
        Next

        ReDim Preserve rn(6)
        Array.Sort(rn)

        TextBox7.Text = rn(1)
        TextBox8.Text = rn(2)
        TextBox9.Text = rn(3)
        TextBox10.Text = rn(4)
        TextBox11.Text = rn(5)
        TextBox12.Text = rn(6)
        '
        Dim c = 0, j
        Dim s1 = ""
        For i = 1 To 6
            For j = 1 To 6
                If cn(i) = rn(j) Then
                    c = c + 1
                    s1 = s1 & cn(i) & ". "
                End If
            Next
        Next
        Label2.Text = "中" & c & "號"
        Label1.Text = "中的號碼:" & s1
        Dim m() = {0, 0, 0, 200, 2000, 20000, 2000000}
        Label5.Text = "獎金:" & Format(m(c), "#,##0")
        aM = aM - 50 + m(c)
        label6.text = "累積輸贏: $" & Format(aM, "#,##0")
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim i
        For i = 1 To 100
            Button1_Click(sender, e)
        Next

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        aM = 0
    End Sub
End Class

2010年3月7日 星期日

因數分解 - 副程式、函數、字串應用綜合演練版

image

'因數分解 - 副程式、函數、字串應用綜合演練版
Public Class Form1
    Dim bqn
    Dim a(20)
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str2 = ""
        ' Dim qn = 720
        For qn = 1 To 50
            bqn = qn
            factorize(qn)
            str2 = str2 & toexpType(a) & vbNewLine
        Next
        MsgBox(str2)
        End
    End Sub

    Sub factorize(ByVal qn)
        ReDim a(20)
        Dim j = 0
        For k = 2 To qn
            While qn Mod k = 0
                qn = qn / k
                a(j) = k
                j = j + 1
            End While
        Next
        j = j - 1
        ReDim Preserve a(j)
    End Sub

    Function toexpType(ByVal a) As String
        Dim str1 = ""
        Dim p = 0
        Dim n = 1
        For i = 0 To a.Length - 1
            Dim c = a(i)
            If c <> p Then
                If str1 = "" Then
                    str1 = str1 & c & "^"
                Else
                    str1 = str1 & n & "*" & c & "^"
                End If
                n = 1
            Else
                n = n + 1
            End If
            p = c
        Next
        str1 = str1 & n
        str1 = Replace(str1, "^1", "")
        str1 = bqn & "=" & str1
        Return str1
    End Function
End Class

因數的次方表達處理 720=2^4*3^2*5

image 

'因數的次方表達處理2
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a(20)
        Dim qn = 720
        Dim bqn = qn
        Dim j = 0
        For k = 2 To qn
            While qn Mod k = 0
                qn = qn / k
                a(j) = k
                j = j + 1
            End While
        Next
        j = j - 1
        ReDim Preserve a(j)

        Dim str1 = ""
        Dim p = 0
        Dim n = 1
        For i = 0 To a.Length - 1
            Dim c = a(i)
            If c <> p Then
                If str1 = "" Then
                    str1 = str1 & c & "^"
                Else
                    str1 = str1 & n & "*" & c & "^"
                End If
                n = 1
            Else
                n = n + 1
            End If
            p = c
        Next
        str1 = str1 & n
        str1 = Replace(str1, "^1", "")
        str1 = bqn & "=" & str1
        MsgBox(str1)
        End
    End Sub
End Class

因數的次方表達處理

image

'因數的次方表達處理
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a() = {2, 2, 2, 3, 3, 5, 7, 7}
        Dim str1 = ""
        Dim p = 0
        Dim n = 1
        For i = 0 To a.Length - 1
            Dim c = a(i)
            If c <> p Then
                If str1 = "" Then
                    str1 = str1 & c & "^"
                Else
                    str1 = str1 & n & "*" & c & "^"
                End If
                n = 1
            Else
                n = n + 1
            End If
            p = c
        Next
        str1 = str1 & n
        str1 = Replace(str1, "^1", "")
        MsgBox(str1)
    End Sub
End Class

字串處理練習

2010-3-7 下午 12-35-01 

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim a = "22233577"
        Dim str1 = ""
        Dim p = ""
        Dim n = 1
        For i = 1 To a.Length
            Dim c = Mid(a, i, 1)
            If c <> p Then
                If str1 = "" Then
                    str1 = str1 & c & "^ "
                Else
                    str1 = str1 & n & "*" & c & "^"
                End If
                n = 1
            Else
                n = n + 1
            End If
            p = c
        Next
        str1 = str1 & n
        str1 = Replace(str1, "^1", "")
        MsgBox(str1)
    End Sub
End Class

2010年1月17日 星期日