Maintain Aspect Ratio of Client II

Category: Aspect Ratio

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
%IDC_Graphic = 500 : %IDC_Toolbar = 501 : %IDC_Open = 502 : %IDC_Go = 503 : %IDC_Stop = 504
Global hDlg,hMenu,hMenuFile As Dword, toolbarH, menuH, borderH, captionH As Long, AspectRatio As Single
 
Function PBMain() As Long
   Local w As Long
   borderH  = Metrics(Frame.Resize.Y)
   AspectRatio = 1.0   'desired aspect ratio of graphic control
   menuH = Metrics(MenuBar)
   captionH = Metrics(Caption)
   Dialog New Pixels, 0, "Test Code",300,300,300,(300/AspectRatio)+menuH, %WS_OverlappedWindow To hDlg
   CreateAppMenu
   CreateToolbar
   Control Get Size hDlg, %IDC_Toolbar To w,toolbarH
   Control Add Graphic, hDlg, %IDC_Graphic, "", 0,toolbarH,100,100  'sized in WM_Size
   Graphic Attach hDlg, %IDC_Graphic
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local w,h As Long, prc As Rect Ptr
   Select Case Cb.Msg
      Case %WM_Size
         Dialog Get Client hDlg To w,h
         Control Set Size hDlg, %IDC_Graphic, w, h-toolbarH
         Graphic Render "cowgirl.bmp", (0,0)-(w-1,h-1-toolbarH)
         Dialog Set Text hDlg, Str$(w) + Str$(h) + Format$(w/h," 0.0 ")
      Case %WM_Sizing
         prc = Cb.LParam : w = (@prc.nRight - @prc.nLeft) : h = (@prc.nBottom - @prc.nTop)
         Select Case Cb.WParam
            Case %WMSZ_TopLeft :
               @prc.nTop = @prc.nBottom - (w / AspectRatio)- captionH - menuH
            Case %WMSZ_Top, %WMSZ_Bottom, %WMSZ_TopRight
               @prc.nRight = @prc.nLeft + ((h-captionH-menuH) * AspectRatio)
            Case %WMSZ_Left, %WMSZ_Right, %WMSZ_BottomLeft, %WMSZ_BottomRight
               @prc.nBottom = @prc.nTop + (w / AspectRatio) + captionH + menuH
         End Select
         Function = %True
   End Select
End Function
 
Sub CreateAppMenu
   Menu New Bar To hMenu
   Menu Attach hMenu, hDlg
   Menu New PopUp To hMenuFile
   Menu Add PopUp, hMenu, "&File", hMenuFile, %MF_Enabled
   Menu Add String, hMenuFile, "&Open", %IDC_Open, %MF_Enabled
   Menu Attach hMenu, hDlg
End Sub
 
Sub CreateToolbar
   Control Add Toolbar, hDlg, %IDC_Toolbar,"", 0,0,0,0
   Toolbar Add Button hDlg, %IDC_Toolbar, 0, %IDC_Go, %TbStyle_Button, "Go"
   Toolbar Add Button hDlg, %IDC_Toolbar, 0, %IDC_Stop, %TbStyle_Button, "Stop"
End Sub
 
'gbs_00746
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm