Keep a window at a certain aspect ratio

[BarryG]

@Idle, your version also suffers the problem of the whole window moving away from its X/Y position when sizing from other edges - it's like it's being dragged by the title bar. Please test resizing on all four window sides, and not from just the bottom-right corner.

[jacdelad]

You're right, it doesn't flicker, but (and I may be blind not to see the solution) how do I write the desired height/width back so it keeps the aspect ratio?
Edit: Ah, I just tried the diagonal resizing. Horizontal/vertical works fine.

[idle]

Aspect ratio stays the same you're given the memory pointer to the rect so all you have to do is change it but
it's complicated as special attention needs to be applied for top and left resize.

see here
https://learn.microsoft.com/en-us/windo ... /wm-sizing

[idle]

This seems to be ok now with the corners

Code: Select all

EnableExplicit 

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 
      Select wparam 
        Case 1                       ;left  
          *rc\bottom = *rc\top + w            
        Case 2                       ;right  
          *rc\bottom = *rc\top + w 
        Case 3,4,7                   ;top / top Left / bottom left 
          *rc\left = *rc\right - h 
        Case 5,6,8                   ;top right / bottom / bottom right  
          *rc\right = *rc\left + h
      EndSelect       
      
  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]

Ah yes, this is great! Thanks!!!
There are still some minor flaws within it: The rect includes the title bar size and of course I don't only want rectangular windows). I'm on it.

[idle]

Ah yes, this is great! Thanks!!!
There are still some minor flaws within it: The rect includes the title bar size and of course I don't only want rectangular windows). I'm on it.

just set the callback with the window number
I'm sure you can work out the title bar thing

Code: Select all

SetWindowCallback(@WinManCallBack(),0)

[RASHAD]

It maybe Cross Platform too
Full control with Width & Height
Using Mouse Wheel
# 1:

Code: Select all

