VB6.0 TQC 檢定第 1 類題

(1)

VB6.0 TQC 檢定第 1 類題

'101 OK-PRD01===================

Private Sub Command1_Click()

MsgBox "這個數字是" & Round(Val(Text1.Text) / 2.54, 2) & "英吋"

End Sub

Private Sub Command2_Click()

A = MsgBox("這個數字是" & Round(Val(Text1.Text) / 2.54, 2) & "英吋", vbOKCancel, "訊息框抬頭")

End Sub

'101 OK-PRD01===================

'102 OK-PRD01===================

Private Sub cmdTransfer_Click() Dim Decimal_Value

Decimal_Value = Val("&H" & txtInput.Text)

MsgBox "這個數字轉換成十進位是" & Decimal_Value, , "MSGBOX"

End Sub

'102 OK-PRD01===================

'103 OK-PRD01===================

Private Sub cmdOK_Click() Dim Blood_Type As String Dim Index_I As Integer For Index_I = 0 To 3

If optType(Index_I).Value = True Then Blood_Type = optType(Index_I).Caption Exit For

(2)

End If Next Index_I

MsgBox "您的血型是" & Blood_Type, , "血型辨識"

End Sub

'103 OK-PRD01===================

'104 OK-PRD01===================

Private Sub cboSize_Click()

lblWord.FontSize = Val(cboSize.Text) End Sub

Private Sub chkFont_Click(Index As Integer) Select Case Index

Case 0

lblWord.FontBold = chkFont(Index).Value Case 1

lblWord.FontItalic = chkFont(Index).Value Case 2

lblWord.FontUnderline = chkFont(Index).Value End Select

End Sub

Private Sub Form_Load() cboSize.AddItem "12"

cboSize.AddItem "18"

cboSize.AddItem "24"

cboSize.ListIndex = 1 chkFont(1).Value = 1 optWay(2).Value = True End Sub

(3)

Private Sub optWay_Click(Index As Integer) lblWord.Alignment = Index

End Sub

'FROM1.BACKCOLOR --> 按鈕表面 '104 OK-PRD01===================

'105 OK-PRD01===================

Private Sub Form_Load() List1.AddItem "台北市"

List1.AddItem "高雄市"

List1.AddItem "台灣省"

List1.AddItem "台北縣"

List1.AddItem "桃園縣"

List1.AddItem "新竹縣"

List1.AddItem "苗栗縣"

List1.AddItem "台中縣"

List1.AddItem "彰化縣"

List1.AddItem "雲林縣"

List1.AddItem "嘉義縣"

List1.AddItem "台南縣"

List1.AddItem "高雄縣"

List1.AddItem "屏東縣"

List1.AddItem "台東縣"

List1.AddItem "花蓮縣"

List1.AddItem "宜蘭縣"

List1.AddItem "南投縣"

List1.AddItem "澎湖縣"

End Sub

Private Sub List1_Click()

(4)

'填入將 List1 中的文字，直印在 Text1 中的程式碼，程式碼需加註解 'Text1.MultiLine --> TRUE

Text_String$ = List1.Text Vertical_String$ = ""

For K = 1 To Len(Text_String$)

Vertical_String$ = Vertical_String$ & Mid(Text_String$, K, 1) & Chr$(13) &

Chr$(10) Next K

Text1.Text = Vertical_String$

End Sub

'TEXT1:MULTILINE --> TRUE 可呈現多列 '105 OK-PRD01===================

'106 OK-PRD01===================

Private Sub cmdStart_Click() Timer1.Enabled = True End Sub

Private Sub Form_Load() Timer1.Enabled = False Form1.Show

Picture1.ForeColor = vbBlue '設其前景色為藍色 Picture2.ForeColor = vbRed '設其前景色為紅色

Picture2.Print "塵緣如夢，幾番起伏總不平"

Picture1.Top = Picture2.Top '使 Picture1 與 Picture Picture1.Left = Picture2.Left '重疊

(5)

Picture1.Width = 0 '將 Picture1 之寬度設為 0 Picture1.ZOrder 0 '將 Picture1 置於最上層 End Sub

Private Sub Timer1_Timer()

If Picture1.Width < Picture2.Width Then Picture1.Width = Picture1.Width + 50 Picture1.Cls

End If End Sub

'Timer1:INTERVAL --> 300 =300/1000=0.3 秒 '106 OK-PRD01===================

'107 OK-PRD01===================

Private Sub cmdEnd_Click() End

End Sub

Private Sub cmdLine_Click()

Picture1.Line (Val(txtX1), Val(txtY1))-(Val(txtX2), Val(txtY2)) End Sub

(6)

'107 OK-PRD01===================

(7)

'108 OK-PRD01===================

Private Sub cmdUp_Click()

shpWizard.Top = shpWizard.Top - 50 End Sub

Private Sub cmdDown_Click()

shpWizard.Top = shpWizard.Top + 50 End Sub

Private Sub cmdLeft_Click()

shpWizard.Left = shpWizard.Left - 50 End Sub

Private Sub cmdRight_Click()

shpWizard.Left = shpWizard.Left + 50 End Sub

End Sub

'shpWizard: SHAPE --> 3 圓形 'shpWizard: FILLSTYLE --> 0 實心

'shpWizard: FILLCOLOR --> &H000000FF& 紅色 L3C2 '108 OK-PRD01===================

(8)

'109 OK-PRD01===================

Private Sub cmdClose_Click() End

End Sub

Private Sub cmdLarge_Click() Call Left_Top_sub1

Image1.Visible = False

'Image1.Left = Image1.Left - Image1.Width / 20 'Image1.Top = Image1.Top - Image1.Height / 20 Image1.Left = Image1.Left - Image1.Width * 0.1 / 2 Image1.Top = Image1.Top - Image1.Height * 0.1 / 2 Image1.Width = Image1.Width * 1.1

Image1.Height = Image1.Height * 1.1 Image1.Visible = True

Call Left_Top_sub2 End Sub

Private Sub cmdSmall_Click() Call Left_Top_sub1

Image1.Visible = False

Image1.Left = Image1.Left + Image1.Width / 20 Image1.Top = Image1.Top + Image1.Height / 20 Image1.Width = Image1.Width * 0.9

Image1.Height = Image1.Height * 0.9 Image1.Visible = True

Call Left_Top_sub2 End Sub

(9)

Public Sub Left_Top_sub1()

Text1 = "前:寬=" & Image1.Width & " 左=" & Image1.Left & _ ", 高=" & Image1.Height & " 上=" & Image1.Top End Sub

Public Sub Left_Top_sub2()

Text2 = "後:寬=" & Image1.Width & " 左=" & Image1.Left & _ ", 高=" & Image1.Height & " 上=" & Image1.Top End Sub

'109 OK-PRD01===================

'110 OK-PRD01===================

Option Explicit

Private Sub cmdClose_Click() Unload Me

End Sub

Private Sub cmdCopy_Click() If Form1.Tag > 28 Then Exit Sub

Else

Dim Newform As New Form1 Form1.Tag = Form1.Tag + 1

