FiveTech Software tech support forums

www.FiveTechSoft.com
http://forums.fivetechsoft.com/

TSBrowse: Headers nativos

http://forums.fivetechsoft.com/viewtopic.php?f=6&t=12101

Page 1 of 1

TSBrowse: Headers nativos

Posted: Tue Jul 29, 2008 9:55 pm
by Carlos Mora
Hola gente,

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
con el añadido de esta línea hemos aislado la clase THeader original y podemos hacer _ necesarios en nuestra propia tHeader que pego a continuación, ya que el cambio es menor:

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
Y hacemos lo proprio con TSBrowse, yo trabajé con la versión 8 pero, por definición del procedimiento, no debería haber problemas con versiones anteriores:

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
Como se puede observar, han sido muy pocos toques. No he tenido en cuenta los SuperHeaders, los he dejado de momento porque no los uso.

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.

Posted: Wed Jul 30, 2008 11:42 am
by mmercado
Hola Carlos:

No sabía que existiera la clase THeader (estuve mucho tiempo fuera), ya vi un ejemplo en FWH Samples, pero desconozco sus alcances, si tienes algún ejemplo funcionando con TSBrowse, por favor házmelo llegar.

Un abrazo.

Manuel Mercado

Posted: Wed Jul 30, 2008 1:19 pm
by Carlos Mora
Hola Manuel,

el código que he posteado te alcanza para probar tus propios ejemplos. Lo único es que tienes que añadir en tu proyecto las clases originales THeader y TSBrowse, usar el truquillo del #translate para renombrar las clases.
Tambien incluyes las sublcases nuevas THeader2.prg y TSBrowse2.prg , y tu test.prg.

Una imagen:

Image

para este código

Code: Select all

//---------------------------------------------------------------------------
Function ClientesBrowse( Variable ) // en variable se copia el codigo que se busca.
//---------------------------------------------------------------------------

   Local oFont
   Local oDlg, oBrw, oGet, lIntroCopia:= ValType( Variable ) != 'U'

   Select Clientes

   oFont = TFont():New( GetDefaultFontName(), 0, GetDefaultFontHeight(),, )

   DEFINE DIALOG oDlg RESOURCE "BROWSE" FONT oFont TITLE "Mantenimiento de Clientes" HELPID 0
      oDlg:lHelpIcon := .f.
      REDEFINE BROWSE oBrw ALIAS "CLIENTES" ID 101 OF oDlg FONT oFont
      // oBrw:nClrFocuFore:= CLR_WHITE
      // oBrw:nClrFocuBack:= CLR_NGREENFOCUS

      *CAMPOS
      ADD COLUMN TO oBrw ;
          HEADER "Cliente" DATA {|| Clientes->Codigo } ;
          ORDER "CODIGO" ;
          ALIGN DT_CENTER
      ADD COLUMN TO oBrw ;
          HEADER "Nombre"  DATA {|| Clientes->Empresa } ORDER "EMPRESA" WIDTH GetTextWidth( 0, Replicate( 'M', Len( Clientes->Empresa ) ), oFont:hFont )
      ADD COLUMN TO oBrw ;
          HEADER "CIF/NIF" DATA {|| Clientes->CIF } ;
          ORDER "CIF" ;
          WIDTH GetTextWidth( 0, Replicate( 'M', Len( Clientes->CIF ) ), oFont:hFont ) ;
          ALIGN DT_CENTER

      REDEFINE GET oGet VAR oBrw:cSeek ID 102 WHEN .F. OF oDlg
      oBrw:bSeekChange := {|| oGet:VarPut( oBrw:cSeek ), oGet:Refresh() }
      oBrw:nHeightCell += 6
      oBrw:nHeightHead += 6

      *BOTONES
      REDEFINE BUTTON ID 131 OF oDlg ACTION ClientesForm( .T., oBrw )
      REDEFINE BUTTON ID 132 OF oDlg ACTION ClientesForm( .F., oBrw )
      REDEFINE BUTTON ID 133 OF oDlg ACTION ClientesBorra( oBrw )
      // REDEFINE BUTTON ID 134 OF oDlg ACTION oBrw:Report() // ClientesImprime()
      REDEFINE BUTTON ID 134 OF oDlg ACTION EtiqCorresp( Clientes->Contacto ) // ClientesImprime()
      REDEFINE BUTTON ID 140 OF oDlg ACTION (oDlg:End())

      oBrw:bLDblClick := {|| ClientesForm( .F., oBrw ) }
      oDlg:bKeyDown := {|nKey, nFlags| ClientesKey( nKey, oDlg, oBrw, @Variable, lIntroCopia ) }

   ACTIVATE DIALOG oDlg CENTERED

Return NIL
ahora veo de empaquetar un ejemplo completo, solo que no se incluirá la theader original de Fivewin por razones obvias.

Saludos

Posted: Wed Jul 30, 2008 6:47 pm
by Carlos Mora
Bueno, aca tienes un ejemplo completo.

http://www.box.net/shared/57zns2uwwk

Está todo, hay que ajustar el makefile para que apunte a los directorios donde instalas FiveWin, Harbour y BCC55, y añadir del directorio sources de fivewin el archivo theader.prg. No lo he incluido porque no estoy seguro de que esté metiendo la pata y viole algo relativo a la propiedad intelectual de fivetech.
Entonces y para resumir, hay que copiar el THeader.prg del dir sources de fivewin y añadirle el translate que comenté en el primer post,

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
tambien incluí el exe y una dbf con datos para que lo pruebes de forma inmediata. Prueba hacer doble click en la cabecera de la columna y mira como reacciona. Tambien prueba de escribir letras cuando esta ordenado por código, o bien numero cuando esta ordenado alfabeticamente.

Un saludo,

Carlos.

Posted: Wed Jul 30, 2008 9:55 pm
by mmercado
Gracias Carlos.

Un abrazo.

Manuel Mercado
All times are UTC
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited