当前位置：文档之家 › VB画图版的原程序

VB画图版的原程序

  • 格式：docx
  • 大小：13.21 KB
  • 文档页数：13

Dim startx, starty, x1, y1, drawtype, i, j, a, b, c, d Dim nX, nY As LongPrivate Sub Form_Load()Timer1.Enabled = FalseEnd SubPrivate Sub juxing_Click()drawtype = 3penqiang.Checked = Falseyuan.Checked = Falsezhixian.Checked = Falsejuxing.Checked = Truewenzi.Checked = Falseshouhui.Checked = Falseshanxing.Checked = Falseshanxing.Checked = FalseEnd SubPrivate Sub new_Click()Picture1.Picture = LoadPicture()End SubPrivate Sub open1_Click()cdg1.DialogTitle = "打开图片"cdg1.Filter = "bmp文件|*.bmp|jpg文件|*.jpg|"cdg1.ShowOpenPicture1.Picture = LoadPicture(cdg1.FileName) End SubPrivate Sub Option1_Click()Picture1.ForeColor = vbBlackEnd SubPrivate Sub Option10_Click()Picture1.DrawWidth = 4End SubPrivate Sub Option11_Click()Dim r As Singler = InputBox("请输入线条宽度值：", "自定义") r = Val(r)Picture1.DrawWidth = rEnd SubPrivate Sub Option2_Click()Picture1.ForeColor = vbRedEnd SubPrivate Sub Option3_Click()Picture1.ForeColor = vbBlueEnd SubPrivate Sub Option4_Click()Picture1.ForeColor = vbYellowEnd SubPrivate Sub Option5_Click()Picture1.ForeColor = vbGreenEnd SubPrivate Sub Option6_Click()cdg1.Flags = cdlCFBoth + cdlCFEffects cdg1.ShowColorPicture1.ForeColor = cdg1.ColorEnd SubPrivate Sub Option7_Click()Picture1.DrawWidth = 1End SubPrivate Sub Option8_Click()Picture1.DrawWidth = 2End SubPrivate Sub Option9_Click()Picture1.DrawWidth = 3End SubPrivate Sub penqiang_Click() drawtype = 8penqiang.Checked = True tuoyuan.Checked = False shanxing.Checked = Falseyuan.Checked = Falsezhixian.Checked = Falsejuxing.Checked = Falsewenzi.Checked = Falseshouhui.Checked = FalseEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)startx = Xstarty = Yx1 = Xy1 = YText1.Left = XText1.Top = YPicture1.CurrentX = XPicture1.CurrentY = YIf Button = 1 And drawtype = 8 ThenTimer1.Enabled = TruenX = XnY = YEnd IfEnd SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Select Case drawtypeCase 1If Button = 1 ThenPicture1.DrawMode = 6Picture1.Circle (startx, starty), Sqr((x1 - startx) ^ 2 + (y1 - starty) ^ 2)Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2)y1 = YEnd IfCase 2If Button = 1 ThenPicture1.DrawMode = 6Picture1.Line (startx, starty)-(x1, y1) Picture1.Line (startx, starty)-(X, Y)x1 = Xy1 = YEnd IfCase 3If Button = 1 ThenPicture1.DrawMode = 6Picture1.Line (startx, starty)-(x1, y1), , B Picture1.Line (startx, starty)-(X, Y), , B x1 = Xy1 = YEnd IfCase 4If Button = 1 ThenPicture1.DrawMode = 13Picture1.Line -(X, Y)End IfCase 5If Button = 1 ThenPicture1.DrawMode = 6Picture1.Line (startx, starty)-(x1, y1), , B Picture1.Line (startx, starty)-(X, Y), , By1 = YEnd IfCase 6If Button = 1 ThenPicture1.DrawMode = 6Picture1.Circle (startx, starty), Sqr((x1 - startx) ^ 2 + (y1 - starty) ^ 2), , , , (y1 - starty) / (x1 - startx + 1)Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2), , , , (Y - starty) / (X - startx + 1)x1 = Xy1 = YEnd IfCase 7If Button = 1 ThenPicture1.DrawMode = 6Picture1.Circle (startx, starty), Sqr((x1 - startx) ^ 2 + (y1 - starty) ^ 2), , -c * 3.14 / 180, -d * 3.14 / 180Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2), , -c * 3.14 / 180, -d * 3.14 / 180x1 = Xy1 = YEnd IfCase 8If Button = 1 ThenTimer1.Enabled = TruenX = XnY = YEnd IfEnd SelectEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)Select Case drawtypeCase 1Picture1.DrawMode = 13Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2)Case 2Picture1.DrawMode = 13Picture1.Line (startx, starty)-(X, Y)Case 3Picture1.DrawMode = 13Picture1.Line (startx, starty)-(X, Y), , BCase 5Text1.Top = startyText1.Left = startxText1.Text = ""Text1.Visible = TrueText1.SetFocusPicture1.DrawMode = 6Picture1.Line (startx, starty)-(X, Y), , BCase 6Picture1.DrawMode = 13Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2), , , , (Y - starty) / (X - startx)Case 7Picture1.DrawMode = 13Picture1.Circle (startx, starty), Sqr((X - startx) ^ 2 + (Y - starty) ^ 2), , -c * 3.14 / 180, -d * 3.14 / 180Case 8Timer1.Enabled = FalseEnd SelectEnd SubPrivate Sub save_Click()cdg1.Filter = ".jpg|*.jpg|.bmp|*.bmp|"cdg1.ShowSaveSavePicture Picture1.Image, cdg1.FileName End SubPrivate Sub shanxing_Click()drawtype = 7penqiang.Checked = Falsetuoyuan.Checked = Falseshanxing.Checked = Trueyuan.Checked = Falsezhixian.Checked = Falsejuxing.Checked = Falsewenzi.Checked = Falseshouhui.Checked = Falsea = InputBox("请输入起始角度：", "输入数据")b = InputBox("请输入终止角度：", "输入数据")c = Val(a)d = Val(b)End SubPrivate Sub shouhui_Click()drawtype = 4penqiang.Checked = Falseyuan.Checked = Falsezhixian.Checked = Falsejuxing.Checked = Falsewenzi.Checked = Falseshouhui.Checked = Trueshanxing.Checked = Falsetuoyuan.Checked = FalseEnd SubPrivate Sub Text1_Click()drawtype = 5End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn ThenText1.Visible = FalsePicture1.CurrentX = startxPicture1.CurrentY = startyPicture1.BorderStyle = Text1.BorderStyle Picture1.FontItalic = TruePicture1.Font = Text1.FontPicture1.FontSize = Text1.FontSizePicture1.FontBold = TruePicture1.ForeColor = Text1.ForeColorPicture1.FontUnderline = Text1.FontUnderline Picture1.FontStrikethru = Text1.FontStrikethruPicture1.Print Text1.TextEnd IfEnd SubPrivate Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Select Case drawtypeCase 5If Button = 2 ThenText1.Enabled = FalseText1.Enabled = TrueForm1.PopupMenu gsEnd IfEnd SelectEnd SubPrivate Sub Timer1_Timer()Picture1.DrawWidth = 1For i = -10 To 10For j = -10 To 10Picture1.PSet (nX + Rnd * i * 100, nY + Rnd * j * 100)Next jNext iEnd SubPrivate Sub tui_Click()EndEnd SubPrivate Sub tuoyuan_Click() drawtype = 6tuoyuan.Checked = True penqiang.Checked = False shanxing.Checked = False yuan.Checked = False zhixian.Checked = False juxing.Checked = False wenzi.Checked = False shouhui.Checked = False End SubPrivate Sub wenzi_Click() drawtype = 5 penqiang.Checked = False yuan.Checked = False zhixian.Checked = False juxing.Checked = False wenzi.Checked = True shouhui.Checked = False tuoyuan.Checked = False shanxing.Checked = False End SubPrivate Sub yuan_Click() drawtype = 1yuan.Checked = True penqiang.Checked = Falsepenqiang.Checked = False zhixian.Checked = Falsejuxing.Checked = Falsewenzi.Checked = Falseshouhui.Checked = FalseEnd SubPrivate Sub zhixian_Click() drawtype = 2penqiang.Checked = Falseyuan.Checked = Falsezhixian.Checked = Truejuxing.Checked = Falsewenzi.Checked = Falseshouhui.Checked = False tuoyuan.Checked = False shanxing.Checked = FalseEnd SubPrivate Sub zt_Click()cdg1.Flags = cdlCFBoth + cdlCFEffects cdg1.FontName = "宋体"cdg1.ShowFontWith Text1.FontName = cdg1.FontName.FontSize = cdg1.FontSize.FontBold = cdg1.FontBold.FontItalic = cdg1.FontItalic.FontUnderline = cdg1.FontUnderline.FontStrikethru = cdg1.FontStrikethru .ForeColor = cdg1.ColorEnd WithEnd Sub。