Newform.Caption = "My Form - " & Form1.Tag Newform.Show

Newform.Move Left + (Width / 10), Top + (Height \ 10) If Form1.Tag < 15 Then

(10)

Newform.BackColor = QBColor(Form1.Tag) Else

Newform.BackColor = QBColor(Form1.Tag - 14) End If

End If End Sub

'QBColor(n)

'0 黑色 8 灰色 '1 藍色 9 淡藍色 '2 綠色 10 淡綠色 '3 青藍色 11 淡青藍色 '4 紅色 12 淡紅色 '5 紫紅色 13 淡紫紅色 '6 黃色 14 淡黃色 '7 淺灰色 15 白色

'110 OK-PRD01===================

(11)

'201 OK-PRD02===================

Dim P As Integer

End Sub

Private Sub Timer1_Timer() cashier(P).Visible = False P = 1 - P

cashier(P).Visible = True

If worm.Left + worm.Width <= Form1.Width Then worm.Left = worm.Left + 150

Else

worm.Left = Form1.Left End If

If P = 0 Then

worm.Top = worm.Top + 50 Else

worm.Top = worm.Top - 50 End If

End Sub

'201 OK-PRD02===================

'202 OK-PRD02===================

Private Sub cmdClear_Click() Picture1.Cls

End Sub

Private Sub cmdRect_Click() If optType(0).Value = True Then

Picture1.Line (Val(txtX1.Text), Val(txtY1.Text))-(Val(txtX2.Text), Val(txtY2.Text)), , B

Else

Picture1.Line (Val(txtX1.Text), Val(txtY1.Text))-(Val(txtX2.Text), Val(txtY2.Text)), , BF

'box fill

(12)

End If End Sub

'202 OK-PRD02===================

'203 OK-PRD02===================

Dim mycolor As Integer Dim c$(9)

End Sub

Private Sub Form_Load()

'記錄每一格的相鄰格索引代號 c$(0) = "138"

c$(1) = "028"

c$(2) = "148"

c$(3) = "0589"

c$(4) = "278"

c$(5) = "369"

c$(6) = "5789"

c$(7) = "468"

c$(8) = "01234679"

c$(9) = "3568"

End Sub

(13)

Private Sub optcolor_Click(Index As Integer)

mycolor = Index '將所選取的顏色記錄在變數 mycolor 中 End Sub

Private Sub picColor_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

'填入可判斷所要填入顏色是否和鄰格相同，若相同則跳出這個 Sub 的程式碼 For I = 1 To Len(c$(Index))

Around_Color = Val(Mid(c$(Index), I, 1))

If optColor(mycolor).ForeColor = picColor(Around_Color).BackColor Then Exit Sub

End If Next I

picColor(Index).BackColor = optColor(mycolor).ForeColor End Sub

'203 OK-PRD02===================

'204 OK-PRD02===================

Private Sub cmdBlack_Click() For I = 0 To 2

hslColor(I).Value = 0 Next I

Call lblTColor_SUB End Sub

Private Sub cmdWhite_Click() For I = 0 To 2

hslColor(I).Value = 255 Next I

(14)

Call lblTColor_SUB End Sub

Private Sub hslColor_Change(Index As Integer) '點 3 角型或空白處 Call lblTColor_SUB

End Sub

Private Sub hslColor_Scroll(Index As Integer) '左右拉動 Call lblTColor_SUB

End Sub

Public Sub lblTColor_SUB() For I = 0 To 2

lblColor(I).Caption = hslColor(I).Value Next I

lblTColor.BackColor = RGB(Val(lblColor(0).Caption), Val(lblColor(1).Caption), Val(lblColor(2).Caption))

End Sub

'204 OK-PRD02===================

'205 OK-PRD02===================

Dim P As Integer

Private Sub cmdStart_Click() For I = 0 To 8

imgSqure(I).Picture = LoadPicture() Next I

End Sub

Private Sub Form_Load() P = 0

End Sub

(15)

Private Sub imgSqure_Click(Index As Integer) imgSqure(Index).Picture = imgPlayer(P).Picture P = 1 - P

End Sub

'205 OK-PRD02===================

'206 OK-PRD02===================

Private Sub cmdMinus_Click(Index As Integer) If Val(lblVote(Index).Caption) > 0 Then

lblVote(Index) = Val(lblVote(Index).Caption) - 1 Call PicSimleCryRtn

End If End Sub

Private Sub cmdPlus_Click(Index As Integer)

lblVote(Index) = Val(lblVote(Index).Caption) + 1 Call PicSimleCryRtn

End Sub

Public Sub PicSimleCryRtn()

If Val(lblVote(0).Caption) = Val(lblVote(1).Caption) Then picCry(0).Visible = False

picSmile(0).Visible = True picCry(1).Visible = False picSmile(1).Visible = True Else

If Val(lblVote(0).Caption) > Val(lblVote(1).Caption) Then picCry(0).Visible = False

picSmile(0).Visible = True picCry(1).Visible = True

(16)

picSmile(1).Visible = False Else

picCry(0).Visible = True picSmile(0).Visible = False picCry(1).Visible = False picSmile(1).Visible = True End If

End If End Sub

'206 OK-PRD02===================

'207 OK-PRD02===================

Private Sub cmdState_Click(Index As Integer) Select Case Index

Case 0

shpMoon.Move 60, 10

shpMoon.Width = shpSun.Width shpMoon.Height = shpSun.Height Case 1

shpMoon.Move 60, 12

shpMoon.Width = shpSun.Width * 0.7 shpMoon.Height = shpSun.Height * 0.7 Case 2

shpMoon.Move 60, 16

shpMoon.Width = shpSun.Width * 0.7 shpMoon.Height = shpSun.Height * 0.7 End Select

Call ActionRtn End Sub

Public Sub ActionRtn()

(17)

For I = 1 To 45

shpMoon.Left = shpMoon.Left - 1 Keep_Time = Timer

Do

DoEvents

Loop Until Timer - Keep_Time > 0.2 Next I

End Sub

Scale (0, 0)-(100, 100) '左上往右下

shpSun.Move 38, 10 'Object.Move Left, [Top], [Width], [Height]

End Sub

'207 OK-PRD02===================

'208 OK-PRD02===================

Dim imgIndex As Integer Dim imgFilePath

End Sub

Private Sub cmdLarge_Click() imgBird.Visible = False

imgBird.Left = imgBird.Left - imgBird.Width * 0.05 imgBird.Top = imgBird.Top - imgBird.Height * 0.05 imgBird.Width = imgBird.Width * 1.1

imgBird.Height = imgBird.Height * 1.1 imgBird.Visible = True

End Sub

(18)

Private Sub cmdNext_Click() imgIndex = imgIndex - 1 If imgIndex < 1 Then imgIndex = 6 End If

Call ShowImageRtn End Sub

Private Sub cmdPrevious_Click() imgIndex = imgIndex + 1 If imgIndex > 6 Then imgIndex = 1 End If

Call ShowImageRtn End Sub

Public Sub ShowImageRtn()

