📄 form1.frm
字号:
Caption = "放大"
End
Begin VB.Menu suaoxiao1
Caption = "缩小"
End
Begin VB.Menu henfdhbg
Caption = "-"
End
Begin VB.Menu line
Caption = "绘框"
End
Begin VB.Menu hen78
Caption = "-"
End
Begin VB.Menu Mold
Caption = "上一幅图"
End
Begin VB.Menu Mnext
Caption = "下一幅图"
End
Begin VB.Menu fuzhi
Caption = "复制"
Visible = 0 'False
End
Begin VB.Menu dak
Caption = "打开"
Visible = 0 'False
End
Begin VB.Menu baoc
Caption = "保存"
Visible = 0 'False
End
End
Begin VB.Menu objectH
Caption = " 选项(&O) "
Begin VB.Menu colorH
Caption = "颜色渐变参数"
Begin VB.Menu JianbianA1
Caption = "渐变a增强"
Shortcut = ^{F1}
End
Begin VB.Menu JianbianA2
Caption = "渐变a减弱"
Shortcut = ^{F2}
End
End
Begin VB.Menu HENJNTET
Caption = "-"
End
Begin VB.Menu OnTop
Caption = "程序位于顶层"
End
Begin VB.Menu henbf
Caption = "-"
End
Begin VB.Menu emRGBedit
Caption = "RGB颜色调整..."
End
Begin VB.Menu henybf543w
Caption = "-"
End
Begin VB.Menu picM
Caption = "图片属性设置..."
End
Begin VB.Menu henlkjfd
Caption = "-"
End
Begin VB.Menu concleH
Caption = "控制台(&S)..."
End
End
Begin VB.Menu bangzhu
Caption = " 帮助(&H) "
Begin VB.Menu guanyu
Caption = "关于程序(&A)..."
End
Begin VB.Menu hen87543
Caption = "-"
End
Begin VB.Menu tuxiang
Caption = "关于图象(&P)..."
Shortcut = {F1}
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public picX As Long, picY As Long '实际绘图尺寸
Public Mang As Double '防止同时运行多个本线程的代码
Public Msx0 As Single, Msy0 As Single '记录开始拖动时的鼠标位置
Public Msx1 As Single, Msy1 As Single '记录拖动时的鼠标位置
Private Sub baoc_Click()
'调用保存功能 （ *.BMP 文件）
Call baocun_Click
End Sub
Private Sub colo_Click()
'锁定颜色参数
SeData(0, 5) = 0
colo.Checked = True: suiji.Checked = False
End Sub
'+++++++++++++重要的一个绘图过程+++++++++++++
Private Sub CommandSatrt_Click()
'具体执行绘制操作的过程
Dim i As Long
'临时用变量 temp
Dim temp As Long, tempA As Double, temp1 As Double, temp2 As Double, temp3 As Double, temp4 As Double, temp5 As Double
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double '记录坐标范围
Dim M As Long, nM As Long '最大迭代次数；最小迭代次数
Dim Tmang As Double '防止同时运行多个本线程的代码
Dim Se1 As Long, Se2 As Long, Se3 As Long, se As Long '记录颜色的变量
Dim A As Long, B As Long, N As Long '从中间开始向两边绘制时使用的变量
Dim x0 As Double, y0 As Double '复平面上的一个点
Dim Kn2 As Single '颜色渐变强度调节参数
Dim Hssx As Double '用来保存返回的函数的一项性质，用作颜色函数的参数,（下同 ）
Dim Hssy As Double
Dim dL1 As Double
Dim dL2 As Double
Dim dL3 As Double
Dim dL4 As Double
'------------------------------------------------------------
On Error Resume Next '出错时继续执行
picX = Picture2.ScaleWidth: picY = Picture2.ScaleHeight '绘图显示尺寸
x1 = SeData(0, 1): y1 = SeData(0, 2) '坐标范围
x2 = SeData(0, 3): y2 = SeData(0, 4)
Tmang = Timer '防止同时运行多个本线程的代码
Mang = Tmang '防止同时运行多个本线程的代码
For i = 1 To 1000
DoEvents '转让控制权，以便让操作系统处理其它的事件(包括再次调用本过程)
Next i
Se1 = SeData(0, 6): Se2 = SeData(0, 7): Se3 = SeData(0, 8) '调色参数
A = picX / 2 '从中间开始向两边绘制
temp1 = -1: temp2 = -1
For N = 0 To frmMain.Picture2.ScaleWidth + 1
A = A - (((N / 1) Mod 2) * 2 - 1) * N '总体上从中间向两边绘制
For B = 0 To frmMain.Picture2.ScaleHeight '从上到下绘制
If Mang <> Tmang Then '========
Mang = -1 '本线程执行时让 Mang = Tmang，当 Mang <> Tmang 时
Exit Sub '表明该线程应该停止。（其他地方类同）
End If '========
x0 = (x2 - x1) * A / picX + x1: y0 = (y2 - y1) * B / picY + y1 '获得复平面上的一个点
If x0 = 0 Then x0 = 1E-150 '最好不要有（0,0）点
If y0 = 0 Then y0 = 1E-150
'特效处理（4重），原理是对（x0,y0）点进行某种变换，使点映射得一个新的复表面上
For i = 3 To 0 Step -1
Select Case Int(SeData(0, 16) / (100# ^ i)) Mod 100#
Case 0
'无
Case 1 '圆
temp1 = Sqr(x0 ^ 2 + y0 ^ 2)
temp2 = ZArg(y0, x0, 0)
temp3 = Int(temp1)
If temp3 <> 1 Then
temp1 = temp1 - temp3
x0 = Sgn(temp1) * (Sqr(2 * temp1 * temp1 / (1 - temp1 * temp1)) + temp1)
y0 = temp2
Else
x0 = temp1
y0 = 45 / 180 * PI
End If
temp1 = x0
temp2 = y0
x0 = temp1 * Cos(temp2)
y0 = temp1 * Sin(temp2)
Case 2 '加倍
temp1 = x0 ^ 2 - y0 ^ 2
temp2 = 2 * x0 * y0
x0 = temp1
y0 = temp2
Case 3 '平铺
temp1 = Tan(x0 / 1.5)
temp2 = Tan(y0)
x0 = temp1
y0 = temp2
Case 4 '网
temp1 = Sin(x0 * 2 + y0 * 2)
temp2 = Cos(x0 * 2 - y0 * 2)
x0 = temp1
y0 = temp2
Case 5 '黎曼面
temp1 = Sqr(x0 * x0 + y0 * y0)
temp2 = ZArg(x0, y0, 0)
temp1 = Tan(temp1 * 1.5) * 2
x0 = temp1 * Sin(temp2)
y0 = temp1 * Cos(temp2)
Case 6 '1/c
Call Zshang(1, 0, x0, y0, temp1, temp2)
x0 = temp1
y0 = temp2
Case 7 'Mandelbrot
Call fz2(x0 - 0.5, y0, x0 - 0.5, y0, temp1, temp2, 4)
x0 = temp1
y0 = temp2
End Select
Next i
'颜色方案处理原理
' RGB(256 - ((x1 Mod 512) - 256), _
256 - ((x2 Mod 512) - 256), _
256 - ((x3 Mod 512) - 256)) _
程序中这样可以保持颜色的渐变
'这样更好： RGB(255 - ((x1 Mod 511) - 255), _
255 - ((x2 Mod 511) - 255), _
255 - ((x3 Mod 511) - 255)) _
'
se = RGB(SeData(0, 6), SeData(0, 7), SeData(0, 8)) '默认颜色
'
Select Case SeData(0, 19) + 1 '颜色方案 （其中有的效果有上面使用的特效处理方式，特效独立出来是由伍胜富先生提出的）
Case 1
M = 10000
nM = 11
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = SeData(0, 9) + 10
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (M - i) * 2 ^ Kn2 / M) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (M - i) * 2 ^ Kn2 / M) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (M - i) * 2 ^ Kn2 / M) Mod 512 - 256))
Case 2
M = 3
nM = 1
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9)) / 2
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * ((Log(Abs(Hssy))) * 2 ^ Kn2)) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * ((Log(dL1))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * ((Log(Abs(Hssx)))) * 2 ^ Kn2) Mod 512 - 256))
Case 3
M = 3
nM = 1
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9) + 5) / 2
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * Log(dL1) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (Abs(Cos(Hssx))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (Abs(Cos(Hssy))) * 2 ^ Kn2) Mod 512 - 256))
Case 4
M = 3
nM = 1
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9)) / 2
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (((dL1 / Hssx))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * ((Tan(Hssy) / (dL1))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * ((Hssx / Hssy)) * 2 ^ Kn2) Mod 512 - 256))
Case 5
temp1 = Sqr(x0 ^ 2 + y0 ^ 2)
temp2 = ZArg(y0, x0, 0)
temp3 = Int(temp1)
If temp3 <> 1 Then
temp1 = temp1 - temp3
x0 = Sgn(temp1) * (Sqr(2 * temp1 * temp1 / (1 - temp1 * temp1)) + temp1)
y0 = temp2
Else
x0 = temp1
y0 = 45 / 180 * PI
End If
temp1 = x0
temp2 = y0
x0 = temp1 * Cos(temp2)
y0 = temp1 * Sin(temp2)
M = 1000
nM = 15
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
dL2 = dL2
Kn2 = SeData(0, 9) + 10
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (Sin(Log(1 / i) + Log(Abs(dL2)))) * 2 ^ Kn2 / M) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (Cos(Log(1 / i) + Log(Abs(dL2)))) * 2 ^ Kn2 / M) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (Sin(Log(1 / i) + Log(Abs(dL2)))) * 2 ^ Kn2 / M) Mod 512 - 256))
Case 6
M = 3
nM = 1
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9)) / 2
se = RGB(66, _
124, _
221)
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (Log((Log(Abs(Hssy))))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (Log((Log(dL1)))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (Log((Log(Abs(Hssx))))) * 2 ^ Kn2) Mod 512 - 256))
Case 7
M = 13
nM = 11
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9)) / 2 - 1.5
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (((Log(Abs(Hssx ^ 2 + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (((Log((dL2 + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (((Log(Abs(Hssy ^ 2 + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256))
Case 8
M = 4
nM = 2
i = MMi(x0, y0, Int(SeData(0, 13)), M, nM, Hssx, Hssy, dL1, dL2, dL3, dL4) 'i
Kn2 = (SeData(0, 9)) / 2 - 1.5
se = RGB(256 - Abs(Abs(Se1 - (2 * Se2 - 256) * (((Log(Abs((Hssx) ^ 2 + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se2 - (2 * Se3 - 256) * (((Log((dL2 * 100 + Hssy + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256), _
256 - Abs(Abs(Se3 - (2 * Se1 - 256) * (((Log(Abs((Hssy) ^ 2 + 0.000001))))) * 2 ^ Kn2) Mod 512 - 256))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -