//bestp8.prg/////////////////////////////////////////////////////////////////// // 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" #include "Thread.ch" //xbeP_User = 134217728 #define xbeU_RefreshHist xbeP_User + 1 #define xbeU_RefreshSuch xbeP_User + 2 #define xbeU_RefreshAnlief xbeP_User + 3 #define xbeU_RefreshScan xbeP_User + 4 #define xbeU_ShowHistDaten xbeP_User + 5 #define xbeU_ShowScan xbeP_User + 6 #define xbeU_RefreshPLZ xbeP_User + 7 /* siehe: #define xbeP_User 134217728 */ PROCEDURE FTest(cTest,aOld,aNew) LOCAL Dummy := sleep(10) /* oDlg:resize := {| aOldSize, aNewSize, self | IIf( (Abs(aOldSize[1]-aNewSize[1])>10 .OR. ; Abs(aOldSize[2]-aNewSize[2])>10), ; IIf( self:getFrameState()==2, ; // 2=maximized {nFrame := 3, ; // self:getFrameState(), ; nH := nHur, ; nV := nVur, ; cV:= cVur, ; Ftest({"==2",aOldSize,aNewsize}) }, ; {nH := aNewSize[1]/800, ; // Differenz zum Verh. der DAs vernachl„ssigbar nV := (aNewSize[2]-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder)/; (600-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder-30), ; // Verh„ltnis der DrawingAreas cTip := aNewSize, ; // zum debuggen! aNewsize == oDlg:currentsize() nFrame := 3, ; // 3=normal cV := cVur, ; PostAppEvent( 1048632 ), ; Ftest({"!=2",aOldSize,aNewsize}) } ), ; Ftest({"klŽ",aOldSize,aNewsize})) } //06.04.2008 19:15 */ RETURN PROCEDURE bestp( cTitel, cS_b ) LOCAL nEvent, mp1, mp2, aFelder := {}, ID_SLE_PRIMKEY := 1 LOCAL oDlg, oXbp, oHelp, oSignal /*24.06.2008 22:11*/ LOCAL drawingArea, aEditControls := {} //, aCrtSize := SetAppWindow():currentsize() // 07.04.2008 18:58 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_COMPOUNDNAME, FONT_DEFFIXED_SMALL} , ; //22.03.2008 22:27 { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } // 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 cVerst0 := cVerst1 := cVerst2 := cVerst3 := Trim(" ") LOCAL oBestMenu := SetAppFocus() LOCAL aPos := {5*nH,30*nV} , aSize := {790*nH,570*nV} , y := 0 // 06.04.2008 10:24 LOCAL nFa := 0, cNr := Space(E) PRIVATE cV := " ", cVur := "11" //IIf(cS_b=="s_best","11","12") //12.04.2008 16:43 PRIVATE 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, 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 PRIVATE PS1, PS2, ANAM //29.03.2008 12:14 die variablen Texte in ~VVo, z.B. Versicherungsnummern PRIVATE nA //*11.07.2008 10:50 damit es einmal deklariert ist... DEFAULT cS_b TO "s_scrap" cProgTyp := "n" // 14.09.2005 fr alle F„lle PUBLIC aBC := {150,150,250} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCR := {250,150,150} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCY := {250,250, 50} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCG := {150,250,150} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCB := {150,150,250} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che ErrorBlock( {|e| FehlerBehandlung(e) } ) // e = Error-Objekt //in SCRAPX nur einen Zugangspunkt?:///////////////////////////////////////////////////////////////// // aZugang-Felder (fest gesetzt in AppName.prg): // 1: Bestattungsf„lle bearbeiten // 2: Versicherungsanschreiben // 3: Rechnung // 4: 0...9: 10 Nummernkreise als Unter-Array // 5: Adressverwaltung // 6: Artikelverwaltung // 7: Kontrollbersicht // 8: Formularverwaltung // 9: Terminverwaltung // 10: Kasse // 11: // 12: // 13: Trauerdruck IF Val(cRS) < aZugang[1] ConfirmBox( oDlg1, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Schrott-Annahme bearbeiten"), ; "Schrott-Annahme bearbeiten"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN ENDIF /////////////////////////////////////////////////////////////////////////////////// DO WHILE cV == " " // cV!=" " zum Umschalten der Filiale/des Mandanten // 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" .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() /* 08.04.2008 09:57 flexible/variable Gr”áe der Hauptmaske: */ IF cSerieBM != "F" aPos := {0 ,30 } //06.04.2008 19:20 aSize := {800*nH,520*nV+50} //06.04.2008 19:20 27.04.2008 22:28 ELSE aPos := IIf(nBestS1!=0,{Max(nBestP1,0*nH),Max(nBestP2,20*nV)},{0,30}) //12.04.2008 17:24 aSize := IIf(nBestS1!=0,{Min(nBestS1,AppDeskTop():currentsize()[1]), ; Min(nBestS2,(AppDeskTop():currentsize()[2]-30))}, ; {800*nH,520*nV+50}) //13.04.2008 18:52 nH := IIf(nBestS1!=0,aSize[1]/800,nH) //12.04.2008 18:20 nV := IIf(nBestS1!=0,(ASize[2]-50)/(600-80),nV) //12.04.2008 18:20 ENDIF /**/ oDlg := AKDialog():new( AppDesktop(), SetAppWindow(), aPos, ASize,aPP , .F.) oDlg:taskList := .T. oDlg:title := cTitel + " *" /*06.04.2008 20:38 erlaubt die Fenster-Gr”áe zu ver„ndern : */ oDlg:resize := {| aOldSize, aNewSize, self | IIf( (Abs(aOldSize[1]-aNewSize[1])>10 .OR. ; Abs(aOldSize[2]-aNewSize[2])>10), ; IIf( self:getFrameState()==2, ; // 2=maximized {nFrame := 3, ; // self:getFrameState(), ; nH := nHur, ; nV := nVur, ; cV:= cVur, ; PostAppEvent( 1048632 ) }, ; {nH := aNewSize[1]/800, ; // Differenz zum Verh. der DAs vernachl„ssigbar nV := (aNewSize[2]-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder)/; (600-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder-30), ; // Verh„ltnis der DrawingAreas cTip := aNewSize, ; // zum debuggen! aNewsize == oDlg:currentsize() nFrame := 3, ; // 3=normal cV := cVur, ; PostAppEvent( 1048632 ) } ), ; ) } //06.04.2008 19:15 /**/ /**/ oDlg:create() // oDlg:setFrameState(nFrame) //08.04.2008 11:49 muss noch verbessert werden (pulsiert...) 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 ) aThrdFenster[1] := oDlg nBz := IIf(cS_b = "s_bes2", 24*nV, 23*nV ) //13.04.2008 16:36 // jetzt folgt die Erzeugung der Eingabefelder oScrap := BestFF():new( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 299, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 /* jetzt ist oScrap:BEArea[1] == oBEDA , also ist oScrap:BEArea[1]:cargo == oDlg !! */ oBest := oScrap /* damit nicht alle oBest ver„ndert werden mssen */ oEdit := oBest // wegen DialogFF:create(IsMemberVar) 14.4.2005 oEdit:cS_b := cS_b //10.10.2006 22:27 zum Umschalten der 'Skins' /*25.06.2008 09:07 das Signal-Objekt zur Mitteilung an den Historie-Thread: */ //* oSignal := Signal():new() /**/ oScrap:CREATE( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 299, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 AEval( oScrap:editControls, {|x| oDlg:addEditControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:childFromName( 1->(FieldPos( "ANUMMER" )) ):disable() 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 ) /* * oBestMaske:aData1 := SatzGetBest() // fr die Ver„nderungsabfrage (sp„ter mal..) */ //------------------------------------------ // das Ende des Hauptprogramms: * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) oHelp:start() 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" /* sp„ter: */ // IF DUM3[1] == "{" .AND. nFa == 0 // 13.07.2007 20:44 damit Fallsuche-Tab ge”ffnet wird 24.03.2008 17:33:nFa // 1->(DbSeek("999999")) //03.08.2007 20:42 damit auf leeren Fall positioniert! (cAc) // oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,DUM2),&DUM3) // oBest:Letzte30(oBest:XbpObjekt(oBest:BEArea,DUM2),StrX( IIf("RNERX"$Upper(AppName()), ; // 100001,Val(cPubAuf)),E),"",{435,235}) //23.11.2007 18:18 // ENDIF DbSkip(0) // damit er ein Notify macht /* 24.06.2008 16:20 startet den Historien-Thread: => AnliefHistorie(oBEDA,aPos,aSize) */ //* oBest:oHistThrd:start( , oBest:BEArea[oBest:BENr], , , oSignal ) /**/ /* 25.06.2008 09:27 hier ist das Signal zum Starten des Historie-Threads */ //* oSignal:signal() /* 25.06.2008 18:24 und zum Warten, bis dieser fertig ist */ //* oSignal:WAIT() /* 09.07.2008 08:56 dann wird der Such-Thread gestartet: */ oBest:oSuchThrd := SuchThrd():new() oBest:oSuchThrd:start( , oBest:XbpObjekt(oBest:BEArea,"THREAD3-1"), RecNo(), oBest:XbpObjekt(,"name") ) // oBest:oSuchThrd:setInterval(10) /* (vielleicht nur, wenn keine Event-Loop ??) */ oDlg:invalidateRect() /**/ Sleep(100) /*??*/// nEvent := AppEvent( @mp1, @mp2, @oXbp ) // soll ein Event rausnehmen, damit Name positioniert... nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) 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 = xbeU_RefreshAnlief IF oBest:EditAnliefNr == 1->anummer i := ConfirmBox( oBEDA, " = Neueingaben gehen verloren!", ; IIf(SET(43)==0,ConvToAnsiCP("Anliefererdaten erst speichern?"), ; "Anliefererdaten erst speichern?"), ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON3 ) IF i == XBPMB_RET_YES oBest:Speichern() ELSEIF i == XBPMB_RET_NO oBest:Rueckgaengig() ELSE LOOP ENDIF ENDIF IF ValType(mp1) == "N" //* 1->(DbGoto( mp1 )) //* aus oSuch ELSEIF ValType(mp2) == "C" //* 13.07.2008 13:19 DbSeek(mp2,.F.) //* aus oHist ENDIF oDlg:readData() oBest:SatzLesen(0) /*29.06.2008 09:29 fr ::Rueckgaengig() */ oBest:SatzLesen(1) /*06.08.2008 22:59 fr ::HistSchreiben() */ LOOP ENDIF IF nEvent = xbeU_ShowHistDaten IF mp1 == 3 oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,"HistDaten"),{-1,+1,0}) ELSEIF mp1 == 1 oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,"AnlDaten"),{-1,-2,0}) ENDIF LOOP ENDIF IF nEvent = xbeU_ShowScan oBest:ShowScan(mp1) LOOP ENDIF IF nEvent == xbeP_Keyboard IF mp1 > xbeK_F1 .AND. mp1 < xbeK_F10 //01.07.2007 12:01 fr ::AdrSuch // wenn eine Funktionstaste gedrckt wird, dann wird PUBLIC cFktT mit deren Nr. belegt: cFktT := 1 + mp1 - xbeK_F1 ////// IF oXbp:cargo$"HEIM"+"&"+"STO1"+"&"+"STO2"+"&"+"STO3" //////// PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) ////// mp1 := xbeK_TAB ////// ENDIF ELSE cFktT := 0 ENDIF IF mp1 == xbeK_HOME .AND. IsMemberVar(oXbp,"value") .AND. oXbp:cargo="NAME" oBest:Wochentag() // beim Start Wochentage setzen 15.4.2005 ENDIF // Buchstaben-Tasten 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:EditAnliefNr == 1->anummer ; .AND. !oBest:EditAnliefNr > Replicate("9",E) // 30.07.2007 14:15 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Anliefererdaten eingeben/„ndern?"), ; "Anliefererdaten eingeben/„ndern?"), ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES oBest:EditAnliefNr := 1->anummer SELECT 1 //+25.03.2009 12:44 fr alle F„lle ! oBest:SatzLesen(0) /*29.06.2008 09:29 fr ::Rueckgaengig() */ mp1 := 0 //02.07.2006 11:47 oBest:killTip() //+ 13.08.2008 08:57 fr 'diese Nr ist noch frei' ELSE LOOP ENDIF ELSEIF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. oXbp:cargo != "cString" .AND. oBest:EditAnliefNr > Replicate("9",E) MsgBox("Dieser Auftrag wird bereits bearbeitet von "+1->benutzer+" !") LOOP ENDIF DO CASE CASE mp1 = xbeK_DOWN .AND. oXbp:isDerivedFrom( "XbpComboBox" ) PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) // - wie LOOP CASE mp1 = xbeK_UP .AND. oXbp:isDerivedFrom( "XbpComboBox" ) PostAppEvent( xbeP_Keyboard, xbeK_SH_TAB,, oXbp ) // - wie 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 := 1->anummer ////// 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_CTRL_F7 //04.09.2007 10:37 //14.09.2007 15:52 'gel”schte' Auftr„ge werden enabled: IF oBest:Codewort( oBEDA, "s_best", 840, 859, cDatver+"param", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; > "4" y := oBest:XbpNummer(oBest:singleZeile,"ADATUM") z := Len(oBest:singleZeile)-y // ::XbpNummer(::singleZeile,"PvSALDO") AEval( oBest:singleZeile, {|a,i| a:enable() }, y, z-y ) AEval( oBest:ListBox, {|a,i| a:enable() } ) IIf(ValType(oBest:XbpObjekt(oBest:multiZeile,"NOTIZ",.F.))="O", ; oBest:XbpObjekt(oBest:multiZeile,"NOTIZ",.F.):enable(),) //*14.07.2008 15:17 IIf(ValType(oBest:XbpObjekt(oBest:multiZeile,"notiz",.F.))="O", ; oBest:XbpObjekt(oBest:multiZeile,"notiz",.F.):enable(),) //*14.07.2008 15:18 IIf(lLogBook,oBest:TLog:write():writeLogFile(),) //16.09.2007 22:27 ENDIF CASE mp1 == xbeK_F4 //{oBest:aI1:={oBest:XbpObjekt(,"strasse"),oBest:XbpObjekt(,"plz_ort")},Plc(1->strasse,1->plz_ort)} //{oBest:aI1:={oBest:XbpObjekt(,"strasse"),oBest:XbpObjekt(,"plz_ort")},Plc(1->strasse,1->plz_ort)} IF oXbp:cargo$"strasse-ort-plz" oXbp:getData() ENDIF oBest:aI1:={oBest:XbpObjekt(,"strasse"),oBest:XbpObjekt(,"ort"),oBest:XbpObjekt(,"plz")} Plc(1->strasse,1->ort,1->plz) // DO CASE // CASE oXbp:cargo$"strasse" // oScrap:XbpObjektGet(,"strasse") // oScrap:XbpObjektSet(,"plz",oScrap:PLZ(1->strasse,1->ort)) // oScrap:XbpObjektGet(,"plz") // CASE oXbp:cargo$"ort" // oScrap:XbpObjektGet(,"ort") // oScrap:XbpObjektSet(,"plz",oScrap:PLZ(1->strasse,1->ort)) // oScrap:XbpObjektGet(,"plz") // CASE oXbp:cargo$"plz" // oScrap:XbpObjektGet(,"plz") // oScrap:XbpObjektSet(,"ort",oScrap:PLZ(1->strasse,1->ort,1->plz)) // oScrap:XbpObjektGet(,"ort") // ENDCASE LOOP // CASE mp1 == xbeK_F4 // DO CASE // CASE oXbp:cargo$"HEIM" // 5->(DbSetFilter({|| Trim(Upper(oXbp:value))=Upper(5->gruppe) } )) // 5->(DbGotop()) // PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) //// KVWAdressen("A",oBEDA, "HEIM","HEIM",,) //// 5->(DbClearFilter()) // ENDCASE CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1.dbf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_CTRL_F //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>0 IF "FETT" $ Upper(cBfont) nPL := At(" Fett",cBfont) cBfont := Stuff(cBfont,nPL,Len(" Fett"),"") // 5=len(" Fett") ELSE cBfont += " Fett" ENDIF IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF CASE mp1 == xbeK_CTRL_G //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>0 .AND. Val(cBfont)<25 nPL := At(".",cBfont)-1 IF 0 < nPL cBfont := Stuff(cBfont,1,nPL,Str(Val(cBfont)+1,2,0)) IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF ENDIF CASE mp1 == xbeK_CTRL_K //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>5 //.AND. Val(cBfont)<25 nPL := At(".",cBfont)-1 IF 0 < nPL cBfont := Stuff(cBfont,1,nPL,Str(Val(cBfont)-1,2,0)) IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF ENDIF CASE mp1 == xbeK_CTRL_S //24.03.2008 17:16 IF cBfont!=NIL .AND. Val(cBfont)>5 //.AND. Val(cBfont)<25 IF "Arial"$cBFont cBfont := Stuff(cBfont,At("Arial",cBfont),5,"Courier New") ELSEIF "Courier New"$cBfont cBfont := Stuff(cBfont,At("Courier New",cBfont),11,"Times New Roman") ELSEIF "Times New Roman"$cBfont cBfont := Stuff(cBfont,At("Times New Roman",cBfont),15,"Arial") ELSE cBfont := "10.Arial" ENDIF IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF 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. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +1 ) CASE mp1 == Asc("-") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -1 ) CASE mp1 == Asc("*") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +7 ) CASE mp1 == Asc("_") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -7 ) CASE mp1 == Asc("#") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, 0 ) ENDCASE ENDIF //+ PLZ/Ort wurde gesucht: in SLE einsetzen (steht in oBest:aI1, beim Aufrufen von PLC() gesetzt) IF nEvent == xbeU_RefreshPLZ IF mp1 != NIL Satzsp(oCB) oBest:aI1[1]:setData(mp1[1]) oBest:aI1[2]:setData(mp1[2]) oBest:aI1[3]:setData(mp1[3]) oBest:aI1[1]:getData() oBest:aI1[2]:getData() oBest:aI1[3]:getData() DbRUnlock() ENDIF oBest:oPLZThrd := NIL //+ fr alle F„lle SetAppFocus(oFocSle) ELSE oXbp:handleEvent( nEvent, mp1, mp2 ) ENDIF ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) BestGeaendert() cPubAuf := 1->anummer SELECT 20 DbUseArea( , "DBFNTX", "C:\HDBE\param" ) // in c:\hdbe Satzsp(oDlg) 20->pubauf := cPubAuf DbUseArea( , "DBFNTX", cDatver+"param" ) // im server Satzsp(oDlg) IF 20->(IsFieldVar("font0")) .AND. !Empty(cBfont) //23.03.2008 11:49 speichert zuletzt eingestellten BenutzerFont 20->&("font"+cBNr) := cBfont ENDIF IF oDlg:currentpos()[1]>= -10 .AND. 20->(IsFieldVar("bestP1_0")) //22.06.2008 10:55 weil sonst bei minimieren negativ (-32000) 20->&("bestP1_"+cBNr) := nBestP1 := oDlg:currentPos()[1] 20->&("bestP2_"+cBNr) := nBestP2 := oDlg:currentPos()[2] 20->&("bestS1_"+cBNr) := nBestS1 := oDlg:currentSize()[1] 20->&("bestS2_"+cBNr) := nBestS2 := oDlg:currentSize()[2] ENDIF DbCloseArea() //+ Area 20 aInfo := ThreadInfo( THREADINFO_TOBJ ) AEval( aInfo, {|a,i| IIf(i>1 .AND. ValType(a[1])=="O",a[1]:terminate(),) } ) AEval( aThrdFenster, {|a,i| PostAppEvent( 1048632,,, a ) } ) ///*25.06.2008 08:43 beendet den Historie-Thread */ // IF ValType(aThrdFenster[3]) == "O" // oBest:oHistThrd:terminate() // ENDIF ////* 09.07.2008 15:35 beendet den Such-Thread // IF ValType(aThrdFenster[2]) == "O" // oBest:oSuchThrd:terminate() // ENDIF ///**/ ////* 09.07.2008 15:35 beendet den Scan-Thread // IF ValType(aThrdFenster[4]) == "O" // oBest:oScanThrd:terminate() // ENDIF Sleep(10) SELECT 1 oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() oDlg:destroy() 1->(DbSkip(0)) IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF 1->benutzer == cBK Satzsp(oCB) 1->benutzer := " " DbRUnlock() ENDIF ENDIF 1->(DbRUnlock()) // oHelp:terminate() DbCloseAll() //+ 30.07.2008 10:36 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 param EXCLUSIVE cDatver := param->netver SET DEFAULT TO &cDatver param->datver := cDatver[1] + SubStr(param->datver,2) param->netver1 := cDatver[1] + SubStr(param->netver1,2) param->netver2 := cDatver[1] + SubStr(param->netver2,2) param->netver3 := cDatver[1] + SubStr(param->netver3,2) param->netver4 := cDatver[1] + SubStr(param->netver4,2) param->netver5 := cDatver[1] + SubStr(param->netver5,2) param->netver6 := cDatver[1] + SubStr(param->netver6,2) param->netver7 := cDatver[1] + SubStr(param->netver7,2) param->netver8 := cDatver[1] + SubStr(param->netver8,2) param->netver9 := cDatver[1] + SubStr(param->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 param EXCLUSIVE // „ndert die c:\hdbe\param auf das Stick-Laufwerk param->datver := cDrive + SubStr(param->datver,2) param->netver1 := cDrive + SubStr(param->netver1,2) param->netver2 := cDrive + SubStr(param->netver2,2) param->netver3 := cDrive + SubStr(param->netver3,2) param->netver4 := cDrive + SubStr(param->netver4,2) param->netver5 := cDrive + SubStr(param->netver5,2) param->netver6 := cDrive + SubStr(param->netver6,2) param->netver7 := cDrive + SubStr(param->netver7,2) param->netver8 := cDrive + SubStr(param->netver8,2) param->netver9 := cDrive + SubStr(param->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 param EXCLUSIVE // „ndert die c:\hdbe\param auf das Stick-Laufwerk param->datver := cDrive + SubStr(param->datver,2) param->netver1 := cDrive + SubStr(param->netver1,2) param->netver2 := cDrive + SubStr(param->netver2,2) param->netver3 := cDrive + SubStr(param->netver3,2) param->netver4 := cDrive + SubStr(param->netver4,2) param->netver5 := cDrive + SubStr(param->netver5,2) param->netver6 := cDrive + SubStr(param->netver6,2) param->netver7 := cDrive + SubStr(param->netver7,2) param->netver8 := cDrive + SubStr(param->netver8,2) param->netver9 := cDrive + SubStr(param->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("") DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) ENDCASE ELSE DO CASE CASE cV == "5" // @ 10,5 SAY "Daten werden kopiert..." // Daten_zum_Stick() DATEN_Backup() CASE cV == "6" // @ 10,5 SAY "Daten werden kopiert..." // Daten_vom_Stick() DATEN_Restore() // 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_scrap" CASE cV == "12" ////////////////////////////////////////////////// // cBNr=Benutzernummer (PUBLIC) (wird beim TT mitnotiert) cBNr := "0" // Benutzer "0"="Gast" und "1"..."9" // cRS=Rechtestufe (PUBLIC) steuert den Zugang zu Modulen /* von 0=keine bis 9=alle Rechte */ cRS := DisplayLogo(@cBNr,@cBK) //20.06.2007 12:00 ////////////////////////////////////////////////// IF "