imgBird.Picture = LoadPicture(imgFilePath & Trim(Str$(imgIndex)) & ".BMP") End Sub

Private Sub cmdSmall_Click() imgBird.Visible = False

imgBird.Left = imgBird.Left + imgBird.Width * 0.05 imgBird.Top = imgBird.Top + imgBird.Height * 0.05 imgBird.Width = imgBird.Width * 0.9

imgBird.Height = imgBird.Height * 0.9 imgBird.Visible = True

End Sub

Private Sub Form_Load() imgIndex = 1

imgFilePath = App.Path & "\PRD02-"

End Sub

'208 OK-PRD02===================

(19)

'209 OK-PRD02===================

Dim n$(5)

Sub cboArea_Click()

'請填入可將配合所選縣市名稱的名人和風景圖顯示出來的程式碼 lblName = n$(cboArea.ListIndex)

picArea.Picture = LoadPicture(App.Path & "\PRD02-" &

Trim(Str$((cboArea.ListIndex + 1))) & ".BMP") End Sub

Sub Form_Load()

'將各縣市名稱加入 cboArea 中，並將當地名人之姓名存放入 n$()中 cboArea.AddItem "台北市": n$(0) = "馬英九"

cboArea.AddItem "台北縣": n$(1) = "蘇貞昌"

cboArea.AddItem "桃園縣": n$(2) = "呂秀蓮"

cboArea.AddItem "新竹縣": n$(3) = "林光華"

cboArea.AddItem "苗栗縣": n$(4) = "傅學鵬"

cboArea.AddItem "台中縣": n$(5) = "廖永來"

cboArea.ListIndex = 0 End Sub

'209 OK-PRD02===================

Dim cmdAdd1(5) As CommandButton '建一物件陣列

Dim i As Integer

Private Sub cmdAdd_Click(Index As Integer)

'請補齊新增物件的程式碼,需注意物件最多只能新增 5 個,新增的物件要顯示出來 i = i + 1

If i > 5 Then

MsgBox "只能新增五個", vbOKOnly, "注意"

(20)

Exit Sub End If

Set cmdAdd1(i) = Controls.Add("vb.commandbutton", "cmdAdd1" & i) cmdAdd1(i).Visible = True

cmdAdd1(i).Caption = i

cmdAdd1(i).Left = 3000 - 500 * i cmdAdd1(i).Top = 3000 - 500 * i End Sub

'209 OK-PRD02===================

(21)

'301 OK-PRD03===================

Dim q$

Dim correct, wrong

Private Sub cmdStatistics_Click()

NoAnsCorrect = "答對: " & Str(correct) & "題"

NoAnswrong = "答錯: " & Str(wrong) & "題"

MsgBox NoAnsCorrect & Chr(13) & Chr(10) & NoAnswrong, vbOKOnly, "統計"

End Sub

Private Sub cmdTopic_Click() Randomize

txtA.Enabled = False

cmdStatistics.Enabled = False txtA.Text = ""

q$ = ""

For I = 1 To Int(Rnd * 3) + 4

AsciiCodeValue = Int(Rnd * 26) + 97 q$ = q$ & Chr$(AsciiCodeValue) Next I

lblQ.Caption = q$

Call TimeDelayRtn lblQ.Caption = ""

txtA.Enabled = True cmdTopic.Enabled = False End Sub

Private Sub Form_Load() cmdTopic.TabIndex = 0 txtA.TabIndex = 1 lblQ.TabIndex = 2 correct = 0

wrong = 0

cmdStatistics.Enabled = False End Sub

Public Sub TimeDelayRtn() KeepTime = Timer Label1 = KeepTime Do

Label4 = Timer DoEvents

(22)

Loop Until Timer - KeepTime > 2 End Sub

Private Sub txtA_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then

If txtA.Text = q$ Then lblQ.Caption = "答對了"

correct = correct + 1 Else

lblQ.Caption = "答錯了"

wrong = wrong + 1 End If

cmdTopic.Enabled = True txtA.Enabled = False

cmdStatistics.Enabled = True Else

cmdStatistics.Enabled = False End If

End Sub

'301 OK-PRD03===================

'302 OK-PRD03===================

Dim TestN, GetNum, I, J, PrimeNumberYesNo

Dim PrimeNumberCount, PrimeNumberSum, PrimeNumberNear

Private Sub cmdCalculate_Click() txtNum = ""

txtSum = ""

txtLike = ""

GetNum = Val(txtN.Text)

If GetNum < 2 Or GetNum > 32767 Then

MsgBox "N 超過 32767 或小於 2,請重新輸入", vbOKOnly, "警告"

(23)

Exit Sub End If

TestN = Int(GetNum) If TestN <> GetNum Then

MsgBox "N 必須為整數值,請重新輸入", vbOKOnly, "警告"

Exit Sub End If

PrimeNumberCount = 1 PrimeNumberSum = 2 PrimeNumberNear = 2 If TestN >= 3 Then

PrimeNumberCount = PrimeNumberCount + 1 PrimeNumberNear = 3

PrimeNumberSum = PrimeNumberSum + PrimeNumberNear End If

If TestN >= 4 Then For I = 4 To TestN

PrimeNumberYesNo = 1 '旗幟 flag, 先行假設為質數 For J = 2 To Int(Sqr(I)) '到平方根即可

If (I Mod J) = 0 Then '整除判定

PrimeNumberYesNo = 0 '如果整除,令 PrimeNumberYesNo = 0 Exit For '即不是質數,立即跳開,以節省時間 End If

Next J

If PrimeNumberYesNo = 1 Then '如果為質數 PrimeNumberCount = PrimeNumberCount + 1 PrimeNumberNear = I

Next I End If

txtNum = PrimeNumberCount txtSum = PrimeNumberSum txtLike = PrimeNumberNear End Sub

Private Sub Command1_Click() txtNum = ""

txtSum = ""

txtLike = ""

GetNum = Val(txtN.Text)

MsgBox "N 超過 32767 或小於 2,請重新輸入", vbOKOnly, "警告"

Exit Sub

(24)

End If

TestN = Int(GetNum) If TestN <> GetNum Then

MsgBox "N 必須為整數值,請重新輸入", vbOKOnly, "警告"

Exit Sub End If

PrimeNumberCount = 1 PrimeNumberSum = 2 PrimeNumberNear = 2 If TestN >= 3 Then For I = 3 To TestN

PrimeNumberYesNo = 1 '旗幟 flag, 先行假設為質數 For J = 2 To I - 1

If (I Mod J) = 0 Then '整除判定

PrimeNumberYesNo = 0 '如果整除,令 PrimeNumberYesNo = 0 Exit For '即不是質數,立即跳開,以節省時間 End If

Next J

If PrimeNumberYesNo = 1 Then '如果為質數 PrimeNumberCount = PrimeNumberCount + 1 PrimeNumberNear = I

Next I End If

txtNum = PrimeNumberCount txtSum = PrimeNumberSum txtLike = PrimeNumberNear End Sub

'302 OK-PRD03===================

(25)

'303 OK-PRD03===================

