* * *    
Главная » Статьи » Код PB

Просмотров: 1508 | Дата: 20.04.2024 | Коментарии (0)

Капля



Code
hdc=GetDC_(GetCapture_())  
r=35  
i=CreateImage(0,r*2+1,r*2+1,32)  
Dim a.Point(r*2,r*2)  
For x.l=0 To r*2  
  For y.l=0 To r*2  
  xrel.f=(x-r)/r  
  yrel.f=(y-r)/r  
  radius.f=Sqr(xrel*xrel+yrel*yrel)  
  If radius>1  
  a(x,y)\x=x  
  a(x,y)\y=y  
  Else  
  If radius=0  
  alpha.f=0  
  ElseIf xrel=0 And yrel>0  
  alpha=#PI/2  
  ElseIf xrel=0 And yrel<0  
  alpha=-#PI/2  
  Else  
  alpha=ATan(yrel/xrel)  
  If xrel<0  
  alpha+#PI  
  EndIf  
  EndIf  
  radius=1-Pow(1-radius,0.4)  
  a(x,y)\x=r*radius*Cos(alpha)+r  
  a(x,y)\y=r*radius*Sin(alpha)+r  
  EndIf  
  If a(x,y)\x<0  
  a(x,y)\x=0  
  EndIf  
  If a(x,y)\y<0  
  a(x,y)\y=0  
  EndIf  
  If a(x,y)\x>r*2  
  a(x,y)\x=r*2  
  EndIf  
  If a(x,y)\y>r*2  
  a(x,y)\y=r*2  
  EndIf  
  Next  
Next  
Define p.point  
dc2=StartDrawing(ImageOutput(0))  
  rr=r*2+1  
  Repeat  
  GetCursorPos_(p)  
  BitBlt_(dc2,0,0,rr,rr,hdc,p\x-r,p\y-r,#SRCCOPY)  
  For x=0 To r*2  
  For y=0 To r*2  
  SetPixel_(hdc,p\x+x-r,p\y+y-r,GetPixel_(dc2,a(x,y)\x,a(x,y)\y))  
  Next  
  Next  
  Delay(50)  
  BitBlt_(hdc,p\x-r,p\y-r,rr,rr,dc2,0,0,#SRCCOPY)  
  Until GetAsyncKeyState_(#VK_SHIFT) And GetAsyncKeyState_(#VK_F11);=-32767  
StopDrawing()










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.