It is currently Wed Sep 18, 2019 9:02 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 20 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Animation [quality]
PostPosted: Tue Aug 20, 2019 1:35 am 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
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?


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 3:19 am 
Offline
User
User

Joined: Sun Jul 21, 2019 1:46 am
Posts: 12
Hi

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

Code:

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




Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 3:39 am 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
Thx
Nice try but it's blinking as hell while moving :D
(Just in case - Win 7x64)


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 8:42 am 
Offline
Addict
Addict
User avatar

Joined: Tue Oct 09, 2007 2:15 am
Posts: 1082
You mean something like this ?

Code:
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

_________________
PureBasic 5.70 LTS (Windows x86/x64) | Windows10 Pro x64 | Z370 Extreme4 | i7 8770k | 32GB RAM | iChill GeForce GTX 980 X4 Ultra | HAF XF Evo​​
English is not my native language... (I often use DeepL to translate my texts.)


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 11:26 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1905
Location: Germany
AddGadgetTimer :wink:
Link: viewtopic.php?f=12&t=73031

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 1:56 pm 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
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)


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 3:11 pm 
Offline
User
User

Joined: Sat May 14, 2011 10:39 am
Posts: 53
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:
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


Last edited by Sirius-2337 on Tue Aug 20, 2019 3:49 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 3:41 pm 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
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...


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 3:50 pm 
Offline
User
User

Joined: Sat May 14, 2011 10:39 am
Posts: 53
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 5:31 pm 
Offline
User
User

Joined: Sun Jul 21, 2019 1:46 am
Posts: 12
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:

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





Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 6:06 pm 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
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)


Last edited by Everything on Tue Aug 20, 2019 6:20 pm, edited 3 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 6:09 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Sep 11, 2016 2:17 pm
Posts: 514
My try :)
Code:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 6:41 pm 
Offline
User
User

Joined: Sat Jul 07, 2018 6:50 pm
Posts: 65
Mijikai, thx, look my comment above about DX


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 7:25 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Sep 11, 2016 2:17 pm
Posts: 514
Everything wrote:
Mijikai, thx, look my comment above about DX

Set the subsystem to OpenGL.


Top
 Profile  
Reply with quote  
 Post subject: Re: Animation [quality]
PostPosted: Tue Aug 20, 2019 7:49 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3395
Windows API
Use Left & Right arrow keys
Change the time period as per your needs(500)
Code:
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

_________________
Egypt my love


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 20 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: SPH and 16 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye