ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Un séparateur sympathique (A friendly splitter)   



L'auteur

Robert Plagnard
France France
Membre Simple
# 0000000031
enregistré le 15/10/2004

http://www.ingelog.fr
PLAGNARD Robert
75015 PARIS
de la société IngéLog
Fiche personnelle


Note des membres
pas de note

Contributions > 02 - SCX : Formulaires

Un séparateur sympathique (A friendly splitter)
# 0000000411
ajouté le 28/02/2007 17:42:20 et modifié le 03/03/2007
consulté 4509 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0
VFP 5.0
VFP 3.0

Zoomer sur l'image
Description

Un séparateur est une sorte de ligne qui, dans une fenêtre, à l'aide de la souris, permet d'agrandir une zone au détriment d'une autre.

Dans certains environnements de développement que je ne citerais pas on peut en trouver de manière native, en VFP, jusqu'à présent, il faut se le fabriquer. Il n'est pas très difficile d'en fabriquer tant que l'on reste avec des objets pur VFP. Par contre, dès que l'on met des composants dérivés de la classe OleControl rien ne va plus. On constate qu'il n'est pas possible de faire apparaitre un objet VFP au dessus des objets Ole. Cela doit tenir à la manière dont VFP organise la méthode "paint" des forms.

Une bonne illustration du problème se voit dans l'implémentation du Browser et de l'explorateur de classes. L'équipe VFP ne s'est pas embettée, lors du déplacement de la ligne elle cache les objets Ole, pour les rendre de nouveau visible quand on relache le bouton de la souris. Ce n'est pas du meilleur effet.

Il y a pourtant une manière de faire assez simple qui évite de cacher les objets Ole. Il suffit d'utiliser la fonction DrawFocusRect() de l'API windows. Et, excusez du peu, c'est ce qu'utilise l'explorateur de fichier (si on n’a pas choisi d’afficher le contenu des fenêtres pendant le déplacement).

Je propose ici un exemple simple. Mais la notion d'Area est déjà prévue pour prendre en compte un arbre binaire de partage de l'écran. J'illustrerais cela dans un prochain article

