Keep a window at a certain aspect ratio

[jacdelad]

Hi #PB_All,
I want to keep a window at a certain aspect ratio (a square (x=y) in my example). I typed the following code, which basically works nice...but flickers like hell:

Code: Select all

Procedure SizeHandler()
  Protected x=WindowWidth(0),y=WindowHeight(0)
  If x<>y
    If x<y
      y=x
    Else
      x=y
    EndIf
    ResizeWindow(0,#PB_Ignore,#PB_Ignore,x,y)
  EndIf
EndProcedure

OpenWindow(0,0,0,400,400,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
SmartWindowRefresh(0,#True)
BindEvent(#PB_Event_SizeWindow,@SizeHandler(),0)
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

No change with/without SmartWindowRefresh. I guess I can maybe do this with subclassing on Windows, but this would destroy the crossplatform capability. Has anyone tried the same and maybe has a better way to do this?

[RASHAD]

Maybe

Code: Select all

Procedure SizeHandler()
  Protected x=WindowWidth(0),y=WindowHeight(0)
  If x > y
    ResizeWindow(0,#PB_Ignore,#PB_Ignore,x,x)
    Delay(100)
  Else
    ResizeWindow(0,#PB_Ignore,#PB_Ignore,y,y)
    Delay(100)
  EndIf
EndProcedure

OpenWindow(0,0,0,400,400,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
WindowBounds(0,300,300,#PB_Default,#PB_Default)
SmartWindowRefresh(0,#True)
BindEvent(#PB_Event_SizeWindow,@SizeHandler(),0)
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

[jacdelad]

This is indeed working a bit better. It's the delay, I guess. Unfortunately this makes the window resizing slow.

[BarryG]

Rashad's slower version is better because it allows resizing from the sides and top/bottom of the window. Your original code doesn't, and loses the aspect.

Having said that, Rashad's code fails when resizing a side too much, as it then starts moving the window across the desktop by mistake. Yikes!

Do you absolutely have to avoid making it cross-platform? What if you use CompilerElse to create valid code for Win/Linux/Mac?

My suggestion (if nobody comes up with a flicker-free cross-platform solution) is to NOT allow manual resizing, but have a setting in the app to choose a size? It can then just auto-size according to what the user wants. Something like this, or buttons for small/medium/large, etc:

Code: Select all

#sizebase=400
s=#sizebase*5*0.25

OpenWindow(0,0,0,s,s,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)

TextGadget(0,10,10,120,20,"Choose window size:")
TrackBarGadget(1,130,10,250,20,1,10,#PB_TrackBar_Ticks)
SetGadgetState(1,5)

Repeat
  ev=WaitWindowEvent()
  If ev=#PB_Event_Gadget
    If EventGadget()=1
      s=#sizebase*GetGadgetState(1)*0.25
      ResizeWindow(0,#PB_Ignore,#PB_Ignore,s,s)
    EndIf
  EndIf
Until ev=#PB_Event_CloseWindow

[Caronte3D]

If you wait for "vertical blank" (as we old school coders did all the time), you get almost flicker free, but only for Windows (I think)

Note: The wait for VB is not a good companion for the Windows system, but...

Code: Select all

Procedure.i WaitForVerticalBlank();wait for vsync! / returns 1 on sucess 0 on failure / note: busy wait!
  Static *ddraw.IDirectDraw
  If Not *ddraw
    If DirectDrawCreate_(#Null, @*ddraw, #Null) = #Null
      If *ddraw\WaitForVerticalBlank($4, #Null) = #Null
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    Else
      ProcedureReturn 0
    EndIf
  Else
    If *ddraw\WaitForVerticalBlank($4, #Null) = #Null
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
  EndIf
EndProcedure

Procedure SizeHandler()
  Protected x = WindowWidth(0), y = WindowHeight(0)
  
    If x>y
      ResizeWindow(0, #PB_Ignore, #PB_Ignore, x, x)
    Else
      ResizeWindow(0, #PB_Ignore, #PB_Ignore, y, y)
    EndIf
    
    While Not WaitForVerticalBlank():Wend
  
EndProcedure

OpenWindow(0, 0, 0, 400, 400, "Test", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget)
SmartWindowRefresh(0, #True)
BindEvent(#PB_Event_SizeWindow, @SizeHandler(), 0)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[BarryG]

@Caronte3D: Your example suffers the same problem as Rashad: if you resize from the left edge to make it smaller to the right, the window starts moving to the right as well. Same if you resize from the top towards the bottom - the entire window moves down.

And you're definitely showing your age when mentioning vertical blank waits, haha.

[Caronte3D]

It's the same code RASHAD posted, I only added the procedure for wait the VB (not mine) to try to get rid of flicker..
The behaviour while scaling the window is another thing

[BarryG]

Oh, I didn't notice it was the same base code. Rashad, fix it! LOL!

[Fred]

And you're definitely showing your age when mentioning vertical blank waits, haha.

[Caronte3D]

[idle]

Im suffering vertical blanks. Just ask me what the day it is.

[jacdelad]

Ok, back to the topic (I was asleep, nightshift...).
Firstly, thanks to everyone contributing.

My code's purpose was only to show flickering problem and yes, it has to be changed to accept vertical/horizontal scaling too.
And it does not necessarily have to be multiplatform because I mainly use Windows. But a multiplatform solution would be very nice of course. Also, this feature would be a cool addition (maybe as a flag, #PB_Window_KeepAspectRatio) for a future PB-Version.

However, I've seen other programs on Windows which do it flickerfree, so I'm curious if anyone knows how they do it (yes, including the Windows-only solutions).

@Caronte3D: Your solution is very cool (for Windows). If there won't pop up another one, I'll use this one! Thanks!

[idle]

Here this will work flicker free, it gets a window rect before the WMSIZE event.

Code: Select all

Procedure WinManCallBack(hwnd,msg,wparam,lparam);
  Protected *rc.rect,w,h  
  Select msg 
    Case #WM_SIZING  
      *rc = lparam 
      w = *rc\right - *rc\left 
      h = *rc\bottom - *rc\top 
      Debug Str(w) + " " + Str(h)  
      Select wparam 
          Case 1 ;LEFT 
            *rc\bottom = *rc\top + w            
          Case 2 ;RIGHT 
            *rc\bottom = *rc\top + w 
          Case 3 ;TOP 
            *rc\right = *rc\left + h 
          Case 6 ;BOTTOM 
            *rc\right = *rc\left + h
       EndSelect       
       If w > h 
         *rc\bottom = *rc\top + w   
       ElseIf h > w  
         *rc\right = *rc\left + h  
       EndIf 
       
  EndSelect 
  
  ProcedureReturn #PB_ProcessPureBasicEvents
     
EndProcedure

OpenWindow(0,0,0,400,400,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
SetWindowCallback(@WinManCallBack())

Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

[jacdelad]

@idle: Not really. Your code doesn't run (though the error is very obvious) and I can resize the window to every aspect ratio I like?!

[idle]

look again it stops the flickering as it intercepts the call before the windows is resized. I was looking at how to handle the corners think its right now