Dim I, GetString, TransString, CurrentChar Dim TransChar, TransAscii

Private Sub txtInput_Change() GetString = txtInput TransString = ""

For I = 1 To Len(GetString) 'First Change

CurrentChar = Mid(GetString, I, 1) TransAscii = Asc(CurrentChar)

If TransAscii >= 65 And TransAscii <= 90 Then TransAscii = TransAscii + 2

If TransAscii > 90 Then

TransAscii = TransAscii - 26 End If

TransChar = Chr$(TransAscii) End If

'Second Change

CurrentChar = TransChar Select Case CurrentChar Case "A"

TransChar = "K"

Case "Z"

TransChar = "E"

Case "C"

TransChar = "H"

Case "S"

TransChar = "U"

Case "R"

TransChar = "V"

Case "K"

TransChar = "N"

Case "P"

TransChar = "T"

Case "B"

TransChar = "C"

End Select 'Third Change

CurrentChar = TransChar Select Case CurrentChar Case "A"

TransChar = "a"

Case "E"

TransChar = "e"

(26)

Case "I"

TransChar = "i"

Case "O"

TransChar = "o"

Case "U"

TransChar = "u"

Case "J"

TransChar = "1"

Case "Q"

TransChar = "2"

Case "K"

TransChar = "3"

Case "X"

TransChar = "?"

Case "Y"

TransChar = "?"

Case "Z"

TransChar = "?"

End Select

TransString = TransString & TransChar Next I

lblOutput = TransString End Sub

'303 OK-PRD03===================

'304 OK-PRD03===================

Dim PascalTableA(), PascalTablePrint() Dim I, J, GetNum

Private Sub cmdCal_Click() Form1.Cls

GetNum = Val(txtN)

MsgBox "輸入 N 請小於等於 10!", vbInformation Exit Sub

End If

ReDim PascalTableA(10) '前次 ReDim PascalTablePrint(10) '印出 PascalTableA(0) = 1

(27)

For I = 0 To GetNum

PascalTablePrint(0) = PascalTableA(0) Print Spc(10 - I); PascalTablePrint(0);

For J = 1 To I

PascalTablePrint(J) = PascalTableA(J - 1) + PascalTableA(J) Print PascalTablePrint(J); " ";

Next J

Print Spc(5 + GetNum - I); "N="; I PascalTableA = PascalTablePrint Next I

End Sub

'304 OK-PRD03===================

'305 OK-PRD03===================

Dim NumA, NumB, NumC Private Sub cmdCalculate_Click() NumA = Val(txtA)

NumB = Val(txtB) NumC = Val(txtC)

lblFunction = "(" & Trim(Str(NumA)) & ")x2+(" & _ Trim(Str(NumB)) & ")x+(" & _ Trim(Str(NumC)) & ")=0"

If NumA = 0 And NumB = 0 And NumC <> 0 Then txtX(0) = "無解"

txtX(1) = ""

End If

If NumA = 0 And NumB = 0 And NumC = 0 Then txtX(0) = "無限多解"

(28)

txtX(1) = ""

End If

If NumA = 0 And NumB <> 0 And NumC <> 0 Then txtX(0) = Round((-NumC / NumB), 2)

txtX(1) = "只有一解"

End If

If NumA <> 0 And NumB <> 0 And _

(NumB ^ 2 - 4 * NumA * NumC) = 0 Then txtX(0) = Round((-NumB / (2 * NumA)), 2) txtX(1) = "同根"

End If

(NumB ^ 2 - 4 * NumA * NumC) > 0 Then

txtX(0) = Round((((-NumB) + Sqr(NumB ^ 2 - 4 * NumA * NumC)) / (2 * NumA)), 2)

txtX(1) = Round((((-NumB) - Sqr(NumB ^ 2 - 4 * NumA * NumC)) / (2 * NumA)), 2)

End If

(NumB ^ 2 - 4 * NumA * NumC) < 0 Then

txtX(0) = Str(Round(((-NumB) / (2 * NumA)), 2)) & "+" & _

Str(Round((Sqr(4 * NumA * NumC - NumB ^ 2) / (2 * NumA)), 2))

& "i"

txtX(1) = Str(Round(((-NumB) / (2 * NumA)), 2)) & "-" & _

Str(Round((Sqr(4 * NumA * NumC - NumB ^ 2) / (2 * NumA)), 2))

& "i"

End If End Sub

'305 OK-PRD03===================

'306 OK-PRD03===================

(29)

Dim EdgeA, EdgeB, EdgeC, TempS

Private Sub cmdCalculate_Click() lblYN = "是"

lblKind = ""

lblLength = ""

lblArea = ""

EdgeA = Val(txtEdgeA) EdgeB = Val(txtEdgeB) EdgeC = Val(txtEdgeC)

If EdgeA = 0 Or EdgeB = 0 Or EdgeC = 0 Then lblYN = "否"

Else

If (EdgeA + EdgeB) < EdgeC Or _ (EdgeA + EdgeC) < EdgeB Or _ (EdgeB + EdgeC) < EdgeA Then lblYN = "否"

Else

If (EdgeA ^ 2 + EdgeB ^ 2) = EdgeC ^ 2 Or _ (EdgeA ^ 2 + EdgeC ^ 2) = EdgeB ^ 2 Or _ (EdgeB ^ 2 + EdgeC ^ 2) = EdgeA ^ 2 Then lblKind = "直角三角形"

Else

If (EdgeA ^ 2 + EdgeB ^ 2) > EdgeC ^ 2 And _ (EdgeA ^ 2 + EdgeC ^ 2) > EdgeB ^ 2 And _ (EdgeB ^ 2 + EdgeC ^ 2) > EdgeA ^ 2 Then lblKind = "銳角三角形"

Else

If (EdgeA ^ 2 + EdgeB ^ 2) < EdgeC ^ 2 Or _ (EdgeA ^ 2 + EdgeC ^ 2) < EdgeB ^ 2 Or _ (EdgeB ^ 2 + EdgeC ^ 2) < EdgeA ^ 2 Then lblKind = "鈍角三角形"

End If End If End If

TempS = (EdgeA + EdgeB + EdgeC) / 2 lblLength = TempS * 2

lblArea = Sqr(TempS * (TempS - EdgeA) * (TempS - EdgeB) * (TempS - EdgeC))

End If End If End Sub

'306 OK-PRD03===================

(30)

'307 OK-PRD03===================

Dim PointX1, PointY1, PointX2, PointY2 Dim I, PiV, RationValue, PointNumber Private Sub cmdEnd_Click()

End End Sub

End Sub

Private Sub cmdDraw_Click()

'PiV = 4 * Atn(1) '圓周率精確值 3.14159265358979...

PiV = 3.14

RationValue = 1000 PointNumber = 200

Picture1.Line (0, 0)-(0, Picture1.Height), vbRed

Picture1.Line (0, Picture1.Height / 2)-(Picture1.Width, Picture1.Height / 2), vbRed PointX1 = 0

If optSin.Value = True Then

