Resize Multi Framed GIF Temporary

Share your advanced PureBasic knowledge/code with the community.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Resize Multi Framed GIF Temporary

Post by RASHAD »

Hi
Need more work to do if the GIF frames has different sizes and timing (But still it is easy to do)

Code: Select all

UseGIFImageDecoder()
Global Quit,imgcount,framedelay,imgwd,imgwh,factor.f,pflag
factor = 1

Procedure PlayGIF(par)
  Repeat
    Delay(10)
    If pflag = 1
      SetImageFrame(10, Frame)       
      StartDrawing(WindowOutput(0))
        DrawImage(ImageID(10),WindowWidth(0)/2-factor*imgwd/2,10,factor*imgwd,factor*imgwh)
      StopDrawing()            
      Frame+1
      If Frame >= imgcount : Frame = 0 : EndIf       
      Delay(framedelay-10)
    EndIf
  Until Quit = 1
EndProcedure

OpenWindow(0,0,0,800,800,"",#PB_Window_SystemMenu| #PB_Window_ScreenCentered)
TrackBarGadget(1,10,740,400,50,1,5,#PB_TrackBar_Ticks)
ButtonGadget(2,420,740,50,50,"Run")
CatchImage(10,?pgif)
imgcount = ImageFrameCount(10)
framedelay = GetImageFrameDelay(10)
imgwd = ImageWidth(10)
imgwh = ImageHeight(10)
If IsImage(10)
  Thread = CreateThread(@PlayGIF(),30)
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          pflg = 0
          StartDrawing(WindowOutput(0))
            Box(0,0,800,700,$F0F0F0)
          StopDrawing()            
          factor = 1+GetGadgetState(1)/10
          
        Case 2
          Run ! 1
          If Run = 1
            pflag = 1
          Else
            pflag = 0
          EndIf
      EndSelect      
  EndSelect
Until Quit =1

DataSection
  pgif:
  IncludeBinary "g:\mmedia\pictures\KccBouleNoel.gif"
EndDataSection

Edit :Modified
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Resize Multi Framed GIF Temporary

Post by RASHAD »

Previous post updated to minimize the CPU usage during the stop intervals
Egypt my love
Post Reply