Fine animated Lines & Boxes, cool ! (&BindEvent &Modul)

Share your advanced PureBasic knowledge/code with the community.
Post Reply
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Fine animated Lines & Boxes, cool ! (&BindEvent &Modul)

Post by walbus »

fine animated boxes and lines

Updated - New code with BindEvent Funktion !
In the next but one Posting as (universal animation or automatic cyclic doing) Module.

Code: Select all

; Animated Lines with BindEvent Function PB 5.20 >
; Idee - Werner Albus - http://www.nachtoptik.de

;-------------------------------------------             

Procedure Linie(x.i, y.i, xx.i, yy.i, shift.a, color.l, lr.i)
  
   
; Warning - Plot is not clipping here in the sample
  
   
   Protected a.i, dx.i, dy.i, addval.i = 1
   Protected *plotX.Integer = @xx, *plotY.Integer = @yy
   
   If Abs(x - xx) <= Abs(y - yy) ; Winkel größer 45°
      Swap x, y
      Swap xx, yy
      *plotX = @yy
      *plotY = @xx
   EndIf
      
   If x < xx
      Swap x, xx
      Swap y, yy
   EndIf
   
   If y < yy
      y = 2 * yy - y
      addval = -1
   EndIf
   
   dy = 2 * (y - yy)
   a  = x - xx
   dx = 2 * a
   
   While xx <= x
     
      If shift & 1
         Plot(*plotX\i, *plotY\i, color)
       EndIf
      
      If lr
         shift = (shift << 1) | ((shift >> 7) & $7f)
      Else
         shift = ((shift >> 1) & $7F) | (shift << 7)
      EndIf
      
      xx + 1
      a - dy
      If a <= 0
         a + dx
         yy + addval
      EndIf
   Wend
   
EndProcedure

;-------------------------------------------

Procedure Liniego(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)
   
  For i=0 To move
  shift = (shift << 1) | ((shift >> 7) & $7f)  
  Next i

  Linie(x, y, xx, yy, shift, color, lr)     

EndProcedure

;-------------------------------------------

Procedure Boxgo(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)

  xx - 1 : yy - 1
  
 If lr
   Liniego(x, y, x + xx, y, color, move, shift, 1)
   Liniego(x + xx, y, x + xx, y + yy, color, move, shift, 1)
   Liniego(x, y + yy, x + xx, y + yy, color, move, shift, 0)
   Liniego(x, y + yy, x, y, color, move, shift, 0)
  Else
   Liniego(x, y, x + xx, y, color, move, shift, 0)
   Liniego(x + xx, y, x + xx, y + yy, color, move, shift, 0)
   Liniego(x, y + yy, x + xx, y + yy, color, move, shift, 1)
   Liniego(x, y + yy, x, y, color, move, shift, 1)
 EndIf
   
EndProcedure

;-------------------------------------------