PointY1 = Picture1.Height / 2 - Sin(0) * RationValue For I = 0 To 2 * PiV Step (PiV / PointNumber) PointX2 = I * RationValue

PointY2 = Picture1.Height / 2 - Sin(I) * RationValue

Picture1.Line (PointX1, PointY1)-(PointX2, PointY2), vbBlue PointX1 = PointX2

PointY1 = PointY2 Next I

Else

PointY1 = Picture1.Height / 2 - Cos(0) * RationValue For I = 0 To 2 * PiV Step (PiV / PointNumber)

(31)

PointX2 = I * RationValue

PointY2 = Picture1.Height / 2 - Cos(I) * RationValue

Picture1.Line (PointX1, PointY1)-(PointX2, PointY2), vbYellow PointX1 = PointX2

PointY1 = PointY2 Next I

End If End Sub

'307 OK-PRD03===================

'308 OK-PRD03===================

Dim PolygonN, EdgeP(), I, J, AngleValue, PiV

End Sub

Private Sub cmdDraw_Click() PiV = 4 * Atn(1)

PolygonN = Val(txtN)

If PolygonN < 3 Or PolygonN > 10 Then

MsgBox "N 需大於等於 3,小於等於 10!", vbInformation, "警告"

Else

Picture1.Scale (-100, 100)-(100, -100) '宣告圖框大小 ReDim EdgeP(PolygonN, 2)

For I = 1 To PolygonN

AngleValue = (360 / PolygonN) * (I - 1) '每次等分之角度累計值 EdgeP(I, 1) = Sin(AngleValue * (PiV / 180)) * 100

EdgeP(I, 2) = Cos(AngleValue * (PiV / 180)) * 100

(32)

Next I

For I = 1 To PolygonN - 1 '兩兩連線 For J = I + 1 To PolygonN

Picture1.Line (EdgeP(I, 1), EdgeP(I, 2))- _ (EdgeP(J, 1), EdgeP(J, 2)) Next J

Next I End If End Sub

'308 OK-PRD03===================

'309 OK-PRD03===================

Dim I, J, KeepTime

Private Sub chkNum_MouseUp(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

'押注時,分數減少 10 分

If chkNum(index).Value = 1 Then

lblMoney.Caption = Val(lblMoney.Caption) - 10

chkNum(index).Caption = chkNum(index).Caption & " --> 10"

Else

lblMoney.Caption = Val(lblMoney.Caption) + 10 chkNum(index).Caption = Str(index + 1)

End If End Sub

Private Sub CmdBet_Click()

(33)

'請補入亂數顯示 picture1(0)~(5)中之任一點數圖,並將顯示最後亂數決定的圖 Randomize

List1.Clear For I = 0 To 5

picNum(J).Visible = False Next I

For I = 1 To 10 J = Int(Rnd * 6) List1.AddItem J

picNum(J).Visible = True KeepTime = Timer Do

DoEvents

Loop Until Timer - KeepTime > 0.2 picNum(J).Visible = False

Next I

picNum(J).Visible = True

'請補入若擇對時,分數加 50 分的程式 If chkNum(J).Value = 1 Then

lblMoney.Caption = Val(lblMoney.Caption) + 50 End If

'請補入將核取方塊恢復原狀的程式碼 For I = 0 To 5

chkNum(I).Value = 0

chkNum(I).Caption = Str(I + 1) Next I

End Sub

'309 OK-PRD03===================

'310 OK-PRD03===================

Dim I

Private Sub cmdPlay_Click()

(34)

For I = 0 To 4

picture1(I).Visible = True Next I

picture1(I).Visible = False Randomize

I = Int(Rnd * 4) Label1 = I '測試

picture1(5).Left = picture1(I).Left picture1(5).Top = picture1(I).Top picture1(I).Visible = False picture1(5).Visible = True If Option1(I).Value = True Then

MsgBox "你猜對了!!", vbOKOnly, "Yi!!"

Else

MsgBox "祝你下次好運!!", vbOKOnly, "Good Luck!!"

End If End Sub

Private Sub Option1_Click(Index As Integer) J = Index

End Sub

'310 OK-PRD03===================

(35)

(36)

'401 OK-PRD04===================

Dim ClipBoardText, AllText, LineText

Private Sub about_Click()

MsgBox "中華民國電腦基金會考題", vbOKOnly, "關於"

End Sub

Private Sub cut_Click()

ClipBoardText = txtContent.SelText txtContent.SelText = ""

End Sub

Private Sub copy_Click()

ClipBoardText = txtContent.SelText End Sub

Private Sub paste_Click()

txtContent.SelText = ClipBoardText End Sub

Private Sub end_Click() End

End Sub

txtContent.Top = Form1.ScaleTop txtContent.Left = Form1.ScaleLeft txtContent.Width = Form1.ScaleWidth txtContent.Height = Form1.ScaleHeight save.Enabled = False

End Sub

Private Sub Form_Resize()

txtContent.Width = Form1.ScaleWidth txtContent.Height = Form1.ScaleHeight End Sub

Private Sub NewFile_Click() txtContent.Text = ""

save.Enabled = False End Sub

(37)

Private Sub open_Click() On Error GoTo Error_Rtn

CMDialog.Action = 1 '1:檔案, 3:色彩, 4:字號, 5:列表機 Open CMDialog.FileName For Input As 1

Form1.Caption = CMDialog.FileName AllText = ""

Do Until EOF(1)

Line Input #1, LineText

AllText = AllText & LineText & Chr$(13) & Chr$(10) Loop

Close 1

txtContent.Text = AllText save.Enabled = True Error_Rtn:

Exit Sub End Sub

Private Sub save_Click() On Error GoTo Error_Rtn

Open CMDialog.FileName For Output As #1 Print #1, txtContent.Text

Close #1 Error_Rtn:

Exit Sub End Sub

Private Sub saveas_Click() On Error GoTo Error_Rtn CMDialog.ShowSave Call save_Click save.Enabled = True Error_Rtn:

Exit Sub End Sub

'401 OK-PRD04===================

(38)

'402 OK-PRD04===================

Dim TrashCan, KeepTime

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) Source.Move (X - Source.Width / 2), (Y - Source.Top / 2)

(39)

lblThing(Source.Index).Move (Source.Left + 500), (Source.Top) End Sub

picTrashCan(0).Visible = False '設為隱藏 picTrashCan(1).Visible = False '設為隱藏 picTrashCan(2).Visible = False '設為隱藏 picTrashCan(3).Visible = False '設為隱藏 picState.Picture = picTrashCan(0).Picture End Sub

Private Sub picState_DblClick()

picState.Picture = picTrashCan(3).Picture KeepTime = Timer

Do

DoEvents

Loop Until Timer - KeepTime > 1

MsgBox "已焚燒的垃圾為:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & TrashCan, vbOKOnly, "垃圾桶"

picState.Picture = picTrashCan(0).Picture TrashCan = ""

End Sub

Private Sub picState_DragDrop(Source As Control, X As Single, Y As Single) TrashCan = TrashCan & lblThing(Source.Index) & Chr(13) & Chr(10) Source.Visible = False

