Splitter Bars II (Minimal, Sub-Classed)

Category: Application Features

Date: 03-28-2012

Return to Index


 
'This snippets shows how to implement splitterbars with a Scintilla control.
'In addition to sub-classing the Scintilla control to get access to the GetCursorPos
'API, this version doesn't resize the controls until the splitter bar is released.
 
'Primary Code:
'Due to the length of this example, the primary code is only included in
'the example below.
 
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include "Win32api.inc"
 
%IDC_Left = 500 : %IDC_Right = 501 : %IDC_Bottom = 502 : %IDC_LabelH = 532 : %IDC_LabelV = 533
 
' Global Variables: handles =============================================================
Global hDlg, hTree, hList, hLib, hMenu As DWord
Global hLeft, hRight, hBottom, hLabelV, hLabelH As DWord
Global SplitVInWork, SplitHInWork As Long
Global XSplit, YSplit As Single
Global HBarLeft, VBarTop, OldProc As Long
 
' Main Function =======================================================================
 
Function PBMain()
   Dialog New Pixels, 0, "Splitter Text",300,300,410,340, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
 
   'add the controls + splitter bars (labels)
   Control Add TextBox, hDlg, %IDC_Left, "TopLeft",  20, 20, 160, 80
   Control Add TextBox, hDlg, %IDC_Bottom, "Bottom",  20, 200, 370, 90
 
   hLib = LoadLibrary("SCILEXER.DLL")
   Control Add "Scintilla", hDlg, %IDC_Right, "", 20, 80, 160, 80, %WS_Child Or %WS_Visible Or %WS_Border
   Control Handle hDlg, %IDC_Right To hRight   'get handle to Scintilla window
 
   Control Add Label, hDlg, %IDC_LabelH, "",  200, 20, 6, 125, %SS_Notify , %WS_Ex_ClientEdge  ' up/down - does horizontal split
   Control Add Label, hDlg, %IDC_LabelV, "",  0,170, 410, 6, %SS_Notify , %WS_Ex_ClientEdge   ' left/right - does vertical split
 
   HBarLeft = 150 : VBarTop = 150
 
   Dialog Show Modal hDlg Call DlgProc()
End Function
 
   'monitor mouse movement=================================
 
CallBack Function DlgProc() As Long
   Local iReturn As Long, x As Long, y As Long, w As Long, h As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         OldProc& = SetWindowLong(hRight, %GWL_WndProc, CodePTR(NewProc))  'subclass
      Case %WM_Size
         ResizeWindow
      Case %WM_SetCursor
         iReturn = GetDlgCtrlID (CB.wParam)  'determine which over which label control mouse was moved
         If iReturn = %IDC_LabelH Then MousePTR 9 : Function = 1    '9 = horizontal cursor
         If iReturn = %IDC_LabelV Then MousePTR 7 : Function = 1    '7 = vertical cursor
         Select Case Hi(Word, CB.lParam)
            Case %WM_LButtonDown
               If iReturn = %IDC_LabelV Then SplitVInWork = 1 : SetSplitterBarColors : RedrawControls
               If iReturn = %IDC_LabelH Then SplitHInWork = 1 : SetSplitterBarColors : RedrawControls
            Case %WM_MouseMove
               'Repositions splitter bars to match mouse position (if position has changed)
               If SplitVInWork Then If MoveBarUpDown Then ResizeSplitterBars : RedrawControls
               If SplitHInWork Then If MoveBarLeftRight Then ResizeSplitterBars : RedrawControls
            Case %WM_LButtonUp
               If SplitHInWork Or SplitVInWork Then
                  SplitHInWork = 0 : SplitVInWork = 0    'sets flags to say splitter action has ended
                  SetSplitterBarColors
                  ResizeWindow
               End If
         End Select
      Case %WM_Destroy
         SetWindowLong hRight, %GWL_WNDPROC, OldProc&   'un-subclass
   End Select
End Function
 
Function MoveBarUpDown As Long
   'returns true if mouse moved vertically while button was down over the horizontal bar
   Local pt As Point, h As Long, w As Long
   Static oldY As Long
   Dialog Get Client hDlg To w,h
   GetCursorPos pt               'pt has xy screen coordinates
   ScreenToClient hDlg, pt       'pt now has client coordinates
   VBarTop = h - (Pt.y-3)
   If pt.y <> oldY Then Function = %True : oldY = pt.y
   Dialog Set Text hDlg, Str$(pt.y)
End Function
 
