PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Animation [quality]

https://www.purebasic.fr/english/viewtopic.php?t=73433

Page 1 of 2

Animation [quality]

Posted: Tue Aug 20, 2019 1:35 am
by Everything
Hi.
I want to make a menu animation similar to this one
(the one that fly out from the left)

and I have two problems here:
  1. Can't get fast & smooth animation with 2d drawing (or any WinAPI winform stuff)
    For example there is no problem to implement this with Sprite (DX hardware acceleration do the job) but GDI gives me some kind of "jumping" effect or artefacts in high speed (especially if menu is big or need to cover the entire window).
    The best visual result that I've got was with WindowOutput (and I hoping not to draw directly on the window), but I think you know how to do it right way.
  2. In the example (link above) there is a little bit easing effect it looks perfect - how to do exactly this one?

Re: Animation [quality]

Posted: Tue Aug 20, 2019 3:19 am
by forgottencoder
Hi

Made a small program. Don't know if this will help you. I tried. :D

Code: Select all


Enumeration
  #win1
  #im1
  #box1
  #ig1
  #bt1
EndEnumeration  

Global event

If OpenWindow(#win1, 0, 0, 800, 600, "Side Menu", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  ButtonGadget(#bt1, 10, 10, 120, 20, "Menu SHOW/HIDE")
  
  
  CreateImage(#im1,300,300,32,RGBA(255,0,0,255))
  StartDrawing(ImageOutput(#im1))
    DrawText(10,10,"menu")
  StopDrawing()
  
  x=-300
  y=200
  btflag=1
      
  Repeat
    event = WindowEvent()
    Select event
      Case #PB_Event_Gadget
        Select EventGadget()  
          Case #bt1
            
            If btflag=1
              cnt=0
              Repeat
                x=x+30
                Delay(30)
                ImageGadget(#ig1, x, y, 300, 300, ImageID(#im1))
                cnt=cnt+1
              Until cnt=10
              btflag=0
            Else 
              cnt=0
              Repeat
                x=x-30
                Delay(30)
                ImageGadget(#ig1, x, y, 300, 300, ImageID(#im1))
                cnt=cnt+1
              Until cnt=10
              btflag=1
            EndIf 
            
        EndSelect    
        
      Case #PB_Event_CloseWindow
        End
    EndSelect   
    
    
  ForEver
  
EndIf

Re: Animation [quality]

Posted: Tue Aug 20, 2019 3:39 am
by Everything
Thx
Nice try but it's blinking as hell while moving :D
(Just in case - Win 7x64)

Re: Animation [quality]

Posted: Tue Aug 20, 2019 8:42 am
by Bisonte
You mean something like this ?

Code: Select all

EnableExplicit

Enumeration EnumImage 1
  #Image_FlyOut
EndEnumeration
Enumeration EnumWindow 1
  #Window_Main
  #Window_FlyOut
EndEnumeration
Enumeration EnumGadget 1
  #Canvas_Bar
  #Canvas_FlyOut
EndEnumeration
Enumeration EnumTimer 123
  #Timer_FlyOut
  #Timer_FlyIn
EndEnumeration

Define Event, oldStyle, i, h, FlyOut

Procedure.i Event_MoveWindow_Main()
  
  Protected x = WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar)
  Protected y = WindowY(#Window_Main) + 26 ; Adjust this value if not fit
  
  ResizeWindow(#Window_FlyOut, x, y, #PB_Ignore, #PB_Ignore)
  
EndProcedure
Procedure.i Event_Timer()
  
  Protected Width = WindowWidth(#Window_FlyOut)
  Protected x = WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar)
  Protected y = WindowY(#Window_Main) + 26
  
  Select EventTimer() 
      
    Case #Timer_FlyOut
      
      Width + 8 
      
      If Width > GadgetWidth(#Canvas_FlyOut)
        Width = GadgetWidth(#Canvas_FlyOut)
        RemoveWindowTimer(#Window_Main, #Timer_FlyOut)
      EndIf
      
    Case #Timer_FlyIn
      
      Width - 8
      
      If Width < 0
        Width = 0
        HideWindow(#Window_FlyOut, #True)
        RemoveWindowTimer(#Window_Main, #Timer_FlyIn)  
      EndIf
      
  EndSelect

  ResizeWindow(#Window_FlyOut, x, y, Width, #PB_Ignore)
    
EndProcedure

LoadImage(#Image_FlyOut, #PB_Compiler_Home + "Examples\Sources\Data\PureBasicLogo.bmp")

OpenWindow(#Window_Main, 0, 0, 640, ImageHeight(#Image_FlyOut) * 6, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

CanvasGadget(#Canvas_Bar, 0, 0, 30, WindowHeight(#Window_Main))

If StartDrawing(CanvasOutput(#Canvas_Bar))
  Box(0, 0, OutputWidth(), OutputHeight(), $151413)
  StopDrawing()
EndIf

If OpenWindow(#Window_FlyOut, WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar), WindowY(#Window_Main) + 26, ImageWidth(#Image_FlyOut), WindowHeight(#Window_Main), "", #PB_Window_BorderLess|#PB_Window_Invisible, WindowID(#Window_Main))
  
  CanvasGadget(#Canvas_FlyOut, 0, 0, WindowWidth(#Window_FlyOut), WindowHeight(#Window_FlyOut))
  If StartDrawing(CanvasOutput(#Canvas_FlyOut))
    For i = 0 To OutputHeight() Step 68
      DrawImage(ImageID(#Image_FlyOut), 0, i)
    Next i
    StopDrawing()
  EndIf
  
  ; From RSBasic - WinAPI Library - Do not change focus
  oldStyle=GetWindowLongPtr_(WindowID(#Window_FlyOut),#GWL_STYLE)
  SetWindowLongPtr_(WindowID(#Window_FlyOut),#GWL_STYLE,oldStyle|#WS_CHILD &(~#WS_POPUP))
  SetWindowPos_(WindowID(#Window_FlyOut), 0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
  SetActiveWindow(#Window_Main)
  
  ResizeWindow(#Window_FlyOut, #PB_Ignore, #PB_Ignore, 0, #PB_Ignore)
  
EndIf

BindEvent(#PB_Event_MoveWindow, @Event_MoveWindow_Main())
BindEvent(#PB_Event_Timer, @Event_Timer())

Repeat
  
  Event = WaitWindowEvent()
  
  Select Event()
      
    Case #PB_Event_CloseWindow
      Break
      
    Case #PB_Event_Gadget
      
      Select EventGadget()
          
        Case #Canvas_Bar
          
          Select EventType()
              
            Case #PB_EventType_LeftClick
              
              If FlyOut = #False
                HideWindow(#Window_FlyOut, #False)
                AddWindowTimer(#Window_Main, #Timer_FlyOut, 1)
                FlyOut = #True
              Else
                AddWindowTimer(#Window_Main, #Timer_FlyIn, 1)
                FlyOut = #False
              EndIf
              
          EndSelect
          
      EndSelect
      
  EndSelect
  
ForEver

Re: Animation [quality]

Posted: Tue Aug 20, 2019 11:26 am
by mk-soft
AddGadgetTimer :wink:
Link: viewtopic.php?f=12&t=73031

Re: Animation [quality]

Posted: Tue Aug 20, 2019 1:56 pm
by Everything
Bisonte wrote:You mean something like this ?
It moves slow and I guess look nice because of it but
I want my animation looks exactly the same as in the gif image (same speed & same easing) and here you might get some problems...

mk-soft wrote:AddGadgetTimer
Already used it for stuff like that, very nice indeed 8)

Re: Animation [quality]

Posted: Tue Aug 20, 2019 3:11 pm
by Sirius-2337
Everything wrote:
Bisonte wrote:You mean something like this ?
It moves slow and I guess look nice because of it but
I want my animation looks exactly the same as in the gif image (same speed & same easing) and here you might get some problems...
How about this?

Code: Select all

EnableExplicit

Enumeration EnumImage 1
  #Image_FlyOut
EndEnumeration
Enumeration EnumWindow 1
  #Window_Main
  #Window_FlyOut
EndEnumeration
Enumeration EnumGadget 1
  #Canvas_Bar
  #Canvas_FlyOut
EndEnumeration
Enumeration EnumTimer 123
  #Timer_FlyOut
  #Timer_FlyIn
EndEnumeration

Define Event, oldStyle, i, h, FlyOut

Global FlyOutWidth.d

Procedure.i Event_MoveWindow_Main()
 
  Protected x = WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar)
  Protected y = WindowY(#Window_Main) + 26 ; Adjust this value if not fit
 
  ResizeWindow(#Window_FlyOut, x, y, #PB_Ignore, #PB_Ignore)
 
EndProcedure
Procedure.i Event_Timer()
 
  Protected Width.d
  Protected x = WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar)
  Protected y = WindowY(#Window_Main) + 26
 
  Select EventTimer()
     
    Case #Timer_FlyOut
      
      FlyOutWidth * 0.85
      
      If FlyOutWidth < 1
        FlyOutWidth = 0
        RemoveWindowTimer(#Window_Main, #Timer_FlyOut)
      EndIf
     
      Width = GadgetWidth(#Canvas_FlyOut) - FlyOutWidth
      
    Case #Timer_FlyIn
     
      FlyOutWidth * 0.65
     
      If FlyOutWidth < 1
        FlyOutWidth = 0
        HideWindow(#Window_FlyOut, #True)
        RemoveWindowTimer(#Window_Main, #Timer_FlyIn) 
      EndIf
     
     Width = FlyOutWidth
     
  EndSelect

  ResizeWindow(#Window_FlyOut, x, y, Width, #PB_Ignore)
   
EndProcedure

LoadImage(#Image_FlyOut, #PB_Compiler_Home + "Examples\Sources\Data\PureBasicLogo.bmp")

OpenWindow(#Window_Main, 0, 0, 640, ImageHeight(#Image_FlyOut) * 6, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

CanvasGadget(#Canvas_Bar, 0, 0, 30, WindowHeight(#Window_Main))

If StartDrawing(CanvasOutput(#Canvas_Bar))
  Box(0, 0, OutputWidth(), OutputHeight(), $151413)
  StopDrawing()
EndIf

If OpenWindow(#Window_FlyOut, WindowX(#Window_Main) + GadgetWidth(#Canvas_Bar), WindowY(#Window_Main) + 26, ImageWidth(#Image_FlyOut), WindowHeight(#Window_Main), "", #PB_Window_BorderLess|#PB_Window_Invisible, WindowID(#Window_Main))
 
  CanvasGadget(#Canvas_FlyOut, 0, 0, WindowWidth(#Window_FlyOut), WindowHeight(#Window_FlyOut))
  If StartDrawing(CanvasOutput(#Canvas_FlyOut))
    For i = 0 To OutputHeight() Step 68
      DrawImage(ImageID(#Image_FlyOut), 0, i)
    Next i
    StopDrawing()
  EndIf
 
  ; From RSBasic - WinAPI Library - Do not change focus
  oldStyle=GetWindowLongPtr_(WindowID(#Window_FlyOut),#GWL_STYLE)
  SetWindowLongPtr_(WindowID(#Window_FlyOut),#GWL_STYLE,oldStyle|#WS_CHILD &(~#WS_POPUP))
  SetWindowPos_(WindowID(#Window_FlyOut), 0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
  SetActiveWindow(#Window_Main)
 
  ResizeWindow(#Window_FlyOut, #PB_Ignore, #PB_Ignore, 0, #PB_Ignore)
 
EndIf

BindEvent(#PB_Event_MoveWindow, @Event_MoveWindow_Main())
BindEvent(#PB_Event_Timer, @Event_Timer())

Repeat
 
  Event = WaitWindowEvent()
 
  Select Event()
     
    Case #PB_Event_CloseWindow
      Break
     
    Case #PB_Event_Gadget
     
      Select EventGadget()
         
        Case #Canvas_Bar
         
          Select EventType()
             
            Case #PB_EventType_LeftClick
             
              If FlyOut = #False
                HideWindow(#Window_FlyOut, #False)
                AddWindowTimer(#Window_Main, #Timer_FlyOut, 1)
                FlyOut = #True
                FlyOutWidth = GadgetWidth(#Canvas_FlyOut)
              Else
                AddWindowTimer(#Window_Main, #Timer_FlyIn, 1)
                FlyOut = #False
                FlyOutWidth = GadgetWidth(#Canvas_FlyOut)
              EndIf
             
          EndSelect
         
      EndSelect
     
  EndSelect
 
ForEver

Re: Animation [quality]

Posted: Tue Aug 20, 2019 3:41 pm
by Everything
Sirius-2337 wrote:How about this?
Damn close!
Could you do that with ~ half window wide (like in code from Bisonte)?
I am asking because even in your example 1 of 15 animations goes with gadget flickering, and I guess that even if it will be a little bit wider, it's become a problem to save same speed and smoothness at the same time...

Re: Animation [quality]

Posted: Tue Aug 20, 2019 3:50 pm
by Sirius-2337
Everything wrote:
Sirius-2337 wrote:How about this?
Damn close!
Could you do that with ~ half window wide (like in code from Bisonte)?
Of course. I edited the code above.

Re: Animation [quality]

Posted: Tue Aug 20, 2019 5:31 pm
by forgottencoder
Hi everyone

This is my best mojo so far. :D

To achieve best performance try to change delays values, x values and cnt values.

Code: Select all


Enumeration
  #win1
  #box1
  #bt1
  #sp1
EndEnumeration  

Global event

InitSprite()

If OpenWindow(#win1, 0, 0, 800, 600, "Side Menu", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(#win1),0,100,800,500,#False,0,0,#PB_Screen_WaitSynchronization)
  ;OpenWindowedScreen(WindowID(#win1),0,100,800,500)
  
  ButtonGadget(#bt1, 10, 10, 120, 20, "Menu SHOW/HIDE")
  
  CreateSprite(#sp1, 400, 400)
  If StartDrawing(SpriteOutput(#sp1))
    
    Box(0, 0, 400, 400, RGBA(128, 128, 128,180))
    StopDrawing()
  EndIf
  
  x=-360
  y=0
  btflag=1
  
  DisplaySprite(#sp1, x, y)
      
  Repeat
  
    event = WaitWindowEvent()
    Select event
      Case #PB_Event_Gadget
        Select EventGadget()  
          Case #bt1
            
            If btflag=1
              cnt=0
              Repeat
                FlipBuffers()
                ClearScreen(RGB(0, 0, 0))
                DisplaySprite(#sp1, x, y)
                
                If cnt>10
                  Delay(20)
                Else  
                  Delay(1)
                EndIf  
                
                cnt=cnt+1
                x=x+20
              Until cnt=18
              btflag=0
              x=-40
            Else
              cnt=0
              Repeat
                FlipBuffers()
                ClearScreen(RGB(0, 0, 0))
                DisplaySprite(#sp1, x, y)
                
                If cnt>10
                  Delay(20)
                Else  
                  Delay(1)
                EndIf 

                cnt=cnt+1
                x=x-20
              Until cnt=18
              btflag=1
              x=-360
            EndIf 
            
        EndSelect    
        
      Case #PB_Event_CloseWindow
        End
    EndSelect   
    
    
    
  ForEver
  
EndIf

Re: Animation [quality]

Posted: Tue Aug 20, 2019 6:06 pm
by Everything
Sirius-2337 wrote:Of course
Well... this is the best result I've ever get, thank you very mach 8)
There is some not covered moments like if you click fast for example

Image

And still (very very rare but) there is flickering from time to time... but in general everything is nice and smooth - I really like it!

forgottencoder, as I said before DX is GPU based and have no problems at all, but I can't use it (VBox crash)

Re: Animation [quality]

Posted: Tue Aug 20, 2019 6:09 pm
by Mijikai
My try :)

Code: Select all

EnableExplicit

Global.i wm.i,st
Global.f tl,tc,td,x
 
If InitSprite() And InitKeyboard()
  If OpenWindow(0,#Null,#Null,800,600,"Side Menu",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    If OpenWindowedScreen(WindowID(0),#Null,#Null,800,600,#False,#Null,#Null,#PB_Screen_WaitSynchronization)
      x = -1
      Repeat
        tc = ElapsedMilliseconds()
        td = tc - tl
        tl = tc
        Repeat
          wm = WindowEvent()
          If wm = #PB_Event_CloseWindow
            Break 2
          EndIf
        Until wm = #Null 
        ExamineKeyboard()
        If KeyboardPushed(#PB_Key_Space)
          If st = 1 And x > 199
            st = 0
          ElseIf x < 0
            st = 1
          EndIf
        EndIf
        If st = 1
          If x > 197:x = 200:Else:x + (1.5 * td):EndIf 
        Else
          If x > 0:x - (1.5 * td):Else:x = -1:EndIf
        EndIf
        ClearScreen(#Null)
        If StartDrawing(ScreenOutput())
          DrawText(200,300,"PRESS [SPACE]")
          Box(0,0,x,600,#Red)
          StopDrawing()
        EndIf
        FlipBuffers()
      ForEver 
    EndIf
    CloseWindow(0)
  EndIf
EndIf

End

Re: Animation [quality]

Posted: Tue Aug 20, 2019 6:41 pm
by Everything
Mijikai, thx, look my comment above about DX

Re: Animation [quality]

Posted: Tue Aug 20, 2019 7:25 pm
by Mijikai
Everything wrote:Mijikai, thx, look my comment above about DX
Set the subsystem to OpenGL.

Re: Animation [quality]

Posted: Tue Aug 20, 2019 7:49 pm
by RASHAD
Windows API
Use Left & Right arrow keys
Change the time period as per your needs(500)

Code: Select all

Procedure winCB(hwnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents
 Select uMsg
                                       
  Case #WM_NCACTIVATE
      Result = 1      
        
  Case #WM_SIZE,#WM_MOVE
    ResizeWindow(1,WindowX(0,#PB_Window_InnerCoordinate), WindowY(0)+25,100,400)
 
 EndSelect   
ProcedureReturn result 
EndProcedure

OpenWindow(0,0,0,600,400,"Main Window",#PB_Window_SystemMenu| #PB_Window_ScreenCentered)
OpenWindow(1,WindowX(0,#PB_Window_InnerCoordinate),WindowY(0)+25,100,400,"",#PB_Window_BorderLess |#WS_BORDER,WindowID(0))
SetWindowColor(1,$C8C8C8)
HideWindow(1,1)
UseGadgetList(WindowID(1))
ButtonGadget(1,10,10,60,40,"TEST")

AddKeyboardShortcut(0,#PB_Shortcut_Right,10)
AddKeyboardShortcut(1,#PB_Shortcut_Left,20)
AddKeyboardShortcut(1,#PB_Shortcut_Right,30)
AddKeyboardShortcut(0,#PB_Shortcut_Left,40)
SetWindowCallback(@winCB())

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 10
          AnimateWindow_(WindowID(1),500,#AW_HOR_POSITIVE| #AW_ACTIVATE)          
        Case 20      
          AnimateWindow_(WindowID(1),500,#AW_HOR_NEGATIVE| #AW_HIDE)
        Case 30
          AnimateWindow_(WindowID(1),500,#AW_HOR_POSITIVE| #AW_ACTIVATE)          
        Case 40      
          AnimateWindow_(WindowID(1),500,#AW_HOR_NEGATIVE| #AW_HIDE)         
      EndSelect
  EndSelect
Until Quit = 1
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited