System Metrics II

Category: System Information

Date: 03-28-2012

Return to Index


 
'Compiler Comments:
'This code compiles only in PBWin10. It uses a PBWin10 Metrics function which
'is not available in PBWin9.  However, the GetSystemMetrics() API can be used
'to provide similar information.
 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg,hMenu,hMenuFile As Dword, captionH,menuH,borderH As Long
%IDC_Label = 501 : %IDC_Go = 502 : %IDC_Stop = 503 : %IDC_Open = 504
 
Function PBMain() As Long
   Dialog New Pixels, 0, "System Metrics",300,300,300,350, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, %IDC_Label,"",0,0,300,350, %WS_Border
   CreateAppMenu
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Local cw,ch,w,h,tw,th,borderX,borderY,i,j,r,s,t As Long, temp$, wRC,cRC As Rect, pt As Point
         Local borderLeft, borderRight, borderTop, borderBottom As Long
 
         'Window/client/caption/menu bar
         Dialog Get Size hDlg To w,h
         Dialog Get Client hDlg To cw,ch
         'menu bar is not part of client (ch does not have Menu height in it
         'caption and menu bar height return a value, even if the caption/menu do not exist!
         'assume borderH = borderW
         temp$ = Str$(h) + "  Total window height" + $CrLf
         temp$ = temp$ + $CrLf + Str$(ch) + "  Client Height"
         temp$ = temp$ + $CrLf + Str$(h-ch) + "  Caption + Menu + 2*Border Height" + $CrLf
         captionH = Metrics(Caption) : temp$ = temp$ + $CrLf + Str$(captionH) + "  Normal Caption"
         menuH    = Metrics(MenuBar) : temp$ = temp$ + $CrLf + Str$(menuH) + "  Menu Bar Height" + $crlf
 
         'Borders - Method 1 - assumes left/right/bottom/border sizes are all the same
         temp$ = temp$ + $CrLf + "Border - Method 1: Assume equal border sizes"
         borderH  = (h - ch - captionH - menuH)/2 : temp$ = temp$ + $CrLf + Str$(borderH) + "  Border Height" + $CrLf
 
         'Borders - Method 2 - calculates each border individually
         temp$ = temp$ + $CrLf + "Border - Method 2: Calculate each border individually"
         GetWindowRect( Cb.Hndl, wRC )   'dialog
         GetClientRect( Cb.Hndl, cRC )   'client area
         pt.x = cRC.nLeft : pt.y = cRC.nTop
         ClientToScreen(hDlg,pt)
         cRC.nRight = pt.x + cw
         cRC.nBottom = pt.y + ch
         borderTop = pt.y - wRC.nTop - menuH - captionH : temp$ = temp$ + $CrLf + Str$(borderTop) + "  Border Top"
         borderBottom = wRC.nBottom - cRC.nBottom       : temp$ = temp$ + $CrLf + Str$(borderBottom) + "  Border Bottom"
         borderLeft = pt.x - wRC.nLeft                  : temp$ = temp$ + $CrLf + Str$(borderLeft) + "  Border Left"
         borderRight = wRC.nRight - cRC.nRight          : temp$ = temp$ + $CrLf + Str$(borderRight) + "  Border Right" + $CrLf
 
         'Borders - Method 3 (simplest method but must know which type of border is used)
         temp$ = temp$ + $CrLf + "Border - Method 3: Use API but must know border type"
         temp$ = temp$ + $CrLf + Str$(Metrics(Frame.Resize.Y)) + "  Frame Resize Y"  'width of a window border in pixels
         temp$ = temp$ + $CrLf + Str$(Metrics(Frame.Fixed.Y)) + "  Frame Fixed Y"    'thickness of frame around perimeter of a window that has a caption but is not resizable
         temp$ = temp$ + $CrLf + Str$(Metrics(Edge.Y)) + "  3D Border"
         temp$ = temp$ + $CrLf + Str$(Metrics(Border.Y)) + "  Y Border" + $CrLf      'thickness of sizing border around perimeter of a window that can be resized
 
         Control Set Size hDlg, %IDC_Label, 300,350-menuH
         Control Set Text hDlg, %IDC_Label, temp$
   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
 
'gbs_00580
'Date: 03-10-2012


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