⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 一个用C语言编写的求混沌序列的源程序,挺好的!
💻 FRM
📖 第 1 页 / 共 5 页
字号:
                     A, _
                     0, _
                     1, _
                     frmMain.Picture2.ScaleHeight, _
                     &HCC0020
        Else
            tempA = -1
        End If
    Next N
    
    '整幅图像全部刷新显示
    frmMain.Picture1.PaintPicture frmMain.Picture2.Image, 0, 0, _
                     frmMain.Picture1.ScaleWidth, frmMain.Picture1.ScaleHeight, _
                     0, _
                     0, frmMain.Picture2.ScaleWidth, _
                     frmMain.Picture2.ScaleHeight, &HCC0020
    frmMain.Picture1.Refresh
    
End Sub

Private Sub concleH_Click()
    '显示“参数控制面板”前的准备
    frmCtrl.Text1.Text = Str(SeData(0, 1))
    frmCtrl.Text2.Text = Str(SeData(0, 2))
    frmCtrl.Text3.Text = Str(SeData(0, 3))
    frmCtrl.Text4.Text = Str(SeData(0, 4))
    If SeData(0, 5) = 1 Then
        frmCtrl.Option2.Value = True
        
    Else
        frmCtrl.Option3.Value = True
    End If
    frmCtrl.Text13.Text = Str(SeData(0, 6))
    frmCtrl.Text15.Text = Str(SeData(0, 7))
    frmCtrl.Text16.Text = Str(SeData(0, 8))
    
    frmCtrl.Text29.Text = Str(SeData(0, 9))
    frmCtrl.Text30.Text = Str(SeData(0, 10))
    frmCtrl.Text31.Text = Str(SeData(0, 11))
    frmCtrl.Text17.Text = Str(SeData(0, 12))
    
    If SeData(0, 13) = 1 Then
        frmCtrl.Option4.Value = True
    ElseIf SeData(0, 13) = 2 Then
        frmCtrl.Option5.Value = True
    ElseIf SeData(0, 13) = 3 Then
        frmCtrl.Option1.Value = True
    End If
    frmCtrl.Text14.Text = Str(SeData(0, 14))
    frmCtrl.Text21.Text = Str(SeData(0, 15))
    'frmCtrl.Text22.Text = Str(SeData(0, 16))
    frmCtrl.Combo1.ListIndex = Int(SeData(0, 16) / 1) Mod 100#
    frmCtrl.Combo2.ListIndex = Int(SeData(0, 16) / 100) Mod 100#
    frmCtrl.Combo3.ListIndex = Int(SeData(0, 16) / 10000) Mod 100#
    frmCtrl.Combo4.ListIndex = Int(SeData(0, 16) / 1000000) Mod 100#
    frmCtrl.Text23.Text = Str(SeData(0, 17))
    frmCtrl.Text24.Text = Str(SeData(0, 18))
    
    frmCtrl.OptionZheSe(SeData(0, 19)).Value = True
    If frmMain.OnTop.Checked = True Then
        '因为主窗口有可能为顶层窗口,所以先取消主窗口为顶层窗口(其它地方不再赘述)
        Call SetWindowPos(Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or _
                    SWP_NOSIZE Or SWP_NOACTIVATE)
    End If

                
    '使要显示的窗口始终位于屏幕中心,当然StartUpPosition属性可以设置窗口初始位置
    frmCtrl.Left = Abs(frmMain.Left + (frmMain.Width - frmCtrl.Width) / 2)
    frmCtrl.Top = Abs(frmMain.Top + (frmMain.Height - frmCtrl.Height) / 2)
    
    '界面处理
    If SeData(0, 5) = 1 Then
        frmCtrl.HScroll1.Enabled = False
        frmCtrl.HScroll2.Enabled = False
        frmCtrl.HScroll3.Enabled = False
        frmCtrl.Text13.Enabled = False
        frmCtrl.Text15.Enabled = False
        frmCtrl.Text16.Enabled = False
    Else
        frmCtrl.HScroll1.Enabled = True
        frmCtrl.HScroll2.Enabled = True
        frmCtrl.HScroll3.Enabled = True
        frmCtrl.Text13.Enabled = True
        frmCtrl.Text15.Enabled = True
        frmCtrl.Text16.Enabled = True
    End If
    If SeData(0, 13) = 1 Then
        frmCtrl.Text14.Enabled = True
        frmCtrl.Text21.Enabled = False
        frmCtrl.Text23.Enabled = False
        frmCtrl.Text24.Enabled = False
        frmCtrl.Label12.Enabled = False
        frmCtrl.Label15.Enabled = False
        frmCtrl.Label16.Enabled = False
    ElseIf SeData(0, 13) = 2 Then
        frmCtrl.Text14.Enabled = False
        frmCtrl.Text21.Enabled = False
        frmCtrl.Text23.Enabled = False
        frmCtrl.Text24.Enabled = False
        frmCtrl.Label12.Enabled = False
        frmCtrl.Label15.Enabled = False
        frmCtrl.Label16.Enabled = False
    Else
        frmCtrl.Text14.Enabled = False
        frmCtrl.Text21.Enabled = True
        frmCtrl.Text23.Enabled = True
        frmCtrl.Text24.Enabled = True
        frmCtrl.Label12.Enabled = True
        frmCtrl.Label15.Enabled = True
        frmCtrl.Label16.Enabled = True
    End If
    frmCtrl.Show 1
    
    If frmMain.OnTop.Checked = True Then
        '设主窗口为顶层窗口
        Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or _
                SWP_NOSIZE Or SWP_NOACTIVATE)
    End If
    
