// BLATTDR.prg         - fllt ein Formular aus
PROCEDURE BlattDR_( cDatei, cTitle, oDlg, nXsize, nYsize, cLPTSCR, cCP )
LOCAL nOldArea := Select(), aSchrift := {}, aBlatt := {}, aBlattZ := {}
LOCAL cSeite, cNa, cPrompt, cText, cTFont, cBereich, cFeld, cFFont, nZei, nSpa
LOCAL aSeite := {}, aNa := {}, aPrompt := {}, aText := {}, aTFont := {}
LOCAL aBereich := {}, aFeld := {}, aFFont := {}, aZei := {}, aSpa := {}
PRIVATE cB, cF

SELECT 12
USE Drubef
IF Upper( cDrucker ) = "HP"
   AAdd( aSchrift, Trim( 12->hpnorm ) )
   Aadd( aSchrift, Trim( 12->hp12p ) )
   Aadd( aSchrift, Trim( 12->hp14p ) )
   Aadd( aSchrift, Trim( 12->hpres1 ) )
   Aadd( aSchrift, Trim( 12->hpres2 ) )
   Aadd( aSchrift, Trim( 12->hpres3 ) )
   Aadd( aSchrift, Trim( 12->hpres4 ) )
   nPoffY := Val( Substr( 12->hpres5, 1, 3 ) )
   nPoffX := Val( Substr( 12->hpres5, 4, 3 ) )
   nPpZ := Val( Substr( 12->hpres5, 7, 3 ) )
   nPpS := Val( Substr( 12->hpres5, 10, 3 ) )
ELSE
   Aadd( aSchrift, Trim( 12->epnorm ) )
   Aadd( aSchrift, Trim( 12->ep12p ) )
   Aadd( aSchrift, Trim( 12->ep14p ) )
   Aadd( aSchrift, Trim( 12->epres1 ) )
   Aadd( aSchrift, Trim( 12->epres2 ) )
   Aadd( aSchrift, Trim( 12->epres3 ) )
   Aadd( aSchrift, Trim( 12->epres4 ) )
   nPoffY := Val( Substr( 12->epres5, 1, 3 ) )
   nPoffX := Val( Substr( 12->epres5, 4, 3 ) )
   nPpZ := Val( Substr( 12->epres5, 7, 3 ) )
   nPpS := Val( Substr( 12->epres5, 10, 3 ) )
ENDIF
USE
cDRnorm := aSchrift[1]
USE &cDatei
DO WHILE .NOT. Eof()
   cSeite := Trim( 12->seite )  // s=Rckseite, b=neues Blatt, n=neue Bildmaske
   cNa := Trim( 12->na )       // t=Text „nderbar, f=Feldinhalt „nderbar
   cPrompt := Trim( 12->prompt )        // Bildschirm: Text fr Eingabe
   cText := Trim( 12->text )
   cTFont := 12->tfont         // Schriftart 1...7
   cBereich := 12->bereich      // Area des Feld-Files
   cFeld := Trim( 12->feld )   // Feldbezeichnung
   cFFont := 12->ffont         // Schriftart 1...7
   nZei := 12->zeile           // 0..80 = Zeilen, >80 = Pixel
   nSpa := 12->spalte          // Angabe in Spalten/Pixel je nach nZei
   AAdd( aBlatt, { cSeite, cNa, cPrompt, cText, cTFont, ;
                        cBereich, cFeld, cFFont, nZei, nSpa }, RecNo() )
   SKIP
ENDDO

FOR i := 1 to Len( aBlatt )
   aBlattZ := aBlatt[i]
   AAdd( aSeite, aBlattZ[1] )
   AAdd( aNa, aBlattZ[2] )
   AAdd( aPrompt, aBlattZ[3] )
   AAdd( aText, aBlattZ[4] )
   AAdd( aTFont, aBlattZ[5] )
   AAdd( aBereich, aBlattZ[6] )
   AAdd( aFeld, aBlattZ[7] )         // Feldbezeichnung
   AAdd( aFFont, aBlattZ[8] )
   AAdd( aZei, aBlattZ[9] )
   AAdd( aSpa, aBlattZ[10] )
   IF aSeite[i] = "n"
      READ