Code source :
*/* Splitter.prg
*   Exemple of splitter
*   Run this prg
*   Robert Plagnard feb 25, 2007

#define SM_CYCAPTION            4
#define SM_CXSIZEFRAME         32
#define SM_CYSIZEFRAME         33
#define SM_CYMENU              15

#define VERTICAL_SPLIT    1
#define HORIZONTAL_SPLIT  2

   declare integer DrawFocusRect    in win32api integerstring @
   declare integer GetWindowDC      in win32api integer
   declare integer ReleaseDC        in win32api integerinteger
   declare integer GetSystemMetrics in win32api integer

   public gfrmSplitter

   gfrmSplitter = CreateObject'CFormSplitter' )
   gfrmSplitter.BackColor = Rgb(255,255,255)

   gfrmSplitter.AddObject('L','Shape' )      && Left
   with gfrmSplitter.L
      .BackColor = Rgb(200,250,150)
      .borderWidth = 1
      .borderColor = .BackColor
      .Visible = .T.
   endwith

   gfrmSplitter.AddObject('R','Shape' )      && Right
   with gfrmSplitter.R
      .BackColor = Rgb(150,200,250)
      .borderWidth = 0
      .borderColor = .BackColor
      .Visible = .T.
   endwith

   gfrmSplitter.Area.Split( VERTICAL_SPLIT  , m.gfrmSplitter.L  , m.gfrmSplitter.R  , 35, 7 )

   gfrmSplitter.Show


*/=========================================================================
define class CFormSplitter as Form
*/=========================================================================

   Area        = null
   lMouseDown    = .F.
   AllowOutput = .F.
   nbName      = 0
   ShowWindow  = 2   && as top level form

   FocusRect   = .F.
   nXOld       = 0
   nYOld       = 0
   nWidth      = 7
   nHeight     = 50
   nXClientOrigin     = 0
   nYClientOrigin     = 0

   */---------------------------------------------------------------------
   procedure Init( lMenu )
   */---------------------------------------------------------------------
      with this
         .nXClientOrigin = GetSystemMetrics( SM_CXSIZEFRAME )
         .nYClientOrigin = GetSystemMetrics( SM_CYSIZEFRAME ) + GetSystemMetrics( SM_CYCAPTION   )
         if m.lMenu then
            .nYClientOrigin = .nYClientOrigin + GetSystemMetrics( SM_CYMENU )
         endif
         .Area = CreateObject'CArea', ;
                                null,    ;   && Sans père (la racine)
                                this     )   && attaché à la form
         .Area._Draw()
      endwith
   endproc

   */---------------------------------------------------------------------
   procedure Destroy
   */---------------------------------------------------------------------
      local o, ref
      for each o in this.Objects
         ref = evaluate'this.' + o.Name )
         ref = null
      endfor
      this.Area.Release()

      clear events

   endproc

   */---------------------------------------------------------------------
   procedure Resize
   */---------------------------------------------------------------------
      if !IsNullthis.Area ) then
         this.Area._Resize()
         this.Area._Draw()
      endif
   endproc

   */---------------------------------------------------------------------
   function NewName() as String
   */---------------------------------------------------------------------
      this.nbName = this.nbName + 1
      return 'Name' + AlltrimStr(this.nbName ))
   endfunc

   */---------------------------------------------------------------------
   procedure DrawClientFocusRect( x, y, w, h )
   */---------------------------------------------------------------------
      local R      && Rectangle
      local hDC    && handle of device context
      with this
         .EndClientFocusRect( m.x, m.y, m.w, m.h )
         .nXOld = m.x + .nXClientOrigin
         .nYOld = m.y + .nYClientOrigin
         R = Rect( .nXOld, .nYOld, .nXOld + m.w, .nYOld + m.h )
         hDC = GetWindowDc( thisform.HWnd )
         DrawFocusRect( m.hDC, @R )
         ReleaseDC( thisform.HWnd, m.hDC )
         .FocusRect = .T.
      endwith
   endproc

   */---------------------------------------------------------------------
   procedure EndClientFocusRect( x, y, w, h )
   */---------------------------------------------------------------------
      local R      && Rectangle
      local hDC    && handle of device context
      with this
         if this.FocusRect
            R = Rect( .nXOld, .nYOld, .nXOld + m.w, .nYOld + m.h )
            hDC = GetWindowDc( thisform.HWnd )
            DrawFocusRect( m.hDC, @R )
            ReleaseDC( thisform.HWnd, m.hDC )
            .FocusRect = .F.
         endif
      endwith
   endproc

enddefine


