VB编程题:编写一个产生1 至100之间的随机整数的Function 过程

VB编程题:编写一个产生1 至100之间的随机整数的Function 过程,第1张

Rnd函数产生的是0和1之间的随机数,范围是[0,1),包括0,但不包括1。

因此要产生1~100之间的随机数,可以使用Rnd98,产生的是[0,98)的随机数,而int(Rnd98)产生的是[0,97]之间的随机整数,那么int(Rnd98)+2产生的就是[2,99]之间的随机整数了,符合目标1到100之间的随机数目的。

函数代码如下:

Public Function sj() As Integer

Randomize

sj = Int(Rnd  98) + 2

End Function

扩展资料:

语法:

Rnd[(number)]

如果 number 的值是 Randomize 生成

小于 0 ,每次都使用 number 作为随机数种子得到的相同结果。

大于 0 ,以上一个随机数为种子产生下一个随机数。

等于 0 ,产生与最近生成的随机数相同的随机数。

省略, 以上一个随机数为种子产生下一个随机数。

说明:

Rnd 函数返回小于 1 但大于或等于 0 的值。

number 的值决定了 Rnd 生成随机数的方式。

对最初给定的种子都会生成相同的数列,因为每一次调用 Rnd 函数都用数列中的前一个数作为下一个数的种子。

在调用 Rnd 之前,先使用无参数的 Randomize语句初始化随机数生成器(若带参数,则产生由参数对应的一个特定序列的随机数),该生成器具有根据系统计时器得到的种子。

为了生成某个范围内的随机整数,可使用以下公式:

Int((upperbound - lowerbound + 1) Rnd + lowerbound)

这里,upperbound 是随机数范围的上限,而 lowerbound 则是随机数范围的下限。

注意 若想得到重复的随机数序列,在使用具有数值参数的 Randomize 之前直接调用具有负参数值的 Rnd。使用具有同样 number 值的 Randomize 是不会得到重复的随机数序列的。

参考资料:

百度百科——rnd(随机函数)

加picturebox(改为PicSource),line(改为LinMov)两个label(LabRow(0),LabCol(0),三个label(改为Labt1,labt2,labt3),三个shape(shape1,shape2,shape3),Text1(不用改名)这里改的都是说Caption属性 )

窗体中的代码

Dim TmEnable As Boolean '记录是不是第一次日启动记时器

Dim VrrTmp(30, 30) As Double '记录横坐标,纵坐标

Dim vrrtmpA(30, 30) As Double, 第二条曲线

Dim intX, intX1 As Integer '直线两端的X坐标值

Dim rtn As String

Dim AllColor, AllColor1 As Double

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Dim RowWidth() As Integer '坚线下边的标识的横坐标

Dim ColHeight() As Integer '横线左边的标识的纵坐标

Private Sub CmdBegin_Click()

Dim i As Integer

Dim KeDu As Integer '定义横坐标的刻度

KeDu = PicSourceScaleWidth / UBound(VrrTmp)

'数组附初值

For i = 0 To UBound(VrrTmp, 2) - 1

VrrTmp(i, 0) = Rnd 1300 '纵坐标负值

If i <> 0 Then

VrrTmp(i, 1) = VrrTmp(i - 1, 1) + KeDu '横坐标负值

End If

Next

For i = 0 To UBound(vrrtmpA, 2) - 1

vrrtmpA(i, 0) = Rnd 900 '纵坐标负值

If i <> 0 Then

vrrtmpA(i, 1) = vrrtmpA(i - 1, 1) + KeDu '横坐标负值

End If

Next

Call DrawLine

' Timer1Enabled = True

End Sub

Private Sub Form_Load()

Dim i As Integer

PicSourceScale (0, PicSourceHeight)-(PicSourceWidth, 0)

TmEnable = False

Call DrawRow(9)

For i = 0 To 8 '下边刻度的值

If i >= 8 Then Exit For

CreatControlRow i + 1, (i + 1) 3, picwidth + RowWidth(i), PicSourceTop + PicSourceHeight + 30

Next i

Call DrawCol(8)

For i = 0 To 7 '左边刻度的值

If i >= 7 Then Exit For

CreatControlCol i + 1, (i + 1) 2, PicSourceLeft - LabCol(0)Width, ColHeight(i)

Next i

End Sub

Private Sub LabT1_Click()

Dim Cc As ChooseColor

CclStructSize = Len(Cc)

CchwndOwner = MehWnd

CchInstance = ApphInstance

Ccflags = 0

CclpCustColors = String$(16 4, 0)

rtn = ChooseColor(Cc)

If rtn >= 1 Then

Shape1FillStyle = 0

Shape1FillColor = CcrgbResult

AllColor = CcrgbResult

End If

End Sub

Private Sub LabT2_Click()

Dim Cc As ChooseColor

CclStructSize = Len(Cc)

CchwndOwner = MehWnd

CchInstance = ApphInstance

Ccflags = 0

CclpCustColors = String$(16 4, 0)

rtn = ChooseColor(Cc)

If rtn >= 1 Then

Shape2FillStyle = 0

Shape2FillColor = CcrgbResult