合集下载

画图程序VB代码

画图程序VB代码

If DrawBlack Then '标志已按下鼠标再拖动
'清除原来位置画的线段
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
Case 1 '画选择框
DrawBlack = True
x0 = x: y0 = y
Sx0 = x: Sy0 = y
Picture1.DrawStyle = 2
xnow = x: ynow = y
Picture1.Line (x0, y0)-(x, y), Not (Picture1.ForeColor)
xnow = x: ynow = y
End If
Case 1
If DrawBlack Then
Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
Picture1.DrawWidth = Linewdh
Picture1.DrawStyle = 0
Picture1.DrawMode = 13
End If
End Sub
Private Sub PicColor_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim x0, y0, xnow, ynow As Single
Private Sub Form_Load()
Linewdh = 1
DrawTool = 0
End Sub
Private Sub LblWidth_Click(Index As Integer)
vb源程序

vb源程序

Private Declare Function Getpixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As LongPrivate Declare Function Setpixel Lib "gdi32" Alias "SetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As LongPrivate Sub BJWSJS_Click()Dim dogr(0 To 1000, 0 To 1000)Dim dogg(0 To 1000, 0 To 1000)Dim dogb(0 To 1000, 0 To 1000)Dim monkeyr(0 To 1000, 0 To 1000)Dim monkeyg(0 To 1000, 0 To 1000)Dim monkeyb(0 To 1000, 0 To 1000)Dim JS1 As IntegerJS1 = 0Dim JS2 As IntegerJS2 = 0Dim JS3 As IntegerJS3 = 0Dim JS4 As IntegerJS4 = 0Dim JS5 As IntegerJS5 = 0Dim JS6 As IntegerJS6 = 0Dim AS1 As SingleDim AS2 As SingleDim AS3 As SingleDim AS4 As SingleDim AS5 As SingleDim AS6 As SingleDim AKS1 As SingleDim AKS2 As SingleDim AKS3 As SingleDim AKS4 As SingleDim AKS5 As SingleDim AKS6 As SingleDim WAI1 As SingleDim WAI2 As SingleDim WAI3 As SingleDim WAI4 As SingleDim WAI5 As SingleDim WAI6 As SingleDim SGMX As SingleDim SGMY As SingleDim SGMXY As SingleDim SGMXF As SingleDim LXY As SingleDim LXX As SingleDim b As SingleDim a As SingleDim file_num As IntegerDim toughold As IntegerDim chenren As IntegerFor i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightdogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))If dogr(i, j) <> 255 ThenSetpixel Picture1.hdc, i, j, RGB(0, 0, 0)End IfNext jNext iFor i = 1 To Picture1.ScaleWidthFor j = 1 To Picture1.ScaleHeighta = getrvalue(Getpixel(Picture1.hdc, i, j))If a = 0 Then '如果该点为黑色则分析For s = -1 To 1For t = -1 To 1b = getrvalue(Getpixel(Picture1.hdc, i + s, j + t)) '获取当前点周围9个点的颜色分量C = getgvalue(Getpixel(Picture1.hdc, i + s, j + t))D = getbvalue(Getpixel(Picture1.hdc, i + s, j + t))If b = 255 ThenIf C = 0 ThenIf D = 0 Then '如果周围9个点有一个或多个是白Picture1.PSet (i, j), RGB(255, 0, 0) '则此点为红End IfEnd IfEnd IfNext tNext sEnd IfNext jNext iFor i = 1 To Picture1.ScaleWidthFor j = 1 To Picture1.ScaleHeightE = getrvalue(Getpixel(Picture1.hdc, i, j))F = getgvalue(Getpixel(Picture1.hdc, i, j))G = getbvalue(Getpixel(Picture1.hdc, i, j))If E = 0 ThenIf F = 0 ThenIf G = 0 ThenPicture1.PSet (i, j), RGB(255, 255, 255)End IfEnd IfEnd IfNext jNext iFor i = 1 To Picture1.ScaleWidthFor j = 1 To Picture1.HeightH = getrvalue(Getpixel(Picture1.hdc, i, j))K = getgvalue(Getpixel(Picture1.hdc, i, j))L = getbvalue(Getpixel(Picture1.hdc, i, j))If H = 255 ThenIf K = 1 ThenIf L = 0 ThenPicture1.PSet (i, j), RGB(0, 0, 0) '把红色点转换为黑色点End IfEnd IfEnd IfNext jNext iEnd SubPrivate Sub chuli_Click()Dim dogr(0 To 1000, 0 To 1000)Dim dogg(0 To 1000, 0 To 1000)Dim dogb(0 To 1000, 0 To 1000)Dim pigr(0 To 1000, 0 To 1000)Dim JISHU1 As LongJISHU1 = 0Dim JISHU2 As LongJISHU2 = 0Dim JISHU3 As LongJISHU3 = 0Dim JISHU4 As LongJISHU4 = 0Dim JISHU5 As LongJISHU5 = 0Dim JISHU6 As LongJISHU6 = 0Dim WEI1 As SingleWEI1 = 0Dim WEI2 As SingleWEI2 = 0Dim WEI3 As SingleWEI3 = 0Dim WEI4 As SingleWEI4 = 0Dim WEI5 As SingleWEI5 = 0Dim WEI6 As SingleWEI6 = 0Dim DDK As SingleDDK = 0Dim XGMAX As SingleXGMAX = 0Dim XGMAY As SingleXGMAY = 0Dim XGMAXY As SingleXGMAXY = 0Dim XGMAXX As SingleXGMAXX = 0Dim LXX As SingleLXX = 0Dim LXY As SingleLXY = 0For i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightdogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))If dogr(i, j) <> 255 ThenSetpixel Picture1.hdc, i, j, RGB(0, 0, 0)JISHU1 = JISHU1 + 1End IfNext jNext iFor i = 0 To 2 * Fix(Picture1.ScaleWidth / 2) Step 2 For j = 0 To 2 * Fix(Picture1.ScaleHeight / 2) Step 2 dogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))pig = 0For m = 0 To 1For n = 0 To 1pig = pig + dogr(i + m, j + n)Next nNext mIf pig / 4 <> 255 ThenJISHU2 = JISHU2 + 1End IfNext jNext iFor i = 0 To 3 * Fix(Picture1.ScaleWidth / 3) Step 3 For j = 0 To 3 * Fix(Picture1.ScaleHeight / 3) Step 3 dogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))cow = 0For m = 0 To 2For n = 0 To 2cow = cow + dogr(i + m, j + n)Next nNext mIf cow / 9 <> 255 ThenJISHU3 = JISHU3 + 1End IfNext jNext iFor i = 0 To 4 * Fix(Picture1.ScaleWidth / 4) Step 4 For j = 0 To 4 * Fix(Picture1.ScaleHeight / 4) Step 4 dogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))cow = 0For m = 0 To 3For n = 0 To 3cow = cow + dogr(i + m, j + n)Next nNext mIf cow / 16 <> 255 ThenJISHU4 = JISHU4 + 1End IfNext jNext iFor i = 0 To 5 * Fix(Picture1.ScaleWidth / 5) Step 5 For j = 0 To 5 * Fix(Picture1.ScaleHeight / 5) Step 5 dogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))sheep = 0For m = 0 To 4For n = 0 To 4sheep = sheep + dogr(i + m, j + n)Next nNext mIf sheep / 25 <> 255 ThenJISHU5 = JISHU5 + 1End IfNext jNext iFor i = 0 To 6 * Fix(Picture1.ScaleWidth / 6) Step 6 For j = 0 To 6 * Fix(Picture1.ScaleHeight / 6) Step 6 dogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))fish = 0For m = 0 To 5For n = 0 To 5fish = fish + dogr(i + m, j + n)Next nNext mIf fish / 36 <> 255 ThenJISHU6 = JISHU6 + 1End IfNext jNext iWEI1 = Log(JISHU1)WEI2 = Log(JISHU2)WEI3 = Log(JISHU3)WEI4 = Log(JISHU4)WEI5 = Log(JISHU5)WEI6 = Log(JISHU6)XGMAX = 0 + 0.69315 + 1.09861 + 1.38629 + 1.60944 + 1.79176XGMAY = WEI1 + WEI2 + WEI3 + WEI4 + WEI5 + WEI6XGMAXY = 0 * WEI1 + 0.69315 * WEI2 + 1.09861 * WEI3 + 1.38629 * WEI4 + 1.60944 * WEI5 + 1.79176 * WEI6XGMAXX = 0 ^ 2 + 0.69315 ^ 2 + 1.09861 ^ 2 + 1.38629 ^ 2 + 1.60944 ^ 2 + 1.79176 ^ 2 LXX = XGMAXX - (((XGMAX) ^ 2) / 6)LXY = XGMAXY - ((XGMAX * XGMAY) / 6)DDK = LXY / LXXLabel8.Caption = WEI1Label9.Caption = WEI2Label10.Caption = WEI3Label11.Caption = WEI4Label12.Caption = WEI5Label13.Caption = WEI6Label21.Caption = DDKLabel24.Caption = JISHU1 * 0.2645835 * 50 * 2 '计算母相边界长度*模型厚度=渣金接触面积(*2表示计算图只取一半)Label25.Caption = JISHU1 * ((0.2645835) ^ 2) * 4 * 2 '计算分散相在立体中的表面积(*2表示计算图只取一半)End SubPrivate Sub close_Click()Picture1.Picture = LoadPicture("")End SubPrivate Sub DAYIN_Click()daprint.ShowPrinterEnd SubPrivate Sub exit_Click()EndEnd SubPrivate Sub HELP_Click()Form4.ShowEnd SubPrivate Sub lidufengbu_Click()'-----------------粒度分布程序开始--------------------------------Dim tjxy(0 To 1000, 0 To 1000) As IntegerDim dogr(0 To 1000, 0 To 1000)Dim dogg(0 To 1000, 0 To 1000)Dim dogb(0 To 1000, 0 To 1000)For i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeighttjxy(i, j) = 0Next jNext iFor i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightdogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))If dogr(i, j) <> 255 ThenSetpixel Picture1.hdc, i, j, RGB(0, 0, 0)End IfNext jNext iFor i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightdogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))If dogr(i, j) = 0 Thentjxy(i, j) = 1End IfNext jNext i'------------------ 第一部分：对所有存在的渣滴（钢液滴）进行编号2004.2.2 Dim BHAO(0 To 1000, 0 To 1000)Dim b As IntegerDim aa As Integerb = 1For i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightBHAO(i, j) = 0Next jNext iFor i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightIf tjxy(i, j) = 1 ThenBHAO(i, j) = baa = bFor m = -1 To 1 '判断周围8点是否存在已处理完的黑点For n = -1 To 1If m <> 0 Or n <> 0 Then '去除该点本身If BHAO(i + m, j + n) > 0 And tjxy(i + m, j + n) = 0 ThenBHAO(i, j) = BHAO(i + m, j + n)b = aa - 1End IfEnd IfNext nNext mFor m = -1 To 1 '判断周围8点是否存在尚未处理的黑点For n = -1 To 1If m <> 0 Or n <> 0 Then '去除该点本身If tjxy(i + m, j + n) = 1 ThenBHAO(i + m, j + n) = BHAO(i, j)tjxy(i + m, j + n) = 0End IfEnd IfNext nNext mb = b + 1tjxy(i, j) = 0End IfNext jNext i'------------------ 第一部分结束（编号结束）2004.2.5完成'-------------------------2004.2.8开始-----------------'---------------------第二部分开始（对渣滴粒数进行计算）----------------'---------------------------二、1 计算黑点个数Dim JISHU1 As LongJISHU1 = 0For i = 0 To Picture1.ScaleWidthFor j = 0 To Picture1.ScaleHeightdogr(i, j) = getrvalue(Getpixel(Picture1.hdc, i, j))dogg(i, j) = getgvalue(Getpixel(Picture1.hdc, i, j))dogb(i, j) = getbvalue(Getpixel(Picture1.hdc, i, j))If dogr(i, j) <> 255 ThenSetpixel Picture1.hdc, i, j, RGB(0, 0, 0)JISHU1 = JISHU1 + 1End IfNext jNext iblackp = JISHU1 - 1506 '1506为边框误差**********************前面的分形计算中也应考虑1506问题'---------------------------二、2计算所有黑点中的最大横坐标Xmax，最大纵坐标YmaxDim Xmax As IntegerDim Ymax As IntegerXmax = 0: Ymax = 0Dim aaa As Integeraaa = 0For i = Picture1.ScaleWidth To 0 Step -1For j = Picture1.ScaleHeight To 0 Step -1aaa = getrvalue(Getpixel(Picture1.hdc, i, j))If aaa = 0 ThenXmax = iGoTo a:End IfNext jNext ia: For j = Picture1.ScaleHeight To 0 Step -1For i = Picture1.ScaleWidth To 0 Step -1aaa = getrvalue(Getpixel(Picture1.hdc, i, j))If aaa = 0 ThenYmax = jGoTo b:End IfNext iNext jb: Dim zhadi(1 To 1000000) As LongDim nz As LongFor i = 1 To 1000000zhadi(i) = 0Next iFor nz = 1 To blackp '把所有编完号的黑点中只要是同号的黑点For i = 0 To Xmax '则加在一起，看每个同号的像素点有多少个。