OpenWindow(0,0,0,400,400,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
TH = WindowY(0,#PB_Window_InnerCoordinate)-WindowY(0,#PB_Window_FrameCoordinate)
ResizeWindow(0,#PB_Ignore,#PB_Ignore,400,400-TH)
CanvasGadget(0,0,0,400,400-th,#PB_Canvas_Keyboard |#PB_Canvas_Container)
  TextGadget(10,10,10,100,24,"Width = 400")
CloseGadgetList()
Repeat
  Select WaitWindowEvent()
  Case #PB_Event_CloseWindow
    Quit = 1
    
  Case #PB_Event_Gadget
    Select EventGadget()
      Case 0
        Select EventType()
          Case #PB_EventType_MouseWheel
            value = GetGadgetAttribute(0,#PB_Canvas_WheelDelta )
            If value > 0
              w = WindowWidth(0)+5
              h = w-TH
              ResizeWindow(0,#PB_Ignore,#PB_Ignore ,w,h)
              ResizeGadget(0,0,0,w,h)
              SetGadgetText(10,"Width = "+Str(w))
            Else
              w = WindowWidth(0)-5
              h = w-TH
              ResizeWindow(0,#PB_Ignore,#PB_Ignore ,w,h)
              ResizeGadget(0,0,0,w,h)
              SetGadgetText(10,"Width = "+Str(w))
            EndIf
            If w > 1080
              w = 1920
            ElseIf w < 300
              w=300
            EndIf         
        EndSelect
    EndSelect
  EndSelect 
Until Quit = 1

# 2:
It maybe Cross Platform too
Resize take effect after release Mouse Capture

Code: Select all

Procedure SizeCB()
  HideWindow(0,1)
EndProcedure

Procedure MoveCB()
If OSVersion() >= #PB_OS_Windows_10
  ResizeWindow(1,WindowX(0),WindowY(0)-3, WindowWidth(0),WindowWidth(0))
Else
  ResizeWindow(1,WindowX(0),WindowY(0), WindowWidth(0),WindowWidth(0))
EndIf
EndProcedure

OpenWindow(1,0,0,400,400,"",#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_ScreenCentered &~ #PB_Window_TitleBar)
OpenWindow(0,0,0,400,400,"Main window",#PB_Window_SystemMenu |#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible,WindowID(1))
StickyWindow(1,1)

BindEvent(#PB_Event_MoveWindow ,@MoveCB(),0)
BindEvent(#PB_Event_SizeWindow ,@SizeCB(),1)

HideWindow(0,0)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1      
      
    Case #PB_Event_MaximizeWindow
      flag = 1
     
    Case #PB_Event_SizeWindow
      If flag = 0
        ResizeWindow(0,WindowX(1),WindowY(1), WindowWidth(1),WindowHeight(1)-22)
      EndIf
      If flag = 1
        flag = 0
      EndIf
      HideWindow(0,0)       
       
  EndSelect
Until Quit = 1

[AZJIO]

RASHAD
We need behavior, if we increase one of the sides, then we want to increase the window. Sometimes the window size reverts to its original state, instead of increasing the window. If we use corner points to resize the window, then here we can also make an assessment of which sides are resized in percentage terms. If one side increased by 10%, and the other side decreased by 5%, then we take 10% as the criterion, since this is a larger indicator. Then we will have the behavior of the window as the user expected. If 10% increase and 10% decrease, then do nothing +-2%.
You also need to change the window from the center in different directions at the same time. We pull to the right, and the left side also moves to the left.
You can add AddWindowTimer() to recalculate the window after the mouse is released.

[RASHAD]

Why don't you do that to see how good you are Mr.X
No more Bla ..Bla

[jacdelad]

Ah yes, this is great! Thanks!!!
There are still some minor flaws within it: The rect includes the title bar size and of course I don't only want rectangular windows). I'm on it.

just set the callback with the window number
I'm sure you can work out the title bar thing

Code: Select all

SetWindowCallback(@WinManCallBack(),0)

I have 8 hours of nothing do to ahead, I'm on it.

[idle]

Ah yes, this is great! Thanks!!!
There are still some minor flaws within it: The rect includes the title bar size and of course I don't only want rectangular windows). I'm on it.

just set the callback with the window number
I'm sure you can work out the title bar thing

Code: Select all

SetWindowCallback(@WinManCallBack(),0)

I have 8 hours of nothing do to ahead, I'm on it.

for the title bar height you can use this in the call back

Code: Select all

Procedure WinManCallBack(hwnd,msg,wparam,lparam);
  Protected *rc.rect,*rc1.rect,rcc.rect,w,h 
  Static tbsize  
  
  If Not tbsize 
    tbsize = GetSystemMetrics_(#SM_CYMIN)
  EndIf 
    
  Select msg 
    Case #WM_SIZING  
      *rc = lparam 
      w = *rc\right - *rc\left 
      h = *rc\bottom - *rc\top 
      Select wparam 
        Case 1                       ;left  
          *rc\bottom = *rc\top + w           
        Case 2                       ;right  
          *rc\bottom = *rc\top + w 
        Case 3,4,7                   ;top / top Left / bottom left 
          *rc\left = *rc\right - (h-tbsize) 
        Case 5,6,8                   ;top right / bottom / bottom right  
          *rc\right = *rc\left + (h-tbsize)
      EndSelect       
      Debug Str(w) + "," + Str(h) 
  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]

Thanks idle, but I think this can cause problem, because GetWindowRect_() has different behavious since Windows Vista (it includes the shadow) and may change again.

However, I'm done. This is what I created from your template:

Code: Select all

;EnableExplicit 
Structure _AR
  Window.i
  Ratio.f
  dx.l
  dy.l
EndStructure
Global NewMap AspectRatioMap._AR()
Procedure WinManCallBack(hwnd,msg,wparam,lparam);
  Protected *rc.rect,w,h  
  Select msg 
    Case #WM_SIZING  
      If FindMapElement(AspectRatioMap(),Str(hwnd))
        *rc = lparam 
        w = *rc\right - *rc\left - AspectRatioMap(Str(hwnd))\dx
        h = *rc\bottom - *rc\top - AspectRatioMap(Str(hwnd))\dy
        Select wparam 
          Case 1,2;Left,right
            *rc\bottom = *rc\top + w/AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dy
          Case 3,6;Top,Bottom
            *rc\right = *rc\left + h*AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dx
          Case 4;Top Left
            If w/AspectRatioMap(Str(hwnd))\Ratio<h
              *rc\top = *rc\bottom - w/AspectRatioMap(Str(hwnd))\Ratio - AspectRatioMap(Str(hwnd))\dy
            Else
              *rc\left = *rc\right - h*AspectRatioMap(Str(hwnd))\Ratio - AspectRatioMap(Str(hwnd))\dx
            EndIf
          Case 7;Bottom Left 
            If w/AspectRatioMap(Str(hwnd))\Ratio<h
              *rc\bottom = *rc\top + w/AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dy
            Else
              *rc\left = *rc\right - h*AspectRatioMap(Str(hwnd))\Ratio - AspectRatioMap(Str(hwnd))\dx
            EndIf
          Case 5;Top Right
            If w/AspectRatioMap(Str(hwnd))\Ratio<h
              *rc\top = *rc\bottom - w/AspectRatioMap(Str(hwnd))\Ratio - AspectRatioMap(Str(hwnd))\dy
            Else
              *rc\right = *rc\left + h*AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dx
            EndIf
          Case 8;Bottom Right  
            If w/AspectRatioMap(Str(hwnd))\Ratio<h
              *rc\bottom = *rc\top + w/AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dy
            Else
              *rc\right = *rc\left + h*AspectRatioMap(Str(hwnd))\Ratio + AspectRatioMap(Str(hwnd))\dx
            EndIf
        EndSelect       
      EndIf
  EndSelect 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure SetWindowAspectRatio(Window.i,Enable=#True)
  Protected rect.rect,WindowID.i=WindowID(Window)
  If Enable
    GetWindowRect_(WindowID(Window),rect)
    AspectRatioMap(Str(WindowID))\Window=Window
    AspectRatioMap(Str(WindowID))\Ratio=WindowWidth(Window,#PB_Window_InnerCoordinate)/WindowHeight(Window,#PB_Window_InnerCoordinate)
    AspectRatioMap(Str(WindowID))\dy=rect\bottom-rect\top-WindowHeight(Window,#PB_Window_InnerCoordinate)
    AspectRatioMap(Str(WindowID))\dx=rect\right-rect\left-WindowWidth(Window,#PB_Window_InnerCoordinate)
    SetWindowCallback(@WinManCallBack(),Window)
  Else
    If FindMapElement(AspectRatioMap(),Str(WindowID))
      SetWindowCallback(0,AspectRatioMap(Str(WindowID))\Window)
      DeleteMapElement(AspectRatioMap(),Str(WindowID))
    EndIf
  EndIf
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  OpenWindow(0,0,0,550,175,"Test",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
  SetWindowAspectRatio(0,1)
  
  Repeat
  Until WaitWindowEvent()=#PB_Event_CloseWindow
CompilerEndIf

...and it's working exactly as I wanted to have it!

[idle]

Nice that seems to work well!

[jacdelad]

Thanks and yeah, it's great. I just need to add some code to make it work with WindowBounds(). This doesn't work yet.

[idle]

Thanks and yeah, it's great. I just need to add some code to make it work with WindowBounds(). This doesn't work yet.

I tried that too and wasn't sure what was going on with the windowbounds function but you can do it in the callback adding the min and max parameters to your structure and then do the fiddling in the cases if result > min or result > max