Simple window effect procedure

[Nituvious]

Hi guys, here's some crappy code that makes a really lame visual effect for OpenWindow(). Maybe it can shorten some dev time for someone.

Code: Select all

Enumeration
	#popupWindow
	#mainWindow
	#button_1
	#button_2
	#text_1
EndEnumeration

ExamineDesktops()


Global mWindowID

#Ex_Dropdown 		= 0
#Ex_Dropright		= 1

Procedure WindowEffect(mWindowID, mWinWidth.f, mWinHeight.f, mWinEffect, mSpeed.f);, WSpeed, HSpeed)
	;exResult = OpenWindow(mWindowID,0,0,mWinResizeWidth,mWinResizeHeight,mWinTitle.s,mWinFlags)
	If mSpeed > 10 : mSpeed = 10 : ElseIf mSpeed <= 1 : mSpeed = 1 : EndIf ; -- A speed higher than 10 makes a window resize oddly
	HideWindow(mWindowID,1) : Delay(2) : HideWindow(mWindowID,0) ; -- Tries to prevent "flashing"
	
	While Ex_Effect = 0 : WaitWindowEvent(10)
		If mWinEffect = #Ex_Dropdown
			If mWinResizeHeight >= mWinHeight : Else
				mWinResizeHeight + mSpeed
			EndIf
			mWinResizeWidth = mWinWidth
			ResizeWindow(mWindowID, #PB_Ignore, #PB_Ignore, mWinResizeWidth, mWinResizeHeight)
			ResizeWindow(#mainWindow, WindowX(#popupWindow)+WindowWidth(#popupWindow)+6,WindowY(#popupWindow),#PB_Ignore,#PB_Ignore)
		EndIf
		
		If mWinEffect = #Ex_Dropright
			If mWinResizeHeight >= mWinHeight : Else
				mWinResizeHeight + mSpeed
			EndIf
			If mWinResizeWidth >= mWinWidth :	Else
				mWinResizeWidth + mSpeed
			EndIf
			ResizeWindow(mWindowID, #PB_Ignore, #PB_Ignore, mWinResizeWidth, mWinResizeHeight)
			ResizeWindow(#mainWindow, WindowX(#popupWindow)+WindowWidth(#popupWindow)+6,WindowY(#popupWindow),#PB_Ignore,#PB_Ignore)
		EndIf

		; -- Check if we've reached our window width and height..
		If mWinResizeHeight >= mWinHeight And mWinResizeWidth >= mWinWidth
			ResizeWindow(mWindowID, #PB_Ignore, #PB_Ignore, mWinWidth, mWinHeight) ; -- fail safe to keep large numbers from making large windows
			Break
		EndIf
	Wend
EndProcedure


OpenWindow(#mainWindow,-100,-100,0,0,"Menu",#PB_Window_Tool) ; -- I set the position to -100 because having it pop up on the top corner was quite annoying
ButtonGadget(#button_1,0,5,125,25,"Drop Down")
ButtonGadget(#button_2,0,30,125,25,"Drop Right")

Delay(10)

OpenWindow(#popupWindow,DesktopWidth(0)/2.7,DesktopHeight(0)/2.5,150,120,"Window Effects",#PB_Window_SystemMenu)
TextGadget(#text_1,5,25,150,55,"Click on a button in the menu"+#LF$+"The menu starts with a drop down effect.")
WindowEffect(#mainWindow,126,70, #Ex_Dropdown, 1)
Repeat
	eventID = WaitWindowEvent(10)
	ResizeWindow(#mainWindow, WindowX(#popupWindow)+WindowWidth(#popupWindow)+6,WindowY(#popupWindow),#PB_Ignore,#PB_Ignore)
	If eventID = #PB_Event_Gadget
		Select EventGadget()
			Case #button_1
				WindowEffect(#popupWindow,150,175,#Ex_Dropdown,1)
				SetGadgetText(#text_1,"Drop down!")
			Case #button_2
				WindowEffect(#popupWindow,250,250,#Ex_Dropright,10)
				SetGadgetText(#text_1,"Drop to the right!")
		EndSelect
	EndIf
Until eventID = #PB_Event_CloseWindow

[idle]

I like the drop down effect, thanks

[Trond]

The drop down effect needs a roll up effect to go with it.

Code: Select all

Procedure GetFoldPath(H, List P.i())
  nH.d = 0
  Repeat
    nH + (H-nH) / 5. + 0.5
    AddElement(P())
    P() = nH
  Until nH >= H
EndProcedure

Procedure WindowFold(W, FoldUp = 0)
  H = WindowHeight(W)
  NewList Path.i()
  ResizeWindow(W, #PB_Ignore, #PB_Ignore, #PB_Ignore, H*FoldUp)
  HideWindow(W, 0)
  GetFoldPath(H, Path())
  ForEach Path()
    If FoldUp
      ResizeWindow(W, #PB_Ignore, #PB_Ignore, #PB_Ignore, H-Path())
    Else
      ResizeWindow(W, #PB_Ignore, #PB_Ignore, #PB_Ignore, Path())
    EndIf
    While WindowEvent()
    Wend
    Delay(10)
  Next
  HideWindow(W, FoldUp)
  ResizeWindow(W, #PB_Ignore, #PB_Ignore, #PB_Ignore, H)
EndProcedure

#W = 512
#H = 384

CreateImage(0, #W, #H, 24)
StartDrawing(ImageOutput(0))
  For I = 0 To 100
    GradientColor(I/100., RGB(I*10, -I*20, I*3000))
  Next
  DrawingMode(#PB_2DDrawing_Gradient)
  CircularGradient(#W/2, #H/2, #W/2)
  Box(0, 0, #W, #H)
StopDrawing()

OpenWindow(0, 0, 0, #W, #H, "Test window", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_Invisible)
ImageGadget(3, 0, 0, 0, 0, ImageID(0))
OpenWindow(1, 0, 0, 100, 100, "Menu")
ResizeWindow(1, WindowX(0)+WindowWidth(0)+6,WindowY(0),#PB_Ignore,#PB_Ignore)
ButtonGadget(0, 10, 10, 80, 25, "Dropdown")
ButtonGadget(1, 10, 40, 80, 25, "Foldup")

While WindowEvent() : Wend

;WindowDropDown(W)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          WindowFold(0, 0)
        Case 1
          WindowFold(0, 1)
      EndSelect
    Case #PB_Event_MoveWindow
      If EventWindow() = 0
        ResizeWindow(1, WindowX(0)+WindowWidth(0)+6,WindowY(0),#PB_Ignore,#PB_Ignore)
      EndIf
    Case #PB_Event_CloseWindow
      If EventWindow() = 0
        HideWindow(0, 1)
      Else
        End
      EndIf
  EndSelect
ForEver

[dige]

@Trond: cool!

[Kwai chang caine]

Cool your two code.

Since a long time, i search a code to simulate the unfolding of a parchment
But it's really difficult to create it

It's perhaps a beginning for create it ?? :roll:
Thanks a lot for sharing

[Nituvious]

That is really neat!