VB绘图

VB绘图

VB绘图.txt 画出单个像素即画点。

画点是最简单的图形操作。

VB 6 ． 0 用 Pset 方法在指定位置处画点，并可以设置该点像素的色彩。

语句格式：［对象名．］ Pset（x,y）[, < 颜色 >]功能：在指定对象上的指定位置画指定颜色的点。

说明：（ 1 ）对象名指窗体或图片框。

缺省时为窗体。

（ 2 ）参数 x 和 y 指定点的位置坐标，是单精度参数，可以接受整数或分数的输人。

该参数的输人可以是任何含有变量的数值表达式。

例如，执行下面语句：Picturel．Pset（1500，2000）则在图片框 Picture1中（1500，2000）处画一个点（ 3 ）如果缺省＜颜色＞参数，则将点设置为前景色。

选择＜颜色＞参数可以将点设置为指定的颜色。

该参数可以引用 QBColor 函数或 RGB 函数产生的颜色。

例如，以下语句在当前窗体画亮蓝色的点。

Pset （ 1500 ， 2000 ） ,RGB （ 0 ， 0 ， 255 ）若需要“擦除”一点，只要把该点的颜色设置为背景色即可。

Pset （ 1500 ， 2000 ） , BackColor7．2．2用Line方法画线和矩形1．用Line方法绘制直线为了在两点之间绘制一条直线，除了使用直线控件外， VB还提供了Line方法。