End Sub

Private Sub emRGBedit_Click()
    '调用以打开RGB调整窗口
    Call ImagePIC_Click
End Sub

Private Sub Form_Click()
    '界面控制
    Shape1.Visible = False
End Sub

'+++++++++++程序启动和重要参数说明++++++++++++
Private Sub Form_Load()
    '主程序启动过程
    Dim i As Long
    Dim x1 As Double, strX As String
    
    Randomize Timer  '利用Timer值的不确定性,使产生的“随机数”真正“随机”
      
    '设置默认参数值
    frmMain.Picture2.Width = 15
    frmMain.Picture2.Height = 15
    picX = Picture1.ScaleWidth: picY = Picture1.ScaleHeight
      
    'SeData(-2 To 20, 0 To 19)
    PSeData = 0
    For i = -2 To 20
        SeData(i, 0) = 0
    Next i
    SeData(0, 0) = 1              '标志
      
    SeData(0, 1) = 2                  '坐标 X1
    SeData(0, 2) = 1.5                '坐标 y1
    SeData(0, 3) = -2                 '坐标 X2
    SeData(0, 4) = -1.5               '坐标 y2
      
    SeData(0, 5) = 1              '颜色 是否随机
    SeData(0, 6) = 150            '颜色 R
    SeData(0, 7) = 250            '颜色 G
    SeData(0, 8) = 50             '颜色 B
      
    SeData(0, 9) = 0           '颜色 渐变参数a
    SeData(0, 10) = 0          '颜色 渐变参数b (没有用到)
    SeData(0, 11) = 0          '颜色 渐变参数c (没有用到)
    SeData(0, 12) = 0          '颜色 渐变参数d (没有用到)
    
    SeData(0, 13) = 2          '选定的函数编号
    SeData(0, 14) = 5          'X^N-1=0 中的 N值
    SeData(0, 15) = 3           'Z*(1+Z^A)/(1-Z^A)=R 中的 A
    SeData(0, 16) = 0           '特效编号
    SeData(0, 17) = 0           'Z*(1+Z^A)/(1-Z^A)=R 中的 R的实部
    SeData(0, 18) = -3          'Z*(1+Z^A)/(1-Z^A)=R 中的 R的虚部
    
    SeData(0, 19) = 6           '着色方案编号
    
    frmCtrl.Hide
    frmMain.Left = (Screen.Width - frmMain.Width) / 2
    frmMain.Top = (Screen.Height - frmMain.Height) / 2.5
    frmMain.Show
    DoEvents
    
    '检查命令行参数,若是 *.HTXT 文件 则打开
    strX = UCase(Command)
    If Len(strX) >= 5 Then
        '文件名称中有可能在前后加上双引号("),有的时候就去掉
        If Len(strX) >= 2 Then
            If Left(strX, 1) = """" And Right(strX, 1) = """" Then
                strX = Left(strX, Len(strX) - 1)
                strX = Right(strX, Len(strX) - 1)
            Else
                strX = (strX + "T")
            End If
        End If
        On Error GoTo aaa: '出错处理
        If (Right(strX, 5)) = ".HTXT" Then
            Open strX For Input As #1
            For i = 0 To 19
                Input #1, x1
                SeData(0, i) = x1
            Next i
            Close #1
        End If
    End If
        
    '刷新显示
    frmMain.Picture1.PaintPicture frmMain.Picture2.Image, 0, 0, _
                     frmMain.Picture1.ScaleWidth, frmMain.Picture1.ScaleHeight, _
                     0, _
                     0, frmMain.Picture2.ScaleWidth, _
                     frmMain.Picture2.ScaleHeight, &HCC0020
    '调用开始绘图
    Call Command1_Click
        
    Exit Sub
        