"$Upper(cBNr) ineux("T") ENDIF cBNr := cBNr[1] cS_b := "s_scrap" ENDCASE DatVerUm(IIf(Upper(cDatver)=="C:\HDBE\",0,1)) //28.04.2008 09:55 ENDIF cV := " " DO WHILE nEvent <> xbe_None //+13.11.2008 09:39 nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO ENDIF ENDDO SetAppFocus( oBestMenu ) SET DATE TO GERMAN SET ORDER TO 1 /**/// SetAppWindow():configure(,,,25,80) // 07.04.2008 18:49 oCRT-Fenster wieder groá machen 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( oCB, ; 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 +CRLF+ ; "Benutzer: "+cBK+"/"+cRS +CRLF+ ; "Thread: " + LTrim(Str(ThreadId())) + "/"+ThreadObject():ClassName() USE BREAK() ENDIF ENDIF RETURN .F. //------------------------------------------ FUNCTION Fallsuche() RETURN .T. FUNCTION NeuerFall() RETURN .T. //------------------------------------------ //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: // VAR SWT // SterbeWochentag // VAR TW0 // Wochentag von Termin0 // VAR TW1 // Wochentag von Termin1 // VAR TW2 // // VAR TW3 // // VAR TW4 // VAR aBP // Betreffperson, je nach TAB: Ansprechpartner/Ehepartner/Angeh”riger VAR EditAnliefNr // =aktuelle Auftrnr, wenn editierbar VAR Fall_geloescht // wenn .T. wird Listbox-Letzte30 neu gefllt VAR cS_b // = "s_best" (bei Flues auch "s_bes2") VAR TLog // TransaktionenLogbuch-Objekt VAR oHistThrd /* das Thread-Objekt des Historien-Programms 24.06.2008 16:16 */ VAR oSuchThrd /* das Thread-Objekt des AnliefSuch-Programms 08.07.2008 10:53 */ VAR oScanThrd /* das Thread-Objekt des Bild-Darstellungs-Programms 09.07.2008 18:31 */ VAR oPLZThrd //+21.10.2008 22:19 METHOD INIT METHOD CREATE METHOD notify // managt z.B. ::PaintTip, ::WochenTag METHOD NeueNummer /* sucht eine freie Nummer zu einem vorgegebenen Nummernkreis */ METHOD FeldSuche //* Suche nach einem beliebigen Feld, in das man vorher geklickt hat METHOD Aendern /* l„sst den Datensatz „ndern durch z.B.:'EditAnliefNr:=1->anummer' 29.06.2008 08:32*/ METHOD Rueckgaengig /* macht die Žnderungen rckg„ngig: kopiert ::aData0 wieder in den Datensatz */ METHOD Speichern /* manifestiert die Žnderung und teilt sie anderen Threads mit */ METHOD PflichtFelder //* kontrolliert, ob vor dem Speichern die Pflichtfelder ausgefllt sind METHOD HistSchreiben //* schreibt Daten in Historie.dbf, wenn ver„ndert METHOD ShowScan //* zeigt die gescannten Objekte auf der mittleren TabPage METHOD ShowHist //* zeigt die Historie zu diesem Anlieferer auf der rechten TabPage METHOD ZumAnfang //* ersetzen die Funktionen aus bestf8.prg 12.07.2008 22:13 METHOD Zurueck //* METHOD Vorwaerts //* METHOD ZumEnde //* METHOD AnliefSuche /* Suche des Anliefers nach jedem beliebigen Feld */ METHOD AnliefLoeschen // markiert den Anlieferer als gel”scht in 1->notiz 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 NamenSuche // sucht nach cSuch:=1->name bei der Neueingabe (findet gleiche Namen) METHOD AdrSuch // sucht nach Adressen mit F4/F5/F6 (welcheF?) und fgt sie ein 01.07.2007 11:19 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\POST 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 AngDaten // holt abh„ngig von GKZ Daten von Angeh”rigen in ::aBP METHOD FriedEF // managed die Friedhofeingaben in ::Beis_Fried abh„ngig von E+F METHOD FormularNotiz // vermerkt Formularausdrucke im Notizfeld, wenn BL_UPPERCASE //*14.07.2008 08:29: //* sind ganz hinten als Functions: // METHOD DATEN_Backup // METHOD DATEN_Restore 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 := "" ::aStructure := 1->(DbStruct()) ::VArea := nA ::aIndex := { "Anlieferer-Nummer", "Anlieferer-Name", 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] ) } ) ::aData0 := Array(FCount()) // Array mit allen Feldinhalten, vor der Ver„nderung fr ::Rueckgaengig() AEval( ::aStructure, {|a,i,c| c:=a[1], ::aData0[i] := &c } ) ::aData1 := Array(FCount()) // Array mit allen Feldinhalten, vor der Ver„nderung AEval( ::aStructure, {|a,i,c| c:=a[1], ::aData1[i] := &c } ) ::aData2 := Array(FCount()) // Array mit allen Feldinhalten, nach der Ver„nderung ::EditAnliefNr := "" // beim Start ist noch kein Auftrag editierbar IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := cBK) DbRUnlock() ::EditAnliefNr := "" ELSEIF 1->benutzer != cBK ::EditAnliefNr := "1"+Replicate("0",E) ENDIF ENDIF ::Fall_geloescht := .F. // beim Start ist noch kein Auftrag gel”scht 26.06.2006 16:01 ::cS_b := "s_scrap" // s_best o.„. ::TLog := TLogWriter():new( "TLog.dbf" ) //16.09.2007 19:31 TXT-Datei zur Tarnung als .dbf /* Threadobjekt erzeugen zur Darstellung der Historie 24.06.2008 16:19 */ //* ::oHistThrd := HistThrd():new() /* Threadobjekt erzeugen zur Darstellung der Suche 08.07.2008 10:53 */ // ::oSuchThrd := SuchThrd():new() /**/ 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 /* Nummernkreis-abh„ngiger Zugang: */ IF Val(cRS) >= aZugang[4,Val(1->anummer[1])+1] /* wenn Rechte ausreichen... */ ASize( aZugang, 13 ) AAdd( aZugang, 1->(Recno()) ) /* ... wird Recno() in aZugang[14] gespeichert */ ENDIF /* damit ein Benutzer den Auftrag automatisch wieder entsperrt: */ IF 1->benutzer == cBK Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") DbRUnlock() ENDIF ENDIF /////////////////////////////////////////////////////////////////////////////////// // hier wurde frher die Historie geschrieben, // jetzt wird die Historie nur dann geschrieben, // -wenn geklickt wird // -wenn mit den Pfeiltasten gewandert wird (oder den entsprechenden ShortCuts) /////////////////////////////////////////////////////////////////////////////////// // wenn der Satzzeiger am Ziel ist: IF mp1 == DBO_MOVE_DONE .OR. mp1 == DBO_GOBOTTOM .OR. mp1 == DBO_GOTOP IF Val(cRS) < aZugang[4,Val(1->anummer[1])+1] // 28.11.2007 12:53 wg Nummernkreis-abh„ngigem Zugang 1->(DbGoto(aZugang[14])) ConfirmBox( oCB, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Nummernkreis "+1->anummer[1]), ; "Nummernkreis "+1->anummer[1]), ; XBPMB_OK, ; XBPMB_WARNING ) DbResumeNotifications() RETURN self ENDIF /*29.03.2008 18:00 Anlieferer und Anlieferernr. zum Weitergeben: */ oBEDA:cargo:setTitle( Stuff( oBEDA:cargo:title, At("*",oBEDA:cargo:title), 100, "* "+Trim(1->name)+", "+Trim(1->vorname)+" - "+1->anummer ) ) /**/ /**/ /* ein Benutzer den Auftrag automatisch fr sich sperrt: */ IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) /* wenn Auftrag frei ist */ Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := cBK) DbRUnlock() ::EditAnliefNr := "" ELSEIF 1->benutzer != cBK /* wenn Auftrag schon besetzt ist... */ ::EditAnliefNr := "1"+Replicate("0",E) /*...1000000 in die anummer*/ ENDIF ENDIF //14.09.2007 15:52 'gel”schte' Anlieferer werden disabled: y := ::XbpNummer(::singleZeile,"ADATUM") z := Len(::singleZeile)-y // ::XbpNummer(::singleZeile,"PvSALDO") IF "g e l ” s c h t"$1->notiz AEval( ::singleZeile, {|a,i| a:disable() }, y, z-y ) /*alle ab adatum disabled */ AEval( ::ListBox, {|a,i| a:disable() } ) /*alle disabled */ IIf(ValType(::XbpObjekt(::multiZeile,"NOTIZ",.F.))="O",::XbpObjekt(::multiZeile,"NOTIZ",.F.):disable(),) IIf(ValType(::XbpObjekt(::multiZeile,"notiz",.F.))="O",::XbpObjekt(::multiZeile,"notiz",.F.):disable(),) ELSE /* hier vielleicht noch eine Abfrage, ob ein Feld disabled ist, dann... */ AEval( ::singleZeile, {|a,i| a:enable() }, y, z-y ) AEval( ::ListBox, {|a,i| a:enable() } ) /*alle disabled */ IIf(ValType(::XbpObjekt(::multiZeile,"NOTIZ",.F.))="O",::XbpObjekt(::multiZeile,"NOTIZ",.F.):enable(),) IIf(ValType(::XbpObjekt(::multiZeile,"notiz",.F.))="O",::XbpObjekt(::multiZeile,"notiz",.F.):enable(),) ENDIF /* schaltet die Farben je nach Nummernkreis: ----- noch fr ScrapX umbauen!!!!! */ IF Upper(AppName())$"BUCKX.EXE-MENGX.EXE-MUELLX.EXE-SINZIGX.EXE-BLEINX.EXE-KUELLX.EXE-FLUESX.EXE-KOMPAKTX.EXE-BERGX.EXE-RAGUSEX.EXE"+cAc // 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 F1F2F3F4",11,IIf(SubStr(1->best_art,1,1)="S",12,13))) ELSE S := Val(1->anummer[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 ::SatzLesen(1) /* 28.06.2008 18:31 liest den aktuellen Datensatz in ::aData1 ein */ ENDIF ENDIF /* wird bei ScrapX nicht gebraucht: ::WochenTag() // 14.4.2005 zeigt fr TD1-4 den Wochentag an*/ DbResumeNotifications() RETURN self /* sucht eine neue Nummer zu einem vorgegebenen Nummernkreis */ METHOD BestFF:NeueNummer( cKreis ) LOCAL nRec := RecNo() LOCAL cItem := " " DEFAULT cKreis TO "X" IF !::Speichern() //+06.08.2008 23:02 RETURN "Erst den laufenden Fall abschlieáen!" ENDIF //+05.08.2008 22:21 erst einmal eine leere Nummer suchen (falls vorhanden): DbSuspendNotifications() OrdSetFocus(2) DbSeek(" ",.F.,"na") DO WHILE (anummer == "000000" .OR. anummer == "999999") .AND. !Eof() DbSkip() IF anummer != "000000" .AND. anummer != "999999" .AND. name[1] < "A" .AND. !Eof() OrdSetFocus(1) DbResumeNotifications() RETURN "Diese Nummer ist noch frei!" ENDIF ENDDO OrdSetFocus(1) IF cKreis == "X" /* egal welche Nummer? */ DbGobottom() /* dann gehe ans Ende */ cItem := StrX(Val(1->anummer)+1,6) /* nimm einfach 1 h”her als die h”chste Nummer */ ELSEIF cKreis == "0" .OR. Val(cKreis) > 0 OrdSetFocus(1) DbSeek( Str(Val(cKreis)+1,1)+"00000", .T., 1 ) /* Softseek findet ersten h”heren Wert */ DbSkip(-1) /* zurck in den richtige Nummernkreis */ IF 1->anummer[1] == cKreis /* ist es auch wirklich der richtige? */ cItem := StrX(Val(1->anummer)+1,6) /* dann z„hle eins hoch */ ELSE /* nein? : */ cItem := cKreis + "00001" /* dann baue die erste Nummer selber auf */ ENDIF DbGoto(nRec) ENDIF DbResumeNotifications() RETURN IIf( cItem[1]=cKreis, cItem, "Keine geeignete Nummer gefunden!" ) //* 08.07.2008 10:21 Suche nach einem beliebigen Feld , in das man vorher geklickt hat METHOD BestFF:FeldSuche(oFeld) DEFAULT oFeld TO oFocSle //+17.07.2008 17:24 fr alle F„lle Historie IF ::Speichern() DbCommit() ::EditAnliefNr := "" // macht wieder !editable ENDIF //* das Suchfeld steht in oFocSle, weil vorher dahin geklickt wurde IF Empty(::oSuchThrd) ::oSuchThrd := SuchThrd():new() ::oSuchThrd:start( , ::BEArea[::BENr-2], RecNo(), oFeld ) ::oSuchThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshSuch, RecNo(), oFeld, aThrdFenster[2] ) //* refresht die Suchtabelle ENDIF ::TabMax(::XbpObjekt(::TabSeite,"Suchen"),{+1,+2,0}) RETURN self /*29.06.2008 08:33 Auftrag auf 'darf ge„ndert werden' setzen: */ METHOD BestFF:Aendern(cNr) ::SatzLesen(0) /* fr ::Rueckgaengig() */ RETURN ::EditAnliefNr := cNr /*29.06.2008 08:33 Auftrag wieder auf Zustand vor der Žnderung setzen: */ METHOD BestFF:Rueckgaengig() ::SatzLesen(2) /*28.06.2008 18:30 liest den aktuellen Datensatz in ::aData2 ein */ IF !ACompare( ::aData1, ::aData2, FieldPos("benutzer") ) .AND. ; 1->anummer > "000000" .AND. 1->anummer < "999999" /*? 999999 ?*/ /* wenn der Datensatz ver„ndert wurde */ IF ConfirmBox( oCB, " berschreibt mit vorigen Werten" + CRLF + ; " Daten beibehalten und weiter eingeben", ; IIf(SET(43)==0,ConvToAnsiCP("Eingaben zu diesem Anlieferer rckg„ngig machen?"), ; "Eingaben zu diesem Anlieferer rckg„ngig machen?"), ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES ::SatzSchreiben(0) /* schreibt ::aData0 in die Datei */ ::oOwner:readData() /* damit es wieder dargestellt wird */ ENDIF ELSE //+17.07.2008 17:18 soll hier gesagt werden, dass nichts rckg„ngig zu machen ist?? ENDIF RETURN ::EditAnliefNr := "" /* macht wieder !editable */ /*29.06.2008 08:33 Auftrag wird mit oHistThrd abgeglichen und wieder als !editable' markiert: */ METHOD BestFF:Speichern() LOCAL lGespeichert := .F. IF ::PflichtFelder() DbCommit() /* l”st Notification aus, der Rest passiert in ::notify() */ ::SatzLesen(0) /* macht ::Rueckgaengig unm”glich */ ::EditAnliefNr := "" // macht wieder !editable PostAppEvent( xbeU_RefreshSuch, RecNo(),, aThrdFenster[2] ) //* refresht die Suchtabelle lGespeichert := .T. ::HistSchreiben() ELSE MsgBox( "* Pflichtfelder mssen ausgefllt werden!", "Angaben unvollst„ndig!" ) ENDIF RETURN lGespeichert METHOD BestFF:PflichtFelder() LOCAL lPflichtOK := .T. // IIf( (::VArea)->name[1] != " " .AND. (::VArea)->strasse[1] != " " .AND. ; // (::VArea)->plz[1] != " " .AND. (::VArea)->ort[1] != " " .AND. ; // (::VArea)->ausw_art[1] != " ", .T., .F. ) IF !1->anummer$"000000 999999" .AND. !"g e l ” s c h t"$1->notiz FOR i := 1 TO Len(::aBeschreib) IF "*"$::aBeschreib[i] c := FieldGet(i) DO CASE CASE ValType(c) == "C" lPflichtOk := (Len(Trim(c)) != 0) CASE ValType(c) == "N" lPflichtOK := (c != 0) CASE ValType(c) == "D" lPflichtOK := (DtoC(c)!=" ") ENDCASE IF !lPflichtOK EXIT ENDIF ENDIF NEXT ENDIF RETURN lPflichtOK //*12.07.2008 21:39 Datensatz von Anlief.dbf in die Historie.dbf schreiben, wenn er ge„ndert wurde: METHOD BestFF:HistSchreiben() LOCAL n /* 25.06.2008 19:16 ist der Datensatz ver„ndert worden? -> Historie updaten */ ::SatzLesen(2) /*28.06.2008 18:30 liest den aktuellen Datensatz in ::aData2 ein */ //* ACompare() nimmt beim Vergleich den Benutzer aus: IF !ACompare( ::aData1, ::aData2, FieldPos("benutzer") ) .AND. ; 1->anummer > "000000" .AND. 1->anummer < "999999" /*? 999999 ?*/ /* wenn der Datensatz ver„ndert wurde */ DbSelectArea( 2 ) 2->(DbSuspendNotifications()) 2->(DbSeek( ::aData2[1], .F., "an" )) IF 2->(Eof()) 2->(DbAppend()) FOR n := 1 to Len(::aData2) FieldPut( n, ::aData2[n] ) /* neu anlegen */ NEXT 2->hdatum := DATE() 2->huhrzeit := Time() 2->typ := "NEU" 2->betr_fldr := "Neuanlage dieses Anlieferers am " + DtoC(DATE()) + " ." /* wenn noch gar keiner da war */ ELSE /* hier msste wohl noch abgefangen werden, wenn innerhalb eines Tages bzw. einer Sitzung durch Unterbrechungen mehrere 'Žnderungen' protokolliert werden */ DO WHILE DATE() > 2->hdatum .AND. !2->(Eof()) 2->(DbSkip()) ENDDO IF DATE() == 2->hdatum .AND. 1->anummer == 2->anummer //* wenn derselbe Anlieferer und derselbe Tag, dann berschreiben, //+ aber nur, wenn es sich um eine Žnderung handelt (nicht am Neuanlagetag) IF 2->typ == "NEU" //+ wenn NEU, dann keine Einzel„nderungen protokollieren ::SatzLesen(1) /*06.08.2008 22:31 liest den aktuellen Datensatz in ::aData1 ein, damit es hier wieder beginnt */ RETURN self ENDIF 2->(Satzsp(oBEDA)) ELSE //* sonst neuen Historie-Satz anlegen: 2->(DbAppend()) ENDIF FOR n := 1 to Len(::aData2) FieldPut( n, ::aData2[n] ) /* berschreiben / neu anlegen */ NEXT 2->hdatum := DATE() 2->huhrzeit := Time() 2->typ := "Žnderung" 2->betr_fldr += IIf( Len(Trim(2->betr_fldr))>2 .AND. ; Right(Trim(2->betr_fldr),2) != Chr(13)+Chr(10), CRLF, "" ) + ; "Žnderung der Anlieferer-Daten am " + DtoC(DATE()) + " durch " + cBK +":" 2->bearbeiter := cBK FOR n := 1 TO Len(::aData1) /* Žnderungen protokollieren: */ IF ::aData1[n] != ::aData2[n] .AND. n != 1->(FieldPos("benutzer")) IF ValType( ::aData1[n] ) == "C" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + Trim(::aData1[n]) + " zu " + Trim(::aData2[n]) ELSEIF ValType( ::aData1[n] ) == "N" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + Str(::aData1[n]) + " zu " + Str(::aData2[n]) ELSEIF ValType( ::aData1[n] ) == "D" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + DtoC(::aData1[n]) + " zu " + DtoC(::aData2[n]) ELSE 2->betr_fldr += CRLF + "Notizen erg„nzt" ENDIF ENDIF NEXT //* erst am Ende noch ein CRLF, wenn da noch keines steht. IF Right(Trim(2->betr_fldr),2) != Chr(13)+Chr(10) 2->betr_fldr += CRLF ENDIF ENDIF 2->(DbRUnlock()) 2->(DbResumeNotifications()) IF ValType(oHist) == "O" .AND. 1->anummer < "999999" /* Meldung an Historie: Es gibt was Neues: */ PostAppEvent( xbeU_RefreshHist, 1->anummer, RecNo(), aThrdFenster[3] ) ENDIF DbSelectArea( 1 ) ENDIF /**/ ::SatzLesen(1) /*06.08.2008 22:31 liest den aktuellen Datensatz in ::aData1 ein, damit es hier wieder beginnt */ RETURN self METHOD BestFF:ShowScan(cDateiName) IF ::Speichern() IF Empty(::oScanThrd) ::oScanThrd := ScanThrd():new() ::oScanThrd:start( , ::XbpObjekt(::BEArea,"THREAD5-1"), RecNo(), cDateiName ) ::oScanThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshScan, RecNo(), cDateiName, aThrdFenster[4] ) //* refresht die Suchtabelle ENDIF ::TabMax(::XbpObjekt(::TabSeite,"Vorschau"),{-1,+1,0}) ENDIF RETURN self METHOD BestFF:ShowHist() IF ::Speichern() IF Empty(::oHistThrd) ::oHistThrd := HistThrd():new() ::oHistThrd:start( , ::XbpObjekt(::BEArea,"THREAD4-1"), 1->anummer, RecNo(), ::XbpObjekt(::BEArea,"THREAD3-2") ) ::oHistThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshHist, 1->anummer, RecNo(), aThrdFenster[3] ) //* refresht die Suchtabelle ENDIF ::TabMax(::XbpObjekt(::TabSeite,"Historie"),{-1,-2,0}) ENDIF RETURN self METHOD BestFF:ZumAnfang( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoTop()) // ELSE // MsgBox("* Pflichtfelder mssen ausgefllt werden!","Angaben unvollst„ndig!") ENDIF ELSE (nA)->(DbGoTop()) (nA)->(DbSkip(0) ) ENDIF RETURN .T. METHOD BestFF:Zurueck( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) IF ! (nA)->(Bof()) (nA)->(DbSkip(-1)) IF (nA)->(Bof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(1)) (nA)->(DbGoTop()) (nA)->(DbResetNotifications()) ENDIF ENDIF // ELSE // MsgBox("* Pflichtfelder mssen ausgefllt werden!","Angaben unvollst„ndig!") ENDIF ELSE (nA)->(DbSkip(-1) ) ENDIF RETURN .T. METHOD BestFF:Vorwaerts( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) IF ! (nA)->(Eof()) (nA)->(DbSkip(1)) IF (nA)->(Eof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(-1)) (nA)->(DbGobottom()) (nA)->(DbResetNotifications()) ENDIF ENDIF // ELSE // MsgBox("* Pflichtfelder mssen ausgefllt werden!","Angaben unvollst„ndig!") ENDIF ELSE (nA)->(DbSkip(1) ) ENDIF RETURN .T. METHOD BestFF:ZumEnde( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoBottom()) // ELSE // MsgBox("* Pflichtfelder mssen ausgefllt werden!","Angaben unvollst„ndig!") ENDIF ELSE (nA)->(DbGoBottom()) // (nA)->(DbSkip(0) ) ENDIF RETURN .T. //* 12.07.2008 23:04 wird bereits anders gemacht: (oSuchThrd) /* der gesuchte Text wird in die Variable 1->such_ein eingegeben: */ METHOD BestFF:AnliefSuche( cSuchArt ) //, cKreis ) LOCAL cSuch := cAuf := "" // IIf(Empty(cKreis),Space(E),cKreis) LOCAL cString := IIf(Empty(cSuchArt),"cStringS","cStringF") LOCAL oFocus := IIf(!Empty(::oFocLFSle),::oFocLFSle,::oFocLFSle := oCtrl:lastXbp) LOCAL nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd, nAnzahl LOCAL cTitle := "Suchen nach:" /* cVariable ist Private von bestP8 */ /* 1->such_ein enth„lt den gesuchten Text */ y := ::XbpNummer( ::SingleZeile, "such_ein" ) ::singleZeile[y]:getdata() DbSkip(0) ////// // 04.09.2007 12:07 damit ein Benutzer den Auftrag automatisch wieder entsperrt: ////// IF 1->(IsFieldVar("benutzer")) ////// IF 1->benutzer == cBK ////// Satzsp(oCB) ////// ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") ////// DbRUnlock() ////// ENDIF ////// ENDIF DbSuspendNotifications() DO CASE CASE Upper(cSuchArt) = "N " cTitle := "Anlieferer-Namen eingeben:" 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 := "anummer" ::SuchFeld := "AnliefererNummer" ENDIF DO CASE CASE cVariable == "name" cSuchArt := "N " cTitle := "AnLieferer-Namen eingeben:" OrdSetFocus( "na" ) /* kontrollierender Index */ OTHERWISE cTitle := ::Suchfeld + " eingeben:" // 17.4.2005 IF ValType(1->&cVariable) == "D" OrdCreate( "AnLief", "x3", Str(Year(1->&cVariable),4,0) + ; StrX(Month(1->&cVariable),2,0) + StrX(day(1->&cVariable),2,0) ) ELSEIF ValType(1->&cVariable) == "N" OrdCreate( "AnLief", "x3", Str(1->&cVariable) ) ELSE // "C"-Felder (Index fr Memo-Felder ist NICHT m”glich) OrdCreate( "AnLief", "x3", Upper(1->&cVariable) ) ENDIF ::aIndex[3] := cVariable OrdSetFocus( "x3" ) /* kontrollierender Index */ DbGoto( nRec ) ENDCASE OTHERWISE cTitle := "Anlieferer-Nr. eingeben:" ENDCASE /* Eingabe von Alpha-Zeichen werden als NAME verstanden, wenn nichts Anderes bestimmt ist: */ IF Empty(cSuchArt) .AND. Len(cStringS)>0 .AND. Asc(cStringS[1])>64 // 10.11.2005 "Lenzomatic" VerstorbenenNamen suchen cSuchArt := "N " ENDIF DO WHILE .T. y := ::XbpNummer( ::SingleZeile, "such_ein" ) 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 Anlieferer-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 Upper(cSuchArt) = "F " OrdSetFocus( "x3" ) /* kontrollierender Index */ DbSeek( Upper(cSuch), .T. ) nAnf := 930; nEnd := 959 CASE Upper(cSuchArt) = "N " OrdSetFocus( "na" ) /* kontrollierender Index */ DbSeek( Upper(cSuch), .T. ) nAnf := 930; nEnd := 959 OTHERWISE OrdSetFocus( "an" ) /* kontrollierender Index */ DbGoto( nRec ) // weil unzul„ssige Eingabe cTip := "Anlieferer nicht gefunden." ::SuchFeld := "AnliefererNummer" // 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 := 1->anummer ENDIF ENDIF IF val(cAuf) == 1->anummer // wenn gefunden cTip := "Anlieferer gefunden." EXIT ELSEIF cAuf == "" // wenn nicht gefunden, gehe zum Ausgangspunkt DbGoto( nRec ) cTip := "Anlieferer nicht gefunden." ::SuchFeld := "AnliefererNummer" OrdSetFocus( "an" ) /* kontrollierender Index */ EXIT ELSE DbGoto( nRec ) cTip := "Andere Anlieferer-Nr. :" EXIT ENDIF ENDDO ::XbpObjekt( ::SingleZeile, "such_ein" ):setdata(such_ein:="") //02.07.2006 11:24 SET FILTER TO // 17.10.2004 oBEDA:cargo:readdata() // 14.11.2004 DbResumeNotifications() DbSkip(0) oCtrl:lastXbp := oBest:oFocLFSle // 29.10.2004 RETURN cTip /* ... */ METHOD BestFF:AnliefLoeschen( lCodeWort ) //*14.07.2008 15:11 LOCAL nAuf := Val(1->anummer) DEFAULT lCodeWort TO .T. IF Val(cRS) < 5 .AND. lCodeWort // wenn nicht berechtigt, ntzt auch kein Codewort ConfirmBox( oCB, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?"), ; "Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN ELSEIF Upper(AppName())$cAc .AND. lCodeWort // z.Zt. nur fr cAc IF oEdit:Codewort( oBEDA, "s_best", 840, 859, cDatver+"param", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; < "5" RETURN ENDIF ENDIF IF ConfirmBox( oCB, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?"), ; "Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht makieren?"), ; XBPMB_YESNO, ; XBPMB_CRITICAL, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES ///////* ab hier ist das berflssig, weil Auftrag nicht wirklich gel”scht wird, sondern nur unzug„nglich wird ///////*18.04.2008 18:54 wurde reaktiviert (speziell wegen Korrektur der Artikelbest„nde/Ums„tze */ ////// SELECT 2 ////// DbSeek(StrX(nAuf,E,0),.F.) ////// IF Found() //.AND. ConfirmBox( oCB, "Abbrechen mit ", ; //////// IIf(SET(43)==0,ConvToAnsiCP("Versicherungsdaten zu "+StrX(nAuf,E,0)+" l”schen?"), ; //////// "Versicherungsdaten zu "+StrX(nAuf,E,0)+" l”schen?"), ; //////// XBPMB_YESNO, ; //////// XBPMB_CRITICAL, ; //////// XBPMB_DEFBUTTON2 ) ; //////// = XBPMB_RET_YES ////// DO WHILE 2->auftrnr = nAuf .AND. !Eof() ////// Satzdelete() ////// DbSkip() ////// ENDDO ////// ENDIF ////// SELECT 3 ////// DbSeek(StrX(nAuf,E,0),.F.) ////// IF Found() //.AND. ConfirmBox( oCB, "Abbrechen mit ", ; //////// IIf(SET(43)==0,ConvToAnsiCP("Rechnung zu "+StrX(nAuf,E,0)+" l”schen?"), ; //////// "Rechnung zu "+StrX(nAuf,E,0)+" l”schen?"), ; //////// XBPMB_YESNO, ; //////// XBPMB_CRITICAL, ; //////// XBPMB_DEFBUTTON2 ) ; //////// = XBPMB_RET_YES ////// IF ConfirmBox( oCB, "Rechnung= / Angebot=", ; ////// IIf(SET(43)==0,ConvToAnsiCP("Mssen Artikeldaten korrigiert werden?"), ; ////// "Mssen Artikeldaten korrigiert werden?"), ; ////// XBPMB_YESNO, ; ////// XBPMB_CRITICAL, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_YES ////// DO WHILE 3->auftrnr = nAuf .AND. !Eof() ////// // Artikel-Daten korrigieren: ////// cArt := 3->zugr_z_st ////// SELECT 6 ////// FIND &cArt ////// Satzsp( oCB ) ////// REPLACE 6->bestand WITH 6->bestand+1 ////// REPLACE 6->mgjahr WITH 6->mgjahr-1 ////// IIf(6->(IsFieldVar("umsatz")), 6->umsatz := 6->umsatz - 3->betrag, ) ////// IIf(6->(IsFieldVar("umsatzeu")), 6->umsatzeu := 6->umsatzeu - 3->betrageu, ) ////// DbRUnlock( Recno() ) ////// SELECT 3 ////// // ////// Satzdelete() ////// DbSkip() ////// ENDDO ////// ENDIF ////// ENDIF SELECT 1 // bis hier ist es berflssig und kann bald gel”scht werden 14.09.2007 18:09 /*18.04.2008 18:56 Obiges wurde reaktiviert */ // Satzdelete() // stattdessen: Satzsp(oCB) 1->notiz := "== A N L I E F E R E R =="+CRLF+"=== g e l ” s c h t ===" + CRLF + 1->notiz ////// IIf(1->(IsFieldVar("recheleu0")),1->recheleu0 := 0,) ////// IIf(1->(IsFieldVar("recheleu0")),1->rechfleu0 := 0,) //wenn recheleu, dann rechfleu ////// 1->&r_b_0 := 0 ////// IIf(1->(IsFieldVar("recheleu1")),1->recheleu1 := 0,) ////// IIf(1->(IsFieldVar("recheleu1")),1->rechfleu1 := 0,) ////// 1->&r_b_1 := 0 ////// IIf(1->(IsFieldVar("recheleu2")),1->recheleu2 := 0,) ////// IIf(1->(IsFieldVar("recheleu2")),1->rechfleu2 := 0,) ////// 1->&r_b_2 := 0 ////// IIf(1->(IsFieldVar("recheleu3")),1->recheleu3 := 0,) ////// IIf(1->(IsFieldVar("recheleu3")),1->rechfleu3 := 0,) ////// IIf(1->(IsFieldVar("&r_b_3")),1->&r_b_3 := 0,) ////// IIf(1->(IsFieldVar("&r_b_n")),1->&r_b_n := 0,) ////// IIf(1->(IsFieldVar("recheleu")),1->recheleu := 0,) ////// IIf(1->(IsFieldVar("recheleu")),1->rechfleu := 0,) ////// 1->&r_s := 0 ////// IF 2->(IsFieldVar("rn")) ////// 1->eingbetr0 := 0 ////// 1->eingbetr1 := 0 ////// 1->eingbetr2 := 0 ////// 1->eingbetr3 := 0 ////// ENDIF ////// 1->&v_m := 0 ////// 1->&t_l := 0 DbRUnlock() ////// SELECT 4 ////// DbSeek( StrX(1->auftrnr,E,0), .F. ) // der erste Angeh”rige von dieser Auftragsnummer ////// DO WHILE 1->auftrnr == 4->P_AUFTRNR .AND. !4->(Eof()) ///////*18.04.2008 19:11 Rechnungsdaten l”schen und Artikel korrigieren: */ ////// 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)+4->P_PERSKZ,.F.) ////// DO WHILE 13->auftrnr == 1->auftrnr .AND. 13->rn == 4->P_PERSKZ .AND. !Eof() ////// // Artikel-Daten korrigieren: (ohne Frage, weil Angeh”rigenrechnung nie Angebot ist!) ////// 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")).AND.13->(IsFieldVar("betrag")), ; ////// 6->umsatz := 6->umsatz - 13->betrag, ) ////// IIf(6->(IsFieldVar("umsatzeu")).AND.13->(IsFieldVar("betrageu")), ; ////// 6->umsatzeu := 6->umsatzeu - 13->betrageu, ) ////// DbRUnlock( Recno() ) ////// SELECT 13 ////// // ////// Satzdelete() ////// DbSkip() ////// ENDDO ////// DbCloseArea() ////// SELECT 4 ///////**/ ////// 4->(Satzsp(oCB)) ////// 4->P_NOTIZ := "==== g e l ” s c h t ===="+CRLF + 4->P_NOTIZ ////// 4->P_RECH_NR := "" ////// 4->P_RECHBETR := 0 ////// 4->P_RECH_EL := 0 ////// 4->P_RECH_FL := 0 ////// 4->P_RECH_DAT := CtoD("") ////// 4->P_EINGBETR := 0 ////// 4->P_EING_DAT := CtoD("") ////// 4->P_EING_KTO := "" ////// 4->P_SALDO := 0 ////// 4->(DbRUnlock()) ////// 4->(DbSkip()) ////// ENDDO SELECT 1 IIf(lLogBook,::TLog:write():writeLogFile(),) //16.09.2007 22:25 oBest:Fall_geloescht := .T. // damit letzte30 neu gefllt werden 26.06.2006 16:02 DbSkip(0) // 14.09.2007 18:11 damit die 'disabled'-Ansicht kommt ENDIF 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 ////// DbUseArea( .T.,, "C:\HDBE\FExport", "fe", .F. ) // 14.1.2005 fe-> statt 9-> ////// // 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() //20.06.2007 09:35 ge„ndert, so wie ::EhePartner() LOCAL cAnsp := IIf(Upper(AppName())$cAc,"Rechnungsempf„nger","Ansprechpartner") ////// LOCAL Wahl := ConfirmBox( ::BEArea[1], "Ist "+cAnsp+" = Ehepartner?", ; ////// IIf(SET(43)==0,ConvToAnsiCP(cAnsp+" „ndern"), ; ////// cAnsp+" „ndern"), ; ////// XBPMB_YESNOCANCEL, ; ////// XBPMB_QUESTION ) LOCAL Wahl := ConfirmBox( ::BEArea[1], ; IIf(SET(43)==0,ConvToAnsiCP("Sollen die Daten vom Ehepartner bernommen werden?"), ; "Sollen die Daten vom Ehepartner bernommen werden?")+CRLF+ ; IIf(SET(43)==0,ConvToAnsiCP("Nein=šbernahme vom Verstorbenen / Esc=abbrechen."), ; "Nein=šbernahme vom Verstorbenen / Esc=abbrechen."), ; IIf(SET(43)==0,ConvToAnsiCP(cAnsp+" „ndern"), ; cAnsp+" „ndern"), ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF Wahl == XBPMB_RET_NO Satzsp( ::BEArea[1] ) IF 1->anrede = "Herr" 1->ansp_anr := "Frau" ELSEIF 1->anrede = "Frau" 1->ansp_anr := "Herr" ENDIF 1->ansp_name := 1->name 1->ansp_str := 1->strasse 1->ansp_ort := 1->plz_ort IIf(IsFieldVar("ansp_ortst").AND.IsFieldVar("ortsteil"),1->ansp_ortst:=1->ortsteil,) DbRUnlock(RecNo()) ELSEIF Wahl == XBPMB_RET_YES Satzsp( ::BEArea[1] ) IIf(IsFieldVar("ansp_akgr").AND.IsFieldVar("eh_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("ansp_ortst").AND.IsFieldVar("eh_ortst"),1->ansp_ortst:=1->eh_ortst,) IF 1->ansp_anr = "Herr" 1->ansp_bez := "Ehemann" ELSEIF 1->ansp_anr = "Frau" 1->ansp_bez := "Ehefrau" ENDIF DbRUnlock(RecNo()) ENDIF ////// 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 cAnsp := IIf(Upper(AppName())$cAc,"Rechnungsempf„nger","Ansprechpartner") LOCAL Wahl := ConfirmBox( ::BEArea[1], "In Anrede mit - In Name mit - Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Adresse als "+cAnsp+" eintragen"), ; "Adresse als "+cAnsp+" 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() //20.06.2007 09:35 ge„ndert, so wie ::AnsprechPartner() LOCAL cAnsp := IIf(Upper(AppName())$cAc,"Rechnungsempf„nger","Ansprechpartner") LOCAL Wahl := ConfirmBox( ::BEArea[1], ; IIf(SET(43)==0,ConvToAnsiCP("Sollen die Daten vom "+cAnsp+" bernommen werden?"), ; "Sollen die Daten vom "+cAnsp+" bernommen werden?")+CRLF+ ; IIf(SET(43)==0,ConvToAnsiCP("Nein=šbernahme vom Verstorbenen / Esc=abbrechen."), ; "Nein=šbernahme vom Verstorbenen / Esc=abbrechen."), ; IIf(SET(43)==0,ConvToAnsiCP("Ehepartner „ndern"), ; "Ehepartner „ndern"), ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF Wahl == XBPMB_RET_NO Satzsp( ::BEArea[1] ) 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,) DbRUnlock(RecNo()) ELSEIF Wahl == XBPMB_RET_YES Satzsp( ::BEArea[1] ) 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,) DbRUnlock(RecNo()) ENDIF RETURN self METHOD BestFF:NeuerFall( cKopie, cKreis ) LOCAL cAuf := IIf(Empty(cKreis),Space(E),cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 LOCAL y, cString := "", aStrings := {}, cTip, nRec := RecNo() LOCAL lLupe := 2->(DbScope()) // nicht 1, weil beim Aufruf Area1 ge'clearscope't wird !!!! DbSkip(0) // 04.09.2007 12:07 damit ein Benutzer den Auftrag automatisch wieder entsperrt: IF 1->(IsFieldVar("benutzer")) IF 1->benutzer == cBK Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") DbRUnlock() ENDIF ENDIF IF Val(1->anummer)=0 DELETE ENDIF IF lLupe ::Lupe({1,2,3}) // 12.11.2005 == Clear Scope ENDIF cAufalt := 1->anummer 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() // 05.09.2007 17:20 Sicherheits-Abfrage fr WernerX? : IF Upper(AppName())$"WERNERX.EXE" .AND. ; ConfirmBox( oBEDA, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Soll wirklich ein neuer Fall angelegt werden?"), ; "Soll wirklich ein neuer Fall angelegt werden?"), ; XBPMB_YESNO, ; XBPMB_QUESTION, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO cTip := "Kein neuer Fall angelegt!" 1->(DbGoto(nRec)) RETURN cTip ENDIF IF VAL( cAufneu ) > 0 .AND. Val( cAufneu ) < Val(Replicate("9",E))+1 // 1000000 1->(DbAppend()) REPLACE 1->ANUMMER WITH 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(1->anummer[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 // bei HWA: Vorsorgef„lle kennzeichnen: 19.10.2007 17:12 aus 7->9 am 03.03.2008 13:59 IF "RNER"$Upper(AppName()) .AND. cAufalt[1] == "9" IF cAufneu[3] == "9" .AND. SubStr(cAufneu,3,E-1) == SubStr(cAufalt,1,E-1) // Zehnergruppe gleich cString := "Achtung: Folgevorsorge beachten: " + SubStr(cAufneu,3) + CRLF + ; "==== V O R S O R G E g e l ” s c h t ====" + CRLF ELSEIF cAufneu[3] != "9" // Kopie auf aktuellen Sterbefall (=NichtVorsorgefall) cString := "Achtung: Wurde zum Sterbefall Nr. " + SubStr(cAufneu,3) + CRLF + ; "==== V O R S O R G E g e l ” s c h t ====" + CRLF ENDIF 1->(Satzsp(oCB)) 1->notiz := cString + 1->notiz 1->(DBRUnlock()) ENDIF // 1->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT ////// // bei HWA: 19.10.2007 18:07 ////// IF "RNER"$Upper(AppName()) .AND. cAufalt[1] == "7" .AND. cAufneu[1] != "7" ////// 1->notiz := "Achtung: Kopiert vom Vorsorgefall Nr. " + cAufalt + CRLF + 1->notiz ////// ENDIF ////// // REPLACE 1->ANUMMER WITH SubStr( Padr( cAufneu, E+2 ),3,E ) IF IsFieldVar("adatum") // 20.11.2004 1->adatum := 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 ", ; ////// IIf(SET(43)==0,ConvToAnsiCP("Versicherungsdaten + Rechnung bernehmen?"), ; ////// "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: , 14.11.2007 11:58: wenn es kein Angebot/Vorvertrag ist: ////// IF StrX(3->auftrnr,E)[1] != IIf("RNERX"$Upper(AppName()),"9","7") //14.11.2007 11:57 ////// cArt := 3->zugr_z_st ////// SELECT 6 ////// FIND &cArt ////// Satzsp( oCB ) ////// //14.11.2007 11:51 Korrektur mit Mengen(!): ////// REPLACE 6->bestand WITH 6->bestand-IIf(3->(IsFieldVar("menge")),3->menge,1) ////// REPLACE 6->mgjahr WITH 6->mgjahr+IIf(3->(IsFieldVar("menge")),3->menge,1) ////// REPLACE 6->umsatz WITH 6->umsatz + 3->betrag * IIf(3->(IsFieldVar("menge")),3->menge,1) ////// REPLACE 6->umsatzeu WITH 6->umsatzeu + 3->betrageu * IIf(3->(IsFieldVar("menge")),3->menge,1) ////// DbRUnlock( Recno() ) ////// ENDIF ////// // ////// 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) IIf(lLogBook,::TLog:write():writeLogFile(),) //16.09.2007 22:27 RETURN cTip ///////* 22.06.2008 13:56 fr ScrapX, schaltet den Editierschutz aus, wenn cBK der erste Benutzer ist */ //////METHOD BestFF:Aendern( nA1, nA2, cIndex ) ////// LOCAL cAtemp := "a_"+cIndex, nAExist ////// LOCAL n ///////* Feststellen, ob die Daten nicht vielleicht schon im Zugriff sind, oder Reste eines Abbruchs */ ////// DO WHILE FExists( cDatver+cAtemp+"*.dbf" ) .AND. nAExist != XBPMB_RET_YES ////// IF FExists( cDatver+cAtemp+"*.dbf" ) .AND. nAExist == XBPMB_RET_NO ////// nAExist := ConfirmBox( oDlg1, ; ////// "Die Daten werden von einem anderen Benutzer bearbeitet."+CRLF+ ; ////// " Wenn dieser die Daten freigibt, dann k”nnen Sie mit"+CRLF+ ; ////// " die Daten selbst bearbeiten."+CRLF+ ; ////// " abbrechen", ; ////// "Datensatz wird schon bearbeitet !", ; ////// XBPMB_YESCANCEL, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ////// nAExist := IIf( nAExist == XBPMB_RET_YES, XBPMB_RET_NO, XBPMB_RET_CANCEL ) ////// ELSEIF FExists( cDatver+cAtemp+cBK+".dbf" ) ////// nAExist := ConfirmBox( oDlg1, ; ////// "Die Daten sind bei einem Programmabsturz bergeblieben.")+CRLF+ ; ////// " rekonstruiert abgebrochene Daten"+CRLF+ ; ////// " baut die Daten neu auf (Normalfall)"+CRLF+ ; ////// " abbrechen", ; ////// "Datensatz wurde schon bearbeitet !", ; ////// XBPMB_YESNOCANCEL, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ////// ELSE ////// nAExist := ConfirmBox( oDlg1, ; ////// "Die Daten werden von einem anderen Benutzer bearbeitet"+CRLF+ ; ////// "oder sind bei einem Programmabsturz bergeblieben.")+CRLF+ ; ////// " versucht abgebrochene Daten zu rekonstruieren"+CRLF+ ; ////// " versucht die Daten neu aufzubauen (Normalfall)"+CRLF+ ; ////// " abbrechen", ; ////// "Datensatz wird/wurde schon bearbeitet !", ; ////// XBPMB_YESNOCANCEL, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ////// ENDIF ////// IF nAExist = XBPMB_RET_CANCEL ////// RETURN ////// ELSEIF nAExist = XBPMB_RET_NO ////// IF FErase( cDatver+cAuf3temp+".dbf" ) != 0 /* 0, wenn FErase gelingt */ ////// nAExist := XBPMB_RET_YES ////// ENDIF ////// ENDIF ////// ENDDO ///////* nAExist muss NO sein, damit es weitergehen kann mit dem Neuerzeugen der Zwischendatei: ////// HIER hat die Zwischendatei nur einen Datensatz! */ ////// IF FExists( cDatver+cAtemp+cBK+".dbf" ) // 06.09.2006 15:59 Datei wird rekonstruiert ////// SELECT (nA2) ////// DbUseArea( , "FOXCDX", cDatver+cAtemp+cBK,, .F. ) ////// ::aData1 := Array((nA2)->(FCount())) ////// FOR n := 1 to (nA2)->(FCount()) ////// ::aData1[n] := (nA2)->(FieldGet( n )) ////// NEXT ////// ELSE ////// SELECT (nA1) ////// ::aData1 := Array((nA1)->(FCount())) ////// FOR n := 1 to (nA1)->(FCount()) ////// ::aData1[n] := (nA1)->(FieldGet( n )) ////// NEXT ////// DbCopyStruct( cDatver+cAtemp+cBK ) ////// SELECT (nA2) ////// DbUseArea( , "FOXCDX", cDatver+cAtemp+cBK,, .F. ) ////// (nA2)->(DbAppend()) ////// FOR n := 1 to (nA1)->(FCount()) // FCount() // 13.8.2004 ////// (nA2)->(FieldPut( n, ::aData1[n] )) ////// NEXT ////// ENDIF ///////* jetzt muss das Template SCAEND geladen werden */ //////RETURN self METHOD BestFF:NamenSuche(cName,cVorname,cStrasse,nA) // zur Kontrolle, ob Verstorbener bereits in Datei enthalten LOCAL nOldOrder := OrdNumber() LOCAL nRec := Recno() LOCAL lUnique := .T. LOCAL cTitel DEFAULT cVorname TO "", cStrasse TO "", nA TO SELECT() //+17.03.2009 20:37 IF !Empty( cName ) DbSuspendNotifications() OrdSetFocus( 2 ) // 1 = Nummer, 2 = Name SatzDelete() // damit er sich nicht selber findet IF !DbSeek(Upper(cName),.T.) // wenn nicht gefunden, cTitel := "Dieser Name existiert noch nicht!" ELSEIF DbSeek(Upper(cName+cVorname+cStrasse),.T.) cTitel := "A C H T U N G: Gleiche Daten bereits vorhanden!" lUnique := .F. ELSEIF DbSeek(Upper(cName+cVorname),.T.) cTitel := "Dieser Name+Vorname ist bereits vorhanden!" lUnique := .F. ELSEIF DbSeek(Upper(cName),.T.) cTitel := "Dieser Name ist bereits vorhanden!" lUnique := .F. ENDIF IF !lUnique // oBest:Such( oBEDA, ::cS_b, 930, 939, 1, 1->(RecNo()), ; // {10,30*nV}, {425*nH,175*nV}, {}, cTitel ) oBest:Such( ::oParent, "s_best", 930, 939, nA, (nA)->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {}, cTitel ) IF cTitel = "A C H T U N G" OrdSetFocus( nOldOrder ) DbGoTo( nRec ) // immer zurck zum Eingabefall! (weil er recalled werden muss!) SatzRecall() // damit er wieder da ist DbResetNotifications() Loeschen( ::oParent, (nA)->anummer, .F. ) RETURN cTitel ENDIF ENDIF OrdSetFocus( nOldOrder ) DbGoTo( nRec ) // immer zurck zum Eingabefall! (weil er recalled werden muss!) SatzRecall() // damit er wieder da ist DbResetNotifications() ENDIF RETURN cTitel // Suche nach Adressen/Personen/Einrichtungen in der Hauptmaske // cFkt=4 heiát, -Taste ist gedrckt worden, also suche nach Eintr„gen, die die Buchstabenfolge enthalten METHOD BestFF:AdrSuch(oXbp,cFkt,cKzNam) //01.07.2007 11:13 05.09.2007 15:36 LOCAL nOldArea := SELECT(), cVorigerWert := IIf(!oXbp:isDerivedFrom("XbpSle"),"",oXbp:vorigerWert) LOCAL cTitel, nRec, nOldOrder := 5->(OrdNumber()) DEFAULT cFkt TO 4, cKzNam TO "N" //05.09.2007 15:49 IF !oXbp:isDerivedFrom("XbpSle") RETURN "Fr dieses Feld steht diese Funktion nicht zur Verfgung" ENDIF SELECT 5 nRec := RecNo() // DbSuspendNotifications() DO CASE CASE cFkt = 0 5->(DbSeek(Trim(oXbp:value),.T.)) cTitel := "Suche nach dem Kennzeichen sortiert:" CASE cFkt = 4 5->(DbSetFilter( {|| Upper(Trim(oXbp:value))$Upper(5->name1+5->name2) } )) IIf( !(5)->(Bof()), 5->(DbGotop()), ) //29.03.2008 14:06 cTitel := "Suche nach einer Buchstabenfolge im Namen:" CASE cFkt = 5 OrdSetFocus( 2 ) 5->(DbSeek(Trim(oXbp:value),.T.)) cTitel := "Suche nach dem Namen sortiert:" CASE cFkt = 6 5->(DbSetFilter( {|| Upper(Trim(oXbp:value))==Upper(Trim(5->gruppe)) } )) IIf( !(5)->(Bof()), 5->(DbGotop()), ) //29.03.2008 14:06 cTitel := "Suche innerhalb einer Gruppe:" ENDCASE DbSkip(0) IF oBest:Such( oCB , "s_vers", 960, 969, 5, 5->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {}, cTitel ) DbClearFilter() OrdSetFocus( nOldOrder ) SELECT (nOldArea) oXbp:setData( cVorigerWert ) oXbp:getData() 5->(DbGoto(nRec)) cFktT := 0 // PUBLIC, zeigt an, welche Fubktionstaste als letzte gedrckt wurde RETURN "Auswahl abgebrochen." ENDIF DbClearFilter() OrdSetFocus( nOldOrder ) // DbResumeNotifications() SELECT (nOldArea) Satzsp(oCB) oXbp:setData(PadR(IIf(cKzNam="N",5->name1,5->verskz),oXbp:bufferlength)) //05.09.2007 15:52 oXbp:getData() IF oXbp:cargo="&"+"STO1" ::XbpObjektSet(::singleZeile,"&"+"STO2",IIf(1->&STO1[1]==Upper(1->&STO1[1]),5->strasse,1->strasse)) ::XbpObjektSet(::singleZeile,"&"+"STO3",IIf(1->&STO1[1]==Upper(1->&STO1[1]),5->plz_ort,1->plz_ort)) ::XbpObjektGet(::singleZeile,"&"+"STO2") ::XbpObjektGet(::singleZeile,"&"+"STO3") ENDIF DBRUnlock() cFktT := 0 // PUBLIC, zeigt an, welche Funktionstaste als letzte gedrckt wurde 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 bestP8 y := ::XbpNummer( ::SingleZeile, cString ) ::singleZeile[y]:getdata() /* IIf(IsFieldVar("perskz"),::SwapPers("S"),) // 9.5.2005 */ DbSkip(0) // 04.09.2007 12:07 damit ein Benutzer den Auftrag automatisch wieder entsperrt: IF 1->(IsFieldVar("benutzer")) IF 1->benutzer == cBK Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") DbRUnlock() ENDIF ENDIF 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, cKreis ) // LOCAL aStrings := {} LOCAL nRec := RecNo() // LOCAL n := AScan( oDlg1:childlist(), {|x| x:isDerivedFrom("XbpListbox")} ) // LOCAL nL := IIf(n>0,::XbpNummer( ::ListBox, oDlg1:childlist()[n]:cargo ),0) LOCAL cItem := " " DEFAULT cKreis TO "" IF cKreis == "X" DbSuspendNotifications() DbGobottom() cItem := StrX(Val(1->anummer)+1,6) DbResumeNotifications() RETURN cItem ELSEIF cKreis == "0" .OR. Val(cKreis) > 0 DbSuspendNotifications() OrdSetFocus(1) DbSeek( Str(Val(cKreis)+1,1)+"00000", .T., 1 ) /* Softseek findet ersten h”heren Wert */ DbSkip(-1) /* zurck in den richtige Nummernkreis */ IF 1->anummer[1] == cKreis /* ist es auch wirklich der richtige? */ cItem := StrX(Val(1->anummer)+1,6) /* dann z„hle eins hoch */ ELSE /* nein? : */ cItem := cKreis + "00001" /* dann baue die erste Nummer selber auf */ ENDIF DbGoto(nRec) DbResumeNotifications() RETURN cItem ENDIF //// 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() //// SET ORDER TO 0 //// GO BOTTOM //// ::ListBox[nL]:CLEAR() //// DO WHILE !Bof() .AND. Len(aStrings) <= 30 //// DO CASE //// CASE !Empty(cString) .AND. PadL(cString,E,"0")[1]!=StrX(1->auftrnr,E,0)[1] //11.2.04 ////// --i // Auftrnr aus falscher Gruppe berspringen //// CASE !Empty(1->name) //26.01.2008 17:07 Rufname erg„nzt //// AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+Trim(1->name)+", "+ ; //// Trim(IIf(Upper(AppName())$cAc .AND. !Empty(1->rufname),1->rufname,1->vorname))+ ; //// ", "+ Trim(1->strasse)+Trim(IIf(Upper(AppName())$cAc,", "+1->plz_ort,"")) ) //22.02.2008 22:38 //// CASE !Empty(1->ansp_name) //// AAdd( aStrings, StrX(1->auftrnr,E,0)+" - "+Trim(1->ansp_name)+", " ; //// +Trim(1->ansp_vname)+ ", "+Trim(1->ansp_str) + ; //// Trim(IIf(Upper(AppName())$cAc,", "+1->ansp_ort,"")) ) //22.02.2008 22:37 //// 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 //// IF "RNER"$Upper(AppName()) .AND. Left(aStrings[1],1)== "9" //14.11.2007 12:11 //// // 9er Gruppe sind HIER die Vorvertr„ge und sollen in Zehnerschritten gehen //// cString := IIf( (Val(cString)>0 .OR. "Kopie"$oDlg1:cargo) .AND. Len(aStrings)>0, ; //// IIf("akzept"$cTip,StrX(Int(Val(Left(aStrings[1],E))/10+1),E-1,0)+"0",Space(E)), ; //// cString ) //19.10.2007 19:40 //// ELSE //// 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 //// ENDIF //// AEval( aStrings, {|c| ::ListBox[nL]:addItem(c) } ) //// ::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 //// IF "RNER"$Upper(AppName()) .AND. cItem[1]== "9" //19.10.2007 19:35 //// cString := StrX(Int(Val(cItem)/10+1),E-1,0)+"0" //// ELSE //// cString := StrX(Val(cItem)+1,E,0) //// ENDIF //// 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" //26.03.2008 16:03 wofr wurde das gebraucht??? 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" // 26.03.2008 16:03 DbSuspendNotifications() DbSeek( cAuf, .T. ) // DbResumeNotifications() IIf( Val(cAuf[1]) != Val(FIELD->anummer[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 cAc-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),1->kirch_auf} 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" //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())$cAc oBest:XbpObjekt( oBest:SingleZeile, "TW3" ):setData(::TW3:=CDoW(1->&TD3)) ENDIF IF IsFieldVar("&TD4") // wieso?? .AND. Upper(AppName())$cAc 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 "anummer" PRIVATE cVariable := cVar IF SELECT()=1 DO CASE CASE Upper(cVariable) == "ANUMMER" 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 //28.04.2008 10:33 cKopie+cKreis werden nicht gebraucht?? METHOD BestFF:FallCaufM( cKopie, cKreis, cVer ) //15.08.2006 LOCAL cAufalt, n, aDataV := {}, cVersTemp, cAufTemp, cTip, nM //nM:28.04.2008 10:42 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 /*28.04.2008 11:09 erst alle Daten der alten Rechnung l”schen und dabei die Artikelbest„nde korrigieren: */ SELECT 23 23->(DbSeek(cAufalt,.F.)) DO WHILE 23->auftrnr == Val(cAufalt) // Artikel-Daten korrigieren: cArt := 23->zugr_z_st nM := IIf(23->(IsFieldVar("menge")),23->menge,1) //28.04.2008 10:41 Menge vorher SELECT 26 26->(DbSeek(cArt,.F.)) //28.04.2008 10:45 sucht den aktuellen 23->Artikel IF !26->(Eof()) //28.04.2008 10:45 Satzsp( oCB ) 26->bestand += nM //ff: 28.04.2008 10:41 26->mgjahr -= nM 26->&u_z -= 23->&b_g * nM IIf(26->(IsFieldVar(u_n)),26->&u_n -= 23->&b_n * nM,) // 29.08.2005 u_n = "umsneteu" IIf(26->(IsFieldVar("gewinneu")),26->gewinneu -= (23->&b_n - 26->&e_p_s) * nM,) // 17.03.2008 22:22 ENDIF // SELECT 23 23->(SatzDelete()) 23->(DbSkip()) 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 /*28.04.2008 11:13 alte Version ist sicher nicht richtig: (Korrektur siehe oben) 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 nM := IIf(23->(IsFieldVar("menge")),23->menge,1) //28.04.2008 10:41 Menge nachher SELECT 26 26->(DbSeek(cArt,.F.)) //28.04.2008 10:45 IF !26->(Eof()) //28.04.2008 10:45 Satzsp( oCB ) 26->bestand -= nM //ff: 28.04.2008 10:41 26->mgjahr += nM 26->&u_z += 23->&b_g * nM IIf(26->(IsFieldVar(u_n)),26->&u_n += 23->&b_n * nM,) // 29.08.2005 u_n = "umsneteu" IIf(26->(IsFieldVar("gewinneu")),26->gewinneu += (23->&b_n - 26->&e_p_s) * nM,) // 17.03.2008 22:22 /*28.04.2008 10:51 erg„nzt siehe vor: 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() ) ENDIF // 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) IIf(lLogBook,::TLog:writeLogFile():write(),) //16.09.2007 22:28 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 (param.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+"param" ) // 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+"param.dbf") COPY TO (cEVerz+"param") 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) ::TLog:writeLogFile():write() //16.09.2007 22:29 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 IsDriveReady(Chr(nDrive)) = 0 // 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) ::TLog:writeLogFile():write() //16.09.2007 22:29 RETURN cTip METHOD BestFF:SwapPers(cLS) ////// LOCAL nOldArea := SELECT(), nRec4 := 4->(RecNo()) ////// LOCAL cPersKZ := "@", y, z //06.09.2007 17:24 ////// // 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 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 ::XbpNummer(::singleZeile,"PvORTSTEIL") > 0 .AND. 4->(IsFieldVar("p_ortsteil")) //13.04.2008 16:06 ////// ::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 ::XbpNummer(::singleZeile,"PvRECH_EL") > 0 .AND. 4->(IsFieldVar("P_RECH_EL")) //13.04.2008 16:02 ////// ::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) ////// IF ::XbpNummer(::singleZeile,"PvEING_KTO") > 0 .AND. 4->(IsFieldVar("P_EING_KTO")) //13.04.2008 16:06 ////// ::XbpObjekt(::singleZeile,"PvEING_KTO"):setData(::PvEING_KTO:=4->P_EING_KTO) ////// ENDIF ////// ::XbpObjekt(::singleZeile,"PvSALDO"):setData(::PvSALDO:=4->P_SALDO) ////// IF ::XbpNummer(::singleZeile,"PvGKZ") > 0 .AND. 4->(IsFieldVar("p_gkz")) //13.04.2008 16:06 ////// ::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()) ////// //06.09.2007 17:24 'gel”schte' Angeh”rige werden disabled: ////// y := ::XbpNummer(::singleZeile,"PvTELEFON") ////// z := ::XbpNummer(::singleZeile,"PvSALDO") ////// IF "g e l ” s c h t"$::PvNOTIZ .OR. "g e l ” s c h t"$1->notiz //14.09.2007 16:08 ////// AEval( ::singleZeile, {|a,i| a:disable() }, y, z-y ) ////// ::XbpObjekt(::multiZeile,"PvNOTIZ"):disable() ////// ELSE ////// AEval( ::singleZeile, {|a,i| a:enable() }, y, z-y ) ////// ::XbpObjekt(::multiZeile,"PvNOTIZ"):enable() ////// ENDIF ////// 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 ::XbpNummer(::singleZeile,"PvORTSTEIL") > 0 .AND. 4->(IsFieldVar("p_ortsteil")) //13.04.2008 16:06 ////// 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 ::XbpNummer(::singleZeile,"PvRECH_EL") > 0 .AND. 4->(IsFieldVar("P_RECH_EL")) //13.04.2008 16:06 ////// 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() ////// IF ::XbpNummer(::singleZeile,"PvEING_KTO") > 0 .AND. 4->(IsFieldVar("P_EING_KTO")) //13.04.2008 16:06 ////// 4->P_EING_KTO:= ::XbpObjekt(::singleZeile,"PvEING_KTO"):getData() ////// ENDIF ////// 4->P_SALDO := ::XbpObjekt(::singleZeile,"PvSALDO"):getData() ////// IF ::XbpNummer(::singleZeile,"PvGKZ") > 0 .AND. 4->(IsFieldVar("p_gkz")) //13.04.2008 16:07 ////// 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, nOldArea := SELECT() ////// IF Val(cRS) < 5 ////// 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())$cAc ////// IF ::Codewort( oBEDA, "s_best", 840, 859, cDatver+"param", 9, , ; ////// {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; ////// < "5" ////// 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")).AND.13->(IsFieldVar("betrag")), ; ////// 6->umsatz := 6->umsatz - 13->betrag, ) ////// IIf(6->(IsFieldVar("umsatzeu")).AND.13->(IsFieldVar("betrageu")), ; ////// 6->umsatzeu := 6->umsatzeu - 13->betrageu, ) ////// DbRUnlock( Recno() ) ////// SELECT 13 ////// // ////// Satzdelete() ////// DbSkip() ////// ENDDO ////// DbCloseArea() ////// SELECT &nOldArea ////// IF !"ERNE"$Upper(AppName()) ////// 4->(Satzsp(oCB)) ////// 4->(DbDelete()) ////// DO WHILE 4->(DELETED()) .AND. !4->(Bof()) ////// 4->(DbSkip(-1)) ////// ENDDO ////// IF 4->(Bof()) ////// DO WHILE 4->(DELETED()) .AND. !4->(Eof()) ////// 4->(DbSkip()) ////// ENDDO ////// ENDIF ////// ELSE ////// 4->(Satzsp(oCB)) ////// 4->P_NOTIZ := "==== g e l ” s c h t ===="+CRLF + 4->P_NOTIZ ////// 4->P_RECH_NR := "" ////// 4->P_RECHBETR := 0 ////// 4->P_RECH_EL := 0 ////// 4->P_RECH_FL := 0 ////// 4->P_RECH_DAT := CtoD("") ////// 4->P_EINGBETR := 0 ////// 4->P_EING_DAT := CtoD("") ////// 4->P_EING_KTO := "" ////// 4->P_SALDO := 0 ////// 4->(DbRUnlock()) ////// ENDIF ////// ::SwapPers("L") ////// IIf(lLogBook,::TLog:write():writeLogFile(),) //16.09.2007 22:30 ////// 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(::TabSeite,o) // IF "Angeh"$::thisTab:cargo //29.04.2007 15:26 speichert Angeh”rigen, wenn umgeschaltet wird // ::SwapPers("S") // ENDIF AEval(aTab, {|x,i| ::TabSeite[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::TabSeite[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())$cAc // 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) // ::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 cAc ::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 cAc ::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 //04.09.2007 18:13: // in GKZ steht dann auáer verskz auch -R, -E, -V, -M, -A.X (= Angeh”riger X) // ::aBP wird im Rechnungs-Programm als Rechnungsadresse verwendet METHOD BestFF:AngDaten(cGkz) // holt sich die Daten von Angeh”rigen je nach GKZ-Inhalt LOCAL nRec LOCAL cBez := "" DEFAULT cGkz TO "-R " // fr alle F„lle IF cGkz[1]>"@" nRec := 5->(RecNo()) 5->(DbSuspendNotifications()) 5->(DbSeek(cGkz,.F.)) ::aBP := { 5->name1, 5->name2, "", 5->strasse, 5->plz_ort, cBez, 1, 5->tel } 5->(DbGoto(nRec)) 5->(DbResumeNotifications()) ELSEIF cGkz[1]="-" DO CASE CASE cGkz[2] == "R" // trivial: der Rechnungsempf„nger=Ansprechpartner ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } CASE cGkz[2] == "E" ::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 cGkz[2] == "A" nRec := 4->(RecNo()) 4->(DbResumeNotifications()) 4->(DbSeek(StrZero(1->AUFTRNR,E,0) + Right(Trim(cGkz),1), .F. )) // .F., damit nur der Richtige gefunden wird IF 4->P_Perskz = Right(Trim(cGkz),1) ::aBP := { 4->P_ANREDE, 4->P_VORNAME, 4->P_NAME, 4->P_STRASSE, 4->P_PLZ_ORT, 4->P_VERW_BEZ, 3, 4->P_TELEFON } ELSE ::aBP := { "-", "-", "-", "-", "-", "-", "-", "-" } // dieser Angeh”riger existiert nicht ENDIF 4->(DbGoto(nRec)) 4->(DbResumeNotifications()) CASE cGkz[2] == "V" // 28.05.2007 15:50 cAc ::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 cGkz[2] == "M" // 28.05.2007 15:50 cAc ::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 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 F1F2F3F4" //26.03.2008 16:07 ////// 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 F1F2F3F4" //.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(), cNotiz := 1->notiz, cP IF cBL_Datei == Upper(cBL_Datei) cP := SET(43,1) // 01.07.2007 10:21 n”tig?? (hilft nicht bei Druck1Seite+(sofort)Ende+Druck) DbUseArea(.T.,,"bl_dir") nA := SELECT() IF DbLocate( {|| PadR(cBL_Datei,8) == Upper((nA)->name)} ) cNotiz += IIf(Upper(AppName())$"WERNERX.EXE",CRLF,"") + ; //01.03.2008 16:52 CRLF+DtoC(DATE())+": " + IIf(IsMemVar("cTKurz0").AND.Len(Trim(cTKurz0))>0, ; IIf(cTKurz0="!angebot","Kostenvoranschlag",Trim(cTKurz0)), Trim((nA)->beschreib)) + ; IIf( (cBL_Datei!="BL_A" .OR. Len(cBL_Datei)>5) .AND. ; 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())$cAc, ; " fr "+aAdrKl[2]+"/"+aAdrKl[3]+"/"+aAdrKL[4]+" gedruckt.", ; IIf(cBL_Datei$"BL_V".AND.Upper(AppName())$cAc, ; " an "+Trim(12->name1)+" gedruckt."," gedruckt."))) IF Upper(AppName())$cAc .AND. cBL_Datei = "BL_ALBR" cNotiz += CRLF + IIf(cTKurz0="!versorg","Aktenzeichen: ","Mitgliedsnummer: ")+ Trim(oEdit:aTxBd[9]) ENDIF IF "POSTRENT"$Upper((nA)->beschreib) cNotiz += CRLF+"Nr.:"+cPR1+", "+cPR2+", "+cPR3+IIf(IsMemVar("cPR4"),", "+cPR4,"") //21.04.2008 20:48 cPR4 ENDIF ENDIF DbCloseArea() SELECT (nOldArea) 1->(Satzsp(oCB)) FOR i:=1 TO Len(::multizeile) // direkte Anzeige auch bei cAc ::multizeile[i]:setData( 1->notiz := cNotiz ) NEXT 1->(DbRUnlock()) SET(43,cP) ENDIF RETURN self //14.07.2008 08:26 vorl„ufiges Backup/Restore///////////////////////////////////////////////////////////// FUNCTION DATEN_Backup() LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0 LOCAL cNetverX := "C:\HDBE_BAK\" + DtoS(date()) + "\" //*14.07.2008 08:12 CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() //////// Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen //////// Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung ////// 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: ////// cNetverX := Chr(nDrive)+":\HDBE_BAK\" ////// EXIT ////// ELSE ////// // Verzeichnis neu erstellen: ////// RunShell( "/C MD "+Chr(nDrive)+":\HDBE_BAK\" ) ////// Sleep(100) //13.03.2008 18:37 ////// IF ++n <= 1 ////// // mit demselben Laufwerk noch einmal versuchen ////// nDrive++ //13.03.2008 18:37 ////// ELSE ////// // beim zweiten Mal ein Laufwerk weitergehen ////// n := 0 ////// ENDIF ////// LOOP ////// ENDIF ////// ENDIF ////// NEXT //////// Abfrage, wenn kein USB-Stick gefunden wurde: ////// IF Asc(Upper(cNetverX[1])) < 69 .AND. ConfirmBox( oBEDA, ; ////// "Soll in das Verzeichnis:"+CRLF+ ; ////// cNetverX+" kopiert werden?", ; ////// "Kein USB-Stick!?", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_NO ////// RETURN .F. // nichts wird kopiert ////// ELSE ////// IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; ////// "Soll WIRKLICH in das Verzeichnis:"+CRLF+ ; ////// cNetverX+" kopiert werden?", ; ////// "Achtung :", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_NO ////// RETURN .F. // nichts wird kopiert ////// ENDIF IF !FExists(cNetverX,"D") //18.10.2007 17:32 // Verzeichnis neu erstellen: RunShell( "/C MD "+cNetverX ) ENDIF ////// ENDIF // vom cDatver zum Stick bzw. in das cNetverX kopieren: FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) COPY FILE (cDatver+aName[i]) TO (cNetverX+aName[i]) ENDIF NEXT ENDIF Tone(1000,9) RETURN .T. FUNCTION DATEN_Restore() LOCAL aName := {}, i, cAltName := " ", nDrive LOCAL cNetverX := "C:\HDBE_BAK\" + DtoS(date()) + "\" //*14.07.2008 08:13 CLOSE ALL // vorsichtshalber ! IF ConfirmBox( oBEDA, ; "Sollen WIRKLICH die Daten des letzten"+CRLF+ ; "Backups restauriert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Original-Daten sichern, aber nur ein Backup pro Tag : IF !FExists(cDatver+DtoS(DATE()),"D") // Backup-Verzeichnis erzeugen mit heutigem Datum als Name: RunShell( "/C MD "+cDatver+DtoS(DATE()) ) // Backup der Dateien: @ 10,5 SAY "Daten werden zuerst gesichert..." FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) COPY FILE (cDatver+aName[i]) TO (cDatver+DtoS(DATE())+"\"+aName[i]) ENDIF NEXT ENDIF //* letztes Backup-Verzeichnis ermitteln: DO WHILE !FExists( SubStr(cNetverX,1,Len(cNetverx)-1), "D" ) // == "C:\HDBE_BAK\" + DtoS(date()) IF Year(DATE()) > Val(SubStr(cNetverX,13,4)) .AND. ConfirmBox( oBEDA, ; "Soll weitergesucht werden?", ; "Kein Backup gefunden!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird restored ENDIF cNetverX := "C:\HDBE_BAK\" + DtoS(date()-1) +"\" ENDDO //////// Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen //////// Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung ////// 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: ////// cNetverX := Chr(nDrive)+":\HDBE_BAK\" ////// EXIT ////// ENDIF ////// ENDIF ////// NEXT //////// Abfrage, wenn kein USB-Stick gefunden wurde: ////// IF Asc(Upper(cNetverX[1])) < 68 .AND. ConfirmBox( oBEDA, ; ////// "Soll vom Verzeichnis:"+CRLF+ ; ////// cNetverX+" kopiert werden?", ; ////// "Kein USB-Stick!?", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_NO ////// RETURN .F. // nichts wird kopiert ////// ELSE ////// IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; ////// "Soll WIRKLICH vom Verzeichnis:"+CRLF+ ; ////// cNetverX+" kopiert werden?", ; ////// "Achtung :", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_NO ////// RETURN .F. // nichts wird kopiert ////// ENDIF ////// ENDIF //////// vom Stick in das cDatver kopieren: ////// @ 10,5 SAY "Daten werden kopiert... " FOR i := 1 TO Len(aName) IF FExists( cNetver+aName[i] ) COPY FILE (cNetverX+aName[i]) TO (cDatver+aName[i]) ENDIF NEXT ENDIF MsgBox("Im Verzeichnis "+cDatver+DtoS(DATE())+" wurde vorher eine Sicherung angelegt!", ; "Daten aus Backup restauriert!") Tone(1000,9) RETURN .T.