//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 "Font.ch" #include "dmlb.ch" #include "Set.ch" #include "Dmlb.ch" #include "Directry.ch" //23.05.2007 12:44 fr Email #include "Common.ch" PROCEDURE bestp( cTitel, cS_b ) LOCAL nEvent, mp1, mp2, aFelder := {}, ID_SLE_PRIMKEY := 1 LOCAL oDlg, oXbp, oHelp LOCAL drawingArea, aEditControls := {} LOCAL aData1[ FCount() ] LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } // tats„chliche Bildschirmaufl”sung: nV kommt seit 27.2.2004 aus EUROV 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 nW := nBSh/600 LOCAL n5 := int(5*nV) LOCAL n10 := int(10*nV) LOCAL n15 := int(15*nV) LOCAL n20 := int(20*nV) LOCAL n30 := int(30*nV) LOCAL nRo := int(505*nV) // oberstes Eingabefeld =505 LOCAL nBo := nRo LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 // LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 // // LOCAL cDeko, aDeko, bAction, cSTATUS, aSTATUS // fr die ComboBox LOCAL cVerst0 := cVerst1 := cVerst2 := cVerst3 := Trim(" ") LOCAL oBestMenu := SetAppFocus() LOCAL aPos := {} , aSize := {} , y := 0// Parameter fr XbpSle/XbpStatic LOCAL nFa := 0, cNr := Space(E) PRIVATE cV := " ", cTN, cTK, cTS, cTF // Text-Neu/Kopie/Such/Feldsuch PRIVATE nFontR := IIf( nV<=1, FONT_DEFFIXED_SMALL, FONT_DEFFIXED_MEDIUM ) PRIVATE nXmod:=nXehe:=nYehe:=int(350*nV), nYmod:=int(250*nV) PRIVATE cFeldC, cFeldN, cFeldD, aFeld[FCount()] PRIVATE cString := cStringN := cStringK := cStringS := cStringF := Space(E) PRIVATE cStringFM := cStringFJ := "" // 17.10.2004 PRIVATE oCB, oBEDA, oFocSle := SetAppFocus() // PRIVATE, weil sie in Funktionen verwendet werden!! PRIVATE cFont, oFont, nVers := 1, oSleSuch, oBest, oCtrl, oEdit PRIVATE aF1a, aF1b, aF2, aF3 PRIVATE aAdrKl := {"","","",""}, aAdrGr := {"","","",""} // 6.5.04 Adresse fr Kuvert PRIVATE cVariable := "vorname", nSpinJahr := Year(DATE()), nSpinMonat := Month(DATE()) // Makro-Variable fr den Maskenaufbau: PRIVATE FAM, STO1, STO2, STO3, TO0, TO1, TO2, TO3, TO4, TD0, TD1, TD2, TD3, TD4, TZ0, TZ1, TZ2, TZ3, TZ4 PRIVATE PR1, MU1, FL1, PR2, MU2, FL2, PR3, MU3, FL3, PR4, MU4, FL4 //23.04.2007 12:50 PRIVATE EHGD, EHSD, EHGO, EHSO, EHHEI, ANSPE, FRIED, NACHO, GRART PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9, cStadt //30.04.2007 17:56 PRIVATE cBU1, cBU2, cSTN //19.04.2006 09:44 PRIVATE oVideo, oFocus //25.06.2006 15:32 PRIVATE nB := nBz //24.04.2007 09:20 hier wird testhalber der Zeilen-Schritt gespeichert DEFAULT cS_b TO "s_best" cProgTyp := "n" // 14.09.2005 fr alle F„lle ErrorBlock( {|e| FehlerBehandlung(e) } ) // e = Error-Objekt DO WHILE cV == " " // cV!=" " zum Umschalten der Filiale/des Mandanten IF IsFieldVar("perskz") // mal sehen, ob man das beim Verlassen SELECT 4 // auf arb.dbf umswitchen muss... DbUseArea( , "FOXCDX", "Personen" ) // OrdListAdd( "Personen" ) // SELECT 1 // ENDIF //////// cDatver mit einbauen, da FExists() wie FErase() eine Low-Level-Funktion ist! : ////// IF !FExists( cDatver+"s_best.dbf" ) .AND. FExists( cDatver+"s_.tak" ) .AND. ; ////// FExists( cDatver+"bl_.tak" ) ////// IF ConfirmBox( SetAppWindow(), "Abbrechen mit ", ; ////// "Screen/Blatt-Dateien erzeugen?", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_YES ////// TXT_zu_DBF() // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ////// ELSE ////// RETURN ////// ENDIF ////// ELSEIF !FExists( cDatver+"s_best.dbf" ) ////// ModalFen( "Bildschirmbeschreibung fehlt! ; " + ; ////// "(Dateiname: s_.tak oder s_best.dbf) ; " + ; ////// "Das Programm wird abgebrochen! ", ; ////// "A C H T U N G !", ; ////// SetAppWindow() ) ////// RETURN ////// ENDIF IF Upper(AppName())$"BERGX.EXE" cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma + ; IIf(cDatver[1]$"DEFGHIJK"," >>>>>>>> DIREKT AUF DEM USB-STICK <<<<<<<<","") cAdrBM := IIf(Upper(Trim(cDatver))==Upper(Trim(cNetver)), "x", " ") //06.03.2007 12:15 ENDIF IF !Upper(AppName()) $ "BRAUCKX.EXE-SANDERX.EXE" .AND. Trim(Upper(cDatver)) != "C:\HDBE\" COPY FILE (cDatver+"FExport.dbf") TO C:\HDBE\FExport.dbf // 19.12.2004 ENDIF SELECT 1 IF !Empty(cPubAuf) FIND &cPubAuf IF Eof() GO BOTTOM ENDIF ELSE GO TOP ENDIF cV := "B" oHelp := MagicHelp():New() oDlg := AKDialog():new( AppDesktop(), SetAppWindow(), {0,30}, {nBSb,nBSh-30}, , .F.) //20.04.2008 18:09 oDlg:taskList := .T. oDlg:title := cTitel oDlg:create() SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oBestMaske := oDlg oCB := oDlg:drawingArea oBEDA := oDlg:drawingArea oBEDA:cargo := oDlg drawingArea := oDlg:drawingArea oBEDA:setColorBG( XBPSYSCLR_TRANSPARENT ) oDlg:lockUpdate(.T.) //+15.04.2016 22:22 Vista/Win7-Effekt II nBz := IIf(Upper(AppName())$"WERNERX.EXE" .AND. cS_b = "s_bes2", 24*nV, nBz ) //24.04.2007 09:28 // jetzt folgt die Erzeugung der Eingabefelder oBest := BestFF():new( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, cS_b, -100, 599, 1 ) oEdit := oBest // wegen DialogFF:create(IsMemberVar) 14.4.2005 oEdit:cS_b := cS_b //10.10.2006 22:27 zum Umschalten der 'Skins' IF ValType(oBest:CREATE( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, cS_b, -100, 599, 1 ))!="O" WAIT ENDIF AEval( oBest:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oBest:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder IF !Upper(AppName())$"SCHIERX.EXE" oDlg:childFromName( 1->(FieldPos( "auftrnr" )) ):disable() ENDIF oEdit:SubMenu[1]:checkItem(1,!oEdit:Sperre) nBz := nB //24.04.2007 09:21 hier wird testhalber der Zeilenschritt zurckgesetzt //------------------------------------------ // SetAppWindow(oDlg) // eventuell aktivieren, wenn HauptAnwendungsfenster SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oDlg:setModalState( XBP_DISP_APPMODAL ) // SetTimerEvent(100, {|| DispOutAt(10,10, Time()) } ) // klappt so nicht... 15.4.2005 /* * oBestMaske:aData1 := SatzGetBest() // fr die Ver„nderungsabfrage (sp„ter mal..) */ // 15.4.2005: oCtrl:= wurde direkt vor den EventLoop verschoben (ohne Wirkung) //------------------------------------------ // das Ende des Hauptprogramms: * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) oHelp:start() // oDlg:childFromName( 1->(FieldPos( "name" )) ):setInputFocus() IF "MENG"$Upper(AppName()) IF cSystem == "S" ////// X:=StrZero(Year(date())-2001,2) // Vorjahr ////// Y:=StrZero(Year(date())-2000,2) // laufendes Jahr ////// oBest:Lupe( {1,2,3},cTop:="22"+X+"000" ,cBot:="22"+Y+"999" ) // Scope fr Stadtgesch„ft oBest:Lupe( {1,2,3},cTop:="0000000" ,cBot:="0999999" ) // Scope fr Stadtgesch„ft ENDIF FIND &cPubAuf IF Eof() GO BOTTOM ENDIF ENDIF sleep(10) //+15.04.2016 22:27 damit Help-Thread etc fertig ist, bevor Focus kommt oCtrl := XbpGetController():new( oDlg ) // seit 15.4.2005 direkt vor dem EventLoop oCtrl:create() oCtrl:LastXbp := oBest:XbpObjekt( oBest:singleZeile,"name") oCtrl:READ( Val(oBest:StartFocus), .F. ) // in der s_best unter ZAHL_FORM z.B. "F4" // SetAppEvent( xbeK_F2, {|mp1,mp2,oXbp| Tone(1000) } ) IF Upper(AppName())$"HANELX.EXE" SetAppEvent( xbeK_F2, {|mp1,mp2,oxbp,c| c:=ORTohnePLZ(cStadt),oXbp:setData(c) } ) ENDIF sleep(10) //+15.04.2016 22:27 damit Help-Thread etc fertig ist, bevor Focus kommt oDlg:lockUpdate(.F.) //+15.04.2016 22:22 Vista/Win7-Effekt II oDlg:invalidateRect() //+15.04.2016 22:22 Vista/Win7-Effekt II PostAppEvent( xbeM_LbDblClick, {5,5},, oEdit:BEArea[5] ) DbSkip(0) // damit er ein Notify macht // nEvent := AppEvent( @mp1, @mp2, @oXbp ) // soll ein Event rausnehmen, damit Name positioniert... SetAppFocus(oEdit:BEArea[5]) sleep(10) //+15.04.2016 22:27 damit Help-Thread etc fertig ist, bevor Focus kommt // SetAppFocus(oEdit:xbpObjekt(,"name"):XbpGet:GET:Sle) // Focus explizit nochmal auf den Namen setzen oEdit:SingleZeile[3]:XbpGet:GET:Sle:setFocus() // Focus explizit nochmal auf den Namen setzen oEdit:SingleZeile[4]:XbpGet:GET:Sle:setFocus() // Focus explizit nochmal auf den Namen setzen nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) // PostAppEvent( xbeM_LbClick, {5,5},, oEdit:SingleZeile[3] ) // PostAppEvent( xbeM_LbClick, {5,5},, oEdit:SingleZeile[4] ) IF ValType(oVideo) == "O" .AND. oVideo:status()="stopped" oVideo:stop() // oVideo:cargo:setModalState( XBP_DISP_MODELESS ) oVideo:cargo:hide() oVideo:destroy() oVideo := NIL mp1 := 0 SetAppFocus( oFocSLE ) LOOP ENDIF IF nEvent = xbeP_Close .AND. Val(cV)=0 IF Empty(mp1) y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) nEvent := 0 LOOP ENDIF ELSE // wenn Abbruch durch AppQuit, dann mp1!=NIL ENDIF ENDIF // IF nEvent == xbeM_LbDblClick .and. oXbp:isDerivedFrom( "XbpListBox" ) IF nEvent == xbeLB_ItemSelected // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cStringS := LTrim( oBest:singleZeile[y]:getData() ) SetAppFocus(oBest:singleZeile[y]) y := oBest:XbpNummer( oBest:DruckKnopf, "suche Nr." ) PostAppEvent( xbeP_Activate,,, oBest:DruckKnopf[y] ) ENDIF IF nEvent == xbeLB_ItemMarked // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( SubStr( cItem, 1, At( "-", cItem )-1 ) ) cStringS := oBest:singleZeile[y]:getData() SetAppFocus(oBest:singleZeile[y]) ENDIF IF nEvent == xbeP_Keyboard IF mp1 == xbeK_HOME .AND. IsMemberVar(oXbp,"value") .AND. oXbp:cargo="NAME" oBest:Wochentag() // beim Start Wochentage setzen 15.4.2005 ENDIF IF mp1 == xbeK_RETURN // 04.08.2004 oBest:killTip() ENDIF // Buchstaben-Tastaturen wirken nur, wenn der Auftrag als editierbar markiert ist: IF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. oXbp:cargo != "cString" .AND. oEdit:Sperre == .T. ; .AND. !oBest:EditAuftragnr == 1->auftrnr // 02.07.2006 11:41 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Auftragsdaten eingeben/„ndern?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES oBest:EditAuftragnr := 1->auftrnr mp1 := 0 //02.07.2006 11:47 ELSE LOOP ENDIF ENDIF DO CASE // CASE mp1 == xbeK_RETURN .AND. oXbp == oSleSuch // SetAppFocus( oDlg:childFromName( 1->(FieldPos( "name" )) ) ) // LOOP CASE mp1 != xbeK_ESC .AND. mp1 != xbeK_F10 .AND. mp1 = xbeK_TAB ; .AND. oXbp:isDerivedFrom( "XbpMle" ) oXbp:KEYBOARD( mp1 ) LOOP CASE mp1 == xbeK_ESC .or. mp1 == xbeK_F10 IF ValType(oVideo) == "O" oVideo:stop() // oVideo:cargo:setModalState( XBP_DISP_MODELESS ) oVideo:cargo:destroy() oVideo := NIL mp1 := 0 SetAppFocus( oFocSLE ) LOOP ENDIF y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) LOOP ENDIF CASE mp1 == xbeK_ALT_D .OR. mp1 == xbeK_CTRL_D cAuf := strX( Auftrnr,E,0 ) BlattDRG( "Bl_b",, oBEDA,,, "P", "O", @nAnz, @nt ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_F11 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Screen/Blatt-Dateien erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES TXT_zu_DBF("i") // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ENDIF CASE mp1 == xbeK_ALT_F12 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Summen in Best-Datei erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES SummenSetzen() // (in Bestf7): setzt die RechBetr + Summen in der Best.dbf ENDIF CASE mp1 == xbeK_ALT_F7 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Rechnungsnummern l”schen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) DO CASE CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnr") 1->rechnr := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn") 1->rechnrn := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn2") 1->rechnrn2 := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn3") 1->rechnrn3 := "" OTHERWISE 1->rechnr := "" 1->rechnrn := "" 1->rechnrn2 := "" 1->rechnrn3 := "" ENDCASE 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_ALT_F8 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Rechnungsnummern 1234-setzen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) 1->rechnr := IIf(Empty(1->rechnr),"1",1->rechnr) 1->rechnrn := IIf(Empty(1->rechnrn),"2",1->rechnrn) 1->rechnrn2 := IIf(Empty(1->rechnrn2),"3",1->rechnrn2) 1->rechnrn3 := IIf(Empty(1->rechnrn3),"4",1->rechnrn3) 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1.dbf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_L LeistungSammeln() CASE mp1 == xbeK_ALT_U // macht die bl_r... fr die šbungsrechnung COPY FILE (cDatver+"bl_r.dbf") TO (cDatver+"bl_rU.dbf") COPY FILE (cDatver+"bl_rp.dbf") TO (cDatver+"bl_rUp.dbf") SELECT 29 USE bl_rU EXCLUSIVE REPLACE ALL fname WITH "bl_rU" USE bl_rUp EXCLUSIVE REPLACE ALL fname WITH "bl_rUp" USE COPY FILE (cDatver+"bl_rh.dbf") TO (cDatver+"bl_rhU.dbf") COPY FILE (cDatver+"bl_rhp.dbf") TO (cDatver+"bl_rhUp.dbf") SELECT 29 USE bl_rhU EXCLUSIVE REPLACE ALL fname WITH "bl_rhU" USE bl_rhUp EXCLUSIVE REPLACE ALL fname WITH "bl_rhUp" USE SELECT 1 CASE mp1 == xbeK_ALT_X oDlg:writeData() REH := "RechEingabe(StrX(1->auftrnr,E,0),oBEDA,nFontR,[bl_rU],,{10,30*nV},{790*nH,550*nV})" // šbungsrechnung REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Y .AND. "RAGUSE"$Upper(AppName()) oDlg:writeData() REH := "RechEingabe(StrX(1->auftrnr,E,0),oBEDA,nFontR,[bl_rhU],,{10,30*nV},{790*nH,550*nV})" // šbungsHandelsrechnung REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Z // holt alle ::editcontrols als Mehrzeiler-Text in die Zwischenablage cBuffer := Trim( " " ) FOR i := 1 TO Len( oBest:editControls ) xWert := oBest:editControls[i]:getData() xWert := IIf(ValType(xWert)="N",Str(xWert),IIf(ValType(xWert)="D",DtoC(xWert),xWert)) cBuffer := cBuffer + Chr(13)+Chr(10)+xWert NEXT oClipBoard := XbpClipBoard():new():create() oClipboard:open() oClipboard:setbuffer( cBuffer ) oClipboard:close() oClipboard:destroy() CASE mp1 == Asc("+") .AND. oXbp:isderivedfrom("XbpSle") .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +1 ) CASE mp1 == Asc("-") .AND. oXbp:isderivedfrom("XbpSle") .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -1 ) CASE mp1 == Asc("*") .AND. oXbp:isderivedfrom("XbpSle") .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +7 ) CASE mp1 == Asc("_") .AND. oXbp:isderivedfrom("XbpSle") .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -7 ) CASE mp1 == Asc("#") .AND. oXbp:isderivedfrom("XbpSle") .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, 0 ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) IF 4->(Alias()) == "PERSONEN" oBest:SwapPers("S") ENDIF BestGeaendert() __SETFUNCTION( 9, StrX( 1->AUFTRNR,E,0 ) ) cPubAuf := StrX( 1->auftrnr,E,0 ) SELECT 20 USE mwstdat Satzsp(oDlg) 20->pubauf := cPubAuf USE SELECT 1 oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() oDlg:destroy() 1->(DbSkip(0)) IF Upper(AppName()) == "DISCHX.EXE" // Trckng( 1, RecNo(), oBest:aData1, cV, oBest:aData2 ) // Tracking nur bei KSOx, Dischx ENDIF 1->(DbRUnlock()) oHelp:terminate() IF Val(cV) > 0 // ”ffnet einen anderen Satz Dateien (siehe eurov) IF cV="1" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Sonne"$cFirma cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma ELSEIF cV="2" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Tier"$cFirma2 cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma2 ENDIF IF Val(cV)<5 DatVerUm(Val(cV)) // hier wird in ein anderes Arbeitsverzeichnis umgeschaltet ELSEIF "."$cV // ...aber gr”áer als 5 (fr BergX-Filialenumschaltung DO CASE CASE Val(cV) = 5 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 5 .AND. Val(cV) < 6 // 06.03.2007 10:11 fr BergX n := (Val(cV)-5)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 6 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 6 .AND. Val(cV) < 7 // 25.02.2007 19:39 fr BergX n := (Val(cV)-6)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 7 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 7 .AND. Val(cV) < 8 // 06.03.2007 10:11 fr BergX n := (Val(cV)-7)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 8 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 8 .AND. Val(cV) < 9 // 25.02.2007 19:39 fr BergX n := (Val(cV)-8)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 9.1 // zurckstellen auf 'Arbeiten auf dem PC/Server' USE mwstdat EXCLUSIVE cDatver := mwstdat->netver SET DEFAULT TO &cDatver mwstdat->datver := cDatver[1] + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDatver[1] + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDatver[1] + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDatver[1] + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDatver[1] + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDatver[1] + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDatver[1] + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDatver[1] + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDatver[1] + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDatver[1] + SubStr(mwstdat->netver9,2) USE DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.2 // umstellen auf 'Arbeiten auf dem USB-Stick' mit Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert das USB-Laufwerk IF cDrive$"DEFGHIJK" FOR n := 1 TO 9 // kopiert notwendige Programmdateien in die Stickverzeichnisse @ 3,5 SAY "Ich bereite den USB-Stick fr die Arbeit vor....."+Str(n,1) COPY FILE (cDatver+"bl_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.tak") COPY FILE (cDatver+"bl_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.sdf") COPY FILE (cDatver+"bl_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_dir.dbf") COPY FILE (cDatver+"xBlFName.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xBlFName.ntx") COPY FILE (cDatver+"s_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.tak") COPY FILE (cDatver+"s_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.sdf") COPY FILE (cDatver+"s_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_dir.dbf") COPY FILE (cDatver+"xFldPos.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xFldPos.ntx") COPY FILE (cDatver+"hilfetip.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"hilfetip.dbf") COPY FILE (cDatver+"xHTip.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xHTip.ntx") COPY FILE (cDatver+"FExport.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"FExport.dbf") COPY FILE (cDatver+"dateien1.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.tak") COPY FILE (cDatver+"dateien1.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.sdf") COPY FILE (cDatver+"dateien2.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.tak") COPY FILE (cDatver+"dateien2.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.sdf") NEXT cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE mwstdat EXCLUSIVE // „ndert die c:\hdbe\mwstdat auf das Stick-Laufwerk mwstdat->datver := cDrive + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDrive + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDrive + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDrive + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDrive + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDrive + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDrive + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDrive + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDrive + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDrive + SubStr(mwstdat->netver9,2) USE cDummyD := cDatver FOR n := 1 TO 9 // macht in allen Stick-Verzeichnissen einen Prflauf CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden indiziert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver ineux(.F.) NEXT cDatver := cDummyD SET DEFAULT TO &cDatver ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.3 // umstellen auf 'Arbeiten auf dem USB-Stick' ohne Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert ds Stick-Laufwerk IF cDrive$"DEFGHIJK" // kopiert keine Prog-Dateien + kein Prflauf cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE mwstdat EXCLUSIVE // „ndert die c:\hdbe\mwstdat auf das Stick-Laufwerk mwstdat->datver := cDrive + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDrive + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDrive + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDrive + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDrive + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDrive + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDrive + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDrive + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDrive + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDrive + SubStr(mwstdat->netver9,2) USE ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.5 // kopieren in das Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.55 // kopieren in das Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.6 // kopieren vom Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.66 // kopieren vom Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.9 // Prflauf dieser Filiale DbCloseAll() ineux(.F.) DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) ENDCASE ELSE DO CASE CASE cV == "5" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Stick() CASE cV == "6" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Stick() ineux(.F.) CASE cV == "7" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server() CASE cV == "8" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server() ineux(.F.) CASE cV == "9" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server(,"\HDBDIENST") CASE cV == "10" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server(,"\HDBDIENST") ineux(.F.) CASE cV == "11" cS_b := "s_best" CASE cV == "12" cS_b := "s_bes2" ENDCASE DatVerUm(1) ENDIF cV := " " ENDIF ENDDO // oHelp:terminate() SetAppFocus( oBestMenu ) SET DATE TO GERMAN SET ORDER TO 1 RETURN //------------------------------------------ FUNCTION FehlerBehandlung(oError) LOCAL cFehler := "Fehlerart: "+oError:description +CRLF+ ; "in Operation: "+oError:operation +CRLF+ ; IIf(!Empty(oError:filename), "Datei: "+oError:filename +CRLF,"") + ; "aufgerufen von:" +CRLF+ ; IIf( !Empty(ProcName(1)), ProcName(1)+"("+LTrim(Str(ProcLine(1)))+")"+CRLF,"")+; IIf( !Empty(ProcName(2)), ProcName(2)+"("+LTrim(Str(ProcLine(2)))+")"+CRLF,"")+; IIf( !Empty(ProcName(3)), ProcName(3)+"("+LTrim(Str(ProcLine(3)))+")"+CRLF,"")+; IIf( !Empty(ProcName(4)), ProcName(4)+"("+LTrim(Str(ProcLine(4)))+")"+CRLF,"")+; IIf( !Empty(ProcName(5)), ProcName(5)+"("+LTrim(Str(ProcLine(5)))+")"+CRLF,"")+; IIf( !Empty(ProcName(6)), ProcName(6)+"("+LTrim(Str(ProcLine(6)))+")"+CRLF,"")+; IIf( !Empty(ProcName(7)), ProcName(7)+"("+LTrim(Str(ProcLine(7)))+")"+CRLF,"")+; "Wiederholen mit , Datenretten + Ende mit " IF oError:severity > 1 IF ConfirmBox( oBEDA, ; cFehler, ; "Ein Fehler ist aufgetreten!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO DbCloseAll() USE AK_F_LOG new APPEND BLANK AK_F_LOG->datum := DATE() AK_F_LOG->zeit := Time() AK_F_LOG->logtext := DtoC(DATE()) +CRLF+ ; Time() +CRLF+ ; cFehler USE BREAK() ENDIF ENDIF RETURN .F. //------------------------------------------ FUNCTION Fallsuche() RETURN .T. FUNCTION NeuerFall() RETURN .T. //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: // von DialogFF geerbt: // VAR VArea // enth„lt die Area der best.dbf (=1) // VAR aStructure // enth„lt die Struktur der best.dbf // VAR aFelder // enth„lt alle Feldbezeichnungen der best.dbf // VAR aData1 // enth„lt alle Feldinhalte des augenblicklichen Datensatzes // VAR aData2 // // VAR aIndex // enth„lt die Namen der Indexdateien VAR SWT // SterbeWochentag VAR TW0 // Wochentag von Termin0 VAR TW1 // Wochentag von Termin1 VAR TW2 // VAR TW3 // VAR TW4 // VAR Beis_Fried // Beisetzungsfriedhof == Test fr Mller VAR PvAUFTRNR // 3.5.2005 fr die Personen.dbf in Area 4 VAR PvPERSKZ VAR PvANREDE VAR PvNAME VAR PvVORNAME VAR PvGEBNAME VAR PvSTRASSE VAR PvPLZ_ORT VAR PvORTSTEIL VAR PvTELEFON VAR PvFAX VAR PvEMAIL VAR PvGEB_DAT VAR PvSTB_DAT VAR PvVERW_BEZ VAR PvRECH_NR VAR PvRECHBETR VAR PvRECH_EL VAR PvRECH_FL VAR PvRECH_DAT VAR PvEINGBETR VAR PvEING_DAT VAR PvSALDO VAR PvGKZ VAR PvMUST_RG VAR PvBILD VAR PvNOTIZ VAR PvSUCH VAR aBP // Betreffperson, je nach TAB: Ansprechpartner/Ehepartner/Angeh”riger VAR EditAuftragnr // =aktuelle Auftrnr, wenn editierbar VAR Fall_geloescht // wenn .T. wird Listbox-Letzte30 neu gefllt VAR cS_b // = "s_best" (bei Flues auch "s_bes2") METHOD INIT METHOD CREATE METHOD notify // managt z.B. ::PaintTip, ::WochenTag METHOD SwapZero // l”scht Felder in einer Datei METHOD SwapInachE // kopiert Daten von einer in die andere Datei METHOD FExport // erzeugt die FExport.DBF mit Daten des aktuellen Falles METHOD AnsprechPartner // fllt die Ansprechpartner-Daten aus mit den Daten des Ehepartners/Verstorbenen METHOD AnspPartAusAdresse // schreibt die Adresse aus GKZ in ANSP METHOD EhePartner // fllt die Ehepartner-Daten aus mit den Daten des Ansprechpartners/Verstorbenen METHOD NeuerFall // legt neuen Bestattungsauftrag an, gibt Nr. in jetziger Gruppe vor METHOD VerstSuche // sucht nach cSuch:=1->name bei der Neueingabe (findet gleiche Namen) METHOD Fallsuche // sucht nach cSuch, wobei nach jedem Feld geindext werden kann METHOD Anzahl // z„hlt wie oft cSuch in der eingestellten Zeit vorkommt METHOD Letzte30 // fllt Array mit den Daten der letzten 30 Auftr„ge in der Datei METHOD ZumBlockAnfang // geht zum Anfang eines Auftragsnummern-Blocks - z.B. 100000 METHOD ZumBlockEnde // geht zum Ende eines Auftragsnummern-Blocks - z.B. 199999 METHOD Anschrift // gibt aAdr zurck, je nachdem ob Area=5,12,1 METHOD MonatsSumme // Anzahl Tr„ger im Monat (fr Bergx) METHOD DruckAlle // druckt Briefe an alle, die eine Filterbedingung erfllen METHOD RDatum // altes/neues Rechnungsdatum METHOD Lupe // Scope METHOD Wochentag // Wochentag zum Datum METHOD Ordnen // Index nach beliebigem Feld METHOD FallCaufM // kopiert Bestattungsf„lle von C:\HDBE auf M:\HDBE METHOD EMAIL // kopiert Bestattungsf„lle vom PC zum Emailverzeichnis oder umgekehrt METHOD EDATEI // erzeugt Array mit dem Inhalt des Email-Verzeichnisses 27.05.2007 13:01 METHOD FDATEI // erzeugt Array mit den Fehlerdateien aus dem Datver 28.05.2007 11:43 METHOD EmailLesen // txt-Datei ausw„hlen und darstellen (wie Hilfedateien) METHOD ProgEntpacken // BergX.ZIP in cDatver\Prog entpacken nach \hdbe\Prog METHOD FallX1aufY1 // kopiert Bestattungsf„lle vom PC zum Stick oder umgekehrt METHOD SwapPers // kopiert aus Personen.dbf in Member-Vars und umgekehrt METHOD PersVor // Navigation der Personen.dbf METHOD PersRueck // METHOD PersLoesch // Loeschen des aktuellen Angeh”rigen-Eintrages METHOD PersSuche // Suche nach einem Feld der Personen-Datei METHOD CreateBestF // Daten fr Word etc. erzeugen METHOD TabMax // berl„dt Parent, damit Betreffperson umgeschaltet wird METHOD TabDaten // holt die Daten aus der obersten TabPage METHOD FriedEF // managed die Friedhofeingaben in ::Beis_Fried abh„ngig von E+F METHOD FormularNotiz // vermerkt Formularausdrucke im Notizfeld, wenn BL_UPPERCASE ENDCLASS METHOD BestFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::SWT := "" ::TW0 := "" ::TW1 := "" ::TW2 := "" ::TW3 := "" ::TW4 := "" ::Beis_Fried := Space(30) ::PvAUFTRNR := 0000000 ::PvPERSKZ := "@" ::PvANREDE := "" ::PvNAME := "" ::PvVORNAME := "" ::PvGEBNAME := "" ::PvSTRASSE := "" ::PvPLZ_ORT := "" ::PvORTSTEIL:= "" ::PvTELEFON := "" ::PvFAX := "" ::PvEMAIL := "" ::PvGEB_DAT := CtoD("") ::PvSTB_DAT := CtoD("") ::PvVERW_BEZ:= "" ::PvRECH_NR := "" ::PvRECHBETR:= 0.00 ::PvRECH_EL := 0.00 ::PvRECH_FL := 0.00 ::PvRECH_DAT:= CtoD("") ::PvEINGBETR:= 0.00 ::PvEING_DAT:= CtoD("") ::PvSALDO := 0.00 ::PvGKZ := "" ::PvMUST_RG := "" ::PvBILD := "" ::PvNOTIZ := "" ::PvSuch := "" ::aStructure := 1->(DbStruct()) ::VArea := nA ::aIndex := { "Auftragsnummer", "Verstorbenen-Namen", ; "Ansprechpartner-Namen", "Verstorbenen-Straáe", cVariable } ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } //28.05.2007 15:45 ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::aFelder := {} // Array mit allen Feldnamen AEval( ::aStructure, {|a| AAdd( ::aFelder, a[1] ) } ) ::aData1 := {} // Array mit allen Feldinhalten, vor der Ver„nderung AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) ::aData2 := {} // Array mit allen Feldinhalten, nach der Ver„nderung ::EditAuftragnr := 0 // beim Start ist noch kein Auftrag editierbar ::Fall_geloescht := .F. // beim Start ist noch kein Auftrag gel”scht 26.06.2006 16:01 ::cS_b := "s_best" // s_best o.„. RETURN self METHOD BestFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) // (nA)->(DbRegisterClient(self)) // reicht es, wenn das Fenster als Ganzes registriert ist?? RETURN self METHOD BestFF:notify( nEvent, mp1, mp2 ) LOCAL nRec, oFocus, cIndex, xIndex, i DbSuspendNotifications() IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_PROLOG // Skip wird starten AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData2, &c ) } ) // fr TT (sp„ter!?) IF 1->(IsFieldVar("perskz")) // A...Z - fr Rechnungen an angeh”rige Personen ::SwapPers("S") // 5.5.2005 Angeh”rigendaten auf Platte schreiben ENDIF ENDIF IF mp1 == DBO_MOVE_DONE .OR. mp1 == DBO_GOBOTTOM .OR. mp1 == DBO_GOTOP IF 1->(IsFieldVar("perskz")) IIf( 4->(DbScope()), 4->(DbClearScope()),) // 26.08.2005 vorsichtshalber 4->(DbSetScope( SCOPE_BOTH, StrX(1->auftrnr,E,0) )) // neuer Auftrag, neue Scope 4->(DbGotop()) // statt DbSetRelation DbSeek() nach dem zuletzt bei diesem Auftrag 'eingeloggten' Angeh”rigen: IIf(!Empty(1->perskz),4->(DbSeek(StrX(1->auftrnr,E,0)+1->perskz),.F.),4->(DbGobottom()) ) ::SwapPers("L") // 5.5.2005 Angeh”rigendaten einlesen ENDIF AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) // wird in AC gebraucht! // 07.11.2005 schaltet die Farben je nach Nummernkreis: IF Upper(AppName())$"BUCKX.EXE-MENGX.EXE-MUELLX.EXE-SINZIGX.EXE-BLEINX.EXE-KUELLX.EXE-FLUESX.EXE-KOMPAKTX.EXE-BERGX.EXE" // S : die Gruppe des Nummernkreises, 0=Ordnungsamt DU, 1=Sonstige SO, 2=Privat-Bestattungen PB, etc // aC : Array mit den RGB-Farben, die den Nummernkreisen zugeordnet sind - siehe s_best // aBEA : Array mit den ::BENr-Werten der zu f„rbenden Fl„chen - siehe s_best FOR i := 1 TO Len(aBEA) IF aBEA[i]<5 // die Area der Navigationskn”pfe, Bestattungsart-farbig S := IIF(1->best_art="E",10,IIf(SubStr(1->best_art,1,2) $ "FAF UAU Fe",11,IIf(SubStr(1->best_art,1,1)="S",12,13))) ELSE S := Val(StrX(1->auftrnr,E,0)[1]) // 07.11.2005 Gruppenfarbe setzen ENDIF // aus AKDialogV entliehen: IF aC[S+1,1] >= 1000 .AND. IsMemberVar( ::BEArea[aBea[i]], "bitmap" ) ::BEArea[aBea[i]]:setColorFG( IIf( Int(aC[S+1,1]) != aC[S+1,1], ; IIf( Int(aC[S+1,1]*10)==aC[S+1,1]*10, ; (Int(aC[S+1,1]) - aC[S+1,1])*10,(Int(aC[S+1,1]) - aC[S+1,1])*100 ), ; GRA_CLR_BLACK ) ) ::BEArea[aBea[i]]:bitmap := Int( aC[S+1,1] ) ::BEArea[aBea[i]]:configure() ELSEIF (aC[S+1,1] > 0 .AND. aC[S+1,1] < 1000) .OR. Len(aC[S+1]) > 1 ::BEArea[aBea[i]]:setColorFG( IIf( Int(aC[S+1,1]) != aC[S+1,1], ; Int(aC[S+1,1]), GRA_CLR_BLACK ) ) ::BEArea[aBea[i]]:setColorBG( IIf( Int(aC[S+1,1])!=aC[S+1,1] .AND. Len(aC[S+1])=1, ; IIf( Int(aC[S+1,1]*10)==aC[S+1,1]*10, ; (Int(aC[S+1,1]) - aC[S+1,1])*10,(Int(aC[S+1,1]) - aC[S+1,1])*100 ), ; IIf( Len(aC[S+1]) > 1, GraMakeRGBColor( ; IIf( Int(aC[S+1,1]) != aC[S+1,1], ; AEval( aC[S+1], {|x,i|aC[S+1,i]:=(Int(aC[S+1,i]) - aC[S+1,i])*1000},1,1), ; aC[S+1] )), ; XBPSYSCLR_DIALOGBACKGROUND ) )) ELSE ::BEArea[aBea[i]]:setColorFG( GRA_CLR_BLACK ) ::BEArea[aBea[i]]:setColorBG( XBPSYSCLR_DIALOGBACKGROUND ) ENDIF NEXT ENDIF ENDIF ENDIF // Test fr MuellX: Beis_Fried als MemberVar -> verteilt auf ortgrab/urnewo, je nach best_art IF FRIED == "Beis_Fried" //26.12.2006 11:23 ::FriedEF() //03.12.2006 09:35 ENDIF IF Upper(AppName())$"MENGX.EXE" ::PaintTip( "Sortiert nach "+"ï"+::SuchFeld+"ï"+"." ; +" - Bereich: "+aVO[S+1], {215,570} ) // 10.2.2005 ELSEIF !Upper(AppName())$"BERGX.EXE" //15.02.2007 11:57 ::PaintTip( "Sortiert nach "+"ï"+::SuchFeld+"ï"+".", {215,565} ) // 19.12.2004 (aus:{20,550}) ENDIF ::WochenTag() // 14.4.2005 zeigt fr TD1-4 den Wochentag an DbResumeNotifications() RETURN self METHOD BestFF:swapZero( aFelder, nA1 ) PRIVATE c (nA1)->(DbRLock()) FOR i := 1 TO Len(aFelder) c := aFelder[i] IF ValType( (na1)->&c ) = "C" (nA1)->&c := "" ELSEIF ValType( (na1)->&c ) = "N" (nA1)->&c := 0 ELSEIF ValType( (na1)->&c ) = "D" (nA1)->&c := CtoD("") ENDIF NEXT (nA1)->(DbRUnLock()) RETURN self METHOD BestFF:swapInachE( aFelderI, nAI, nAE, aFelderE ) PRIVATE cI, cE // FExport.dbf hat nur String-Felder!!! IF Empty(aFelderE) (nAE)->(DbRLock()) FOR i := 1 TO Len(aFelderI) // aFelderE darf mehr Felder haben als aFelderI cI := aFelderI[i] DO CASE CASE ValType((nAI)->&cI)="C" (nAE)->&cI := (nAI)->&cI CASE ValType((nAI)->&cI)="N" IF (nAI)->&cI != Int((nAI)->&cI) // wenn dezimal, dann mit 2 Stellen: (nAE)->&cI := Str((nAI)->&cI,10,2) ELSE (nAE)->&cI := Str((nAI)->&cI) ENDIF CASE ValType((nAI)->&cI)="D" (nAE)->&cI := DtoC((nAI)->&cI) ENDCASE NEXT (nAE)->(DbRUnLock()) ELSE (nAE)->(DbRLock()) FOR i := 1 TO Len(aFelderI) cI := aFelderI[i] cE := aFelderE[i] DO CASE CASE ValType((nAI)->&cI)="C" (nAE)->&cE := (nAI)->&cI CASE ValType((nAI)->&cI)="N" IF (nAI)->&cI != Int((nAI)->&cI) // wenn dezimal, dann mit 2 Stellen: (nAE)->&cE := Str((nAI)->&cI,10,2) ELSE (nAE)->&cE := Str((nAI)->&cI) ENDIF CASE ValType((nAI)->&cI)="D" (nAE)->&cE := DtoC((nAI)->&cI) ENDCASE NEXT (nAE)->(DbRUnLock()) ENDIF RETURN self METHOD BestFF:FExport( nA1, aFelder1a, aFelder1b, nA2, aFelder2, nA3, aFelder3 ) LOCAL aFelderE1a := { "auftrnr", "Vanrede", "Vvorname", "Vname", "Vgebname", "Vstrasse", "Vort", ; "Vberuf", "Vkonfess", "Vstaatsang", "Vgebdatum", "Vgebort", ; "Vtodesurs", "Vstrbdatum", "Stheim", "Ststrasse", "Stort", ; "Vbeziehung" } LOCAL aFelderE1b := { "Aanrede", "Avorname", "Aname", "Astrasse", "Aort", ; "Abeziehung", "Atelefon", "Abank", "Akonto", "Ablz", "Akontoinh", ; "bestart", "friedhof", "beerddat", "grabart", "kirche" } LOCAL aFelderE2 := { "Fname1", "Fname2", "Fstrasse", "Fort", "Firmenbez", ; "Fpolbetrag", "Fbezbetrag", "Fbezdatum", "Fzahlenan", ; "Ftext1", "Ftext2", "Ftext3", "Ftext4", ; "Fanl1", "Fanl2", "Fanl3", "Fanl4", "Fanl5", "Fanl6" } LOCAL aFelderE3 := { "Rartnr", "Rartbez", "Rpreis", "Reigfremd", "Rmwstproz", "Rnachtrag" } LOCAL nOldArea := SELECT(), nRec := 1->(RecNo()) IF !Empty(1->auftrnr) // SELECT 9 IF !FExists("C:\HDBE\FExport.dbf") DbUseArea( .T.,, cDatver[1]+":\HDBE\FExport", "fe", .F. ) // 14.1.2005 fe-> statt 9-> 08.03.2009 20:14 ELSE DbUseArea( .T.,, "C:\HDBE\FExport", "fe", .F. ) // 14.1.2005 fe-> statt 9-> ENDIF // USE C:\HDBE\FExport EXCLUSIVE ZAP fe->(DbAppend()) ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) fe->vbeziehung := Verwum(fe->abeziehung) // 7.6.2005 IF nA2 = 2 (nA2)->(DbSeek( StrX(1->auftrnr,E,0) )) DO WHILE (nA2)->auftrnr == (nA1)->auftrnr ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) fe->vbeziehung := Verwum(fe->abeziehung) // 7.6.2005 ::swapInachE( aFelder2, nA2, SELECT("fe"), aFelderE2 ) (nA2)->(DbSkip()) IIf( (nA2)->auftrnr == (nA1)->auftrnr, fe->(DbAppend()),) ENDDO ELSEIF nA2 = 5 // 19.12.2004 IIf( Len(aFelder2)>5, ARemove( aFelder2, 6, Len(aFelder2)-5 ), ) ::swapInachE( aFelder2, nA2, SELECT("fe"), aFelderE2 ) ENDIF fe->(DbGotop()) IIf( nA3 = 3, (nA3)->(DbSeek( StrX(1->auftrnr,E,0) )), ) DO WHILE (nA3)->auftrnr == (nA1)->auftrnr .AND. nA2 != 5 // 9.4.2005, aus Adresseingabe ::swapInachE( aFelder3, nA3, SELECT("fe"), aFelderE3 ) fe->(DbSkip()) IF fe->(Eof()) fe->(DbAppend()) ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) fe->vbeziehung := Verwum(fe->abeziehung) // 7.6.2005 ENDIF (nA3)->(DbSkip()) ENDDO fe->(DbCloseArea()) // fe ist auáerhalb der normal ge”ffneten Areas, daher geht das so: IF Upper(AppName())$"MENGX.EXE" // 18.11.2005 //////////////PROCEDURE ErzeugeBestF() ////////////// LOCAL nOldArea := SELECT(), nRec := 1->(RecNo()) ////////////// SELECT 21 CREATE C:\HDBE\bestF FROM bestru DbUseArea(,,"C:\HDBE\bestF",,.F.) // "Use EXCLUSIVE in neuer Area" DbImport( cDatver+"best.dbf",,,,1,nRec) DbCloseArea() ////////////// SELECT (nOldArea) //////////////RETURN ENDIF ENDIF SELECT &nOldArea RETURN self METHOD BestFF:AnsprechPartner() LOCAL Wahl := ConfirmBox( ::BEArea[1], "Ist Ansprechpartner = Ehepartner?", ; "Ansprechpartner „ndern", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF Wahl == XBPMB_RET_YES Satzsp( ::BEArea[1] ) 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 IF Empty(1->eh_name) 1->ansp_name := 1->name // 1->ansp_vname := 1->eh_vname 1->ansp_str := 1->strasse 1->ansp_ort := 1->plz_ort IIf(IsFieldVar("ansp_ortst").AND.IsFieldVar("ortsteil"),1->ansp_ortst:=1->ortsteil,) IIf(IsFieldVar("eh_akgr").AND.IsFieldVar("ansp_akgr"),1->eh_akgr:=1->ansp_akgr,) 1->eh_telp := 1->ansp_telp 1->eh_anr := 1->ansp_anr 1->eh_name := 1->ansp_name 1->eh_vname := 1->ansp_vname 1->eh_str := 1->ansp_str 1->eh_ort := 1->ansp_ort IIf(IsFieldVar("eh_ortst").AND.IsFieldVar("ansp_ortst"),1->eh_ortst:=1->ansp_ortst,) ELSE IIf(IsFieldVar("eh_akgr").AND.IsFieldVar("ansp_akgr"),1->ansp_akgr:=1->eh_akgr,) 1->ansp_telp := 1->eh_telp 1->ansp_anr := 1->eh_anr 1->ansp_name := 1->eh_name 1->ansp_vname := 1->eh_vname 1->ansp_str := 1->eh_str 1->ansp_ort := 1->eh_ort IIf(IsFieldVar("eh_ortst").AND.IsFieldVar("ansp_ortst"),1->ansp_ortst:=1->eh_ortst,) ENDIF DbRUnlock(RecNo()) ENDIF RETURN self METHOD BestFF:AnspPartAusAdresse(x) LOCAL Wahl := ConfirmBox( ::BEArea[1], "In Anrede mit - In Name mit - Abbrechen mit ", ; "Adresse als Ansprechpartner eintragen", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF Wahl == XBPMB_RET_NO Wahl := XBPMB_RET_YES x:= 0 ENDIF IF Wahl == XBPMB_RET_YES 5->(DbSeek(1->gkz,.F.)) Satzsp( ::BEArea[1] ) 1->ansp_anr := IIf(Empty(x)," ",5->name1) IF 1->(IsFieldVar("ansp_akgr")) 1->ansp_akgr := " " ENDIF 1->ansp_name := IIf(Empty(x),5->name2," ") 1->ansp_vname := IIf(Empty(x),5->name1,5->name2) 1->ansp_str := 5->strasse IF 1->(IsFieldVar("ansp_ortst")) 1->ansp_ortst := 5->ortsteil ENDIF 1->ansp_ort := 5->plz_ort IF Upper(AppName())$"HANELX.EXE" 1->stern := "A" ENDIF DbRUnlock(RecNo()) ENDIF RETURN self METHOD BestFF:Ehepartner() LOCAL Wahl := ConfirmBox( ::BEArea[1], "Ist Ehepartner = Ansprechpartner?", ; "Ehepartner „ndern", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) Satzsp( ::BEArea[1] ) IF Wahl == XBPMB_RET_NO IF 1->anrede = "Herr" 1->eh_anr := "Frau" ELSEIF 1->anrede = "Frau" 1->eh_anr := "Herr" ENDIF 1->eh_name := 1->name 1->eh_str := 1->strasse 1->eh_ort := 1->plz_ort IIf(IsFieldVar("eh_ortst").AND.IsFieldVar("ortsteil"),1->eh_ortst:=1->ortsteil,) ELSEIF Wahl == XBPMB_RET_YES IIf(IsFieldVar("eh_akgr").AND.IsFieldVar("ansp_akgr"),1->eh_akgr:=1->ansp_akgr,) 1->eh_telp := 1->ansp_telp 1->eh_anr := 1->ansp_anr 1->eh_name := 1->ansp_name 1->eh_vname := 1->ansp_vname 1->eh_str := 1->ansp_str 1->eh_ort := 1->ansp_ort IIf(IsFieldVar("eh_ortst").AND.IsFieldVar("ansp_ortst"),1->eh_ortst:=1->ansp_ortst,) ENDIF DbRUnlock(RecNo()) RETURN self METHOD BestFF:NeuerFall( cKopie, cKreis ) LOCAL cAuf := IIf(Empty(cKreis),Space(E),cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 LOCAL y, cString := cAuf, aStrings := {}, cTip, nRec LOCAL lLupe := 2->(DbScope()) // nicht 1, weil beim Aufruf Area1 ge'clearscope't wird !!!! DbSkip(0) IF auftrnr=0 DELETE ENDIF IF lLupe ::Lupe({1,2,3}) // 12.11.2005 == Clear Scope ENDIF cAufalt := StrX( 1->auftrnr,E,0 ) DO WHILE .T. y := ::XbpNummer( ::SingleZeile, IIf(Empty(cKopie),"cStringN","cStringK") ) cAufneu := ::singleZeile[y]:getdata() //************IIf(cAuf... !!!!!! cAufneu := IIf( Val(cAufneu)>0, StrX(Val(cAufneu),E,0), cAufneu ) IF Empty( cAufneu) .OR. Val(cAufneu) = 0 .AND. Upper(cAufneu[1]) != "S" //01.09.2006 09:32 RETURN cTip := "Auftrag-Nr. eingeben:" ELSEIF Val(cAufneu) > Val(Replicate("9",E)) // 999999 cAuf := Space(E) RETURN cTip := "Zu lang! Neue Auftrag-Nr. :" ENDIF cAufneu := IIf( !Empty(cKopie), cKopie+cAufneu, cAufneu ) // "BS" wegen Bestattungsfall-Kopie und Vom-Stick-Einlesen: 01.09.2006 09:19 cAuf := IIf( Upper( Substr( cAufneu,1,1 ))$"BS", Substr( Padr(cAufneu,9),3,E), Padl(cAufneu,E )) cAuf := StrX(Val(cAuf),E,0) 1->(DbSeek( cAuf )) IF Found() .AND. VAL( cAuf ) > 0 cAuf := Space(E) RETURN cTip := "Schon belegt! Neue Auftrag-Nr. :" ELSEIF VAL( cAuf ) < Val(Replicate("9",E)) +1 // 1000000 EXIT ENDIF ENDDO // oBestMaske:aData1 := SatzGetBest() IF VAL( cAufneu ) > 0 .AND. Val( cAufneu ) < Val(Replicate("9",E))+1 // 1000000 1->(DbAppend()) REPLACE 1->AUFTRNR WITH Val( cAuf ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF IF IsFieldVar("berater") // 20.04.2007 21:10 cBK := IIf(IsMemVar("cBK"),PadR(cBK,Len(1->berater)),Space(Len(1->berater))) 1->berater := cBK ENDIF IF IsFieldVar("todesurs") REPLACE todesurs with "natrlicher Tod" ENDIF IF IsFieldVar("RBrNe") REPLACE RBrNe with cBrNe1 //17.03.2007 17:48 Brutto/NettoRechnung (BergX) ENDIF REPLACE staatsan with "deutsch" IF FRIED == "Beis_Fried" ::Beis_Fried := "" ENDIF IF IsMemVar("cStadt") REPLACE plz_ort WITH cStadt REPLACE ansp_ort WITH cStadt REPLACE eh_ort WITH cStadt IF 1->(IsFieldVar("geb_in")) REPLACE geb_in WITH ORTohnePLZ(cStadt) ELSEIF 1->(IsFieldVar("gebin")) REPLACE gebin WITH ORTohnePLZ(cStadt) ENDIF // REPLACE verst_in WITH cStadt // heiát nicht berall gleich!!! ENDIF S := Val(StrX(1->auftrnr,E,0)[1]) IF 1->(IsFieldVar("ver_ort")) 1->ver_ort := aVO[S+1] ENDIF cTip := "Neue Auftrag-Nr.: "+cAuf+" angelegt." AEval( ::Listbox, {|lb| lb:CLEAR() } ) 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( Substr( Padr( cAufneu, E+2 ),3,E ) ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF 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 // Versicherungsdaten und Rechnung des Quell-Falles kopieren? : IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Versicherungsdaten + Rechnung bernehmen?", ; XBPMB_YESNO, ; XBPMB_QUESTION, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES // Versicherungseintr„ge in den Bestattungsfall kopieren: cVerstemp := "v_"+cAufalt //"ver2"+LTrim(Str(Int(Seconds()/10))) 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( Substr( cAufneu,3,E ) ) 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)) 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( Substr( cAufneu,3,E ) ) REPLACE 13->rn WITH " " // 5.6.04 : alles in die 1.Rg REPLACE 13->ttmm WITH " " // 18.4.2005 : noch nicht gedruckt REPLACE 13->r_datum WITH CtoD("") // 13.12.2005 : noch nicht gedruckt 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( oCB ) 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 DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 1 // FIND &( 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" ) cTip := "Auf neue Auftrag-Nr.: "+cAuf+" kopiert." AEval( ::Listbox, {|lb| lb:CLEAR() } ) ELSE //12.06.2006 18:07 cTip := "Auf neue Auftrag-Nr.: "+cAuf+" kopiert (ohne Rechnung+Versicherung)." AEval( ::Listbox, {|lb| lb:CLEAR() } ) ENDIF //01.09.2006 09:16 Fall vom Stick neu einlesen: ELSEIF Upper( Substr( cAufneu,1,1 ) ) = "S" FOR nDrive := 75 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":\HDBE_BAK", "D" ) // wenn das Verzeichnis existiert: cNetver2 := Chr(nDrive)+":\HDBE_BAK\" EXIT ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetver2[1])) < 68 .AND. ConfirmBox( oBEDA, ; "Soll vom Verzeichnis:"+CRLF+ ; cNetver2+" kopiert werden?", ; "Kein USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ELSE IF !"dasi"$cNetver2 .AND. ConfirmBox( oBEDA, ; "Soll WIRKLICH vom Verzeichnis:"+CRLF+ ; cNetver2+" kopiert werden?", ; "Kein USB-Stick!!!!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF ENDIF // vom Stick in das cDatver kopieren: SELECT 1 APPEND FROM (cNetver2+"best") FOR auftrnr = Val(cAuf) SELECT 2 APPEND FROM (cNetver2+"vv") FOR auftrnr = Val(cAuf) SELECT 3 APPEND FROM (cNetver2+"auftr") FOR auftrnr = Val(cAuf) SELECT 4 APPEND FROM (cNetver2+"personen") FOR p_auftrnr = Val(cAuf) VIA "FOXCDX" SELECT 1 cTip := "Neue Auftrag-Nr.: "+cAuf+" vom Stick kopiert." Tone(1000,9) ENDIF IF lLupe // 12.11.2005 soll MengX schneller machen nRec := RecNo() ::Lupe({1,2,3},StrX(1->auftrnr,E,0)[1]+Replicate("0",E-1),StrX(1->auftrnr,E,0)[1]+Replicate("9",E-1) ) DbGoto(nRec) ENDIF DbSkip(0) RETURN cTip METHOD BestFF:VerstSuche(cName,cVorname,dGebDatum) // zur Kontrolle, ob Verstorbener bereits in Datei enthalten LOCAL nRec := RecNo(), cTitel DbSuspendNotifications() SET ORDER TO 2 // indiziert nach VerstorbenenNamen IF !DbSeek(Upper(cName),.T.) // wenn nicht gefunden, // kommt nicht vor, weil er mindestens sich selber findet! stattdessen n„chste Zeile: ELSEIF RecNo() == nRec // wenn er sich selber findet - als letzten, damit einzigen Eintrag cTitel := "Dieser Name existiert noch nicht!" SET ORDER TO 1 DbResumeNotifications() RETURN cTitel ELSEIF DbSeek(Upper(cName+cVorname+DtoS(dGebDatum)),.T.) .AND. nRec!=RecNo() cTitel := "A C H T U N G: Gleiche Daten bereits vorhanden!" ELSEIF DbSeek(Upper(cName+cVorname),.T.) .AND. nRec!=RecNo() cTitel := "Dieser Name+Vorname ist bereits vorhanden!" ELSE // wenn nur der Name gleich ist cTitel := "Dieser Name ist bereits vorhanden!" ENDIF IF oBest:Such( oBEDA, ::cS_b, 930, 939, 1, 1->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {}, cTitel ) DbGoto(nRec) // .T. == mit ESC ausgestiegen -> zurck zum Eingabefall ENDIF SET ORDER TO 1 DbResumeNotifications() RETURN cTitel METHOD BestFF:Fallsuche( cSuchArt, cKreis ) LOCAL cSuch := cAuf := IIf(Empty(cKreis),Space(E),cKreis) LOCAL cString := IIf(Empty(cSuchArt),"cStringS","cStringF") // LOCAL oFocus := SetAppFocus(), nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd LOCAL oFocus := IIf(!Empty(::oFocLFSle),::oFocLFSle,::oFocLFSle := oCtrl:lastXbp) LOCAL nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd, nAnzahl LOCAL lLupe := 2->(DbScope()) // nicht 1, weil beim Aufruf Area1 ge'clearscope't wird !!!! LOCAL cTitle := "Auftrags-Nr. (oder ïv ï+Verstorbener/ïa ï+Auftraggeber):" // cVariable ist Private von bestP6 IIf(IsFieldVar("perskz"),::SwapPers("S"),) // 9.5.2005 DbSkip(0) DbSuspendNotifications() IF lLupe ::Lupe({1,2,3}) // 12.11.2005 == Clear Scope ENDIF DO CASE CASE Upper(cSuchArt) = "V " cTitle := "Verstorbenen-Namen eingeben:" CASE Upper(cSuchArt) = "A " cTitle := "Ansprechpartner-Namen eingeben:" CASE Upper(cSuchArt) = "S " cTitle := "Verstorbenen-Straáe eingeben:" CASE Upper(cSuchArt) = "R " // 16.10.2004 cTitle := "Rechnungs-Nr.:" cString := cVariable := "rechnr" ::oFocLFSle := ::XbpObjekt( ::SingleZeile, cVariable ) // 14.11.2004 INDEX on Upper(1->&cVariable) TO x5 ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 DbGoto( nRec ) CASE Upper(cSuchArt) = "F " IF !Empty(::oFocLFSle:cargo) cVariable := IIf( ::oFocLFSle:cargo[1]=="&", &(SubStr(::oFocLFSle:cargo,2)), ::oFocLFSle:cargo ) IF !IsFieldVar(cVariable) //09.10.2006 14:44 cVariable := "NAME" ::oFocLFSle := ::XbpObjekt( ::singleZeile, "NAME" ) ENDIF ::SuchFeld := ::aBeschreib[AScan(::aFelder,Trim(cVariable))] // 17.4.2005 ELSE cVariable := "AUFTRNR" ::SuchFeld := "AuftragsNummer" ENDIF DO CASE CASE cVariable == "NAME" cSuchArt := "V " cTitle := "Verstorbenen-Namen eingeben:" CASE cVariable == "ANSP_NAME" cSuchArt := "A " cTitle := "Ansprechpartner-Namen eingeben:" CASE cVariable == "STRASSE" cSuchArt := "S " cTitle := "Verstorbenen-Straáe eingeben:" OTHERWISE // cTitle := cVariable + " eingeben:" cTitle := ::Suchfeld + " eingeben:" // 17.4.2005 IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrX(Month(1->&cVariable),2,0)+ ; StrX(day(1->&cVariable),2,0) to x5 ELSEIF ValType(1->&cVariable) == "N" INDEX on Str(1->&cVariable) TO x5 ELSE // "C"-Felder (Index fr Memo-Felder ist NICHT m”glich) INDEX on Upper(1->&cVariable) TO x5 ENDIF ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 DbGoto( nRec ) ENDCASE OTHERWISE cTitle := "Auftrag-Nr. eingeben:" ENDCASE // Len() 29.11.2006 08:22: IF Empty(cSuchArt) .AND. Len(cStringS)>0 .AND. Asc(cStringS[1])>64 // 10.11.2005 "Lenzomatic" VerstorbenenNamen suchen cSuchArt := "V " ENDIF DO WHILE .T. y := ::XbpNummer( ::SingleZeile, cString ) cSuch := ::singleZeile[y]:getdata() IF Empty( cSuch) .AND. !Upper(cSuchArt)=="R " // 14.11.2004 cTip := cTitle EXIT ELSEIF Val(cSuch) > Val(Replicate("9",E)) // 999999 cTip := "Zu lang! Neue Auftrag-Nr. :" EXIT ENDIF cSuch := IIf(Val(cSuch)>0 .AND. Empty(cSuchArt), StrX(Val(cSuch),E,0), Trim(cSuch) ) cSuch := IIf(Upper(cSuchArt)=="F " .AND. ValType(1->&cVariable)=="N", ; Str(Val(cSuch),FieldInfo(FieldPos(cVariable),FLD_LEN), ; FieldInfo(FieldPos(cVariable),FLD_DEC) ), ; cSuch ) nRec := RecNo() DO CASE CASE Val(cSuch) > 0 .AND. Empty(cSuchArt) // .or. Trim(cSuch) == "" SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := Padl(cSuch,E) lSuch := DbSeek( cAuf, .F. ) ::SuchFeld := "AuftragsNummer" // 01.05.2005 IF lSuch == .F. DbGoto(nRec) cSuch := cAuf //:= Space(E) cTip := "Auftrag nicht vorhanden." ::Letzte30( ::thisTab, cAuf, cTip, {435,235} ) EXIT ENDIF CASE Trim(cSuch)=="" .AND. !Upper(cSuchArt)=="R " // 14.11.2004 SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := StrX(1->auftrnr,E,0) ::SuchFeld := "AuftragsNummer" // 01.05.2005 CASE Upper(cSuchArt) = "R " // 16.10.2004 : Suchen von Rechnungsnummern SET ORDER TO 5 DbSkip(0) cSuch := IIf(Empty(cSuch),RechnungsNr("9999"),cSuch) // 14.11.2004 DbSeek( Upper(cSuch), .T. ) // DbSkip(-1) nAnf := 940; nEnd := 950 CASE Upper(cSuchArt) = "F " SET ORDER TO 5 nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + "/ Anzahl: "+LTrim(Str(nAnzahl)) ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSeek( Upper(cSuch), .T. ) nAnf := 920; nEnd := 929 CASE Upper(cSuchArt) = "V " SET ORDER TO 2 // Index nach Verstorbenem nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + "/ Anzahl: "+LTrim(Str(nAnzahl)) ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 900; nEnd := 909 CASE Upper(cSuchArt) = "A " SET ORDER TO 3 // Index nach Auftraggeber nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + "/ Anzahl: "+LTrim(Str(nAnzahl)) ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 910; nEnd := 919 CASE Upper(cSuchArt) = "S " SET ORDER TO 4 // Index nach Straáe nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + "/ Anzahl: "+LTrim(Str(nAnzahl)) ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 900; nEnd := 909 OTHERWISE SET ORDER TO 1 // Index nach Auftrnr DbGoto( nRec ) // weil unzul„ssige Eingabe cTip := "Auftrag nicht gefunden." ::SuchFeld := "AuftragsNummer" // 01.05.2005 EXIT ENDCASE IF !Empty(cSuchArt) IF oBest:Such( oBEDA, ::cS_b, nAnf, nEnd, 1, 1->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {} ) cAuf := "" // .T. == mit ESC ausgestiegen ELSE cAuf := StrX(1->auftrnr,E,0) ENDIF ENDIF IF val(cAuf) == 1->Auftrnr // wenn gefunden cTip := "Auftrag gefunden." EXIT ELSEIF cAuf == "" // wenn nicht gefunden, gehe zum Ausgangspunkt DbGoto( nRec ) cTip := "Auftrag nicht gefunden." ::SuchFeld := "AuftragsNummer" SET ORDER TO 1 EXIT ELSE DbGoto( nRec ) cTip := "Andere Auftrag-Nr. :" EXIT ENDIF ENDDO ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata(cStringF:="") //02.07.2006 11:24 SET FILTER TO // 17.10.2004 oBEDA:cargo:readdata() // 14.11.2004 IF Upper(cSuchArt) == "R " SET ORDER TO 1 ::SuchFeld := "AuftragsNummer" ENDIF IF lLupe .AND. OrdNumber()==1 // 12.11.2005 soll MengX schneller machen nRec := RecNo() ::Lupe({1,2,3},StrX(1->auftrnr,E,0)[1]+Replicate("0",E-1),StrX(1->auftrnr,E,0)[1]+Replicate("9",E-1) ) DbGoto(nRec) // weil Scope an den Anfang positioniert ENDIF IIf(IsFieldVar("perskz"),::SwapPers("L"),) // 1.6.2005 DbResumeNotifications() DbSkip(0) oCtrl:lastXbp := oBest:oFocLFSle // 29.10.2004 RETURN cTip METHOD BestFF:Anzahl( cSuch ) LOCAL nAnzahl := 0, nRec := RecNo() IF "MENG"$Upper(AppName()) // 12.11.2005 weil Filter alles langsam machen!! DbSeek( Upper(cSuch), .T. ) RETURN 0 ENDIF DO CASE // 17.10.2004 CASE Val(cStringFM)=0 .AND. Val(cStringFJ)>0 SET FILTER TO Year(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFJ) CASE Val(cStringFM)>0 .AND. Val(cStringFJ)=0 SET FILTER TO Month(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFM) CASE Val(cStringFM)>0 .AND. Val(cStringFJ)>0 SET FILTER TO Month(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFM) .AND. ; Year(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFJ) OTHERWISE SET FILTER TO ENDCASE DbSkip(0) DO CASE // 01.12.2004 CASE cSuch="!" .AND. Len(Trim(cSuch))=2 .AND. (Val(cSuch[2])>0 .OR. cSuch[2]=0) //21.01.2007 10:52 cSuch := SubStr(cSuch,2) COUNT FOR 1->auftrnr>=Val(cSuch[1]+"00000") .AND. 1->auftrnr<=Val(cSuch[1]+"99999") TO nAnzahl SET ORDER TO 1 DbSeek( Upper(cSuch), .T. ) CASE cSuch="!" cSuch := SubStr(cSuch,2) COUNT TO nAnzahl // DbSeek( Upper(cSuch), .T. ) DbGoto( nRec ) //21.01.2007 11:12 CASE ValType(1->&cVariable) == "C" //7.11.2004 COUNT FOR Upper(1->&cVariable) = Upper(cSuch) TO nAnzahl // 17.10.2004 DbSeek( Upper(cSuch), .T. ) CASE ValType(1->&cVariable) == "D" COUNT FOR DtoC(1->&cVariable) = cSuch TO nAnzahl // 7.11.2004 DbSeek( Str(Year(CtoD(cSuch)),4,0)+StrX(Month(CtoD(cSuch)),2,0)+ ; StrX(Day(CtoD(cSuch)),2,0), .T. ) CASE ValType(1->&cVariable) == "N" COUNT FOR 1->&cVariable = Val(cSuch) TO nAnzahl // 7.11.2004 DbSeek( Upper(cSuch), .T. ) ENDCASE RETURN nAnzahl METHOD BestFF:Letzte30( oDlg1, cString, cTip, aTipPos ) LOCAL aStrings := {} LOCAL nRec := RecNo() LOCAL n := AScan( oDlg1:childlist(), {|x| x:isDerivedFrom("XbpListbox")} ) LOCAL nL := ::XbpNummer( ::ListBox, oDlg1:childlist()[n]:cargo ) LOCAL cItem := " ", cS := IIf(Len(cString)==0,"x",cString[1]) IF !Empty( ::ListBox[nL]:getItem(1) ) ::ListBox[nL]:setData({1}) cItem := ::ListBox[nL]:getItem(1) ENDIF ::PaintTip(cTip,aTipPos) IF cString=="" .OR. cString[1] != cItem[1] .OR. ::Fall_geloescht == .T. //26.06.2006 16:05 DBSuspendNotifications() //+15.04.2016 20:59 statt 'go bott' dbSeekLast() IF cS != "x" cS := cS+"99999" DbSeek(cS,.T.) DbSkip(-1) ENDIF //15.04.2016 20:55 nur wenn Suchstring nicht vorhanden: IF cS == "x" SET ORDER TO 0 GO BOTTOM ENDIF ::ListBox[nL]:CLEAR() DO WHILE !Bof() .AND. Len(aStrings) <= 30 DO CASE CASE !Empty(cString) .AND. PadL(cString,E)[1]!=StrX(1->auftrnr,E,0)[1] //11.2.04 // --i // Auftrnr aus falscher Gruppe berspringen 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 DbSkip(-1) ENDDO SET ORDER TO 1 IF Upper(AppName())$"SINZIGX.EXE" //18.12.2005 ASort( aStrings,,,{|x1,x2|Stuff(x1,3,1,"0")>Stuff(x2,3,1,"0")} ) ELSE ASort( aStrings,,,.T. ) ENDIF cString := IIf( (Val(cString)>0 .OR. "Kopie"$oDlg1:cargo) .AND. Len(aStrings)>0, ; IIf("akzept"$cTip,StrX(Val(Left(aStrings[1],E))+1,E,0),Space(E)), ; cString ) //11.2.04 //+27.01.2011 20:34 AEval( aStrings, {|c| ::ListBox[nL]:addItem(c) } ) FOR i := 1 TO Len(aStrings) Sleep(1) //+27.01.2011 20:34 race-Effekt ::ListBox[nL]:addItem(aStrings[i]) NEXT ::ListBox[nL]:setData( {1}, .T. ) ::Fall_geloescht := .F. // wieder zurckgesetzt 26.06.2006 16:04 GO nRec DbResumeNotifications() ELSEIF nL == 4 // 12.11.2005 Neuer Fall cString := StrX(Val(cItem)+1,E,0) ENDIF //RETURN Trim(cString) RETURN IIf(nL>2,cString,"") // 12.11.2005 beim Suchen keine Vorgaben METHOD BestFF:ZumBlockAnfang(cAuf) LOCAL nOldArea := SELECT() DbSkip(0) // 20.07.2006 17:47 damit abgespeichert wird SELECT 1 cAuf := IIf( Val(cAuf[1])!=0, cAuf[1]+Replicate("0",E-1), Space(E) ) SET ORDER TO 1 ::suchFeld := "Auftragsnummer" DbSuspendNotifications() DbSeek( cAuf, .T. ) DbResumeNotifications() SELECT (nOldArea) RETURN self METHOD BestFF:ZumBlockEnde(cAuf) LOCAL nOldArea := SELECT() DbSkip(0) // 20.07.2006 17:47 damit abgespeichert wird SELECT 1 cAuf := cAuf[1]+Replicate("9",E-1) // "99999" SET ORDER TO 1 ::suchFeld := "Auftragsnummer" DbSuspendNotifications() DbSeek( cAuf, .T. ) DbResumeNotifications() IIf( Val(cAuf[1]) != Val(StrX(field->auftrnr,E,0)[1]), DbSkip(-1), DbSkip(0) ) SELECT (nOldArea) RETURN self METHOD BestFF:Anschrift(nA) LOCAL aAdr DO CASE CASE nA = 5 aAdr := {5->name1,5->name2,5->strasse,5->plz_ort} CASE nA = 12 aAdr := {12->name1,12->name2,12->strasse,12->plz_ort} CASE nA = 4 aAdr := {4->P_ANREDE,Trim(4->P_VORNAME)+" "+4->P_NAME,4->P_STRASSE,4->P_PLZ_ORT} CASE nA = 99 //16.05.2007 22:35 fr Werner-Checkliste DO CASE CASE ::oFocLFSle:cargo = "&"+"TO1" aAdr := {::TW1,DtoC(1->&TD1),Str(1->&TZ1,5,2)+" Uhr",1->&TO1,1->&PR1,1->PKW,1->&MU1,1->&FL1, ; 1->konf,IIf("Text fr Grabkreuz"$1->notiz,"Grabkreuz","kein Grabkreuz"), ; 1->grreihe,Trim(1->feld)+" - "+Trim(1->grabnr)+" - "+Trim(1->gr_einheit),""} CASE ::oFocLFSle:cargo = "&"+"TO2" aAdr := {::TW2,DtoC(1->&TD2),Str(1->&TZ2,5,2)+" Uhr",1->&TO2,1->&PR2,1->PKW,1->&MU2,1->&FL2, ; 1->konf,IIf("Text fr Grabkreuz"$1->notiz,"Grabkreuz","kein Grabkreuz"), ; 1->grreihe,Trim(1->feld)+" - "+Trim(1->grabnr)+" - "+Trim(1->gr_einheit),""} CASE ::oFocLFSle:cargo = "&"+"TO3" aAdr := {::TW3,DtoC(1->&TD3),Str(1->&TZ3,5,2)+" Uhr",1->&TO3,1->&PR3,1->PKW3,1->&MU3,1->&FL3, ; 1->konf,IIf("Text fr Grabkreuz"$1->notiz,"Grabkreuz","kein Grabkreuz"), ; 1->grreihe,Trim(1->feld)+" - "+Trim(1->grabnr)+" - "+Trim(1->gr_einheit),""} OTHERWISE aAdr := {::TW4,DtoC(1->&TD4),Str(1->&TZ4,5,2)+" Uhr",1->&TO4,1->&PR4,1->PKW4,1->&MU4,1->&FL4, ; 1->konf,IIf("Text fr Grabkreuz"$1->notiz,"Grabkreuz","kein Grabkreuz"), ; 1->grreihe,Trim(1->feld)+" - "+Trim(1->grabnr)+" - "+Trim(1->gr_einheit),""} ENDCASE OTHERWISE aAdr := {1->ansp_anr,Trim(1->ansp_vname)+" "+1->ansp_name,1->ansp_str,1->ansp_ort} ENDCASE RETURN aAdr // fr BergX: Berechnung der Tr„ger pro Monat METHOD BestFF:MonatsSumme(cFeld,cDatum1,cDatum2,cBedingung,nPP) // nPP = EUR/Tr„ger LOCAL nMSumme, nRec := 1->(RecNo()), nA := SELECT() DEFAULT cBedingung TO "1->traeger$[jJ]" // Tr„gerprovision fr BergX (nA)->(DbSuspendNotifications()) SELECT 1 1->(DbSuspendNotifications()) 1->(DbSetFilter({|| 1->beerd_dat>=CtoD(cDatum1) .AND. 1->beerd_dat<=CtoD(cDatum2)})) 1->(DbGotop()) // SUM Anztrae TO nMSumme FOR traeger = "j" //&cBedingung SUM &cFeld TO nMSumme FOR &cBedingung 1->(DbClearFilter()) 1->(DbGoto(nRec)) 1->(DbResumeNotifications()) IF !Empty(nPP) SELECT 3 DbSuspendNotifications() DbSeek(StrX(1->auftrnr,E,0),.F.) IIf( Eof(),DbAppend(),) IF 3->bezeich = "Tr„gerprovision" .OR. Empty(3->bezeich) Satzsp(oBEDA) 3->auftrnr := 1->auftrnr 3->zeile := " 1" 3->kennz := "1" 3->mwst_schl := "3" 3->zugr_z_st := "1" 3->bezeich := "Tr„gerprovision vom "+cDatum1+" - "+cDatum2 3->&b_g := nMSumme * nPP + nMSumme*nPP*0.16 3->(DbRUnlock()) ENDIF DbResumeNotifications() ENDIF SELECT &nA (nA)->(DbResumeNotifications()) RETURN nMSumme METHOD BestFF:DruckAlle( cBlDatei, bFilter ) LOCAL nRec := RecNo() DbSuspendNotifications() DbSetFilter(bFilter) DbGotop() DO WHILE !Eof() Satzsp( oBEDA ) BlattDRG( cBlDatei,, oBEDA,,, "P", "O", @nAnz, @nt ) DbRUnLock() DbSkip() ENDDO DbClearFilter() DbGoto(nRec) DbResumeNotifications() RETURN self METHOD BestFF:RDatum(nt) // 23.8.04 : in bl_a statt date() LOCAL dDatum := DATE(), nAuf, nOldArea := SELECT(), nRec DbSelectArea(3) DbSeek(StrX(1->auftrnr,E,0),.F.) IF 1->auftrnr != 3->auftrnr RETURN(dDatum) ENDIF nRec := RecNo() IF Empty(3->ttmm) IF Upper(AppName())$"KREMERX.EXE" dDatum := DATE() ELSE dDatum := IIf( nt=0, IIf(!Empty(1->beerd_dat),1->beerd_dat,DATE()), DATE() ) ENDIF ELSE IF nt!=0 DbSuspendNotifications() DO WHILE 1->auftrnr == 3->auftrnr IF nt != Val(3->rn) 3->(DbSkip()) LOOP ENDIF ENDDO IF 1->auftrnr != 3->auftrnr GO nRec ENDIF ENDIF dDatum := CtoD( SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( !Empty(1->beerd_dat),Str(Year(1->beerd_dat)), ; IIf(Month(DATE()) >= Val(SubStr(3->ttmm,3,2)), Str(Year(DATE()),4), ; Str(Year(DATE())-1,4) )) ) IF nt!=0 GO nRec DbResumeNotifications() ENDIF ENDIF DbSelectArea(nOldArea) RETURN dDatum METHOD BestFF:Lupe( aA, cTop, cBot ) FOR nA := aA[1] TO aA[Len(aA)] IF Empty(cTop) .AND. Empty(cBot) (nA)->(DbClearScope()) ELSE (nA)->(DbSetScope( SCOPE_TOP, cTop )) (nA)->(DbSetScope( SCOPE_BOTTOM, cBot )) (nA)->(DbGobottom()) ENDIF NEXT RETURN self METHOD BestFF:Wochentag() IF IsFieldVar("perskz") .OR. Upper(AppName())$"BERGX.EXE-LANGEX.EXE-SANDERX.EXE" //16.02.2007 10:07 IF IsFieldVar("GESTORBEN") oBest:XbpObjekt( oBest:SingleZeile, "SWT" ):setData(::SWT:=CDoW(1->GESTORBEN)) ENDIF IF IsFieldVar("&TD0") oBest:XbpObjekt( oBest:SingleZeile, "TW0" ):setData(::TW0:=CDoW(1->&TD0)) ENDIF IF IsFieldVar("&TD1") oBest:XbpObjekt( oBest:SingleZeile, "TW1" ):setData(::TW1:=CDoW(1->&TD1)) ENDIF IF IsFieldVar("&TD2") oBest:XbpObjekt( oBest:SingleZeile, "TW2" ):setData(::TW2:=CDoW(1->&TD2)) ENDIF IF IsFieldVar("&TD3") .AND. !Upper(AppName())$"WERNERX.EXE" oBest:XbpObjekt( oBest:SingleZeile, "TW3" ):setData(::TW3:=CDoW(1->&TD3)) ENDIF IF IsFieldVar("&TD4") oBest:XbpObjekt( oBest:SingleZeile, "TW4" ):setData(::TW4:=CDoW(1->&TD4)) ENDIF ENDIF RETURN self METHOD BestFF:Ordnen(cVar,cSuchArt) // cSuchArt:="F " wird per Referenz bergeben DEFAULT cVar TO "auftrnr" PRIVATE cVariable := cVar IF SELECT()=1 DO CASE CASE Upper(cVariable) == "AUFTRNR" cSuchArt := "" SET ORDER TO 1 CASE Upper(cVariable) == "NAME" cSuchArt := "V " SET ORDER TO 2 CASE Upper(cVariable) == "ANSP_NAME" cSuchArt := "A " SET ORDER TO 3 CASE Upper(cVariable) == "STRASSE" cSuchArt := "S " SET ORDER TO 4 OTHERWISE IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrX(Month(1->&cVariable),2,0)+ ; StrX(day(1->&cVariable),2,0) to x5 ELSEIF ValType(1->&cVariable) == "N" INDEX on Str(1->&cVariable) TO x5 ELSE INDEX on Upper(1->&cVariable) TO x5 ENDIF ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 SET ORDER TO 5 ENDCASE ELSEIF SELECT()=4 DO CASE CASE Upper(cVariable) == "P_NAME" OrdSetFocus("x2") ENDCASE ENDIF RETURN OrdNumber() // fr DischX: Kopieren vom Laptop in das Netzwerk METHOD BestFF:FallCaufM( cKopie, cKreis, cVer ) //15.08.2006 LOCAL cAufalt, n, aDataV := {}, cVersTemp, cAufTemp, cTip DEFAULT cVer TO cNetver // 15.08.2006 cAufalt := StrX( 1->auftrnr,E,0 ) //***************** // 18.4.2005: // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 21 // USE (cVer+"Best") DbUseArea(,,cVer+"Best",,.T.) SET INDEX TO (cVer+"xauftrnr") 21->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall IF 21->(Eof()) 21->(DbAppend()) ELSE 21->(Satzsp(oCB)) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT USE // Versicherungseintr„ge in den Bestattungsfall kopieren: cVerstemp := "v_"+cAufalt //"ver2"+LTrim(Str(Int(Seconds()/10))) 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 SELECT 2 skip enddo SELECT 12 USE SELECT 22 // USE (cVer+"VV") DbUseArea(,,cVer+"VV",,.T.) SET INDEX TO (cVer+"xvvauf") 22->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall DO WHILE 22->auftrnr = Val(cAufalt) 22->(SatzDelete()) ENDDO APPEND FROM (cVersTemp) USE // Rechnungsdaten in den Bestattungsfall kopieren: SELECT 23 // USE (cVer+"AUFTR") DbUseArea(,,cVer+"AUFTR",,.T.) SET INDEX TO (cVer+"xaufauf") SELECT 26 // USE (cVer+"ART") DbUseArea(,,cVer+"ART",,.T.) SET INDEX TO (cVer+"xart_lei") cAuf3temp := "r_"+cAufalt // 5.6.04 //LTrim(StrX(1->auftrnr,E,0)) 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 SELECT 3 skip enddo SELECT 13 IF .NOT. Bof() GO TOP ENDIF aData2 := Array(FCount()) DO WHILE .NOT. Eof() FOR n := 1 to FCount() aData2[n] := FieldGet( n ) NEXT SELECT 23 23->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall DO WHILE 23->auftrnr = Val(cAufalt) // Artikel-Daten korrigieren: cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) REPLACE 26->bestand WITH 26->bestand+1 REPLACE 26->mgjahr WITH 26->mgjahr-1 REPLACE 26->umsatz WITH 26->umsatz - 23->betrag REPLACE 26->umsatzeu WITH 26->umsatzeu - 23->betrageu REPLACE 26->umsneteu WITH 26->umsneteu - 23->betneteu DbRUnlock( Recno() ) // 23->(SatzDelete()) ENDDO APPEND BLANK FOR n := 1 to FCount() FieldPut( n, aData2[n] ) NEXT DbRUnlock( Recno() ) // ... und unlock // Artikel-Daten korrigieren: cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) REPLACE 26->bestand WITH 26->bestand-1 REPLACE 26->mgjahr WITH 26->mgjahr+1 REPLACE 26->umsatz WITH 26->umsatz + 23->betrag REPLACE 26->umsatzeu WITH 26->umsatzeu + 23->betrageu REPLACE 26->umsneteu WITH 26->umsneteu + 23->betneteu DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 23 USE SELECT 26 USE SELECT 1 FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) cTip := "Auftrag kopiert." DbSkip(0) RETURN cTip //Email.prg////////////////////////////////////////////////////////////////////////////////////////// // Fall 1: Kopie eines Falls in das Email-Verzeichnis // a) wenn Email-Verzeichnis leer: Dateien neu anlegen und Fall-Daten reinkopieren. // b) wenn Dateien existieren, berprfen, ob richtige Filiale (mwstdat.dbf) // wenn richtige Filiale, den Fall in die bestehenden Dateien kopieren // wenn falsche Filiale, melden und NICHT kopieren. // Fall 2: Kopie eines Falles aus dem Email-Verzeichnis in die PC-Datein // -zuerst die Filiale feststellen, deren Fall-Daten im Email-Verzeichnis sind // -dann in die Filiale einloggen // -dann die Fall-Daten in die PC-Dateien reinkopieren ///////////////////////////////////////////////////////////////////////////////////////////// // Dateien/WorkAreas: // Area 1: best.dbf auf dem PC // Area 2: vv.dbf auf dem PC // Area 3: auftr.dbf auf dem PC // Area 21: best.dbf im Email-Verzeichnis // Area 22: vv.dbf im Email-Verzeichnis // Area 23: auftr.dbf im Email-Verzeichnis //Vorgang: zuerst in die Filiale gehen, in die/aus der kopiert werden soll // deren Daten-Verzeichnis auf dem PC ist cQuelle oder cZiel - je nachdem... METHOD BestFF:Email( cQuelle, cZiel ) //21.05.2007 22:35 LOCAL cAufalt, i, n, aDataV := {}, cVersTemp, cAufTemp, cTip, nOldArea := SELECT() LOCAL cEVerz := cDatver[1]+":\HDBE\EMAIL\" // im selben Laufwerk wie die PC-Dateien // Email-Verzeichnis l”schen: IF Empty(cZiel) AEval( Directory(cQuelle+"*.*"), { |a| FErase( cQuelle+a[1] ) } ) RETURN cTip := "Email-Verzeichnis gel”scht" ENDIF // sind bereits Daten im Email-Verzeichnis? IF FExists( cEVerz+"best.dbf" ) // stimmt die Filiale? SELECT 9 DbUseArea( ,,cEVerz+"mwstdat" ) // wenn die Filiale nicht stimmt: Abbbuch: IF Trim(9->bname) != cFirma ConfirmBox( oCB, ; "Es sind Daten von "+Trim(9->bname)+CRLF+ ; "im Email-Verzeichnis!", ; "Falsche Filiale!", ; XBPMB_OK, ; XBPMB_WARNING ) cTip := "Falsche Filiale: ("+Trim(9->bname)+") im Email-Verzeichnis!" DbCloseArea() SELECT (nOldArea) RETURN cTip ENDIF DbCloseArea() ELSE // wenn noch keine Daten im Email-Verzeichnis: IF !FExists(SubStr(cEVerz,1,Len(cEVerz)-1),"D") // Verzeichnis neu erstellen, wenn es noch nicht existiert: RunShell( "/C MD "+SubStr(cEVerz,1,Len(cEVerz)-1),, .T. ) Sleep(100) // damit Windows es bemerkt... ENDIF IF cZiel == cDatver // wenn aus dem Emailverzeichnis kopiert werden soll cTip := "Das Email-Verzeichnis ist leer." RETURN cTip // muss dort schon etwas sein!! Also abbrechen! ENDIF // Dateien im Email-Verzeichnis anlegen: SELECT 1 COPY stru TO (cEVerz+"best") SELECT 2 COPY stru TO (cEVerz+"vv") SELECT 3 COPY stru TO (cEVerz+"auftr") ENDIF // richtige Filiale festgestellt und Dateien existieren im Emailverzeichnis // // Dateien ”ffnen in 21,22,23: (ist das wirklich n”tig???, sie sind ja schon in 1,2,3 offen! IF cQuelle == cDatver // FallDaten kopieren in das Email-Verzeichnis SELECT 1 cAufalt := StrX( 1->auftrnr,E,0 ) // der aktuelle Quell-Auftrag (auf PC oder USBStick) // Quell-Bestattungsfall ist ja schon da... FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // liest die Quelle in ein Array ein NEXT // ...in das Zielverzeichnis kopieren SELECT 21 DbUseArea(,,cEVerz+"Best",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 21->auftrnr = Val(cAufalt) // berschreibt ggf. vorhandenen Fall... IF 21->(Eof()) 21->(DbAppend()) // ...oder h„ngt neuen Fall dran ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // schreibt Array in das Ziel NEXT DbCloseArea() // // Versicherungseintr„ge in den Ziel-Bestattungsfall kopieren: SELECT 22 DbUseArea(,,cEVerz+"VV",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 22->auftrnr = val(cAufalt) // gibt es den Fall schon im Emailverzeichnis? DO WHILE 22->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. vorhandene Eintr„ge 22->(SatzDelete()) DbSkip(0) ENDDO SELECT 2 aDataV := Array(FCount()) FIND &cAufalt // Quell-Versicherungseintr„ge suchen DO WHILE 2->auftrnr=val(cAufalt) .and. .not. Eof() FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 22 22->(DbAppend()) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zieldatei schreiben NEXT SELECT 2 SKIP ENDDO SELECT 22 PACK DbCloseArea() // // Rechnungsdaten in den Ziel-Bestattungsfall kopieren: SELECT 23 DbUseArea(,,cEVerz+"auftr",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 23->auftrnr = val(cAufalt) // gibt es den Fall schon im Emailverzeichnis? DO WHILE 23->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. vorhandene Eintr„ge 23->(SatzDelete()) DbSkip(0) ENDDO SELECT 3 aDataV := Array(FCount()) FIND &cAufalt // Quell-Versicherungseintr„ge suchen DO WHILE 3->auftrnr=val(cAufalt) .and. !Eof() FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 23 23->(DbAppend()) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zieldatei schreiben NEXT SELECT 3 SKIP ENDDO SELECT 23 PACK DbCloseArea() DbUseArea(,,cDatver+"mwstdat.dbf") COPY TO (cEVerz+"mwstdat") DbCloseArea() SELECT 1 cTip := "Auftrag ins Email-Verzeichnis kopiert." // ELSEIF cZiel == cDatver // Daten aus dem Emailverzeichnis ins cDatver reinkopieren i := 0 SELECT 1 aDataV := Array(FCount()) SELECT 23 DbUseArea(,,cEVerz+"auftr","a2") // Quelle ”ffnen SELECT 22 DbUseArea(,,cEVerz+"vv","v2") // Quelle ”ffnen SELECT 21 DbUseArea(,,cEVerz+"best","b2") // Quelle ”ffnen DO WHILE !Eof() cAufalt := StrX( 21->auftrnr,E,0 ) // der Quell-Auftrag (im Emailverzeichnis) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // liest die Quelle in ein Array ein NEXT // ...in das Zielverzeichnis kopieren SELECT 1 1->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) IF 1->(Eof()) 1->(DbAppend()) // ...oder h„ngt neuen Fall dran ENDIF Satzsp(oCB) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // schreibt Array in das Ziel NEXT DbRUnlock() ++i // ein Auftrag eingelesen // // Email-Versicherungseintr„ge in den Ziel-Bestattungsfall im cDatver kopieren: SELECT 2 aDataV := Array(FCount()) 2->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) SELECT 22 LOCATE FOR auftrnr = Val(cAufalt) // in Email-Datei sind alle Records.. DO WHILE 22->auftrnr = val(cAufalt) .AND. !Eof() // ..zum selben Auftrag hintereinander! FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 2 IF 2->(Eof()) 2->(DbAppend()) // ...oder h„ngt neuen Fall dran ELSE Satzsp(oCB) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT DbRUnlock() DbSkip() SELECT 22 DbSkip() ENDDO SELECT 2 DO WHILE 2->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. weitere Eintr„ge 2->(SatzDelete()) DbSkip() ENDDO // // Email-Rechnungen in den Ziel-Bestattungsfall im cDatver kopieren: SELECT 3 aDataV := Array(FCount()) 3->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) SELECT 23 LOCATE FOR auftrnr = Val(cAufalt) // in Email-Datei sind alle Records.. DO WHILE 23->auftrnr = val(cAufalt) .AND. !Eof() // ..zum selben Auftrag hintereinander! FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 3 IF 3->(Eof()) 3->(DbAppend()) // ...oder h„ngt neuen Fall dran ELSE Satzsp(oCB) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT DbRUnlock() DbSkip() SELECT 23 DbSkip() ENDDO SELECT 3 DO WHILE 3->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. weitere Eintr„ge 3->(SatzDelete()) DbSkip() ENDDO // SELECT 1 // damit die Struktur des heimischen PCs gilt! aDataV := Array(FCount()) SELECT 21 DbSkip() // einfach physikalisch der n„chste Auftrag ENDDO DbCloseArea() SELECT 22 DbCloseArea() SELECT 23 DbCloseArea() // Email-Verzeichnis komplett l”schen (als Backup dient immer noch der Original-Anhang!) AEval( Directory(cEVerz+"*.*"), { |a| FErase( cEVerz+a[ F_NAME ] ) } ) cTip := LTrim(Str(i))+" Auftr„ge vom Email-Verzeichnis eingelesen + Email-Dateien gel”scht." ENDIF SELECT (nOldArea) RETURN cTip // mit ::EDatei() holt man alle Dateien aus cEVerz="X:\HDBE\Email", wo die Daten hinterlegt werden // mit (z.B.) ::EDatei( "c:\PM4\", .T. ) wird der Auswahldialog im PageMaker-Verzeichnis gezeigt METHOD BestFF:EDatei(cEVerz,lDiag, cTitel) LOCAL aDateien := {} DEFAULT cEVerz TO cDatver[1]+":\HDBE\Email\" DEFAULT lDiag TO .F. DEFAULT cTitel TO "W„hlen Sie Dateien zum Versenden aus (oder ESC fr keine)" IF lDiag oDlg := XbpFileDialog():new() oDlg:title := cTitel oDlg:create() aDateien := oDlg:open( cEVerz+IIf("*."$cEVerz,"","*.PM*"),, .T. ) // .T. = lAllowMultiple aDateien := IIf( Empty(aDateien), {""}, aDateien ) ELSE AEval( Directory(cEVerz+"*.*"), { |a| AAdd(aDateien, cEVerz+a[ F_NAME ] ) } ) ENDIF RETURN aDateien METHOD BestFF:FDatei() LOCAL aDateien := {} AEval( Directory(cDatver+"ak_f*.*"), { |a| AAdd(aDateien, cDatver+a[ F_NAME ] ) } ) RETURN aDateien // mit ::EmailLesen() werden in der Auswahl nur .TXT-Dateien gezeigt METHOD BestFF:EmailLesen(cDatei) LOCAL oDlg, cTextDatei := "" DEFAULT cDatei TO "*.txt" oDlg := XbpFileDialog():new() oDlg:title := "W„hlen Sie eine Email (oder ESC fr keine)" oDlg:create() cTextDatei := oDlg:open( cDatver+"POST\"+cDatei ) IF !Empty(cTextDatei) .AND. ValType(cTextDatei)=="C" IF ".PM"$Upper(cTextDatei) // RunShell( "/C \PM5\PM5 "+cTextDatei,, .T. ) RunShell( cTextDatei, "\PM5\PM5.EXE", .T. ) ELSE ModalDialog( (cTextDatei), "Email-Datei "+cTextDatei+" lesen.", oBEDA, 600*nV, 480*nV ) ENDIF ENDIF RETURN self // Entpacken der im POST-Verzeichnis abgelegten App.ZIP-Datei in das PROG-Verzeichnis // Es gibt fr jede Filiale ein POST-Verzeichnis, daher als Unterverzeichnis des jeweil. cDatver // Es gibt nur ein einziges PROG-Verzeichnis, daher als Unterverzeichnis von HDBE // Als EntPacker wird 7zG.exe verwendet (G-Version beinhaltet bereits die Codecs) // e wie entpacken, -o wie Ziel-Verzeichnis, -y wie ohne zu fragen berschreiben METHOD BestFF:ProgEntpacken(cDatei) LOCAL cTip DEFAULT cDatei TO SubStr(Appname(),1,Len(AppName())-4)+".ZIP" IF FExists(cDatver+"PROG\"+cDatei) IF ConfirmBox( oCB, ; "Soll die "+cDatver+"PROG\"+cDatei+" in das Verzeichnis"+CRLF+ ; cDatver[1]+":\HDBE\PROG"+" entpackt werden?", ; "Programmdatei entpacken:", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN "NICHTS entpackt !" // nichts wird kopiert ENDIF RunShell( "/C 7zg e "+cDatver+"PROG\"+cDatei+" -o"+cDatver[1]+":\HDBE\PROG -y",, .F. ) cTip := cDatei+" wurde entpackt! ->Mit F10 beenden und 'Programm rekonstruieren'" ELSE cTip := cDatei+" existiert nicht !" ENDIF RETURN cTip // (hier und nicht in BDTransfer, weil das wohl fr jeden Kunden interessant ist:) // entwickelt fr BergX: fallweises Kopieren vom Stick auf den PC und umgekehrt //Vorgang: zuerst in den Auftrag gehen, der kopiert werden soll (ggf. 'auf dem Stick arbeiten') METHOD BestFF:FallX1aufY1( cQuLw, cVer ) //07.03.2007 16:51 x:cVer <-> y:cVer LOCAL cAufalt, n, aDataV := {}, cVersTemp, cAufTemp, cTip LOCAL nDrive, cNetverX := " " DEFAULT cQuLw TO SubStr(cDatver,1,2) // Quell-Laufwerk, also PC/Server ODER USB-Stick DEFAULT cVer TO Trim(SubStr(cDatver,3)) // Datenverzeichnis auf dem PC/Server UND auf dem Stick IF Asc(cQuLw)>67 .AND. Asc(cQuLw)<76 // Quelle=USB-Stick, Ziel=PC/Server cNetverX := SubStr(cNetver,1,2)+cVer // Zielverzeichnis liegt auf dem PC/Server ELSE // Quelle=PC/Server, Ziel=USB-Stick // auf dem Stick der gleiche Verzeichnisname wie auf dem PC/Server // Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen // Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung // das Server-Laufwerk heiát in der Regel M: (oder S:), das CD-LW ist normalerweise D: // L: wurde ausgespart, wegen MengX (Lenzen-Laufwerk!) FOR nDrive := 75 TO 68 STEP -1 // Chr(nDrive) = "K" ... "D" IF BIsDriveReady(Chr(nDrive)) = 0 // wieso BIsDrive... // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":"+SubStr(cVer,1,Len(cVer)-1), "D" ) // wenn das Verzeichnis existiert: cNetverX := Chr(nDrive)+":"+cVer // Ziel-Verzeichnis des USB-Sticks, //auf das kopiert werden soll EXIT ELSE IF ConfirmBox( oCB, ; "Soll auf dem Stick das Verzeichnis"+CRLF+ ; Chr(nDrive)+":"+cVer+" angelegt werden?", ; "Zielverzeichnis existiert nicht!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF // Verzeichnis neu erstellen: RunShell( "/C MD "+Chr(nDrive)+":"+cVer,, .T. ) Sleep(100) IF ++n <= 1 // n ist nur ein Z„hler, der auf 0 voreingestellt ist // mit demselben Laufwerk noch einmal versuchen: jetzt existiert das Verzeichnis nDrive++ ELSE // beim zweiten Mal ein Laufwerk weitergehen (war vielleicht nicht beschreibbar?) n := 0 ENDIF LOOP ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetverX[1])) < 68 ConfirmBox( oCB, ; "USB-Stick einstecken und"+CRLF+ ; "Vorgang wiederholen.", ; "Kein USB-Stick!?", ; XBPMB_OK, ; XBPMB_WARNING ) RETURN .F. // nichts wird kopiert ENDIF ENDIF cAufalt := StrX( 1->auftrnr,E,0 ) // der aktuelle Quell-Auftrag (auf PC oder USBStick) // Quell-Bestattungsfall ist ja schon da... FIND &cAufalt // ...in das Zielverzeichnis kopieren aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // liest die Quelle in ein Array ein NEXT SELECT 21 DbUseArea(,,cNetverX+"Best",,.T.) // ”ffnet Zieldatei SET INDEX TO (cNetverX+"xauftrnr") 21->(DbSeek(cAufalt,.F.)) // berschreibt ggf. vorhandenen Fall... IF 21->(Eof()) 21->(DbAppend()) // ...oder h„ngt neuen Fall dran ELSE 21->(Satzsp(oCB)) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // schreibt Array in das Ziel NEXT USE // // Versicherungseintr„ge in den Ziel-Bestattungsfall kopieren: cVerstemp := "v_"+cAufalt SELECT 2 COPY STRU TO (cVerstemp) // Zwischendatei erzeugen aDataV := Array(FCount()) SELECT 12 USE (cVerstemp) EXCLUSIVE SELECT 2 FIND &cAufalt // Quell-Versicherungseintr„ge suchen do while 2->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 12 12->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT SELECT 2 skip enddo SELECT 12 USE SELECT 22 DbUseArea(,,cNetverX+"VV",,.T.) // ”ffnet Zieldatei SET INDEX TO (cNetverX+"xvvauf") 22->(DbSeek(cAufalt,.F.)) //berschreibt vorhandenen Fall DO WHILE 22->auftrnr = Val(cAufalt) // l”scht evtl. vorhandene Eintr„ge 22->(SatzDelete()) DbSkip(0) ENDDO APPEND FROM (cVersTemp) // liest Zwischendatei in Zieldatei ein USE // // Rechnungsdaten in den Ziel-Bestattungsfall kopieren: SELECT 23 DbUseArea(,,cNetverX+"AUFTR",,.T.) // ”ffnet Zieldatei SET INDEX TO (cNetverX+"xaufauf") SELECT 26 DbUseArea(,,cNetverX+"ART",,.T.) // ”ffnet Ziel-Artikel-Datei SET INDEX TO (cNetverX+"xart_lei") cAuf3temp := "r_"+cAufalt 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 ) // Quelle lesen NEXT SELECT 13 13->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT SELECT 3 skip enddo SELECT 13 IF .NOT. Bof() GO TOP ENDIF aDataV := Array(FCount()) DO WHILE .NOT. Eof() FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Zwischendatei lesen NEXT SELECT 23 23->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall DO WHILE 23->auftrnr = Val(cAufalt) // Artikel-Daten korrigieren: bisherigen Rechnungsbestand/Umsatz rckg„ngig machen cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) IIf( IsFieldVar("bestand"), 26->bestand := 26->bestand+1, ) IIf( IsFieldVar("mgjahr"), 26->mgjahr := 26->mgjahr-1, ) IIf( IsFieldVar("umsatz"), 26->umsatz := 26->umsatz - 23->betrag, ) IIf( IsFieldVar("umsatzeu"), 26->umsatzeu := 26->umsatzeu - 23->betrageu, ) IIf( IsFieldVar("umsneteu"), 26->umsneteu := 26->umsneteu - 23->betneteu, ) DbRUnlock( Recno() ) SELECT 23 // bisherige Rechnungs-Zeile l”schen: 23->(SatzDelete()) 23->(DbSkip(0)) ENDDO APPEND BLANK FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Ziel schreiben NEXT DbRUnlock( Recno() ) // ... und unlock // Artikel-Daten korrigieren: cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) IIf( IsFieldVar("bestand"), 26->bestand := 26->bestand-1, ) IIf( IsFieldVar("mgjahr"), 26->mgjahr := 26->mgjahr+1, ) IIf( IsFieldVar("umsatz"), 26->umsatz := 26->umsatz + 23->betrag, ) IIf( IsFieldVar("umsatzeu"), 26->umsatzeu := 26->umsatzeu + 23->betrageu, ) IIf( IsFieldVar("umsneteu"), 26->umsneteu := 26->umsneteu + 23->betneteu, ) DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 23 USE SELECT 26 USE SELECT 1 FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) cTip := "Auftrag kopiert." DbSkip(0) RETURN cTip METHOD BestFF:SwapPers(cLS) LOCAL nOldArea := SELECT(), nRec4 := 4->(RecNo()) LOCAL cPersKZ := "@" // Es gibt Apps ohne Angeh”rige: IF (Upper(AppName())$"FLUESX.EXE" .AND. Upper(::cS_b) != "S_BEST") .OR. ; //15.10.2006 13:44 fr FluesX (Upper(AppName())$"KOMPAKTX.EXE" .AND. Upper(::cS_b) = "S_BEST") //29.06.2007 19:01 fr KompaktX RETURN self ENDIF // DbSuspendNotifications() // wird doch garnicht gebraucht!! IF Upper(cLS) != "A" .AND. ::PvPERSKZ="@" // hier muss noch eine Warnung hin, wenn noch kein Angeh”riger angelegt ist IF Upper(cLS) == "S" .AND. oCtrl:lastXbp != NIL .AND. IsMemberVar(oCtrl:lastXbp,"cargo") .AND. ; ValType(oCtrl:lastXbp:cargo)=="C" .AND. oCtrl:lastXbp:cargo = "Pv" ////// IF ::oFocLMSle:value != ::oFocLMSle:vorigerwert .AND. ; ////// ConfirmBox( oCB, "Soll ein neuer Angeh”riger angelegt werden?", ; ////// "Noch kein Angeh”riger angelegt!", ; ////// XBPMB_YESNO, ; ////// XBPMB_QUESTION, ; ////// XBPMB_DEFBUTTON2 ) == XBPMB_RET_YES ::SwapPers("A") ////// ELSE ////// ::oFocLMSle:setData( ::oFocLMSle:vorigerwert ) ////// ::oFocLMSle:getData() ////// ENDIF RETURN self ELSEIF Upper(cLS) == "S" //20.05.2007 17:20 sonst wird kaputtgeschrieben RETURN self ENDIF ENDIF SELECT 4 IF Upper(cLS) = "L" // IF DbSeek( StrX(1->auftrnr,E,0)+1->perskz,.F.) // 26.08.2005 stellt "Relation" her // IF 1->auftrnr == 4->P_AUFTRNR .AND. 1->perskz == 4->P_PERSKZ // wenn synchron // ::PvAUFTRNR := 4->P_AUFTRNR // ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:=4->P_PERSKZ) // ELSE IF 1->auftrnr == 4->P_AUFTRNR // oder wenn ziemlich synchron ::PvAUFTRNR := 4->P_AUFTRNR ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:=4->P_PERSKZ) ELSEIF DbSeek( StrX(1->auftrnr,E,0),.F.) // 26.08.2005 zu diesem Auftrag schon Angeh”rige? ::PvAUFTRNR := 4->P_AUFTRNR ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:=4->P_PERSKZ) ELSE // 26.08.2005 sollte auf LastRec+1 stehen, also leere Felder liefern! ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:="@") ENDIF ::XbpObjekt(::singleZeile,"PvANREDE"):setData(::PvANREDE:=4->P_ANREDE) ::XbpObjekt(::singleZeile,"PvNAME"):setData(::PvNAME:=4->P_NAME) ::XbpObjekt(::singleZeile,"PvVORNAME"):setData(::PvVORNAME:=4->P_VORNAME) ::XbpObjekt(::singleZeile,"PvGEBNAME"):setData(::PvGEBNAME:=4->P_GEBNAME) ::XbpObjekt(::singleZeile,"PvSTRASSE"):setData(::PvSTRASSE:=4->P_STRASSE) ::XbpObjekt(::singleZeile,"PvPLZ_ORT"):setData(::PvPLZ_ORT:=4->P_PLZ_ORT) IF 4->(IsFieldVar("p_ortsteil")) .AND. ::XbpNummer(::singleZeile,"PvORTSTEIL") > 0 ::XbpObjekt(::singleZeile,"PvORTSTEIL"):setData(::PvORTSTEIL:=4->P_ORTSTEIL) ENDIF ::XbpObjekt(::singleZeile,"PvTELEFON"):setData(::PvTELEFON:=4->P_TELEFON) ::XbpObjekt(::singleZeile,"PvFAX"):setData(::PvFAX:=4->P_FAX) ::XbpObjekt(::singleZeile,"PvEMAIL"):setData(::PvEMAIL:=4->P_EMAIL) ::XbpObjekt(::singleZeile,"PvGEB_DAT"):setData(::PvGEB_DAT:=4->P_GEB_DAT) ::XbpObjekt(::singleZeile,"PvSTB_DAT"):setData(::PvSTB_DAT:=4->P_STB_DAT) ::XbpObjekt(::singleZeile,"PvVERW_BEZ"):setData(::PvVERW_BEZ:=4->P_VERW_BEZ) ::XbpObjekt(::singleZeile,"PvRECH_NR"):setData(::PvRECH_NR:=4->P_RECH_NR) ::XbpObjekt(::singleZeile,"PvRECHBETR"):setData(::PvRECHBETR:=4->P_RECHBETR) IF 4->(IsFieldVar("p_rech_el")) .AND. ::XbpNummer(::singleZeile,"PvRECH_EL") > 0 ::XbpObjekt(::singleZeile,"PvRECH_EL" ):setData(::PvRECH_EL :=4->P_RECH_EL ) ::XbpObjekt(::singleZeile,"PvRECH_FL" ):setData(::PvRECH_FL :=4->P_RECH_FL ) ENDIF ::XbpObjekt(::singleZeile,"PvRECH_DAT"):setData(::PvRECH_DAT:=4->P_RECH_DAT) ::XbpObjekt(::singleZeile,"PvEINGBETR"):setData(::PvEINGBETR:=4->P_EINGBETR) ::XbpObjekt(::singleZeile,"PvEING_DAT"):setData(::PvEING_DAT:=4->P_EING_DAT) ::XbpObjekt(::singleZeile,"PvSALDO"):setData(::PvSALDO:=4->P_SALDO) IF 4->(IsFieldVar("p_gkz")) .AND. ::XbpNummer(::singleZeile,"PvGKZ") > 0 ::XbpObjekt(::singleZeile,"PvGKZ"):setData(::PvGKZ:=4->P_GKZ) ::XbpObjekt(::singleZeile,"PvMUST_RG"):setData(::PvMUST_RG:=4->P_MUST_RG) ENDIF // ::XbpObjekt(::multiZeile,"PvBILD"):setData() ::XbpObjekt(::multiZeile,"PvNOTIZ"):setData(::PvNOTIZ:=4->P_NOTIZ) nRec4 := 4->(RecNo()) // der jetzige Satz in Area4 ... 1->(Satzsp(oCB)) // ... geht hier verloren ... 4->(DbGoto(nRec4)) // ... und wird hier wieder angepeilt 1->perskz := ::PvPERSKZ 1->(DbRUnlock()) ELSEIF Upper(cLS) = "S" .AND. !Empty(1->auftrnr) IF 1->auftrnr == 4->P_AUFTRNR // 4->SatzZeiger nicht ver„ndern!! // ::PvPERSKZ := IIf( ::PvPERSKZ$" @", "A", ::PvPERSKZ ) // wofr denn jetzt noch?? 22.08.2005 4->(Satzsp(oCB)) // weil getData auf Pv... wirkt, nicht auf P_... 4->P_AUFTRNR := 1->auftrnr // ist doch schon, oder?? 4->P_PERSKZ := ::XbpObjekt(::singleZeile,"PvPERSKZ"):getData() 4->P_ANREDE := ::XbpObjekt(::singleZeile,"PvANREDE"):getData() 4->P_NAME := ::XbpObjekt(::singleZeile,"PvNAME"):getData() 4->P_VORNAME := ::XbpObjekt(::singleZeile,"PvVORNAME"):getData() 4->P_GEBNAME := ::XbpObjekt(::singleZeile,"PvGEBNAME"):getData() 4->P_STRASSE := ::XbpObjekt(::singleZeile,"PvSTRASSE"):getData() 4->P_PLZ_ORT := ::XbpObjekt(::singleZeile,"PvPLZ_ORT"):getData() IF 4->(IsFieldVar("p_ortsteil")) .AND. ::XbpNummer(::singleZeile,"PvORTSTEIL") > 0 4->P_ORTSTEIL := ::XbpObjekt(::singleZeile,"PvORTSTEIL"):getData() ENDIF 4->P_TELEFON := ::XbpObjekt(::singleZeile,"PvTELEFON"):getData() 4->P_FAX := ::XbpObjekt(::singleZeile,"PvFAX"):getData() 4->P_EMAIL := ::XbpObjekt(::singleZeile,"PvEMAIL"):getData() 4->P_GEB_DAT := ::XbpObjekt(::singleZeile,"PvGEB_DAT"):getData() 4->P_STB_DAT := ::XbpObjekt(::singleZeile,"PvSTB_DAT"):getData() 4->P_VERW_BEZ:= ::XbpObjekt(::singleZeile,"PvVERW_BEZ"):getData() 4->P_RECH_NR := ::XbpObjekt(::singleZeile,"PvRECH_NR"):getData() 4->P_RECHBETR:= ::XbpObjekt(::singleZeile,"PvRECHBETR"):getData() IF 4->(IsFieldVar("p_rech_el")) .AND. ::XbpNummer(::singleZeile,"PvRECH_EL") > 0 4->P_RECH_EL := ::XbpObjekt(::singleZeile,"PvRECH_EL" ):getData() 4->P_RECH_FL := ::XbpObjekt(::singleZeile,"PvRECH_FL" ):getData() ENDIF 4->P_RECH_DAT:= ::XbpObjekt(::singleZeile,"PvRECH_DAT"):getData() 4->P_EINGBETR:= ::XbpObjekt(::singleZeile,"PvEINGBETR"):getData() 4->P_EING_DAT:= ::XbpObjekt(::singleZeile,"PvEING_DAT"):getData() 4->P_SALDO := ::XbpObjekt(::singleZeile,"PvSALDO"):getData() IF 4->(IsFieldVar("p_gkz")) .AND. ::XbpNummer(::singleZeile,"PvGKZ") > 0 4->P_GKZ := ::XbpObjekt(::singleZeile,"PvGKZ"):getData() 4->P_MUST_RG := ::XbpObjekt(::singleZeile,"PvMUST_RG"):getData() ENDIF // 4->P_BILD := ::XbpObjekt(::multiZeile,"PvBILD"):getData() 4->P_NOTIZ := ::XbpObjekt(::multiZeile,"PvNOTIZ"):getData() 4->(DbRUnlock()) nRec4 := 4->(RecNo()) // der jetzige Satz in Area4 ... // ohne SET RELATION 1->(Satzsp(oCB)) // ... geht hier verloren ... // wird das wohl 4->(DbGoto(nRec4)) // ... und wird hier wieder angepeilt // nicht gebraucht! 1->perskz := ::PvPERSKZ 1->(DbRUnlock()) ENDIF ELSEIF Upper(cLS) = "A" .AND. !Empty(1->auftrnr) 4->(DbGotop()) DO WHILE !4->(Eof()) // Asc(4->P_PERSKZ)>64 .AND. !Eof() cPersKZ := 4->P_PERSKZ // PersKZ des letzten Eintrags feststellen 4->(Dbskip()) ENDDO 4->(DbClearScope()) 4->(DbAppend()) 4->P_AUFTRNR := 1->auftrnr ::PvAUFTRNR := 4->P_AUFTRNR ::PvPERSKZ := Chr(Asc(cPersKZ)+1) ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ) ////// 4->(Satzsp(oCB)) // wird das denn nach Append gebraucht?? 4->P_PERSKZ := ::XbpObjekt(::singleZeile,"PvPERSKZ"):getData() 4->(DbRUnlock()) 4->(DbSetScope( SCOPE_BOTH, StrX(1->auftrnr,E,0) )) 4->(DbSeek( StrX(::PvAUFTRNR,E,0) + ::PvPERSKZ )) ENDIF SELECT (nOldArea) // DbResumeNotifications() // wird doch garnicht gebraucht!! RETURN self METHOD BestFF:PersVor() ::SwapPers("S") IF !4->(Eof()) 4->(DbSkip()) IF 4->(Eof()) 4->(DbSuspendNotifications()) 4->(DbSkip(-1) ) // Append-Situation vermeiden 4->(DbResumeNotifications()) 4->(DbGobottom()) // Notification ausl”sen ENDIF ENDIF ::SwapPers("L") RETURN self METHOD BestFF:PersRueck() ::SwapPers("S") IF !4->(Bof()) 4->(DbSkip(-1)) IF 4->(Bof()) 4->(DbSuspendNotifications()) 4->(DbSkip(1) ) // Append-Situation vermeiden 4->(DbResumeNotifications()) 4->(DbGoTop()) // Notification ausl”sen ENDIF ENDIF ::SwapPers("L") RETURN self METHOD BestFF:PersLoesch() LOCAL cArt IF Val(cRS) < 7 ConfirmBox( oCB, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Angeh”rigen " + ::PvPERSKZ + " komplett l”schen?"), ; "Angeh”rigen " + ::PvPERSKZ + " komplett l”schen?"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN self ELSEIF Upper(AppName())$"WERNERX.EXE" IF ::Codewort( oBEDA, "s_best", 800, 819, cDatver+"mwstdat", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; < "7" RETURN ENDIF ENDIF IF Asc(4->P_PERSKZ)>64 .AND. ; ConfirmBox( oCB, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Angeh”rigen " + ::PvPERSKZ + " komplett l”schen?"), ; "Angeh”rigen " + ::PvPERSKZ + " komplett l”schen?"), ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES SELECT 13 // erst Rechnung l”schen, solange ::PvPERSKZ noch existiert ! 30.05.2007 12:28 DbUseArea( , "FOXCDX", "PersRech" ) OrdListAdd( "PersRech" ) DbSeek(StrX(1->auftrnr,E,0)+::PvPERSKZ,.F.) DO WHILE 13->auftrnr == 1->auftrnr .AND. 13->rn == ::PvPERSKZ .AND. !Eof() // Artikel-Daten korrigieren: cArt := 13->zugr_z_st SELECT 6 FIND &cArt Satzsp( oCB ) REPLACE 6->bestand WITH 6->bestand+1 REPLACE 6->mgjahr WITH 6->mgjahr-1 IIf(6->(IsFieldVar("umsatz")), 6->umsatz := 6->umsatz - 13->betrag, ) IIf(6->(IsFieldVar("umsatzeu")), 6->umsatzeu := 6->umsatzeu - 13->betrageu, ) DbRUnlock( Recno() ) SELECT 13 // Satzdelete() DbSkip() ENDDO DbCloseArea() SELECT 1 4->(Satzsp(oCB)) 4->(DbDelete()) IF !4->(Bof()) 4->(DbSkip(-1)) ELSE 4->(DbSkip()) ENDIF ::SwapPers("L") ENDIF RETURN self METHOD BestFF:PersSuche( oXbp, nAnf, nEnd ) LOCAL nRec1 := 1->(RecNo()), nRec4 := 4->(RecNo()) PRIVATE cPFeld := Stuff(IIf(oXbp:cargo="Pv",oXbp:cargo,"PvAUFTRNR"),2,1,"_") nAnf := IIf(cPFeld=="P_AUFTRNR",nAnf+10,nAnf) nEnd := IIf(cPFeld=="P_AUFTRNR",nEnd+10,nEnd) DbSuspendNotifications() // 04.09.2005 , damit Ziel nicht bei 1->(DbSeek()) berschrieben wird !! SELECT 4 4->(DbSuspendNotifications()) 4->(DbClearScope()) 4->(OrdListClear()) // schlieát die Indexdatei FErase( cDatver+"Personen.cdx" ) // damit der Index nicht nur berschrieben wird OrdCreate( "PERSONEN", "ap", "StrX(P_AUFTRNR,E,0) + P_PERSKZ" ) IF ValType(&cPFeld) == "N" OrdCreate( "Personen", "x2", "StrX(&cPFeld)" ) ELSEIF ValType(&cPFeld) == "D" OrdCreate("Personen","x2","DtoS(&cPFeld)") ELSEIF cPFeld=="P_RECH_NR" // 9.1.2006 Rechnung ohne Buchstabe sortiert OrdCreate("Personen","x2","Substr(Upper(&cPFeld),2)") ELSE OrdCreate("Personen","x2","Upper(&cPFeld)") ENDIF IIf(cPFeld=="P_AUFTRNR",OrdSetFocus("ap"),OrdSetFocus("x2")) // x2 wird kontrollierender Index DbGoto(nRec4) // zum Suchstart wieder auf den Start-Satz der Area4 IF ::Such( oBEDA, ::cS_b, nAnf, nEnd, 4, nRec4, {10,30*nV}, {425*nH,175*nV}, {} ) // wenn .T. dann wurde mit ESC abgebrochen => zurck zum alten Datensatz ELSE nRec4 := 4->(RecNo()) // >>>>>>> der gesuchte/gefundene Satz in Area4 1->(DbSeek(StrX(4->P_AUFTRNR,E,0),.F.)) // danach ist 1->auftrnr == 4->auftrnr ENDIF FErase( cDatver+"Personen.cdx" ) // damit der Index nicht nur berschrieben wird OrdCreate( "PERSONEN", "ap", "StrX(P_AUFTRNR,E,0) + P_PERSKZ" ) OrdCreate( "PERSONEN", "x2", "P_NAME" ) 4->(OrdSetFocus("ap")) 4->(DbSetScope( SCOPE_BOTH, StrX(1->auftrnr,E,0) )) 4->(DbGoto(nRec4)) 4->(DbResumeNotifications()) ::SwapPers("L") SELECT 1 DbResumeNotifications() RETURN self // REM vom 26.12.2005: daran muss noch viel ge„ndert werden!: METHOD BestFF:CreateBestF // erzeugt eine Datenbergabe-Datei fr Word etc. LOCAL aStructB, aStructV, aStructP, aStructF LOCAL nOldArea := SELECT(), nRecB SELECT 1 nRecB := RecNo() aStructB := DbStruct() SELECT 2 aStructV := DbStruct() SELECT 4 aStructP := DbStruct() aStructF := AClone(aStructB) AEval( aStructV, {|x,i,c| c := "V"+x[1], x[1] := c } ) AEval( aStructV, {|x,i| AAdd( aStructF, x ) } ) AEval( aStructP, {|x,i| AAdd( aStructF, x ) } ) DbCreate( "bestF.dbf", aStructF ) DbUseArea( .T., "FOXCDX", "bestF.dbf", "bf",.F. ) // .F. == EXCLUSIVE !! DbImport( "best.dbf",,,,,nRecB,, "DBFNTX" ) ////// DbGotop() ////// DbImport( "vv.dbf",,{||best->auftrnr==vv->auftrnr},,,,, "DBFNTX" ) 2->(DbSeek(StrX(1->auftrnr),.F.)) DO WHILE 2->auftrnr == 1->auftrnr IF bf->(Eof()) DbImport( "best.dbf",,,,,nRecB,, "DBFNTX" ) ENDIF bf->Vauftrnr := 2->auftrnr bf->Vverskz := 2->verskz bf->Vname1 := 2->name1 bf->Vname2 := 2->name2 bf->Vstrasse := 2->strasse bf->Vplz_ort := 2->plz_ort bf->Veinschr := 2->einschr bf->Verf_datum:= 2->erf_datum bf->Vkennzab := 2->kennzab bf->Vbez_am := 2->bez_am bf->Vbez_wie := 2->bez_wie bf->Vpol_betra:= 2->pol_betrag bf->Vpol_betre:= 2->pol_betreu bf->Vbez_betra:= 2->bez_betrag bf->Vbez_betre:= 2->bez_betreu bf->Vueb1 := 2->ueb1 bf->Vueb2 := 2->ueb2 bf->Vueb3 := 2->ueb3 bf->Vueb4 := 2->ueb4 bf->Vueb5 := 2->ueb5 bf->Vabrname := 2->abrname bf->Vgruppe := 2->gruppe bf->Vbb := 2->bb bf->Vanl1 := 2->anl1 bf->Vanl2 := 2->anl2 bf->Vanl3 := 2->anl3 bf->Vanl4 := 2->anl4 bf->Vanl5 := 2->anl5 bf->Vausw1 := 2->ausw1 bf->Vausw2 := 2->ausw2 bf->Vddd := 2->ddd bf->Vzan_bankv:= 2->zan_bankv bf->Vzan_ktoi := 2->zan_ktoi bf->Vzan_blz := 2->zan_blz bf->Vzan_kto := 2->zan_kto bf->Vausw3 := 2->ausw3 bf->Vausw4 := 2->ausw4 bf->Vausw5 := 2->ausw5 2->(DbSkip()) bf->(DbSkip()) ENDDO DbGotop() ////// DbImport( "personen.dbf",,{||best->auftrnr==vv->auftrnr},,,,, "FOXCDX" ) 4->(DbSeek(StrX(1->auftrnr),.F.)) DO WHILE 4->P_auftrnr == 1->auftrnr IF bf->(Eof()) DbImport( "best.dbf",,,,,nRecB,, "DBFNTX" ) ENDIF bf->P_AUFTRNR := 4->P_AUFTRNR bf->P_PERSKZ := 4->P_PERSKZ bf->P_ANREDE := 4->P_ANREDE bf->P_NAME := 4->P_NAME bf->P_VORNAME := 4->P_VORNAME bf->P_GEBNAME := 4->P_GEBNAME bf->P_STRASSE := 4->P_STRASSE bf->P_PLZ_ORT := 4->P_PLZ_ORT bf->P_ORTSTEIL:= 4->P_ORTSTEIL bf->P_TELEFON := 4->P_TELEFON bf->P_FAX := 4->P_FAX bf->P_EMAIL := 4->P_EMAIL bf->P_GEB_DAT := 4->P_GEB_DAT bf->P_STB_DAT := 4->P_STB_DAT bf->P_VERW_BEZ:= 4->P_VERW_BEZ bf->P_RECH_NR := 4->P_RECH_NR bf->P_RECHBETR:= 4->P_RECHBETR bf->P_RECH_DAT:= 4->P_RECH_DAT bf->P_EINGBETR:= 4->P_EINGBETR bf->P_EING_DAT:= 4->P_EING_DAT bf->P_SALDO := 4->P_SALDO 4->(DbSkip()) bf->(DbSkip()) ENDDO DbCloseArea() SELECT (nOldArea) RETURN self //////// o ist das TabPage-Objekt //////// aTab ist ein Array mit den relativen ::BEArea-Positionen //////// ATail(aTab) (=aTab[3]) ist immer 0 (=Position von ::thisTab) //////METHOD BestFF:TabMax(o,aTab) // berl„dt DialogFF:TabMax // XXXXXruft es dann auf ////// LOCAL n := AScan(oBest:BEArea,o) ////// IF ::thisTab:cargo!=NIL .AND. "Angeh"$::thisTab:cargo //29.04.2007 15:26 speichert Angeh”rigen, wenn umgeschaltet wird ////// ::SwapPers("S") ////// ENDIF ////// AEval(aTab, {|x,i| ::BEArea[n+x]:minimize()}, 1, Len(aTab)-1 ) ////// ::thisTab := ::BEArea[n+ATail(aTab)] ////// ::thisTab:maximize() ////// IF Len(aTab) = 3 //.AND. "NOLTE"$Upper(AppName()) // die 3 TabPages in der Mitte ////// DO CASE ////// CASE aTab[1]+aTab[2]+aTab[3] > 0 ////// ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } ////// CASE aTab[1]+aTab[2]+aTab[3] = 0 ////// ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; ////// IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2 } ////// CASE aTab[1]+aTab[2]+aTab[3] < 0 ////// ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ////// ENDCASE ////// ENDIF ////// IF Len(aTab) = 6 .AND. Upper(AppName())$"WERNERX.EXE" // die 6 TabPages rechts ////// DO CASE ////// CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 6 ////// ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } ////// CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 30 ////// ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; ////// IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2, 1->eh_telp } ////// CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 18 .AND. (::oFocLFSle:cargo="VA" .OR. ::aBP[7]==4) ////// ::aBP := { 1->va_anr, 1->va_vname, 1->va_name, 1->va_str, 1->va_ort, "Vater", 4, ; ////// IIf(IsFieldVar("va_telp"),1->va_telp,"") } ////// CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 18 .AND. (::oFocLFSle:cargo="MU" .OR. ::aBP[7]==5) ////// ::aBP := { 1->mu_anr, 1->mu_vname, 1->mu_name, 1->mu_str, 1->mu_ort, "Mutter", 5, ; ////// IIf(IsFieldVar("mu_telp"),1->mu_telp,"") } ////// CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = -6 ////// ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3, ::PvTELEFON } ////// OTHERWISE ////// ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } ////// ENDCASE ////// ENDIF //////RETURN self ////////RETURN DialogFF():TabMax(o,aTab) // o ist das TabPage-Objekt // aTab ist ein Array mit den relativen ::BEArea-Positionen // ATail(aTab) (=aTab[3]) ist immer 0 (=Position von ::thisTab) METHOD BestFF:TabMax(o,aTab) // berl„dt DialogFF:TabMax // XXXXXruft es dann auf LOCAL n := AScan(oBest:BEArea,o) AEval(aTab, {|x,i| ::BEArea[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::BEArea[n+ATail(aTab)] ::thisTab:maximize() IF Len(aTab) = 3 //.AND. "NOLTE"$Upper(AppName()) // die 3 TabPages in der Mitte DO CASE CASE aTab[1]+aTab[2]+aTab[3] > 0 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } CASE aTab[1]+aTab[2]+aTab[3] = 0 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2 } CASE aTab[1]+aTab[2]+aTab[3] < 0 ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ENDCASE ENDIF RETURN self //////// ::aBP[7] wird vorgesetzt durch Anklicken der gewnschten TabPage - oder durch nTab //////// ::aBP wird in der Hauptmaske als Briefanschrift verwendet //////// ~ wird im Adress-Programm als Betreff/Ansprechpartner verwendet //////METHOD BestFF:TabDaten(cGkz,cBez,nTab) // holt sich die Daten aus der oberen der 3 TabPages in der Mitte ////// LOCAL nRec ////// DEFAULT cBez TO "" ////// IIf( !Empty(nTab), ::aBP[7]:=nTab, ) ////// IF !Empty(cGkz) .AND. !Empty(cBez) // 13.11.2005 fr bl_quit ////// nRec := 5->(RecNo()) ////// 5->(DbSeek(cGkz,.F.)) ////// ::aBP := { 5->name1, 5->name2, "", 5->strasse, 5->plz_ort, cBez, 1 } ////// 5->(DbGoto(nRec)) ////// ELSE ////// DO CASE ////// CASE ::aBP[7] == 1 ////// ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } ////// CASE ::aBP[7] == 2 ////// ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; ////// IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2, 1->eh_telp } ////// CASE ::aBP[7] == 3 ////// ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3, ::PvTELEFON } ////// CASE ::aBP[7] == 4 // 28.05.2007 15:50 WernerX ////// ::aBP := { 1->va_anr, 1->va_vname, 1->va_name, 1->va_str, 1->va_ort, "Vater", 4, ; ////// IIf(IsFieldVar("va_telp"),1->va_telp,"") } ////// CASE ::aBP[7] == 5 // 28.05.2007 15:50 WernerX ////// ::aBP := { 1->mu_anr, 1->mu_vname, 1->mu_name, 1->mu_str, 1->mu_ort, "Mutter", 5, ; ////// IIf(IsFieldVar("mu_telp"),1->mu_telp,"") } ////// ENDCASE ////// ENDIF //////RETURN self // ::aBP[7] wird vorgesetzt durch Anklicken der gewnschten TabPage - oder durch nTab // ::aBP wird in der Hauptmaske als Briefanschrift verwendet // ~ wird im Adress-Programm als Betreff/Ansprechpartner verwendet METHOD BestFF:TabDaten(cGkz,cBez,nTab) // holt sich die Daten aus der oberen der 3 TabPages in der Mitte LOCAL nRec DEFAULT cBez TO "" IIf( !Empty(nTab), ::aBP[7]:=nTab, ) IF !Empty(cGkz) .AND. !Empty(cBez) // 13.11.2005 fr bl_quit nRec := 5->(RecNo()) 5->(DbSeek(cGkz,.F.)) ::aBP := { 5->name1, 5->name2, "", 5->strasse, 5->plz_ort, cBez, 1 } 5->(DbGoto(nRec)) ELSE DO CASE CASE ::aBP[7] == 1 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } CASE ::aBP[7] == 2 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2 } CASE ::aBP[7] == 3 ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ENDCASE ENDIF RETURN self METHOD BestFF:FriedEF() // 06.12.2005: MuellX-Spezialit„t IF oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ) .AND. ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):vorigerwert != ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):value 1->(Satzsp(oCB)) IF 1->best_art = "E" ::XbpObjekt( ::singleZeile, "&"+"TO2" ):setData( 1->&TO2 := ::Beis_Fried ) ELSEIF SubStr(1->best_art,1,2) $ "FAF SAS UAU Fe Se" IF 1->best_art[2] = "A" ::XbpObjekt( ::singleZeile, "&"+"TO4" ):setData( 1->&TO4 := Trim(PadR( "anonym " + ::Beis_Fried, 28 )) ) ELSE ::XbpObjekt( ::singleZeile, "&"+"TO4" ):setData( 1->&TO4 := Trim(::Beis_Fried) ) ENDIF ENDIF 1->(DbRUnlock()) ELSE //IF oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"TO2" ) .OR. ; // oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"TO4" ) //////// Test fr MuellX: Beis_Fried als MemberVar -> verteilt auf ortgrab/urnewo, je nach best_art // IF IsFieldVar("&TO4") .AND. FRIED == "Beis_Fried" IF 1->best_art="E" //.AND. !Empty(1->&TO2) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried:=1->&TO2) ELSEIF SubStr(1->best_art,1,2) $ "FAF SAS UAU Fe Se" //.AND. !Empty(1->&TO4) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried := ; IIf(1->&TO4="anonym",PadR(SubStr(1->&TO4,8),30),1->&TO4)) ELSEIF Empty(1->best_art) .OR. (Empty(1->&TO4) .AND. Empty(1->&TO2)) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried := Space(30)) ENDIF ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):vorigerwert := ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):value // ENDIF ENDIF RETURN self METHOD BestFF:FormularNotiz(cBL_Datei) // notiert, wenn ein Formular gedruckt wurde LOCAL nA, nOldArea := SELECT() IF cBL_Datei == Upper(cBL_Datei) DbUseArea(.T.,,"bl_dir") nA := SELECT() IF DbLocate( {|| PadR(cBL_Datei,8) == Upper((nA)->name)} ) 1->(Satzsp(oCB)) 1->notiz += CRLF+DtoC(DATE())+": "+Trim((nA)->beschreib)+ ; IIf(cBL_Datei$"BL_FIRM-BL_RENT-BL_ORD-BL_HELL-BL_KAF1-BL_FRKI-BL_ALBR", ; " an "+Trim(5->name1)+" gedruckt.", ; IIf(cBL_Datei$"BL_CHEC".AND.Upper(AppName())$"WERNERX.EXE", ; " fr "+aAdrKl[2]+"/"+aAdrKl[3]+"/"+aAdrKL[4]+" gedruckt."," gedruckt.")) IF "POSTRENT"$Upper((nA)->beschreib) 1->notiz += CRLF+"Nr.:"+cPR1+", "+cPR2+IIf(IsMemVar("cPR4"),CRLF+cPR3+", "+cPR4,", "+cPR3) //21.04.2008 20:48 cPR4 ENDIF 1->(DbRUnlock()) ENDIF DbCloseArea() SELECT (nOldArea) ::multizeile[1]:setData( 1->notiz ) ENDIF RETURN self