Procedure moving_sample()

   Static move.b, swapp.b, x.l, y.l, xx.l, yy.l ; Static Moving counter
 
         
           x+xx : If x>491 : xx=-3 : EndIf
                  If x<3   : xx=3  : EndIf

           y+yy : If y>241 : yy=-3 : EndIf
                  If y<3   : yy=3  : EndIf
            
              If StartDrawing(CanvasOutput(0))
                  Box   (0, 0, 500, 250, $FFFFFF)
                  DrawingMode(#PB_2DDrawing_Outlined) ; Zeichnen von Flächen erfolgt nicht ausgefüllt
                  
                  Box (184, 104, 132, 32, $FF)
                  Box (185, 105, 130, 30, $FF)
                  Box (186, 106, 128, 28, $FF)
                  
                 If swapp<50
                  Boxgo (184, 104, 132, 32, $FFFF00, move, %11110000,1)
                  Boxgo (185, 105, 130, 30, $FFFF00, move, %11110000,1)
                  Boxgo (186, 106,  128, 28,$FFFF00, move, %11110000,1)
                   Else
                  Boxgo (184, 104, 132, 32, $00FFFF, move, %11110000,0)
                  Boxgo (185, 105, 130, 30, $00FFFF, move, %11110000,0)
                  Boxgo (186, 106,  128, 28,$00FFFF, move, %11110000,0)
                 EndIf
                
                  Boxgo (174, 94, 152, 52, $FF0000, move, %00100011,0)
                  Boxgo (175, 95, 150, 50, $FF0000, move, %00100011,0)
                  Boxgo (176, 96, 148, 48, $FF0000, move, %00100011,0)
                  
                  Boxgo (164, 84, 172, 72, $FF, move, %00100111,1)
                  Boxgo (165, 85, 170, 70, $FF, move, %00100111,0)
                  Boxgo (166, 86, 168, 68, $FF, move, %00100111,1)
                  
                  Boxgo (154, 74, 192, 92, $FF, move, %10111111,0)
                  Boxgo (155, 75, 190, 90, $FF, move, %00110011,0)
                  Boxgo (156, 76, 188, 88, $FF, move, %11111101,0)
                  
                  Boxgo (148, 68, 204, 104, $0 , move, %11100110,1)
                  Boxgo (144, 64, 212, 112, $0 , move, %00111111,0)
                  Boxgo (140, 60, 220, 120, $0 , move, %00110011,1)

                  Boxgo (144, 50, 212, 2, $32CD32 , move, %00111111,0)
                  Boxgo (143, 49, 214, 4, $32CD32 , move, %00110011,1)
                  Boxgo (142, 48, 216, 6, $32CD32 , move, %00111111,0)
                  
                  Boxgo (2+x, 2+y, 4, 4, $32CD32 , move, %00111111,1)
                  Boxgo (1+x, 1+y, 6, 6, $32CD32 , move, %00111111,1)
                  Boxgo (0+x, 0+y, 8, 8, $32CD32 , move, %00111111,1)
                  
                  liniego(144,40,250,10,$FF, move,%00111111, 1)
                  liniego(144,40,250,11,$FF, move,%00111111, 1)
                  liniego(144,40,250,12,$FF, move,%00111111, 1)
                  liniego(250,10,356,40,$FF, move,%00111111, 0)
                  liniego(250,11,356,40,$FF, move,%00111111, 0)
                  liniego(250,12,356,40,$FF, move,%00111111, 0)

                StopDrawing()
              EndIf
              
                   move +1 ; Animations Counter für bewegte Linien
                   If move >7 : move = 0 : EndIf
                   
                   swapp +1 ; Animations Counter für bewegte Linien
                   If swapp>100 : swapp= 0 : EndIf
                   
EndProcedure
                 
;-------------------------------------------

Procedure timer_events()

  Static move.b, swapp.b, x.l, y.l, xx.l, yy.l ; Static Moving counter
  
  Select EventTimer()
      
      Case 0 ; Moving Sample 
         
       moving_sample()
                   
  EndSelect
                   
EndProcedure
   
;---------------------------------------------
;---------------------------------------------

ExamineDesktops()

If OpenWindow (0, DesktopWidth(0) / 2 - 200, DesktopHeight(0) / 2 - 250, 500, 250, "")
   
   CanvasGadget(0, 0, 0, 500 , 400)
   AddWindowTimer(0, 0, 40)
   
   BindEvent(#PB_Event_Timer, @timer_events())

   Repeat
     Select WaitWindowEvent()
       Case #PB_Event_CloseWindow
         End
     EndSelect
   ForEver
   
EndIf
as fine sample herewith, you can see here :

http://www.nachtoptik.de/QUICK-AES-256-Tool.html

regards werner

http://www.nachtoptik.de
Last edited by walbus on Fri Sep 13, 2013 7:36 pm, edited 6 times in total.
Top
sec
Enthusiast
Enthusiast
Posts: 792
Joined: Sat Aug 09, 2003 3:13 am
Location: 90-61-92 // EU or ASIA
Contact:
Contact sec

Re: fine animated Lines & Boxes, cool !

Post by sec »

It does looks nice 8)

Should use?

Code: Select all

BindEvent(#PB_Event_Timer,...)
Top
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: fine animated Lines & Boxes, cool !

Post by walbus »

Thanks for Inspiration, BindEvent is now included

Here also as animations Modul sample for Lines and Boxes or other

Code: Select all

; Animations Modul for Lines and Boxes with BindEvent PB 5.20 >
; Idee - Werner Albus - http://www.nachtoptik.de

;------------------------------------------- 

DeclareModule moving
  
  Declare Linie(x.i, y.i, xx.i, yy.i, shift.a, color.l, lr.i)
  Declare Liniego(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)
  Declare Boxgo(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)
  Declare moving_1()
  Declare timer_event()
  
EndDeclareModule

;------------------

Module moving
  
EnableExplicit
    
BindEvent(#PB_Event_Timer, @timer_event())

;------------------------------------------- 
  
Procedure Linie(x.i, y.i, xx.i, yy.i, shift.a, color.l, lr.i)
   
; Warning - Plot is not clipping here in the sample
  
   Protected a.i, dx.i, dy.i, addval.i = 1
   Protected *plotX.Integer = @xx, *plotY.Integer = @yy
   
   If Abs(x - xx) <= Abs(y - yy) ; Winkel größer 45°
      Swap x, y
      Swap xx, yy
      *plotX = @yy
      *plotY = @xx
   EndIf
      
   If x < xx
      Swap x, xx
      Swap y, yy
   EndIf
   
   If y < yy
      y = 2 * yy - y
      addval = -1
   EndIf
   
   dy = 2 * (y - yy)
   a  = x - xx
   dx = 2 * a
   
   While xx <= x
     
      If shift & 1
         Plot(*plotX\i, *plotY\i, color)
       EndIf
      
      If lr
         shift = (shift << 1) | ((shift >> 7) & $7f)
      Else
         shift = ((shift >> 1) & $7F) | (shift << 7)
      EndIf
      
      xx + 1
      a - dy
      If a <= 0
         a + dx
         yy + addval
      EndIf
   Wend
   
EndProcedure

;-------------------------------------------

Procedure Liniego(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)
  
  Protected i.l
   
  For i=0 To move
  shift = (shift << 1) | ((shift >> 7) & $7f)  
  Next i

  Linie(x, y, xx, yy, shift, color, lr)     

EndProcedure

;-------------------------------------------

Procedure Boxgo(x.i, y.i, xx.i, yy.i, color.l, move.i, shift.a, lr.i)

  xx - 1 : yy - 1
  
 If lr
   Liniego(x, y, x + xx, y, color, move, shift, 1)
   Liniego(x + xx, y, x + xx, y + yy, color, move, shift, 1)
   Liniego(x, y + yy, x + xx, y + yy, color, move, shift, 0)
   Liniego(x, y + yy, x, y, color, move, shift, 0)
  Else
   Liniego(x, y, x + xx, y, color, move, shift, 0)
   Liniego(x + xx, y, x + xx, y + yy, color, move, shift, 0)
   Liniego(x, y + yy, x + xx, y + yy, color, move, shift, 1)
   Liniego(x, y + yy, x, y, color, move, shift, 1)
 EndIf
   
EndProcedure

;-------------------------------------------

Procedure timer_event()
  
  If StartDrawing(CanvasOutput(0))
    
    Select EventTimer()
        
      Case 0 ; Moving Sample 
        moving_1()
        
    EndSelect
    
    StopDrawing()
    
  EndIf
  
EndProcedure

;-------------------------------------------

Procedure moving_1()

    Static move.b, swapp.b, x.l, y.l, xx.l, yy.l ; Static Moving counter
 
           x+xx : If x>491 : xx=-3 : EndIf
                  If x<3   : xx=3  : EndIf

           y+yy : If y>241 : yy=-3 : EndIf
                  If y<3   : yy=3  : EndIf
            
                  Box   (0, 0, 500, 250, $FFFFFF)
                  DrawingMode(#PB_2DDrawing_Outlined) ; Zeichnen von Flächen erfolgt nicht ausgefüllt
                  
                  Box (184, 104, 132, 32, $FF)
                  Box (185, 105, 130, 30, $FF)
                  Box (186, 106, 128, 28, $FF)
                  
                 If swapp<50
                  Boxgo (184, 104, 132, 32, $FFFF00, move, %11110000,1)
                  Boxgo (185, 105, 130, 30, $FFFF00, move, %11110000,1)
                  Boxgo (186, 106,  128, 28,$FFFF00, move, %11110000,1)
                   Else
                  Boxgo (184, 104, 132, 32, $00FFFF, move, %11110000,0)
                  Boxgo (185, 105, 130, 30, $00FFFF, move, %11110000,0)
                  Boxgo (186, 106,  128, 28,$00FFFF, move, %11110000,0)
                 EndIf
                
                  Boxgo (174, 94, 152, 52, $FF0000, move, %00100011,0)
                  Boxgo (175, 95, 150, 50, $FF0000, move, %00100011,0)
                  Boxgo (176, 96, 148, 48, $FF0000, move, %00100011,0)
                  
                  Boxgo (164, 84, 172, 72, $FF, move, %00100111,1)
                  Boxgo (165, 85, 170, 70, $FF, move, %00100111,0)
                  Boxgo (166, 86, 168, 68, $FF, move, %00100111,1)
                  
                  Boxgo (154, 74, 192, 92, $FF, move, %10111111,0)
                  Boxgo (155, 75, 190, 90, $FF, move, %00110011,0)
                  Boxgo (156, 76, 188, 88, $FF, move, %11111101,0)
                  
                  Boxgo (148, 68, 204, 104, $0 , move, %11100110,1)
                  Boxgo (144, 64, 212, 112, $0 , move, %00111111,0)
                  Boxgo (140, 60, 220, 120, $0 , move, %00110011,1)

                  Boxgo (144, 50, 212, 2, $32CD32 , move, %00111111,0)
                  Boxgo (143, 49, 214, 4, $32CD32 , move, %00110011,1)
                  Boxgo (142, 48, 216, 6, $32CD32 , move, %00111111,0)
                  
                  Boxgo (2+x, 2+y, 4, 4, $32CD32 , move, %00111111,1)
                  Boxgo (1+x, 1+y, 6, 6, $32CD32 , move, %00111111,1)
                  Boxgo (0+x, 0+y, 8, 8, $32CD32 , move, %00111111,1)
                  
                  liniego(144,40,250,10,$FF, move,%00111111, 1)
                  liniego(144,40,250,11,$FF, move,%00111111, 1)
                  liniego(144,40,250,12,$FF, move,%00111111, 1)
                  liniego(250,10,356,40,$FF, move,%00111111, 0)
                  liniego(250,11,356,40,$FF, move,%00111111, 0)
                  liniego(250,12,356,40,$FF, move,%00111111, 0)
              
                   move +1 ; Animations Counter für bewegte Linien
                   If move >7 : move = 0 : EndIf
                   
                   swapp +1 ; Animations Counter für bewegte Linien
                   If swapp>100 : swapp= 0 : EndIf
                   
                 EndProcedure
                 
EndModule
;-------------------------------------------


ExamineDesktops()

If OpenWindow (0, DesktopWidth(0) / 2 - 200, DesktopHeight(0) / 2 - 250, 500, 250, "")
   
  CanvasGadget(0, 0, 0, 500 , 400)
  
  AddWindowTimer(0, 0, 40) ; Start moving_1

   Repeat
     Select WaitWindowEvent()
       Case #PB_Event_CloseWindow
         End
     EndSelect
   ForEver
   
EndIf
Last edited by walbus on Fri Sep 13, 2013 7:05 pm, edited 1 time in total.
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: fine animated Lines & Boxes, cool ! (&BindEvent &Modul)

Post by davido »

Very nice. Thanks. :D
DE AA EB
Top
Post Reply

Return to “Tricks 'n' Tips”