/*
   MemoAllToArray2.prg
   Transformer un champ mémo d'une table en tableau multi dimensions.

   Ce code est un exemple de base à modifier.

   Librairies dans le fichier.hbp :
   # Pour numat() : -lhbct.
   -lhbct
   -lhbwin
*/

// Paramètres.

#define BM_COMMA_END  hb_eol()
//#define BM_COMMA_END  chr( 9 )
#define BM_TABLE_TEST hb_dirbase() + "_Result_Table_Test.dbf"
#define BM_FIELD_MEMO "TEST_MEMO"
#define BM_FILE_LOG   hb_dirbase() + "_Result.log"

procedure Main

   local aArray                      // Tableau
   local c                           // Colonne du tableau.
   local cLine                       // Ligne de data du champ mémo.
   local l                           // Ligne du tableau.
   local MaxRows                     // Nombre maximum de records ( lignes ).
   local MaxCols := 0                // Nombre maximum de colonnes.
   local nAt                         // Position de séparateur( BM_COMMA_END ).

   // ANSI ( Windows ) en français.
   request HB_LANG_FR
   request HB_CODEPAGE_FRWIN
   hb_cdpSelect( 'FRWIN' )
   hb_langSelect( 'FR' )

   // Taille de la console.
   setmode( 43, 80 )
   @ 0, 0, maxrow(), maxcol() box space( 9 )
   setcolor( "W/B" )

   bh_CreateMemoTableTest()

   dbSelectArea( 1 )
   dbUseArea( .F., "DBFNTX", BM_TABLE_TEST, "F001", .F., .F. )

   // Comptage de nombre maximum de colonnes.
   MaxRows := F001->( reccount() )
   F001->( dbgotop() )
   do while .not. F001->( eof() )
      cLine := F001->&( BM_FIELD_MEMO )
      if right( cLine, len( BM_COMMA_END ) ) <> BM_COMMA_END
         MaxCols := max( MaxCols, numat( BM_COMMA_END, cLine ) + 1 )
      else
         MaxCols := max( MaxCols, numat( BM_COMMA_END, cLine ) )
      endif
      F001->( dbskip() )
   enddo

   // Création du tableau vide.
   aArray := Array( MaxRows, MaxCols )
   for l := 1 to MaxRows
      for c := 1 to MaxCols
         aArray[ l, c ] := ""
      endfor
   endfor

   // Remplissage des données.
   F001->( dbgotop() )
   do while .not. F001->( eof() )
      cLine := F001->&( BM_FIELD_MEMO )
      l     := F001->( recno() )
      for c := 1 to MaxCols
         nAt := at( BM_COMMA_END, cLine )
         if nAt > 0
            aArray[ l, c ] := left( cLine, nAt - 1 )
            cLine := right( cLine, len( cLine ) - nAt - len( BM_COMMA_END ) + 1 )
            if len( cLine ) == 0
               exit // for c := 1 to MaxCols.
            endif
         elseif len( cLine ) > 0
            aArray[ l, c ] := cLine
            exit // for c := 1 to MaxCols.
         endif
      endfor
      F001->( dbskip() )
   enddo

   F001->( dbCloseArea() )

   bh_SetAlte( BM_FILE_LOG )
   set( _SET_CONSOLE, .F. )
   for l := 1 to MaxRows
      for c := 1 to MaxCols
         ? aArray[ l, c ]
      endfor
      ? "---"
   endfor
   set( _SET_CONSOLE, .T. )
   bh_SetAlte()
   wapi_ShellExecute( nil, "open", BM_FILE_LOG )

//   wait
   return

/* bh_CreateMemoTableTest.ch
   Créer une table de test avec un champ mémo.
*/
procedure bh_CreateMemoTableTest()
   local c
   local l
   local lx
   local cLine
   if file( BM_TABLE_TEST )
//      return
   endif
   dbSelectArea( 1 )
   dbCreate( BM_TABLE_TEST, { { BM_FIELD_MEMO, "M", 10, 0 } }, "DBFNTX", .F., "F001" )
   for l := 1 to 5
      cLine := ""
      for c := 1 to 2
         cLine += "L" + hb_ntos( l ) + ", C" + hb_ntos( c ) + BM_COMMA_END
      endfor
      cLine += "L" + hb_ntos( l ) + ", C" + hb_ntos( c )
      F001->( dbAppend() )
      F001->&( BM_FIELD_MEMO ) := cLine
   endfor
   lx := l
   for l := lx to lx + 2
      cLine := ""
      for c := 1 to 5
         cLine += "L" + hb_ntos( l ) + ", C" + hb_ntos( c ) + BM_COMMA_END
      endfor
      F001->( dbAppend() )
      F001->&( BM_FIELD_MEMO ) := cLine
   endfor
   lx := l
   for l := lx to lx + 2
      cLine := ""
      for c := 1 to 1
         cLine += "Lx" + hb_ntos( l ) + ", C" + hb_ntos( c )
      endfor
      F001->( dbAppend() )
      F001->&( BM_FIELD_MEMO ) := cLine
   endfor
   F001->( dbCloseArea() )
   return

// Mes outils :

/*
   bh_ErrorSysCons.ch
   Gestion de l'affichage des erreurs de programme dans Harbour.
   Ecrit : Copyright 1999 Antonio Linares <alinares@fivetech.com>.
   Modifié par Bernard Mouille <bernard.mouille@free.fr>

   Fonctionne pour Harbour avec utilisation de la console.

   Ce programme permet d'afficher les programmes appellants avec leur numéro de
   la ligne en cas d'erreur, ce qui n'est pas le cas s'il n'est pas utilisé.

   Doc Harbour : https://github.com/vszakats/hb/blob/096e855/src/rtl/errsys.prg#L49

   Dernière modification : 2022-04-02
*/

// Ne compiler le programme qu'une seule fois.
#ifndef _bh_ErrorSysCons_ch_
#define _bh_ErrorSysCons_ch_

#include "error.ch" // Constantes pour ces programmes.

procedure ErrorSys()
   ErrorBlock( { | oError | DefError( oError ) } )
   return

static function DefError( oError )
   local cMessage
   local cDOSError
   local aOptions
   local nChoice
   local n
   if oError:genCode == EG_ZERODIV .and. oError:canSubstitute
      return 0
   endif
   // By default, retry on RDD lock error failure
   if oError:genCode == EG_LOCK .and. ;
      oError:canRetry
      // oError:tries++
      return .T.
   endif
   // Set NetErr() of there was a database open error
   if oError:genCode == EG_OPEN .and. ;
      oError:osCode == 32 .and. ;
      oError:canDefault
      NetErr( .T. )
      return .F.
   endif
   // Set NetErr() if there was a lock error on dbAppend()
   if oError:genCode == EG_APPENDLOCK .and. ;
      oError:canDefault
      NetErr( .T. )
      return .F.
   endif
   cMessage = ErrorMessage( oError )
   if ! empty( oError:osCode )
      cDOSError = "(DOS Error " + hb_NToS( oError:osCode ) + ")"
   endif
   // Build buttons
   aOptions := {}
   aadd( aOptions, "Quit" )
   if oError:canRetry
      aadd( aOptions, "Retry" )
   endif
   if oError:canDefault
      aadd( aOptions, "Default" )
   endif
   // Show alert box
   nChoice := 0
   do while nChoice == 0
      if cDOSError == nil
         nChoice := alert( cMessage, aOptions )
      else
         cMessage = HB_OEMTOANSI( cMessage )
         nChoice := alert( cMessage + ";" + cDOSError, aOptions )
      endif
   enddo
   if ! empty( nChoice )
      switch aOptions[ nChoice ]
      case "Break"
         Break( oError )
      case "Retry"
         return .T.
      case "Default"
         return .F.
      endswitch
   endif
   // "Quit" selected
   if cDOSError != nil
      cMessage += ";" + cDOSError
   endif
   n := -1
   do while ! empty( ProcName( ++n ) )
    cMessage += ";" + ProcName( n ) + ;
               "( " + hb_NToS( ProcLine(  n  ) ) + " )"
   enddo
   alert( cMessage )
   ErrorLevel( 1 )
   quit
   return .F.

static function ErrorMessage( oError )
   // start error message
   local cMessage := iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "
   // add subsystem name if available
   if valtype( oError:subsystem ) == "C"
      cMessage += oError:subsystem()
   else
      cMessage += "???"
   endif
   // add subsystem's error code if available
   if valtype( oError:subCode ) == "N"
      cMessage += "/" + hb_NToS( oError:subCode )
   else
      cMessage += "/???"
   endif
   // add error description if available
   if valtype( oError:description ) == "C"
      cMessage += "  " + oError:description
   endif
   // add either filename or operation
   do case
   case !empty( oError:filename )
      cMessage += ": " + oError:filename
   case !empty( oError:operation )
      cMessage += ": " + oError:operation
   endcase
   return cMessage

#endif // _bh_ErrorSysCons_ch_

/* 
   bh_SetAlte.ch
   Rediriger la console vers un fichier.

   Dernière modification : 2022-04-25
*/


#ifndef _ch_bh_SetAlte_ch_
#define _ch_bh_SetAlte_ch_

procedure bh_SetAlte( cFile )

   if cFile == nil
      // Fin de la redirection.
      ?
      set( _SET_ALTERNATE, .F. )
      set( _SET_ALTFILE  , ""  )
   else
      // Début de la redirection.

      if file( cFile )
         ferase( cFile )
      endif

      set( _SET_EOF      , .F.   ) // Pas de <Ctrl-Z> à la fin des fichiers créés avec set alte.
      set( _SET_ALTFILE  , cFile )
      set( _SET_ALTERNATE, .T.   )
   endif

   return

#endif // _ch_bh_SetAlte_ch_