*/=========================================================================
define class CArea as Custom
*/=========================================================================

   oForm            = null
   oGraphicalObject = null
   oParentArea      = null
   One              = null
   Two              = null

   nSplit   = 0
   nThick   = 0
   Splitter = null
   nCursor  = 0      && in oParentArea coordinates
   top      = 0
   left     = 0
   height   = 0
   width    = 0

   procedure Init( oParentArea, oGraphicalObject, nPart )
      with this
         .oGraphicalObject  = m.oGraphicalObject
         if IsNull( m.oParentArea ) then
            .top    = m.oGraphicalObject.top
            .left   = m.oGraphicalObject.left
            .Width  = m.oGraphicalObject.width
            .Height = m.oGraphicalObject.height
         else
            if m.oParentArea.nSplit = VERTICAL_SPLIT then
               .top    = m.oParentArea.top
               .Height = m.oParentArea.height
               if m.nPart = 1 then
                  .left   = m.oParentArea.Left
                  .Width  = m.oParentArea.nCursor
               else
                  .left   = m.oParentArea.Left + m.oParentArea.nCursor + m.oParentArea.nThick
                  .Width  = Max(0, m.oParentArea.Width - m.oParentArea.nCursor - m.oParentArea.nThick)
               endif
            else
               .left   = m.oParentArea.left
               .Width  = m.oParentArea.width
               if m.nPart = 1 then
                  .top    = m.oParentArea.Top
                  .Height = m.oParentArea.nCursor
               else
                  .top    = m.oParentArea.Top+ m.oParentArea.nCursor + m.oParentArea.nThick
                  .Height = Max(0,m.oParentArea.Height - m.oParentArea.nCursor - m.oParentArea.nThick)
               endif
            endif
         endif
         .oParentArea = m.oParentArea
         if IsNull( m.oParentArea ) then
            .oForm = m.oGraphicalObject
         else
            .oForm = m.oParentArea.oForm
         endif
      endwith
   endproc

   */-------------------------------------------------------------------------
   procedure Release()
   */-------------------------------------------------------------------------
      * Release area's objects using endorder traversal
      * --- visit childs if any
      if !IsNullthis.One ) then
         this.One.Release()
         this.Two.Release()
      endif
      * --- visit root
      this.Splitter          = null
      this.oForm             = null
      this.oGraphicalObject  = null
      this.oParentArea       = null
    endproc

   procedure destroy
      this.Release()
   endproc

   */-------------------------------------------------------------------------
   procedure _Draw
   */-------------------------------------------------------------------------
      * Set position and size of linked graphical object, if any, using preorder
      * traversal
      * --- visit root
      if !IsNullthis.oParentArea ) and !IsNullthis.oGraphicalObject )
         with this.oGraphicalObject
            .top    = this.top
            .left   = this.left
            .Width  = this.width
            .Height = this.Height
         endwith
      endif
      * --- visit childs
      if Type'this.One' ) = 'O'
         this.One._Draw()
         this.Two._Draw()
      endif
   endproc

   */-------------------------------------------------------------------------
   procedure _Resize
   */-------------------------------------------------------------------------
      * Set position and size of areas (non graphical objects), if any, using
      * preorder traversal
      if IsNullthis.oParentArea ) and Type'this.oGraphicalObject.Width' ) = 'N' then
         this.Width  = this.oGraphicalObject.Width
         this.Height = this.oGraphicalObject.Height
      endif
      with this
         do case
            case .nSplit = VERTICAL_SPLIT
               .ResizeV()
            case .nSplit = HORIZONTAL_SPLIT
               .ResizeH()
         endcase
         if Type'.One' ) = 'O'
            .One._Resize()
            .Two._Resize()
         endif
      endwith
   endproc

   */-------------------------------------------------------------------------
   procedure ResizeV()
   */-------------------------------------------------------------------------
      local lnB, lnC
      lnB = Minthis.nThick, this.width )
      lnC = Max(0,this.width-this.nCursor-m.lnB)
      with this.One
         .top    = this.top
         .height = this.Height
         .left   = this.left
         .width  = this.nCursor
      endwith
      with this.Two
         .top    = this.top
         .height = this.Height
         .left   = this.Left + this.nCursor + m.lnB
         .width  = m.lnC
      endwith
      with this.Splitter
         .top    = this.top-1
         .height = this.Height+2
         .left   = this.Left + this.nCursor
         .width  = m.lnB
      endwith
   endproc

   */-------------------------------------------------------------------------
   procedure ResizeH()
   */-------------------------------------------------------------------------
      local lnB, lnC
      lnB = Minthis.nThick, this.Height )
      lnC = Max(0,this.Height-this.nCursor-m.lnB)
      with this.One
         .top    = this.top
         .height = this.Top + this.nCursor
         .left   = this.left
         .width  = this.width
      endwith
      with this.Two
         .top    = this.Top + this.nCursor + m.lnB
         .height = m.lnC
         .left   = this.left
         .width  = this.width
      endwith
      with this.Splitter
         .top    = this.top + this.nCursor
         .height = m.lnB
         .left   = this.left - 1
         .width  = this.width + 2
      endwith
   endproc

   */-------------------------------------------------------------------------
   procedure Split( nMode, oLeftSon, oRightSon, nPc, nSplitThickness )
   */-------------------------------------------------------------------------
      *set step on
      local lcCursorName
      with this
         .nThick = m.nSplitThickness
         .nSplit = m.nMode
         lcCursorName = .oform.NewName()
         do case
            case m.nMode = VERTICAL_SPLIT
               .nCursor = Max(0, Intthis.width * m.nPc / 100 + 0.5 ) - m.nSPlitThickness)
               .One     = CreateObject'cArea'this, oLeftSon , 1 )
               .Two     = CreateObject'cArea'this, oRightSon, 2 )
               .oform.AddObject( m.lcCursorName, 'CVerticalSplitter'this )
               .Splitter = Evaluate'this.oform.' + m.lcCursorName )
               .ResizeV()
            case m.nMode = HORIZONTAL_SPLIT
               .nCursor = Max(0, Intthis.Height * m.nPc / 100 + 0.5 ) - m.nSPlitThickness)
               .One     = CreateObject'cArea'this, oLeftSon , 1 )
               .Two     = CreateObject'cArea'this, oRightSon, 2 )
               .oForm.AddObject( m.lcCursorName, 'CHorizontalSplitter'this )
               .Splitter = Evaluate'this.oform.' + m.lcCursorName )
               .ResizeH()
         endcase
         .Splitter.Visible = .T.
      endwith
   endproc