lblThing(Source.Index).Visible = False picState.Picture = picTrashCan(2).Picture End Sub

Private Sub picState_DragOver(Source As Control, X As Single, Y As Single, State As Integer)

Select Case State Case 0 '進入

picState.Picture = picTrashCan(1).Picture Case 1 '離開

picState.Picture = picTrashCan(1).Picture End Select

End Sub

'402 OK-PRD04===================

(40)

'403 OK-PRD04===================

'題目及答案如下:(標準答案列於題號之前)

' C 1. 評估求職者能力標準的認證，除了 IQ、EQ、TQC 測驗外，還有 ' (A) AEC 認證

' (B) CAE 認證 ' (C) ACE 認證 ' (D) ECA 認證

' B 2. ACE 專業工程師認證是那一個單位舉辦認證的 ' (A) 台北市電腦公會

' (B) 財團法人中華民國電腦技能基金會 ' (C) 台灣歐特克股份有限公司

' (D) 台灣微軟股份有限公司 ' D 3. ACE 專業工程師認證包含那些類別 ' (A) 工程製圖工程師、系統規劃工程師 ' (B) 機械設計工程師、歐特克全方位工程師

' (C) 程式設計工程師、網頁編輯設計師、美術排版設計工程師 ' (D) 以上皆是

' C 4. AutoCAD 機械設計工程師應考 ' (A) R14 3D

' (B) Word 文件控管 ' (C) MDT

' (D) Autolisp

' A 5. 程式語言對 AutoCAD R14 系統規劃工程師相當重要，所以要考 ' (A) Autolisp

' (B) MDT

' (C) Excel 零件庫處理 ' (D) Word 文件控管 '答對題數訊息框的訊息

(41)

'其訊息框的標題為"ＡＣＥ大考驗！",答對題數為 n 題

'若答對 4 題以上（含 4 題）,則顯示"恭喜你！你答對了 n 題！"

'否則顯示"對不起，你只有對了 n 題，請下一次再來！必能更上一層樓！"

Dim KeepTime, I, J, S, TotalRecord

Private Sub cmdEnd_Click() If S > 0 And S <= 5 Then Call CheckRtn End If

If TotalRecord = 5 Then

MsgBox "恭喜你!你答對了" & Str(TotalRecord) & "題!", vbCritical, "ACE 大考驗"

Else

MsgBox "對不起,你只有對了" & Str(TotalRecord) & "題,請下一次再來!必能更上一層樓!", vbCritical, "ACE 大考驗"

End If End End Sub

Private Sub cmdNext_Click() If S > 0 And S <= 5 Then Call CheckRtn Else

cmdNext.Caption = "下一題"

End If S = S + 1 For I = 0 To 3

optAns(I).Value = False Next I

If S > 5 Then For I = 0 To 3

optAns(I).Enabled = False Next I

End If Select Case S Case 1

lblTopic.Caption = "1. 評估求職者能力標準的認證，除了 IQ、EQ、

TQC 測驗外，還有"

optAns(0).Caption = "(A) AEC 認證"

optAns(1).Caption = "(B) CAE 認證"

optAns(2).Caption = "(C) ACE 認證"

optAns(3).Caption = "(D) ECA 認證"

Case 2

(42)

lblTopic.Caption = "2. ACE 專業工程師認證是那一個單位舉辦認證的"

optAns(0).Caption = "(A) 台北市電腦公會"

optAns(1).Caption = "(B) 財團法人中華民國電腦技能基金會"

optAns(2).Caption = "(C) 台灣歐特克股份有限公司"

optAns(3).Caption = "(D) 台灣微軟股份有限公司"

Case 3

lblTopic.Caption = "3. ACE 專業工程師認證包含那些類別"

optAns(0).Caption = "(A) 工程製圖工程師、系統規劃工程師"

optAns(1).Caption = "(B) 機械設計工程師、歐特克全方位工程師

"

optAns(2).Caption = "(C) 程式設計工程師、網頁編輯設計師、美術排版設計工程師"

optAns(3).Caption = "(D) 以上皆是"

Case 4

lblTopic.Caption = "4. AutoCAD 機械設計工程師應考"

optAns(0).Caption = "(A) R14 3D"

optAns(1).Caption = "(B) Word 文件控管"

optAns(2).Caption = "(C) MDT"

optAns(3).Caption = "(D) Autolisp"

Case 5

lblTopic.Caption = "5. 程式語言對 AutoCAD R14 系統規劃工程師相當重要，所以要考"

optAns(0).Caption = "(A) Autolisp"

optAns(1).Caption = "(B) MDT"

optAns(2).Caption = "(C) Excel 零件庫處理"

optAns(3).Caption = "(D) Word 文件控管"

End Select End Sub

cmdNext.Caption = "開始測驗"

TotalRecord = 0 End Sub

Public Sub CheckRtn()

If S = 1 And optAns(2).Value = True Then TotalRecord = TotalRecord + 1

'Exit Sub End If

(43)

'Exit Sub End If

Label1 = TotalRecord End Sub

Private Sub Timer1_Timer() KeepTime = Timer For I = 0 To 5

imgACE(I).Visible = False DoEvents

Next I

imgACE(J).Visible = True DoEvents

J = J + 1 If J > 5 Then J = 0 End If End Sub

'403 OK-PRD04===================

(44)

'404 OK-PRD04===================

Dim NationId, SelectId

Private Sub cmdCountry_Click(Index As Integer) SelectId = Index

If SelectId = NationId Then lblCorrect = lblCorrect + 1 lblCorrect.Caption = lblCorrect imgFace.Picture = picSmile.Picture lblAnswer.Caption = "答對了!"

Else

lblError = lblError + 1 lblError.Caption = lblError imgFace.Picture = picCry.Picture

lblAnswer.Caption = "答案是 " & cmdCountry(NationId).Caption End If

Frame1.Visible = True End Sub

End Sub

Private Sub cmdNext_Click() Call GetNationIdRtn End Sub

(45)

Private Sub Form_Load() Frame1.Top = 2400 Frame1.Left = 360 Frame1.Visible = False Call GetNationIdRtn End Sub

Public Sub GetNationIdRtn() Frame1.Visible = False Randomize

NationId = Int(Rnd * 15)

imgCountry.Picture = picCountry(NationId).Picture DoEvents

End Sub

'404 OK-PRD04===================

(46)

'405 OK-PRD04===================

Dim LightDuration(), LightNo, KeepTime

End Sub

Private Sub Form_Load() ReDim LightDuration(2) LightDuration(0) = 24 LightDuration(1) = 8 LightDuration(2) = 24

hslInterval(0).Value = LightDuration(0) hslInterval(1).Value = LightDuration(1) hslInterval(2).Value = LightDuration(2) Label1(0) = hslInterval(0).Value '測試 Label1(1) = hslInterval(1).Value '測試 Label1(2) = hslInterval(2).Value '測試 Timer1.Interval = 1

LightNo = 0 '0:綠燈,1:黃燈,2:紅燈 KeepTime = Timer

