// Bestf7.prg - Funktionen zu Bestp7.prg // 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 "dmlb.ch" #include "common.ch" //#define xbeUser_FileMarked xbeP_User + 1 //#define xbeUser_FileSelected xbeP_User + 2 PROCEDURE RunDosWin(oOwner, cProc, aWinSize, aWinPos, cTitle, optP1,optP2,optP3,optP4,optP5) LOCAL oDosWin LOCAL oOldWin LOCAL oOldFocus := SetAppFocus() LOCAL nOldArea := SELECT(), nRec := RecNo() LOCAL aSizeDesktop, aPos (nOldArea)->(DbSuspendNotifications()) aSizeDesktop := AppDesktop():currentSize() #define DEF_FONTHEIGHT aSizeDesktop[2]/28 #define DEF_FONTWIDTH aSizeDesktop[1]/80 #define DEF_ROWS 25 #define DEF_COLS 80 aPos := { (aSizeDesktop[1]-(DEF_COLS * DEF_FONTWIDTH)) /2, ; (aSizeDesktop[2]-(DEF_ROWS * DEF_FONTHEIGHT)) /2 } aWinSize := { DEF_COLS, DEF_ROWS } aWinPos := aPos oDosWin := XbpCrt():New(AppDeskTop(),oOwner:cargo,aWinPos,aWinSize[2],aWinSize[1],cTitle,.f. ) IF aWinPos[1] = 0 .AND. aWinPos[2] = 0 ScreenCenter(oDosWin,.t.) ENDIF oDosWin:FontWidth := DEF_FONTWIDTH oDosWin:FontHeight := DEF_FONTHEIGHT oDosWin:FontName := "8.Arial" oDosWin:Create() oDosWin:SetModalState(XBP_DISP_APPMODAL) oOldWin := SetAppWindow(oDosWin) oDosWin:Show() SET COLOR TO "GR+/B,W+/R,,,N/W" oDosWin:Close := {||PostAppEvent(xbeK_PGDN)} SetAppFocus(oDosWin) SetCursor(1) &cProc(optP1,optP2,optP3,optP4,optP5) oDosWin:Hide() oDosWin:SetModalState(XBP_DISP_MODELESS) SetAppWindow(oOldWin) oDosWin:Destroy() set charset to oem if oOldFocus <> NIL SetAppFocus(oOldFocus) ENDIF SELECT &nOldArea GO nRec (nOldArea)->(DbResumeNotifications()) RETURN FUNCTION ScreenCenter(oXbp, lSet) LOCAL aParentSize := oXbp:SetParent():CurrentSize() LOCAL aWinSize := oXbp:CurrentSize() LOCAL aNewPos := {0,0} // DEFAULT lSet TO .T. aNewPos[1] := (aParentSize[1]-aWinSize[1])/2 aNewPos[2] := (aParentSize[2]-aWinSize[2])/2 if lSet oXbp:SetPos(aNewPos) endif RETURN aNewPos /// -------------------------------------- FUNCTION AppQuit(oDlg) // oDlg = Window nicht DrawingArea!! LOCAL y := ConfirmBox( oCB, "Best„tigen mit J?", ; "Programm sofort beenden.", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) oDlg:writeData() IF 4->(Alias()) == "PERSONEN" oBest:SwapPers("S") ENDIF IF y == XBPMB_RET_YES cPubAuf := StrX( 1->auftrnr,E,0 ) SELECT 20 USE mwstdat EXCLUSIVE IIf( IsFieldVar("pubauf"),20->pubauf := cPubAuf,) DbCloseAll() QUIT ELSEIF y == XBPMB_RET_NO .AND. !IsMemVar( "NurWindows" ) PostAppEvent( xbeP_Close, .T.,, oDlg ) ENDIF RETURN y FUNCTION IsIndexUnique( nOrder, xIndexValue ) LOCAL nOldOrder := OrdNumber() LOCAL nRecno := Recno() LOCAL lUnique := .F. OrdSetFocus( nOrder ) lUnique := ! DbSeek( xIndexValue ) OrdSetFocus( nOldOrder ) DbGoTo( nRecno ) RETURN lUnique FUNCTION Satzsp( oDlg1, nRl ) DO WHILE nRl == NIL // IF DbRlock( Recno() ) // alle anderen Satzsperren bleiben beibehalten IF DbRlock(RecNo()) // Record-Lock UND: alle anderen Locks werden damit NICHT aufgehoben nRl := 1 ELSE ModalFen( ,,oDlg1 ) ENDIF ENDDO RETURN (.T.) FUNCTION StrL(nAuf,nL,nD) // 13.04.2007 22:11 mit Picture, aber linksbndig DEFAULT nD TO 2 RETURN LTrim(IIf(cKomma=",".AND.nD!=0, Transform(nAuf,cPicture), Str(nAuf,nL,nD) )) //13.04.2007 22:22; FUNCTION StrP(nAuf,nL,nD) // 13.04.2007 21:59 mit Picture und fhrenden Leerzeichen RETURN IIf(cKomma=",",Transform(nAuf,cPicture), Str(nAuf,nL,nD)) //13.04.2007 22:23; // nachgestelltes EUR: FUNCTION StrPE(nAuf,nL,nD) // 13.04.2007 21:59 mit Picture und fhrenden Leerzeichen RETURN IIf(cKomma=",",Transform(nAuf,cPicture)+" "+w_g, Str(nAuf,nL,nD)+" "+w_g) //13.04.2007 22:23; // vorangestelltes EUR: FUNCTION StrEP(nAuf,nL,nD) // 13.04.2007 21:59 mit Picture und fhrenden Leerzeichen RETURN IIf(cKomma=",",w_g+" "+Transform(nAuf,cPicture), w_g+" "+Str(nAuf,nL,nD)) //13.04.2007 22:23; FUNCTION StrS(nAuf,nL,nD) // 26.08.2005 MengX: alle mit neuer Rechnung: StrZero RETURN IIf(nL=6 .OR. Upper(AppName())!="MENGX.EXE", StrZERO(nAuf,nL,nD), ; Trim(1->ver_ort)+SubStr(StrZero(nAuf,nL,nD),2,6) ) // VO +6 Stellen! FUNCTION StrU(nAuf,nL,nD) // 03.06.2007 14:10 fr Uhrzeit-Format: "10.30 Uhr" DEFAULT nL TO 5, nD TO 2 RETURN IIf(nAuf == 0.00,"",Str(nAuf,nL,nD)+" Uhr") FUNCTION StrV(nAuf,nL,nD) // 26.08.2005 MengX: alle mit neuer Rechnung: StrZero RETURN IIf(nL=6 .OR. Upper(AppName())!="MENGX.EXE", StrZERO(nAuf,nL,nD), ; Trim(1->ver_ort)+" "+StrZero(nAuf,nL,nD) ) // VO +6 Stellen! FUNCTION StrX(nAuf,nL,nD) // 26.08.2005 alle mit neuer Rechnung: StrZero RETURN StrZERO(nAuf,nL,nD) //+14.08.2009 18:43 AllTrim() und alle Blancs raus FUNCTION ATB(cString) LOCAL n := 0, cVar := "" cString := AllTrim(cString) FOR n := 1 TO Len(cString) IIf( !cString[n]$" .,;+!?=#", cVar += cString[n], ) NEXT RETURN cVar //+15.08.2009 12:16 BIC in Druckform bringen FUNCTION pBIC(cBIC) RETURN IIf(Len(cBIC)=11,Left(cBIC,8)+" "+Right(cBIC,3),cBIC) //+15.08.2009 12:18 IBAN in Druckform bringen FUNCTION pIBAN(cIBAN) RETURN IIf(Len(cIBAN)>12,Left(cIBAN,2)+" "+SubStr(cIBAN,3,2)+ ; " "+SubStr(cIBAN,5,8)+" "+SubStr(cIBAN,13),cIBAN) FUNCTION SubSet(cText,cAnf,cEnd,nStart) //08.01.2008 11:41 Auftrnr-Extraktion zwischen zwei Kommas im Termin-Text LOCAL cSub:="", lAnf:=lEnd:=.F., i, n:=1 DEFAULT nStart TO 1 FOR i := 1 TO Len(cText) IIf(lAnf .AND. cText[i]==cEnd,lEnd:=.T.,) IF lEnd EXIT ENDIF IIF(lAnf,cSub+=cText[i],) IIf(!lAnf,IIf(cText[i]==cAnf,IIf(nStart==n,lAnf:=.T.,n++),),) NEXT RETURN AllTrim(cSub) //+14.08.2009 18:15 macht DatumStrings ohne Punkte (fr Formulare) FUNCTION Dop(dDatum) LOCAL cDatum := IIf(ValType(dDatum)=="D",DtoC(dDatum),dDatum) RETURN Left(cDatum,2)+SubStr(cDatum,4,2)+Right(cDatum,4) FUNCTION MMzuMonat( dDatum ) RETURN Str(Day(dDatum),2)+". "+CMonth(dDatum)+" "+Str(Year(dDatum),4) FUNCTION ORTohnePLZ( cPlzOrt ) RETURN IIf( Val(SubStr( cPlzOrt,1,1 ))=0, Trim(cPlzOrt), ; IIf( SubStr( cPlzOrt,6,1 )=" ", Trim( SubStr(cPlzOrt,7)), ; Trim(SubStr(cPLZOrt,6)))) FUNCTION DatumDifferenz( dDatum1, dDatum2, cDiff ) // cDiff = "1->jahre" (mit Alias!) // LOCAL nDiff := Round((Val(DtoS(dDatum2))-Val(DtoS(dDatum1)))/10000,0) LOCAL nDiff := Int((dDatum2-dDatum1)/365.25) // 14.4.04 Satzsp( oCB ) &cDiff := IIf(!Empty(dDatum1).AND.!Empty(dDatum2), ; nDiff,0) oCB:childFromName( 1->(FieldPos( SubStr(cDiff,4))) ):setdata() // 26.3.04 RETURN DbRUnlock(RecNo()) FUNCTION GebGest() RETURN { "* "+DtoC(1->geb_datum), "† "+DtoC(1->gestorben) } FUNCTION Breit(cWort,cS) //25.06.2007 19:13 LOCAL i, cString := "" FOR i := 1 TO Len(cWort)-1 cString += cWort[i] + cS NEXT cString += Right(cWort,1) RETURN cString //----------------------------------------------------------------------- FUNCTION Anrede(cAnr,lAkG) // wegen HerrN aus Herr 31.05.2007 19:06 LOCAL cAnrede DEFAULT lAkG TO .T. IF cAnr = "Herr" cAnrede := "Herrn " + IIf( lAkG, SubStr(cAnr,At(" ",cAnr)+1), "" ) ELSE cAnrede := SubStr(cAnr,1,At(" ",cAnr)) + IIf( lAkG, SubStr(cAnr,At(" ",cAnr)+1), "" ) ENDIF RETURN Trim(cAnrede) FUNCTION AkGrad(cAnr) //19.05.2007 18:31 LOCAL cAkGr RETURN Trim(SubStr(cAnr,At(" ",cAnr)+1)) FUNCTION Verstorbener(lHn,lAd) //19.05.2007 18:31 31.05.2007 17:27 LOCAL cVerst DEFAULT lHn TO .F., lAd TO .F. IF Upper(AppName())$"WERNERX.EXE" cVerst := IIf(lHn .AND. 1->anrede="Herr","Herrn"+Trim(SubStr(1->anrede,6)),Trim(1->anrede))+ ; " "+Trim(IIf(Empty(1->vorname),1->rufname,1->vorname))+" "+Trim(1->name) ELSE cVerst := IIf(lHn.AND.1->anrede="Herr","Herrn"+Trim(SubStr(1->anrede,6)),Trim(1->anrede))+ ; " "+Trim(1->vorname)+" "+Trim(1->name) ENDIF cVerst += IIf( lAd, ", "+Trim(1->plz_ort)+", "+1->strasse, "" ) RETURN Trim(cVerst) FUNCTION Auftraggeber(lHn,lAd,aAG) //19.05.2007 18:31 31.05.2007 17:27 LOCAL cVerst DEFAULT lHn TO .F., lAd TO .F. IF Empty(aAG) cVerst := IIf(lHn .AND. oBest:aBP[1]="Herr","Herrn"+Trim(SubStr(oBest:aBP[1],6)),Trim(oBest:aBP[1]))+ ; " "+Trim(oBest:aBP[2])+" "+Trim(oBest:aBP[3]) ELSE cVerst := IIf(lH.AND.1->anrede="Herr","Herrn"+SubStr(1->ansp_anr,6),Trim(1->ansp_anr))+ ; " "+Trim(1->ansp_vname)+" "+Trim(1->ansp_name) ENDIF IF lAD cVerst += IIf( Empty(aAG), ", "+Trim(oBest:aBP[5])+", "+oBest:aBP[4], ; ", "+Trim(1->ansp_ort)+", "+1->ansp_str ) ENDIF RETURN Trim(cVerst) FUNCTION SehrGeehrte(cAnrede,cName) //31.05.2007 17:19 LOCAL cSeGe := "Sehr geehrte Damen und Herren," DO CASE CASE cAnrede = "Herr" cSeGe := "Sehr geehrter Herr "+Trim(cName)+"," CASE cAnrede = "Frau" cSeGe := "Sehr geehrte Frau "+Trim(cName)+"," CASE "Herr "$SubStr(cName,1,7) .OR. "Herrn "$SubStr(cName,1,8) cSeGe := "Sehr geehrter Herr "+Trim(SubStr(cName,At(" ",cName,At("Herr",cName))+1))+"," CASE "Frau "$SubStr(cName,1,7) cSeGe := "Sehr geehrte "+Trim(SubStr(cName,At("Frau",cName)))+"," CASE cAnrede = "Eheleute" cSeGe := "Sehr geehrte Frau "+Trim(cName)+", "+"sehr geehrter Herr "+Trim(cName)+"," ENDCASE RETURN cSeGe //////FUNCTION StrX(nAuf,nL,nD) // 26.08.2005 alle mit neuer Rechnung: StrZero //////RETURN StrZERO(nAuf,nL,nD) ////// //////FUNCTION StrL(nAuf,nL,nD) // 13.04.2007 22:11 mit Picture, aber linksbndig //////RETURN LTrim(IIf(cKomma=",", Transform(nAuf,cPicture), Str(nAuf,nL,nD) )) //13.04.2007 22:22; //////// Transform(nAuf,"@ "+Replicate("9",nL-nD-1)+"."+Replicate("9",nD)) ) ) ////// //////FUNCTION StrP(nAuf,nL,nD) // 13.04.2007 21:59 mit Picture und fhrenden Leerzeichen //////RETURN IIf(cKomma=",",Transform(nAuf,cPicture), Str(nAuf,nL,nD)) //13.04.2007 22:23; //////// Transform(nAuf,"@ "+Replicate("9",nL-nD-1)+"."+Replicate("9",nD)) ) ////// //////FUNCTION StrS(nAuf,nL,nD) // 26.08.2005 MengX: alle mit neuer Rechnung: StrZero //////RETURN IIf(nL=6 .OR. Upper(AppName())!="MENGX.EXE", StrZERO(nAuf,nL,nD), ; ////// Trim(1->ver_ort)+SubStr(StrZero(nAuf,nL,nD),2,6) ) // VO +6 Stellen! ////// //////FUNCTION StrV(nAuf,nL,nD) // 26.08.2005 MengX: alle mit neuer Rechnung: StrZero //////RETURN IIf(nL=6 .OR. Upper(AppName())!="MENGX.EXE", StrZERO(nAuf,nL,nD), ; ////// Trim(1->ver_ort)+" "+StrZero(nAuf,nL,nD) ) // VO +6 Stellen! FUNCTION BestGeaendert() // LOCAL nElements := FCount(), nCount := 0, lGleich := .T. // IF SELECT() == 1 ////* // oBestMaske:aData2 := SatzGetBest() // //*// // DO WHILE ++nCount <= nElements // IF lGleich // lGleich := (oBestMaske:aData1[nCount] == oBestMaske:aData2[nCount]) // ELSE // IF ConfirmBox( oBEDA, "Žnderungen speichern?", ; // "Datensatz wurde ver„ndert", ; // XBPMB_YESNO, ; // XBPMB_QUESTION ) == XBPMB_RET_NO // SatzPutBest( oBestMaske:aData1 ) // alten Stand wieder zurckschreiben // RETURN .F. // ELSE // EXIT // ENDIF // ENDIF // ENDDO // ENDIF RETURN .T. FUNCTION SatzGetBest() LOCAL i, aData[ FCount() ] // PRIVATE cFieldName // FOR i := 1 to FCount() // IF TYPE( FieldName(i) ) == "M" // cFieldName := FieldName(i) // aData[i] := &cFieldName // ELSE // aData[i] := FieldGet( i ) // ENDIF // NEXT RETURN aData FUNCTION SatzPutBest( aData ) // LOCAL i // DbRlock( RecNo()) // FOR i := 1 to FCount() // IF aData[i] == NIL // DO CASE // CASE Type( FieldName(i) ) == "N" // FieldPut( i, 0 ) // CASE Type( FieldName(i) ) == "C" // FieldPut( i, Trim(" ") ) // CASE Type( FieldName(i) ) == "D" // FieldPut( i, CtoD(" ") ) // ENDCASE // ELSE //// FieldPut( i, aData[i] ) // IF TYPE( FieldName(i) ) == "M" // cFieldName := FieldName(i) // FIELD->&cFieldName := aData[i] // ELSE // FieldPut( i, aData[i] ) // ENDIF // ENDIF // NEXT // DbRUnlock( RecNo()) RETURN ( aData ) FUNCTION ZumAnfang( nA ) IF nA == 1 IF 1->auftrnr=0 DELETE ENDIF // IIF( (nA = 1 .AND. (nA)->Auftrnr > 0), BestGeaendert() , (nA)->(DbDelete()) ) (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoTop()) oBestMaske:aData1 := SatzGetBest() ELSE (nA)->(DbGoTop()) (nA)->(DbSkip(0) ) ENDIF RETURN .T. FUNCTION Zurueck( nA ) IF nA == 1 IF 1->auftrnr=0 DELETE ENDIF // IIF( (nA = 1 .AND. (nA)->Auftrnr>0), BestGeaendert(), (nA)->(DbDelete()) ) (nA)->(DbRUnlock( Recno() ) ) IF ! (nA)->(Bof()) (nA)->(DbSkip(-1) ) IF (nA)->(Bof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(1) ) // Append-Situation vermeiden (nA)->(DbResetNotifications()) (nA)->(DbGoTop()) // Notification ausl”sen ENDIF ENDIF // oBestMaske:aData1 := SatzGetBest() ELSE (nA)->(DbSkip(-1) ) ENDIF RETURN .T. FUNCTION Vorwaerts( nA ) IF nA == 1 IF 1->auftrnr=0 DELETE ENDIF // IIF( nA = 1 .AND.(nA)->Auftrnr>0, BestGeaendert(), (nA)->(DbDelete()) ) (nA)->(DbRUnlock( Recno() ) ) VorSkip( nA ) // oBestMaske:aData1 := SatzGetBest() ELSE (nA)->(DbSkip(1) ) ENDIF RETURN .T. FUNCTION ZumEnde( nA ) IF nA == 1 IF 1->auftrnr=0 DELETE ENDIF // IIF( nA = 1 .AND. (nA)->Auftrnr>0, BestGeaendert(), (nA)->(DbDelete()) ) (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoBottom()) oBestMaske:aData1 := SatzGetBest() ELSE (nA)->(DbGoBottom()) (nA)->(DbSkip(0) ) ENDIF RETURN .T. FUNCTION VorSkip( nA ) IF ! (nA)->(Eof()) (nA)->(DbSkip(1) ) IF (nA)->(Eof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(-1) ) // Append-Situation vermeiden (nA)->(DbResetNotifications()) (nA)->(DbGobottom()) // Notification ausl”sen ENDIF ENDIF RETURN (.T.) PROCEDURE HiliteSle( oXbpSle ) LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_YELLOW } } // { XBP_PP_COMPOUNDNAME, FONT_TIMES_MEDIUM + FONT_STYLE_BOLD } } oXbpSle:setPresParam( aPP ) PostAppEvent( xbeP_Keyboard, xbeK_HOME, , oXbpSle ) //10.3.04 startet direkt am Anfang oFocSle := SetAppFocus( ) IF ValType(oFocSle:cargo) == "C" .AND. oFocSle:cargo[1] != "&" // LetztesFeldSle mit Focus oBest:oFocLFSle := IIf( IsFieldVar(oFocSle:cargo), oFocSle, oBest:oFocLFSle ) oBest:oFocLFSle:vorigerwert := oBest:oFocLFSle:value // 16.12.2004 ELSEIF ValType(oFocSle:cargo) == "C" .AND. oFocSle:cargo[1] = "&" // LetztesFeldSle mit Focus oBest:oFocLFSle := IIf( IsFieldVar(&(SubStr(oFocSle:cargo,2))), oFocSle, oBest:oFocLFSle ) oBest:oFocLFSle:vorigerwert := oBest:oFocLFSle:value // 16.12.2004 ENDIF RETURN PROCEDURE DeHiliteSle( oXbpSle ) LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } // { XBP_PP_COMPOUNDNAME, FONT_TIMES_MEDIUM + FONT_STYLE_BOLD } } oXbpSle:setPresParam( aPP ) RETURN PROCEDURE Loeschen( oDlg1, nAuf ) IF ConfirmBox( oDlg1, "Abbrechen mit ", ; "Gesamt-Auftrag Nr. "+StrX(nAuf,E,0)+" l”schen?", ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES SELECT 2 // IIf(AppName()="MENGX.EXE",DbSeek(StrZERO(nAuf,E,0),.F.),DbSeek(Str(nAuf,E,0),.F.) ) DbSeek(StrX(nAuf,E,0),.F.) IF Found() .AND. ConfirmBox( oDlg1, "Abbrechen mit ", ; "Versicherungsdaten zu "+StrX(nAuf,E,0)+" l”schen?", ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES DO WHILE 2->auftrnr = nAuf .AND. !Eof() Satzdelete() DbSkip() ENDDO ENDIF SELECT 3 // IIf(AppName()="MENGX.EXE",DbSeek(StrZERO(nAuf,E,0),.F.),DbSeek(Str(nAuf,E,0),.F.) ) DbSeek(StrX(nAuf,E,0),.F.) IF Found() .AND. ConfirmBox( oDlg1, "Abbrechen mit ", ; "Rechnung zu "+StrX(nAuf,E,0)+" l”schen?", ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES IF ConfirmBox( oDlg1, "Rechnung= / Angebot=", ; "Mssen Artikeldaten korrigiert werden?", ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES DO WHILE 3->auftrnr = nAuf .AND. !Eof() // Artikel-Daten korrigieren: cArt := 3->zugr_z_st SELECT 6 FIND &cArt Satzsp( oDlg1 ) REPLACE 6->bestand WITH 6->bestand+1 REPLACE 6->mgjahr WITH 6->mgjahr-1 //// REPLACE 6->umsatz WITH 6->umsatz - 3->betrag //// REPLACE 6->umsatzeu WITH 6->umsatzeu - 3->betrageu IIf(6->(IsFieldVar("umsatz")), 6->umsatz := 6->umsatz - 3->betrag, ) IIf(6->(IsFieldVar("umsatzeu")), 6->umsatzeu := 6->umsatzeu - 3->betrageu, ) DbRUnlock( Recno() ) SELECT 3 // Satzdelete() DbSkip() ENDDO ENDIF ENDIF SELECT 1 Satzdelete() oBest:Fall_geloescht := .T. // damit letzte30 neu gefllt werden 26.06.2006 16:02 DbSkip(-1) // 2.5.2005, damit die n„chstkleinere Auftragsnummer kommt ENDIF RETURN //////FUNCTION MMzuMonat( dDatum ) //////RETURN Str(Day(dDatum),2)+". "+CMonth(dDatum)+" "+Str(Year(dDatum),4) ////// //////FUNCTION ORTohnePLZ( cPlzOrt ) //////RETURN IIf( Val(SubStr( cPlzOrt,1,1 ))=0, Trim(cPlzOrt), ; ////// IIf( SubStr( cPlzOrt,6,1 )=" ", Trim( SubStr(cPlzOrt,7)), ; ////// Trim(SubStr(cPLZOrt,6)))) ////// //////FUNCTION DatumDifferenz( dDatum1, dDatum2, cDiff ) // cDiff = "1->jahre" (mit Alias!) //////// LOCAL nDiff := Round((Val(DtoS(dDatum2))-Val(DtoS(dDatum1)))/10000,0) ////// LOCAL nDiff := Int((dDatum2-dDatum1)/365.25) // 14.4.04 ////// Satzsp( oCB ) ////// &cDiff := IIf(!Empty(dDatum1).AND.!Empty(dDatum2), ; ////// nDiff,0) ////// oCB:childFromName( 1->(FieldPos( SubStr(cDiff,4))) ):setdata() // 26.3.04 //////RETURN DbRUnlock(RecNo()) ////// //////FUNCTION GebGest() //////RETURN { "* "+DtoC(1->geb_datum), "† "+DtoC(1->gestorben) } ////// ////////----------------------------------------------------------------------- //////FUNCTION Anrede(cAnr,lAkG) // wegen HerrN aus Herr 31.05.2007 19:06 ////// LOCAL cAnrede ////// DEFAULT lAkG TO .T. ////// IF cAnr = "Herr" ////// cAnrede := "Herrn " + IIf( lAkG, SubStr(cAnr,At(" ",cAnr)+1), "" ) ////// ELSE ////// cAnrede := SubStr(cAnr,1,At(" ",cAnr)) + IIf( lAkG, SubStr(cAnr,At(" ",cAnr)+1), "" ) ////// ENDIF //////RETURN Trim(cAnrede) ////// //////FUNCTION AkGrad(cAnr) //19.05.2007 18:31 ////// LOCAL cAkGr //////RETURN Trim(SubStr(cAnr,At(" ",cAnr)+1)) ////// //////FUNCTION Verstorbener(lHn,lAd) //19.05.2007 18:31 31.05.2007 17:27 ////// LOCAL cVerst ////// DEFAULT lHn TO .F., lAd TO .F. ////// IF Upper(AppName())$"WERNERX.EXE" ////// cVerst := IIf(lHn .AND. 1->anrede="Herr","Herrn"+Trim(SubStr(1->anrede,6)),Trim(1->anrede))+ ; ////// " "+Trim(IIf(Empty(1->vorname),1->rufname,1->vorname))+" "+Trim(1->name) ////// ELSE ////// cVerst := IIf(lH.AND.1->anrede="Herr","Herrn"+SubStr(1->anrede,6),Trim(1->anrede))+ ; ////// " "+Trim(1->vorname)+" "+Trim(1->name) ////// ENDIF ////// cVerst += IIf( lAd, ", "+Trim(1->plz_ort)+", "+1->strasse, "" ) //////RETURN Trim(cVerst) ////// //////FUNCTION Auftraggeber(lHn,lAd,aAG) //19.05.2007 18:31 31.05.2007 17:27 ////// LOCAL cVerst ////// DEFAULT lHn TO .F., lAd TO .F. ////// IF Empty(aAG) ////// cVerst := IIf(lHn .AND. oBest:aBP[1]="Herr","Herrn"+Trim(SubStr(oBest:aBP[1],6)),Trim(oBest:aBP[1]))+ ; ////// " "+Trim(oBest:aBP[2])+" "+Trim(oBest:aBP[3]) ////// ELSE ////// cVerst := IIf(lH.AND.1->anrede="Herr","Herrn"+SubStr(1->ansp_anr,6),Trim(1->ansp_anr))+ ; ////// " "+Trim(1->ansp_vname)+" "+Trim(1->ansp_name) ////// ENDIF ////// IF lAD ////// cVerst += IIf( Empty(aAG), ", "+Trim(oBest:aBP[5])+", "+oBest:aBP[4], ; ////// ", "+Trim(1->ansp_ort)+", "+1->ansp_str ) ////// ENDIF //////RETURN Trim(cVerst) ////// //////FUNCTION SehrGeehrte(cAnrede,cName) //31.05.2007 17:19 ////// LOCAL cSeGe := "Sehr geehrte Damen und Herren," ////// DO CASE ////// CASE cAnrede = "Herr" ////// cSeGe := "Sehr geehrter Herr "+Trim(cName)+"," ////// CASE cAnrede = "Frau" ////// cSeGe := "Sehr geehrte Frau "+Trim(cName)+"," ////// CASE "Herr "$SubStr(cName,1,7) .OR. "Herrn "$SubStr(cName,1,8) ////// cSeGe := "Sehr geehrter Herr "+Trim(SubStr(cName,At(" ",cName,At("Herr",cName))+1))+"," ////// CASE "Frau "$SubStr(cName,1,7) ////// cSeGe := "Sehr geehrte "+Trim(SubStr(cName,At("Frau",cName)))+"," ////// CASE cAnrede = "Eheleute" ////// cSeGe := "Sehr geehrte Frau "+Trim(cName)+", "+"sehr geehrter Herr "+Trim(cName)+"," ////// ENDCASE //////RETURN cSeGe ////// //----------------------------------------------------------------------- /* * Prozedur, die Daten aus einem modalen Dialog abfragt */ PROCEDURE Suchen( oDlg1, aData1, nXsize, nYsize, cSuchArt, cKreis ) LOCAL cSuch := cAuf := IIf(Empty(cKreis),Space(E),cKreis) LOCAL oFocus := SetAppFocus(), nRec := RecNo(), lSuch LOCAL cTitle := "Auftrags-Nr. (oder ïv ï+Verstorbener/ïa ï+Auftraggeber):" cSuchArt := IIf( Empty(cSuchArt), "", cSuchArt ) cKreis := IIf( Empty(cKreis), "", cKreis ) DbSkip(0) DO CASE CASE cSuchArt = "v " cTitle := "Verstorbenen-Namen unten eingeben:" IF Upper(AppName())$"MENGX.EXE" .AND. cSystem="S" SET INDEX TO xauftrnr,xname,xanspnam,xstrasse // cTop := "0000000"; cBot := "9999999" // 2->(DbSetScope( SCOPE_TOP, cTop )); 2->(DbSetScope( SCOPE_BOTTOM, cBot )) // 3->(DbSetScope( SCOPE_TOP, cTop )); 3->(DbSetScope( SCOPE_BOTTOM, cBot )) ENDIF CASE cSuchArt = "a " cTitle := "Ansprechpartner-Namen unten eingeben:" IF Upper(AppName())$"MENGX.EXE" .AND. cSystem="S" SET INDEX TO xauftrnr,xname,xanspnam,xstrasse // cTop := "0000000"; cBot := "9999999" // 2->(DbSetScope( SCOPE_TOP, cTop )); 2->(DbSetScope( SCOPE_BOTTOM, cBot )) // 3->(DbSetScope( SCOPE_TOP, cTop )); 3->(DbSetScope( SCOPE_BOTTOM, cBot )) ENDIF CASE cSuchArt = "s " cTitle := "Verstorbenen-Straáe unten eingeben:" IF Upper(AppName())$"MENGX.EXE" .AND. cSystem="S" SET INDEX TO xauftrnr,xname,xanspnam,xstrasse // cTop := "0000000"; cBot := "9999999" // 2->(DbSetScope( SCOPE_TOP, cTop )); 2->(DbSetScope( SCOPE_BOTTOM, cBot )) // 3->(DbSetScope( SCOPE_TOP, cTop )); 3->(DbSetScope( SCOPE_BOTTOM, cBot )) ENDIF CASE cSuchArt = "f " cTitle := oFocus:cargo + " unten eingeben:" // SET ORDER TO 5 cVariable := oFocus:cargo IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+Str(Month(1->&cVariable),2,0)+ ; Str(day(1->&cVariable),2,0) to x5 ELSE INDEX on 1->&cVariable TO x5 ENDIF SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 DbGoto( nRec ) ENDCASE ////// DbSuspendNotifications() DO WHILE .T. cSuch := Trim( ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) ) // cSuch := IIf(Val(cSuch)>0 .AND. Upper(cSuchArt)!="F", ; // IIf(AppName()=="MENGX.EXE",StrZERO(Val(cSuch),E,0),Str(Val(cSuch),E,0)), cSuch ) cSuch := IIf(Val(cSuch)>0 .AND. Upper(cSuchArt)!="F", StrX(Val(cSuch),E,0), cSuch ) cSuch := IIf( Len(cSuch)<3, PadR(cSuch,3,"!"), cSuch ) IF !Empty(cSuch) cSuch := IIf( !Empty(cSuchArt) .AND. ; (Asc(cSuch[1]) > 64 .OR. "."$cSuch .OR. "ORT"$oFocus:cargo), ; IIf( cSuch[2]=" ", cSuchArt+SubStr(cSuch,3,25),cSuchArt+cSuch), ; IIf( Asc(cSuch[1])>64 .AND. cSuch[2]!=" ", "v "+cSuch, cSuch ) ) ENDIF nRec := RecNo() IF Val(cSuch) > 0 .AND. Upper(Substr(cSuch,1,2)) != "F " // .or. Trim(cSuch) == "" SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := Padl(cSuch,E) lSuch := DbSeek( cAuf, .F. ) IF lSuch == .F. DbGoto(nRec) cSuch := cAuf := Space(E) LOOP ENDIF ELSEIF Trim(cSuch)=="" SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := StrX(1->auftrnr,E,0) ELSE DO CASE CASE Upper(Substr(cSuch,1,2)) = "F " SET ORDER TO 5 DbSkip(0) CASE Upper(Substr(cSuch,1,2)) = "V " SET ORDER TO 2 // Index nach Verstorbenem DbSkip(0) CASE Upper(Substr(cSuch,1,2)) = "A " SET ORDER TO 3 // Index nach Auftraggeber DbSkip(0) CASE Upper(Substr(cSuch,1,2)) = "S " SET ORDER TO 4 // Index nach Straáe DbSkip(0) OTHERWISE SET ORDER TO 1 // Index nach Auftrnr DbGoto( nRec ) // weil unzul„ssige Eingabe EXIT ENDCASE cauf := BestSuch( cSuch, cAuf, oDlg1 ) ENDIF IF val(cAuf) == 1->Auftrnr // wenn gefunden EXIT ELSEIF cAuf == "" // wenn nicht gefunden, gehe zum Ausgangspunkt DbGoto( nRec ) EXIT ELSE cAuf := Space(E) cTitle := "Andere Auftrag-Nr. :" ENDIF ENDDO oBestMaske:aData1 := SatzGetBest() ////// DbResumeNotifications() DbSkip(0) SetAppFocus( oFocus ) RETURN FUNCTION Modaldialog( cString, cTitle, oDlg1, nXsize, nYsize ) LOCAL nEvent, mp1, mp2, oXbp, mp1l, mp2l, oXbpl, lExit, nOldArea LOCAL oDlg, oSle, oMle, oFocus := SetAppFocus(), aPos, aSize, oCB, oListbox //, drawingArea LOCAL cDatei := cString, aStrings := {}, nRec, cItem PRIVATE cZeimax := "60" //26.11.2006 16:13 // LOCAL nV := AppDeskTop():currentsize()[1]/800 cTitle := IIf(cTitle="Bedienung", ; cTitle := cTitle + " Ende=, Druck=, Speichern=", ; cTitle ) aSize := oDlg1:currentSize() aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+Int(20*nV) ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oCB := oDlg:drawingArea oCB:cargo := oDlg aSize := oDlg:drawingArea:currentSize() IF nXsize < Int(600*nV) oXbp1 := XbpStatic():new( oCB,,{Int(12*nV),aSize[2]-Int(20*nV)},{aSize[1]-Int(20*nV),Int(20*nV)}) oXbp1:caption := "Die letzten 30 Auftr„ge:" oXbp1:CREATE() oListBox := XbpListBox():new( oCB,,{Int(12*nV),Int(84*nV)},{aSize[1]-Int(20*nV),aSize[2]-Int(100*nV)}) oListBox:create() DBSuspendNotifications() nRec := RecNo() IF nXSize = Int(333*nV) DbSeek( cString, .T. ) // das sind die Musterrechnungen: DO WHILE 1->auftrnr >= Val(cString) .and. 1->auftrnr < Val(cString)+30 AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+Trim(1->name)+", "+Trim(1->vorname)) DbSkip() ENDDO ELSE SET ORDER TO 0 GO BOTTOM FOR i := 1 TO 30 DO CASE CASE !Empty(cString) .AND. PadL(cString,E)[1]!=StrX(1->auftrnr,E,0)[1] //11.2.04 --i CASE !Empty(1->name) AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+Trim(1->name)+", "+Trim(1->vorname)+", "+ ; Trim(1->strasse)) CASE !Empty(1->ansp_name) AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+Trim(1->ansp_name)+", "+Trim(1->ansp_vname)+ ; ", "+Trim(1->ansp_str)) OTHERWISE IF 1->(IsFieldVar("gkz")) AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+1->gkz ) ELSEIF 1->(IsFieldVar("schladr")) AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+1->schladr ) ENDIF ENDCASE IIf( !Bof(), DbSkip( -1 ), i := 30 ) NEXT cString := IIf( Val(cString)>0 .AND. Len(aStrings)>0, ; IIf("Verst"$cTitle,Space(E),StrX(Val(Left(aStrings[1],E))+1,E,0)), ; cString ) //11.2.04 SET ORDER TO 1 ENDIF //+27.07.2013 21:39 umgebaut (Fehlermeldung in Usergroup)+++++++++ // AEval( aStrings, {|c| oListBox:addItem(c) } ) FOR i := 1 TO Len(aStrings) Sleep(1) //+27.07.2013 21:39 Vista-Problem ! oListBox:addItem(aStrings[i]) NEXT //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // AEval( aStrings, {|c| oListBox:addItem(c) } ) oListBox:setData( {1}, .T. ) GO nRec DbResumeNotifications() // aPos := { 12, ( aSize[2] - Int(20*nV) ) / 2 } aPos := { Int(12*nV), Int(48*nV) } oSle := XbpSle():new( oCB, , aPos, { aSize[1] - Int(20*nV), Int(24*nV) } ) oSle:TabStop := .T. oSle:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oSle:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oSle:dataLink := {|x| IIf( PCOUNT()==0, Trim( cString ), cString := x ) } oSle:create() oSle:setData( cString ) oSle:setName( 111 ) ELSEIF nXsize > Int(599*nV) cString := MemoRead( cString ) oMle := XbpMle():new( oCB,, {Int(30*nV),Int(40*nV)}, {nXsize-Int(60*nV),nYsize-Int(70*nV)}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oMle:dataLink := {|x| IIf( x==NIL, cString, cString := x ) } oMle:wordWrap := .T. oMle:horizScroll := IIf( Upper(cString) = "C:\HDBE\", .T., .F. ) oMle:create() //+27.07.2013 21:40 :setData() sleep(2) oMle:setData() ENDIF aPos := { ( aSize[1]-Int(72*nV) ) / 2, Int(12*nV) } oXbpBok := XbpPushbutton():new( oDlg:drawingArea,, aPos, {Int(72*nV),Int(24*nV)} ) oXbpBok:caption := "OK" oXbpBok:TabStop := .T. oXbpBok:create() oXbpBok:activate := {|| IIf( nXsize < Int(450*nV), cString := LTrim( oSle:getData() ), ), ; PostAppEvent( xbeP_Close ) } oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() oDlg1:invalidateRect() IF nXsize < Int(600*nV) oFocus := SetAppFocus( oSle ) ELSEIF nXsize > Int(599*nV) oFocus := SetAppFocus( oMle ) ENDIF nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick .and. oXbp:isDerivedFrom( "XbpListBox" ) cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cString := LTrim( oSle:getData() ) PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDIF IF nEvent == xbeM_LbClick .and. oXbp:isDerivedFrom( "XbpListBox" ) cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) ENDIF IF nEvent == xbeP_User cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC IF oXbp:isDerivedFrom( "XbpSle" ) oXbp:setData( " " ) cString := "" ENDIF PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_RETURN IF oXbp:isDerivedFrom( "XbpPushbutton" ) PostAppEvent( xbeP_Activate,,, oXbp ) ELSEIF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) cString := LTrim( oSle:getData() ) PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDIF CASE mp1 == xbeK_F10 IF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) cString := LTrim( oSle:getData() ) ENDIF PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpSle" ) SetAppFocus( oListBox ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpListBox" ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpSle" ) SetAppFocus( oListBox ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpListBox" ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_ALT_W .and. oXbp:isDerivedFrom( "XbpMle" ) cString := oMle:getdata() Memowrit( cDatei, cString ) oXbp:enable() CASE mp1 == xbeK_ALT_D .and. oXbp:isDerivedFrom( "XbpMle" ) cDummy := cLPT ; cLPT := "LPTA" SET DEVICE TO printw MemoDruck( aPrinterPS, aFont, aPaper, {5,5}, Trim(oMle:getData()), 1, {"10.COURIER NEW"} ) SET DEVICE TO SCREEN cLPT := cDummy CASE mp1 >= 32 .and. mp1 <= 255 IF oXbp:isDerivedFrom( "XbpListBox" ) SetAppFocus ( oSle ) oSle:CLEAR() PostAppEvent( xbeP_Keyboard, mp1, mp2, oSle ) // oSle:setData ( Chr(mp1) ) ENDIF ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO IF nXsize<600*nV // cString := oSle:getData() ELSE cString := oMle:getData() ENDIF oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN Trim( cString ) FUNCTION Neu( oDlg1, aData1, nXsize, nYsize, cKopie, cKreis ) // LOCAL cAuf := IIf(Empty(cKreis),Space(E),cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 LOCAL cAuf := IIf(Empty(cKreis),"000000",cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 LOCAL cTitle := "Neue Auftrag-Nr. unten eingeben :" DbSkip(0) IF auftrnr=0 DELETE ENDIF cAufalt := StrX( 1->auftrnr,E,0 ) DO WHILE .T. cAufneu := ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) cAufneu := IIf( Val(cAufneu)>0, StrX(Val(cAufneu),E,0), cAufneu ) IF Empty( cAufneu) EXIT ENDIF cAufneu := IIf( !Empty(cKopie), cKopie+cAufneu, cAufneu ) cAuf := IIf( Upper( Substr( cAufneu,1,1 ))="B", Substr( Padr(cAufneu,8),3,E), Padl(cAufneu,E ) ) cAuf := Padl( Trim( cAuf ), E ) 1->(DbSeek( cAuf )) IF Found() .AND. VAL( cAuf ) > 0 cAuf := Space(E) cTitle := "Schon belegt! Neue Auftrag-Nr. :" ELSEIF VAL( cAuf ) < 1000000 EXIT ELSE cAuf := Space(E) cTitle := "Zu lang! Neue Auftrag-Nr. :" ENDIF ENDDO oBestMaske:aData1 := SatzGetBest() IF VAL( cAufneu ) > 0 1->(DbAppend()) REPLACE 1->AUFTRNR WITH Val( cAuf ) aData1[1] := Val( cAuf ) IF IsFieldVar("todesurs") REPLACE todesurs with "natrlicher Tod" ENDIF REPLACE staatsan with "deutsch" IF Upper(AppName())$"MUELLX.EXE-BLEINX.EXE" REPLACE plz_ort WITH "Essen" REPLACE ansp_ort WITH "Essen" REPLACE eh_ort WITH "Essen" REPLACE geb_in WITH "Essen" REPLACE verst_in WITH "Essen" ENDIF IF IsMemVar("cStadt") REPLACE plz_ort WITH cStadt REPLACE ansp_ort WITH cStadt REPLACE eh_ort WITH cStadt REPLACE geb_in WITH cStadt // REPLACE verst_in WITH cStadt // heiát nicht berall gleich!!! ENDIF ELSEIF Upper( Substr( cAufneu,1,1 ) ) = "B" // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT 1->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 1->AUFTRNR WITH Val(cAuf) // 6.5.04 Val( Substr( Padr( cAufneu, 8 ),3,6 ) ) IF 1->(IsFieldVar("rechnr")) IF ValType(1->rechnr)=="C" REPLACE 1->RECHNR WITH "" // 30.1.2004 REPLACE 1->RECHNRN WITH "" // damit neue Auftr„ge nicht schon alte Rg-Nrn haben REPLACE 1->RECHNRN2 WITH "" REPLACE 1->RECHNRN3 WITH "" ENDIF ENDIF // IF Upper( AppName()) != "NOLTEX.EXE" // IIf(IsFieldVar("1->&r_b_0"), 1->&r_b_0 := 0, ) // IIf(IsFieldVar("1->&r_b_0h"), 1->&r_b_0h := 0, ) // IIf(IsFieldVar("1->&r_b_1"), 1->&r_b_1 := 0, ) // IIf(IsFieldVar("1->&r_b_1h"), 1->&r_b_1h := 0, ) // IIf(IsFieldVar("1->&r_b_2"), 1->&r_b_2 := 0, ) // IIf(IsFieldVar("1->&r_b_2h"), 1->&r_b_2h := 0, ) // IIf(IsFieldVar("1->&r_b_3"), 1->&r_b_3 := 0, ) // IIf(IsFieldVar("1->&r_b_3h"), 1->&r_b_3h := 0, ) // IIf(IsFieldVar("1->&r_b_n"), 1->&r_b_n := 0, ) // IIf(IsFieldVar("1->&r_b_nh"), 1->&r_b_nh := 0, ) // IIf(IsFieldVar("1->&r_s"), 1->&r_s := 0, ) // IIf(IsFieldVar("1->&r_sh"), 1->&r_sh := 0, ) // IIf(IsFieldVar("1->&v_m"), 1->&v_m := 0, ) // IIf(IsFieldVar("1->&v_mh"), 1->&v_mh := 0, ) // IIf(IsFieldVar("1->&t_l"), 1->&t_l := 0, ) // IIf(IsFieldVar("1->&t_lh"), 1->&t_lh := 0, ) // ENDIF ////// FIND &cAufalt // 5.6.04 : wozu denn? // Versicherungseintr„ge in den Bestattungsfall kopieren: // cVerstemp := "ver2"+LTrim(Str(Int(Seconds()/10))) cVerstemp := "v_"+cAufalt // 5.6.04 bisher: LTrim(StrX(1->auftrnr,E,0)) SELECT 2 COPY STRU TO (cVerstemp) aDataV := Array(FCount()) SELECT 12 USE (cVerstemp) EXCLUSIVE SELECT 2 FIND &cAufalt do while 2->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 12 12->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 12->AUFTRNR WITH Val(cAuf) // 6.5.04 Val( Substr( cAufneu,3,6 ) ) REPLACE 12->&b_b_g WITH 0 // 5.6.04 : noch kein Zahlungseingang SELECT 2 skip enddo SELECT 12 USE SELECT 2 APPEND FROM (cVersTemp) // Rechnungsdaten in den Bestattungsfall kopieren: cAuf3temp := "r_"+cAufalt // 5.6.04 //LTrim(StrX(1->auftrnr,E,0)) // cAuf3temp := "auf3"+LTrim(Str(Int(Seconds()/10))) SELECT 3 COPY STRU TO (cAuf3temp) aDataV := Array(FCount()) SELECT 13 // Zwischendatei erzeugen und daraus die neue Rechnung USE (cAuf3temp) EXCLUSIVE SELECT 3 FIND &cAufalt do while 3->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 13 13->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 13->AUFTRNR WITH Val(cAuf) // 6.5.04 Val( Substr( cAufneu,3,6 ) ) REPLACE 13->rn WITH " " // 5.6.04 : alles in die 1.Rg SELECT 3 skip enddo SELECT 13 IF .NOT. Bof() GO TOP ENDIF aData2 := Array(FCount()) nGS := 0 DO WHILE .NOT. Eof() FOR n := 1 to FCount() aData2[n] := FieldGet( n ) NEXT SELECT 3 APPEND BLANK FOR n := 1 to FCount() FieldPut( n, aData2[n] ) NEXT DbRUnlock( Recno() ) // ... und unlock nGS := nGS + 3->&b_g // Artikel-Daten korrigieren: cArt := 3->zugr_z_st SELECT 6 FIND &cArt Satzsp( oDlg1 ) REPLACE 6->bestand WITH 6->bestand-1 REPLACE 6->mgjahr WITH 6->mgjahr+1 IIf(6->(IsFieldVar("umsatz")), 6->umsatz := 6->umsatz + 3->betrag, ) IIf(6->(IsFieldVar("umsatzeu")), 6->umsatzeu := 6->umsatzeu + 3->betrageu, ) DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 1 // FIND &cAuf // 6.5.04 ( Padl( Substr( cAufneu,3,E ), E) ) IF Upper(AppName())$"KOMPAKTX.EXE" REPLACE 1->&r_b_0 WITH nGS ELSE REPLACE 1->&r_b_0 WITH nGS REPLACE 1->&r_s WITH nGS REPLACE 1->&t_l WITH nGS REPLACE 1->&v_m WITH 0 REPLACE 1->&r_b_1 WITH 0 REPLACE 1->&r_b_2 WITH 0 REPLACE 1->&r_b_3 WITH 0 // Rechbetr( 0, nGS, oDlg1 ) ENDIF FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) ENDIF DbSkip(0) ////// oDlg1:cargo:readData() // SetAppFocus ( oDlg1 ) RETURN aData1 PROCEDURE F1( cDatei, cTitle, oDlg1, nXsize, nYsize ) ModalDialog( cDatei, cTitle, oDlg1, nXsize, nYsize ) // SetAppFocus ( oDlg1 ) RETURN FUNCTION Ehe( oDlg1, nXsize, nYsize ) LOCAL aEhe := {} LOCAL cTitle := "Ehe-Partner :" DbSkip(0) IF Empty( 1->EH_NAME ) Satzsp(oDlg1) REPLACE 1->EH_NAME WITH 1->name REPLACE 1->EH_VNAME WITH IIf(1->ansp_bez="Ehe",1->ansp_vname,Trim(" ")) REPLACE 1->EH_GEBN WITH Trim(" ") REPLACE 1->EH_STR WITH 1->strasse REPLACE 1->EH_ORT WITH 1->plz_ort REPLACE 1->EH_GEBD WITH CtoD(" ") // REPLACE 1->EH_NAME WITH oDlg1:childFromName( 1->(FieldPos( "name" )) ):getData() // REPLACE 1->EH_VNAME WITH Trim(" ") // REPLACE 1->EH_GEBN WITH Trim(" ") // REPLACE 1->EH_STR WITH oDlg1:childFromName( 1->(FieldPos( "strasse" )) ):getData() // REPLACE 1->EH_ORT WITH oDlg1:childFromName( 1->(FieldPos( "plz_ort" )) ):getData() // REPLACE 1->EH_GEBD WITH CtoD(" ") DbRUnlock(RecNo()) ENDIF EheDialog( oDlg1, cTitle, nXsize, nYsize ) RETURN .T. FUNCTION Ehedialog( oDlg1, cTitle, nXsize, nYsize ) LOCAL nEvent, mp1, mp2, oXbp, lExit, aEditControls := {}, oEhe LOCAL oDlg, oSle, oFocus, oCtrlE, aPos, aSize //, drawingArea LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } LOCAL aPPTxt, y LOCAL nBo := nYsize - 50 // tats„chliche Bildschirmaufl”sung: LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL n5 := 5*nV LOCAL n10 := 10*nV LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 // LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 LOCAL nFa := 0 PRIVATE oCB, oXbp1 aSize := oDlg1:currentSize() aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+20 ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oDlg:Close := {|| lExit := .T. } oCB := oDlg:drawingArea oCB:cargo := oDlg oCB:setColorBG( XBPSYSCLR_TRANSPARENT ) // damit Farbe durchscheint // jetzt folgt die Erzeugung der Eingabefelder oEhe := BestFF():new( oCB,oDlg, {0,0}, {nXSize,nYSize-35*nV},,, 25*nV, "s_best", 500, 599, 1 ) oEhe:CREATE( oCB,oDlg, {0,0}, {nXSize,nYSize-35*nV},,, 25*nV, "s_best", 500, 599, 1 ) AEval( oEhe:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oEhe:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder // ***** nur fr die PLZ-Suche aktivieren: // oDlg:childFromName( 1->(FieldPos( "eh_ort" )) ):killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ), ; // obj:setData( ; // Plz( oDlg:childFromName( 1->(FieldPos( "eh_str" )) ):getdata(), ; // oDlg:childFromName( 1->(FieldPos( "eh_ort" )) ):getdata() )) } oDlg:setModalState( XBP_DISP_APPMODAL ) // oDlg:show() // oFocus := SetAppFocus( oDlg:childFromName( 1->(FieldPos( "eh_name" )) ) ) oCtrlE := XbpGetController():new( oDlg ) oCtrlE:create() oCtrlE:READ( , .F. ) oDlg:invalidateRect() nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .AND. oXbp:isDerivedFrom( "oXbpPushButton" ) Satzsp(oCB) Gather( aEditControls ) DbRUnlock() PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_ESC .OR. mp1 == xbeK_F10 .OR. mp1 == xbeK_PGDN Satzsp(oCB) Gather( aEditControls ) DbRUnlock() PostAppEvent( xbeP_Close ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() // SetAppFocus( oFocus ) RETURN .T. FUNCTION ModalFen( cString, cTitle, oDlg1, nXsize, nYsize ) LOCAL nEvent, mp1, mp2, oXbp, lExit LOCAL oDlg, oSle, oMle, oFocus, aPos, ASize, nSemi := 0 //, drawingArea PRIVATE oCB nXsize := IIf( nXSize<>NIL, nXSize, 300 ) nYsize := IIf( nYsize<>NIL, nYsize, 300 ) nY := Int(nYSize*.75) nBz := 30 cTitle := IIf( cTitle<>NIL, cTitle, "A C H T U N G !" ) cString := IIf( cString<>NIL, cString, "Datensatz "+LTrim(Str(Recno()))+" ist z.Zt. gesperrt!" ) oDlg1 := IIf( oDlg1<>NIL, oDlg1, AppDesktop() ) aSize := oDlg1:currentSize() aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+20 ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oDlg:drawingArea:setColorBG( GRA_CLR_YELLOW ) oCB := oDlg:drawingArea oCB:cargo := oDlg oFocus := SetAppFocus( oDlg ) DO WHILE (nSemi := IIf( At( ";", cString )>0 , At( ";", cString ), Len(cString)+1 ) ) > 1 oXbp := XbpStatic():new( oDlg:drawingarea, , {20, nY := nY - nBz }, {nXsize-40,30} ) oXbp:caption := Left( cString, nSemi-1 ) cString := IIf( nSemi>Len(cString), "", SubStr( cString, nSemi+1 ) ) oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_CENTER oXbp:create() ENDDO aSize := oDlg:drawingArea:currentSize() aPos := { ( aSize[1]-72 ) / 2, 12 } oXbpBok := XbpPushbutton():new( oDlg:drawingArea,, aPos, {72,24} ) oXbpBok:caption := "OK" oXbpBok:TabStop := .T. oXbpBok:create() oXbpBok:activate := {|| PostAppEvent( xbeP_Close ) } oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC cString := "ESC" PostAppEvent( xbeP_Activate,,, oXbpBok ) CASE mp1 == xbeK_RETURN .OR. mp1 == xbeK_F10 cString := "!" PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN Trim( cString ) FUNCTION KVWAdressen( cVerskz, oDlg1, cFAdr0, cFAdr1, cFAdr2, cFAdr3, cFAdr4 ) LOCAL oDlg, nEvent, mp1, mp2 LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nOldArea := Select() LOCAL lFlucht := .F., oFocus PRIVATE oCB IF Trim( Upper( cVerskz ) ) == "W" Satzsp( oDlg1 ) (nOldArea)->&cFAdr0 := cVerskz (nOldArea)->&cFAdr1 := IIf(Upper(cVerskz)=cVerskz,"in der Wohnung","zu Hause") (nOldArea)->&cFAdr2 := 1->strasse (nOldArea)->&cFAdr3 := 1->plz_ort ELSE SELECT 5 SET SOFTSEEK ON FIND &cVerskz SET SOFTSEEK OFF oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "Adressen suchen:" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10,10}, {int(770*nH),int(500*nV)} ) oDlg:drawingArea:setColorBG( GRA_CLR_BLUE ) oCB := oDlg:drawingArea oCB:cargo := oDlg APPBROWSE ; PARENT oDlg:drawingArea ; POSITION TOP ; FONT &cFont ; SIZE 100,100 PERCENT APPFIELD verskz CAPTION "Kennz" WIDTH 5 APPFIELD name1 CAPTION "Name1" WIDTH 15 APPFIELD name2 CAPTION "Name2" WIDTH 15 APPFIELD strasse CAPTION "Straáe" WIDTH 15 APPFIELD plz_ort CAPTION "PLZ Ort" WIDTH 15 APPFIELD tel CAPTION "Telefon" WIDTH 10 IF IsFieldVar( "brname" ) APPFIELD brname CAPTION "Name in der Aufstellung" WIDTH 20 ELSEIF IsFieldVar( "abrname" ) APPFIELD abrname CAPTION "Name in der Aufstellung" WIDTH 20 ELSE APPFIELD anschr1 CAPTION "Name in der Aufstellung" WIDTH 20 ENDIF IF IsFieldVar( "gruppe" ) APPFIELD gruppe CAPTION "Gruppe" WIDTH 2 ELSE APPFIELD etgruppe CAPTION "Gruppe" WIDTH 2 ENDIF APPDISPLAY MODELESS // oFocus := SetAppFocus( ) // wird das wirklich gebraucht?? oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() // SetAppFocus( oFocus ) Select &nOldArea IF lFlucht = .F. // ESC-Taste: lFlucht = .T. IF cFAdr1 = "preisgr" // also z.Zt. nur bei Raguse Satzsp( oDlg1 ) (nOldArea)->&cFAdr0 := 5->verskz (nOldArea)->&cFAdr1 := 5->preisgr (nOldArea)->&cFAdr2 := 5->abschlag (nOldArea)->&cFAdr3 := 5->zahlbed nRet := ConfirmBox( oDlg1, "Verst: / Auftraggeber: ", ; "Verstorbenen-Adresse „ndern ?(ESC=keine) ...", ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) IF nRet == XBPMB_RET_YES 1->anrede := "" 1->vorname := 5->name1 1->name := 5->name2 1->geb_name="" 1->strasse := 5->strasse 1->plz_ort := 5->plz_ort oDlg1:childFromName( 1->(FieldPos( "anrede" )) ):setdata("") oDlg1:childFromName( 1->(FieldPos( "vorname" )) ):setdata(5->name1) oDlg1:childFromName( 1->(FieldPos( "name" )) ):setdata(5->name2) oDlg1:childFromName( 1->(FieldPos( "geb_name" )) ):setdata("") oDlg1:childFromName( 1->(FieldPos( "strasse" )) ):setdata(5->strasse) oDlg1:childFromName( 1->(FieldPos( "plz_ort" )) ):setdata(5->plz_ort) ELSEIF nRet == XBPMB_RET_NO 1->ansp_anr := "" 1->ansp_vname := 5->name1 1->ansp_name := 5->name2 1->ansp_bez := "" 1->ansp_str := 5->strasse 1->ansp_ort := 5->plz_ort 1->ansp_bankv := 5->bankv 1->ansp_kto := 5->kto 1->ansp_blz := 5->blz 1->ansp_ktoi := 5->anschr1 oDlg1:childFromName( 1->(FieldPos( "ansp_anr" )) ):setdata("") oDlg1:childFromName( 1->(FieldPos( "ansp_vname" )) ):setdata(5->name1) oDlg1:childFromName( 1->(FieldPos( "ansp_name" )) ):setdata(5->name2) oDlg1:childFromName( 1->(FieldPos( "ansp_bez" )) ):setdata("") oDlg1:childFromName( 1->(FieldPos( "ansp_str" )) ):setdata(5->strasse) oDlg1:childFromName( 1->(FieldPos( "ansp_ort" )) ):setdata(5->plz_ort) oDlg1:childFromName( 1->(FieldPos( "ansp_bankv" )) ):setdata(5->bankv) oDlg1:childFromName( 1->(FieldPos( "ansp_kto" )) ):setdata(5->kto) oDlg1:childFromName( 1->(FieldPos( "ansp_blz" )) ):setdata(5->blz) oDlg1:childFromName( 1->(FieldPos( "ansp_ktoi" )) ):setdata(5->anschr1) ENDIF ELSEIF cFAdr0 = "gkz#" // also z.Zt. nur Experiment cFAdr0 := "gkz" cGKZ := 1->gkz nAntw := ConfirmBox( oDlg1, "fllen/„ndern: / so lassen: ", ; "Angeh”rigen-Adresse fllen ?(ESC=abbrechen) ...", ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) Satzsp( oDlg1 ) IF nAntw == XBPMB_RET_YES (nOldArea)->&cFAdr0 := 5->verskz (nOldArea)->&cFAdr1 := 5->name1 (nOldArea)->&cFAdr2 := 5->name2 (nOldArea)->&cFAdr3 := 5->strasse (nOldArea)->&cFAdr4 := 5->plz_ort ELSEIF nAntw == XBPMB_RET_NO (nOldArea)->&cFAdr0 := 5->verskz ELSE (nOldArea)->&cFAdr0 := cGKZ ENDIF // oDlg1:childFromName( 1->(FieldPos( cFAdr0 )) ):setdata((nOldArea)->&cFAdr0) ELSEIF cFAdr0 = "gkz" // also z.Zt. nur bei Doennewald // inzwischen bei allen... Satzsp( oDlg1 ) (nOldArea)->&cFAdr0 := 5->verskz (nOldArea)->&cFAdr1 := 5->verskz (nOldArea)->&cFAdr2 := 5->verskz (nOldArea)->&cFAdr3 := 5->verskz oDlg1:childFromName( 1->(FieldPos( cFAdr0 )) ):setdata((nOldArea)->&cFAdr0) ELSEIF cFAdr0 = "PvGKZ#" // also z.Zt. nur bei Nolte cFAdr0 := "PvGKZ" &cFAdr0 := 5->verskz ELSEIF cFAdr0 = "PvGKZ" // also z.Zt. nur bei Nolte nAntw := "#"$cVerskz .OR. ConfirmBox( oDlg1, "fllen/„ndern: / so lassen: ", ; "Angeh”rigen-Adresse fllen ?(ESC=abbrechen) ...", ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) IF nAntw == XBPMB_RET_YES oBest:XbpObjekt( oBest:singleZeile, cFAdr0 ):setData( 5->verskz ) oBest:XbpObjekt( oBest:singleZeile, cFAdr1 ):setData( 5->name1 ) oBest:XbpObjekt( oBest:singleZeile, cFAdr2 ):setData( 5->name2 ) oBest:XbpObjekt( oBest:singleZeile, cFAdr3 ):setData( 5->strasse) oBest:XbpObjekt( oBest:singleZeile, cFAdr4 ):setData( 5->plz_ort) ELSEIF nAntw == XBPMB_RET_NO oBest:XbpObjekt( oBest:singleZeile, cFAdr0 ):setData( 5->verskz ) ELSE oBest:XbpObjekt( oBest:singleZeile, cFAdr0 ):setData( "" ) ENDIF ELSE Satzsp( oDlg1 ) (nOldArea)->&cFAdr0 := 5->verskz (nOldArea)->&cFAdr1 := 5->name1 (nOldArea)->&cFAdr2 := 5->strasse (nOldArea)->&cFAdr3 := 5->plz_ort ENDIF ENDIF ENDIF DbSkip(0) // oDlg1:childFromName( 1->(FieldPos( cFAdr0 )) ):setdata((nOldArea)->&cFAdr0) // oDlg1:childFromName( 1->(FieldPos( cFAdr1 )) ):setdata((nOldArea)->&cFAdr1) // oDlg1:childFromName( 1->(FieldPos( cFAdr2 )) ):setdata((nOldArea)->&cFAdr2) // oDlg1:childFromName( 1->(FieldPos( cFAdr3 )) ):setdata((nOldArea)->&cFAdr3) RETURN DbRUnlock(RecNo()) FUNCTION Ansprech( oDlg1, nXehe, nYehe ) DbSkip(0) IF !Empty( 1->ansp_bez ) IF ConfirmBox( oDlg1, "Ist Ansprechpartner = Ehepartner?", ; "Ansprechpartner „ndern", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_NO RETURN .F. ENDIF ENDIF Satzsp( oDlg1 ) IF 1->anrede = "Herr" 1->ansp_anr := "Frau" 1->ansp_bez := "Ehefrau" ELSEIF 1->anrede = "Frau" 1->ansp_anr := "Herr" 1->ansp_bez := "Ehemann" ENDIF 1->ansp_name := 1->name 1->ansp_vname := 1->eh_vname 1->ansp_str := 1->strasse 1->ansp_ort := 1->plz_ort DbSkip(0) RETURN DbRUnlock(RecNo()) FUNCTION Plz( xstr, xort, cStrasse ) // 29.10.2004 LOCAL nOldArea := Select() LOCAL cPlz := IIf(At(" ",xort)>0,SubStr(xort,1,At(" ",xort)-1),"") // 29.10.2004 LOCAL cNeueStrasse := IIf(xstr="!","j","") // 29.10.2004 DbSuspendNotifications() IF cNeueStrasse == "j" .AND. !Empty(cStrasse) // 29.10.2004 xstr := SubStr(xstr,2) cStrasse := xstr SKIP(0) ENDIF DO WHILE .t. IF "ESSEN"$Upper(xort) xort := "Essen" xdatei="Essen.dbf" xindex="xessen" ELSEIF "DIN"$Upper(xort) xort := "Dinslaken" xdatei="Din.dbf" xindex="xdin" ELSEIF "KREFELD"$Upper(xort) xort := "Krefeld" xdatei="Krefeld.dbf" xindex="xkrefeld" ELSE EXIT ENDIF SELECT 10 USE &xdatei INDEX &xindex xstr=trim(xstr) xstelle=0 xzahl=0 xnr="0" gefunden=0 DO WHILE .t. xzahl=xzahl+1 IF xzahl>len(xstr) EXIT ENDIF IF Substr(xstr,xzahl,1) >="1" .and. Substr(xstr,xzahl,1) <= "9" xnr=Substr(xstr,xzahl,5) xnr=trim(xnr) xstr=Substr(xstr,1,xzahl-1) xstr=Trim(xstr) gefunden=1 EXIT ENDIF ENDDO IF gefunden=0 xort="????? "+Substr(xort,1,24) EXIT ENDIF xxx=0 xxx=At("Straáe",xstr) IF xxx<>0 xstr=Substr(xstr,1,xxx+2) ENDIF xxx=0 xxx=At("straáe",xstr) IF xxx<>0 xstr=Substr(xstr,1,xxx+2) ENDIF IF cNeueStrasse = "j" // 29.10.2004 APPEND BLANK 10->plz := cPlz 10->strasse := xstr 10->kennz := "0" ELSE FIND &xstr IF Eof() xort="????? "+substr(xort,1,24) EXIT ENDIF ENDIF IF kennz="0" xort=plz+" "+Substr(xort,1,24) ELSE ynr=val(xnr) IF ynr>0 IF ynr/2=Int(ynr/2) xgerade="1" ELSE xgerade="2" ENDIF ELSE xgerade=0 ENDIF DO while .t. xvon=val(Substr(nr,1,4)) xbis=val(Substr(nr,9,4)) IF xbis=0 xbis=999 ENDIF IF (kennz=xgerade).and.(ynr>=xvon).and.(ynr<=xbis) xort=plz+" "+Substr(xort,1,24) EXIT ENDIF SKIP IF Eof() EXIT ENDIF IF Substr(strasse,1,Len(xstr))=xstr LOOP ELSE xort="????? "+Substr(xort,1,24) EXIT ENDIF ENDDO ENDIF EXIT ENDDO SELECT &nOldArea DbResumeNotifications() IIf(DbRLock(),,) // vorsichtshalber RETURN Trim(xort) FUNCTION BestSuch( cSuch, cAuf, oDlg1 ) LOCAL oDlg, nEvent, mp1, mp2 LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nOldArea := Select() LOCAL lFlucht := .F. PRIVATE oCB GO TOP oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "Bestattungsfall suchen zu >" + cSuch +"<" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10,10}, {int(740*nH),int(460*nV)} ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg cKey := Upper(Substr(cSuch,1,1)) cSuch := Upper(Substr(cSuch,3,25)) IF cKey = "F" .and. "."$cSuch .AND. Len(cSuch)=10 cSuch := SubStr(cSuch,7,4)+SubStr(cSuch,4,2)+SubStr(cSuch,1,2) ENDIF SET SOFTSEEK ON FIND &cSuch SET SOFTSEEK OFF APPBROWSE ; PARENT oDlg:drawingArea ; POSITION TOP ; FONT &cFont ; SIZE 95,100 PERCENT DO CASE CASE cKey = "F" // APPFIELD Ordkey() CAPTION Ordkey() WIDTH 6 APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Sterbe-Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 APPFIELD geb_datum CAPTION "geb. am" WIDTH 6 CASE cKey = "V" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Sterbe-Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 APPFIELD geb_datum CAPTION "geb. am" WIDTH 6 CASE cKey = "A" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Sterbe-Datum" WIDTH 6 APPFIELD ansp_name CAPTION "Name (Auftraggeber)" WIDTH 12 APPFIELD ansp_vname CAPTION "Vorname" WIDTH 10 APPFIELD ansp_str CAPTION "Straáe" WIDTH 12 APPFIELD ansp_ort CAPTION "Ort" WIDTH 12 APPFIELD geb_datum CAPTION "geb. am" WIDTH 6 CASE cKey = "S" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Sterbe-Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 APPFIELD geb_datum CAPTION "geb. am" WIDTH 6 ENDCASE APPDISPLAY MODELESS oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() IF lFlucht = .F. // ESC-Taste: lFlucht = .T. cAuf := StrX( 1->auftrnr,E,0 ) ELSE cAuf := Trim(" ") ENDIF RETURN cAuf //23.12.2006 22:57 abgeglichen: 21.05.2007 17:43 PROCEDURE SummenSetzen(lIndex) // mit ALT-F12 LOCAL nOldArea := SELECT(), nRec1 := 1->(RecNo()), nRec2 := 2->(RecNo()), nRec3 := 3->(RecNo()) LOCAL nSumme := 0, nSumme1 := 0, nSumme2 := 0, nSumme3 := 0, nSummeN := 0 LOCAL nAuf, nAufalt, nSummeEL := 0, nSummeFL := 0 DEFAULT lIndex TO .F. //17.12.2006 12:06 .T., wenn aufgerufen von IneuX() SELECT 1 USE best EXCLUSIVE SET INDEX TO xauftrnr DbSuspendNotifications() IF Upper(AppName())$"BERGX.EXE" //"KOMPAKTX.EXE" Jahr2000-Korrektur ( DO WHILE !Eof() //15.01.2007 22:33 fr Hartenstein cJahr := IIf( 1->auftrnr>900000, "19"+SubStr(Str(1->auftrnr,6),1,2), ; IIf( 1->auftrnr>200000 .AND. 1->auftrnr<270000, ; "200"+SubStr(Str(1->auftrnr,6),2,1)," ")) IF DtoC(1->gestorben)!=" " cJahr := IIf(cJahr=" ",Str(Year(1->gestorben),4),cJahr) 1->gestorben := CtoD( Str(Day(1->gestorben),2)+"."+Str(Month(1->gestorben),2)+"."+cJahr ) // DatumDifferenz( 1->geb_datum, 1->gestorben, "1->jahre" ) ENDIF IF DtoC(1->messedat)!=" " cJahr := IIf(cJahr=" ",Str(Year(1->messedat),4),cJahr) 1->messedat := CtoD( Str(Day(1->messedat),2)+"."+Str(Month(1->messedat),2)+"."+cJahr ) ENDIF IF DtoC(1->trauerdat)!=" " cJahr := IIf(cJahr=" ",Str(Year(1->trauerdat),4),cJahr) 1->trauerdat := CtoD( Str(Day(1->trauerdat),2)+"."+Str(Month(1->trauerdat),2)+"."+cJahr ) ENDIF IF DtoC(1->beerd_dat)!=" " cJahr := IIf(cJahr=" ",Str(Year(1->beerd_dat),4),cJahr) 1->beerd_dat := CtoD( Str(Day(1->beerd_dat),2)+"."+Str(Month(1->beerd_dat),2)+"."+cJahr ) ENDIF IF DtoC(1->urndat)!=" " cJahr := IIf(cJahr=" ",Str(Year(1->urndat),4),cJahr) 1->urndat := CtoD( Str(Day(1->urndat),2)+"."+Str(Month(1->urndat),2)+"."+cJahr ) ENDIF SKIP ENDDO ENDIF IF Upper(AppName())$"KOMPAKTX.EXE" //Jahr2000-Korrektur DO WHILE !Eof() //26.06.2007 10:17 fr Hartenstein IF 1->(IsFieldVar("gestorben")).AND.DtoS(1->gestorben)<"19080101".AND.Year(1->gestorben)>1900 1->gestorben := CtoD(Stuff(DtoC(1->gestorben),7,2,"20")) ELSEIF 1->(IsFieldVar("kidatum")).AND.DtoS(1->kidatum)<"19080101".AND.Year(1->kidatum)>1900 1->kidatum := CtoD(Stuff(DtoC(1->kidatum),7,2,"20")) ELSEIF 1->(IsFieldVar("beerd_dat")).AND.DtoS(1->beerd_dat)<"19080101".AND.Year(1->beerd_dat)>1900 1->beerd_dat := CtoD(Stuff(DtoC(1->beerd_dat),7,2,"20")) ELSEIF 1->(IsFieldVar("feierdat")).AND.DtoS(1->feierdat)<"19080101".AND.Year(1->feierdat)>1900 1->feierdat := CtoD(Stuff(DtoC(1->feierdat),7,2,"20")) ELSEIF 1->(IsFieldVar("urndat")).AND.DtoS(1->urndat)<"19080101".AND.Year(1->urndat)>1900 1->urndat := CtoD(Stuff(DtoC(1->urndat),7,2,"20")) ENDIF SKIP ENDDO ENDIF GO TOP SELECT 2 DbSuspendNotifications() GO TOP nAufalt := 2->auftrnr DO WHILE !Eof() .AND. !lIndex //17.12.2006 12:24: nur wenn nicht vom Index aufgerufen nSumme := nSumme + 2->&b_b_g SKIP IF 2->auftrnr != nAufalt 1->(DbSeek( StrX(nAufalt,E,0), .F. )) IF !1->(Eof()) 1->&v_m := Round(nSumme,2) 1->&t_l := 1->&r_s - 1->&v_m ENDIF nSumme := 0 nAufalt := 2->auftrnr ENDIF ENDDO nSumme := 0 SELECT 3 IF Upper(AppName()) == "KOMPAKTX.EXE" use auftr_b EXCLUSIVE SET index TO xaufaufB ELSE use auftr EXCLUSIVE SET index TO xaufauf ENDIF DbSuspendNotifications() GO TOP nAufalt := 3->auftrnr DO WHILE !Eof() 1->(DbSeek( StrX(nAufalt,E,0), .F. )) IF 1->(IsFieldVar("auftrdat")).AND.DtoS(1->auftrdat)<"19900101" // 26.06.2007 10:02 IF 1->(IsFieldVar("gestorben")).AND.DtoS(1->gestorben)>"19900101" 1->auftrdat := 1->gestorben ELSEIF 1->(IsFieldVar("beerd_dat")).AND.DtoS(1->beerd_dat)>"19900101" 1->auftrdat := 1->beerd_dat ELSEIF 1->(IsFieldVar("urndat")).AND.DtoS(1->urndat)>"19900101" 1->auftrdat := 1->urndat ENDIF ENDIF IF Upper(AppName())=="BERGX.EXE" //17.03.2007 23:20 weil bisher ttmm nicht gefllt wurde! IF 3->ttmm = " " .OR. "."$3->ttmm IF DtoC(1->urndat)!=" " 3->ttmm := SubStr(DtoC(1->urndat),1,2)+SubStr(DtoC(1->urndat),4,2) ELSEIF DtoC(1->beerd_dat)!=" " 3->ttmm := SubStr(DtoC(1->beerd_dat),1,2)+SubStr(DtoC(1->beerd_dat),4,2) ENDIF ENDIF IF DtoS(1->auftrdat) < "20070201" //16.04.2007 22:04 3->jn := "j" 3->artvkeu := 3->&b_g ENDIF ENDIF IF Upper(AppName())=="SANDERX.EXE" //22.01.2008 15:27 durch Falscheingaben bei Rechnung IF 3->kennz == "1" 3->mwst_schl := IIf(3->mwst_schl$" 01","3",3->mwst_schl) 3->mwst_satz := zschl_voll ENDIF IF 3->kennz == "2" 3->mwst_schl := IIf(3->mwst_schl$" 23","0",3->mwst_schl) 3->mwst_satz := 0 ENDIF ENDIF IF 3->(IsFieldVar("r_datum")) //22.08.2006 09:52 // IF DtoC(3->r_datum) = " " // wenn noch keine Rechnung gedruckt 22.01.2007 18:20 IF DtoC(3->r_datum) = " " .OR. (SubStr(DtoC(3->r_datum),1,2)+SubStr(DtoC(3->r_datum),4,2))!=3->ttmm .OR. ; //+06.03.2011 18:49 Langex-Probleme mit Rechnungsdatum (Upper(AppName())$"LANGEX.EXE" .AND. Year(3->r_datum) != Year(1->gestorben)) // wenn noch keine Rechnung gedruckt 22.01.2007 18:20 IF Empty(3->ttmm) .AND. "KOMPAKT"$Upper(AppName()) //15.01.2007 22:32 fr Hartenstein 3->r_datum := IIf(DtoC(1->beerd_dat)!=" ",1->beerd_dat,1->auftrdat) 3->ttmm := StrX(Day(3->r_datum),2)+StrX(Month(3->r_datum),2) ELSEIF 1->(IsFieldVar("auftrdat")).AND.DtoC(1->auftrdat)!=" " .AND. 3->ttmm != " " //22.08.2006 09:44 3->r_datum := CtoD(SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( Month(1->auftrdat)>Val(SubStr(3->ttmm,3))+9, ; Str(Year(1->auftrdat)+1,4,0),Str(Year(1->auftrdat),4,0))) ELSEIF 1->(IsFieldVar("gestorben")).AND.DtoC(1->gestorben)!=" " .AND. 3->ttmm != " " 3->r_datum := CtoD(SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( Month(1->gestorben)>Val(SubStr(3->ttmm,3))+9, ; Str(Year(1->gestorben)+1,4,0),Str(Year(1->gestorben),4,0))) ELSEIF 1->(IsFieldVar("beerd_dat")).AND.DtoC(1->beerd_dat)!=" " .AND. 3->ttmm != " " //22.08.2006 09:44 3->r_datum := CtoD(SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( Month(1->beerd_dat)>Val(SubStr(3->ttmm,3))+9, ; Str(Year(1->beerd_dat)+1,4,0),Str(Year(1->beerd_dat),4,0))) ELSEIF 1->(IsFieldVar("urndat")).AND.DtoC(1->urndat)!=" " .AND. 3->ttmm != " " //22.08.2006 09:44 3->r_datum := CtoD(SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( Month(1->urndat)>Val(SubStr(3->ttmm,3))+9, ; Str(Year(1->urndat)+1,4,0),Str(Year(1->urndat),4,0))) ELSEIF Empty(3->ttmm) 3->r_datum := CtoD("") ELSE // Tone(1000,5) ENDIF ENDIF 3->mwst_satz := IIf(3->mwst_schl="3", ; IIf(DtoC(3->r_datum)=" ",zschl_voll, ; IIf(Year(3->r_datum)>2006,19, ; IIf(3->r_datum>CtoD("31.03.1998"),16, ; IIf(Year(3->r_datum)>1993,15, ; IIf(Year(3->r_datum)>1985,14,0))))), ; IIf(3->mwst_schl="2",zschl_halb,0)) IF 3->(IsFieldVar("betneteu")) //09.02.2007 12:15 3->betneteu := Round(3->betrageu/(1+3->mwst_satz/100),2) ELSEIF 3->(IsFieldVar("betbrteu")) 3->betbrteu := Round(3->betrageu*(1+3->mwst_satz/100),2) ENDIF ENDIF IF !lIndex IF Upper(AppName())$"NOLTEX.EXE" // 19.09.2005 Summen sind BRUTTO-Betr„ge nSumme := 0 ; nSumme3 := 0 nSumme1 := IIf( 3->rn$" 0", nSumme1 + 3->betbrteu, nSumme1 ) nSumme2 := IIf( 3->rn=="2", nSumme2 + 3->betbrteu, nSumme2 ) nSummeN := IIf( 3->rn=="3", nSummeN + 3->betbrteu, nSumme3 ) // fr Nolte nSummeEL := IIf( 3->kennz=="1", nSummeEL + 3->betbrteu, nSummeEL ) // bei Nolte zur Kontrolle nSummeFL := IIf( 3->kennz$"23", nSummeFL + 3->betbrteu, nSummeFL ) // bei Nolte zur Kontrolle ELSEIF cBrNe3 == "N" // Summen als Nettobetr„ge nSumme := IIf( 3->rn==" ", nSumme + 3->&b_n, nSumme ) nSumme1 := IIf( 3->rn=="1", nSumme1 + 3->&b_n, nSumme1 ) nSumme2 := IIf( 3->rn=="2", nSumme2 + 3->&b_n, nSumme2 ) nSumme3 := IIf( 3->rn=="3", nSumme3 + 3->&b_n, nSumme3 ) nSummeEL := IIf( 3->kennz=="1", nSummeEL + 3->&b_n, nSummeEL ) nSummeFL := IIf( 3->kennz$"23", nSummeFL + 3->&b_n, nSummeFL ) ELSEIF 3->(IsFieldVar("betbrteu")) // z.B. Raguse : Summen sind Bruttobetr„ge nSumme := IIf( 3->rn==" ", nSumme + 3->betbrteu, nSumme ) nSumme1 := IIf( 3->rn=="1", nSumme1 + 3->betbrteu, nSumme1 ) nSumme2 := IIf( 3->rn=="2", nSumme2 + 3->betbrteu, nSumme2 ) nSumme3 := IIf( 3->rn=="3", nSumme3 + 3->betbrteu, nSumme3 ) nSummeEL := IIf( 3->kennz=="1", nSummeEL + 3->betbrteu, nSummeEL ) nSummeFL := IIf( 3->kennz$"23", nSummeFL + 3->betbrteu, nSummeFL ) ELSE nSumme := IIf( 3->rn==" ", nSumme + 3->&b_g, nSumme ) nSumme1 := IIf( 3->rn=="1", nSumme1 + 3->&b_g, nSumme1 ) nSumme2 := IIf( 3->rn=="2", nSumme2 + 3->&b_g, nSumme2 ) nSumme3 := IIf( 3->rn=="3", nSumme3 + 3->&b_g, nSumme3 ) nSummeEL := IIf( 3->kennz=="1", nSummeEL + 3->&b_g, nSummeEL ) nSummeFL := IIf( 3->kennz$"23", nSummeFL + 3->&b_g, nSummeFL ) ENDIF ENDIF SKIP IF !lIndex IF 3->auftrnr != nAufalt 1->(DbSeek( StrX(nAufalt,E,0), .F. )) IF !1->(Eof()) 1->&r_b_0 := Round(nSumme,2) 1->&r_b_1 := Round(nSumme1,2) 1->&r_b_2 := Round(nSumme2,2) IIf(1->(IsFieldVar("&r_b_3")), 1->&r_b_3 := Round(nSumme3,2),) // 19.09.2005 IIf(1->(IsFieldVar("&r_b_n")), 1->&r_b_n := Round(nSummeN,2),) // 19.09.2005 IF Upper(AppName())$"NOLTEX.EXE" // 19.09.2005 1->&r_s := Round(nSumme1,2) + Round(nSumme2,2) + Round(nSummeN,2) ELSE 1->&r_s := Round(nSumme,2) + Round(nSumme1,2) + Round(nSumme2,2) + Round(nSumme3,2) ENDIF 1->&t_l := 1->&r_s - 1->&v_m IIf(1->(IsFieldVar("recheleu")), 1->recheleu := Round(nSummeEL,2),) // 18.6.2005 IIf(1->(IsFieldVar("rechfleu")), 1->rechfleu := Round(nSummeFL,2),) ENDIF nSumme := 0 nSumme1 := 0 nSumme2 := 0 nSumme3 := 0 nSummeN := 0 nSummeEL := 0 nSummeFL := 0 nAufalt := 3->auftrnr ENDIF ELSE nAufalt := 3->auftrnr ENDIF ENDDO schdat := "0010000" // wegen KompaktX: auftr_b.dbf Datei( "0010000" ) // USE auftr INDEX xaufauf GO nRec3 DbResumeNotifications() SELECT 2 GO nRec2 DbResumeNotifications() SELECT 1 use best // index xauftrnr SET INDEX TO xauftrnr,xname,xanspnam,xstrasse GO nRec1 DbResumeNotifications() SELECT &nOldArea RETURN