How can I set a multiline-header within a XbpBrowse()?



Solution:

#include "Appevent.ch"
#include "Common.ch"
#include "Font.ch"
#include "Xbp.ch"

#pragma library( "xppui2.lib" )

PROCEDURE AppSys
   // no Crt instances are created
RETURN

PROCEDURE DbeSys
   // This program does not use index files.
   // Therefore, we do not load DBE ORDER components.
   IF ! DbeLoad( "DBFDBE" )
      MsgBox( "Unable to load DBFDBE" )
   ENDIF

   IF ! DbeLoad( "FOXDBE" )
      MsgBox( "Unable to load FOXDBE" )
   ENDIF

   DbeSetDefault( "DBFDBE" )
RETURN

CLASS MultiLineCellGroup FROM XbpCellGroup
EXPORTED:
  INLINE METHOD Create( oParent, oOwner, aPos, aSize, aPP, lVisible )
     // always make sure that we have two lines
     ::XbpCellGroup:MaxRow := 2
  RETURN ::XbpCellgroup:Create( oParent, oOwner, aPos, aSize, aPP, lVisible )
ENDCLASS

CLASS MultiLineColumn FROM XbpColumn
EXPORTED:
  INLINE METHOD Init( oParent, oOwner, aPos, aSize, aPP, lVisible )
     ::XbpColumn:Init( oParent, oOwner, aPos, aSize, aPP, lVisible )
     // exchange the heading by our own header object
     ::Heading := MultilineCellgroup():New( self )
  RETURN self
ENDCLASS

PROCEDURE Main ( name )
   LOCAL nEvent, mp1, mp2, oXbp, oBrowse, aStruct, i, imax, bError, cDbe
   LOCAL aCols, aPP

   DEFAULT name TO GetFilename()

   IF name == NIL
      MsgBox ( "No Filename specified" + CHR(10) + CHR(10)+ ;
               "Usage: DBBrowse []" )
      RETURN
   ENDIF

   bError := ErrorBlock( {|oErr| Break( oErr ) } )
   cDBE   := "DBFDBE"
   FOR i:=1 TO 2
      BEGIN SEQUENCE
         DbUseArea( .T., cDBE, name )
      RECOVER

         IF i== 1
            cDBE := "FOXDBE"
            LOOP
         ENDIF
      ENDSEQUENCE
      EXIT
   NEXT
   ErrorBlock( bError )


   IF ! Used()
      MsgBox ( "Unable to open file" + CHR(10) + CHR(10)+ Name )
      QUIT
   ENDIF

   // create std dialog
   oXbp := GuiStdDialog( "Standard GUI Browser for DBF" )

   // create browser in window
   oBrowse := GuiBrowseDb( oXbp:drawingArea )

   // create columns for all fields but exclude FoxPro specific data types
   imax    := FCount()
   aStruct := DbStruct()
   aCols   := Array( imax )
   FOR i:=1 TO imax
      IF .NOT. aStruct[i,2] $ "BOVTXY"
         aPP      := {}
         Aadd ( aPP, { XBP_PP_COL_HA_CAPTION,   aStruct[i,1] } )
         // Aadd ( aPP, { XBP_PP_COL_HA_CHARWIDTH, aStruct[i,1] } )
         aCols[i] := MultiLineColumn():new(,,,,aPP)
         aCols[i]:DataLink := FieldBlockTrimmed(aStruct[i,1], aStruct[i,2])
         oBrowse:addColumn( aCols[i] )
      ENDIF
   NEXT

   oBrowse:Create()

   // Apply the second header line
   AEval( aCols, { | o | o:Heading:SetCell( 2, "Second Line" ) } )

   // overload resize that browser fills the window
   oXbp:drawingArea:resize := ;
       {|mp1,mp2,obj| obj:childList()[1]:setSize(mp2) }

   // show browser and set focus on it
   oXbp:show()
   oBrowse:show()
   SetAppFocus( oBrowse )

   DO WHILE nEvent <> xbeP_Close
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      oXbp:handleEvent( nEvent, mp1, mp2 )
   ENDDO
RETURN


******************************************************************
* Create GUI Browser with navigation codeblocks
******************************************************************
FUNCTION GuiBrowseDB( oParent, aPos, aSize )
   LOCAL oBrowse

   oBrowse := XbpBrowse():new( oParent,, aPos, aSize,, .F. )

   // navigation codeblocks for the browser
   oBrowse:skipBlock     := {|n| DbSkipper(n) }
   oBrowse:goTopBlock    := {| | DbGoTop()    }
   oBrowse:goBottomBlock := {| | DbGoBottom() }
   oBrowse:phyPosBlock   := {| | Recno()      }

   // Code blocks for the vertical scrollbar.
   // Note: DbPosition() returns values in the range from 0 to 100.
   // We multiply this with 10 to increase the granularity of
   // the vertical scrollbar.
   oBrowse:posBlock      := {| | DbPosition()*10    }
   oBrowse:goPosBlock    := {|n| DbGoPosition(n/10) }
   oBrowse:lastPosBlock  := {| | 1000               }
   oBrowse:firstPosBlock := {| | 0                  }

RETURN oBrowse


******************************************************************
* Create std dialog window hidden
******************************************************************
FUNCTION GuiStdDialog( cTitle )
   LOCAL oDlg

   DEFAULT cTitle TO "Standard Dialog Window"

   oDlg          := XbpDialog():new( ,,{10,10}, {600,400},, .F. )
   oDlg:icon     := 1
   oDlg:taskList := .T.
   oDlg:title    := cTitle
   oDlg:drawingArea:ClipChildren := .T.
   oDlg:create()
   oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL )

RETURN oDlg


******************************************************************
* Get filename with filedialog
******************************************************************
FUNCTION GetFilename()
   LOCAL oDlg := XbpFiledialog():New(), cFile

   oDlg:Title := "Please select DBF file"
   oDlg:Create()
   cFile := oDlg:Open( "..\..\DATA\*.DBF" )

RETURN cFile


****************************************************************************
* Data code block for fields
****************************************************************************
FUNCTION FieldBlockTrimmed( cFieldName, cType )
   LOCAL bBlock
   IF FieldPos( cFieldName ) <> 0
      IF ! "->" $ cFieldName
         cFieldName := "FIELD->"+cFieldName
      ENDIF
      IF cType = "C"
         bBlock := &( "{|x| IIf(x==NIL,RTrim("+cFieldName+"), ;
                 "+cFieldName+":=x)}" )
      ELSE
         bBlock := &( "{|x| IIf(x==NIL,"+cFieldName+","+cFieldName+":=x) }" )
      ENDIF
   ENDIF
RETURN bBlock



 
(