AllColor1 = CcrgbResult

End If

End Sub

Private Sub DrawLine()

'画图

'数组的排序为从新到老

Dim TmpArr As Double

Dim i As Integer

PicSourceCls

AllColor = Shape1FillColor

If Check1Value = 1 Then

DrawRow (9)

End If

If Check2Value = 1 Then

DrawCol (8)

End If

TmpArr = Rnd 1300

For i = UBound(VrrTmp, 2) - 1 To 1 Step -1

VrrTmp(i, 0) = VrrTmp(i - 1, 0)

Next

VrrTmp(0, 0) = TmpArr '将新得到的数据放到数组的起始位置即第一个

For i = UBound(VrrTmp, 2) - 1 To 1 Step -1

If VrrTmp(i, 0) <> 0 Then

PicSourceLine (VrrTmp(i, 1), -PicSourceScaleHeight / 2 + VrrTmp(i, 0))-(VrrTmp(i - 1, 1), -PicSourceScaleHeight / 2 + VrrTmp(i - 1, 0)), AllColor

End If

Next

'第二条曲线

TmpArr = Rnd 900

For i = UBound(vrrtmpA, 2) - 1 To 1 Step -1

vrrtmpA(i, 0) = vrrtmpA(i - 1, 0)

Next

vrrtmpA(0, 0) = TmpArr '将新得到的数据放到数组的起始位置即第一个

For i = UBound(vrrtmpA, 2) - 1 To 1 Step -1

If vrrtmpA(i, 0) <> 0 Then

PicSourceLine (vrrtmpA(i, 1), -PicSourceScaleHeight / 2 + vrrtmpA(i, 0))-(VrrTmp(i - 1, 1), -PicSourceScaleHeight / 2 + vrrtmpA(i - 1, 0)), AllColor1

End If

Next

End Sub

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

Dim Bfb As Integer

LinMovX1 = X

LinMovX2 = X

LinMovY1 = 0

LinMovY2 = PicSourceHeight

LinMovVisible = True

If X <= 10 Or X >= PicSourceScaleWidth - 180 Then LinMovVisible = False

If Y <= 70 Or Y >= -(PicSourceScaleHeight) - 70 Then LinMovVisible = False

Bfb = PicSourceHeight / 7

If LinMovVisible = True Then

Text1Text = (GetValue(X, AllColor) / Bfb) 2

End If

End Sub

Private Function GetValue(ByVal X As Integer, ByVal Canshi As Double) As Double

'得到当前曲线的值

'传入参数:

'X--标准线的横坐标

'对比的条件,曲线的颜色值

Dim j As Integer

Dim TmpColor As Double

For j = 0 To PicSourceHeight

TmpColor = GetPixel(PicSourcehdc, X / 15, j / 15)

If TmpColor = Canshi Then

GetValue = -PicSourceScaleHeight - j

Exit For

End If

Next j

End Function

Private Sub DrawRow(ByVal IntPoint As Integer)

'画网络的竖线

'传入参数:IntPoint--横坐标上的点数

Dim MinUnit As Double '两点之间的距离

Dim H As Integer

ReDim RowWidth(IntPoint - 1)

PicSourceDrawStyle = 2

MinUnit = PicSourceWidth / (IntPoint - 1)

For H = 0 To IntPoint - 1

PicSourceLine (MinUnit (H + 1), 0)-(MinUnit (H + 1), PicSourceHeight), RGB(23, 43, 43)

RowWidth(H) = PicSourceLeft + (H + 1) MinUnit

Next H

PicSourceDrawStyle = 0

End Sub

Private Sub DrawCol(ByVal IntPoint As Integer)

'画网络的横线

'传入参数:IntPoint--横坐标上的点数

Dim MinUnit As Double '两点之间的距离

Dim H As Integer

ReDim ColHeight(IntPoint - 1)

PicSourceDrawStyle = 2

MinUnit = PicSourceHeight / (IntPoint - 1)

For H = 0 To IntPoint - 1

PicSourceLine (0, MinUnit (H + 1))-(PicSourceWidth, MinUnit (H + 1)), RGB(23, 43, 43)

ColHeight(H) = PicSourceTop + (PicSourceHeight - MinUnit (H + 1))

Next H

PicSourceDrawStyle = 0

End Sub

Private Sub CreatControlCol(ByVal Index As Integer, ByVal Name As String, ByVal X As Integer, ByVal Y As Integer)

'动态生成左边的Label控件

'输入参数:

'Index---控件索引

'Name----控件的Caption属性

Load MeLabCol(Index)

LabCol(Index)Top = LabCol(Index - 1)Top + 2 LabCol(Index)Height

LabCol(Index)Caption = Name

LabCol(Index)Visible = True

LabCol(Index)Left = X

LabCol(Index)Top = Y

End Sub

Private Sub CreatControlRow(ByVal Index As Integer, ByVal Name As String, ByVal X As Integer, ByVal Y As Integer)

'动态生成下边的Label控件

'输入参数:

'Index---控件索引

'Name----控件的Caption属性

Load MeLabRow(Index)

