I can’t understand the problem "Virtual machine stack overfl

[timur77]

I can’t understand the problem, when starting a program on Windows 10, the message "Virtual machine stack overflow" appears, when starting on Windows XP - "#gr These handles closed by LB. Please add the appropriate CLOSE commands", or how to use getpixel in LB5


it's a screensaver that displays snowflakes

The code is exactly working here is a prototype
Snejinka

[timur77]

nomainwin
'===================================================
UpperLeftX = 0
UpperLeftY = 0
d=DisplayWidth
sh=DisplayHeight
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight

Dim xx(101)
Dim yy(101)
Dim rs(101)

graphicbox #gr.gb, 0, 0, d, sh
open "Snejinka" for window_popup as #gr
#gr, "trapclose [exit]"
#gr.gb, "when characterInput [exit]"
#gr.gb, "when leftButtonDown [exit]"
#gr.gb, "setfocus"
#gr.gb, "cls"
#gr.gb, "down; size 2; fill 0 0 0"

global hDC,hWnd
hWnd=hwnd(#gr.gb)
calldll #user32, "GetDC", hWnd as ulong, hDC as ulong

pi=3.14159265359
'pause- - - - - - - - - - - - - - - - - - -
[L4]
timm=time$("ms")
[l71]
if time$("ms")<timm+2000 then goto [l71]
scan
'- - - - - - - - - - - - - - - - - - -
#gr.gb, "color ";0;" ";0;" ";0
#gr.gb, "place ";d/2;" ";sh/2
For ii=10+sh/2 To 0 Step (-1)
   #gr.gb, "circle ";ii
   timm=time$("ms")
   [l72]
   scan
   if time$("ms")<timm+1 then goto [l72]
Next ii
'start data- - - - - - - - - - - - - - - - - - -
#gr.gb, "color ";0;" ";0;" ";0
#gr.gb, "backcolor ";0;" ";0;" ";0
#gr.gb, "place ";0;" ";0
#gr.gb, "boxfilled ";d;" ";sh
Shrn=Rnd(1)*0.04
rr=1
rad=1
ykk=sh/2-1-(sh/2)*0.5*Rnd(1)
w=Rnd(1)*pi*pi
'- - - - - - - - - - - - - - - - - - -
For i=1 To 100
   xx(i)=0
   yy(i)=0
   rs(i)=0
Next i
'- - - - - - - - - - - - - - - - - - -
x2=d/2
y2=sh/2

r=128+127*(cos(w))
g=128+127*(cos(w+2.0943951023))
b=128+127*(cos(w+4.1887902047))
#gr.gb, "color ";r;" ";g;" ";b
#gr.gb, "backcolor ";r;" ";g;" ";b
#gr.gb, "place ";d/2-5;" ";sh/2-5
#gr.gb, "boxfilled ";d/2+5;" ";sh/2+5
'- - - - - - - - - - - - - - - - - - -
'begin- - - - - - - - - - - - - - - - - - -
[L1]
x1=d/2-sh/2
y1=ykk
If (Sqr((d/2-x2)*(d/2-x2)+(sh/2-y2)*(sh/2-y2)))>(sh/2) Then GoTo [L4]
r=128+127*(cos(w))
g=128+127*(cos(w+2.0943951023))
b=128+127*(cos(w+4.1887902047))
w=w+0.002
scan

'find- - - - - - - - - - - - - - - - - - -
[L3]
If (Rnd(1))>(0.35-0.1*Rnd(1)) Then
   x2=x1+Sgn(0.5-Rnd(1))*2
   y2=y1+Sgn(0.5-Rnd(1))*3
Else
   x2=x1+Sgn(0.7-Rnd(1))*4
   y2=y1
End if

If int(x2)=int(x1) And int(y2)=int(y1) Then GoTo [L3]

'check- - - - - - - - - - - - - - - - - - -
c=getPixel(int(x2),int(y2))
If ((Abs(sh/2-y2))/Sqr((d/2-x2)*(d/2-x2)+(sh/2-y2)*(sh/2-y2)))>0.5 And c<1 Then GoTo [L3]
If c<1 And y2>(sh/2) Then GoTo [L3]
If c>0 Or x2>(d/2) Then GoTo [L2]
x1=x2
y1=y2
GoTo [L3]
'- - - - - - - - - - - - - - - - - - -
[L2]
For i=1 To 100
   If (Rnd(1))>(0.5+Shrn) Then
       xx(i)=0
       yy(i)=0
       rs(i)=0
   End if
   If xx(i)=0 And yy(i)=0 Then
       xx(i)=x1
       yy(i)=y1
       GoTo [L5]
   End if
   rs(i)=rs(i)+2
Next i
[L5]
'- - - - - - - - - - - - - - - - - - -
#gr.gb, "color ";r;" ";g;" ";b
For i=1 To 100
   If xx(i)=0 And yy(i)=0 Then GoTo [L6]

   rad=Sqr((d/2-xx(i))*(d/2-xx(i))+(sh/2-yy(i))*(sh/2-yy(i)))
   grad=Acs((d/2-xx(i))/rad)
   If (sh/2-yy(i))<0 Then grad=pi*2-grad

   For ee=1 To 6

       xz=d/2+rad*Cos(grad+pi+pi*ee/3)
       yz=sh/2+rad*Sin(grad+pi+pi*ee/3)

       #gr.gb, "set ";xz;" ";yz
       For a=1 To 7
           #gr.gb, "goto ";(xz+(rs(i)+1)*Cos(0*pi/6+pi*a/3));" ";(yz+(rs(i)+1)*Sin(0*pi/6+pi*a/3))
       Next a
       '- - - - - - - - - - - - - - - - - - -
       xz=d/2+rad*Cos((-1)*grad+pi+pi*ee/3)
       yz=sh/2+rad*Sin((-1)*grad+pi+pi*ee/3)

       #gr.gb, "set ";xz;" ";yz
       For a=1 To 7
           #gr.gb, "goto ";(xz+(rs(i)+1)*Cos(0*pi/6+pi*a/3));" ";(yz+(rs(i)+1)*Sin(0*pi/6+pi*a/3))
       Next a

   Next ee
[L6]
Next i

GoTo [L1]
'- - - - - - - - - - - - - - - - - - -
[exit]
close #gr
end
'- - - - - - - - - - - - - - - - - - -
function getPixel(x,y)
   calldll #gdi32, "GetPixel", hDC as ulong, x as long, y as long, getPixel as long
end function
'- - - - - - - - - - - - - - - - - - -
Function Sgn(ch)
   Sgn=(ch<0)*(-1)+(ch>0)
End Function
'======================================================


[tsh73]

I don't think you should close DLLS you did not open, so
'close #user32
'close #gdi32

Also, I added int()
c=getPixel(int(x2),int(y2))
and now it runs for me (under Win XP)

[Rod]

This is a looping error. If you jump out and repeatedly start into a new loop you get stack overflow.

Write the code without goto on a far more structured basis.

Anatoly's fixes fix two other errors, you are still likely to get the overflow error if the looping is wrong.

[timur77]

For Windows 10, I solved the problem like this, gave the command to create a tkn-file, copied the necessary exe and dll, launched it and it worked. In Windows 10, the editor constantly swears that he can’t create his files and in general he has problems accessing the disk, maybe this was the problem.

[timur77]

Apr 27, 2020 12:48:20 GMT -5 tsh73 said:

I don't think you should close DLLS you did not open, so
'close #user32
'close #gdi32

Also, I added int()
c=getPixel(int(x2),int(y2))
and now it runs for me (under Win XP)

fixed