enddefine

*/=========================================================================
define class CSplitter as Shape && Abstract
*/=========================================================================

   Area          = null
   guarded       = .F.
   lMouseDown    = .F.
   Borderwidth   = 1
   Dx            = 0
   Dy            = 0

   procedure Init( oArea )
      with this
         .backcolor     = Rgb( 224,223,227)
         .specialEffect = 0 && 3D
         .Borderstyle   = 1 && 1=Solid 0=Transparent
         .colorSOurce   = 4
         .Style         = 0 && 0=Normal 3=Themed
         .Area = m.oArea
      endwith
   endproc

   procedure MouseDown( nButton, nShift, nXCoord, nYCoord )
      with this
         .Dx = m.nXCoord - .left
         .Dy = m.nYCoord - .top
         .Area.oForm.DrawClientFocusRect( .left, .top, .Width, .Height )
         .lMouseDown = .T.
      endwith
   endproc

   procedure MouseMove( nButton, nShift, nXCoord, nYCoord )
   endproc

   procedure MouseUp( nButton, nShift, nXCoord, nYCoord )
   endproc

enddefine

*/=========================================================================
define class CVerticalSplitter as CSplitter
*/=========================================================================

   procedure Init( oArea )
      DoDefault( m.oArea )
      this.MousePointer=9
   endproc

   procedure MouseMove( nButton, nShift, nXCoord, nYCoord )
      with this
         if not .guarded
            .guarded = .T.
            if .lMouseDown then
              .Area.oForm.DrawClientFocusRect( nXCoord-.Dx, this.topthis.Widththis.Height )
            endif
            .guarded = .F.
         endif
      endwith
   endproc

   procedure MouseUp( nButton, nShift, nXCoord, nYCoord )
      with this
         .lMouseDown = .F.
         with .Area
            .oForm.EndClientFocusRect(nXCoord-this.Dx,this.topthis.Widththis.Height )
            .nCursor = Max(0,nXCoord-this.Dx - .left)
            ._Resize()
            ._Draw()
         endwith
      endwith
   endproc

enddefine

*/=========================================================================
define class CHorizontalSplitter as CSplitter
*/=========================================================================

   procedure Init( oArea )
      DoDefault( m.oArea )
      this.MousePointer=7
   endproc

   procedure MouseMove( nButton, nShift, nXCoord, nYCoord )
      with this
         if not .guarded
            .guarded = .T.
            if .lMouseDown then
               .Area.oForm.DrawClientFocusRect( this.left, m.nYCoord-.Dy, this.Widththis.Height )
            endif
            .guarded = .F.
         endif
      endwith
   endproc

   procedure MouseUp( nButton, nShift, nXCoord, nYCoord )
      with this
         .lMouseDown = .F.
         with .Area
            .oForm.EndClientFocusRect( this.left, m.nYCoord-this.Dy, this.Widththis.Height )
            .nCursor = Max(0,m.nYCoord-this.Dy - .top)
            ._Resize()
            ._Draw()
         endwith
      endwith
   endproc

enddefine


*/--------------------------------------------------------------------------
function Rectlefttoprightbottom ) as String
*/--------------------------------------------------------------------------
   return BinToC(m.left,'4RS')+BinToC(m.top'4RS')+BinToC(m.right'4RS')+BinToC(m.bottom'4RS')
endfunc

Commentaires
le 29/11/2007, Hamdi a écrit :
Du grand art.

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2019.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3