imgLight.Picture = imgState(LightNo).Picture Label2.Caption = LightDuration(LightNo) '測試 End Sub

Private Sub hslInterval_Change(Index As Integer)

(47)

LightDuration(Index) = hslInterval(Index).Value Label1(Index) = hslInterval(Index).Value End Sub

Private Sub Timer1_Timer() DoEvents

If (Timer - KeepTime) > LightDuration(LightNo) Then LightNo = LightNo + 1

If LightNo > 2 Then LightNo = 0 End If

KeepTime = Timer

imgLight.Picture = imgState(LightNo).Picture Label2.Caption = LightDuration(LightNo) '測試 End If

If Not (picCars.Left >= 2400 And picCars.Left <= 2760 And LightNo = 2) Then picCars.Left = picCars.Left + 60

If picCars.Left > 5380 Then picCars.Left = 480 End If

End If End Sub

'405 OK-PRD04===================

'406 OK-PRD04===================

Dim I, RunHorse, RunDistance, Yn

Private Sub chkWin_Click(Index As Integer) If chkWin(Index) = 1 Then

chkWin(Index).Caption = Str(Index + 1) & " --> 10 "

lblMoney.Caption = Val(lblMoney.Caption) - 10

(48)

Else

chkWin(Index).Caption = Str(Index + 1) If Yn = 0 Then '正常狀態

lblMoney.Caption = Val(lblMoney.Caption) + 10 End If

End If End Sub

Private Sub cmdStart_Click() '測試

Yn = 1 '非正常狀態 RunDistance = 0 For I = 0 To 3

RunDistance = RunDistance + chkWin(I).Value Next I

If RunDistance = 0 Then Exit Sub

End If

cmdStart.Enabled = False For I = 0 To 3

chkWin(I).Enabled = False Next I

'測試 Randomize

ReDim CurrentHorse(3) For I = 0 To 3

imgHorse(I).Left = 420 Next I

Do

RunHorse = Int(Rnd * 4)

RunDistance = Int(Rnd * 30) + 10

imgHorse(RunHorse).Left = imgHorse(RunHorse).Left + RunDistance Label3 = RunHorse + 1 '測試

Loop Until (imgHorse(RunHorse).Left + imgHorse(RunHorse).Width) >= lFinish.X2 If chkWin(RunHorse).Value = 1 Then

lblMoney = lblMoney + 30

MsgBox "你贏了!", vbOKOnly, "訊息"

Else

MsgBox "你輸了!", vbOKOnly, "訊息"

End If '測試

For I = 0 To 3

imgHorse(I).Left = 420 chkWin(I).Value = 0

(49)

Next I

cmdStart.Enabled = True For I = 0 To 3

chkWin(I).Enabled = True Next I

Yn = 0 '正常狀態 '測試

End Sub

'測試

Yn = 0 '控制重玩時不會加回賭金, 0:正常狀態 End Sub

'測試

'406 OK-PRD04===================

(50)

'407 OK-PRD04===================

Dim SecondOrder(2), N, I, J, K

Dim NewHr(2), NewMin(2), NewSec(2), NewEvent(2) Dim LastHr(2), LastMin(2), LastSec(2)

Dim SwapA, SwapB, Temp

Dim CurrentOrder, CurrentHr, CurrentMin, CurrentSec

End Sub

Private Sub cmdStart_Click() lblTime = Time$

DoEvents

Timer1.Enabled = True End Sub

Private Sub cmdSure_Click() Call GetData

For I = 0 To 2 '取得秒序

SecondOrder(I) = (Val(txtHr(I)) * 60 + Val(txtMin(I))) * 60 + Val(txtSec(I)) Next I

For K = 1 To 3 - 1 '排大小 For N = 1 To 3 - K J = N - 1

If SecondOrder(J) > SecondOrder(J + 1) Then

Call SwapRtn(SecondOrder(J), SecondOrder(J + 1)) '交換 Call SwapRtn(NewHr(J), NewHr(J + 1))

Call SwapRtn(NewMin(J), NewMin(J + 1)) Call SwapRtn(NewSec(J), NewSec(J + 1)) Call SwapRtn(NewEvent(J), NewEvent(J + 1)) End If

Next N Next K

For I = 0 To 2 '重新顯示 txtHr(I) = NewHr(I) txtMin(I) = NewMin(I) txtSec(I) = NewSec(I) txtEvent(I) = NewEvent(I) Next I

DoEvents End Sub

Private Sub SwapRtn(SwapA, SwapB) '交換

(51)

Temp = SwapA SwapA = SwapB SwapB = Temp End Sub

Private Sub GetData() For I = 0 To 2

LastHr(I) = Val(txtHr(I)) NewHr(I) = Val(txtHr(I)) Next I

For I = 0 To 2

LastMin(I) = Val(txtMin(I)) NewMin(I) = Val(txtMin(I)) Next I

For I = 0 To 2

LastSec(I) = Val(txtSec(I)) NewSec(I) = Val(txtSec(I)) Next I

For I = 0 To 2

NewEvent(I) = txtEvent(I).Text Next I

End Sub

Private Sub Timer1_Timer() lblTime = Time$

DoEvents

CurrentHr = Val(Mid(lblTime, 1, 2)) CurrentMin = Val(Mid(lblTime, 4, 2)) CurrentSec = Val(Mid(lblTime, 7, 2))

CurrentOrder = (CurrentHr * 60 + CurrentMin) * 60 + CurrentSec For I = 0 To 2

If CurrentOrder = SecondOrder(I) Then

MsgBox NewEvent(I), vbOKOnly, "看這裏,重要喔!"

Exit For End If Next I End Sub

Private Sub txtHr_LostFocus(Index As Integer) NewHr(Index) = Val(txtHr(Index).Text)

If NewHr(Index) < 0 Or NewHr(Index) > 23 Then txtHr(Index).Text = Trim(Str(LastHr(Index))) NewHr(Index) = LastHr(Index)

Else

(52)

LastHr(Index) = NewHr(Index) End If

End Sub

Private Sub txtMin_LostFocus(Index As Integer) NewMin(Index) = Val(txtMin(Index).Text)

If NewMin(Index) < 0 Or NewMin(Index) > 60 Then txtMin(Index).Text = Trim(Str(LastMin(Index))) NewMin(Index) = LastMin(Index)

Else

LastMin(Index) = NewMin(Index) End If

End Sub

Private Sub txtSec_LostFocus(Index As Integer) NewSec(Index) = Val(txtSec(Index).Text)

If NewSec(Index) < 0 Or NewSec(Index) > 60 Then txtSec(Index).Text = Trim(Str(LastSec(Index))) NewSec(Index) = LastSec(Index)

Else

LastSec(Index) = NewSec(Index) End If

End Sub

'407 OK-PRD04===================

'408 OK-PRD04===================

Dim SumCash

(53)

Private Sub chkPrinter_Click() If chkPrinter.Value = 1 Then printer.Enabled = True Else

printer.Enabled = False End If

End Sub

Private Sub cmdCalculate_Click() SumCash = 1000

