English Deutsch Français Italiano Español Português 繁體中文 Bahasa Indonesia Tiếng Việt ภาษาไทย
所有分類

樂透模擬系統內容:
TEXT1個.Command1個
6個號碼1~48
我目前進度:
Dim a(6) as integer
for i = 1 to 6
x=int (Rnd*n+1)
a(i)=x
next i
Text1.text=sum
text1\"樂透號碼為:\";&Round(Rnd*48+1)
不知道哪邊有錯誤=.=+
-----------------------分隔線--------------------
阿拉伯數字轉換中文

Private Sub Command1_Click()
Text2.Text=ToChnWord(int(text1.text))
End Sub

Function ToChnWord(num As Long) As String
Const listnum=\"一二三四五六七八九\"
Dim s As String
Dim cnt As Integer
s=\"\"
cnt=0
While num>0
i=num Mod 10
num=num \\ 10
cnt=cnt+1
If i > 0 Then
Select Case cnt
Case 1: s = Mid(listnum, i , 1) +s
Case 2: s = Mid(listnum, i , 1) \"十\" +s
Case 3: s = Mid(listnum, i , 1) \"百\" +s
Case 4: s = Mid(listnum, i , 1) \"千\" +s
Case 5: s = Mid(listnum, i , 1) \"萬\" +s
Case 6: s = Mid(listnum, i , 1) \"十萬\" +s
Case 7: s = Mid(listnum, i , 1) \"百萬\" +s
Case 8: s = Mid(listnum, i , 1) \"千萬\" +s
End Select
Else
If Left(S,1)<>\"零\" then s = \"零\" + s
End If
Wend
If Right (s,1)=\"零\" then s = Left(s, Len(s)-1)
If Left (s,2)=\"一十\" Then S = Right(s,Len(s)-1)
ToChnWord=s
End Function

2006-03-22 10:32:56 · 1 個解答 · 發問者 Anonymous in 電腦與網際網路 程式設計

1 個解答

Private Sub Command1_Click()    Dim N&    On Error Resume Next    N = Int(Val(Text1.Text))    '防止溢位    If Err = 0 Then       Text2.Text = ToChnWord(N)    Else       Text2.Text = "溢位"    End IfEnd SubPrivate Sub Command2_Click() '以B陣列來判斷是否重複    Dim A(6) As String, B(1 To 48) As Boolean, X%, I%    Randomize    For I = 1 To 6        Do          X = Int(Rnd * 48 + 1)        Loop Until B(X) = False        A(I) = X: B(X) = True    Next I    Text1 = "樂透號碼為:" & Join(A)End Sub'有些地方少了 &,還有字串連接最好用 & 不要用 +Function ToChnWord(num As Long) As StringConst listnum = "一二三四五六七八九"Dim S As String, Cnt As IntegerIf num = 0 Then ToChnWord = "零": Exit FunctionWhile num > 0        I = num Mod 10        num = num \ 10        Cnt = Cnt + 1        If I > 0 Then            Select Case Cnt            Case 1: S = Mid(listnum, I, 1) + S                Case 2: S = Mid(listnum, I, 1) & "十" & S                Case 3: S = Mid(listnum, I, 1) & "百" & S                Case 4: S = Mid(listnum, I, 1) & "千" & S                Case 5: S = Mid(listnum, I, 1) & "萬" & S                Case 6: S = Mid(listnum, I, 1) & "十萬" & S                Case 7: S = Mid(listnum, I, 1) & "百萬" & S                Case 8: S = Mid(listnum, I, 1) & "千萬" & S                Case 9: S = Mid(listnum, I, 1) & "億" & S                Case 10: S = Mid(listnum, I, 1) & "十億" & S            End Select        Else            If Left(S, 1) <> "零" Then S = "零" & S        End IfWendIf Right(S, 1) = "零" Then S = Left(S, Len(S) - 1)If Left(S, 2) = "一十" Then S = Right(S, Len(S) - 1)'把多餘的億拿掉Do Until InStr(S, "億") = InStrRev(S, "億")   S = Replace(S, "億", "", , 1)Loop'把多餘的萬拿掉Do Until InStr(S, "萬") = InStrRev(S, "萬")   S = Replace(S, "萬", "", , 1)LoopToChnWord = SEnd Function

2006-03-23 13:32:20 補充:
請把Dim A(6) As String 改成 Dim A(1 To 6) As String

2006-03-23 08:16:29 · answer #1 · answered by W.J.S. 7 · 0 0

fedest.com, questions and answers