aaa:  '错误处理
    Close #1
    MsgBox "   打开文件时出错 (或者其它错误) !   ", vbOKOnly, " 错误"
End Sub


Private Sub baocun_Click()
    '保存为 *.BMP 文件
    
    Dim fileName As String
    
    On Error GoTo aaa:
    
    CommonDialogBMP.fileName = ""
    CommonDialogBMP.ShowSave
    
    If CommonDialogBMP.fileName = "" Then Exit Sub
    If (Dir(CommonDialogBMP.fileName)) <> "" Then
       If MsgBox("     文件已经存在,要覆盖吗?      ", vbOKCancel, "文件重名") <> vbOK Then Exit Sub
    End If
    
    fileName = CommonDialogBMP.fileName
    SavePicture frmMain.Picture2.Image, fileName  '保存图片为 *.BMP
    Exit Sub
aaa:
    MsgBox "   文件名错误 (或者其它) !  ", vbOKOnly, " 错误"
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '退出程序处理
    Mang = Timer ' 停止绘图
    DoEvents
    End
End Sub

Private Sub line_Click()
    '调用绘框过程
    Call ImageLine_Click
End Sub

Private Sub MClease_Click()
    '调用清除显示的过程
    Call ImageC_Click
End Sub

Private Sub Mend_Click()
    '调用停止绘图过程
    Call ImageS_Click
End Sub

Private Sub Mnext_Click()
    '载入下一幅图形参数
    Call ImageR_Click
End Sub

Private Sub Mold_Click()
    '载入上一幅图形参数
    Call ImageL_Click
End Sub

Private Sub MsaveHTXT_Click()
    '保存为 *.HTXT 文件
    
    Dim x1 As Double, i As Long
    
    On Error GoTo aaa:
    
    CommonDialogSaveH.fileName = ""
    CommonDialogSaveH.ShowSave
     
    If Me.CommonDialogSaveH.fileName = "" Then Exit Sub
    If (Dir(CommonDialogSaveH.fileName)) <> "" Then
       If MsgBox("     文件已经存在,要覆盖吗?      ", vbOKCancel, "文件重名") <> vbOK Then Exit Sub
    End If
    
    Open CommonDialogSaveH.fileName For Output As #1
        For i = 0 To 19
            SeData(-1, i) = SeData(0, i) '获得现在的参数值
        Next i
        SeData(-1, 0) = 1
        SeData(-1, 5) = 0
        For i = 0 To 19
            Write #1, SeData(-1, i)  '将现在的参数值写入文件
        Next i
    Close #1
    
    Exit Sub
aaa:
    Close #1
    MsgBox "   保存文件时出错 (或者其它错误) !   ", vbOKOnly, " 错误"
    
End Sub

Private Sub Mstart_Click()
Call ImageP_Click
End Sub

Private Sub OnTop_Click()
    '程序始终位于顶层切换
    If OnTop.Checked = False Then
        OnTop.Checked = True
        '设置窗口位于顶层
        Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or _

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -