//////////////////////////////////////////////////////////////////////
//
//  BLOCKS.PRG
//
//  Copyright:
//       Alaska Software, (c) 1998-2002. Alle Rechte vorbehalten.         
//  
//  Inhalt:
//       Funktionen, die Daten-Codebl”cke f�r den Zugriff auf FIELDs
//       und MEMVARs erzeugen
//       - FieldBlock()
//       - FieldWBlock()
//       - MemvarBlock()
//       - anchorCB()
//       - Scatter()
//       - Gather()
//   
//////////////////////////////////////////////////////////////////////

****************************************************************************
* Daten-Codeblock f�r Felder
****************************************************************************
FUNCTION FieldBlock( cFieldName )
   LOCAL bBlock
   IF FieldPos( cFieldName ) <> 0
      IF ! "->" $ cFieldName
         cFieldName := "FIELD->"+cFieldName
      ENDIF
      bBlock := &( "{|x| IIf(x==NIL,"+cFieldName+","+cFieldName+":=x) }" )
   ENDIF
RETURN bBlock

****************************************************************************
* Daten-Codeblock f�r Felder in einem bestimmten Arbeitsbereich
****************************************************************************
FUNCTION FieldWBlock( cFieldName, cnArea )
   LOCAL cBlock := "{|x| ", bBlock, nArea := Select()

   DbSelectArea( cnArea )
   IF FieldPos( cFieldName ) <> 0
      IF Valtype( cnArea ) == "C"
         cBlock += cnArea+ '->'
      ELSE
         cBlock += "(" +LTrim(Str(cnArea))+ ")->"
      ENDIF
      cBlock += "(IIf(x==NIL,FIELD->"+cFieldName+","+ ;
                            "FIELD->"+cFieldName+":=x)) }"
      bBlock := &(cBlock)
   ENDIF
   DbSelectArea( nArea )

RETURN bBlock
 
****************************************************************************
* Daten-Codeblock f�r MEMVARs
****************************************************************************
FUNCTION MemvarBlock( cVarname )
   LOCAL bError := ErrorBlock( {|e| Break(e) } ), bBlock, dummy
   BEGIN SEQUENCE
      IF ! "->" $ cVarName
         cVarName := "M->"+cVarName
      ENDIF
      /*
       * Wenn die Variable cVarName nicht existiert erzeugt der
       * Macro Operator einen Laufzeitfehler und bBlock bleibt NIL
       */
      dummy  := &( cVarName )
      bBlock := &( "{|x| IIf(x==NIL,"+cVarname+","+cVarname+":=x) }" )
   ENDSEQUENCE
   ErrorBlock( bError )
RETURN bBlock

****************************************************************************
* Daten-Codeblock f�r alle VARs
* Achtung: <AnyVar> muá per Referenz �bergeben werden !
****************************************************************************
FUNCTION anchorCB( AnyVar )
RETURN  {|x| IIf( PCount()==0 , AnyVar, AnyVar:=x ) } 

******************************************************************************
* Žquivalent zu :setData()
******************************************************************************
FUNCTION Scatter( aValues )

   IF Valtype( aValues ) <> "A"
      aValues := Array( FCount() )
   ENDIF

   IF ! Empty( aValues )
      IF AScan( aValues, {|x| Valtype(x) <> "O" } ) > 0
         AEval( aValues, {|x,i| x:=FieldGet(i) },,, .T. )
      ELSE
         AEval( aValues, {|o| o:setData() } )
      ENDIF
   ENDIF

RETURN aValues

******************************************************************************
* Žquivalent zu :getData()
******************************************************************************
FUNCTION Gather( aValues )

   IF Valtype( aValues ) == "A"
      IF AScan( aValues, {|x| Valtype(x) <> "O" } ) > 0
         AEval( aValues, {|x,i| FieldPut(i,x) } )
      ELSE
         AEval( aValues, {|o| o:getData() } )
      ENDIF
   ENDIF

RETURN aValues