none
VB6.0 到VB 2008 图形显示差距太大 复杂数学函数图像显示如何从6.0升级到2008 RRS feed

  • 问题

  • 如下代码 在 VB 6.0中可以显示 然而在VB 2008 中却无法显示

    VERSION 5.00
    Begin VB.Form Form1
       Caption         =   "迭代函数系统(分形频道:fractal.cn)2004"
       ClientHeight    =   7260
       ClientLeft      =   60
       ClientTop       =   450
       ClientWidth     =   10155
       LinkTopic       =   "Form1"
       ScaleHeight     =   7260
       ScaleWidth      =   10155
       StartUpPosition =   3  '窗口缺省
       Begin VB.CommandButton Command2
          Caption         =   "退  出"
          Height          =   375
          Left            =   9000
          TabIndex        =   2
          Top             =   960
          Width           =   975
       End
       Begin VB.CommandButton Command1
          Caption         =   "绘  制"
          Height          =   375
          Left            =   9000
          TabIndex        =   1
          Top             =   360
          Width           =   975
       End
       Begin VB.PictureBox Picture1
          BackColor       =   &H00FFFFFF&
          Height          =   6975
          Left            =   120
          ScaleHeight     =   6915
          ScaleWidth      =   8595
          TabIndex        =   0
          Top             =   120
          Width           =   8655
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Private Sub ifs()
      Dim x As Single, y As Single '仿射变换中的自变量
      Dim newx As Single, newy As Single '仿射变换产生的新点
      Dim a As Single, b As Single, c As Single, d As Single, e As Single, f As Single '仿射变幻中的系数
      Dim n As Long '迭代次数
      Dim R As Single '随机变量
      Dim m(7, 7) '存放IFS码
     
      Randomize Timer
      x = 0: y = 0
      n = 100000
     
     'IFS码赋值
      m(0, 0) = 0.5:   m(0, 1) = 0#:  m(0, 2) = 0#:  m(0, 3) = 0.5:  m(0, 4) = 0#:   m(0, 5) = 0#:  m(0, 6) = 0.333
      m(1, 0) = 0.5:   m(1, 1) = 0#:  m(1, 2) = 0#:  m(1, 3) = 0.5:  m(1, 4) = 0.5:  m(1, 5) = 0#:  m(1, 6) = 0.333
      m(2, 0) = 0.5:   m(2, 1) = 0#:  m(2, 2) = 0#:  m(2, 3) = 0.5:  m(2, 4) = 0.25: m(2, 5) = 0.5: m(2, 6) = 0.334
     
     
     '循环迭代,在不同的概率空间下,赋不同的IFS码值
      While n > 0
            R = Rnd
        Select Case R
          Case Is <= m(0, 6)
             a = m(0, 0): b = m(0, 1): c = m(0, 2): d = m(0, 3): e = m(0, 4): f = m(0, 5)
          Case Is <= (m(0, 6) + m(1, 6))
             a = m(1, 0): b = m(1, 1): c = m(1, 2): d = m(1, 3): e = m(1, 4): f = m(1, 5)
          Case Is <= (m(0, 6) + m(1, 6) + m(2, 6))
             a = m(2, 0): b = m(2, 1): c = m(2, 2): d = m(2, 3): e = m(2, 4): f = m(2, 5)
        
        End Select
          newx = (a * x) + (b * y) + e
          newy = (c * x) + (d * y) + f
          x = newx: y = newy
          Picture1.PSet (1500 + 6000 * x, 5500 - 5000 * y), RGB(50 * R, 100 * R, 10 * R)
          n = n - 1
      Wend
     
    End Sub


    Private Sub Command1_Click()
      Call ifs
    End Sub

    Private Sub Command2_Click()
      End
    End Sub

    简述下 就是利用ifs 函数构造  sierpinski 垫片 的图像显示

    2009年5月14日 21:18

答案

