L'auteur Robert Plagnard http://www.ingelog.fr Note des membres pas de note
Contributions > 02 - SCX : Formulaires
Un séparateur sympathique (A friendly splitter)
# 0000000411
28/02/2007 17:42:20 et modifié le 03/03/2007 9408 fois
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 4define SM_CXSIZEFRAME 32define SM_CYSIZEFRAME 33define SM_CYMENU 15define VERTICAL_SPLIT 1define HORIZONTAL_SPLIT 2declare integer DrawFocusRect in win32api integer , string @declare integer GetWindowDC in win32api integer declare integer ReleaseDC in win32api integer , integer declare integer GetSystemMetrics in win32api integer public gfrmSplitterCreateObject ( 'CFormSplitter' )BackColor = Rgb (255,255,255)AddObject ('L' ,'Shape' ) && Left with gfrmSplitter.LBackColor = Rgb (200,250,150)borderWidth = 1borderColor = .BackColor Visible = .T. endwith AddObject ('R' ,'Shape' ) && Right with gfrmSplitter.RBackColor = Rgb (150,200,250)borderWidth = 0borderColor = .BackColor Visible = .T. endwith Show */========================================================================= define class CFormSplitter as Form */========================================================================= null .F. AllowOutput = .F. ShowWindow = 2 && as top level form .F. */--------------------------------------------------------------------- procedure Init ( lMenu ) */--------------------------------------------------------------------- with this if m.lMenu then endif CreateObject ( 'CArea' , ;null , ; && Sans père (la racine) this ) && attaché à la form endwith endproc */--------------------------------------------------------------------- procedure Destroy */--------------------------------------------------------------------- local o, reffor each o in this .Objects evaluate ( 'this.' + o.Name )null endfor this .Area.Release ()clear events endproc */--------------------------------------------------------------------- procedure Resize */--------------------------------------------------------------------- if !IsNull ( this .Area ) then this .Area._Resize()this .Area._Draw()endif endproc */--------------------------------------------------------------------- function NewName() as String */--------------------------------------------------------------------- this .nbName = this .nbName + 1return 'Name' + Alltrim ( Str (this .nbName ))endfunc */--------------------------------------------------------------------- procedure DrawClientFocusRect( x, y, w, h ) */--------------------------------------------------------------------- local R && Rectangle local hDC && handle of device context with this Rect ( .nXOld, .nYOld, .nXOld + m.w, .nYOld + m.h )thisform .HWnd )thisform .HWnd , m.hDC ).T. endwith endproc */--------------------------------------------------------------------- procedure EndClientFocusRect( x, y, w, h ) */--------------------------------------------------------------------- local R && Rectangle local hDC && handle of device context with this if this .FocusRectRect ( .nXOld, .nYOld, .nXOld + m.w, .nYOld + m.h )thisform .HWnd )thisform .HWnd , m.hDC ).F. endif endwith endproc enddefine */========================================================================= define class CArea as Custom */========================================================================= null null null null null null && in oParentArea coordinates top = 0left = 0height = 0width = 0procedure Init ( oParentArea, oGraphicalObject, nPart )with this 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.nCursorelse left = m.oParentArea.Left + m.oParentArea.nCursor + m.oParentArea.nThickWidth = 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.nCursorelse top = m.oParentArea.Top + m.oParentArea.nCursor + m.oParentArea.nThickHeight = Max (0,m.oParentArea.Height - m.oParentArea.nCursor - m.oParentArea.nThick)endif endif endif if IsNull ( m.oParentArea ) then else endif endwith endproc */------------------------------------------------------------------------- procedure Release () */------------------------------------------------------------------------- * Release area's objects using endorder traversal * --- visit childs if any if !IsNull ( this .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 !IsNull ( this .oParentArea ) and !IsNull ( this .oGraphicalObject )with this .oGraphicalObjecttop = 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 IsNull ( this .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_SPLITcase .nSplit = HORIZONTAL_SPLITendcase if Type ( '.One' ) = 'O' endif endwith endproc */------------------------------------------------------------------------- procedure ResizeV() */------------------------------------------------------------------------- local lnB, lnCMin ( this .nThick, this .width )Max (0,this .width -this .nCursor-m.lnB)with this .Onetop = this .top height = this .Height left = this .left width = this .nCursorendwith with this .Twotop = this .top height = this .Height left = this .Left + this .nCursor + m.lnBwidth = m.lnCendwith with this .Splittertop = this .top -1height = this .Height +2left = this .Left + this .nCursorwidth = m.lnBendwith endproc */------------------------------------------------------------------------- procedure ResizeH() */------------------------------------------------------------------------- local lnB, lnCMin ( this .nThick, this .Height )Max (0,this .Height -this .nCursor-m.lnB)with this .Onetop = this .top height = this .Top + this .nCursorleft = this .left width = this .width endwith with this .Twotop = this .Top + this .nCursor + m.lnBheight = m.lnCleft = this .left width = this .width endwith with this .Splittertop = this .top + this .nCursorheight = m.lnBleft = this .left - 1width = this .width + 2endwith endproc */------------------------------------------------------------------------- procedure Split( nMode, oLeftSon, oRightSon, nPc, nSplitThickness ) */------------------------------------------------------------------------- *set step on local lcCursorNamewith this do case case m.nMode = VERTICAL_SPLITMax (0, Int ( this .width * m.nPc / 100 + 0.5 ) - m.nSPlitThickness)CreateObject ( 'cArea' , this , oLeftSon , 1 )CreateObject ( 'cArea' , this , oRightSon, 2 )AddObject ( m.lcCursorName, 'CVerticalSplitter' , this )Evaluate ( 'this.oform.' + m.lcCursorName )case m.nMode = HORIZONTAL_SPLITMax (0, Int ( this .Height * m.nPc / 100 + 0.5 ) - m.nSPlitThickness)CreateObject ( 'cArea' , this , oLeftSon , 1 )CreateObject ( 'cArea' , this , oRightSon, 2 )AddObject ( m.lcCursorName, 'CHorizontalSplitter' , this )Evaluate ( 'this.oform.' + m.lcCursorName )endcase Visible = .T. endwith endproc enddefine */========================================================================= define class CSplitter as Shape && Abstract */========================================================================= null .F. .F. Borderwidth = 1procedure Init ( oArea )with this backcolor = Rgb ( 224,223,227)specialEffect = 0 && 3D Borderstyle = 1 && 1=Solid 0=Transparent colorSOurce = 4Style = 0 && 0=Normal 3=Themed endwith endproc procedure MouseDown ( nButton, nShift, nXCoord, nYCoord )with this left top left , .top , .Width , .Height ).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 =9endproc procedure MouseMove ( nButton, nShift, nXCoord, nYCoord )with this if not .guarded.T. if .lMouseDown then this .top , this .Width , this .Height )endif .F. endif endwith endproc procedure MouseUp ( nButton, nShift, nXCoord, nYCoord )with this .F. with .Areathis .Dx,this .top , this .Width , this .Height )Max (0,nXCoord-this .Dx - .left )endwith endwith endproc enddefine */========================================================================= define class CHorizontalSplitter as CSplitter*/========================================================================= procedure Init ( oArea )DoDefault ( m.oArea )this .MousePointer =7endproc procedure MouseMove ( nButton, nShift, nXCoord, nYCoord )with this if not .guarded.T. if .lMouseDown then this .left , m.nYCoord-.Dy, this .Width , this .Height )endif .F. endif endwith endproc procedure MouseUp ( nButton, nShift, nXCoord, nYCoord )with this .F. with .Areathis .left , m.nYCoord-this .Dy, this .Width , this .Height )Max (0,m.nYCoord-this .Dy - .top )endwith endwith endproc enddefine */-------------------------------------------------------------------------- function Rect ( left , top , right , bottom ) as String */-------------------------------------------------------------------------- return BinToC (m.left ,'4RS' )+BinToC (m.top , '4RS' )+BinToC (m.right , '4RS' )+BinToC (m.bottom , '4RS' )endfunc Commentaires
Retour à la liste
France
Fiche personnelle
Note des membres
Du grand art.