Code: Select all
#include <hmg.ch>
Function Main
public lStop := .f.
define window main at 0, 0 width 1000 height 800 title 'MandelBrot' main
define button b1
row 10
col 10
width 80
caption "Draw"
action startcalc()
end button
define button stop
row 10
col 110
caption 'Stop'
action lStop := .t.
end button
end window
Main.Center
Main.Activate
Return
function startcalc
local nWidth := 800
local nHeight := 600
local hDC, BTstruct
local aColors := { ;
{66, 30, 15},;
{25, 7, 26},;
{9, 1, 47},;
{4, 4, 73},;
{0, 7, 100},;
{12, 44, 138},;
{24, 82, 177},;
{57, 125, 209},;
{134, 181, 229},;
{211, 236, 248},;
{241, 233, 191},;
{248, 201, 95},;
{255, 170, 0},;
{204, 128, 0},;
{153, 87, 0},;
{106, 52, 3};
}
BT_ClientAreaInvalidateAll ("main")
hDC := BT_CreateDC ("main", BT_HDC_INVALIDCLIENTAREA, @BTstruct)
BT_DrawFillRectangle (hDC, 40, 40, nWidth, nHeight, { 255, 255, 255 }, { 0, 0, 0 }, 1 )
cx := 0.05
cy := 0.05
scale := 0.005
limit := 40
for x := -400 to ( nWidth / 2 )
for y:= -300 to ( nHeight / 2 )
ax := cx + ( x * scale )
ay := cy + ( y * scale )
a1 := ax
b1 := ay
lp := 0
for lp = 1 to 255
a2 := ( a1 * a1 ) - ( b1 * b1 ) + ax
b2 := 2*a1*b1+ay
a1 := a2
b1 := b2
if ( a1 * a1 ) + ( b1 * b1 ) > limit
exit
endif
next lp
if lp < 255
aColor := aColors[ if( int( mod( lp, 16 ) ) > 0, int( mod( lp, 16 ) ), 1 ) ]
else
aColor := { 0, 0, 0 }
endif
nRow := 40 + 300 + y
nCol := 40 + 400 + x
BT_DrawSetPixel ( hDC, nRow, nCol, aColor )
do events
if lStop
exit
endif
next y
if lStop
exit
endif
next x
BT_DeleteDC( BTstruct )
return nil 