Select Case cboCPU.Text Case "Pentium III-300"

SumCash = SumCash + 2200 Case "Pentium III-350"

SumCash = SumCash + 5800 Case "Pentium III-400"

SumCash = SumCash + 7500 Case "K6-2 400"

SumCash = SumCash + 3250 End Select

Select Case cboMainBoard Case "ASUS"

SumCash = SumCash + 4750 Case "GIGA"

SumCash = SumCash + 3750 Case "SOYO"

SumCash = SumCash + 3650 Case "Aopen"

SumCash = SumCash + 3350 End Select

If optCDROM(0).Value = True Then SumCash = SumCash + 1500 End If

If optRAM(0).Value = True Then SumCash = SumCash + 1250 End If

If optRAM(1).Value = True Then SumCash = SumCash + 2000

(54)

End If

If optRAM(2).Value = True Then SumCash = SumCash + 4100 End If

If optMonitor(0).Value = True Then SumCash = SumCash + 4900 End If

If optHDD(0).Value = True Then SumCash = SumCash + 3500 End If

If printer.Enabled = True Then

If optPrinter(0).Value = True Then SumCash = SumCash + 5700 End If

End If

If chkModem.Value = 1 Then SumCash = SumCash + 1950 End If

If chkDVD.Value = 1 Then SumCash = SumCash + 4200 End If

If chkDIY.Value = 0 Then SumCash = SumCash + 1500 End If

lblTotal = SumCash End Sub

(55)

Private Sub Form_Load() chkDVD.Value = 0 chkModem.Value = 0 chkDIY.Value = 0 chkPrinter.Value = 0 printer.Enabled = False

cboCPU.AddItem "Pentium III-300"

cboCPU.AddItem "K6-2 400"

cboCPU.ListIndex = 0

cboMainBoard.AddItem "ASUS"

cboMainBoard.AddItem "GIGA"

cboMainBoard.AddItem "SOYO"

cboMainBoard.AddItem "Aopen"

cboMainBoard.ListIndex = 0 End Sub

'408 OK-PRD04===================

'409 OK-PRD04===================

Dim I, SumCash

Private Sub cmdCalculate_Click() SumCash = 0

For I = 0 To 4

SumCash = SumCash + Val(txtMealPrice(I)) * Val(txtMealQ(I)) Next I

For I = 0 To 5

SumCash = SumCash + Val(txtHotPrice(I)) * Val(txtHotQ(I)) SumCash = SumCash + Val(txtDrinkPrice(I)) * Val(txtDrinkQ(I)) Next I

lblTotal = Round((SumCash * 1.05), 0)

(56)

End Sub

Private Sub cmdReset_Click() Call ResetRtn

End Sub

Private Sub Form_Load() Call ResetRtn

End Sub

Public Sub ResetRtn()

lblTotal = "待客人點餐中"

For I = 0 To 4

vsbMeal(I).Max = 0 vsbMeal(I).Min = 10 vsbMeal(I).Value = 0 txtMealQ(I) = 0 Next I

For I = 0 To 5

vsbHot(I).Max = 0 vsbHot(I).Min = 10 vsbHot(I).Value = 0 txtHotQ(I) = 0 vsbDrink(I).Max = 0 vsbDrink(I).Min = 10 vsbDrink(I).Value = 0 txtDrinkQ(I) = 0 Next I

DoEvents End Sub

Private Sub vsbDrink_Change(Index As Integer) txtDrinkQ(Index) = vsbDrink(Index).Value End Sub

Private Sub vsbHot_Change(Index As Integer) txtHotQ(Index) = vsbHot(Index).Value End Sub

Private Sub vsbMeal_Change(Index As Integer) txtMealQ(Index) = vsbMeal(Index).Value End Sub

'409 OK-PRD04===================

(57)

'410 OK-PRD04===================

Dim SalaryRecord(), SalaryCount Dim I, SalaryRecordString

Dim TotalIncom, TotalFree, NetIncom, PayTax Dim LastPeople, NewPeople

Private Sub cmdIncome_Click()

SalaryRecordString = lblName.Caption & txtName.Text For I = 1 To SalaryCount

SalaryRecordString = SalaryRecordString & Chr(13) & Chr(10) &

Str(SalaryRecord(I)) Next I

MsgBox SalaryRecordString, vbOKOnly, "薪資明細"

End Sub

Private Sub cmdInput_Click()

If IsNumeric(txtIncome) And Val(txtIncome) > 0 Then SalaryCount = SalaryCount + 1

If SalaryCount <= 10 Then

SalaryRecord(SalaryCount) = Val(txtIncome)

TotalIncom = TotalIncom + SalaryRecord(SalaryCount)

(58)

If SalaryRecord(SalaryCount) > 60000 Then TotalFree = TotalFree + 60000

Else

TotalFree = TotalFree + SalaryRecord(SalaryCount) End If

End If

txtIncome = ""

Else

MsgBox "薪資輸入錯誤!", vbOKOnly, "錯誤"

End If

Call CalTaxRtn End Sub

Private Sub Form_Load() ReDim SalaryRecord(10) SalaryCount = 0

TotalIncom = 0 TotalFree = 0 NetIncom = 0 PayTax = 0 LastPeople = 0 NewPeople = 0

If optMarried.Value = True Then TotalFree = TotalFree + 65000 End If

If optUnmarried.Value = True Then TotalFree = TotalFree + 43000 End If

Private Sub optMarried_Click() Call CheckMarriedStatusRtn End Sub

Private Sub optUnmarried_Click() Call CheckMarriedStatusRtn End Sub

Public Sub CheckMarriedStatusRtn() If optMarried.Value = True Then TotalFree = TotalFree + 65000 Else

TotalFree = TotalFree - 65000

(59)

End If

If optUnmarried.Value = True Then TotalFree = TotalFree + 43000 Else

TotalFree = TotalFree - 43000 End If

Private Sub txtPeople_Change() NewPeople = Val(txtPeople) If NewPeople < 0 Then Exit Sub

Else

TotalFree = TotalFree + (NewPeople - LastPeople) * 72000 LastPeople = NewPeople

End If

Public Sub CalTaxRtn()

NetIncom = TotalIncom - TotalFree Select Case NetIncom

Case Is <= 370000

PayTax = NetIncom * 0.06 Case Is <= 990000

PayTax = NetIncom * 0.13 - 25900 Case Is <= 1980000

PayTax = NetIncom * 0.21 - 105100 Case Is <= 3720000

PayTax = NetIncom * 0.3 - 283300 Case Else

PayTax = NetIncom * 0.4 - 655300 End Select

PayTax = Round(PayTax, 0) If PayTax < 0 Then

PayTax = 0 End If

lblFreeTax = TotalFree lblTotalIncome = TotalIncom If NetIncom < 0 Then

lblNetIncome = 0 Else

lblNetIncome = NetIncom

(60)

End If

lblTax = PayTax End Sub

'410 OK-PRD04===================

VB6.0 TQC 檢定 第 1 類題

VB6.0 TQC 檢定第 1 類題