November 25, 2020, 08:11:01 AM

Author Topic: [bb] Animate Windows by Ked [ 1+ years ago ]  (Read 539 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Animate Windows by Ked [ 1+ years ago ]
« on: June 29, 2017, 12:28:41 AM »
Title : Animate Windows
Author : Ked
Posted : 1+ years ago

Description : This is a neat way to animate windows when they are created and when they are being freed.

Code :
Code: BlitzBasic
  1. Function CreateAnimWindow(title$,width,height,x,y,group,style=1+2)
  2.         Local curw=0
  3.         Local curh=0
  4.         window=CreateWindow(title$,curw,curh,x,y,group,style)
  5.        
  6.         Repeat
  7.                 curw=curw+5
  8.                 If curw>width
  9.                         curw=width
  10.                 EndIf
  11.                 SetGadgetShape window,x,y,curw,curh
  12.         Until curw=width
  13.        
  14.         Repeat
  15.                 curh=curh+5
  16.                 If curh>height
  17.                         curh=height
  18.                 EndIf
  19.                 SetGadgetShape window,x,y,curw,curh
  20.         Until curh=height
  21.        
  22.         Return window
  23. End Function
  24.  
  25. Function DeleteAnimWindow(wnd)
  26.         Local curw=GadgetWidth(wnd)
  27.         Local curh=GadgetHeight(wnd)
  28.         Local x=GadgetX(wnd),y=GadgetY(wnd)
  29.        
  30.         Repeat
  31.                 curh=curh-5
  32.                 If curh<0
  33.                         curh=0
  34.                 EndIf
  35.                 SetGadgetShape wnd,x,y,curw,curh
  36.         Until curh=0
  37.        
  38.         Repeat
  39.                 curw=curw-5
  40.                 If curw<0
  41.                         curw=0
  42.                 EndIf
  43.                 SetGadgetShape wnd,x,y,curw,curh
  44.         Until curw=0
  45.        
  46.         FreeGadget wnd
  47. End Function
  48.  
  49. wnd=CreateAnimWindow("TEST",640,480,50,50,Desktop())
  50.  
  51. Repeat
  52.  
  53. Until WaitEvent()=$803
  54. DeleteAnimWindow(wnd)


Comments :


xlsior(Posted 1+ years ago)

 Interesting.you might want to add some small delays though, on my Core 2 Duo E6600 the window appeared instantaneously, without any visible animation effect at all.  the code below has some very small (1ms) delays built in, which does make the effect visible even on fast computers.
Code: [Select]
Function CreateAnimWindow(title$,width,height,x,y,group,style=1+2)
Local curw=0
Local curh=0
window=CreateWindow(title$,curw,curh,x,y,group,style)

Repeat
curw=curw+5
If curw>width
curw=width
EndIf
SetGadgetShape window,x,y,curw,curh
Delay 1
Until curw=width

Repeat
curh=curh+5
If curh>height
curh=height
EndIf
SetGadgetShape window,x,y,curw,curh
Delay 1
Until curh=height

Return window
End Function

Function DeleteAnimWindow(wnd)
Local curw=GadgetWidth(wnd)
Local curh=GadgetHeight(wnd)
Local x=GadgetX(wnd),y=GadgetY(wnd)

Repeat
curh=curh-5
If curh<0
curh=0
EndIf
SetGadgetShape wnd,x,y,curw,curh
Delay 1
Until curh=0

Repeat
curw=curw-5
If curw<0
curw=0
EndIf
SetGadgetShape wnd,x,y,curw,curh
Delay 1
Until curw=0

FreeGadget wnd
End Function

wnd=CreateAnimWindow("TEST",640,480,50,50,Desktop())

Repeat

Until WaitEvent()=$803
DeleteAnimWindow(wnd)




Siopses(Posted 1+ years ago)

 Wow, that's really cool. [/i]

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal