Splitter Bars (Minimal, Sub-Classed)

Category: Application Features

Date: 03-28-2012

Return to Index


 
'This snippets shows how to implement splitterbars with a Scintilla control.
'It uses pretty much the same code as the other splitterbar examples, but
'it also has to sub-class the scintilla control in order to get access to the
'GetCursorPos API when the mouse is over the Scintilla control.
 
'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 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   'set flag saying splitter is in work
               If iReturn = %IDC_LabelH Then SplitHInWork = 1   'set flag saying splitter is in work
            Case %WM_MouseMove
               'Repositions splitter bars to match mouse position (if position has changed)
               If SplitVInWork Then If MoveBarUpDown Then ResizeWindow    'if bar
               If SplitHInWork Then If MoveBarLeftRight Then ResizeWindow
            Case %WM_LButtonUp
               SplitHInWork = 0 : SplitVInWork = 0    'sets flags to say splitter action has ended
         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
 
   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 ResizeWindow    'if bar
               If SplitHInWork Then If MoveBarLeftRight Then ResizeWindow
            Case %WM_LButtonUp
               SplitHInWork = 0 : SplitVInWork = 0    'sets flags to say splitter action has ended
         End Select
   End Select
   Function = CallWindowProc(OldProc&, hWnd, MsgwParamlParam)
End Function
 
'gbs_00690
'Date: 03-10-2012


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