全部回复

  • 虽然大部分函数,方法可用.但是你得重写代码
    2009年5月14日 23:05
  • 请教下比如说

    Picture1.PSet (1500 + 6000 * x, 5500 - 5000 * y), RGB(50 * R, 100 * R, 10 * R)
          n = n - 1

    在VB 2008 中 应该怎么写 好像米有 Picture1.PSet 这个函数了

    2009年5月14日 23:44
  • Hi 王磊,

    从VB6到VB.NET有很多东西都改变了,很多控件,函数,属性在VB.NET里有了新的替代方法和属性,如果直接将VB6的代码用于VB.NET肯定会遇到很多问题,以下是我找到的VB6和VB.NET一些常见元素功能的对应表。
    http://hi.baidu.com/sleepcent/blog/item/56a7dd62cdc0cddce6113a3f.html

    对于PictureBox.PSet方法,他的作用是手动设置某个像素点的颜色,这一点在VB.NET里的做法是handle Paint方法来画点。如下代码:
        Private Sub PictureBox1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
            e.Graphics.DrawLine(New Pen(Color.Blue), 10, 20, 10, 21)
        End Sub
    虽然VB.NET中没有画一个像素点的函数,但通过一个像素点的位移画直线可以相当于这个效果,以上例子表示在PictureBox1的点(10, 20)处画一个蓝色的点。

    Sincerely,
    Kira Qian


    Please mark the replies as answers if they help and unmark if they don't.
    2009年5月18日 3:26
  • 好吧 多谢Kira Qian 的指导

    解决的问题就是

    1  Picture1.PSet 的取消 导致无法直接描绘一个点 除了 你说的画一个长度为1的线段外 我用的是画一个面积为一的园

    2 vb2008 竟然米有直接的坐标转换 导致我调试很久 才想起来 原来和vb6.0里面的坐标不同 一个是像素 一个是不知道怎么打的单位





    现在的采用的方法是 基本可以显示

    Public Class Form1

        Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
            End
        End Sub
        Dim pen1 As New System.Drawing.Pen(Color.Red, 0.4)
        Dim g As System.Drawing.Graphics
        Private Sub ifs()
            Dim x As Single, y As Single '仿射变换中的自变量
            Dim newx As Single, newy As Single '仿射变换产生的新点
            Dim a As Single, b As Single, c As Single, d As Single, h As Single, f As Single '仿射变幻中的系数
            Dim n As Long '迭代次数
            Dim R As Single '随机变量
            Dim m(7, 7) As Single '存放IFS码

            Randomize()
            x = 0
            y = 0
            n = 100000


            g = PictureBox1.CreateGraphics

            'IFS码赋值
            m(0, 0) = 0.5 : m(0, 1) = 0.0# : m(0, 2) = 0.0# : m(0, 3) = 0.5 : m(0, 4) = 0.0# : m(0, 5) = 0.0# : m(0, 6) = 0.333
            m(1, 0) = 0.5 : m(1, 1) = 0.0# : m(1, 2) = 0.0# : m(1, 3) = 0.5 : m(1, 4) = 0.5 : m(1, 5) = 0.0# : m(1, 6) = 0.333
            m(2, 0) = 0.5 : m(2, 1) = 0.0# : m(2, 2) = 0.0# : m(2, 3) = 0.5 : m(2, 4) = 0.0 : m(2, 5) = 0.5 : m(2, 6) = 0.334

            '循环迭代,在不同的概率空间下,赋不同的IFS码值
            While n > 0
                R = Rnd()
                Select Case R
                    Case Is <= m(0, 6)
                        a = m(0, 0) : b = m(0, 1) : c = m(0, 2) : d = m(0, 3) : h = m(0, 4) : f = m(0, 5)
                    Case Is <= (m(0, 6) + m(1, 6))
                        a = m(1, 0) : b = m(1, 1) : c = m(1, 2) : d = m(1, 3) : h = m(1, 4) : f = m(1, 5)
                    Case Is <= (m(0, 6) + m(1, 6) + m(2, 6))
                        a = m(2, 0) : b = m(2, 1) : c = m(2, 2) : d = m(2, 3) : h = m(2, 4) : f = m(2, 5)

                End Select

                newx = (a * x) + (b * y) + h
                newy = (c * x) + (d * y) + f
                x = newx : y = newy

                g.DrawEllipse(pen1, 100 + 400 * x, 367 - 333 * y, 1, 1)

                n = n - 1
            End While

        End Sub

        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            Call ifs()
        End Sub

        Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        End Sub
    End Class


    然而还有带解决的问题是

    原来的图像是通过

    RGB(50 * R, 100 * R, 10 * R)  来随即显示点的颜色 但是现在无法找到类似的函数来 通过传参数随即选择颜色

    请教下怎么来 随即显示颜色


    feiyun0112 的贴 全是鸟文 看不明白




    2009年5月19日 3:17
  • pen1 = New System.Drawing.Pen(Color.FromArgb(50 * R, 100 * R, 10 * R), 0.4)
    http://feiyun0112.cnblogs.com/
    2009年5月19日 4:15
    版主
  • Hi 王磊,

    feiyun的方法是对的,你可以在凡是传Color参数的地方都使用Color.FromArgb来创建Color对象。以下是MSDN对于这个方法的文档,供参考
    http://msdn.microsoft.com/zh-cn/library/system.drawing.color.fromargb.aspx

    Sincerely,
    Kira Qian


    Please mark the replies as answers if they help and unmark if they don't.
    2009年5月19日 5:10