// BLATTDRVG.prg - gibt eine Druckseite (mit Vorschau) aus // BlattDRG() heiát die Funktion aus historischen Grnden (Button-Activates) #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" ** FUNCTION BlattDRG( cDatei, cTitle, oDlg1, nXsize, nYsize, cLPTSCR_Loc, cCP, nAnzahl, nt ) LOCAL oPrinterPS, oFont, oBitMap, aBitSize, aBitRect, nRec LOCAL nOldArea := Select(), aSchrift := {}, aBlattG := {}, aBlattZ := {}, i, aParamG := {} LOCAL cSeite, cNa, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, aRep := {} //LOCAL aSeite := {}, aNa := {}, aPrompt := {}, aText := {}, aTFont := {} //LOCAL aBereich := {}, aFeld := {}, aFFont := {}, aZei := {}, aSpa := {} PRIVATE cB, cF, nZei, nSpa PRIVATE nMSum := nGS := nS1 := nS2 := nS3 := nS4 := nS5 := 0, nF := xFaktor PRIVATE nGSA := nGSN := nGRSA := nGRS := nSv := 0 PRIVATE nMSumh := nGSh := nS1h := nS2h := nS3h := nS4h := nS5h := 0, nF := xFaktor PRIVATE nGSAh := nGSNh := nGRSAh := nGRSh := nSvh := 0 PRIVATE cX := "i" FOR i := 11 TO 30 // Dummy-Variablen fr Berechnungen in Formularen &("i"+Str(i,2,0)) := "0" NEXT PRIVATE nISum := 0, cISum := "0", nAnz := 1 PRIVATE cNt := "0", cAnz := "1" , cMwstjn := "n" , cHgwjn := "n", cZweiseitjn := "n" PRIVATE cEigen := "n", lFremd := .F. PRIVATE cAuf := Str( (1->auftrnr),6,0 ) PRIVATE cPoffY, nPoffY, cPoffX, nPoffX, cPpS, cPpZ, cZeiMax := "65" PRIVATE nA, cBriefKopf := "n" PRIVATE cZwi := "Im Rechnungsbetrag ist die gesetzliche Mehrwertsteuer" cLPTSCR := IIf( !Empty(cLPTSCR_Loc), cLPTSCR_Loc, "P" ) DbSuspendNotifications() SELECT 20 use Drubef GO BOTTOM IF RecNo() == 1 DbAppend() ELSE DbRLock( RecNo() ) ENDIF IF Upper( cDrucker ) = "HP" AAdd( aSchrift, Trim( 20->hpnorm ) ) Aadd( aSchrift, Trim( 20->hp12p ) ) Aadd( aSchrift, Trim( 20->hp14p ) ) Aadd( aSchrift, Trim( 20->hpres1 ) ) Aadd( aSchrift, Trim( 20->hpres2 ) ) Aadd( aSchrift, Trim( 20->hpres3 ) ) Aadd( aSchrift, Trim( 20->hpres4 ) ) nPoffY := Val( Substr( 20->hpres5, 1, 3 ) ) nPoffX := Val( Substr( 20->hpres5, 4, 3 ) ) nPpZ := Val( Substr( 20->hpres5, 7, 3 ) ) nPpS := Val( Substr( 20->hpres5, 10, 3 ) ) ELSE Aadd( aSchrift, Trim( 20->epnorm ) ) Aadd( aSchrift, Trim( 20->ep12p ) ) Aadd( aSchrift, Trim( 20->ep14p ) ) Aadd( aSchrift, Trim( 20->epres1 ) ) Aadd( aSchrift, Trim( 20->epres2 ) ) Aadd( aSchrift, Trim( 20->epres3 ) ) Aadd( aSchrift, Trim( 20->epres4 ) ) nPoffY := Val( Substr( 20->epres5, 1, 3 ) ) nPoffX := Val( Substr( 20->epres5, 4, 3 ) ) nPpZ := Val( Substr( 20->epres5, 7, 3 ) ) nPpS := Val( Substr( 20->epres5, 10, 3 ) ) ENDIF USE cDRnorm := aSchrift[1] IF File( cDatei+"p.dbf" ) USE &(cDatei+"p") DO WHILE .NOT. Eof() cSeite := Trim( 20->seite ) // s=Rckseite, b=neues Blatt, n=neue Bildmaske cNa := Trim( 20->na ) // t=Text „nderbar, f=Feldinhalt „nderbar cPrompt := Trim( 20->prompt ) // Bildschirm: Text fr Eingabe cText := IIf( 20->Text="&", &(Trim( Substr( 20->text, 2, 69 ) ) ), 20->text ) nTFont := 20->tfont // Schriftart 1...7 cBereich := 20->bereich // Area des Feld-Files cFeld := Trim( 20->feld ) // Feldbezeichnung nFFont := 20->ffont // Schriftart 1...7 nZei := 20->zeile // 0..80 = Zeilen, >80 = Pixel nSpa := 20->spalte // Angabe in Spalten/Pixel je nach nZei IF !Empty( cFeld ) &cFeld := cText // PRIVATE Variable als Parameter fr das Blatt ENDIF AAdd( aParamG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }, RecNo() ) skip ENDDO ENDIF //System-Variable entweder Standardwert oder Wert aus aParamG : nt := Val( cNt ) nAnz := IIf( !Empty(cAnz), Val( cAnz ), nAnzahl ) nPoffX := IIf( !Empty( cPoffX ), Val( cPoffX ), nPoffX ) nPoffY := IIf( !Empty( cPoffY ), Val( cPoffY ), nPoffY ) nPpS := IIf( !Empty( cPpS ), Val( cPpS ), nPpS ) nPpZ := IIf( !Empty( cPpZ ), Val( cPpZ ), nPpZ ) USE &cDatei nA := Alias() DO WHILE .NOT. Eof() cSeite := Trim( &nA->seite ) // s=Rckseite, b=neues Blatt, n=neue Bildmaske cNa := Trim( &nA->na ) // t=Text „nderbar, f=Feldinhalt „nderbar cPrompt := Trim( &nA->prompt ) // Bildschirm: Text fr Eingabe cText := &nA->text nTFont := &nA->tfont // Schriftart 1...7 cBereich := &nA->bereich // Area des Feld-Files cBereich := IIf( cLPTSCR="B" .AND. Val(cBereich)>10, Str(Val(cBereich)-10,2,0), cBereich ) cFeld := Trim( &nA->feld ) // Feldbezeichnung nFFont := &nA->ffont // Schriftart 1...7 nZei := &nA->zeile // 0..80 = Zeilen, >80 = Pixel nSpa := &nA->spalte // Angabe in Spalten/Pixel je nach nZei IF cNa = "t" // Text ist zu ver„ndern ////// cB := cBereich ; cF := cFeld ////// IF !Empty( cF ) .AND. Val( cB ) > 0 ////// cFeld := ((&cB)->(&cF)) //Feldinhalt ////// ENDIF ELSEIF cNa = "f" // Feldinhalt soll editiert werden cB := cBereich ; cF := cFeld xF := ( (&cB)->(&cF) ) //Feldinhalt DO CASE CASE Valtype( xF ) == "C" cFeld := xF CASE ValType( xF ) == "N" cFeld := Str( xF ) CASE ValType( xF ) == "D" cFeld := DtoC( xF ) ENDCASE cNa := "t" cText := cFeld nTFont := nFFont nFFont := 0 cBereich := "" cFeld := "" // cFeld := "&([" + cFeld + "])" ELSEIF cNa = "v" .AND. cBereich = "v" .AND. Upper(cSeite)!="V"// Variable soll editiert werden cF := cFeld xF := &(cF) //Variableninhalt DO CASE CASE xF == NIL cFeld := "&(" + cF + ")" CASE Valtype( xF ) == "C" cFeld := xF CASE ValType( xF ) == "N" cFeld := Str( xF ) CASE ValType( xF ) == "D" cFeld := DtoC( xF ) ENDCASE cNa := "t" cText := cFeld nTFont := nFFont nFFont := 0 cBereich := "" cFeld := IIf( !":="$cF,"", SubStr( cF,1,At(":=",cF)-1) ) // cFeld := "&([" s+ cFeld + "])" ////// ELSEIF cNa != "v" .AND. cBereich = "v" // im cFeld steht Mem-Variable ////// cF := cFeld ////// cFeld := "&(" + cF + ")" ////// ELSE ////// IF ASC( cFeld ) > 32 ////// cB := cBereich ; cF := cFeld ////// cFeld := ((&cB)->(&cF)) //Feldinhalt ////// ENDIF ENDIF AAdd( aBlattG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }, RecNo() ) SKIP ENDDO FOR i := 11 TO 30 // Summe der Dummy-Variablen fr Berechnungen in Formularen nISum := nISum + Val( &("i"+Str(i,2,0)) ) NEXT cISum := Str( nISum,8,2 ) ////////////////////////////////////////////////////////////// BPreview( aBlattG, oDlg1, cCP, aSchrift, aParamG ) // IF Empty( aBlattG ) // USE // SELECT &nOldArea // (nOldArea)->(DbResumeNotifications()) // cLPTSCR := "S" // RETURN NIL // ENDIF // nGS := BlattDruck( aBlattG, oDlg1, cCP, aSchrift ) // ////////////////////////////////////////////////////////////// SELECT &nOldArea DbResumeNotifications() cLPTSCR := "S" RETURN nGS FUNCTION Vorschau_Ausgabe( oPrinterPS, aSegments, aBlatt, cCP, aSchrift ) LOCAL dummy2 := GraSegDrawMode( oPrinterPS, GRA_DM_RETAIN ) LOCAL nSegment := GraSegOpen( oPrinterPS ) LOCAL aPrinterPS := { oPrinterPS, PrinterPS() } //; LOCAL aPaper := aPrinterPS[2]:DEVICE():paperSize() , aPoSZ := {0,0} LOCAL aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") ASize( aSegments, 0 ) Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP, aSegments, @nSegment ) GraSegClose( oPrinterPS ) AAdd( aSegments, nSegment ) GraSegDrawMode( oPrinterPS, GRA_DM_DRAWANDRETAIN ) RETURN aSegments // aktiv, wenn in der Vorschau "ENDE+Druck" angew„hlt wird: FUNCTION BlattDruck( aBlatt, oDlg1, cCP, aSchrift ) LOCAL oBitMap, aBitSize, aBitRect, nRec, i LOCAL aPrinterPS := { PrinterPS(), PrinterPS() } //; LOCAL aPaper := aPrinterPS[2]:DEVICE():paperSize() , aPoSZ := {0,0} LOCAL aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") IF cBriefKopf != "n" cBriefkopf := IIf("."$cBriefKopf,cBriefKopf,cBriefKopf+".BMP") oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := aPrinterPS[1]:device():paperSize() aBitRect := { 0, 0, aBitSize[1], aBitSize[2] } oBitmap:loadFile( cBriefKopf ) // Bitmap laden ENDIF aPrinterPS[1]:device():startdoc() DO WHILE --nAnz >= 0 IF cBriefKopf != "n" .AND. cLPTSCR != "B" oBitmap:draw( aPrinterPS[1], aBitRect ) ENDIF Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP ) IF nAnz > 0 aPrinterPS[1]:device():newPage() ENDIF ENDDO aPrinterPS[1]:device():endDoc() DestroyDevice( aPrinterPS[1] ) DestroyDevice( aPrinterPS[2] ) IF cBriefKopf != "n" oBitmap:destroy() ENDIF USE RETURN nGS FUNCTION PrinterPS( cPrinterObjectName ) LOCAL oPS, oDC := XbpPrinter():New() oDC:create( cPrinterObjectName ) oPS := XbpPresSpace():New() oPS:create( oDC, oDC:papersize(), GRA_PU_LOMETRIC ) RETURN oPS PROCEDURE DestroyDevice( oPS ) LOCAL oDC := oPS:device() IF oDC <> NIL oPS:configure() oDC:destroy() ENDIF RETURN FUNCTION FdrG( aPrinterPS, aFont, aPaper, aPoSZ, cText, nFont, aSettings ) //Arrayelemente von :paperSize() Element Bedeutung ////// LOCAL nXSize := aPaper[1] // 1 Papierbreite in 1/10 mm (= nXsize) ////// LOCAL nYSize := aPaper[2] // 2 Papierhöhe in 1/10 mm (= nYsize) ////// LOCAL nLeftMargin := aPaper[3] // 3 Linker Rand in 1/10 mm (= nLeftMargin) ////// LOCAL nBottomMargin := aPaper[4] // 4 Unterer Rand in 1/10 mm (= nBottomMargin) ////// LOCAL nRightMargin := aPaper[5] // 5 Rechter Rand in 1/10 mm (= nRightMargin) ////// LOCAL nTopMargin := aPaper[6] // 6 Oberer Rand in 1/10 mm (= nTopMargin) //Die Werte fr die nicht bedruckbaren R„nder beziehen sich auf die linke, //untere Ecke des Papiers. Fr das Papierformat A4 (2100, 2970) k”nnten die //R„nder also folgende Koordinaten haben: 50, 50, 2050, 2920. In diesem //Fall w„re der nicht bedruckbare Rand auf dem Papier ringsherum 5 mm breit. LOCAL aTextbox := {}, aPenPos := {}, nZeiG, nSpaG LOCAL nPpSG := nPpS, nPpZG := nPpZ aFont[1]:configure( IIf( !Empty(aSettings), aSettings, ; { "12.COURIER NEW" , ; "10.ARIAL" , ; "10.ARIAL FETT" , ; "12.COURIER NEW FETT" , ; "10.TIMES NEW ROMAN" , ; "10.TIMES NEW ROMAN FETT" , ; "12.TIMES NEW ROMAN FETT KURSIV" ; } )[nFont] ) aFont[2]:configure( IIf( !Empty(aSettings), aSettings, ; { "12.COURIER NEW" , ; FONT_DEFPROP_MEDIUM , ; FONT_DEFPROP_LARGE , ; "12.COURIER NEW FETT" , ; FONT_TIMES_MEDIUM , ; FONT_TIMES_LARGE , ; FONT_TIMES_XLARGE + FONT_STYLE_ITALIC + FONT_STYLE_BOLD ; } )[nFont] ) IF aPoSZ[2]<80 nZeiG := aPaper[6] - aPaper[4] - nPoffY - Int( aPoSZ[2] * nPpZG ) nSpaG := nPoffX + aPaper[3] + Int( aPoSZ[1] * nPpSG ) ELSE nZeiG := aPoSZ[2] nSpaG := aPoSZ[1] ENDIF GraSetFont( aPrinterPS[1], aFont[1] ) GraSetFont( aPrinterPS[2], aFont[2] ) GraStringAt( aPrinterPS[1], {nSpaG, nZeiG}, cText ) aTextbox := GraQueryTextBox( aPrinterPS[2], cText ) aPenPos := AClone(aTextbox[5]) //? aPenPos[1] := aPenPos[1]/oFontH:width*nPpSG //? aPenPos[2] := aPenPos[2]/oFontH:height*nPpZG aPoSZ[2] := Int( ( aPaper[6] - aPaper[4] - nPoffY - nZeiG - aPenPos[2] ) / nPpZG ) aPoSZ[1] := Round( ( nSpaG + aPenPos[1] - nPoffX - aPaper[3] ) / nPpSG,0 ) RETURN aPenPos FUNCTION RepDruck1G( aRep, cNa, cArea, cCP, nt, cRAV, aPrinterPS, aFont, aPaper, aPoSZ, ; aSchrift, aBlatt, aSegments, nSegment ) LOCAL nOldArea := Select(), nRec, k, nZeiold, nSpaold LOCAL cSeite, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, cF LOCAL nSumme := 0 , nZeile := -1 lFremd := .F. // PRIVATE der vorigen Ebene nMSum := 0 cAuf := Str( (1->auftrnr),6,0 ) SELECT &cArea nRec := RecNo() //****** IF Val( cArea ) < 10 FIND &cAuf // wenn Index ELSE GO TOP // wenn kein Index (bei TEMP-Dateien:Vers/Rng/Aufst) ENDIF DO WHILE auftrnr = Val(cAuf) .AND. .NOT. Eof() IF Upper( cRAV ) == "R" lFremd := IIf( kennz = "2" .AND. nt=Val(rn), .T., lFremd ) // beim 1.Durchlauf setzen! IF cNA <> kennz .OR. nt <> Val( rn ) SKIP LOOP ENDIF nMSum := nMSum + IIf( mwst_schl="3", ; &b_g/(100+zschl_voll)*zschl_voll, 0 ) ENDIF IF Upper( cRAV ) == "A" IF Upper( rn ) == "A" SKIP LOOP ENDIF ENDIF IF cDrucker = "HP" ELSE SetPrc( PRow()+1, 0 ) ENDIF FOR k := 1 to Len( aRep ) aBlattZ := aRep[k] 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] IF cBereich = "v" cF := &cFeld ELSE cF := ((&cBereich)->(&cFeld)) ENDIF // wenn cF leer ist -> keine Bewegung von Zeile/Spalte: aPoSZ[2] := IIf( !Empty( cF ) .OR. (Empty(nFFont) .AND. Empty(nTFont)), ; IIf( aBlattZ[9]<1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ), ; aPoSZ[2] ) aPoSZ[1] := IIf( !Empty( cF ) .OR. (Empty(nFFont) .AND. Empty(nTFont)), ; IIf( aBlattZ[10]<1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ), ; aPoSZ[1]+1 ) IF cNa = "1" .AND. aPoSZ[2] > Val( cZeimax ) nZeiOld := aPoSZ[2] nSpaOld := aPoSZ[1] aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := 50 FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; "Zwischensumme "+ Str( nSumme,8,2 ), 1, aSchrift ) // &nA->(DbSuspendNotifications()) // &nA->(DbLocate( {|| &nA->seite = "2" } )) Kopf2( oPrinterPS, oFont, aSchrift, aBlatt, aSegments, @nSegment ) ///////////////////// // &nA->(DBResumeNotifications()) aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := 50 FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; "šbertrag "+ Str( nSumme,8,2 ), 1, aSchrift ) aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := nSpaOld // cZeimax := "70" ENDIF DO CASE CASE Valtype( cF ) == "C" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cF ), nFFont, aSchrift ), ) CASE Valtype( cF ) == "N" IF cF <> 0 .AND. ( Upper( cRAV ) = "R" .OR. Upper( cRAV ) = "V" ) IF Upper( AppName() ) = "DOENNEX.EXE" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( cF, cPicture ) ), nFFont, aSchrift ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( cF,8,2 ) ), nFFont, aSchrift ), ) ENDIF ENDIF nSumme := nSumme + cF CASE Valtype( cF ) == "D" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( cF ), nFFont, aSchrift ), ) ENDCASE NEXT SKIP ENDDO GO nRec //******** SELECT &nOldArea RETURN nSumme PROCEDURE Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, nSegment ) LOCAL cFK, nFFont, nTFont, cText, cFeld, cBereich, ccFeld LOCAL aBlattZ, cSeite, cNa, cPrompt aPoSZ[2] := 0 FOR i := 1 to Len( aBlatt ) aBlattZ := aBlatt[i] cSeite := aBlattZ[1] IF cSeite != "2" LOOP ENDIF cNa := aBlattZ[2] cPrompt := aBlattZ[3] cText := aBlattZ[4] nTFont := aBlattZ[5] cBereich := aBlattZ[6] cFeld := aBlattZ[7] nFFont := aBlattZ[8] //////// IF (cSeite == "2" .AND. cZweiSeitjn != "2") .OR. Upper( cSeite ) == "R" .OR. Upper( cSeite ) == "V" ////////// nZei und nSpa bleiben unver„ndert, wenn Artikel/Versicherungszeilen bzw. (2.Seitenkopf bei einseitig) //////// ELSE aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ) aPoSZ[1] := IIf( aBlattZ[10]<1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ) //////// ENDIF IF Upper( cNa ) = "Z" IF !Empty(oFont) aPrinterPS[1]:device():newPage() ++nSeitNr ELSE GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1] ) ++nSeitNr ENDIF LOOP ENDIF // IF cBereich = "v" // cFK := &cFeld // ELSEIF Val(cBereich)>0 // cFK := ((&cBereich)->(&cFeld)) // ELSE // cFK := NIL // ENDIF // // cFeld := cFK IF cFeld <> NIL IF Upper( AppName() ) = "DOENNEX.EXE" ccFeld := IIf( Valtype( cFeld ) == "C", ; IIf( cFeld="&", ; IIf( Valtype( &(substr( cFeld,2,len(cFeld)-1 )))=="N", ; Transform( &(substr( cFeld,2,len(cFeld)-1 )), cPicture ), ; &(substr( cFeld,2,len(cFeld)-1 )) ), ; cFeld ), cFeld ) ELSE ccFeld := IIf( Valtype( cFeld ) == "C", ; IIf( cFeld="&", ; IIf( Valtype( &(substr( cFeld,2,len(cFeld)-1 )))=="N", ; Str( &(substr( cFeld,2,len(cFeld)-1 )),8,2 ), ; &(substr( cFeld,2,len(cFeld)-1 )) ), ; cFeld ), cFeld ) ENDIF DO CASE CASE Valtype( ccFeld ) == "C" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( ccFeld ), nFFont, aSchrift ), ) CASE Valtype( ccFeld ) == "N" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift ), ) IF Upper( AppName() ) = "DOENNEX.EXE" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( ccFeld, cPicture ) ), &nA->FFont, aSchrift ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( ccFeld,8,2 ) ), nFFont, aSchrift ), ) ENDIF CASE Valtype( ccFeld ) == "D" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( ccFeld ), nFFont, aSchrift ), ) CASE ccFeld == NIL // es soll sich nichts bewegen, wenn nichts zu drucken nZei := IIf( nZeile<1, nZei+nZeile, nZei ) ENDCASE ELSE IIf( nTFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift ), ) ENDIF NEXT RETURN FUNCTION MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, cString, nTFont, aSchrift ) LOCAL nSpaS := aPoSZ[1], cLine, i cString := HardCR( cString ) FOR i := 1 TO MlCount(cString) cLine := MemoLine( cString,60, i ) ++aPoSZ[2]; aPoSZ[1] := nSpaS FdrG( aPrinterPS, aFont, aPaper, aPoSZ, Trim( cLine ), nTFont, aSchrift ) NEXT RETURN "." //------------------------------------------ PROCEDURE Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP, aSegments, nSegment ) LOCAL aBlattZ := {}, i, aRep := {} LOCAL cSeite, cNa, cPrompt, cText, nTFont, cBereich, cFeld, nFFont PRIVATE cB, cF, xF, nSeitNr := 1 PRIVATE nMSum := nGS := nS1 := nS2 := nS3 := nS4 := nS5 := 0, nF := xFaktor PRIVATE nGSA := nGSN := nGRSA := nGRS := nSv := 0 PRIVATE nMSumh := nGSh := nS1h := nS2h := nS3h := nS4h := nS5h := 0, nF := xFaktor PRIVATE nGSAh := nGSNh := nGRSAh := nGRSh := nSvh := 0 PRIVATE cX := "i", nSeitNr := 1 FOR i := 11 TO 30 &("i"+Str(i,2,0)) := "0" NEXT PRIVATE nISum := 0, cISum := "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 := aBlattZ[5] cBereich := aBlattZ[6] cFeld := IIf( cCP="A" .AND. ValType( aBlattZ[7] ) = "C", ; ConvToAnsiCP( aBlattZ[7] ), aBlattZ[7] ) // Feldinhalt nFFont := aBlattZ[8] IF (cSeite == "2" .AND. cZweiSeitjn != "2") .OR. Upper( cSeite ) == "R" .OR. Upper( cSeite ) == "V" // nZei und nSpa bleiben unver„ndert, wenn Artikel/Versicherungszeilen bzw. (2.Seitenkopf bei einseitig) ELSE aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ) aPoSZ[1] := IIf( aBlattZ[10]<1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ) ENDIF IF Upper( cSeite ) = "S" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1] ) ELSE aPrinterPS[1]:device():newPage() ENDIF ++nSeitNr DO WHILE ConfirmBox( oCB, "fertig?", ; "Formular umdrehen!", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_NO ENDDO ELSEIF Upper( cSeite ) = "B" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1] ) ELSE aPrinterPS[1]:device():newPage() ENDIF ++nSeitNr ELSEIF Upper( cSeite ) == "R" .OR. Upper( cSeite ) == "V" AAdd( aRep, aBlattZ ) ENDIF IF cSeite = "R" .OR. cSeite = "V" IF !(cNa = "2" .AND. !lFremd) nZwiSumme := Repdruck1G( aRep, cNa, AllTrim(cBereich), cCP, nt, cSeite, ; aPrinterPS, aFont, aPaper, aPoSZ,, aSchrift, aBlatt, aSegments, @nSegment ) &("nS"+cNa) := nZwiSumme ENDIF ASize( aRep, 0 ) ELSEIF Upper( cSeite ) == "M" MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, 1->notiz, nTFont, aSchrift ) ELSEIF Upper( cSeite ) <> "R" .AND. Upper( cSeite ) <> "V" IF cSeite<>"2" .OR. (cSeite="2" .AND. cZweiSeitjn="2") IF Upper( cNa ) = "Z" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1] ) ELSE aPrinterPS[1]:device():newPage() ENDIF ++nSeitNr LOOP ENDIF IF Upper( AppName() ) = "NOLTEX.EXE" nGS := Round(nS1+nS2+nS3+nS4,2) ELSE nGS := Round(nS1+nS2+nS3+nS4+nS5,2) ENDIF nGSA := Round(nS1+nS2-nS3,2) nGRS := Round(1->&r_b_0 + 1->&r_b_1 + 1->&r_b_2 + 1->&r_b_3,2) nGRSA := Round(nGRS-nS3,2) nGRSV := Round(nGRS-nSv,2) IF Upper( AppName() ) = "NOLTEX.EXE" nGSN := Round(1->&r_b_1 + 1->&r_b_n + nS2 - nSv,2) ENDIF IF xdmeu == "D" nGSh := Round(nGS/xFaktor,2) nGSAh:= Round(nGSA/xFaktor,2) nGRSh := Round(nGRS/xFaktor,2) nGRSAh:= Round(nGRSA/xFaktor,2) nGRSVh:= Round(nGRSV/xFaktor,2) IF Upper( AppName() ) = "NOLTEX.EXE" nGSNh := Round(nGSN/xFaktor,2) ENDIF nS1h := Round(nS1/xFaktor,2) nS2h := Round(nS2/xFaktor,2) nS3h := Round(nS3/xFaktor,2) ELSE nGSh := Round(nGS*xFaktor,2) nGSAh:= Round(nGSA*xFaktor,2) nGRSh := Round(nGRS*xFaktor,2) nGRSAh:= Round(nGRSA*xFaktor,2) nGRSVh:= Round(nGRSV*xFaktor,2) IF Upper( AppName() ) = "NOLTEX.EXE" nGSNh := Round(nGSN*xFaktor,2) ENDIF nS1h := Round(nS1*xFaktor,2) nS2h := Round(nS2*xFaktor,2) nS3h := Round(nS3*xFaktor,2) ENDIF IF cFeld <> NIL IF Upper( AppName() ) = "DOENNEX.EXE" cFeld := IIf( Valtype( cFeld ) == "C", ; IIf( cFeld="&", ; IIf( Valtype( &(substr( cFeld,2,len(cFeld)-1 )))=="N", ; Transform( &(substr( cFeld,2,len(cFeld)-1 )), cPicture ), ; &(substr( cFeld,2,len(cFeld)-1 )) ), ; cFeld ), cFeld ) ELSE cFeld := IIf( Valtype( cFeld ) == "C", ; IIf( cFeld="&", ; IIf( Valtype( &(substr( cFeld,2,len(cFeld)-1 )))=="N", ; Str( &(substr( cFeld,2,len(cFeld)-1 )),8,2 ), ; &(substr( cFeld,2,len(cFeld)-1 )) ), ; cFeld ), cFeld ) ENDIF DO CASE CASE Valtype( cFeld ) == "C" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, .T. ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cFeld ), nFFont, aSchrift, .T. ), ) CASE Valtype( cFeld ) == "N" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, .T. ), ) IF Upper( AppName() ) = "DOENNEX.EXE" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( cFeld, cPicture ) ), nFFont, aSchrift, .T. ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( cFeld,8,2 ) ), nFFont, aSchrift, .T. ), ) ENDIF CASE Valtype( cFeld ) == "D" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, .T. ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( cFeld ), nFFont, aSchrift, .T. ), ) CASE cFeld == NIL // es soll sich nichts bewegen, wenn nichts zu drucken aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]+aBlattZ[9], aPoSZ[2] ) ENDCASE ELSE IIf( nTFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, .T. ), ) ENDIF ENDIF ENDIF NEXT RETURN