// vielleicht wird die folgende FOR-NEXT-Schleife gar nicht gebraucht..??
      FOR j:=1 to i-1
         aBlattZ := { aSeite[j], aNa[j], aPrompt[j], Trim(aText[j]), aTFont[j], aBereich[j], ;
                          IIf( ValType(aFeld[j])="C", Trim(aFeld[j]), aFeld[j]), ;
                          aFFont[j], aZei[j], aSpa[j] }
         aBlatt[j] := aBlattZ
      NEXT
      @ 6,0 CLEAR
      nZb := 4
   ENDIF
   IF aNa[i] = "t"                 // Text ist zu ver„ndern
         aText[i] := aText[i]+Space(50-len(aText[i]))
         @ ++nZb,1 SAY aPrompt[i]+Space(75-len(aPrompt[i]))
         @ nZb,21 GET aText[i]
         aText[i] := ( aText[i] )
      IF ASC( aFeld[i] ) > 32
         cB := aBereich[i] ; cF := aFeld[i]
         aFeld[i] := ((&cB)->(&cF))          //Feldinhalt
      ENDIF                     
   ELSEIF aNa[i] = "f"             // Feldinhalt soll editiert werden
      cB := aBereich[i] ; cF := aFeld[i]
      aFeld[i] := ( (&cB)->(&cF) )      //Feldinhalt
      @ ++nZb,1 SAY aPrompt[i]+Space(75-len(aPrompt[i]))
      @ nZb, 21 GET aFeld[i]
      aFeld[i] := ( aFeld[i] )
      aText[i] := ""
   ELSE
      IF ASC( aFeld[i] ) > 32
         cB := aBereich[i] ; cF := aFeld[i]
         aFeld[i] := ((&cB)->(&cF))          //Feldinhalt
      ENDIF                     
   ENDIF
   IF ValType(cF)="C"
      IF Upper(cF) = "FAM" .OR. Upper(cF) = "KONF"
         aFeld[i] := Kurzlang( aFeld[i] )
      ENDIF
   ENDIF
NEXT
CLOSE DATA
READ
FOR i=1 to len(aBlatt)
   aBlattZ := { aSeite[i], aNa[i], aPrompt[i], Trim(aText[i]), aTFont[i], aBereich[i], ;
                        IIf( ValType(aFeld[i])="C", Trim(aFeld[i]), aFeld[i]), ;
                        aFFont[i], aZei[i], aSpa[i] }
   aBlatt[i] := aBlattZ
NEXT

SET DEVICE TO PRINTER
IF cLPTSCR = "S"
   SET PRINTER TO blattdr.txt
FOR i := 1 to Len( aBlatt )
   aBlattZ := aBlatt[i]
   cSeite := aBlattZ[1]
   cNa := aBlattZ[2]
   cPrompt := aBlattZ[3]
   cText := IIf( cCP="A", ConvToAnsiCP( aBlattZ[4] ), aBlattZ[4] )
   nTFont := aBlattZ[5]
   cBereich := aBlattZ[6]
   cFeld := IIf( cCP="A" .AND. ValType( aBlattZ[7] ) = "C", ;
                ConvToAnsiCP( aBlattZ[7] ), aBlattZ[7] ) // Feldinhalt
   nFFont := aBlattZ[8]
   nZei := aBlattZ[9]
   nSpa := IIf( aBlattZ[10]<0, PCol(), aBlattZ[10] )
   IF cFeld <> NIL
      DO CASE
         CASE Valtype( cFeld ) == "C"
            @ nZei,nSpa SAY cText+" "+cFeld
         CASE Valtype( cFeld ) == "N"
            @ nZei,nSpa SAY cText+" "+Str( cFeld )
         CASE Valtype( cFeld ) == "D"
            @ nZei,nSpa SAY cText+" "+DtoC( cFeld )
      ENDCASE
   ELSE
      @ nZei,nSpa SAY cText
   ENDIF