语法格式：［对象．］ Line ［［ Step ］（ xl ， y1 ）］一［ Step ］（ x2 ， y2 ） [ ，颜色 ]功能：在对象上的两个指定点之间画一条指定颜色的直线。

说明：对象是指窗体、图片框等，缺省指窗体。

第一个 Step表示它后面的一对坐标是相对于当前坐标的偏移量，第二个Step表示它后面的一对坐标是相对于第一对坐标的偏移量。

（ 3）如果不指定颜色则使用所在控件的前景色作为直线的颜色。

当然也可以为直线指定其他颜色例如：Line（1000，1000）-（2000，2000）Line-（4000，4000）Picturel．Line（100，500）-Step（1000，350）Forml．Line Step（200,200）- Step（800，1000）Line（500，200）-（3000，3500），QBColor（12）上述五行命令使用 Line方法的不同形式画直线。

VB画图小程序设计

VB画图小程序设计

VB程序设计实验报告（画图板小程序）1、实验目的1．了解VB系统对计算机软、硬件的要求；2．熟悉VB的系统环境，了解VB程序的编写、保存和编译的方法过程；3．熟悉常用控件的使用方法。

4．会用VB编写一些简单的小软件。

2、实验要求作一个画图板小程序（本题由5人完成）功能：设计一个画图板程序，可模仿Windows操作系统中“画图”程序。