Function MoveBarLeftRight As Long
   'returns true if mouse moved horizontaolly while button was down over the vertical bar
   Local pt As Point, h As Long, w As Long
   Static oldX As Long
   Dialog Get Client hDlg To w,h
   GetCursorPos pt               'pt has xy screen coordinates
   ScreenToClient hDlg, pt       'pt now has client coordinates
   HBarLeft = pt.x-3
   If pt.x <> oldX Then Function = %True : oldX = pt.x
   Dialog Set Text hDlg, Str$(pt.x)
End Function
 
Sub ResizeWindow
   Local vx As Long, vy As Long, hx As Long, hy As Long
   Local h As Long, w As Long, HLeft As Long, VTop As Long
   Dialog Get Client hDlg To w,h
 
   'Resize Splitter Bars
   VTop = h - VBarTop      'VTop will be position of horizontal bar
   HLeft = HBarLeft        'HLeft will be position of vertical bar
   Control Set Loc hDlg,  %IDC_LabelV, 5, VTop
   Control Set Size hDlg, %IDC_LabelH, 6, h - 15
   Control Set Loc hDlg,  %IDC_LabelH, HLeft, 10
   Control Set Size hDlg, %IDC_LabelV, HLeft-10, 6
 
   'Resize  controls
   Control Set Loc  hDlg, %IDC_Left, 5, 10
   Control Set Size hDlg, %IDC_Left, HLeft - 10, VTop - 20
 
   Control Set Loc  hDlg, %IDC_Right, HLeft + 10, 10
   Control Set Size hDlg, %IDC_Right, w - HLeft - 20, h - 20
 
   Control Set Loc  hDlg, %IDC_Bottom, 5, VTop + 15
   Control Set Size hDlg, %IDC_Bottom, HLeft - 10, h - VTop - 25
 
   RedrawControls
   '   Dialog Redraw hDlg
 
End Sub
 
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case Msg
      Case %WM_SetCursor
         Select Case Hi(Word, lParam)
            Case %WM_MouseMove
               'Repositions splitter bars to match mouse position (if position has changed)
               If SplitVInWork Then If MoveBarUpDown Then ResizeSplitterbars : RedrawControls
               If SplitHInWork Then If MoveBarLeftRight Then ResizeSplitterbars : RedrawControls
            Case %WM_LButtonUp
               If SplitHInWork Or SplitVInWork Then
                  SplitHInWork = 0 : SplitVInWork = 0    'sets flags to say splitter action has ended
                  SetSplitterBarColors
                  ResizeWindow
               End If
         End Select
   End Select
   Function = CallWindowProc(OldProc&, hWnd, MsgwParamlParam)
End Function
 
Sub SetSplitterBarColors
   If SplitVInWork Then
      Control Set Color hDlg, %IDC_LabelV, %Black, %Gray
   Else
      Control Set Color hDlg, %IDC_LabelV, %Black, %Red
   End If
   If SplitHInWork Then
      Control Set Color hDlg, %IDC_LabelH, %Black, %Gray
   Else
      Control Set Color hDlg, %IDC_LabelH, %Black, %Blue
   End If
End Sub
 
Sub ResizeSplitterBars
   Local h,w,M, T, VTop, HLeft, Flag As Long
   Local yStatus As Long, yTool As Long
 
   Dialog Get Client hDlg To w,h
   M = 5  'margin around controls
   T = 6  'splitter thickness (smallest dimension)
 
   'get the splitter bar positions - top of vertical splitter (VTop) and
   'left of horizontal splitter (HLeft).  These will be used in positioning
   'controls on the dialog.  Result depends on whether fixed or percentage
   'positioning is selected by the user.
   VTop = h - VBarTop
   HLeft = HBarLeft
 
   If SplitHInWork Then
      'H splitter bar loc/size
      Control Set Size hDlg, %IDC_LabelH, T, h - yTool - yStatus - 2*M
      Control Set Loc hDlg, %IDC_LabelH, HLeft, yTool + 5
      '         Control Set Size hDlg, %IDC_LabelH, T, h - yTool - yStatus - 2*M
   End If
 
   If SplitVInWork Then
      'V splitter bar loc/size
      Control Set Size hDlg, %IDC_LabelV, HLeft - M, T
      Control Set Loc hDlg, %IDC_LabelV, M, VTop
      '         Control Set Size hDlg, %IDC_LabelV, HLeft - M, T
   End If
 
   RedrawControls
 
End Sub
 
Sub RedrawControls
   '   Dialog ReDraw hDlg
   Control Redraw hDlg, %IDC_LabelV
   Control Redraw hDlg, %IDC_LabelH
   '   Control Redraw hDlg, %IDC_Right
   '   Control Redraw hDlg, %IDC_Left
   '   Control Redraw hDlg, %IDC_Bottom
End Sub
 
'gbs_00683
'Date: 03-10-2012


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