NEXT
ELSE
SET PRINTER ON
SET PRINTER TO LPT1
SetPrc( 0, 0 )
FOR i := 1 to Len( aBlatt )
   aBlattZ := aBlatt[i]
   cSeite := aBlattZ[1]
   cNa := aBlattZ[2]
   cPrompt := aBlattZ[3]
   cText := IIf( cCP="A", ConvToAnsiCP( aBlattZ[4] ), aBlattZ[4] )
   nTFont := IIf( aBlattZ[5]>0, aBlattZ[5],1 )
   cBereich := aBlattZ[6]
   cFeld := IIf( cCP="A" .AND. ValType( aBlattZ[7] ) = "C", ;
                ConvToAnsiCP( aBlattZ[7] ), aBlattZ[7] ) // Feldinhalt
   nFFont := IIf( aBlattZ[8]>0, aBlattZ[8], 1 )
   nZei := aBlattZ[9]
   nSpaalt := PCol()
   nSpa := IIf( aBlattZ[10]<0, PCol(), aBlattZ[10] )
   IF cSeite = "s"
      eject
      wait "Formular umdrehen"
   ELSEIF cSeite = "b"
      eject
   ENDIF
   IF cFeld <> NIL
         DO CASE
         CASE Valtype( cFeld ) == "C"
            ZS_( nZei, nSpa )
            IIf( Len(Trim(cText))>0, FDr_( Trim( cText ), aSchrift[nTFont] ), )
            FDr_( Trim( cFeld ), aSchrift[nFFont] )
         CASE Valtype( cFeld ) == "N"
            ZS_( nZei, nSpa )
            IIf( Len(Trim(cText))>0, FDr_( Trim( cText ), aSchrift[nTFont] ), )
            FDr_( Trim( Str( cFeld ) ), aSchrift[nFFont] )
         CASE Valtype( cFeld ) == "D"
            ZS_( nZei, nSpa )
            IIf( Len(Trim(cText))>0, FDr_( Trim( cText ), aSchrift[nTFont] ), )
            FDr_( Trim( DtoC( cFeld ) ), aSchrift[nFFont] )
      ENDCASE
   ELSE
      ZS_( nZei, nSpa )
      FDr_( Trim( cText ), aSchrift[nTFont] )
   ENDIF
NEXT
ENDIF
USE
EJECT
SET PRINTER TO
SET DEVICE TO SCREEN
SELECT &nOldArea

RETURN


FUNCTION ZS_( nZei, nSpa )
   IF Upper( cDrucker ) = "HP"
      IF nZei<80
         QQOut( Chr(27)+"*p"+LTrim(Str(nPoffY+Int(nZei*nPpZ),4,0))+"Y" ;
          + Chr(27)+"*p"+LTrim(Str(nPoffX+Int(nSpa*nPpS),4,0))+"X" )
      SetPrc( nZei, nSpa )
      ELSE
         QQOut( Chr(27)+"*p"+LTrim(Str(nPoffY+nZei,4,0))+"Y" ;
          + Chr(27)+"*p"+LTrim(Str(nPoffX+nSpa,4,0))+"X" )
      SetPrc( Int(nZei/nPpZ), Int(nSpa/nPpS ) )
      ENDIF
   ELSE

   ENDIF
RETURN .T.

FUNCTION Fdr_( cFeldText, cSchrift )
   LOCAL nRow := PRow() , nCol := PCol()
   IF cSchrift<>""
      QQOut( Chr(27)+cSchrift )
   ENDIF
   SetPrc( nRow, nCol )
   QQOut( Trim( cFeldText ) )
   nRow := PRow() ; nCol := PCol()
   QQOut( Chr(27)+cDRnorm )
 RETURN SetPrc( nRow, nCol )

FUNCTION Kurzlang( cFeld )
   DO CASE
      CASE cFeld = "le"
         cFeld := "ledig"
      CASE cFeld = "vh"
         cFeld := "verheiratet"
      CASE cFeld = "vw" .OR. cFeld = "Ww"
         cFeld := "verwitwet"
      CASE cFeld = "ge"
         cFeld := "geschieden"
      CASE cFeld = "ev"
         cFeld := "evangelisch"
      CASE cFeld = "r.k"
         cFeld := "r”misch katholisch"
   ENDCASE
RETURN cFeld