系统要求设计合理，逻辑性强，界面友好。

图片浏览器（功能：可浏览和添加相片。

）3、实验步骤（写出界面设计和代码设计）○1.先整体规划进行界面设计如图所示○2.分工合作进行各模块代码编写。

○3.大家共同合作将各自负责的那部分任务合在一起，然后修改完善程序。

再在一起讨论心得。

4、实验心得1.VB程序设计是一项很神奇的东西。

如同C语言，但比C语言简单。

2.在程序的学习过程中，实验准备是极其重要和环节，以前实验认真做的那方面就好做的多了。

但以前没有实践过的就两眼一摸黑。

3.VB的功能十分强大但要下功夫才能学得好。

尤其是程序设计中，字母的拼写，大小写，符号的准确性十分重要。

4.这次的课程实验，使我对于VB课程的实验和程序设计有了更深层次的了解，特别是明白了标签、文本、按钮等的属性的设置的应用，也学习了一些简单的函数。

的在老师的指导和帮助以及自己的努力下终于完成了程序设计课题。

5.VB的课程设计，对于我们来说是一个锻炼，它提升了我们的编程水平。

一学期的上机操作，使我们学到了更多的VB知识，而且我们在编程期间，学会了协作，团结，为我们积累了资本。

总之，这次课程设计让我受益匪浅，我将会继续学习VB知识，提高水平。

6.在学习VB之后，同样，对C语言、VF等产生了极大地兴趣。