Question

一道简单的VB代码编写题。急！在线等。

先编写一通用过程，用于判断一个整数是否是“桃花数”（所谓“桃花数”是指一个4位数，其各位数字的4次方和等于该数本身）。然后在单击窗体时，调用该通用过程，输出所有的“桃花数”。
3楼错误的。

Answer 1

Private Sub th_sub(n)
Dim a() As Integer
Dim x As Integer, y As Long
y = 0
x = Len(CStr(n))
ReDim a(1 To x) As Integer
For i = 1 To x
a(i) = Val(Mid(n, i, 1))
y = y + a(i) ^ 4
Next
If y = n Then Print n & "是桃花数"
End Sub

Private Sub Form_Click()
For i = 0 To 100000
Call th_sub(i)
Next
End Sub

Answer 2

界面在我空间里!你直接到我空间看!我的版本是VS2005的VB

'说明:minTB文本框输入最小数,maxTB文本框输入最大数,xsTB富文本框(RichTextBox)用来显示计算的结果
'jbTB文本框输入总的段落数,jzTB文本框输入每段落的组(行)数,jgTB文本框输入每组(行)的号码个数
Public Class Form1
Dim min, max, jd, jz, jg As Integer 'max表示最大整数,jd表示共几段,jz表示几组,jg表示几个
Dim xc As New System.Threading.Thread(AddressOf play) '建立一个指向play过程的新线程xc
Private Sub playbtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles playbtn.Click
Timer1.Enabled = False
If playbtn.Text = "开始" Then
'如果playbtn按钮显示"开始",则...
playbtn.Text = "暂停"
xsTB.Text = ""
min = minTB.Text : max = maxTB.Text : jd = jdTB.Text : jz = jzTB.Text : jg = jgTB.Text
'将文本框数值赋值给变量
minTB.Enabled = False : maxTB.Enabled = False : jdTB.Enabled = False : jzTB.Enabled = False : jgTB.Enabled = False
'将文本框设置为不可用,防止在运算过程中数据被更改
If xc.ThreadState = Threading.ThreadState.Unstarted Then
'如果xc线程从未启动过,则...
xc.Priority = Threading.ThreadPriority.BelowNormal '设置xc线程的优先级为较慢,较少的占用CPU
xc.Start() '启动线程xc
ElseIf xc.ThreadState = Threading.ThreadState.Suspended Then

'当xc线程处于挂起状态,结合playbtn.text="开始",即线程已运行过且目前不在运算中,条件成立则...
xc.Resume() '恢复被挂起(暂停)的xc线程
End If
ElseIf playbtn.Text = "暂停" And xc.ThreadState <> Threading.ThreadState.Suspended Then
'如果playbtn按钮显示"暂停"且线程不是挂起状态,即如果线程正在执行循环运算,条件成立则...
playbtn.Text = "恢复"
xc.Suspend() '暂停xc线程的运算
ElseIf playbtn.Text = "恢复" And xc.ThreadState = Threading.ThreadState.Suspended Then
'如果playbtn按钮显示"恢复"且线程处于挂起状态,即如果xc线程在执行运算时被暂停,条件成立则...
xc.Resume() '恢复xc线程被挂起(暂停)的运算
playbtn.Text = "暂停"
End If
Timer1.Enabled = True
End Sub
Private Sub play()
Do '无限循环避免xc线程结束,防止结束后重新启动线程需要再定义!
Dim d, z, g As Integer, str, tt As String
str = ""
Randomize()
For d = 1 To jd
str = str & vbCrLf & "自定义选项=随机第" & CStr(d).PadLeft(CStr(jd).Length, "0") & "分段" & vbCrLf
For z = 1 To jz
str = str & "随机第" & CStr(d).PadLeft(CStr(jd).Length, "0") & "分段_第" & CStr(z).PadLeft(CStr(jz).Length, "0") & "组"
For g = 1 To jg
tt = CStr(Fix(max * Rnd()) + 1).PadLeft(CStr(max).Length, "0")
str = str & " " & tt
Next
str = str & vbCrLf
Me.SetText(str) '将str字符串赋值给文本框,线程不能直接使用其它线程的控件,所以必须委托该控件的建立者!
Next
Next
xc.Suspend() '运算完成后将线程挂起(暂停),直到其它线程执行xc.resume()语句
Loop '进入下一次运算组合,只要不退出此过程,线程不会结束!
End Sub
Delegate Sub SetTextCallback(ByVal str As String) '定义settextcallback为一个委托类
Private Sub SetText(ByVal str As String)
If Me.xsTB.InvokeRequired Then '如果调用xsTB文本框的线程不是其所在的线程
Dim k As New SetTextCallback(AddressOf SetText) '创建settextcallback委托类的实例k,并指定该实例的方法为settext
Me.Invoke(k, New Object() {str}) '在控件所在的线程中执行委托实例k指定的方法(其实就是要求主线程运行一下settext过程)
Else '如果调用xsTB文本框的线程是其所在的线程
Me.xsTB.Text = str '将str内容添加到xsTB文本框
End If
End Sub
Private Sub exitbtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles exitbtn.Click
End
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If xc.ThreadState = Threading.ThreadState.Suspended And playbtn.Text = "暂停" Then
'当xc线程挂起且playbtn按钮显示"暂停"时,即表示线程内的循环运算已经完成,将文本框与按钮重置!
minTB.Enabled = True : maxTB.Enabled = True : jdTB.Enabled = True : jzTB.Enabled = True : jgTB.Enabled = True
'重新启用文本框及按钮
playbtn.Text = "开始"
End If
End Sub
End Class

参考资料：http://hi.baidu.com/lgf126/blog/item/da96c123c9b195559822ede5.html

Answer 3

楼上的什么啊，乱七八糟的。如果需要，联系我。

Answer 4

Private Sub Command1_Click()
For a = 1000 To 9999
q = Val(Mid(a, 1, 1))
b = Val(Mid(a, 2, 1))
s = Val(Mid(a, 3, 1))
g = Val(Mid(a, 4, 1))
If q ^ 4 + b ^ 4 + s ^ 4 + g ^ 4 = a Then Print a
Next
End Sub

结果为：
1634
8208
9474

Answer 5

Private Sub Command1_Click()
Call search
End Sub

Private Sub search()
Dim i%
Dim a%, b%, c%, d%
For i = 1000 To 9999
a = Val(Mid(CStr(i), 1, 1))
b = Val(Mid(CStr(i), 2, 1))
c = Val(Mid(CStr(i), 3, 1))
d = Val(Mid(CStr(i), 4, 1))
If a ^ 4 + b ^ 4 + c ^ 4 + d ^ 4 = i Then
Print i
End If
Next i
End Sub