2013-08-20 12:34

'================= QMAXSPLITTER ==================
'
' This one's a doozy. A splitter control that
' emulates all of Delphi 6's splitter styles.
' It's based on a QPanel rather than QCanvas
' like the original for two reasons:

' 1. To get a handle
' 2. To improve drawing and aligning

' There are still some issues with this
' component, and they are:

' 1. Mouse trapping - if you move the mouse too
' fast, you leave the splitter behind. SetCapture
' doesn't seem to solve the problem, maybe sub-
' classing in the next version...

' 2. Setting MinSize to 0 sometimes causes
' resizing problems, I'm sure this is an oversight
' in the math, but I can live with it for now.

' 3. There are stil problems with CREATE, most
' notably the order in which ALIGNed components
' are created, as well as the order in which
' properties are assigned to sibling windows
' (Uncomment the "Color" in Rich3 and run. See
' what I mean? Now place the code for Rich3 AFTER
' the code for Split3. Problem solved!)
' Anyway, I had fun with it, I hope you will too.
' Psyclops ·)
' P.S. Sorry for the lack of comments, maybe in the
' next release...



     DIM Moving      AS LONG
     DIM SplitPos    AS POINTAPI
     DIM OldSplitPos AS POINTAPI
     DIM OldWhere    AS POINTAPI
     DIM Org         AS POINTAPI
     DIM Rect1           AS QRECT
     DEFWORD PatternPtn(7) = {&H00AA, &H0055, &H00AA, &H0055, &H00AA, &H0055, &H00AA, &H0055}
     DEFWORD SolidPtn(7) = {&H00FF, &H00FF, &H00FF, &H00FF, &H00FF, &H00FF, &H00FF, &H00FF}

     CONST PATINVERT = &H5A0049
     CONST rsNone    = 0
     CONST rsSolid   = 1
     CONST rsPattern = 2
     CONST rsUpdate  = 3
     $IFNDEF __WIN32API				   'windows 32 definitions
      TYPE POINTAPI
       X AS LONG
       Y AS LONG
      END TYPE

      DECLARE FUNCTION GetParent LIB "user32" ALIAS "GetParent" (BYVAL hwnd AS LONG) AS LONG
      DECLARE FUNCTION ChildWindowFromPoint LIB "user32" ALIAS "ChildWindowFromPoint"(BYVAL hWndParent AS LONG, BYVAL X AS LONG, BYVAL Y AS LONG) AS LONG
      DECLARE FUNCTION GetDC LIB "user32" ALIAS "GetDC" (BYVAL hwnd AS LONG) AS LONG
      DECLARE FUNCTION CreateBitmap LIB "gdi32" ALIAS "CreateBitmap"(BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL nPlanes AS LONG, BYVAL nBitCount AS LONG, BYVAL lpBits AS LONG) AS LONG
      DECLARE FUNCTION CreatePatternBrush LIB "gdi32" ALIAS "CreatePatternBrush"(BYVAL hBitmap AS LONG) AS LONG
      DECLARE FUNCTION SelectObject LIB "gdi32" ALIAS "SelectObject" (BYVAL hdc AS LONG, BYVAL hObject AS LONG) AS LONG
      DECLARE FUNCTION SetBrushOrgEx LIB "gdi32" ALIAS "SetBrushOrgEx"(BYVAL hdc AS LONG, BYVAL nXOrg AS LONG, BYVAL nYOrg AS LONG, lppt AS POINTAPI) AS LONG
      DECLARE FUNCTION ClientToScreen LIB "user32" ALIAS "ClientToScreen" (BYVAL hwnd AS LONG, lpPoint AS POINTAPI) AS LONG
      DECLARE FUNCTION PatBlt LIB "gdi32" ALIAS "PatBlt" (BYVAL hdc AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL dwRop AS LONG) AS LONG
      DECLARE FUNCTION DeleteObject LIB "gdi32" ALIAS "DeleteObject" (BYVAL hObject AS LONG) AS LONG
      DECLARE FUNCTION ReleaseDC LIB "user32" ALIAS "ReleaseDC" (BYVAL hwnd AS LONG, BYVAL hdc AS LONG) AS LONG
      DECLARE FUNCTION GetCursorPos LIB "user32" ALIAS "GetCursorPos"(lpPoint AS POINTAPI) AS LONG
      DECLARE FUNCTION GetClientRect LIB "user32" ALIAS "GetClientRect" (BYVAL hwnd AS LONG, lpRect AS QRECT) AS LONG
      DECLARE FUNCTION ScreenToClient LIB "user32" ALIAS "ScreenToClient"(BYVAL hwnd AS LONG, lpPoint AS POINTAPI) AS LONG
      DECLARE FUNCTION OffsetRect LIB "user32" ALIAS "OffsetRect" (lpRect AS QRECT, BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
      DECLARE FUNCTION MoveWindow LIB "user32" ALIAS "MoveWindow" (BYVAL hwnd AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL bRepaint AS LONG) AS LONG
     $ENDIF

     TYPE QMAXSPLITTER EXTENDS QPANEL

      WITH QMAXSPLITTER

       Owner      AS LONG
       Tmr        AS QTIMER
       MinSize    AS LONG
       Beveled    AS LONG PROPERTY SET Set_Beveled
       Mover      AS LONG
       MoverRect  AS QRECT
       Style      AS LONG PROPERTY SET Set_Style
       Pattern(7) AS WORD
       Canvas     AS QCANVAS

       PROPERTY SET Set_Beveled(Bevel AS LONG)
        .Beveled = Bevel
        .Canvas.Visible = Bevel
        .Canvas.Repaint
       END PROPERTY

       PROPERTY SET Set_Style(NewStyle AS LONG)
        DIM X AS LONG
        FOR X = 0 TO 7
         SELECT CASE NewStyle
         CASE 0, 3
          .Pattern(X) = 0
         CASE 1
          .Pattern(X) = SolidPtn(X)
         CASE 2
          .Pattern(X) = PatternPtn(X)
         END SELECT' CASE
        NEXT X
        .Style = NewStyle
       END PROPERTY

       EVENT Tmr.OnTimer
        IF .Visible THEN
         .Owner = GetParent(.Handle)
         .Tmr.Enabled = 0
         Org.X = .Left
         Org.Y = .Top
         IF .Align = 1 THEN
          DEC(Org.Y)
         ELSEIF .Align = 2 THEN
          INC(Org.Y, .Height)
         ELSEIF .Align = 3 THEN
          DEC(Org.X)
         ELSEIF .Align = 4 THEN
          INC(Org.X, .Width)
         END IF
         .Mover = ChildWindowFromPoint(.Owner, Org.X, Org.Y)
        END IF
       END EVENT

       EVENT Canvas.OnPaint
        SELECT CASE .Align
        CASE 1, 2
         .Canvas.Line(0, 0, .Width, 0, &H808080)
         .Canvas.Line(0, 1, .Width, 1, &HC8D0D8)
         .Canvas.Line(0, 2, .Width, 2, &HFFFFFF)
         .Canvas.Line(0, .Height-3, .Width, .Height-3, &H808080)
         .Canvas.Line(0, .Height-2, .Width, .Height-2, &HC8D0D8)
         .Canvas.Line(0, .Height-1, .Width, .Height-1, &HFFFFFF)
        CASE ELSE
         .Canvas.Line(0, 0, 0, .Height, &H808080)
         .Canvas.Line(1, 0, 1, .Height, &HC8D0D8)
         .Canvas.Line(2, 0, 2, .Height, &HFFFFFF)
         .Canvas.Line(.Width-3, 0, .Width-3, .Height, &H808080)
         .Canvas.Line(.Width-2, 0, .Width-2, .Height, &HC8D0D8)
         .Canvas.Line(.Width-1, 0, .Width-1, .Height, &HFFFFFF)
        END SELECT
       END EVENT

       SUB MoveChild(Where AS POINTAPI)
        ScreenToClient(.Mover, Where)
        GetClientRect(.Mover, This.MoverRect)
        OffsetRect(This.MoverRect, 1, 1)
        IF Where = OldWhere THEN EXIT SUB
        DIM Redraw AS LONG
        SELECT CASE .Align
        CASE 1
         MoveWindow(.Mover, 0, 0, 0, .MoverRect.Top+Where.Y-1, 0)
        CASE 2
         MoveWindow(.Mover, 0, Rect1.Bottom-(Where.Y+.Height), 0, .MoverRect.Bottom-(Where.Y+.Height)+1, 0)
        CASE 3
         MoveWindow(.Mover, 0, 0, .MoverRect.Left+Where.X+1, 0, 0)
        CASE 4
         MoveWindow(.Mover, Rect1.Right-(Where.X+.Width), 0, .MoverRect.Right-(Where.X+.Width)+1, 0, 0)
        END SELECT
        SendMessage(.Owner, &H5, 0, 0)
        DOEVENTS
        OldWhere = Where
       END SUB

       SUB DrawSplitter(Split AS POINTAPI)
        DIM hDC AS LONG
        DIM hBM AS LONG
        DIM hBr AS LONG
        DIM hOldBr AS LONG

        hDC = GetDC(0)
        hBm = CreateBitmap(8, 8, 1, 1, VARPTR(This.Pattern(0)))
        hBr = CreatePatternBrush(hBm)
        hOldBr = SelectObject(hDC, hBr)
        SetBrushOrgEx(hDC, Split.X, Split.Y, 0)

        Org.X = 0
        Org.Y = 0
        ClientToScreen(.Handle, Org)
        IF .Align = 1 OR .Align = 2 THEN
         PatBlt(hDC, Org.X, Split.Y, .Width, .Height, PATINVERT)
        ELSEIF .Align = 3 OR .Align = 4 THEN
         PatBlt(hDC, Split.X, Org.Y, .Width, .Height, PATINVERT)
        END IF
        SelectObject(hDC, hOldBr)
        DeleteObject(hBr)
        DeleteObject(hBm)
        ReleaseDC(0, hDC)
       END SUB

       EVENT Canvas.OnMouseDown(Button AS LONG, X AS LONG, Y AS LONG)
        IF Button = 0 THEN
         Moving = 1
         SplitPos.X = 0
         SplitPos.Y = 0
         ClientToScreen(.Handle, SplitPos)
         .DrawSplitter(SplitPos)
         OldSplitPos = SplitPos
        END IF
       END EVENT

       EVENT Canvas.OnMouseMove(X AS LONG, Y AS LONG)
        DIM OwnerOrg AS POINTAPI
        IF Moving = 1 THEN
         GetCursorPos(SplitPos)

         GetClientRect(.Owner, R)
         OwnerOrg.X = 0
         OwnerOrg.Y = 0
         ClientToScreen(.Owner, OwnerOrg)
         IF .Align = 1 OR .Align = 2 THEN
          IF SplitPos.Y < (OwnerOrg.Y+.MinSize) OR SplitPos.Y > (OwnerOrg.Y-.MinSize) + Rect1.Bottom _
           OR SplitPos.Y < (OwnerOrg.Y+(.Height/2)) THEN EXIT EVENT
          SplitPos.Y = SplitPos.Y-(.Height/2)
         ELSEIF .Align = 3 OR .Align = 4 THEN
          IF SplitPos.X < (OwnerOrg.X+.MinSize) OR SplitPos.X > (OwnerOrg.X-.MinSize) + Rect1.Right _
           OR SplitPos.X < (OwnerOrg.X+(.Width/2)) THEN EXIT EVENT
          SplitPos.X = SplitPos.X-(.Width/2)
         ELSE
          EXIT EVENT
         END IF

         .DrawSplitter(OldSplitPos)
         .DrawSplitter(SplitPos)
         OldSplitPos = SplitPos
         IF .Style = 3 THEN
          .MoveChild(SplitPos)
         END IF
        END IF
       END EVENT

       EVENT Canvas.OnMouseUp
        IF Moving = 1 THEN
         Moving = 0
         .DrawSplitter(OldSplitPos)
         .MoveChild(OldSplitPos)
        END IF
       END EVENT

       CONSTRUCTOR
        Set_Style(2)
        Set_Beveled(0)
        Width = 5
        Height = 5
        Align = 1
        Tmr.Interval = 1
        MinSize = 30
        Cursor = -15
        Canvas.PARENT = This
        Canvas.Align = 5
        BevelOuter = 0
        OnMouseDown = This.Canvas.InheritOnMouseDown
        OnMouseMove = This.Canvas.InheritOnMouseMove
        OnMouseUp = This.Canvas.InheritOnMouseUp
       END CONSTRUCTOR

      END WITH
     END TYPE

2013-08-20 12:34