LabRow(Index)Top = LabRow(Index - 1)Top + 2 LabRow(Index)Height

LabRow(Index)Caption = Name & ":" & "00"

LabRow(Index)Visible = True

LabRow(Index)Left = X

LabRow(Index)Top = Y

End Sub

横块中的代码

Option Explicit

'调用颜色对话框

Declare Function ChooseColor Lib "comdlg32dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

Type ChooseColor

lStructSize As Long

hwndOwner As Long

hInstance As Long

rgbResult As Long

lpCustColors As String

flags As Long

lCustData As Long

lpfnHook As Long

lpTemplateName As String

End Type

以前写的不成熟的工业曲线画法,送你了

完全可以运行,只要你控件增加的是正确的

试题一1

Private Sub Form_Click()

Print fs_sum(100)

End Sub

Function fs_sum(ByVal n As Integer) As Single

Dim s!, nc! '和与倒数

s=0

For i = 1 To n

nc = 1 / i

s = s + nc

Next i

fs_sum = s

End Function

试题一2

Private Sub Form_Click()

For i = 1 To 4

Print Space(4 - i);

For j = 1 To i

Print " ";

Next j

Print

Next i

End Sub

待续,未完

Dim AA(1 To 10) As Integer

Private Sub Command1_Click()

For I = 1 To 10

AA(I) = Val(InputBox("请输入第" & I & "个学生的成绩:"))

Next I

Command2Enabled = True

End Sub

Private Sub Command2_Click()

Dim DY60 As Integer, XY60 As Integer, SS As Single

For I = 1 To 10

    If AA(I) >= 60 Then DY60 = DY60 + 1

    If AA(I) < 60 Then XY60 = XY60 + 1

    SS = SS + AA(I)

Next I

Text1Text = DY60

Text2Text = XY60

Text3Text = Format(SS / 10, "000")    '格式化数据,显示小数后二位

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Form_Load()

Text1Text = ""

Text2Text = ""

Text3Text = ""

Command2Enabled = False

End Sub

代码不多,界面与你的界面一样,不再抓图了。

你这小子,是不是在搞自修啊,

我看到你在网上放了无数个类似的题目啦,

这么简单的问题,自己不动脑筋,光求个答案敷衍教师了事啊

建议大家都不要为这点小分误了程序员这个行当

你只要在窗口中放一个frame,再在frame中放两个label1和label2。再在frame外面放一个label3,一个command1,一个text1。其他由程序完成,程序如下,已经运行过:

Private Sub Command1_Click()

    Dim Sum As String

    Dim N As Integer

    Dim I As Integer, J As Integer, K As Integer

    Dim S As Integer

    N = Val(Text1)

    For I = 1 To N

        If I = 1 And (N Mod 2 = 0) Then K = -1 Else K = 1

        S = 0

        For J = 1 To I

            S = S + K

            K = -K

        Next

        Sum = Sum & S

    Next

    If Right(Sum, 1) = "1" Then Sum = Sum & "1"

    For I = 1 To Len(Sum)

        If Mid(Sum, I, 1) = "1" Then Mid(Sum, I, 1) = "3"

    Next

    Label2Caption = Sum

End Sub

 

Private Sub Form_Load()

    With Form1

        Caption = "求和计算"

        Width = 7000

        Height = 4000

    End With

    With Frame1

        Caption = "求数列前N项和"

        Width = 6000

        Height = 1000

        Top = 500

        Left = 500

    End With

    With Label1

        Width = 2500

        Height = 500

        Caption = "33-333+3333-33333+="

        Top = 400

        Left = 100

    End With

    With Label2

        Width = Frame1Width - (Label1Left + Label1Width) - 100

        Height = Label1Height

        Caption = ""

        Top = 400

        Left = Label1Left + Label1Width

    End With

    With Text1

        Width = 1000

        Height = 300

        Text = ""

        Top = 2500

        Left = 4000

    End With

    With Command1

        Caption = "计算"

        Width = 1000

        Height = 300

        Top = 2500

        Left = 1000

    End With

    With Label3

        Width = 2000

        Height = Label1Height

        Caption = "输入N的值,N="

        Top = Command1Top

        Left = Command1Left + Command1Width + 500

    End With

End Sub

Private Sub form_click()

Dim i As Integer, a As Integer '定义i、a为整数变量

a = 1 '给a赋值为1

For i = 1 To 10 'i值从1到10循环

If i Mod 3 = 2 Then '如果i除以3的余数为2,则

a = a i 'a的值变为其原来的值乘以i

End If '结束If过程

Next i '结束循环

Print a '在窗体上打印出a的值

End Sub '过程结束

所以结果是:1至10中的能够除以3余数为2 的所有数的乘积

而1到10中 能够除以3余2的数只有:2、5、8

他们的乘积为:258=80

以上就是关于VB编程题:编写一个产生1 至100之间的随机整数的Function 过程全部的内容,包括:VB编程题:编写一个产生1 至100之间的随机整数的Function 过程、一道VB的程序题、vb程序设计实例100等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/zz/10214144.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-06
下一篇 2023-05-06

发表评论

登录后才能评论

评论列表(0条)

保存