form1.frm

小波分形算法源代码,写的不错,希望能给大家帮助!

VERSION 5.00
Begin VB.Form FormM 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Form1"
   ClientHeight    =   7155
   ClientLeft      =   165
   ClientTop       =   555
   ClientWidth     =   9345
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   7155
   ScaleWidth      =   9345
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "控制台"
      Height          =   495
      Left            =   3000
      TabIndex        =   7
      Top             =   0
      Width           =   975
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   2040
      TabIndex        =   6
      Text            =   "Text3"
      Top             =   840
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1200
      TabIndex        =   5
      Text            =   "0"
      Top             =   840
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Text            =   "0"
      Top             =   840
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton Command3 
      Appearance      =   0  'Flat
      Caption         =   "清除底图"
      Height          =   495
      Left            =   2000
      TabIndex        =   3
      Top             =   0
      Width           =   1000
   End
   Begin VB.CommandButton Command2 
      Appearance      =   0  'Flat
      Caption         =   "停止绘图"
      Height          =   500
      Left            =   1000
      TabIndex        =   2
      Top             =   0
      Width           =   1000
   End
   Begin VB.CommandButton Command1 
      Appearance      =   0  'Flat
      Caption         =   "开始绘图"
      Height          =   500
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   1000
   End
   Begin VB.PictureBox PictureT 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      FillColor       =   &H0080FF80&
      Height          =   2055
      Left            =   1440
      ScaleHeight     =   137
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   153
      TabIndex        =   0
      Top             =   1320
      Width           =   2295
      Begin VB.Shape Shape1 
         BorderStyle     =   3  'Dot
         Height          =   975
         Left            =   720
         Top             =   840
         Visible         =   0   'False
         Width           =   1455
      End
   End
End
Attribute VB_Name = "FormM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'开始绘制
Public Sub Command1_Click()
On Error Resume Next
Mang = Timer
Dim MangT As Long
MangT = Mang

Dim i As Double
Dim x0 As Double, y0 As Double
Dim x1 As Double, y1 As Double

x0 = Fx0: y0 = Fy0

FmPSWidth = FormM.PictureT.ScaleWidth
FmPSHeight = FormM.PictureT.ScaleHeight

ReDim Pxy(0 To FmPSWidth, 0 To FmPSHeight) As Long
ReDim PxyT(0 To FmPSWidth, 0 To FmPSHeight) As Boolean
Dim A As Long, B As Long, DoRf As Long
 Randomize Timer
 
 FormM.PictureT.Cls
 
 Se1 = Rnd * 256: Se2 = Rnd * 256: Se3 = Rnd * 256
 
'IFS算法的核心部分
DoRf = 0
Do While MangT = Mang '绘图循环

    Call NextP(x0, y0, x1, y1) '计算下一个点
    If DoRf Mod 500 = 0 Then
        DoRf = 1

        FormM.PictureT.Refresh '刷新显示
    Else
        DoRf = DoRf + 1
    End If
    
     '将点x1,y1映射到屏幕上的一个点A,B
    A = (x1 - Px1) * FmPSWidth / (Px2 - Px1)
    B = (y1 - Py1) * FmPSHeight / (Py2 - Py1)
    If A > 0 And A < FmPSWidth And B > 0 And B < FmPSHeight Then
        Pxy(A, B) = Pxy(A, B) + 1
        If Pxy(A, B) > 2560# Then Pxy(A, B) = 0
        Call HuaDian(A, B, Pxy(A, B), x0, y0, x1, y1) '得到点的颜色
    End If
    
    x0 = x1: y0 = y1
    DoEvents
Loop

End Sub

Private Sub Command2_Click()
Mang = Timer
End Sub

Private Sub Command3_Click()
Dim i As Long, k As Long
Me.PictureT.Cls
ReDim PxyT(0 To FmPSWidth, 0 To FmPSHeight) As Boolean
End Sub

Private Sub Command4_Click()
FormK.Show 1
End Sub

Private Sub file_Click()

End Sub

'程序启动以后设置一些初始值
Private Sub Form_Load()
Dim j As Long
Randomize Timer

Pn = 1

DoEvents
    FormK.CheckP.Value = 1
    FormK.TextP(0).Text = "0.4"
    FormK.TextP(1).Text = "0.6"

    FormK.Check(0).Value = 1
    FormK.Check(1).Value = 1
    For j = 2 To FormK.Check.UBound
        FormK.Check(j).Value = 0
    Next j
    
    FormK.TextA(0).Text = "0.5"
    FormK.TextA(1).Text = "0.5"
    FormK.TextB(0).Text = "-0.5"
    FormK.TextB(1).Text = "-0.5"
    FormK.TextC(0).Text = "0.5"
    FormK.TextC(1).Text = "0.5"
    FormK.TextD(0).Text = "0.5"
    FormK.TextD(1).Text = "0.5"
    FormK.TextE(0).Text = "1"
    FormK.TextE(1).Text = "-1"
    FormK.TextF(0).Text = "0"
    FormK.TextF(1).Text = "0"
    FormK.TextX1.Text = "2.8"
    FormK.TextY1.Text = "2.5"
    FormK.TextX2.Text = "-2.8"
    FormK.TextY2.Text = "-2.5"
    HowHua = 4
    
    
    FormK.Hide

Call FormK.Command1_Click
End Sub

'退出程序
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 Mang = Timer
    End
End Sub

Private Sub Form_Resize()

PictureT.Left = 0
PictureT.Top = 500
PictureT.Width = Me.Width
PictureT.Height = Me.Height - 50

End Sub


Private Sub KongZhi_Click()
FormK.Show 1
End Sub


Private Sub PictureT_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
    Text1.Text = x
    Text2.Text = y
    Shape1.Left = x
    Shape1.Top = y
    Shape1.Width = 1
    Shape1.Height = 1
    Shape1.Visible = True
End If
End Sub

Private Sub PictureT_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
   Shape1.Width = Abs(x - Text1.Text)
   Shape1.Height = Abs((y - Text2.Text))
End If
End Sub

Private Sub PictureT_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.Shape1.Visible = False

Dim x0 As Double, x1 As Double, y0 As Double, y1 As Double
x0 = Text1.Text * (Px2 - Px1) / FmPSWidth + Px1
x1 = x * (Px2 - Px1) / FmPSWidth + Px1
y0 = Text2.Text * (Py2 - Py1) / FmPSHeight + Py1
y1 = y * (Py2 - Py1) / FmPSHeight + Py1
FormK.TextX1 = x0
FormK.TextY1 = y0
FormK.TextX2 = x1
FormK.TextY2 = y1

FormK.Command1_Click
End Sub