//bestp7.prg/////////////////////////////////////////////////////////////////// // 06.11.2005 Auftrnr statt 6 jetzt 7-stellig bei MengX // 06.11.2005: E ersetzt 6: aus StrX(1->auftrnr,6,0) wird StrX(1->auftrnr,E,0) #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Font.ch" #include "dmlb.ch" #include "Set.ch" #include "Dmlb.ch" #include "Directry.ch" //23.05.2007 12:44 fr Email #include "Common.ch" #include "Thread.ch" //xbeP_User = 134217728 //+vorl„ufig mal: #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 #define xbeU_CalcReturn xbeP_User + 11 #define xbeU_RefreshCalc xbeP_User + 12 #define xbeDS_DirChanged xbeP_User + 100 #define xbeFS_FileMarked xbeP_User + 101 #define xbeFS_FileSelected xbeP_User + 102 //////FUNCTION Test( aOldSize, aNewSize, self ) ////// IF Abs(aOldSize[1]-aNewSize[1])>1 .OR. Abs(aOldSize[2]-aNewSize[2])>1 ////// nH := nH*aNewSize[1]/aOldSize[1] ////// nV := nV*(aNewSize[2])/(aOldSize[2]) ////// cV:= "12" ////// PostAppEvent( 1048632 ) ////// ENDIF //////RETURN .T. PROCEDURE bestp( cTitel, cS_b ) LOCAL nEvent, mp1, mp2, aFelder := {}, ID_SLE_PRIMKEY := 1 LOCAL oDlg, oXbp, oHelp 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 } } // tats„chliche Bildschirmaufl”sung: nV kommt seit 27.2.2004 aus EUROV //06.04.2008 10:06 geREMt: // LOCAL aSizeDesktop := AppDesktop():currentSize() // LOCAL nBSb := nH*800 //aSizeDesktop[1] // LOCAL nBSh := nV*600 //aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung //06.04.2008 09:59 LOCAL nW := nBSh/600 wird eh' nicht gebraucht... 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 //06.04.2008 10:05 LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 // LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 // // LOCAL cDeko, aDeko, bAction, cSTATUS, aSTATUS // fr die ComboBox LOCAL cVerst0 := cVerst1 := cVerst2 := cVerst3 := Trim(" ") LOCAL oBestMenu := SetAppFocus() LOCAL aPos := {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 := 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 // oBest ist jetzt Public 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 TO5, TO6, TD5, TD6, TZ5, TZ6 //+01.03.2009 11:57 fr TDZ 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, EHHD, EHHO //+02.05.2009 11:06 PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9 //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 cPR1 := cPR2 := cPR3 := "" //+13.10.2008 16:29 fr Postrentenformular DEFAULT cS_b TO "s_best" cProgTyp := "n" // 14.09.2005 fr alle F„lle ErrorBlock( {|e| FehlerBehandlung(e) } ) // e = Error-Objekt //28.02.2008 18:52///////////////////////////////////////////////////////////////// // aZugang-Felder (fest gesetzt in AppName.prg): // 1: Bestatungsf„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("Bestattungsf„lle bearbeiten"), ; "Bestattungsf„lle bearbeiten"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN ENDIF /////////////////////////////////////////////////////////////////////////////////// DO WHILE cV == " " // cV!=" " zum Umschalten der Filiale/des Mandanten IF IsFieldVar("perskz") // mal sehen, ob man das beim Verlassen SELECT 4 // auf arb.dbf umswitchen muss... DbUseArea( , "FOXCDX", "Personen" ) // OrdListAdd( "Personen" ) // SELECT 1 // ENDIF //////// cDatver mit einbauen, da FExists() wie FErase() eine Low-Level-Funktion ist! : ////// IF !FExists( cDatver+"s_best.dbf" ) .AND. FExists( cDatver+"s_.tak" ) .AND. ; ////// FExists( cDatver+"bl_.tak" ) ////// IF ConfirmBox( SetAppWindow(), "Abbrechen mit ", ; ////// "Screen/Blatt-Dateien erzeugen?", ; ////// XBPMB_YESNO, ; ////// XBPMB_WARNING, ; ////// XBPMB_DEFBUTTON2 ) ; ////// = XBPMB_RET_YES ////// TXT_zu_DBF() // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ////// ELSE ////// RETURN ////// ENDIF ////// ELSEIF !FExists( cDatver+"s_best.dbf" ) ////// ModalFen( "Bildschirmbeschreibung fehlt! ; " + ; ////// "(Dateiname: s_.tak oder s_best.dbf) ; " + ; ////// "Das Programm wird abgebrochen! ", ; ////// "A C H T U N G !", ; ////// SetAppWindow() ) ////// RETURN ////// ENDIF IF Upper(AppName())$"BERGX.EXE" cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma + ; IIf(cDatver[1]$"DEFGHIJK"," >>>>>>>> DIREKT AUF DEM USB-STICK <<<<<<<<","") cAdrBM := IIf(Upper(Trim(cDatver))==Upper(Trim(cNetver)), "x", " ") //06.03.2007 12:15 ENDIF IF !Upper(AppName()) $ "BRAUCKX.EXE" .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" .OR. Upper(AppName())$"BLEINX.EXE" //+22.08.2008 15:03 Bleines ! IF cSerieBM == "N" aPos := {5 ,30 } //06.04.2008 19:20 aSize := {790*4/3*nV,520*nV+50} //06.04.2008 19:20 27.04.2008 22:28 ELSE aPos := {5 ,30 } //06.04.2008 19:20 aSize := {790*nH,520*nV+50} //06.04.2008 19:20 27.04.2008 22:28 ENDIF ELSE // aPos := {5*IIf(nH<1,1,nH),30*IIf(nV<1,1,nV)} // aSize := {790*nH,570*nV+IIf(nV<1,50-nV*50,0)} // aPos := IIf(nBestS1!=0,{Max(nBestP1,0*nH),Max(nBestP2,20*nV)},{5*IIf(nH<1,1,nH),30*IIf(nV<1,1,nV)}) //12.04.2008 17:24 aPos := IIf(nBestS1!=0,{Max(nBestP1,0*nH),Max(nBestP2,20*nV)},{5,30}) //12.04.2008 17:24 aSize := IIf(nBestS1!=0,{Min(nBestS1,AppDeskTop():currentsize()[1]), ; Min(nBestS2,(AppDeskTop():currentsize()[2]-30))}, ; {790*nH,520*nV+50}) //13.04.2008 18:52 ////// {790*nH,570*nV+IIf(nV<1,50-nV*50,0)}) //13.04.2008 18:52 // aPos := IIf(nBestS1!=0,{nBestP1,nBestP2},{5*IIf(nH<1,1,nH),30*IIf(nV<1,1,nV)}) //12.04.2008 17:24 // aSize := IIf(nBestS1!=0,{nBestS1,nBestS2},{790*nH,570*nV+IIf(nV<1,50-nV*50,0)}) //12.04.2008 17:25 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 | Test( aOldSize, aNewSize, self ) } //06.04.2008 19:15 IF !Upper(AppName())$"BLEINX.EXE" 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 ENDIF /**/ oDlg:create() aThrdFenster[1] := oDlg //+28.09.2008 13:43 // 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 ) nBz := IIf(cS_b = "s_bes2", 24*nV, 25*nV ) //13.04.2008 16:36 // jetzt folgt die Erzeugung der Eingabefelder ////// oBest := BestFF():new( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, cS_b, -100, 599, 1 ) oBest := BestFF():new( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 599, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 oEdit := oBest // wegen DialogFF:create(IsMemberVar) 14.4.2005 oEdit:cS_b := cS_b //10.10.2006 22:27 zum Umschalten der 'Skins' ////// oBest:CREATE( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, cS_b, -100, 599, 1 ) oBest:CREATE( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 599, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 AEval( oBest:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oBest:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder IF !Upper(AppName())$"SCHIERX.EXE" oDlg:childFromName( 1->(FieldPos( "auftrnr" )) ):disable() ENDIF oEdit:SubMenu[1]:checkItem(1,!oEdit:Sperre) nBz := nB //24.04.2007 09:21 hier wird testhalber der Zeilenschritt zurckgesetzt //------------------------------------------ SetAppWindow(oDlg) // eventuell aktivieren, wenn HauptAnwendungsfenster SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oDlg:setModalState( XBP_DISP_APPMODAL ) // SetTimerEvent(100, {|| DispOutAt(10,10, Time()) } ) // klappt so nicht... 15.4.2005 /* * oBestMaske:aData1 := SatzGetBest() // fr die Ver„nderungsabfrage (sp„ter mal..) */ // 15.4.2005: oCtrl:= wurde direkt vor den EventLoop verschoben (ohne Wirkung) //------------------------------------------ // das Ende des Hauptprogramms: * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) oHelp:start() // oDlg:childFromName( 1->(FieldPos( "name" )) ):setInputFocus() IF "MENG"$Upper(AppName()) IF cSystem == "S" ////// X:=StrZero(Year(date())-2001,2) // Vorjahr ////// Y:=StrZero(Year(date())-2000,2) // laufendes Jahr ////// oBest:Lupe( {1,2,3},cTop:="22"+X+"000" ,cBot:="22"+Y+"999" ) // Scope fr Stadtgesch„ft oBest:Lupe( {1,2,3},cTop:="0000000" ,cBot:="0999999" ) // Scope fr Stadtgesch„ft ENDIF FIND &cPubAuf IF Eof() GO BOTTOM ENDIF ENDIF oCtrl := XbpGetController():new( oDlg ) // seit 15.4.2005 direkt vor dem EventLoop oCtrl:create() oCtrl:LastXbp := oBest:XbpObjekt( oBest:singleZeile,"name") oCtrl:READ( Val(oBest:StartFocus), .F. ) // in der s_best unter ZAHL_FORM z.B. "F4" // SetAppEvent( xbeK_F2, {|mp1,mp2,oXbp| Tone(1000) } ) IF Upper(AppName())$"HANELX.EXE" SetAppEvent( xbeK_F3, {|mp1,mp2,oxbp,c| c:=ORTohnePLZ(cStadt),oXbp:setData(c) } ) ENDIF 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) IF IsMemberVar(oBest,"TabSeite") oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,DUM2),&DUM3) oBest:Letzte30(oBest:XbpObjekt(oBest:TabSeite,DUM2),StrX( IIf("RNERX"$Upper(AppName()), ; 100001,Val(cPubAuf)),E),"",{435,235}) //23.11.2007 18:18 ELSE oBest:TabMax(oBest:XbpObjekt(oBest:BEArea,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 ENDIF IF SetAppWindow():IsDerivedFrom("XbpCrt") .AND. SetAppWindow():ysize > 100 IF !Upper(AppName())$"BUCKX.EXE-BLEINX.EXE" //27.04.2008 22:18 SetAppWindow():configure(,,,0,0) // 07.04.2008 18:58 oCRT-Fenster klein machen ENDIF ENDIF DbSkip(0) // damit er ein Notify macht 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 oXbp == oBest:oVorDlg oBest:oVorDlg:destroy() nEvent := xbe_None LOOP ELSEIF Empty(mp1) y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) nEvent := 0 LOOP ENDIF ELSE // wenn Abbruch durch AppQuit, dann mp1!=NIL ENDIF ENDIF // IF nEvent == xbeM_LbDown // oDlg:lbIsDown := .T. // ENDIF // IF nEvent == xbeM_LbUp .OR. nEvent == xbeM_LbClick // oDlg:lbIsDown := .F. // ENDIF IF nEvent == xbeLB_ItemSelected .AND. oXbp:cargo!=NIL .AND. Upper(oXbp:cargo)$"NEUERFALL-FALLKOPIE-FALLSUCHE-FELDSUCHE" //+26.09.2008 20:12 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cStringS := LTrim( oBest:singleZeile[y]:getData() ) SetAppFocus(oBest:singleZeile[y]) y := oBest:XbpNummer( oBest:DruckKnopf, "suche Nr." ) PostAppEvent( xbeP_Activate,,, oBest:DruckKnopf[y] ) ENDIF IF nEvent == xbeLB_ItemMarked .AND. oXbp:cargo!=NIL .AND. Upper(oXbp:cargo)$"NEUERFALL-FALLKOPIE-FALLSUCHE-FELDSUCHE" //+26.09.2008 20:12 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( SubStr( cItem, 1, At( "-", cItem )-1 ) ) cStringS := oBest:singleZeile[y]:getData() SetAppFocus(oBest:singleZeile[y]) ENDIF IF nEvent == xbeP_Keyboard IF oBest:cTipTime < Time("") oBest:killTip() ENDIF 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 ValType(oXbp:cargo)=="C" .AND. 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 // IF mp1 == xbeK_RETURN // 04.08.2004 // oBest:killTip() // ENDIF // Buchstaben-Tastaturen wirken nur, wenn der Auftrag als editierbar markiert ist: IF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. ValType(oXbp:cargo)=="C" .AND. oXbp:cargo != "cString" .AND. oEdit:Sperre == .T. ; .AND. !oBest:EditAuftragnr == 1->auftrnr ; .AND. !oBest:EditAuftragnr > Val(Replicate("9",E)) // 30.07.2007 14:15 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Auftragsdaten eingeben/„ndern?"), ; "Auftragsdaten eingeben/„ndern?"), ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES oBest:EditAuftragnr := 1->auftrnr mp1 := 0 //02.07.2006 11:47 ELSE LOOP ENDIF ELSEIF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. ValType(oXbp:cargo) == "C" .AND. oXbp:cargo != "cString" .AND. ; oBest:EditAuftragnr > Val(Replicate("9",E)) //+27.10.2008 18:41 MsgBox("Dieser Auftrag wird bereits bearbeitet von "+1->benutzer+" !") LOOP ENDIF DO CASE // CASE mp1 == xbeK_RETURN .AND. oXbp == oSleSuch // SetAppFocus( oDlg:childFromName( 1->(FieldPos( "name" )) ) ) // LOOP CASE mp1 != xbeK_ESC .AND. mp1 != xbeK_F10 .AND. mp1 = xbeK_TAB ; .AND. oXbp:isDerivedFrom( "XbpMle" ) oXbp:KEYBOARD( mp1 ) LOOP CASE mp1 == xbeK_ESC .or. mp1 == xbeK_F10 IF ValType(oVideo) == "O" oVideo:stop() // oVideo:cargo:setModalState( XBP_DISP_MODELESS ) oVideo:cargo:destroy() oVideo := NIL mp1 := 0 SetAppFocus( oFocSLE ) LOOP ENDIF y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) LOOP ENDIF CASE mp1 == xbeK_ALT_D .OR. mp1 == xbeK_CTRL_D cAuf := strX( Auftrnr,E,0 ) BlattDRG( "Bl_b",, oBEDA,,, "P", "O", @nAnz, @nt ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_F11 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Screen/Blatt-Dateien erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES TXT_zu_DBF("i") // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ENDIF CASE mp1 == xbeK_ALT_F12 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Summen in Best-Datei erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES SummenSetzen() // (in Bestf7): setzt die RechBetr + Summen in der Best.dbf ENDIF CASE mp1 == xbeK_ALT_F7 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; IIf(SET(43)==0,ConvToAnsiCP("Rechnungsnummern l”schen?"), ; "Rechnungsnummern l”schen?"), ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) DO CASE CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnr") 1->rechnr := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn") 1->rechnrn := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn2") 1->rechnrn2 := "" CASE oXbp == oBest:XbpObjekt(oBest:singleZeile,"rechnrn3") 1->rechnrn3 := "" OTHERWISE 1->rechnr := "" 1->rechnrn := "" 1->rechnrn2 := "" 1->rechnrn3 := "" ENDCASE 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_ALT_F8 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Rechnungsnummern 1234-setzen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) 1->rechnr := IIf(Empty(1->rechnr),"1",1->rechnr) 1->rechnrn := IIf(Empty(1->rechnrn),"2",1->rechnrn) 1->rechnrn2 := IIf(Empty(1->rechnrn2),"3",1->rechnrn2) 1->rechnrn3 := IIf(Empty(1->rechnrn3),"4",1->rechnrn3) 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_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+"mwstdat", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; > "4" y := oBest:XbpNummer(oBest:singleZeile,"AUFTRDAT") z := Len(oBest:singleZeile)-y // ::XbpNummer(::singleZeile,"PvSALDO") AEval( oBest:singleZeile, {|a,i| a:enable() }, y, z-y ) oBest:XbpObjekt(oBest:multiZeile,"NOTIZ",.F.):enable() //03.03.2008 14:24 oBest:XbpObjekt(oBest:multiZeile,"notiz",.F.):enable() //03.03.2008 14:24 oBest:XbpObjekt(oBest:multiZeile,"PvNOTIZ"):enable() IIf(lLogBook,oBest:TLog:write():writeLogFile(),) //16.09.2007 22:27 ENDIF // 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_F3 .AND. Upper(AppName())$"MUELLX.EXE-BLEINX.EXE" //+28.09.2008 13:45 oBest:oCalcThrd := ThrdShll():new(3) oBest:oCalcThrd:start( , oBest:BEArea[1] ) oBest:oCalcThrd:setInterval(10) // calculator(oCB) // CASE mp1 == xbeK_CTRL_F2 .AND. Upper(AppName())$"MUELLX.EXE-BLEINX.EXE-SCHIERX.EXE" //+28.09.2008 13:45 // //+ geht zuerst in die METHOD ::Scannen !! (in diesem PRG-File) // oBest:Scannen( StrX(1->auftrnr,6), {0,0}, {300*nHur,400*nVur},, 300, 399 ) // SetAppFocus( oFocSle ) // LOOP CASE mp1 == xbeK_F2 .AND. Upper(AppName())$"MUELLX.EXE-BLEINX.EXE-SCHIERX.EXE-KREMERX.EXE-HANELX.EXE-RAGUSEX.EXE-NOLTEX.EXE-TDX.EXE" //+10.01.2009 23:04 //+ geht zuerst in die METHOD ::Scannen !! (in diesem PRG-File) oBest:Scannen( StrX(1->auftrnr,6), {0,0}, {300*nHur,400*nVur} ) SetAppFocus( oFocSle ) LOOP CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1.rtf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) // ModalFen( "rTfMlE-TEST", "rTf-mLe", oBEDA, , , "tag_char.htm" ) //+ interessant und vielleicht ganz wichtig: <<=======<<======= ////+27.09.2008 17:22 aus der NewsGroup: zeigt eine Datei mit dem Browser: // file2open := "url.dll,FileProtocolHandler " + "c:\bestatt\muellx\" + "INDEX.html" // SetAppWindow(oDlg) // RunShell( file2open, "Rundll32.exe" ) // //+ oder: WinApiOpen( file2open ) ...aus der PrinterAPI von Phil Ide //++// SetAppFocus( oFocSle ) LOOP 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_L LeistungSammeln() // sammelt alle berechneten Leistungen in artsamm.dbf CASE mp1 == xbeK_ALT_U // macht die bl_r... fr die šbungsrechnung COPY FILE (cDatver+"bl_r.dbf") TO (cDatver+"bl_rU.dbf") COPY FILE (cDatver+"bl_rp.dbf") TO (cDatver+"bl_rUp.dbf") SELECT 29 USE bl_rU EXCLUSIVE REPLACE ALL fname WITH "bl_rU" USE bl_rUp EXCLUSIVE REPLACE ALL fname WITH "bl_rUp" USE COPY FILE (cDatver+"bl_rh.dbf") TO (cDatver+"bl_rhU.dbf") COPY FILE (cDatver+"bl_rhp.dbf") TO (cDatver+"bl_rhUp.dbf") SELECT 29 USE bl_rhU EXCLUSIVE REPLACE ALL fname WITH "bl_rhU" USE bl_rhUp EXCLUSIVE REPLACE ALL fname WITH "bl_rhUp" USE SELECT 1 CASE mp1 == xbeK_ALT_X oDlg:writeData() REH := "RechEingabe(StrX(1->auftrnr,E,0),oBEDA,nFontR,[bl_rU],,{10,30*nV},{790*nH,550*nV})" // šbungsrechnung REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Y .AND. "RAGUSE"$Upper(AppName()) oDlg:writeData() REH := "RechEingabe(StrX(1->auftrnr,E,0),oBEDA,nFontR,[bl_rhU],,{10,30*nV},{790*nH,550*nV})" // šbungsHandelsrechnung REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Z // holt alle ::editcontrols als Mehrzeiler-Text in die Zwischenablage cBuffer := Trim( " " ) FOR i := 1 TO Len( oBest:editControls ) xWert := oBest:editControls[i]:getData() xWert := IIf(ValType(xWert)="N",Str(xWert),IIf(ValType(xWert)="D",DtoC(xWert),xWert)) cBuffer := cBuffer + Chr(13)+Chr(10)+xWert NEXT oClipBoard := XbpClipBoard():new():create() oClipboard:open() oClipboard:setbuffer( cBuffer ) oClipboard:close() oClipboard:destroy() CASE mp1 == Asc("+") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; 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 //+ Calculator wurde beendet: IF nEvent == xbeU_CalcReturn //+ xbeP_User + 11 //+ bisher noch keine Aktion an dieser Stelle ! oFocsle:setData( mp1 ) SetAppFocus(oFocSle) //+ PLZ/Ort wurde gesucht: in SLE einsetzen (steht in oBest:aI1, beim Aufrufen von PLC() gesetzt) ELSEIF nEvent == xbeU_RefreshPLZ IF mp1 != NIL Satzsp(oCB) oBest:aI1[1]:setData(mp1[1]) oBest:aI1[2]:setData(mp1[2]) // oBest:XbpObjektSet(,oBest:aI1[3],mp1[3]) // wrde gebraucht bei separatem PLZ-Feld oBest:aI1[1]:getData() oBest:aI1[2]:getData() // oBest:XbpObjektGet(,oBest:aI1[3]) DbRUnlock() ENDIF oBest:oPLZThrd := NIL //+ fr alle F„lle SetAppFocus(oFocSle) //+21.07.2008 20:31 fr DirSelector+FileSelector: ELSEIF nEvent == xbeDS_DirChanged oBest:oFiles:setFilesTo( mp1 ) //+21.07.2008 20:32 fr Grafik-Vorschau: ELSEIF nEvent == xbeFS_FileMarked oBest:oView:load( mp1 ) oBest:oView:display() P_aFileMark := oBest:oFiles:FileList:getData() //+31.07.2008 16:08 P_aFileExt := oBest:oFiles:ExtList:getData() //+31.07.2008 16:08 ELSEIF nEvent == xbeFS_FileSelected ////////////// oBest:ABDrucken(oBest:BEArea[6],"A" ,,,"bl_grb2" ) //+ normaler EventHandler: ELSE oXbp:handleEvent( nEvent, mp1, mp2 ) ENDIF ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) IF 4->(Alias()) == "PERSONEN" oBest:SwapPers("S") ENDIF BestGeaendert() __SETFUNCTION( 9, StrX( 1->AUFTRNR,E,0 ) ) cPubAuf := StrX( 1->auftrnr,E,0 ) SELECT 20 USE mwstdat // in c:\hdbe Satzsp(oDlg) 20->pubauf := cPubAuf USE (cDatver+"mwstdat") //23.03.2008 13:15 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 20->(IsFieldVar("bestP1_0")) //23.03.2008 11:49 speichert zuletzt eingestellten BenutzerFont 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 USE 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 IF Upper(AppName()) == "DISCHX.EXE" // Trckng( 1, RecNo(), oBest:aData1, cV, oBest:aData2 ) // Tracking nur bei KSOx, Dischx ENDIF 1->(DbRUnlock()) oHelp:terminate() IF Val(cV) > 0 // ”ffnet einen anderen Satz Dateien (siehe eurov) IF cV="1" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Sonne"$cFirma cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma ELSEIF cV="2" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Tier"$cFirma2 cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma2 ENDIF IF Val(cV)<5 DatVerUm(Val(cV)) // hier wird in ein anderes Arbeitsverzeichnis umgeschaltet ELSEIF "."$cV // ...aber gr”áer als 5 (fr BergX-Filialenumschaltung DO CASE CASE Val(cV) = 5 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 5 .AND. Val(cV) < 6 // 06.03.2007 10:11 fr BergX n := (Val(cV)-5)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 6 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 6 .AND. Val(cV) < 7 // 25.02.2007 19:39 fr BergX n := (Val(cV)-6)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 7 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 7 .AND. Val(cV) < 8 // 06.03.2007 10:11 fr BergX n := (Val(cV)-7)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 8 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 8 .AND. Val(cV) < 9 // 25.02.2007 19:39 fr BergX n := (Val(cV)-8)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 9.1 // zurckstellen auf 'Arbeiten auf dem PC/Server' USE mwstdat EXCLUSIVE cDatver := mwstdat->netver SET DEFAULT TO &cDatver mwstdat->datver := cDatver[1] + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDatver[1] + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDatver[1] + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDatver[1] + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDatver[1] + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDatver[1] + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDatver[1] + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDatver[1] + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDatver[1] + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDatver[1] + SubStr(mwstdat->netver9,2) USE DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.2 // umstellen auf 'Arbeiten auf dem USB-Stick' mit Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert das USB-Laufwerk IF cDrive$"DEFGHIJK" FOR n := 1 TO 9 // kopiert notwendige Programmdateien in die Stickverzeichnisse @ 3,5 SAY "Ich bereite den USB-Stick fr die Arbeit vor....."+Str(n,1) COPY FILE (cDatver+"bl_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.tak") COPY FILE (cDatver+"bl_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.sdf") COPY FILE (cDatver+"bl_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_dir.dbf") COPY FILE (cDatver+"xBlFName.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xBlFName.ntx") COPY FILE (cDatver+"s_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.tak") COPY FILE (cDatver+"s_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.sdf") COPY FILE (cDatver+"s_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_dir.dbf") COPY FILE (cDatver+"xFldPos.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xFldPos.ntx") COPY FILE (cDatver+"hilfetip.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"hilfetip.dbf") COPY FILE (cDatver+"xHTip.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xHTip.ntx") COPY FILE (cDatver+"FExport.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"FExport.dbf") COPY FILE (cDatver+"dateien1.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.tak") COPY FILE (cDatver+"dateien1.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.sdf") COPY FILE (cDatver+"dateien2.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.tak") COPY FILE (cDatver+"dateien2.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.sdf") NEXT cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE mwstdat EXCLUSIVE // „ndert die c:\hdbe\mwstdat auf das Stick-Laufwerk mwstdat->datver := cDrive + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDrive + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDrive + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDrive + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDrive + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDrive + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDrive + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDrive + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDrive + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDrive + SubStr(mwstdat->netver9,2) USE cDummyD := cDatver FOR n := 1 TO 9 // macht in allen Stick-Verzeichnissen einen Prflauf CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden indiziert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver ineux(.F.) NEXT cDatver := cDummyD SET DEFAULT TO &cDatver ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.3 // umstellen auf 'Arbeiten auf dem USB-Stick' ohne Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert ds Stick-Laufwerk IF cDrive$"DEFGHIJK" // kopiert keine Prog-Dateien + kein Prflauf cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE mwstdat EXCLUSIVE // „ndert die c:\hdbe\mwstdat auf das Stick-Laufwerk mwstdat->datver := cDrive + SubStr(mwstdat->datver,2) mwstdat->netver1 := cDrive + SubStr(mwstdat->netver1,2) mwstdat->netver2 := cDrive + SubStr(mwstdat->netver2,2) mwstdat->netver3 := cDrive + SubStr(mwstdat->netver3,2) mwstdat->netver4 := cDrive + SubStr(mwstdat->netver4,2) mwstdat->netver5 := cDrive + SubStr(mwstdat->netver5,2) mwstdat->netver6 := cDrive + SubStr(mwstdat->netver6,2) mwstdat->netver7 := cDrive + SubStr(mwstdat->netver7,2) mwstdat->netver8 := cDrive + SubStr(mwstdat->netver8,2) mwstdat->netver9 := cDrive + SubStr(mwstdat->netver9,2) USE ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.5 // kopieren in das Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.55 // kopieren in das Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.6 // kopieren vom Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.66 // kopieren vom Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.9 // Prflauf dieser Filiale DbCloseAll() ineux(.F.) DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10,, cDatver ) //+25.11.2008 18:37 cDatver ENDCASE ELSE DO CASE CASE cV == "5" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Stick() CASE cV == "6" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Stick() ineux(.F.) CASE cV == "7" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server() CASE cV == "8" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server() ineux(.F.) CASE cV == "9" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server(,"\HDBDIENST") CASE cV == "10" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server(,"\HDBDIENST") ineux(.F.) CASE cV == "11" cS_b := "s_best" CASE cV == "12" cS_b := "s_bes2" CASE cV == "22" Backup_zum_NotServer("L:") ENDCASE DatVerUm(IIf(Upper(cDatver)=="C:\HDBE\",0,1), cS_b!=cVur, cDatver ) //+25.11.2008 18:34 cDatver ENDIF cV := " " ENDIF ENDDO // oHelp:terminate() 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+ ; // "in Thread: "+LTrim(Str(oError:thread)) +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,"")+; // IIf( !Empty(ProcName(8)), ProcName(8)+"("+LTrim(Str(ProcLine(8)))+")"+CRLF,"")+; // IIf( !Empty(ProcName(9)), ProcName(9)+"("+LTrim(Str(ProcLine(9)))+")"+CRLF,"")+; // IIf( !Empty(ProcName(10)), ProcName(10)+"("+LTrim(Str(ProcLine(10)))+")"+CRLF,"")+; // "Wiederholen mit , Datenretten + Ende mit " // IF oError:severity > 1 // IF ConfirmBox( AppDeskTop(), ; // 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 FehlerBehandlung(oError) LOCAL oFenster := SetAppFocus() LOCAL cFehler := "Fehlerart: "+oError:description +";"+ ; "in Operation: "+oError:operation +";"+ ; IIf(!Empty(oError:filename), "Datei: "+oError:filename +";","") + ; "aufgerufen von:" +";"+ ; IIf( !Empty(ProcName(1)), ProcName(1)+"("+LTrim(Str(ProcLine(1)))+")"+";","")+; IIf( !Empty(ProcName(2)), ProcName(2)+"("+LTrim(Str(ProcLine(2)))+")"+";","")+; IIf( !Empty(ProcName(3)), ProcName(3)+"("+LTrim(Str(ProcLine(3)))+")"+";","")+; IIf( !Empty(ProcName(4)), ProcName(4)+"("+LTrim(Str(ProcLine(4)))+")"+";","")+; IIf( !Empty(ProcName(5)), ProcName(5)+"("+LTrim(Str(ProcLine(5)))+")"+";","")+; IIf( !Empty(ProcName(6)), ProcName(6)+"("+LTrim(Str(ProcLine(6)))+")"+";","")+; IIf( !Empty(ProcName(7)), ProcName(7)+"("+LTrim(Str(ProcLine(7)))+")"+";","") // "Wiederholen mit , Datenretten + Ende mit " IF oError:severity > 1 // DO WHILE !oFenster:isDerivedFrom("XbpIWindow") //+01.06.2009 16:31 // oFenster := oFenster:setParent() // IF oFenster = AppDeskTop(); EXIT; ENDIF // ENDDO // IF ConfirmBox( oFenster , ; //oCB, ; // cFehler, ; // "Ein Fehler ist aufgetreten!", ; // XBPMB_YESNO, ; // XBPMB_WARNING, ; // XBPMB_DEFBUTTON2 ) ; // = XBPMB_RET_NO IF AlertBox( , cFehler, ; { "Wiederholen mit ", "Datenretten + Ende mit " } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Ein Fehler ist aufgetreten!" ) = 2 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. //+ 06.10.2008 20:33 analog zu Clickdate(), aufgerufen durch Doppelclick auf numerisches Feld FUNCTION ClickCalc(oXbp) LOCAL oClipBoard, i, cValue := 0 LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. IF !Empty( oBest:oCalcThrd ) AEval( aInfo, {|a,i| IIf( a[1] == oBest:oCalcThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF //+ oXbp:value als DezimalZahl ins Clipboard schieben: IF ValType(oXbp:value) == "N" cValue := Str(oXbp:value) ELSEIF ValType(oXbp:value) == "C" cValue := oXbp:value FOR i:=1 TO Len(cValue) IF cValue[i]=="," cValue:=Stuff(cValue,i,1,".") ELSEIF !cValue[i]$"01234567890" cValue:=Stuff(cValue,i,1," ") ENDIF NEXT ENDIF oClipBoard := XbpClipBoard():new():create() oClipBoard:open() oClipBoard:setbuffer(cValue) oClipBoard:CLOSE() IF !lThreadIstAktiv oBest:oCalcThrd := ThrdShll():new(3) oBest:oCalcThrd:start( , oBest:BEArea[1] ) oBest:oCalcThrd:setInterval(10) ELSE //+ dabei ist aPos und aSize egal, weil das Fenster ja schon existiert! : PostAppEvent( xbeU_RefreshCalc, , , aThrdFenster[3] ) //* refresht die Suchtabelle ENDIF RETURN .T. //Calculator(oCB) //+ Calculator aufrufen //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: // von DialogFF geerbt: // VAR VArea // enth„lt die Area der best.dbf (=1) // VAR aStructure // enth„lt die Struktur der best.dbf // VAR aFelder // enth„lt alle Feldbezeichnungen der best.dbf // VAR aData1 // enth„lt alle Feldinhalte des augenblicklichen Datensatzes // VAR aData2 // // VAR aIndex // enth„lt die Namen der Indexdateien VAR SWT // SterbeWochentag VAR TW0 // Wochentag von Termin0 VAR TW1 // Wochentag von Termin1 VAR TW2 // VAR TW3 // VAR TW4 // VAR TW5 //+01.03.2009 11:58 fr TDX VAR TW6 //+ VAR Beis_Fried // Beisetzungsfriedhof == Test fr Mller VAR PvAUFTRNR // 3.5.2005 fr die Personen.dbf in Area 4 VAR PvPERSKZ VAR PvANREDE VAR PvNAME VAR PvVORNAME VAR PvGEBNAME VAR PvSTRASSE VAR PvPLZ_ORT VAR PvORTSTEIL VAR PvTELEFON VAR PvFAX VAR PvEMAIL VAR PvGEB_DAT VAR PvSTB_DAT VAR PvVERW_BEZ VAR PvRECH_NR VAR PvRECHBETR VAR PvRECH_EL VAR PvRECH_FL VAR PvRECH_DAT VAR PvEINGBETR VAR PvEING_DAT VAR PvEING_KTO //25.06.2007 17:32 VAR PvSALDO VAR PvGKZ VAR PvMUST_RG VAR PvBILD VAR PvNOTIZ VAR PvSUCH VAR aBP // Betreffperson, je nach TAB: Ansprechpartner/Ehepartner/Angeh”riger VAR EditAuftragnr // =aktuelle Auftrnr, wenn editierbar VAR Fall_geloescht // wenn .T. wird Listbox-Letzte30 neu gefllt VAR cS_b // = "s_best" (bei Flues auch "s_bes2") VAR TLog // TransaktionenLogbuch-Objekt VAR oScanThrd //+ das Thread-Objekt des Bild-Darstellungs-Programms 28.09.2008 14:04 VAR oCalcThrd //+ das Thread-Objekt des Calculators 08.10.2008 16:43 VAR oPLZThrd //+ das Thread-Objekt, das die PLZs sucht 14.10.2008 22:03 VAR oHistThrd //+ das Thread-Objekt fr die Kunden-Historie + Statistik-Diagramme 10.11.2008 09:03 METHOD INIT METHOD CREATE METHOD notify // managt z.B. ::PaintTip, ::WochenTag METHOD AuftragLoeschen // markiert den Auftrag 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 VerstSuche // 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 METHOD Scannen //+28.09.2008 13:38 2. Thread zum Scannen starten METHOD Historie //+10.11.2008 13:12 4. Thread fr Statistik/Grafik starten 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 := "" ::TW5 := "" ::TW6 := "" ::Beis_Fried := Space(30) ::PvAUFTRNR := 0000000 ::PvPERSKZ := "@" ::PvANREDE := "" ::PvNAME := "" ::PvVORNAME := "" ::PvGEBNAME := "" ::PvSTRASSE := "" ::PvPLZ_ORT := "" ::PvORTSTEIL:= "" ::PvTELEFON := "" ::PvFAX := "" ::PvEMAIL := "" ::PvGEB_DAT := CtoD("") ::PvSTB_DAT := CtoD("") ::PvVERW_BEZ:= "" ::PvRECH_NR := "" ::PvRECHBETR:= 0.00 ::PvRECH_EL := 0.00 ::PvRECH_FL := 0.00 ::PvRECH_DAT:= CtoD("") ::PvEINGBETR:= 0.00 ::PvEING_DAT:= CtoD("") ::PvEING_KTO:= "" //25.06.2007 17:32 ::PvSALDO := 0.00 ::PvGKZ := "" ::PvMUST_RG := "" ::PvBILD := "" ::PvNOTIZ := "" ::PvSuch := "" ::aStructure := 1->(DbStruct()) ::VArea := nA ::aIndex := { "Auftragsnummer", "Verstorbenen-Namen", ; "Ansprechpartner-Namen", "Verstorbenen-Straáe", cVariable } ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } //28.05.2007 15:45 ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::aFelder := {} // Array mit allen Feldnamen AEval( ::aStructure, {|a| AAdd( ::aFelder, a[1] ) } ) ::aData1 := {} // Array mit allen Feldinhalten, vor der Ver„nderung AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) ::aData2 := {} // Array mit allen Feldinhalten, nach der Ver„nderung ::EditAuftragnr := 0 // beim Start ist noch kein Auftrag editierbar IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := cBK) DbRUnlock() ::EditAuftragnr := 0 ELSEIF 1->benutzer != cBK ::EditAuftragnr := Val(Replicate("9",E))+1 ENDIF ENDIF ::Fall_geloescht := .F. // beim Start ist noch kein Auftrag gel”scht 26.06.2006 16:01 ::cS_b := "s_best" // s_best o.„. ::TLog := TLogWriter():new( "TLog.dbf" ) //16.09.2007 19:31 TXT-Datei zur Tarnung als .dbf RETURN self METHOD BestFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) // (nA)->(DbRegisterClient(self)) // reicht es, wenn das Fenster als Ganzes registriert ist?? RETURN self METHOD BestFF:notify( nEvent, mp1, mp2 ) LOCAL nRec, oFocus, cIndex, xIndex, i DbSuspendNotifications() IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_PROLOG // Skip wird starten AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData2, &c ) } ) // fr TT (sp„ter!?) IF 1->(IsFieldVar("perskz")) // A...Z - fr Rechnungen an angeh”rige Personen ::SwapPers("S") // 5.5.2005 Angeh”rigendaten auf Platte schreiben ENDIF // 30.07.2007 14:19 damit ein Benutzer den Auftrag automatisch wieder entsperrt: IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 ////////////////////////////////////////////////////////////////////////////////// IF Val(cRS) >= aZugang[4,Val(StrX(1->auftrnr,E)[1])+1] // 28.11.2007 12:53 wg Nummernkreis-abh„ngigem Zugang // ConfirmBox( oCB, "Sie haben dazu NICHT die Berechtigung!", ; // IIf(SET(43)==0,ConvToAnsiCP("Nummernkreis "+StrX(1->auftrnr,E)[1]), ; // "Nummernkreis "+StrX(1->auftrnr,E)[1]), ; // XBPMB_OK, ; // XBPMB_WARNING ) ASize( aZugang, 13 ) AAdd( aZugang, 1->(Recno()) ) // RETURN self ENDIF /////////////////////////////////////////////////////////////////////////////////// IF 1->benutzer == cBK Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") DbRUnlock() ENDIF ENDIF ENDIF // 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(StrX(1->auftrnr,E)[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 "+StrX(1->auftrnr,E)[1]), ; "Nummernkreis "+StrX(1->auftrnr,E)[1]), ; XBPMB_OK, ; XBPMB_WARNING ) DbResumeNotifications() RETURN self ENDIF /*29.03.2008 18:00 Verstorbener und Auftragnummer zum Weitergeben: */ // ThreadObject():cargo := {oBEDA:cargo,Trim(1->name)+", "+Trim(1->vorname)+" - "+StrX(1->auftrnr)} /*29.03.2008 18:32 „ndert den Fenster-Titel: */ // PRIVATE cT, aX, aY, oZ // aX := ThreadInfo(8,1) // IF ValType(aX)=="A" // aY := aX[1,1]:cargo // IF ValType(aY) == "A" // oZ := aY[1] // cT := oBEDA:cargo:title oBEDA:cargo:setTitle( Stuff( oBEDA:cargo:title, At("*",oBEDA:cargo:title), 100, "* "+Trim(1->name)+", "+Trim(1->vorname)+" - "+StrX(1->auftrnr) ) ) // ENDIF // ENDIF /**/ /**/ ::TabDaten(,,::aBP[7]) //01.09.2007 20:50 IF 1->(IsFieldVar("perskz")) IIf( 4->(DbScope()), 4->(DbClearScope()),) // 26.08.2005 vorsichtshalber 4->(DbSetScope( SCOPE_BOTH, StrX(1->auftrnr,E,0) )) // neuer Auftrag, neue Scope 4->(DbGotop()) // statt DbSetRelation DbSeek() nach dem zuletzt bei diesem Auftrag 'eingeloggten' Angeh”rigen: IIf(!Empty(1->perskz),4->(DbSeek(StrX(1->auftrnr,E,0)+1->perskz),.F.),4->(DbGobottom()) ) ::SwapPers("L") // 5.5.2005 Angeh”rigendaten einlesen ENDIF // 30.07.2007 14:19 damit ein Benutzer den Auftrag automatisch fr sich sperrt: IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := cBK) DbRUnlock() ::EditAuftragnr := 0 ELSEIF 1->benutzer != cBK ::EditAuftragnr := Val(Replicate("9",E))+1 ENDIF ENDIF AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) // wird in AC gebraucht! //14.09.2007 15:52 'gel”schte' Auftr„ge werden disabled: y := ::XbpNummer(::singleZeile,"AUFTRDAT") 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 ) ::XbpObjekt(::multiZeile,"NOTIZ",.F.):disable() ::XbpObjekt(::multiZeile,"notiz",.F.):disable() ELSE AEval( ::singleZeile, {|a,i| a:enable() }, y, z-y ) 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 // 07.11.2005 schaltet die Farben je nach Nummernkreis: IF Upper(AppName())$"BUCKX.EXE-MENGX.EXE-MUELLX.EXE-SINZIGX.EXE-BLEINX.EXE-KUELLX.EXE-FLUESX.EXE-KOMPAKTX.EXE-BERGX.EXE-RAGUSEX.EXE-SCHIERX.EXE-TDX.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(StrX(1->auftrnr,E,0)[1]) // 07.11.2005 Gruppenfarbe setzen ENDIF // aus AKDialogV entliehen: IF aC[S+1,1] >= 1000 .AND. IsMemberVar( ::BEArea[aBea[i]], "bitmap" ) ::BEArea[aBea[i]]:setColorFG( IIf( Int(aC[S+1,1]) != aC[S+1,1], ; IIf( Int(aC[S+1,1]*10)==aC[S+1,1]*10, ; (Int(aC[S+1,1]) - aC[S+1,1])*10,(Int(aC[S+1,1]) - aC[S+1,1])*100 ), ; GRA_CLR_BLACK ) ) ::BEArea[aBea[i]]:bitmap := Int( aC[S+1,1] ) ::BEArea[aBea[i]]:configure() ELSEIF (aC[S+1,1] > 0 .AND. aC[S+1,1] < 1000) .OR. Len(aC[S+1]) > 1 ::BEArea[aBea[i]]:setColorFG( IIf( Int(aC[S+1,1]) != aC[S+1,1], ; Int(aC[S+1,1]), GRA_CLR_BLACK ) ) ::BEArea[aBea[i]]:setColorBG( IIf( Int(aC[S+1,1])!=aC[S+1,1] .AND. Len(aC[S+1])=1, ; IIf( Int(aC[S+1,1]*10)==aC[S+1,1]*10, ; (Int(aC[S+1,1]) - aC[S+1,1])*10,(Int(aC[S+1,1]) - aC[S+1,1])*100 ), ; IIf( Len(aC[S+1]) > 1, GraMakeRGBColor( ; IIf( Int(aC[S+1,1]) != aC[S+1,1], ; AEval( aC[S+1], {|x,i|aC[S+1,i]:=(Int(aC[S+1,i]) - aC[S+1,i])*1000},1,1), ; aC[S+1] )), ; XBPSYSCLR_DIALOGBACKGROUND ) )) ELSE ::BEArea[aBea[i]]:setColorFG( GRA_CLR_BLACK ) ::BEArea[aBea[i]]:setColorBG( XBPSYSCLR_DIALOGBACKGROUND ) ENDIF NEXT ENDIF ENDIF ENDIF // Test fr MuellX: Beis_Fried als MemberVar -> verteilt auf ortgrab/urnewo, je nach best_art IF FRIED == "Beis_Fried" //26.12.2006 11:23 ::FriedEF() //03.12.2006 09:35 ENDIF IF Upper(AppName())$"MENGX.EXE" ::PaintTip( "Sortiert nach "+"ï"+::SuchFeld+"ï"+"." ; +" - Bereich: "+aVO[S+1], {215,570} ) // 10.2.2005 ELSEIF !Upper(AppName())$"BERGX.EXE" //15.02.2007 11:57 ::PaintTip( "Sortiert nach "+"ï"+::SuchFeld+"ï"+".", {215,565} ) // 19.12.2004 (aus:{20,550}) ENDIF ::WochenTag() // 14.4.2005 zeigt fr TD1-4 den Wochentag an DbResumeNotifications() RETURN self METHOD BestFF:AuftragLoeschen( lCodeWort ) //14.09.2007 16:20 LOCAL nAuf := 1->auftrnr 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("Gesamt-Auftrag Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?"), ; "Gesamt-Auftrag 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+"mwstdat", 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("Gesamt-Auftrag Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?"), ; "Gesamt-Auftrag 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 U F T R A G 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("Ehepartner „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 auftrnr=0 DELETE ENDIF IF lLupe ::Lupe({1,2,3}) // 12.11.2005 == Clear Scope ENDIF cAufalt := StrX( 1->auftrnr,E,0 ) DO WHILE .T. y := ::XbpNummer( ::SingleZeile, IIf(Empty(cKopie),"cStringN","cStringK") ) cAufneu := ::singleZeile[y]:getdata() //************IIf(cAuf... !!!!!! cAufneu := IIf( Val(cAufneu)>0, StrX(Val(cAufneu),E,0), cAufneu ) IF Empty( cAufneu) .OR. Val(cAufneu) = 0 .AND. Upper(cAufneu[1]) != "S" //01.09.2006 09:32 RETURN cTip := "Auftrag-Nr. eingeben:" ELSEIF Val(cAufneu) > Val(Replicate("9",E)) // 999999 cAuf := Space(E) RETURN cTip := "Zu lang! Neue Auftrag-Nr. :" ENDIF cAufneu := IIf( !Empty(cKopie), cKopie+cAufneu, cAufneu ) // "BS" wegen Bestattungsfall-Kopie und Vom-Stick-Einlesen: 01.09.2006 09:19 cAuf := IIf( Upper( Substr( cAufneu,1,1 ))$"BS", Substr( Padr(cAufneu,9),3,E), Padl(cAufneu,E )) cAuf := StrX(Val(cAuf),E,0) 1->(DbSeek( cAuf )) IF Found() .AND. VAL( cAuf ) > 0 cAuf := Space(E) RETURN cTip := "Schon belegt! Neue Auftrag-Nr. :" ELSEIF VAL( cAuf ) < Val(Replicate("9",E)) +1 // 1000000 EXIT ENDIF ENDDO // oBestMaske:aData1 := SatzGetBest() // 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->AUFTRNR WITH Val( cAuf ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF IF IsFieldVar("berater") // 20.04.2007 21:10 cBK := IIf(IsMemVar("cBK"),PadR(cBK,Len(1->berater)),Space(Len(1->berater))) 1->berater := cBK ENDIF IF IsFieldVar("todesurs") REPLACE todesurs with "natrlicher Tod" ENDIF IF IsFieldVar("RBrNe") REPLACE RBrNe with cBrNe1 //17.03.2007 17:48 Brutto/NettoRechnung (BergX) ENDIF REPLACE staatsan with "deutsch" IF FRIED == "Beis_Fried" ::Beis_Fried := "" ENDIF IF IsMemVar("cStadt") REPLACE plz_ort WITH cStadt REPLACE ansp_ort WITH cStadt REPLACE eh_ort WITH cStadt IF 1->(IsFieldVar("geb_in")) REPLACE geb_in WITH ORTohnePLZ(cStadt) ELSEIF 1->(IsFieldVar("gebin")) REPLACE gebin WITH ORTohnePLZ(cStadt) ENDIF // REPLACE verst_in WITH cStadt // heiát nicht berall gleich!!! ENDIF S := Val(StrX(1->auftrnr,E,0)[1]) IF 1->(IsFieldVar("ver_ort")) 1->ver_ort := aVO[S+1] ENDIF cTip := "Neue Auftrag-Nr.: "+cAuf+" angelegt." AEval( ::Listbox, {|lb| lb:CLEAR() } ) ELSEIF Upper( Substr( cAufneu,1,1 ) ) = "B" // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT // 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 /* 28.06.2008 14:11 bei Kopie auf aktuellen Sterbefall (=NichtVorsorgefall), Name mit * versehen: */ IF cAufneu[3] != "9" 1->name := "*"+SubStr(1->name,1,Len(1->name)-1) ENDIF /**/ 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->AUFTRNR WITH Val( Substr( Padr( cAufneu, E+2 ),3,E ) ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF IF 1->(IsFieldVar("rechnr")) IF ValType(1->rechnr)=="C" REPLACE 1->RECHNR WITH "" // 30.1.2004 REPLACE 1->RECHNRN WITH "" // damit neue Auftr„ge nicht schon alte Rg-Nrn haben REPLACE 1->RECHNRN2 WITH "" REPLACE 1->RECHNRN3 WITH "" ENDIF ENDIF // Versicherungsdaten und Rechnung des Quell-Falles kopieren? : IF ConfirmBox( oBEDA, "Abbrechen mit ", ; 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 METHOD BestFF:VerstSuche(cName,cVorname,dGebDatum) // zur Kontrolle, ob Verstorbener bereits in Datei enthalten LOCAL nOldOrder := OrdNumber() LOCAL nRec := Recno() LOCAL lUnique := .T. LOCAL cTitel IF !Empty( cName ) DbSuspendNotifications() OrdSetFocus( 2 ) 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+DtoS(dGebDatum)),.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 ) 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( oBEDA, 1->auftrnr, .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 ) LOCAL aStrings := {} LOCAL nRec := RecNo() LOCAL n := AScan( oDlg1:childlist(), {|x| x:isDerivedFrom("XbpListbox")} ) LOCAL nL := ::XbpNummer( ::ListBox, oDlg1:childlist()[n]:cargo ) LOCAL cItem := " " 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(StrX(field->auftrnr,E,0)[1]), DbSkip(-1), DbSkip(0) ) SELECT (nOldArea) RETURN self METHOD BestFF:Anschrift(nA) LOCAL aAdr DO CASE CASE nA = 5 aAdr := {5->name1,5->name2,5->strasse,5->plz_ort} CASE nA = 12 aAdr := {12->name1,12->name2,12->strasse,12->plz_ort} CASE nA = 4 aAdr := {4->P_ANREDE,Trim(4->P_VORNAME)+" "+4->P_NAME,4->P_STRASSE,4->P_PLZ_ORT} CASE nA = 99 //16.05.2007 22:35 fr 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 //+01.03.2009 11:59 fr TDX: IF IsFieldVar("&TD5") // wieso?? .AND. Upper(AppName())$cAc oBest:XbpObjekt( oBest:SingleZeile, "TW5" ):setData(::TW5:=CDoW(1->&TD5)) ENDIF //+01.03.2009 11:59 fr TDX: IF IsFieldVar("&TD6") // wieso?? .AND. Upper(AppName())$cAc oBest:XbpObjekt( oBest:SingleZeile, "TW6" ):setData(::TW6:=CDoW(1->&TD6)) ENDIF ENDIF RETURN self METHOD BestFF:Ordnen(cVar,cSuchArt) // cSuchArt:="F " wird per Referenz bergeben DEFAULT cVar TO "auftrnr" PRIVATE cVariable := cVar IF SELECT()=1 DO CASE CASE Upper(cVariable) == "AUFTRNR" cSuchArt := "" SET ORDER TO 1 CASE Upper(cVariable) == "NAME" cSuchArt := "V " SET ORDER TO 2 CASE Upper(cVariable) == "ANSP_NAME" cSuchArt := "A " SET ORDER TO 3 CASE Upper(cVariable) == "STRASSE" cSuchArt := "S " SET ORDER TO 4 OTHERWISE IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrX(Month(1->&cVariable),2,0)+ ; StrX(day(1->&cVariable),2,0) to x5 ELSEIF ValType(1->&cVariable) == "N" INDEX on Str(1->&cVariable) TO x5 ELSE INDEX on Upper(1->&cVariable) TO x5 ENDIF ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 SET ORDER TO 5 ENDCASE ELSEIF SELECT()=4 DO CASE CASE Upper(cVariable) == "P_NAME" OrdSetFocus("x2") ENDCASE ENDIF RETURN OrdNumber() // fr DischX: Kopieren vom Laptop in das Netzwerk //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 (mwstdat.dbf) // wenn richtige Filiale, den Fall in die bestehenden Dateien kopieren // wenn falsche Filiale, melden und NICHT kopieren. // Fall 2: Kopie eines Falles aus dem Email-Verzeichnis in die PC-Datein // -zuerst die Filiale feststellen, deren Fall-Daten im Email-Verzeichnis sind // -dann in die Filiale einloggen // -dann die Fall-Daten in die PC-Dateien reinkopieren ///////////////////////////////////////////////////////////////////////////////////////////// // Dateien/WorkAreas: // Area 1: best.dbf auf dem PC // Area 2: vv.dbf auf dem PC // Area 3: auftr.dbf auf dem PC // Area 21: best.dbf im Email-Verzeichnis // Area 22: vv.dbf im Email-Verzeichnis // Area 23: auftr.dbf im Email-Verzeichnis //Vorgang: zuerst in die Filiale gehen, in die/aus der kopiert werden soll // deren Daten-Verzeichnis auf dem PC ist cQuelle oder cZiel - je nachdem... METHOD BestFF:Email( cQuelle, cZiel ) //21.05.2007 22:35 LOCAL cAufalt, i, n, aDataV := {}, cVersTemp, cAufTemp, cTip, nOldArea := SELECT() LOCAL cEVerz := cDatver[1]+":\HDBE\EMAIL\" // im selben Laufwerk wie die PC-Dateien // Email-Verzeichnis l”schen: IF Empty(cZiel) AEval( Directory(cQuelle+"*.*"), { |a| FErase( cQuelle+a[1] ) } ) RETURN cTip := "Email-Verzeichnis gel”scht" ENDIF // sind bereits Daten im Email-Verzeichnis? IF FExists( cEVerz+"best.dbf" ) // stimmt die Filiale? SELECT 9 DbUseArea( ,,cEVerz+"mwstdat" ) // wenn die Filiale nicht stimmt: Abbbuch: IF Trim(9->bname) != cFirma ConfirmBox( oCB, ; "Es sind Daten von "+Trim(9->bname)+CRLF+ ; "im Email-Verzeichnis!", ; "Falsche Filiale!", ; XBPMB_OK, ; XBPMB_WARNING ) cTip := "Falsche Filiale: ("+Trim(9->bname)+") im Email-Verzeichnis!" DbCloseArea() SELECT (nOldArea) RETURN cTip ENDIF DbCloseArea() ELSE // wenn noch keine Daten im Email-Verzeichnis: IF !FExists(SubStr(cEVerz,1,Len(cEVerz)-1),"D") // Verzeichnis neu erstellen, wenn es noch nicht existiert: RunShell( "/C MD "+SubStr(cEVerz,1,Len(cEVerz)-1),, .T. ) Sleep(100) // damit Windows es bemerkt... ENDIF IF cZiel == cDatver // wenn aus dem Emailverzeichnis kopiert werden soll cTip := "Das Email-Verzeichnis ist leer." RETURN cTip // muss dort schon etwas sein!! Also abbrechen! ENDIF // Dateien im Email-Verzeichnis anlegen: SELECT 1 COPY stru TO (cEVerz+"best") SELECT 2 COPY stru TO (cEVerz+"vv") SELECT 3 COPY stru TO (cEVerz+"auftr") ENDIF // richtige Filiale festgestellt und Dateien existieren im Emailverzeichnis // // Dateien ”ffnen in 21,22,23: (ist das wirklich n”tig???, sie sind ja schon in 1,2,3 offen! IF cQuelle == cDatver // FallDaten kopieren in das Email-Verzeichnis SELECT 1 cAufalt := StrX( 1->auftrnr,E,0 ) // der aktuelle Quell-Auftrag (auf PC oder USBStick) // Quell-Bestattungsfall ist ja schon da... FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // liest die Quelle in ein Array ein NEXT // ...in das Zielverzeichnis kopieren SELECT 21 DbUseArea(,,cEVerz+"Best",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 21->auftrnr = Val(cAufalt) // berschreibt ggf. vorhandenen Fall... IF 21->(Eof()) 21->(DbAppend()) // ...oder h„ngt neuen Fall dran ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // schreibt Array in das Ziel NEXT DbCloseArea() // // Versicherungseintr„ge in den Ziel-Bestattungsfall kopieren: SELECT 22 DbUseArea(,,cEVerz+"VV",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 22->auftrnr = val(cAufalt) // gibt es den Fall schon im Emailverzeichnis? DO WHILE 22->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. vorhandene Eintr„ge 22->(SatzDelete()) DbSkip(0) ENDDO SELECT 2 aDataV := Array(FCount()) FIND &cAufalt // Quell-Versicherungseintr„ge suchen DO WHILE 2->auftrnr=val(cAufalt) .and. .not. Eof() FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 22 22->(DbAppend()) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zieldatei schreiben NEXT SELECT 2 SKIP ENDDO SELECT 22 PACK DbCloseArea() // // Rechnungsdaten in den Ziel-Bestattungsfall kopieren: SELECT 23 DbUseArea(,,cEVerz+"auftr",,.F.) // ”ffnet Zieldatei exclusiv LOCATE FOR 23->auftrnr = val(cAufalt) // gibt es den Fall schon im Emailverzeichnis? DO WHILE 23->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. vorhandene Eintr„ge 23->(SatzDelete()) DbSkip(0) ENDDO SELECT 3 aDataV := Array(FCount()) FIND &cAufalt // Quell-Versicherungseintr„ge suchen DO WHILE 3->auftrnr=val(cAufalt) .and. !Eof() FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 23 23->(DbAppend()) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zieldatei schreiben NEXT SELECT 3 SKIP ENDDO SELECT 23 PACK DbCloseArea() DbUseArea(,,cDatver+"mwstdat.dbf") COPY TO (cEVerz+"mwstdat") DbCloseArea() SELECT 1 cTip := "Auftrag ins Email-Verzeichnis kopiert." // ELSEIF cZiel == cDatver // Daten aus dem Emailverzeichnis ins cDatver reinkopieren i := 0 SELECT 1 aDataV := Array(FCount()) SELECT 23 DbUseArea(,,cEVerz+"auftr","a2") // Quelle ”ffnen SELECT 22 DbUseArea(,,cEVerz+"vv","v2") // Quelle ”ffnen SELECT 21 DbUseArea(,,cEVerz+"best","b2") // Quelle ”ffnen DO WHILE !Eof() cAufalt := StrX( 21->auftrnr,E,0 ) // der Quell-Auftrag (im Emailverzeichnis) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // liest die Quelle in ein Array ein NEXT // ...in das Zielverzeichnis kopieren SELECT 1 1->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) IF 1->(Eof()) 1->(DbAppend()) // ...oder h„ngt neuen Fall dran ENDIF Satzsp(oCB) FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // schreibt Array in das Ziel NEXT DbRUnlock() ++i // ein Auftrag eingelesen // // Email-Versicherungseintr„ge in den Ziel-Bestattungsfall im cDatver kopieren: SELECT 2 aDataV := Array(FCount()) 2->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) SELECT 22 LOCATE FOR auftrnr = Val(cAufalt) // in Email-Datei sind alle Records.. DO WHILE 22->auftrnr = val(cAufalt) .AND. !Eof() // ..zum selben Auftrag hintereinander! FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 2 IF 2->(Eof()) 2->(DbAppend()) // ...oder h„ngt neuen Fall dran ELSE Satzsp(oCB) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT DbRUnlock() DbSkip() SELECT 22 DbSkip() ENDDO SELECT 2 DO WHILE 2->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. weitere Eintr„ge 2->(SatzDelete()) DbSkip() ENDDO // // Email-Rechnungen in den Ziel-Bestattungsfall im cDatver kopieren: SELECT 3 aDataV := Array(FCount()) 3->(DbSeek(cAufalt,.F.)) // sucht ggf. vorhandenen Fall... (HARD-Seek!) SELECT 23 LOCATE FOR auftrnr = Val(cAufalt) // in Email-Datei sind alle Records.. DO WHILE 23->auftrnr = val(cAufalt) .AND. !Eof() // ..zum selben Auftrag hintereinander! FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) // Quelle lesen NEXT SELECT 3 IF 3->(Eof()) 3->(DbAppend()) // ...oder h„ngt neuen Fall dran ELSE Satzsp(oCB) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) // Zwischendatei schreiben NEXT DbRUnlock() DbSkip() SELECT 23 DbSkip() ENDDO SELECT 3 DO WHILE 3->auftrnr = Val(cAufalt) .AND. !Eof() // l”scht evtl. weitere Eintr„ge 3->(SatzDelete()) DbSkip() ENDDO // SELECT 1 // damit die Struktur des heimischen PCs gilt! aDataV := Array(FCount()) SELECT 21 DbSkip() // einfach physikalisch der n„chste Auftrag ENDDO DbCloseArea() SELECT 22 DbCloseArea() SELECT 23 DbCloseArea() // Email-Verzeichnis komplett l”schen (als Backup dient immer noch der Original-Anhang!) AEval( Directory(cEVerz+"*.*"), { |a| FErase( cEVerz+a[ F_NAME ] ) } ) cTip := LTrim(Str(i))+" Auftr„ge vom Email-Verzeichnis eingelesen + Email-Dateien gel”scht." ENDIF SELECT (nOldArea) ::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. ) // //+13.12.2008 11:48 Rahmen und Hintergrnde fr TrauerDruck: // IF FExists(cDatei+"PROG\"+"Rahmen1.ZIP") // //+ erzeugt ein SubDir unter Scans2 // IF !FExists(cDatver+"Scans2\Hintergrund","D") // RunShell( "/C MD "+cDatver + "Scans2\Hintergrund",, .T. ) // ENDIF // RunShell( "/C 7zg e "+cDatver+"PROG\Rahmen1.ZIP"+" -o "+cDatver[1]+":\HDBE\SCANS2\HINTERGRUND -y",, .F. ) // FErase(cDatei+"PROG\"+"Rahmen1.ZIP") // ENDIF // //+// 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+"mwstdat", 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 PRIVATE cTab := IIf(IsMemberVar(self,"TabSeite"),"TabSeite","BEArea") //+25.09.2008 16:29 n := AScan(self:&cTab,o) //+25.09.2008 16:29 IF "Angeh"$::thisTab:cargo //29.04.2007 15:26 speichert Angeh”rigen, wenn umgeschaltet wird ::SwapPers("S") ENDIF AEval(aTab, {|x,i| self:&cTab[n+x]:minimize()}, 1, Len(aTab)-1 ) //+25.09.2008 16:29 ::thisTab := self:&cTab[n+ATail(aTab)] //+25.09.2008 16:29 ::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()) //+06.10.2008 17:39 damit nicht noch weitere Datens„tze ver„ndert werden, wenn ... // ...ohne das Feld zu verlassen zu einem anderen Datensatz gegangen wird! oFocSle:vorigerwert := oFocSle:value 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", IIf( Len(Trim(ci20))>0, ci20, "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 IF "KNAPP"$Upper((nA)->beschreib) cNotiz += CRLF+"Vers.-Nr.:"+cPR1 //+14.11.2008 12:58 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 //+ 28.09.2008 13:39 erzeugt einen 2. Thread und startet FileView/Scan-Dialog METHOD BestFF:Scannen(cDateiName, aPos, a2Size, cS_s, nAnf, nEnd ) LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. //:= IIf( Empty(::oScanThrd), .F., aInfo[Min(Len(aInfo),::oScanThrd:threadid),2] != NIL ) IF !Empty( ::oScanThrd ) AEval( aInfo, {|a,i| IIf( a[1] == ::oScanThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF // IF ::Speichern() IF !lThreadIstAktiv ::oScanThrd := ScanThrd():new() // ::oScanThrd:start( , ::XbpObjekt(::BEArea,"THREAD4-1"), RecNo(), cDateiName ) ::oScanThrd:start( , ::BEArea[1], aPos, a2Size, RecNo(), cDateiName, cS_s, nAnf, nEnd ) ::oScanThrd:setInterval(10) ELSE //+ dabei ist aPos und aSize egal, weil das Fenster ja schon existiert! : PostAppEvent( xbeU_RefreshScan, RecNo(), cDateiName, aThrdFenster[2] ) //* refresht die Suchtabelle ENDIF // ::TabMax(::XbpObjekt(::TabSeite,"Vorschau"),{-1,+1,0}) // ENDIF RETURN self METHOD BestFF:Historie( cKdKz, cAuf, cS_h, nAnf, nEnd ) LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. //:= IIf( Empty(::oScanThrd), .F., aInfo[Min(Len(aInfo),::oScanThrd:threadid),2] != NIL ) IF !Empty( ::oHistThrd ) AEval( aInfo, {|a,i| IIf( a[1] == ::oHistThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF IF !lThreadIstAktiv ::oHistThrd := HistThrd():new() ::oHistThrd:start( , ::BEArea[1], cKdKz, cAuf, cS_h, nAnf, nEnd ) ::oHistThrd:setInterval(10) ELSE //+ dabei ist aPos und aSize egal, weil das Fenster ja schon existiert! : PostAppEvent( xbeU_RefreshHist, cKdKz, StrX(1->auftrnr,E,0), aThrdFenster[4] ) //* refresht die Suchtabelle ENDIF RETURN self