📄 form1.frm
字号:
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 + -