一道VB的程序题

加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

待续，未完

Private Function yh(n As Integer)

Dim a() As Integer

ReDim a(1 To n, 1 To n)

Print

Print

For i = 1 To n

a(i, 1) = 1

a(i, i) = 1

Next i

For i = 3 To n

For j = 2 To i - 1

a(i, j) = a(i - 1, j) + a(i - 1, j - 1)

Next j

Next i

Print

Print

For i = 1 To n

For j = 1 To i

Print Tab(20 - 2 i + 4 j); a(i, j);

Next j

Print

Next i

End Function

Private Sub Form_Load()

Dim n As Integer

MeShow

n = InputBox("输入行数：")

yh n

End Sub

以上就是关于一道VB的程序题全部的内容，包括:一道VB的程序题、vb程序设计实例100、急！2道大学VB程序设计题,希望高手帮忙！（截止至今晚7点）等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！