Animations Modul sample mit BindEvent

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
walbus
Beiträge: 137
Registriert: 03.03.2013 20:50

Animations Modul sample mit BindEvent

Beitrag von walbus »

:)
Zuletzt geändert von walbus am 08.02.2015 23:31, insgesamt 2-mal geändert.
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Animations Modul sample mit BindEvent

Beitrag von ts-soft »

:allright:

Aber trotzdem noch ein paar Anmerkungen:
Bei einem Module erwarte ich eigentlich EnableExplicit, es ist zwar
nur eine einzige Variable nicht deklariert, aber ...

In der timer_event() Procedure, werden div. Variablen static deklariert, aber erstens gar nicht genutzt
und da static belegen sie auch noch unnötig (aber vernachlässigbar) Speicher.

Deine TimerProcedure reagiert auf alle Timer, so das ich selber keinen mehr Sicher nutzen kann.
Da solltest Du noch was zum Setzen des Timers hinzufügen und dann auch nur diesen binden.

Gruß
Thomas
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
walbus
Beiträge: 137
Registriert: 03.03.2013 20:50

Re: Animations Modul sample mit BindEvent

Beitrag von walbus »

:)
Zuletzt geändert von walbus am 08.02.2015 23:31, insgesamt 1-mal geändert.
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Animations Modul sample mit BindEvent

Beitrag von ts-soft »

Ich habs mal kurz eingebaut:

Code: Alles auswählen

; 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()
  Declare StartTimer(timer, timeout = 40, window = 0)
EndDeclareModule

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

Module moving
  EnableExplicit
  
  Global mTimer
  
  Procedure StartTimer(timer, timeout = 40, window = 0)
    mTimer = timer
    AddWindowTimer(window, timer, timeout) 
    BindEvent(#PB_Event_Timer, @timer_event(), window, mTimer)
  EndProcedure
  
  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
    
    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 mTimer ; 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
;-------------------------------------------

CompilerIf #PB_Compiler_IsMainFile
  ExamineDesktops()
  
  If OpenWindow (0, DesktopWidth(0) / 2 - 200, DesktopHeight(0) / 2 - 250, 500, 250, "")
    
    CanvasGadget(0, 0, 0, 500 , 400)
    
    moving::StartTimer(1)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          End
      EndSelect
    ForEver
    
  EndIf
CompilerEndIf
Ich hoffe mal, ich hab nichts übersehen. Der Timer läßt sich setzen und wird automatisch hinzugefügt.
Timeout und Window können optional angegeben werden, macht das ganze flexibler, ansonsten ist das
als Modul nicht so geeignet.

Gruß

Thomas

//edit
Das Canvas ist auch fix auf 0 festgelegt, das sollte auch noch angepaßt werden, weil ansonsten
ist die wiederverwendbarkeit unter anderen Bedingungen nicht möglich und das einpacken in ein
Modul nicht sinnvoll.

Aber das darfste jetzt selber hinzufügen :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
walbus
Beiträge: 137
Registriert: 03.03.2013 20:50

Re: Animations Modul sample mit BindEvent

Beitrag von walbus »

:)
Antworten