Algo que hace rato me da vueltas en la cabeza era usar los THeaders nativos en los browses, y he logrado algo más o menos interesante.
Para poder llevar a cabo el proyecto hay que hacer modificaciones en las 2 clases involucradas, THeader y TSBrowse, para lo que use una técnica/patrón de programación que se llama variaciones protegidas y que trataré de resumir.
Modificar una clase de la que no somos autores ni controlamos y no tenemos los derechos de publicar el codigo fuente es una tarea dificil.
Además, al aparecer una nueva versión publicada por sus autores _ se perderían en la actualización, y volver a reimplantarlos en las nuevas versiones de las clases es una tarea engorrosa.
Aunque en Harbour disponemos de una buena implementacion de OOP no podemos usar la herencia directamente porque los comandos de FiveWin estan basados en un nombre de clase en particular.
La solución que encontré es dotar, al menos a las clases a alterar, de una capa protegida, donde se conserva el 100% del código original, y otra donde implementamos _.
Paso 1: Copiar las clases originales THeader.prg y TSBrwose.prg al directorio donde tenemos nuestro proyecto.
Editamos ambos prgs, añadiendo 1 línea con un solo #translate:
Code: Select all
.... THeader.prg ....
#translate CLASS THeader => CLASS __THeader // Añadir esta línea
CLASS THeader FROM TControl
DATA aPrompts, aSizes
.... más código
THeader2.prg
Code: Select all
#include "FiveWin.ch"
#include "Constant.ch"
#include "Header.ch"
#define COLOR_BTNFACE 15
#define WM_ERASEBKGND 20
#define GWL_STYLE -16
CLASS THeader FROM __THeader
METHOD Notify( nIdCtrl, nPtrNMHDR )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD Notify( nIdCtrl, nPtrNMHDR ) CLASS THeader
local nCode := GetNMHDRCode( nPtrNMHDR )
local nItem := GETNMHEAITEM( nPtrNMHDR )
do case
case ValType( ::bAction ) != "B"
case nCode > HDN_FIRST
case nCode == HDN_ITEMCLICK ; Eval( ::bAction, nItem, Self, HDN_ITEMCLICK )
case nCode == HDN_ENDTRACK ; Eval( ::bAction, nItem, Self, HDN_ENDTRACK )
otherwise ; Eval( ::bAction, nItem, Self, nCode )
endcase
return nil
TSBrowse.prg
Code: Select all
.. codigo de tsbrowse...
//----------------------------------------------------------------------------//
#translate CLASS TSBROWSE => CLASS __TSBROWSE // solo se añade esta línea!
CLASS TSBrowse FROM TControl
CLASSDATA lRegistered AS LOGICAL
... más código de tsbrowse
Y la nueva subclase donde implantamos el nuevo código
TSBrowse2.prg
Code: Select all
#include "FiveWin.ch"
#include "hbclass.ch"
#include "TSBrowse.ch"
#include "Header.ch"
CLASS TSBrowse FROM __TSBROWSE
DATA oHeader
METHOD DrawHeaders()
ENDCLASS
METHOD DrawHeaders( lFooters ) CLASS TSBrowse
Local nI, nJ, nBegin, nStartCol, oColumn, l3DLook, nClrFore, lAdjBmp, nAlign, nClrBack, hFont, cFooting, ;
cHeading, hBitMap, nLastCol, lMultiLine, nVertText, nClrTo, lOpaque, lBrush, ;
nMaxWidth := ::nWidth() , ;
aColSizes := AClone( ::aColSizes ), ; // use local copies for speed
nHeightHead := ::nHeightHead, ;
nHeightFoot := ::nHeightFoot
Local nHeightSuper := ::nHeightSuper, ;
nVAlign := 1, ;
l3DText, nClr3dL, nClr3dS
Local hWnd := ::hWnd, ;
hDC := ::hDc, ;
nClrText := ::nClrText, ;
nClrPane := ::nClrPane, ;
nClrHeadFore := ::nClrHeadFore, ;
nClrHeadBack := ::nClrHeadBack, ;
nClrFootFore := ::nClrFootFore, ;
nClrFootBack := ::nClrFootBack, ;
nClrOrdeFore := ::nClrOrdeFore, ;
nClrOrdeBack := ::nClrOrdeBack, ;
nClrLine := ::nClrLine
Default lFooters := .F.
If lFooters
Return Super:DrawHeaders( lFooters )
EndIf
If Empty( ::aColumns )
Return Self
EndIf
If ::aColSizes == Nil .or. Len( ::aColSizes ) < Len( ::aColumns )
::aColSizes := {}
For nI := 1 To Len( ::aColumns )
AAdd( ::aColSizes, ::aColumns[ nI ]:nWidth )
Next
EndIf
nClrBack := If( ::nPhantom == -1, ATail( ::aColumns ):nClrHeadBack, nClrPane )
nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack )
nClrFore := If( ::nPhantom == -1, ATail( ::aColumns ):nClrFootBack, nClrPane )
nClrFore := If( ValType( nClrFore ) == "B", Eval( nClrFore ), nClrFore )
l3DLook := If( ::nPhantom == -1, ATail( ::aColumns ):l3DLookHead, .F. )
If ::oPhant == Nil
// "Phantom" column; :nPhantom hidden IVar
::oPhant := TSColumn():New( "", ; // cHeading
{|| "" }, ; // bdata
nil, ; // cPicture
{ nClrText, nClrPane,, ;
nClrBack,,,,,,nClrFore }, ; // aColors
nil, ; // aAlign
::nPhantom, ; // nWidth
nil, ; // lBitMap
nil, ; // lEdit
nil, ; // bValid
.T., ; // lNoLite
nil, ; // cOrder
nil, ; // cFooting
nil, ; // bPrevEdit
nil, ; // bPostEdit
nil, ; // nEditMove
nil, ; // lFixLite
{ l3DLook, l3DLook }, ;
nil, ;
Self )
Else
::oPhant:nClrFore := nClrText
::oPhant:nClrBack := nClrBack
::oPhant:nWidth := ::nPhantom
::oPhant:l3DLookHead := l3DLook
EndIf
nLastCol := Len( ::aColumns ) + 1
AAdd( aColSizes, ::nPhantom )
nJ := nStartCol := 0
nBegin := Min( If( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ;
::nColPos - ::nFreeze ), nLastCol )
If Empty( ::aColumns )
Return Self
EndIf
If ! Empty( ::aSuperHead ) .and. ! lFooters
::DrawSuper()
EndIf
If ::oHeader == NIL
::oHeader:= THeader():New( Self, 0, 0, ::nWidth, nHeightHead, AFill( Array( Len( aColSizes ) ), "" ) ,aColSizes,, nClrFore, nClrBack, {|nItem, oHeader, nMessage| HandleHeader( Self, nItem, oHeader, nMessage ) } )
EndIf
For nI := 1 To nBegin-1
::oHeader:SetItem( nI, cHeading, 0, 0 )
Next
For nI := nBegin To nLastCol
If nStartCol > nMaxWidth
Exit
EndIf
nJ := If( nI < ::nColPos, nJ + 1, nI )
oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] )
If ::lDrawHeaders .and. ! lFooters
cHeading := If( Valtype( oColumn:cHeading ) == "B", Eval( oColumn:cHeading ), oColumn:cHeading )
nAlign := If( ValType( oColumn:nHAlign ) == "B", Eval( oColumn:nHAlign ), oColumn:nHAlign )
If nAlign == DT_CENTER
nAlign:= HDF_CENTER
ElseIf nAlign == DT_RIGHT
nAlign:= HDF_RIGHT
EndIf
If !Empty( oColumn:cOrder ) .And. ::nColOrder == nJ
nAlign+= HDF_SORTUP + HDF_BITMAP_ON_RIGHT
EndIf
::oHeader:SetItem( nJ, cHeading, aColSizes[ nJ ], nAlign )
EndIf
Next
Return Self
Function HandleHeader( Self, nItem, oHeader, nMessage )
Local oColumn, nPrevCol, nAlign, cHeading
// Debug nMessage, nItem
If nMessage == HDN_ENDTRACK
::aColSizes[ nItem ] := ;
::aColumns[ nItem ]:nWidth := oHeader:GetItem( nItem )[1]
::Refresh( .T. )
ElseIf nMessage == HDN_ITEMDBLCLICK
If nItem != ( nPrevCol:= ::nColOrder )
::SetOrder( nItem )
EndIf
EndIf
Return 0 // NIL
Más allá del resultado estético, me interesa más la técnica de modificar las clases, que aunque se cambie la version de fivewin o TSBrowse nuestro código está separado y protegido, tal como se llama el patrón: Variaciones Protegidas.
Espero que les guste.
Un saludo,
Carlos.
