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
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
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()
'填入將 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.Print "塵緣如夢,幾番起伏總不平"
Picture1.Top = Picture2.Top '使 Picture1 與 Picture Picture1.Left = Picture2.Left '重疊
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
Picture1.Print "塵緣如夢,幾番起伏總不平"
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
'107 OK-PRD01===================
'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
Private Sub cmdEnd_Click() End
End Sub
'shpWizard: SHAPE --> 3 圓形 'shpWizard: FILLSTYLE --> 0 實心
'shpWizard: FILLCOLOR --> &H000000FF& 紅色 L3C2 '108 OK-PRD01===================
'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
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
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===================
VB6.0 TQC 檢定 第 2 類題
'201 OK-PRD02===================
Dim P As Integer
Private Sub cmdEnd_Click() End
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 cmdEnd_Click() End
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
End If End Sub
'202 OK-PRD02===================
'203 OK-PRD02===================
Dim mycolor As Integer Dim c$(9)
Private Sub cmdEnd_Click() End
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
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
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
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
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()
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
Private Sub Form_Load()
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
Private Sub cmdEnd_Click() End
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
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===================
'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===================
'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, "注意"
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===================
VB6.0 TQC 檢定 第 3 類題
'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
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, "警告"
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
PrimeNumberSum = PrimeNumberSum + PrimeNumberNear End If
Next I End If
txtNum = PrimeNumberCount txtSum = PrimeNumberSum txtLike = PrimeNumberNear End Sub
Private Sub Command1_Click() txtNum = ""
txtSum = ""
txtLike = ""
GetNum = Val(txtN.Text)
If GetNum < 2 Or GetNum > 32767 Then
MsgBox "N 超過 32767 或小於 2,請重新輸入", vbOKOnly, "警告"
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 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
PrimeNumberSum = PrimeNumberSum + PrimeNumberNear End If
Next I End If
txtNum = PrimeNumberCount txtSum = PrimeNumberSum txtLike = PrimeNumberNear End Sub
'302 OK-PRD03===================
'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"
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)
If GetNum < 0 Or GetNum > 10 Then
MsgBox "輸入 N 請小於等於 10!", vbInformation Exit Sub
End If
ReDim PascalTableA(10) '前次 ReDim PascalTablePrint(10) '印出 PascalTableA(0) = 1
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) = "無限多解"
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
If NumA <> 0 And NumB <> 0 And _
(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
If NumA <> 0 And NumB <> 0 And _
(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===================
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===================
'307 OK-PRD03===================
Dim PointX1, PointY1, PointX2, PointY2 Dim I, PiV, RationValue, PointNumber Private Sub cmdEnd_Click()
End End Sub
Private Sub cmdClear_Click() Picture1.Cls
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)
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
Private Sub cmdClear_Click() Picture1.Cls
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
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()
'請補入亂數顯示 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()
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===================
VB6.0 TQC 檢定 第 4 類題
'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
Private Sub Form_Load()
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
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===================
'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)
lblThing(Source.Index).Move (Source.Left + 500), (Source.Top) End Sub
Private Sub Form_Load()
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===================
'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 文件控管 '答對題數訊息框的訊息
'其訊息框的標題為"ACE大考驗!",答對題數為 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
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
Private Sub Form_Load()
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
If S = 2 And optAns(1).Value = True Then TotalRecord = TotalRecord + 1
'Exit Sub End If
If S = 3 And optAns(3).Value = True Then TotalRecord = TotalRecord + 1
'Exit Sub End If
If S = 4 And optAns(2).Value = True Then TotalRecord = TotalRecord + 1
'Exit Sub End If
If S = 5 And optAns(0).Value = True Then TotalRecord = TotalRecord + 1
'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===================
'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
Private Sub cmdEnd_Click() End
End Sub
Private Sub cmdNext_Click() Call GetNationIdRtn End Sub
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===================
'405 OK-PRD04===================
Dim LightDuration(), LightNo, KeepTime
Private Sub cmdEnd_Click() End
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)
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
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
Next I
cmdStart.Enabled = True For I = 0 To 3
chkWin(I).Enabled = True Next I
Yn = 0 '正常狀態 '測試
End Sub
'測試
Private Sub Form_Load()
Yn = 0 '控制重玩時不會加回賭金, 0:正常狀態 End Sub
'測試
'406 OK-PRD04===================
'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
Private Sub cmdEnd_Click() End
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) '交換
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
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
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 optCDROM(1).Value = True Then SumCash = SumCash + 1900 End If
If optCDROM(2).Value = True Then SumCash = SumCash + 2400 End If
If optRAM(0).Value = True Then SumCash = SumCash + 1250 End If
If optRAM(1).Value = True Then SumCash = SumCash + 2000
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 optMonitor(1).Value = True Then SumCash = SumCash + 9300 End If
If optMonitor(2).Value = True Then SumCash = SumCash + 15500 End If
If optHDD(0).Value = True Then SumCash = SumCash + 3500 End If
If optHDD(1).Value = True Then SumCash = SumCash + 3700 End If
If optHDD(2).Value = True Then SumCash = SumCash + 4200 End If
If printer.Enabled = True Then
If optPrinter(0).Value = True Then SumCash = SumCash + 5700 End If
If optPrinter(1).Value = True Then SumCash = SumCash + 6200 End If
If optPrinter(2).Value = True Then SumCash = SumCash + 10500 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
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 "Pentium III-350"
cboCPU.AddItem "Pentium III-400"
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)
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===================
'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)
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
Call CalTaxRtn End Sub
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
End If
If optUnmarried.Value = True Then TotalFree = TotalFree + 43000 Else
TotalFree = TotalFree - 43000 End If
Call CalTaxRtn End Sub
Private Sub txtPeople_Change() NewPeople = Val(txtPeople) If NewPeople < 0 Then Exit Sub
Else
TotalFree = TotalFree + (NewPeople - LastPeople) * 72000 LastPeople = NewPeople
End If
Call CalTaxRtn End Sub
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
End If
lblTax = PayTax End Sub
'410 OK-PRD04===================