// BLATTDRVG.prg - gibt eine Druckseite (mit Vorschau) aus // BlattDRG() heiát die Funktion aus historischen Grnden (Button-Activates) // 06.11.2005 Auftrnr statt 6 jetzt 7-stellig bei MengX // 06.11.2005: E ersetzt 6: aus StrX(1->auftrnr,6,0) wird StrX(1->auftrnr,E,0) #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Common.ch" ** // 3.5.2004 : nOrientierung = 1 (Portrait) oder = 2 (Landscape): FUNCTION BlattDRG( cDatei, cTitle, oDlg1, nXsize, nYsize, cLPTSCR_Loc, cCP, nAnzahl, nt, nOrientierung ) LOCAL oPrinterPS, oFont, oBitMap, aBitSize, aBitRect, nRec LOCAL nOldArea := Select(), cKommaOld := cKomma LOCAL aSchrift := {}, aBlattG := {}, aBlattZ := {}, i, aParamG := {} LOCAL cSeite, cNa, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, aRep := {} LOCAL c, aDateien := {"bl_v","bl_r","bl_ra","bl_vr","bl_vr1","bl_ru","bl_rh","bl_vrh", ; "bl_a","bl_a1", ; "bl_m","bl_m1","bl_m2","bl_m3","bl_m14","bl_m24","bl_m34",; "bl_firm","bl_rent","bl_ord", ; "bl_albr","bl_alb2","bl_hell","bl_krem"} // 05.04.2006 //LOCAL aSeite := {}, aNa := {}, aPrompt := {}, aText := {}, aTFont := {} //LOCAL aBereich := {}, aFeld := {}, aFFont := {}, aZei := {}, aSpa := {} PRIVATE cB, cF, cT, bT, nZei, nSpa //, nV := AppDesktop():currentSize()[1]/800 PRIVATE nMSum := nGS := nS1 := nS2 := nS3 := nS4 := nS5 := 0, nF := xFaktor PRIVATE nS10 := nS11 := nS12 := nS13 := nS20 := nS21 := nS22 := nS23 := 0 PRIVATE nGSA := nGSN := nGRSA := nGRS := nSv := 0 PRIVATE nMSumh := nGSh := nS1h := nS2h := nS3h := nS4h := nS5h := 0 PRIVATE nGSAh := nGSNh := nGRSAh := nGRSh := nSvh := 0 PRIVATE aS := { 0, 0, 0, 0, 0 } PRIVATE cX := "i", cDummyZ //10.12.2006 11:48 nOrientierung := IIf( nOrientierung = 2, 2, 1 ) // 1 = Portrait = default // 3.5.2004 FOR i := 11 TO 30 // Dummy-Variablen fr Berechnungen in Formularen &("i"+Str(i,2,0)) := "0" NEXT FOR i := 11 TO 30 // Dummy-Variablen fr Berechnungen in Formularen &("ci"+Str(i,2,0)) := "0" NEXT PRIVATE nISum := 0, cISum := "0", nAnz := 1 PRIVATE cNt := "0", cAnz := "1" , cMwstjn := "n" , cHgwjn := "n", cZweiseitjn := "a" //a=automat. PRIVATE cEigen := "n", lFremd := .F., nLetzteZeile := 0, hDA := DtoC(DATE()) PRIVATE cAuf := StrX( (1->auftrnr),E,0 ) //PRIVATE cPoffY := "0", cPoffX := "0", cPpZ := "0", cPpS := "0", cZeiMax := "65" PRIVATE cZeiMax := "65", cZwiSpalte := "50" PRIVATE nA, cBriefKopf := "n", cZwiSaldo := "n" PRIVATE cZwi := "Im Rechnungsbetrag ist die gesetzliche Mehrwertsteuer" PRIVATE aSeitZ := {}, cBK1, cBK2, hA1, hA2, hA3, hA4, hA5, hAN0, hAN1, hAN11, hAN2, hAN3, hAN4 PRIVATE cSp //11.07.2006 10:21 PRIVATE cDru := cDatei //16.09.2006 10:56 Dateiname der Druckdatei, zB. bl_brq2 PRIVATE cDummyNr := 0 // IF "W"$cBU2 .AND. !"BLEINX"$Upper(AppName()) // PRIVATE xDemo // FErase( cDatver+"md.fbd" ) // ENDIF // IF "BLEINX"$Upper(AppName()) .AND. !FILE( cDatver+"bd.fbd" ) // cZiel := SubStr(cNetver2,1,Len(cNetver2)-1) // COPY FILE (cNetver+"bd.fbd") TO (cNetver2+"bd.fbd") // PRIVATE xDemo // ENDIF // IF "BLEINX"$Upper(AppName()) .AND. !FILE( cDatver+"bd.fbd" ) // PRIVATE xDemo // ENDIF cLPTSCR := IIf( !Empty(cLPTSCR_Loc), cLPTSCR_Loc, "P" ) c := cZoom // 04.04.2006 IF AScan( aDateien, {|x| Upper(x)=Upper(cDatei) } ) = 0 // 05.04.2006 cZoom := "{1,0,0}" ENDIF DbSuspendNotifications() IF Empty(cDruckerName) // 10.04.2006 cDruckerName := DruckerWahl() ENDIF SELECT 20 USE Drubef IF "EPSON"$Upper(cDruckerName) // 10.04.2006 GO 2 ELSE GO BOTTOM ENDIF //IF RecNo() == 1 // DbAppend() //ELSE // DbRLock( RecNo() ) //ENDIF IF (Upper( cDrucker ) = "HP" .OR. "MI"$Upper(cDruckerName)) ; .AND. !"EPSON"$Upper(cDruckerName) //29.04.2006 17:05 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" ) IF 1->(IsFieldVar("perskz")) .AND. !("MENG"$Upper(AppName()).AND.cSystem="S") //Upper(AppName())$"MUELLX.EXE-AX.EXE-BX.EXE" // 8.2.2005 // Experiment, damit der Aufbau aus bl_.tak statt aus bl_*.dbf erfolgt: DbUseArea( ,"SDFNTX", "bl_.tak", "bv", .T. ) // bereits in Area 20 OrdListAdd("xBlFName") // 9.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei+"p"),8) ) DbGotop() ELSEIF cSystem="S" .AND. "MENG"$Upper(AppName()) // 12.11.2005 MengX mit s-t-a DbUseArea( ,"SDFNTX", "C"+SubStr(cDatver,2)+"bl_.tak", "bv", .T. ) // bereits in Area 20 // OrdListAdd("xBlFName") // 9.2.2005: weil schon in ineux geindext OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei+"p"),8) ) DbGotop() ELSE USE &(cDatei+"p") // die bisherige Originalzeile // 8.2.2005 ENDIF 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 IF 20->Text[1]=="&" .AND. Empty(20->tfont) //23.07.2006 19:24 // 16.4.2005 cT := Trim(SubStr(20->Text,2)) cT := &cT IF ValType(cT)=="C" .AND. "{|"$cT bT := &cT cText := Eval(bT) ELSE cText := cT ENDIF ELSE cText := Trim(20->text) ENDIF // cText := IIf( 20->Text="&", IIf(ValType(&(SubStr( 20->text, 2)))=="B",Eval(&SubStr( 20->text, 2)), ; // &(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 ) cF := cFeld // PRIVATE Variable als Parameter fr das Blatt &cF := IIf(cText="&",&(SubStr(cText,2)),cText) //23.07.2006 19:24 ENDIF AAdd( aParamG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }) //, RecNo() ) // 8.2.2005 skip ENDDO ENDIF //System-Variable entweder Standardwert oder Wert aus aParamG : nt := Val( cNt ) nAnz := IIf( Val(cAnz)!=0, Val( cAnz ), IIf(nAnzahl!=NIL,nAnzahl,0) ) //////// 10.12.2005: nPoffX/Y ergeben sich aus Val(cPoffX/Y) sp„ter in FDrG() (k”nnte geremt werden!?): //////nPoffX := IIf( Val( cPoffX )!=0, Val( cPoffX ), IIf(nPoffX!=NIL,nPoffX,0) ) //////nPoffY := IIf( Val( cPoffY )!=0, Val( cPoffY ), IIf(nPoffY!=NIL,nPoffY,0) ) //////// Bemerkung vom 10.12.2005: nPpS/Z bzw. cPpS/Z sind absolut, also entweder/oder nicht plus! //////nPpS := IIf( Val( cPpS )!=0, Val( cPpS ), IIf(nPpS!=NIL,nPpS,0) ) //////nPpZ := IIf( Val( cPpZ )!=0, Val( cPpZ ), IIf(nPpZ!=NIL,nPpZ,0) ) // IF cBriefKopf[1] == "_" // 12.6.2005 (fr Hanel) // aBlattG := Formular( aBlattG, SubStr(cBriefKopf,2) ) // druckt bl_fbk zus„tzlich aus // ELSEIF cBriefKopf[1] == "j" .AND. !Upper(AppName())$"AX.EXE-KREMERX.EXE" // j bedeutet: l„dt bl_fbk // aBlattG := Formular( aBlattG, "bl_fbk" ) // aber druckt nur bei "_" // cBriefKopf := "n" // ENDIF // 10.12.2006 18:05 damit PRIVATEs erkl„rt werden k”nnen cFBK := IIf(cBriefKopf[1]=="_", SubStr(cBriefKopf,2), IIf( ; cBriefKopf[1] == "j" .AND. !Upper(AppName())$"AX.EXE-KREMERX.EXE", "bl_fbk","" )) IF !Empty(cDatei) IF 1->(IsFieldVar("perskz")) //(Upper(AppName())$"MUELLX.EXE-AX.EXE-BX.EXE" // 8.2.2005 // Experiment, damit der Aufbau aus bl_.tak statt aus bl_*.dbf erfolgt: DbUseArea( ,"SDFNTX", "bl_.tak", "bv", .T. ) // bereits in Area 20 OrdListAdd("xBlFName") // 8.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cFBK),8) ) DbGotop() ELSE USE &cFBK // die bisherige Originalzeile // 8.2.2005 ENDIF 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 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 == "!" .AND. At(":=",cFeld) > 0 // 10.12.2006 17:49 Gleichung aufl”sen: cF := SubStr(cFeld,1,At(":=",cFeld)-1) IF !Empty(cF) .AND. cF != "IIf" PRIVATE &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Variable definieren // cText := cFeld // cNA := "v" ENDIF ENDIF AAdd( aBlattG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }) //10.12.2006 08:49 SKIP ENDDO DbCloseArea() ENDIF IF 1->(IsFieldVar("perskz")) .AND. !("MENG"$Upper(AppName()).AND.cSystem="S") //Upper(AppName())$"MUELLX.EXE-AX.EXE-BX.EXE" // 8.2.2005 // damit der Aufbau aus bl_.tak statt aus bl_*.dbf erfolgt: DbUseArea( ,"SDFNTX", "bl_.tak", "bv", .T. ) // bereits in Area 20 OrdListAdd("xBlFName") // 8.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei),8) ) DbGotop() ELSEIF "RUDOX"$Upper(AppName()) //19.11.2006 14:55 // damit der Aufbau aus bl_.tak statt aus bl_*.dbf erfolgt: DbUseArea( ,"SDFNTX", "bl_.tak", "bv", .T. ) // bereits in Area 20 OrdListAdd("xBlFName") // 8.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei),8) ) DbGotop() ELSEIF cSystem="S" .AND. "MENG"$Upper(AppName()) // 12.11.2005 MengX mit s-t-a DbUseArea( ,"SDFNTX", "C:\HDBE\bl_.tak", "bv", .T. ) // bereits in Area 20 // OrdListAdd("xBlFName") // 9.2.2005: weil schon in ineux geindext OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei),8) ) DbGotop() ELSE USE &cDatei // die bisherige Originalzeile // 8.2.2005 ENDIF 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 IF cFeld = "#" // speziell fr bl_grue cFeld := SubStr(cFeld,2) ELSE 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 := "" ************* //// IF cSeite != "=" cFeld := IIf( !":="$cF,"", SubStr( cF,1,At(":=",cF)-1) ) // =Name der Variablen //// ELSE //// cFeld := cF // damit der in cFeld enthaltene Ausdruck erhalten wird //// ENDIF ************* ENDIF // 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 ELSEIF cNA = "x" // fhrt eine Funktion wie z.B. DbSeek() aus //":="$cFeld cF := cFeld IF !Empty(&(cF)) //Variableninhalt (Empty(&(cF)) fhrt den Ausdruck cFeld aus) cFeld := SubStr(cFeld,1,At(":=",cFeld)-1) ENDIF ELSEIF cNA = "X" // fhrt eine Funktion wie z.B. DbSeek() aus cF := cFeld &(cF) //Variableninhalt &(cF) fhrt den Ausdruck cFeld aus) ELSEIF cNA = "!" // 18.04.2006 belegt Variable vor dem ':=' mit String danach cF := SubStr(cFeld,1,At(":=",cFeld)-1) IF !Empty(cF) .AND. cF != "IIf" &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Gleichung aufl”sen ELSE ENDIF cNA := "v" cText := cFeld // Ausdruck konservieren fr oVorschau:Update() ELSEIF cNA = "M" .AND. cText = "!" // 13.07.2006 22:05 belegt Variable vor dem ':=' mit String danach cF := SubStr(cFeld,1,At(":=",cFeld)-1) IF !Empty(cF) .AND. cF != "IIf" &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Gleichung aufl”sen ELSE ENDIF cText := cFeld // Ausdruck konservieren fr oVorschau:Update() // ELSEIF At(":=",cFeld) > 0 // 10.12.2006 17:49 // cF := SubStr(cFeld,1,At(":=",cFeld)-1) // IF !Empty(cF) .AND. cF != "IIf" // PRIVATE &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Gleichung aufl”sen, Variable definieren // ENDIF ENDIF AAdd( aBlattG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }) //, RecNo() ) // 8.2.2005 SKIP ENDDO ////// IF cBriefKopf[1] == "_" // 12.6.2005 (fr Hanel) ////// aBlattG := Formular( aBlattG, SubStr(cBriefKopf,2) ) // druckt bl_fbk zus„tzlich aus ////// ELSEIF cBriefKopf[1] == "j" // j bedeutet: l„dt bl_fbk ////// aBlattG := Formular( aBlattG, "bl_fbk" ) // aber druckt nur bei "_" ////// cBriefKopf := "n" ////// ENDIF 20->(DbCloseArea()) // 8.2.2005 vor Preview gezogen SELECT &nOldArea // 8.2.2005 ////////////////////////////////////////////////////////////// BPreview( aBlattG, oDlg1, cCP, aSchrift, aParamG, nOrientierung ) // 3.5.2004 cZoom := c // 04.04.2006 IF Empty( aBlattG ) // // 20->(DbCloseArea()) // SELECT &nOldArea // fr alle F„lle cKomma := cKommaOld (nOldArea)->(DbResumeNotifications()) // cLPTSCR := "S" // RETURN NIL // ENDIF // IF Upper(AppName())$"HANELX.EXE-RAGUSEX.EXE-SONNEX.EXE-BUCKX.EXE-FLUESX.EXE" nGS := 0 ELSE nGS := BlattDruck( aBlattG, oDlg1, cCP, aSchrift, nOrientierung ) // 3.5.2004 ENDIF // 20->(DbCloseArea()) ////////////////////////////////////////////////////////////// SELECT &nOldArea // fr alle F„lle cKomma := cKommaOld DbResumeNotifications() cLPTSCR := "S" RETURN nGS FUNCTION ISumme() nISum := 0 FOR i := 11 TO 30 // Summe der Dummy-Variablen fr Berechnungen in Formularen nISum := nISum + Val( &("i"+Str(i,2,0)) ) NEXT RETURN Str( nISum,8,2 ) FUNCTION cISumme() nISum := 0 FOR i := 11 TO 30 // Summe der Dummy-Variablen fr Berechnungen in Formularen nISum := nISum + Val( &("ci"+Str(i,2,0)) ) NEXT RETURN Str( nISum,8,2 ) FUNCTION Vorschau_Ausgabe( oPrinterPS, aSegments, aBlatt, cCP, aSchrift, nOrientierung ) LOCAL dummy2 := GraSegDrawMode( oPrinterPS, GRA_DM_RETAIN ) LOCAL nSegment := GraSegOpen( oPrinterPS ) LOCAL aPrinterPS := { oPrinterPS, PrinterPS(cDruckerName,nOrientierung) } //; LOCAL aPaper := aPrinterPS[2]:DEVICE():paperSize() , aPoSZ := {0,0} LOCAL aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } LOCAL i := 0, j := 0 aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") ASize( aSegments, 0 ) // fr BitMap-Druck siehe XbpPreview:printpage() Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP, aSegments, @nSegment ) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) // aSeitZ[1]=len(aSegments) / aSeitZ[2]=aPoSZ / aSeitZ[3]=TEXT / aSeitZ[4]=FONT : IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FOR i := 1 TO j := aSeitZ[1] // aSeitZ[1] = Anzahl Segmente GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE, aSegments[i] ) FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift ) GraSegClose( aPrinterPS[1] ) NEXT ENDIF GraSegDrawMode( oPrinterPS, GRA_DM_DRAWANDRETAIN ) RETURN aSegments // aktiv, wenn in der Vorschau "ENDE+Druck" angew„hlt wird: FUNCTION BlattDruck( aBlatt, oDlg1, cCP, aSchrift, nOrientierung ) // 3.5.2004 LOCAL oBitMap, aBitSize, aBitRect, nRec, i LOCAL aPrinterPS := { PrinterPS(cDruckerName, nOrientierung), PrinterPS(cDruckerName,nOrientierung) } //; LOCAL aPaper := aPrinterPS[2]:DEVICE():paperSize() , aPoSZ := {0,0} LOCAL aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } PRIVATE xR // damit nur beim "Ende+Druck" ggf. eine neue Rechnugnsnr vergeben wird PRIVATE xD // damit nur beim "Ende+Druck" ggf. das Rg-Datum gespeichert wird (ttmm) nAnz := IIf( !Empty(cAnz), Val( cAnz ), nAnzahl ) aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") cBriefKopf := IIf( Len( cBriefKopf ) > 100, cBriefKopf, Trim(cBriefKopf) ) // vorsichtshalber wg Grafik IF Len(cBriefKopf)>100 .OR. (cBriefKopf != "n" .AND. cBriefKopf != "_") //22.07.2006 17:34 IF Len(cBriefkopf)>100 .AND. Len("oEdit:TxBd11")>100 // 23.07.2006 18:03 cBriefkopf := oEdit:TxBd11 // ist reserviert fr Briefpapier ELSE cBriefkopf := IIf( cBriefkopf="&",&(SubStr(cBriefkopf,2)),cBriefkopf) cBriefkopf := IIf("."$cBriefkopf,Trim(cBriefkopf),Trim(cBriefkopf)+".BMP") ENDIF // cBriefkopf := IIf("."$cBriefKopf,cBriefKopf,cBriefKopf+".BMP") oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := aPrinterPS[1]:device():paperSize() aBitRect := { 0, 0, aBitSize[5]-aBitSize[3], aBitSize[6]-aBitSize[4] } ////// aBitRect := { 0, 0, aBitSize[1], aBitSize[2] } IF Len(cBriefKopf)>100 //22.07.2006 11:47 >50 heiát:in cGrafik ist die Grafik oBitmap:setbuffer( cBriefKopf ) // Bitmap laden ELSE //22.07.2006 11:47 <50 heiát:in cGrafik ist der GrafikdateiName oBitmap:loadFile( cBriefKopf ) // Bitmap laden ENDIF // oBitmap:loadFile( cBriefKopf ) // Bitmap laden ENDIF aPrinterPS[1]:device():startdoc() DO WHILE --nAnz >= 0 IF Len(cBriefKopf)>100 .OR. (cBriefKopf != "n" .AND. cLPTSCR != "B") //22.07.2006 17:37 oBitmap:draw( aPrinterPS[1], aBitRect ) ENDIF IF "TEST"$Upper(AppName()) .OR. IsMemVar("xDemo") // Eindruck des Schriftzugs "DEMO" IF Empty(oBitmap) oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := aPrinterPS[1]:device():paperSize() ////// aBitRect := { 0, 0, aBitSize[1], aBitSize[2] } aBitRect := { 0, 0, aBitSize[5]-aBitSize[3], aBitSize[6]-aBitSize[4] } ENDIF oBitmap:load( , 1020 ) // aus der RES-Datei oBitmap:draw( aPrinterPS[1], aBitRect ) ENDIF IF nAnz=0 .AND. IsMemVar("xKopie") // Eindruck des Schriftzugs "KOPIE" IF Empty(oBitmap) oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := aPrinterPS[1]:device():paperSize() // aBitRect := { 0, 0, aBitSize[1], aBitSize[2] } aBitRect := { 800, 800, 200, 100 } ENDIF oBitmap:load( , 1035 ) // aus der RES-Datei oBitmap:draw( aPrinterPS[1], aBitRect ) ENDIF Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP ) // aSeitZ[1]=len(aSegments) / aSeitZ[2]=aPoSZ / aSeitZ[3]=TEXT / aSeitZ[4]=FONT : IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift ) ENDIF IF nAnz > 0 aPrinterPS[1]:device():newPage() ENDIF ENDDO aPrinterPS[1]:device():endDoc() DestroyDevice( aPrinterPS[1] ) DestroyDevice( aPrinterPS[2] ) IF Len(cBriefKopf)>100 .OR. (cBriefKopf != "n" .AND. cBriefKopf != "_") // 12.6.2005 oBitmap:destroy() ENDIF // USE // geremt am 8.2.2005 RETURN nGS FUNCTION PrinterPS( cPrinterObjectName, nOrientierung ) LOCAL oPS, oDC := XbpPrinter():New() oDC:create( cPrinterObjectName ) oDC:setorientation(nOrientierung) // 16.09.2005 zun„chst nur fr Nolte: cSchacht wird in Noltex.exe erkl„rt und in bl_rp gesetzt IIf(IsMemVar("cSchacht").AND.!Empty(cSchacht),oDC:setPaperBin(Val(cSchacht)),) 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, cAusR ) //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 := {} // LOCAL nPpSG := nPpS, nPpZG := nPpZ // 21.10.2003 wurde Drubef erg„nzt um cPp und cLPT: LOCAL nPpSG := IIf(IsMemVar("cPpS").AND.IsMemVar("nPpS"), IIf( !Empty( cPpS ), Val( cPpS ), nPpS ), 25 ) LOCAL nPpZG := IIf(IsMemVar("cPpZ").AND.IsMemVar("nPpZ"), IIf( !Empty( cPpZ ), Val( cPpZ ), nPpZ ), 42 ) ****************************************************************************** LOCAL aAttr := ARRAY( GRA_AS_COUNT ) LOCAL aOldAttr, nOldPoffX := nPoffX, nOldPoffy := nPoffY //29.04.2006 17:51 Drubef-Wert retten PRIVATE nZeiG, nSpaG //////////// IF !IsMemVar("XXXak") // 11/2004 : soll den Aufbau verkrzen (siehe BPreviewP) //////////// RETURN aPenPos //////////// ENDIF //////#define GRA_HALIGN_LEFT 0 // Auszug aus gra.ch //////#define GRA_HALIGN_CENTER 6 //////#define GRA_HALIGN_RIGHT 2 IF ValType(cAttrib) == "C" .AND. cAttrib != "{{},}" .AND. ValType(&cAttrib)=="A" //21.10.2006 09:56 aAttr[GRA_AS_COLOR] := GraMakeRGBColor(&cAttrib[1]) aAttr[GRA_AS_EXTRA] := &cAttrib[2] ENDIF aAttr[GRA_AS_HORIZALIGN] := GRA_HALIGN_LEFT IF !Empty(cAusR) .AND. cAusR[1] $ ">^" aAttr[GRA_AS_HORIZALIGN] := IIf(cAusR[1]=="^",GRA_HALIGN_CENTER,GRA_HALIGN_RIGHT) ENDIF IF !Empty(cText) .AND. cText[1] $ ">^" aAttr[GRA_AS_HORIZALIGN] := IIf(cText[1]=="^",GRA_HALIGN_CENTER,GRA_HALIGN_RIGHT) cText := SubStr(cText,2) ENDIF aOldAttr := GraSetAttrString( aPrinterPS[1], aAttr ) ****************************************************************************** // 10.12.2005: nPoffX/Y ergeben sich aus Val(cPoffX/Y), wenn in bl_*p gesetzt: nPoffX := IIf( Val( cPoffX )!=0 .OR. cPoffX="0", Val( cPoffX ), nPoffX ) // nPoffX+Y sind PUBLIC nPoffY := IIf( Val( cPoffY )!=0 .OR. cPoffY="0", Val( cPoffY ), nPoffY ) // 10.12.2005: "IIf( Val(" statt "!Empty(" aSettings := IIf(nFont>7,aSchArt,aSettings) // 26.9.2004 nFont := IIf(nFont>7,1,nFont) // 26.9.2004 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] < IIf(!Empty(cPpZ), 2970/Max(10,Val(cPpZ)),80) // 12.6.2005 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] ) IF Len(cText)>1 .AND. cText[1]$"|%_#" //15.06.2006 17:41 cText := cText[1]+IIf(cText[2]="&",&(SubStr(cText,3,Len(cText)-2)),SubStr(cText,2,Len(cText)-1)) ENDIF IF Len(cText)>1 .AND. cText[1] = "%" GraLine( aPrinterPS[1], {nSpaG, nZeiG+nPpZG/2}, {nSpaG+Val(SubStr(cText,2)), nZeiG+nPpZG/2} ) aPenPos := {0,0} ELSEIF Len(cText)>1 .AND. cText[1] = "_" GraLine( aPrinterPS[1], {nSpaG, nZeiG-10}, {nSpaG+Val(SubStr(cText,2)), nZeiG-10} ) aPenPos := {0,0} ELSEIF Len(cText)>1 .AND. cText[1] = "|" GraLine( aPrinterPS[1], {nSpaG+nPpSG/2, nZeiG+nPpZG}, {nSpaG+nPpSG/2, nZeiG+nPpZG-Val(SubStr(cText,2))} ) aPenPos := {0,0} ELSEIF Len(cText)>1 .AND. cText[1] = "#" // 11.10.2005 macht dickere Striche mit Boxen aBoxAttr := Array( GRA_AA_COUNT ) // =5 aBoxAttr[ GRA_AA_SYMBOL ] := GRA_SYM_DENSE1 GraSetAttrArea( aPrinterPS[1], aBoxAttr ) aBRO := &(SubStr(cText,2)) GraBox( aPrinterPS[1], {nSpaG:=0, nZeiG}, {nSpaG+aBRO[1], nZeiG+aBRO[2]}, GRA_OUTLINEFILL ) // 1=GRA_FILL aBoxAttr[ GRA_AA_SYMBOL ] := GRA_SYM_SOLID GraSetAttrArea( aPrinterPS[1], aBoxAttr ) aPenPos := {0,0} ELSE GraStringAt( aPrinterPS[1], {nSpaG, nZeiG}, cText ) aTextbox := GraQueryTextBox( aPrinterPS[2], cText ) aPenPos := AClone(aTextbox[5]) ENDIF //? 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[2] := Round( ( aPaper[6] - aPaper[4] - nPoffY - nZeiG - aPenPos[2] ) / nPpZG, 0 ) aPoSZ[1] := Round( ( nSpaG + aPenPos[1] - nPoffX - aPaper[3] ) / nPpSG,0 ) nPoffX := nOldPoffX //29.04.2006 17:51 zurck auf den Wert in Drubef.dbf nPoffY := nOldPoffY //29.04.2006 17:51 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, nZeile := -1 LOCAL cSeite, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, cF, cAusR // 7.7.2005 Ausrichtung PRIVATE nSumme := 0 // wird gebraucht fr VellX-Zwischensumme // 14.1.2005 PRIVATE nTeilSum := 0 // wird gebraucht fr VellX-Zwischensummen // 13.1.2005 PRIVATE cB, cFd // wegen Makros PRIVATE aZS := {} // wird gebraucht fr VellX-Zwischensummen // 14.1.2005 aS := { 0, 0, 0, 0, 0 } // PRIVATE aus der vorigen Ebene lFremd := .F. // PRIVATE der vorigen Ebene nMSum := 0 IF Upper(AppName()) == "AX.EXE" // 25.9.2004 rn := Str(nt,1,0) ENDIF cAuf := StrX( (1->auftrnr),E,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" // steht in cSeite (nicht in cNt!) lFremd := IIf( kennz = "2" .OR. kennz = "3" .AND. nt=Val(rn), .T., lFremd ) // beim 1.Durchlauf setzen! // 22.6.2004: wenn nt<0 (z.B. cNt in bl_ ="-1"), dann nahme alle Rg.- und NRg.-Werte IF cNA <> kennz .OR. ( nt <> Val( rn ) .AND. nt >= 0 ) 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] cAusR := IIf(!Empty(cPrompt).AND.cPrompt[1]$">^",cPrompt[1],"<") // 7.7.2005 Ausrichtung 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] cB := cBereich ; cFd := cFeld IF cBereich = "v" ////// IF "ZwiSu_EL"$cFD ////// aZS := { 13->kennzart, nSumme, nTeilSum, ; ////// aPrinterPS, aFont, aPaper, aPoSZ, nFFont, aSchrift } ////// ENDIF cF := &cFd ELSE cF := ((&cB)->(&cFd)) ENDIF // wenn cF leer ist -> keine Bewegung von Zeile/Spalte: IF Len(aRep)>1 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 ) ENDIF // IF cNa = "1" .AND. aPoSZ[2] > Val( cZeimax ) IF aPoSZ[2] > Val( cZeimax ) .AND. nSumme<>0 // 24.10.2005 // Test fr Hanel!!!!!!!!!!!!!!!!!!!!!! nZeiOld := aPoSZ[2] nSpaOld := aPoSZ[1] aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := IIf(Empty(cZwiSpalte),50,Val(cZwiSpalte)) // 29.1.04 FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; "Zwischensumme "+ Str( nSumme,8,2 ), 1, aSchrift ) // Betragspalte - 16 Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) ///////////////////// aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := IIf(Empty(cZwiSpalte),50,Val(cZwiSpalte)) // 29.1.04 FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; "šbertrag "+ Str( nSumme,8,2 ), 1, aSchrift ) aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := nSpaOld ENDIF DO CASE CASE Valtype( cF ) == "C" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cF ), nFFont, aSchrift, cAusR ), ) CASE Valtype( cF ) == "N" IF cF <> 0 .AND. ( Upper( cRAV ) = "R" .OR. Upper( cRAV ) = "V" ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( cF, cPicture ) ), nFFont, aSchrift, cAusR ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( cF,8,2 ) ), nFFont, aSchrift, cAusR ), ) ENDIF ENDIF /////////////////////////////////////////////////////////////////////////////////////// // Wenn in der Rechnung eine Trennung in 16/7% MwSt gefordert wird: // nSumme entsteht aus allen numerischen cFs, soll aber nur aus dem einen Preis entstehen, // daher drfen die "aS[]"-enthaltenden Felder nicht mitaddiert werden: nSumme := nSumme + IIf("aS["$cFeld,0,cF) //***************************** // diese 5 Zeilen sind in den EL-Teil der Rechnung einzufgen (als "r 1"-Zeilen, siehe Dischleid): // aS[1] := aS[1] + IIf( 13->mwst_schl="3", Round(cF/(1+zschl_voll/100),2), 0 ) // aS[2] := aS[2] + IIf( 13->mwst_schl="3", cF-Round(cF/(1+zschl_voll/100),2), 0 ) // aS[3] := aS[3] + IIf( 13->mwst_schl="2", Round(cF/(1+zschl_halb/100),2), 0 ) // aS[4] := aS[4] + IIf( 13->mwst_schl="2", cF-Round(cF/(1+zschl_halb/100),2), 0 ) // aS[5] := nSumme // aS[1]: Netto zu 16%, aS[2]: MwSt-Betrag zu 16%, aS[3]: Netto zu 7%, aS[4]: MwSt-Betrag zu 7% //////////////////////////////////////////////////////////////////////////////////////// CASE Valtype( cF ) == "D" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( cF ), nFFont, aSchrift, cAusR ), ) ENDCASE NEXT SKIP ENDDO GO nRec //******** SELECT &nOldArea RETURN nSumme FUNCTION ZwiSu_EL( ckennz ) // 14.1.2005 nur fr VellX.exe! LOCAL nGesSum := nSumme // Private der vorigen Ebene, darf nicht beeinflusst werden LOCAL nZwiSum := 0 // auszugebende Zwischensumme = nGesSum-nTeilsum(vorher) // in bl_r muá das Feld noch "aS[" als Dummy enthalten, damit nTeilSum nicht zu nSumme addiert wird ////// LOCAL ckennz:=aZS[1], nGesSum:=aZS[2], aPrinterPS:=aZS[4], aFont:=aZS[5], ; ////// aPaper:=aZS[6], aPoSZ:=aZS[7], nFFont:=aZS[8], aSchrift:=aZS[9] ////// nTeilSum:=aZS[3] // ckennz ist 13->kennzart der bisherigen Art // nGesSum ist das bisher aufgelaufene nS1, also nSumme // nTeilSum ist die bis zur letzten Zwischensumme aufgelaufene nS1, Private vorige Ebene // // Start mit ckennz = "0", nGesSum = 0 und nTeilSum = 0 // Artikel1 100,-- // hier wird ckennz = 13->kennzart gesetzt, nGesSum wird = 100 // Artikel2 150,-- // ckennz bleibt, nGesSum wird = 250 // Artikel3 50,-- // ckennz bleibt, nGesSum wird = 300 // z.B.: nach dem Druck von Artikel3 „ndert sich 13->kennzart // dann wird die Zwischensumme ausgegeben als nGesSum-nTeilSum, wenn != 0 // 300,-- // nTeilSum wird = nGesSum // Artikel4 60,-- // hier wird ckennz = 13->kennzart gesetzt, nGesSum wird = 360 // Artikel5 140,-- // ckennz bleibt, nGesSum wird = 500 // nach dem Druck von Artikel5 „ndert sich wieder 13->kennzart, oder die EL/FL-Gruppe ist zu Ende // => Zwischensumme IF nGesSum != nTeilSum .AND. nGesSum != 0 13->(DbSkip()) IF 13->kennzart != ckennz .OR. 13->(Eof()) 13->(DbSkip(-1)) ////// IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," ////// IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; ////// Trim( Transform( nGesSum-nTeilSum, cPicture ) ), nFFont, aSchrift ), ) ////// ELSE ////// IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; ////// Trim( Str( nGesSum-nTeilSum,8,2 ) ), nFFont, aSchrift ), ) ////// ENDIF nZwiSum := nGesSum - nTeilSum nTeilSum := nGesSum // da nTeilsum PRIVATE ist, „ndert es sich auch in der vorigen Ebene! ELSE 13->(DbSkip(-1)) ENDIF ENDIF RETURN IIf(nGesSum==nTeilSum, nZwiSum, 0 ) PROCEDURE Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, nSegment, cS ) LOCAL cFK, nFFont, nTFont, cText, cFeld, cBereich, ccFeld, i LOCAL aBlattZ, cSeite, cNa, cPrompt, cAusR // 7.7.2005 Ausrichtung LOCAL aBitSize, aBitRect, aSourceRect, cGrafik cS := IIf(Empty(cS),"2",cS) // 17.10.2005 cS="F" fr Firmenbriefkopf aPoSZ[2] := 0 FOR i := 1 to Len( aBlatt ) aBlattZ := aBlatt[i] cSeite := aBlattZ[1] IF cSeite != cS // 17.10.2005 LOOP ENDIF cNa := aBlattZ[2] cPrompt := aBlattZ[3] // cAusR := IIf(!Empty(cPrompt).AND.cPrompt[1]$">^",cPrompt[1],"<") // 7.7.2005 Ausrichtung cText := aBlattZ[4] nTFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[5] != 0, ; aBlattZ[5] := nStandardFont, aBlattZ[5] ) cBereich := aBlattZ[6] cFeld := aBlattZ[7] nFFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[8] != 0, ; aBlattZ[8] := nStandardFont, aBlattZ[8] ) aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ) aPoSZ[1] := IIf( aBlattZ[10]<1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ) IF Upper( cNa ) = "Z" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE ) ELSE IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift, cAusR ) ENDIF aPrinterPS[1]:device():newPage() // [1]! ENDIF ++nSeitNr // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> hier wird der Briefkopf eingefgt 17.10.2005 Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment, "F" ) ///////////////////// // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP ENDIF IF Upper( cNa ) = "G" // 17.10.2005 Grafik im Briefkopf IF ":"$cText //22.07.2006 11:45 in cText steht Membervariable cGrafik := IIf( cText="&",&(SubStr(cText,2)),&cText) ELSE cText := IIf( cText="&",&(SubStr(cText,2)),cText) // 17.09.2005 cGrafik := IIf("."$cText,Trim(cText),Trim(cText)+".BMP") ENDIF oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := &cFeld aBitRect := IIf( aBlattZ[10]<0 .AND. aBlattZ[9]<0, &cFeld, ; { aBlattZ[10], aBlattZ[9], aBitSize[1], aBitSize[2] } ) //17.09.2005 // aSourceRect := { aBlattZ[9]/2, aBlattZ[10]/2, aBitSize[1]*2, aBitSize[2]*2 } aSourceRect := { 0, 0, oBitmap:xSize, oBitmap:ySize } IF Len(cGrafik)>50 //22.07.2006 11:47 >50 heiát:in cGrafik ist die Grafik oBitmap:setbuffer( cGrafik ) // Bitmap laden ELSE //22.07.2006 11:47 <50 heiát:in cGrafik ist der GrafikdateiName oBitmap:loadFile( cGrafik ) // Bitmap laden ENDIF oBitmap:draw( aPrinterPS[1], aBitRect, aSourceRect ) LOOP ENDIF IF cFeld <> NIL IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," 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, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( ccFeld ), nFFont, aSchrift, cAusR ), ) CASE Valtype( ccFeld ) == "N" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( ccFeld, cPicture ) ), &nA->FFont, aSchrift, cAusR ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( ccFeld,8,2 ) ), nFFont, aSchrift, cAusR ), ) ENDIF CASE Valtype( ccFeld ) == "D" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( ccFeld ), nFFont, aSchrift, cAusR ), ) 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, cAusR ), ) ENDIF NEXT RETURN FUNCTION RepDruck2G( aRep, cNa, cArea, cCP, nt, cRAV, cBedingung, ; aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, nSegment ) LOCAL nOldArea := Select(), nRec, k, nZeiold, nSpaold LOCAL cSeite, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, cF, cAusR // 7.7.2005 Ausrichtung LOCAL nSumme := 0 , nZeile := -1, cHeute := "XX.XX." PRIVATE cB, cFd // wegen Makros PRIVATE cFilter := IIf(!Empty(cBedingung),cBedingung,"") // weil Makro PRIVATE braucht! nMSum := 0 ASize(aSum,Len(aRep)) AFill(aSum,0) cAuf := StrX( (1->auftrnr),E,0 ) SELECT &cArea nRec := RecNo() //****** DbSetFilter( {||&cFilter} ) DbGotop() DO WHILE !Eof() FOR k := 1 TO Len( aRep ) aBlattZ := aRep[k] cSeite := aBlattZ[1] cNa := aBlattZ[2] cPrompt := aBlattZ[3] cAusR := IIf(!Empty(cPrompt).AND.cPrompt[1]$">^",cPrompt[1],"<") // 7.7.2005 Ausrichtung 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 !cFeld[1]$"|%_" cB := cBereich ; cFd := cFeld IF cBereich = "v" IF cFd[1]="&" cFd := &(SubStr(cFd,2)) cF := &cFd ELSE cF := &cFd ENDIF ELSE IF cFd[1]="&" cFd := &(SubStr(cFd,2)) cF := &cB->&cFd ELSE cF := ((&cB)->(&cFd)) ENDIF ENDIF ELSE cF := cFeld[1]+IIf(cFeld[2]="&",&(SubStr(cFeld,3,Len(cFeld)-2)),SubStr(cFeld,2,Len(cFeld)-1)) 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 (cArea)->(IsFieldVar("datum")) // IF k=3 .AND. cHeute != cF .AND. cZwiSaldo = "j" // wenn anderes Datum als Vorzeile**** IF k=1 .AND. !cHeute$DtoC((cArea)->datum)+"XX.XX." .AND. Upper(cZwiSaldo) = "J" // wenn anderes Datum als Vorzeile**** nZeiOld := aPoSZ[2] + 1 nSpaOld := aPoSZ[1] Zwischen( aPrinterPS, aFont, aPaper, @aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) ///////////////////// aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := nSpaOld ENDIF // cHeute := IIf( k=3, cF, cHeute ) // demn„chst: das Datum der vorigen Zeile**** cHeute := IIf( "DtoC"$cFeld, cF, cHeute ) // demn„chst: das Datum der vorigen Zeile**** ENDIF // IF cNa = "1" .AND. aPoSZ[2] > Val( cZeimax ) IF aPoSZ[2] > Val( cZeimax ) // 10.09.2005 damit auch FL mehrseitig geht nZeiOld := aPoSZ[2] nSpaOld := aPoSZ[1] Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) ///////////////////// aPoSZ[2] := aPoSZ[2] + 2 aPoSZ[1] := nSpaOld ENDIF DO CASE CASE Valtype( cF ) == "C" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cF ), nFFont, aSchrift, cAusR ), ) aSum[k] = IIf( Val(cF)!=0, aSum[k]+Val(cF), aSum[k] ) CASE Valtype( cF ) == "N" IF cF <> 0 .AND. ; ( Upper( cRAV ) = "R" .OR. Upper( cRAV ) = "V" .OR. Upper( cRAV ) = "K" ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( cF, cPicture ) ), nFFont, aSchrift, cAusR ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( cF,8,2 ) ), nFFont, aSchrift, cAusR ), ) ENDIF ENDIF aSum[k] := aSum[k] + cF CASE Valtype( cF ) == "D" IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( cF ), nFFont, aSchrift, cAusR ), ) aSum[k] = "D" ENDCASE NEXT SKIP ENDDO DbClearFilter() GO nRec //******** SELECT &nOldArea RETURN aSum // wird fr RepDruck2 gebraucht (Statistik-Listings) PROCEDURE Zwischen( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, nSegment ) LOCAL cFK, nFFont, nTFont, cText, cFeld, cBereich, ccFeld, cAusR // 7.7.2005 Ausrichtung LOCAL aBlattZ, cSeite, cNa, cPrompt // aPoSZ[2] := 0 FOR i := 1 to Len( aBlatt ) aBlattZ := aBlatt[i] cSeite := aBlattZ[1] IF Upper(cSeite) != "Z" // ZETT LOOP ENDIF cNa := aBlattZ[2] cPrompt := aBlattZ[3] cAusR := IIf(!Empty(cPrompt).AND.cPrompt[1]$">^",cPrompt[1],"<") // 7.7.2005 Ausrichtung cText := aBlattZ[4] nTFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[5] != 0, ; aBlattZ[5] := nStandardFont, aBlattZ[5] ) cBereich := aBlattZ[6] cFeld := aBlattZ[7] nFFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[8] != 0, ; aBlattZ[8] := nStandardFont, aBlattZ[8] ) aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ) aPoSZ[1] := IIf( aBlattZ[10]<1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ) IF Upper( cNa ) = "Z" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE ) ELSE IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift, cAusR ) ENDIF aPrinterPS[1]:device():newPage() // [1]! ENDIF ++nSeitNr // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> hier wird der Briefkopf eingefgt, wenn fr Statistik gebraucht... LOOP ENDIF IF cFeld <> NIL IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," 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, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( ccFeld ), nFFont, aSchrift, cAusR ), ) CASE Valtype( ccFeld ) == "N" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( ccFeld, cPicture ) ), &nA->FFont, aSchrift, cAusR ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( ccFeld,8,2 ) ), nFFont, aSchrift, cAusR ), ) ENDIF CASE Valtype( ccFeld ) == "D" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( ccFeld ), nFFont, aSchrift, cAusR ), ) 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, cAusR ), ) ENDIF NEXT RETURN //////// alte Originalversion 19.12.2005 testweise fr SinzigX: //////FUNCTION MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, cString, nTFont, aSchrift, aSegments, nSegment, aBlatt, nZeiLen ) ////// LOCAL nSpaS := aPoSZ[1], cLine, i, nCRLF, nOldArea := SELECT(), j:=1 ////// LOCAL cTKurz := IIf( !Empty(nZeiLen), &("cTKurz" + Str((nZeiLen-Int(nZeiLen))*10,1)),"") ////// PRIVATE cZ ////// nZeiLen := IIf( Empty(nZeiLen), 65, Int(nZeiLen) ) ////// IIf( IsMemVar("nSeitnr"),nSNr := nSeitnr, nSnr := 1 ) ////// IF ValType(aBlatt)=="A" // 19.12.2005 ////// cString := HardCR( cString ) ////// ENDIF ////// DO WHILE ( nCRLF := RAt( CRLF+CRLF+CRLF, cString )) > 0 ////// cString := IIf( nCRLF>0, Left( cString, nCRLF-1 ), cString ) ////// ENDDO ////// cString := cString + CRLF ////// IF IsMemVar( "xR" ) ////// SELECT 27 ////// USE txdat EXCLUSIVE ////// SET INDEX TO xtx ////// 27->(DbSeek( cTKurz, .F. )) ////// IF 27->(Eof()) ////// 27->(DbAppend()) ////// 27->txname := cTKurz ////// ENDIF ////// 27->adrschl := StrX(1->auftrnr,E,0) ////// 27->n1 := hA1 ////// 27->n1 := hA2 +" "+ hA3 ////// 27->str := hA4 ////// 27->ort := hA5 ////// 27->datum := CtoD(hDA) ////// 27->betrz := hSF ////// 27->z1 := IIf(Empty(1->gkz),IIf(oBest:aBP[1]="Herr","Sehr geehrter Herr","Sehr geehrte Frau"),"") + ; ////// IIf(Empty(1->gkz)," "+Trim(oBest:aBP[3])+",","Sehr geehrte Damen und Herren,") ////// 27->z2 := Trim(" ") // weil die Anrede von einer Leerzeile gefolgt ist ////// ENDIF ////// FOR i := 1 TO MlCount(cString,nZeiLen) ////// cLine := MyMemoLine( cString,IIf(Len(aSchrift)=1,90,nZeiLen), i ) ////// ++aPoSZ[2]; aPoSZ[1] := nSpaS ////// FdrG( aPrinterPS, aFont, aPaper, aPoSZ, Trim( cLine ), nTFont, aSchrift ) ////// IF IsMemVar( "xR" ) ////// j := Min(i+2,33) // i+2, weil in z1 die Anrede steht und z2 leer ist ////// // 33, damit nicht ber das feld z33 hinausgeschossen wird ////// cZ := "z"+LTrim(Str(j,2,0)) ////// 27->&cZ := Trim(cLine) // die Felder z1-z33 in txdat.dbf sind 60 Zeichen lang ////// ENDIF ////// IF aPoSZ[2] > 60 //Val( cZeimax ) ////// ++nSnr ////// nZeiOld := aPoSZ[2] ////// nSpaOld := aPoSZ[1] ////// IF ValType(aBlatt)=="A" ////// Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) ////// ELSE // 17.12.2005 z.B. fr die F1-Ausdrucke ////// FdrG( aPrinterPS, aFont, aPaper, {aPoSZ[1],nZeiOld+1}, "- "+Str(nSnr,1,0)+" -", ; ////// nTFont, aSchrift ) ////// aPrinterPS[1]:device():newPage() // [1]! ////// aPoSZ[2] := 3 // weil 5-2=3 ////// FdrG( aPrinterPS, aFont, aPaper, {5,aPoSZ[2]}, "- "+Str(nSnr,1,0)+" -", ; ////// nTFont, aSchrift ) ////// ENDIF ////// aPoSZ[2] := aPoSZ[2] + 2 ////// aPoSZ[1] := nSpaOld ////// ENDIF //////// IF aPoSZ[2]>60 //////// IF !Empty(nSegment) //////// GraSegClose( aPrinterPS[1] ) //////// AAdd( aSegments, nSegment ) //////// nSegment := GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE ) //////// ELSE //////// FdrG( aPrinterPS, aFont, aPaper, aPoSZ, "- 2 -", nTFont, aSchrift ) //////// aPrinterPS[2]:device():newPage() //////// ENDIF //////// aPoSZ[2]=5 //////// ENDIF ////// NEXT ////// IF IsMemVar( "xR" ) ////// FOR i := j+1 TO 33 // l”scht die restlichen Zeilen in txdat.dbf ////// cZ := "z"+LTrim(Str(i,2,0)) ////// 27->&cZ := Trim(" ") // die Felder z1-z33 in txdat.dbf sind 60 Zeichen lang ////// NEXT ////// 27->(DbCloseArea()) ////// SELECT (nOldArea) ////// ENDIF //////RETURN "." // in TFont steht nZAb: Anzahl der Zeilen pro LF 24.09.2006 15:24 FUNCTION MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, cString, nMFont, aSchrift, aSegments, nSegment, aBlatt, nZeiLen, cAusR, nZAb ) LOCAL nSpaS := aPoSZ[1], cLine, i, nCRLF, nOldArea := SELECT(), j:=1 // LOCAL cTKurz := IIf( !Empty(nZeiLen), &("cTKurz" + Str((nZeiLen-Int(nZeiLen))*10,1)),"") PRIVATE cZ DEFAULT nZAb TO 1 //24.09.2006 15:35 nZAb := Max( 1, nZab ) //24.09.2006 15:35 IF Len(Trim(cString)) = 0 .OR. (Len(Trim(cString))=1 .AND. cString[1]$"<^>:") //24.09.2006 13:07 IF IsMemberVar( oEdit, "aDK" ) aPosZ[2] = aPoSZ[2] - 1 * nZAb RETURN .F. ENDIF ENDIF nZeiLen := IIf( Empty(nZeiLen), IIf(Len(aSchrift)=1,90,65), Int(nZeiLen) ) //21.10.2006 11:26 IIf( IsMemVar("nSeitnr"),nSNr := nSeitnr, nSnr := 1 ) IF ValType(aBlatt)=="A" // 19.12.2005 cString := HardCR( cString ) ENDIF DO WHILE ( nCRLF := RAt( CRLF+CRLF+CRLF, cString )) > 0 cString := IIf( nCRLF>0, Left( cString, nCRLF-1 ), cString ) ENDDO cString := cString + " " + CRLF //16.07.2006 19:57 " " FOR i := 1 TO MlCount(cString,nZeiLen) cLine := MyMemoLine( cString, nZeiLen, i ) //21.10.2006 11:26 s.o nZeiLen= aPoSZ[2] := aPoSZ[2] + 1 * nZAb //24.09.2006 15:26 aPoSZ[1] := nSpaS FdrG( aPrinterPS, aFont, aPaper, aPoSZ, Trim( cLine ), nMFont, aSchrift, cAusR, nZeiLen ) //03.10.2006 10:05 nZeiLen IF aPoSZ[2] > 60 //Val( cZeimax ) ++nSnr nZeiOld := aPoSZ[2] nSpaOld := aPoSZ[1] IF ValType(aBlatt)=="A" Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) ELSE // 17.12.2005 z.B. fr die F1-Ausdrucke FdrG( aPrinterPS, aFont, aPaper, {aPoSZ[1],nZeiOld+1}, "- "+Str(nSnr,1,0)+" -", ; nMFont, aSchrift, cAusR ) aPrinterPS[1]:device():newPage() // [1]! aPoSZ[2] := 3 // weil 5-2=3 FdrG( aPrinterPS, aFont, aPaper, {5,aPoSZ[2]}, "- "+Str(nSnr,1,0)+" -", ; nMFont, aSchrift, cAusR ) ENDIF aPoSZ[2] := aPoSZ[2] + 2 * nZAb //24.09.2006 15:27 aPoSZ[1] := nSpaOld ENDIF NEXT RETURN "." // 20.12.2005: vorl„ufiger Test nur bei SinzigX: (jetzt in AKDialogVH.prg) FUNCTION TextLesen( cKurz, cString ) LOCAL i, nOldArea := SELECT(), j PRIVATE cZ cString := "" // == oEdit:BriefText, wird per Referenz bergeben (oder als Ergebnis gelesen) SELECT 27 USE txdat INDEX xtx 27->(DbSeek( cKurz, .F. )) j := IIf( 27->z1="Sehr" .AND. 27->z2=" ", 3, 1 ) FOR i := j TO 33 cZ := "z"+LTrim(Str(i,2,0)) cZ := Trim(&cZ) cString := cString + cZ + IIf(Len(cZ)>0," ","") + CRLF NEXT USE SELECT (nOldArea) RETURN cString // nachfolgende User-Funktion aus der Knowledgebase ersetzt Memoline // und behebt Probleme, wenn die Zeile komplett gefllt ist (ohne Space am Ende) FUNCTION MyMemoLine( cString, nLineLen, nLine, nTabSize, lWrap ) local cLine,startrow,spacechar,hyphenchar,crlfchar,extract_len,checkstring default nLineLen to 79,; nLine to 1,; nTabSize to 4,; lWrap to .t. startrow := 1 cLine := "" // Convert tab to space cString := strtran(cString, chr(9), space(nTabSize)) // cString needs a trailing space so function will find one on last line cString += " " if lWrap // Find position of rightmost space // The largest value is the maximum line length while len(cString) > 0 checkstring := substr(cString,1,nLineLen+1) crlfchar := at(CRLF,checkstring) if crlfchar > 0 extract_len := crlfchar else spacechar := rat(' ' ,checkstring) hyphenchar := rat('-' ,checkstring) extract_len := max(spacechar, hyphenchar) endif // No space or hyphen -- extract as much of line as possible if extract_len == 0 extract_len := nLineLen endif // Extract the line cLine := left(checkstring,extract_len) if right(cLine,1) == chr(13) // wrapped at CRLF cLine := left(cLine, len(cLine)-1) endif cLine := pad(cLine, nLineLen) // Required line extracted, exit if startrow == nLine exit endif startrow ++ // Remove extracted part from string and continue with rest cString := ltrim(substr(cString,extract_len+1)) if left(cString,1) == chr(10) // wrapped at CRLF cString := substr(cString, 2) endif if left(cString,2) == CRLF .AND. Len(cString)>2 // CRLF VOR der Zeile cString := substr(cString, 3) endif cLine := "" // reinit it end else cLine := left(checkstring,nLinelen) endif RETURN cLine //------------------------------------------ PROCEDURE Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP, aSegments, nSegment ) LOCAL oBitmap, aBitRect, aBitSize, aSourceRect, cGrafik LOCAL aBlattZ := {}, i, aRep := {}, cOldPic := cPicture, cAusR // 7.7.2005 Ausrichtung LOCAL cSeite, cNa, cPrompt, cText, nTFont PRIVATE cBereich, cFeld, nFFont, aSum := {}, aS1 := {} PRIVATE cB, cF, xF, nSeitNr := 1, aSchr := aSchrift // 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" PRIVATE nStandardFont := IIf( IsMemVar("cStandardFont"), Val(cStandardFont), 0 ) FOR i := 11 TO 30 &("i"+Str(i,2,0)) := "0" NEXT nISum := 0; cISum := "0" cZweiseitjn := IIf( cZweiseitjn="a" .AND. nLetzteZeile>Val(cZeiMax), "2", cZweiseitjn ) FOR i := 1 to Len( aBlatt ) aBlattZ := aBlatt[i] cSeite := aBlattZ[1] cNa := aBlattZ[2] // IF cSeite == "F" .OR. !cNA == "G" // 17.10.2005 blendet bl_fbk aus // LOOP // ENDIF cPrompt := aBlattZ[3] // in cPrompt kann die Ausrichtung als ^=zentriert und >=rechtsbndig angegeben werden // (wirkt genauso wie in der ersten Stelle von cText) siehe FdrG cAusR := IIf(!Empty(cPrompt).AND.cPrompt[1]$">^",cPrompt[1],"<") // 7.7.2005 Ausrichtung cText := IIf( cCP="A", ConvToAnsiCP( aBlattZ[4] ), aBlattZ[4] ) nTFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[5] != 0, ; aBlattZ[5] := nStandardFont, aBlattZ[5] ) cBereich := aBlattZ[6] cFeld := IIf( cCP="A" .AND. ValType( aBlattZ[7] ) = "C", ; ConvToAnsiCP( aBlattZ[7] ), aBlattZ[7] ) // Feldinhalt nFFont := IIf( !Empty(nStandardFont) .AND. aBlattZ[8] != 0, ; aBlattZ[8] := nStandardFont, aBlattZ[8] ) //************************************************************************************ // in der Rechnung werden die Zeilen gez„hlt wegen des automatischen Umbruchs // wenn in cFeld eine Funktion ist, die bei einem leeren Ergebnis keinen Zeilenvorschub bringen soll, // ...dann muss das hier getestet werden und in die IF-Schleife zur aPoSZ-Bestimmung eingebaut werden. // wenn aber unabh„ngig vom Ergebnis der Funktion ein Zeilenvorschub stattfinden soll, // ...dann kann man das erzwingen durch eine zus„tzliche 1 auch in nTFont! //******** W I C H T I G ************ 02.10.2005 ************************************* // cFeldTest berechnet schon mal das Ergebnis der ausfhrbaren Funktion in cFeld (falls eine ist) cFeldTest := IIf( !Empty(cFeld) .AND. Valtype( cFeld ) == "C", ; IIf( cFeld[1]="&", ; 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 ) IF (cSeite == "2" .AND. cZweiSeitjn != "2") .OR. Upper( cSeite ) == "R" ; .OR. Upper( cSeite ) == "V" .OR. Upper( cSeite ) == "K" ; .OR. cSeite == "M" .OR.; (Empty(cFeldTest) .AND. IIf(ValType(cFeldTest)="C",Trim(cFeldTest)!="",.T.) ; .AND. Empty(cText) .AND. Empty(nTFont) ) // (cFeldTest==NIL .AND. Empty(cText) .AND. Empty(nTFont) ) // nZei und nSpa bleiben unver„ndert, wenn Artikel/Versicherungszeilen bzw. (2.Seitenkopf bei einseitig) ELSEIF cSeite != "G" .AND. cText!="#" .AND. cNA != "G" // 22.8.2004 aPoSZ[2] := IIf( aBlattZ[9]<0.1, aPoSZ[2]-aBlattZ[9], aBlattZ[9] ) //09.12.2006 23:07 aPoSZ[1] := IIf( aBlattZ[10]<0.1, aPoSZ[1]-aBlattZ[10], aBlattZ[10] ) //09.12.2006 23:07 ENDIF // Zeile ist nicht fr den Druck, sondern fr die Editierdarstellung: // (kommt erst hier, wegen der Zeilenkorrekturen in dem vorausgehenden IF-ENDIF) IF cNA == "M" LOOP ENDIF IF Upper( cSeite ) = "S" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE ) ELSE IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift, cAusR ) ENDIF aPrinterPS[1]:device():newPage() // [1]! 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], GRA_SEG_MODIFIABLE ) ELSE IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift, cAusR ) ENDIF aPrinterPS[1]:device():newPage() // [1]! ENDIF ++nSeitNr // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> hier wird der Briefkopf eingefgt 17.10.2005 Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment, "F" ) ///////////////////// // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> ELSEIF Upper( cSeite ) == "R" .OR. Upper( cSeite ) == "V" .OR. Upper( cSeite ) == "K" AAdd( aRep, aBlattZ ) // ELSEIF Upper( cSeite ) = "G" .AND. cBriefKopf != "n" // 22.8.2004 Test mit Grafiken im Bild ELSEIF cSeite = "G" .OR. cNA = "G" //.AND. cBriefKopf = "_" // 12.6.2005 Test mit Grafiken im Bild IF ":"$cText //22.07.2006 11:45 in cText steht Membervariable cGrafik := IIf( cText="&",&(SubStr(cText,2)),&cText) ELSE cText := IIf( cText="&",&(SubStr(cText,2)),cText) // 17.09.2005 cGrafik := IIf("."$cText,Trim(cText),Trim(cText)+".BMP") ENDIF oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := &cFeld aBitRect := IIf( aBlattZ[10]<0 .AND. aBlattZ[9]<0, &cFeld, ; { aBlattZ[10], aBlattZ[9], aBitSize[1], aBitSize[2] } ) //17.09.2005 // aSourceRect := { aBlattZ[9]/2, aBlattZ[10]/2, aBitSize[1]*2, aBitSize[2]*2 } aSourceRect := { 0, 0, oBitmap:xSize, oBitmap:ySize } IF Len(cGrafik)>50 //22.07.2006 11:47 >50 heiát:in cGrafik ist die Grafik oBitmap:setbuffer( cGrafik ) // Bitmap laden ELSE //22.07.2006 11:47 <50 heiát:in cGrafik ist der GrafikdateiName oBitmap:loadFile( cGrafik ) // Bitmap laden ENDIF oBitmap:draw( aPrinterPS[1], aBitRect, aSourceRect ) ELSEIF cSeite = "g" .OR. cNA = "g" //22.07.2006 11:23 Grafik als Variable // IF ((".BMP"$Upper( sv->TEXT ) .OR. ".JPG"$Upper( sv->TEXT ) .AND. ::Fancy != "0") .OR. ; // (nA)->(IsFieldVar(Trim(sv->FIELD_NAME)))) // 26.02.2006 fr Artikelbilder // ::BEArea[::BENr]:cargo := BitView():new( ::BEArea[::BENr] ) // IF !Empty(sv->text) // ::BEArea[::BENr]:cargo:load( Trim(::Fancy) + Trim(sv->TEXT) ) // ::BEArea[::BENr]:paint := {|x,y,obj| x:=obj:currentSize(), ; // ::BEArea[::BENr]:cargo:DISPLAY( {0,0,x[1],x[2]} ) } // ::BEArea[::BENr]:cargo:CREATE() // ELSEIF (nA)->(IsFieldVar(Trim(sv->FIELD_NAME))) // fr Artikelbilder // cFeld := Trim( sv->FIELD_NAME ) // y := (nA)->(FieldPos( cFeld )) // y : Feld-Position in WorkArea nA // ::BEArea[::BENr]:cargo:datalink := {|x| IIf( PCOUNT()==0,(nA)->&cFeld,(nA)->&cFeld:=x ) } // ::BEArea[::BENr]:cargo:CREATE():setdata() // ::BEArea[::BENr]:cargo:setname( y ) // ::addEditControl( ::BEArea[::BENr]:cargo ) // ENDIF // ENDIF 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) := Round(nZwiSumme,2) ENDIF ASize( aRep, 0 ) ELSEIF cSeite = "K" cBereich := IIf(SELECT()=4 .AND. Val(cbereich)<3,"4",cBereich) // 08.03.2006 aZwiSumme := Repdruck2G( aRep, cNa, AllTrim(cBereich), cCP, nt, cSeite, cText, ; aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment ) &("aS"+cNa) := aZwiSumme // ist schon in aSum drin, kann also wohl weg? ASize( aRep, 0 ) ELSEIF Upper( cSeite ) == "Z" // wird gebraucht fr Zwischensummen in RepDruck2G:Zwischen() ELSEIF Upper( cSeite ) == "M" // druckt mehrzeilige Texte in notiz/&cF cF := cFeld // die Ausrichtung in Prompt geht vor der Ausrichtung im Text (in &cF) 21.07.2006 15:01 IF !Empty(cF) .AND. ValType(&cF)=="C" .AND. Len(&cF)>0 .AND. ; !cAusR$">^" .AND. &cF[1]$">^" //02.08.2006 12:52 cAusR := &cF[1] // &cF := SubStr( &cF, 2 ) // passiert doch schon in FDrG ENDIF MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, IIf(Empty(cFeld),1->notiz,&cF), ; Max(nFFont,1), aSchrift, @aSegments, @nSegment, aBlatt, ; Val(IIf(cText[1]="&",&(SubStr(cText,2)),cText)), ; cAusR, nTFont ) //17.10.2006 13:51 //// MemoDruck( aPrinterPS, aFont, aPaper, aPoSZ, IIf(Empty(cFeld),1->notiz,&cF), ; //// nTFont+nFFont, aSchrift, @aSegments, @nSegment, aBlatt, Val(cText), cAusR ) //11.07.2006 12:32 ELSEIF Upper( cSeite ) <> "R" .AND. Upper( cSeite ) <> "V" .AND. Upper( cSeite ) <> "K" IF cSeite<>"2" .OR. (cSeite="2" .AND. cZweiSeitjn="2") IF Upper( cNa ) = "G" .AND. cBriefKopf = "_" // 12.6.2005 Test mit Grafiken im Bild IF ":"$cText //22.07.2006 11:45 in cText steht Membervariable cGrafik := IIf( cText="&",&(SubStr(cText,2)),&cText) ELSE cText := IIf( cText="&",&(SubStr(cText,2)),cText) // 17.09.2005 cGrafik := IIf("."$cText,Trim(cText),Trim(cText)+".BMP") ENDIF // cGrafik := IIf("."$cText,Trim(cText),Trim(cText)+".BMP") oBitmap := XbpBitmap():new():create( aPrinterPS[1] ) aBitSize := &cFeld aBitRect := IIf( aBlattZ[10]<0 .AND. aBlattZ[9]<0, &cFeld, ; { aBlattZ[10], aBlattZ[9], aBitSize[1], aBitSize[2] } ) //17.09.2005 // aSourceRect := { aBlattZ[9]/2, aBlattZ[10]/2, aBitSize[1]*2, aBitSize[2]*2 } aSourceRect := { 0, 0, oBitmap:xSize, oBitmap:ySize } IF Len(cGrafik)>50 //22.07.2006 11:47 >50 heiát:in cGrafik ist die Grafik oBitmap:setbuffer( cGrafik ) // Bitmap laden ELSE //22.07.2006 11:47 <50 heiát:in cGrafik ist der GrafikdateiName oBitmap:loadFile( cGrafik ) // Bitmap laden ENDIF oBitmap:draw( aPrinterPS[1], aBitRect, aSourceRect ) ENDIF IF Upper( cNa ) = "Z" IF !Empty(nSegment) GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) nSegment := GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE ) ELSE IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift, cAusR ) ENDIF aPrinterPS[1]:device():newPage() // [1]! ENDIF ++nSeitNr //// IF !Empty(oBitmap) //// oBitmap:draw( aPrinterPS[1], aBitRect, aSourceRect ) //// ENDIF // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> hier wird der Briefkopf eingefgt 17.10.2005 Kopf2( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, aSegments, @nSegment, "F" ) ///////////////////// // >>>>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP ENDIF IF Upper(AppName()) != "AX.EXE" // 25.9.2004 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 ENDIF IF !Empty(cFeld) //cFeld <> NIL cF := SubStr(cFeld,1,At(":=",cFeld)-1) // falls Variable gesetzt wird 10.12.2006 19:32 cF := IIf( !Empty(cF) .AND. cF != "IIf" .AND. cF = "&", SubStr(cF,2), cF ) cF := IIf( !Empty(cF) .AND. cF != "IIf" .AND. cF = "(", SubStr(cF,2), cF ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," 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 ) // ELSEIF ":="$cFeld .AND. !Empty(cF) .AND. cF != "IIf" .AND. nFFont == 0 // &cF := cFeld ELSE cFeld := IIf( Valtype( cFeld ) == "C", ; IIf( cFeld[1]="&", ; 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 nTFont == 0 .AND. nFFont == 0 // 10.12.2006 19:29 IF !Empty(cF) .AND. cF != "IIf" .AND. !":="$cFeld &cF := cFeld // cFeld wurde gerade ausgerechnet ENDIF CASE Valtype( cFeld ) == "C" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cFeld ), nFFont, aSchrift, cAusR ), ) CASE Valtype( cFeld ) == "N" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IF Upper( AppName() ) $ "DOENNEX.EXE" .or. cKomma = "," IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Transform( cFeld, cPicture ) ), nFFont, aSchrift, cAusR ), ) ELSE IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( Str( cFeld,8,2 ) ), nFFont, aSchrift, cAusR ), ) ENDIF CASE Valtype( cFeld ) == "D" IIf( Len(Trim(cText))>0 .AND. cText <> "&" .AND. nTFont>0, ; FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) IIf( nFFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; DtoC( cFeld ), nFFont, aSchrift, cAusR ), ) CASE Empty(cFeld) //cFeld == NIL // es soll sich nichts bewegen, wenn nichts zu drucken // wird schon oben gemacht!! aPoSZ[2] := IIf( aBlattZ[9]<1, aPoSZ[2]+aBlattZ[9], aPoSZ[2] ) ENDCASE ELSEIF cText!="#" // 22.08.2004 ï#ï bedeutet: Zeile wird nicht gedruckt + kein LF // bei Kremer zuerst eingefhrt fr Schlusszeilen der Abrechnung:'#' berschreiben, damit Zeile gedruckt wird IIf( nTFont>0, FdrG( aPrinterPS, aFont, aPaper, aPoSZ, ; Trim( cText ), nTFont, aSchrift, cAusR ), ) ENDIF ENDIF ENDIF NEXT nLetzteZeile := aPoSZ[2] IF cPrompt = "Seitenn" .AND. !Empty(nSegment) // in der letzten Zeile der bl_xx ASize( aSeitZ, 4 ) aSeitZ[1] := Len(aSegments)+1 // +1, weil nach dem Return noch ein Segment addiert wird aSeitZ[2] := AClone( aPoSZ ) aSeitZ[3] := cFeld // in cNA steht der Font fr Seitennr. aSeitZ[4] := IIf( IsMemVar("cStandardFont"), Val(cStandardFont), Val( cNa ) ) ENDIF cPicture := cOldPic RETURN //----------------------------------------------------------------------- //----------------------------------------------------------------------- FUNCTION Drucker_aus() IF cLPT = "LPTA" .and. !Empty( aPrinterPS ) aPrinterPS[1]:device():endDoc() DestroyDevice( aPrinterPS[1] ) DestroyDevice( aPrinterPS[2] ) ASize(aPrinterPS,0) Set( _SET_DEVICE, "SCREEN" ) cLPTSCR := "S"; lSeiteLeer := .T. // 31.10.2003 cPoffY := Str(nPoffY,3,0) // cPoffX := Str(nPoffX,3,0) // cPpZ := Str(nPpZ,3,0) // cPpS := Str(nPpS,3,0) // 31.10.2003 IIf(Upper(AppName())="SINZIGX.EXE", cPoffX:=cPoffY:="0",) //14.10.04: //cPpS:=cPpZ:="0",) ELSE IF lSeiteLeer == .F. // 21.10.2003: wenn schon was auf der Seite steht NeueSeite() // weil sonst die Seite nicht heraus kommt. ENDIF set printer to SET PRINTER OFF SET CONSOLE ON Set( _SET_DEVICE, "SCREEN" ) ENDIF lSeiteLeer := .T. // 23.10.2003: jetzt ist die Seite per Definition leer RETURN .T. FUNCTION Drucker_an(nP) IF cLPT = "LPTA" IF nP=1 Set(_SET_PRINTER, .T. ) SET CONSOLE OFF ELSE cLPTSCR := "P"; cPoffY := Str(nLPTy,3); cPoffX := Str(nLPTx,3) // 21.10.2003 cPpZ := Str(nLpZ,3); cPpS := Str(nLpS,3) aPrinterPS := { PrinterPS(cDruckerName), PrinterPS(cDruckerName) } //; aPaper := aPrinterPS[2]:DEVICE():paperSize() aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") aPrinterPS[1]:device():startdoc() ENDIF ELSE DO WHILE .not. IsPrinter() IF ALERT( "Drucker ist nicht bereit", ; {"Wiederholen", "Abbrechen"}, ; "W+/R,BG+/N,,,W/R" ) ==2 funk="!" RETURN (.F.) ENDIF ENDDO SetPrc(0,0) IF nP=1 Set(_SET_PRINTER, .T. ) SET CONSOLE OFF ELSE Set( _SET_DEVICE, "PRINTER" ) Set( _SET_PRINTFILE, "LPT1" ) ENDIF ENDIF lSeiteLeer := .T. // 21.10.2003: zun„chst ist die Seite noch leer RETURN .T. FUNCTION Drucker_anW(nP) IF cLPT = "LPTA" IF nP=1 Set(_SET_PRINTER, .T. ) SET CONSOLE OFF ELSE cLPTSCR := "P"; cPoffY := Str(nLPTy,3); cPoffX := Str(nLPTx,3) // 21.10.2003 cPpZ := Str(nLpZ,3); cPpS := Str(nLpS,3) aPrinterPS := { PrinterPS(cDruckerName), PrinterPS(cDruckerName) } //; aPaper := aPrinterPS[2]:DEVICE():paperSize() aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") aPrinterPS[1]:device():startdoc() ENDIF ELSE SetPrc(0,0) IF nP=1 Set(_SET_PRINTER, .T. ) SET CONSOLE OFF ELSE Set( _SET_DEVICE, "PRINTER" ) Set( _SET_PRINTFILE, "LPT1" ) ENDIF ENDIF lSeiteLeer := .T. // 21.10.2003 zun„chst ist die Seite noch leer RETURN .T. FUNCTION Sage( nRow, nCol, cSay ) LOCAL aPenPos IF cLPTSCR = "S" DevPos( nRow, nCol ) DevOut( cSay ) ELSE aPoSZ := {nCol,nRow} cText := IIf( ValType(cSay)="C", cSay, IIf(ValType(cSay)="N",Str(cSay), ; IIf(ValType(cSay)="D",DtoC(cSay),))) aPenPos := FdrG( aPrinterPS, aFont, aPaper, aPoSZ, Trim( cText ), 1, dummy := {} ) ENDIF lSeiteLeer := .F. // 21.10.2003 es steht was auf der Seite RETURN aPenPos //----------------------------------------------------------------------- FUNCTION NeueSeite() IF lSeiteLeer == .F. // 23.10.2003: damit eject keine leeren Seiten bef”rdert IF cLPT = "LPTA" aPrinterPS[1]:device():newPage() ELSE _Eject() ENDIF ENDIF lSeiteLeer := .T. // 21.10.2003 Seite ist leer RETURN .T. //----------------------------------------------------------------------- FUNCTION Druckerwahl() LOCAL oDlg, oPrinter, cDruckername oDlg := XbpPrintDialog():new() oDlg:CREATE() oPrinter := oDlg:DISPLAY() oDlg:destroy() cDruckerName := IIf( Empty(oPrinter), (oPrinter := XbpPrinter():new():CREATE()):devName, oPrinter:devName ) RETURN cDruckerName //----------------------------------------------------------------------- FUNCTION Formular( aBG, cDatei ) // baut das Briefkopf-Formular, z.B. bl_fbk auf LOCAL cSeite, cNa, cPrompt, cText, nTFont, cBereich, cFeld, nFFont, nZei, nSpa IF 1->(IsFieldVar("perskz")) //(Upper(AppName())$"MUELLX.EXE-AX.EXE-BX.EXE" // 8.2.2005 // Experiment, damit der Aufbau aus bl_.tak statt aus bl_*.dbf erfolgt: DbUseArea( ,"SDFNTX", "bl_.tak", "bv", .T. ) // bereits in Area 20 OrdListAdd("xBlFName") // 8.2.2005: weil schon in ineux geindext // OrdCreate( "C:\HDBE\xBlFName",, "Upper(fname)" ) // 8.2.2005 DbSetScope( SCOPE_BOTH, PadR(Upper(cDatei),8) ) DbGotop() ELSE USE &cDatei // die bisherige Originalzeile // 8.2.2005 ENDIF 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 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 ////// IF cFeld = "#" // speziell fr bl_grue ////// cFeld := SubStr(cFeld,2) ////// ELSE ////// 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) ) ////// ENDIF ////// // 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 ////// // ELSEIF ":="$cFeld ////// // cF := cFeld ////// // cFeld := &(cF) //Variableninhalt ////// ENDIF IF cNA = "!" // 10.12.2006 08:53 belegt Variable vor dem ':=' mit String danach // cF := SubStr(cFeld,1,At(":=",cFeld)-1) // IF !Empty(cF) .AND. cF != "IIf" // &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Gleichung aufl”sen // ELSE // ENDIF // cNA := "v" // cText := cFeld // Ausdruck konservieren fr oVorschau:Update() // cFeld := "" ELSEIF At(":=",cFeld) > 0 // 10.12.2006 17:49 cF := SubStr(cFeld,1,At(":=",cFeld)-1) IF !Empty(cF) .AND. cF != "IIf" PRIVATE &cF := &(SubStr(cFeld,At(":=",cFeld)+2)) // Gleichung aufl”sen, Variable definieren ENDIF ENDIF AAdd( aBG, { cSeite, cNa, cPrompt, cText, nTFont, ; cBereich, cFeld, nFFont, nZei, nSpa }) //10.12.2006 08:49 // AAdd( aBG, { Trim( &nA->seite ), Trim( &nA->na ), Trim( &nA->prompt ), &nA->text, &nA->tfont, ; // &nA->bereich, Trim( &nA->feld ), &nA->ffont, &nA->zeile, &nA->spalte }) //, RecNo() ) // 8.2.2005 SKIP ENDDO DbCloseArea() RETURN aBG //----------------------------------------------------------------------- //----------------------------------------------------------------------- //----------------------------------------------------------------------- //----------------------------------------------------------------------- FUNCTION Anrede(cAnr) // wegen HerrN aus Herr LOCAL cAnrede IF cAnr = "Herr" cAnrede := "Herrn"+SubStr(cAnr,6) ELSE cAnrede := cAnr ENDIF RETURN Trim(cAnrede)