//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" //////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, oBest, oCtrl, oEdit PRIVATE aF1a, aF1b, aF2, aF3 PRIVATE aAdrKl := {"","","",""}, aAdrGr := {"","","",""} // 6.5.04 Adresse fr Kuvert PRIVATE cVariable := "vorname", nSpinJahr := Year(DATE()), nSpinMonat := Month(DATE()) // Makro-Variable fr den Maskenaufbau: PRIVATE FAM, STO1, STO2, STO3, TO0, TO1, TO2, TO3, TO4, TD0, TD1, TD2, TD3, TD4, TZ0, TZ1, TZ2, TZ3, TZ4 PRIVATE PR1, MU1, FL1, PR2, MU2, FL2, PR3, MU3, FL3, PR4, MU4, FL4 //23.04.2007 12:50 PRIVATE EHGD, EHSD, EHGO, EHSO, EHHEI, ANSPE, FRIED, NACHO, GRART PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9, cStadt //30.04.2007 17:56 PRIVATE cBU1, cBU2, cSTN //19.04.2006 09:44 PRIVATE oVideo, oFocus //25.06.2006 15:32 PRIVATE nB := nBz //24.04.2007 09:20 hier wird testhalber der Zeilen-Schritt gespeichert PRIVATE PS1, PS2, ANAM //29.03.2008 12:14 die variablen Texte in ~VVo, z.B. Versicherungsnummern 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" aPos := {5 ,30 } //06.04.2008 19:20 aSize := {790*nH,520*nV+50} //06.04.2008 19:20 27.04.2008 22:28 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 oDlg:resize := {| aOldSize, aNewSize, self | IIf( (Abs(aOldSize[1]-aNewSize[1])>10 .OR. ; Abs(aOldSize[2]-aNewSize[2])>10), ; IIf( self:getFrameState()==2, ; // 2=maximized {nFrame := 3, ; // self:getFrameState(), ; nH := nHur, ; nV := nVur, ; cV:= cVur, ; PostAppEvent( 1048632 ) }, ; {nH := aNewSize[1]/800, ; // Differenz zum Verh. der DAs vernachl„ssigbar nV := (aNewSize[2]-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder)/; (600-self:nHeightTitlebar-self:nHeightMenubar-self:nHeightBorder-30), ; // Verh„ltnis der DrawingAreas cTip := aNewSize, ; // zum debuggen! aNewsize == oDlg:currentsize() nFrame := 3, ; // 3=normal cV := cVur, ; PostAppEvent( 1048632 ) } ), ) } //06.04.2008 19:15 /**/ oDlg:create() // oDlg:setFrameState(nFrame) //08.04.2008 11:49 muss noch verbessert werden (pulsiert...) SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oBestMaske := oDlg oCB := oDlg:drawingArea oBEDA := oDlg:drawingArea oBEDA:cargo := oDlg drawingArea := oDlg:drawingArea oBEDA:setColorBG( XBPSYSCLR_TRANSPARENT ) 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_F2, {|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) 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 IF !Upper(AppName())$"BUCKX.EXE" //27.04.2008 22:18 SetAppWindow():configure(,,,0,0) // 07.04.2008 18:58 oCRT-Fenster klein machen 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 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 // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cStringS := LTrim( oBest:singleZeile[y]:getData() ) SetAppFocus(oBest:singleZeile[y]) y := oBest:XbpNummer( oBest:DruckKnopf, "suche Nr." ) PostAppEvent( xbeP_Activate,,, oBest:DruckKnopf[y] ) ENDIF IF nEvent == xbeLB_ItemMarked // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( SubStr( cItem, 1, At( "-", cItem )-1 ) ) cStringS := oBest:singleZeile[y]:getData() SetAppFocus(oBest:singleZeile[y]) ENDIF IF nEvent == xbeP_Keyboard IF 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 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. 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. oXbp:cargo != "cString" .AND. oBest:EditAuftragnr > Val(Replicate("9",E)) 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_F1 ModalDialog( (cDatver+"f1.dbf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_CTRL_F //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>0 IF "FETT" $ Upper(cBfont) nPL := At(" Fett",cBfont) cBfont := Stuff(cBfont,nPL,Len(" Fett"),"") // 5=len(" Fett") ELSE cBfont += " Fett" ENDIF IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF CASE mp1 == xbeK_CTRL_G //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>0 .AND. Val(cBfont)<25 nPL := At(".",cBfont)-1 IF 0 < nPL cBfont := Stuff(cBfont,1,nPL,Str(Val(cBfont)+1,2,0)) IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF ENDIF CASE mp1 == xbeK_CTRL_K //23.03.2008 12:03 IF cBfont!=NIL .AND. Val(cBfont)>5 //.AND. Val(cBfont)<25 nPL := At(".",cBfont)-1 IF 0 < nPL cBfont := Stuff(cBfont,1,nPL,Str(Val(cBfont)-1,2,0)) IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF ENDIF CASE mp1 == xbeK_CTRL_S //24.03.2008 17:16 IF cBfont!=NIL .AND. Val(cBfont)>5 //.AND. Val(cBfont)<25 IF "Arial"$cBFont cBfont := Stuff(cBfont,At("Arial",cBfont),5,"Courier New") ELSEIF "Courier New"$cBfont cBfont := Stuff(cBfont,At("Courier New",cBfont),11,"Times New Roman") ELSEIF "Times New Roman"$cBfont cBfont := Stuff(cBfont,At("Times New Roman",cBfont),15,"Arial") ELSE cBfont := "10.Arial" ENDIF IIf(Upper(AppName())$cAc,nFontR := cBfont,) //23.03.2008 17:23 fr Rechnung cV := IIf( cS_b == "s_bes2", "12", "11" ) nFa := 1 // 24.03.2008 17:33 Zweitnutzen der Variablen PostAppEvent( 1048632 ) ENDIF CASE mp1 == xbeK_ALT_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 oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) IF 4->(Alias()) == "PERSONEN" oBest:SwapPers("S") ENDIF BestGeaendert() __SETFUNCTION( 9, StrX( 1->AUFTRNR,E,0 ) ) cPubAuf := StrX( 1->auftrnr,E,0 ) SELECT 20 USE mwstdat // 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 ) ENDCASE ELSE DO CASE CASE cV == "5" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Stick() CASE cV == "6" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Stick() ineux(.F.) CASE cV == "7" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server() CASE cV == "8" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server() ineux(.F.) CASE cV == "9" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server(,"\HDBDIENST") CASE cV == "10" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server(,"\HDBDIENST") ineux(.F.) CASE cV == "11" cS_b := "s_best" CASE cV == "12" cS_b := "s_bes2" ENDCASE DatVerUm(IIf(Upper(cDatver)=="C:\HDBE\",0,1)) //28.04.2008 09:55 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+ ; IIf(!Empty(oError:filename), "Datei: "+oError:filename +CRLF,"") + ; "aufgerufen von:" +CRLF+ ; IIf( !Empty(ProcName(1)), ProcName(1)+"("+LTrim(Str(ProcLine(1)))+")"+CRLF,"")+; IIf( !Empty(ProcName(2)), ProcName(2)+"("+LTrim(Str(ProcLine(2)))+")"+CRLF,"")+; IIf( !Empty(ProcName(3)), ProcName(3)+"("+LTrim(Str(ProcLine(3)))+")"+CRLF,"")+; IIf( !Empty(ProcName(4)), ProcName(4)+"("+LTrim(Str(ProcLine(4)))+")"+CRLF,"")+; IIf( !Empty(ProcName(5)), ProcName(5)+"("+LTrim(Str(ProcLine(5)))+")"+CRLF,"")+; IIf( !Empty(ProcName(6)), ProcName(6)+"("+LTrim(Str(ProcLine(6)))+")"+CRLF,"")+; IIf( !Empty(ProcName(7)), ProcName(7)+"("+LTrim(Str(ProcLine(7)))+")"+CRLF,"")+; "Wiederholen mit , Datenretten + Ende mit " IF oError:severity > 1 IF ConfirmBox( oBEDA, ; cFehler, ; "Ein Fehler ist aufgetreten!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO DbCloseAll() USE AK_F_LOG new APPEND BLANK AK_F_LOG->datum := DATE() AK_F_LOG->zeit := Time() AK_F_LOG->logtext := DtoC(DATE()) +CRLF+ ; Time() +CRLF+ ; cFehler USE BREAK() ENDIF ENDIF RETURN .F. //------------------------------------------ FUNCTION Fallsuche() RETURN .T. FUNCTION NeuerFall() RETURN .T. //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: // von DialogFF geerbt: // VAR VArea // enth„lt die Area der best.dbf (=1) // VAR aStructure // enth„lt die Struktur der best.dbf // VAR aFelder // enth„lt alle Feldbezeichnungen der best.dbf // VAR aData1 // enth„lt alle Feldinhalte des augenblicklichen Datensatzes // VAR aData2 // // VAR aIndex // enth„lt die Namen der Indexdateien VAR SWT // SterbeWochentag VAR TW0 // Wochentag von Termin0 VAR TW1 // Wochentag von Termin1 VAR TW2 // VAR TW3 // VAR TW4 // VAR Beis_Fried // Beisetzungsfriedhof == Test fr Mller VAR PvAUFTRNR // 3.5.2005 fr die Personen.dbf in Area 4 VAR PvPERSKZ VAR PvANREDE VAR PvNAME VAR PvVORNAME VAR PvGEBNAME VAR PvSTRASSE VAR PvPLZ_ORT VAR PvORTSTEIL VAR PvTELEFON VAR PvFAX VAR PvEMAIL VAR PvGEB_DAT VAR PvSTB_DAT VAR PvVERW_BEZ VAR PvRECH_NR VAR PvRECHBETR VAR PvRECH_EL VAR PvRECH_FL VAR PvRECH_DAT VAR PvEINGBETR VAR PvEING_DAT VAR 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 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 ENDCLASS METHOD BestFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::SWT := "" ::TW0 := "" ::TW1 := "" ::TW2 := "" ::TW3 := "" ::TW4 := "" ::Beis_Fried := Space(30) ::PvAUFTRNR := 0000000 ::PvPERSKZ := "@" ::PvANREDE := "" ::PvNAME := "" ::PvVORNAME := "" ::PvGEBNAME := "" ::PvSTRASSE := "" ::PvPLZ_ORT := "" ::PvORTSTEIL:= "" ::PvTELEFON := "" ::PvFAX := "" ::PvEMAIL := "" ::PvGEB_DAT := CtoD("") ::PvSTB_DAT := CtoD("") ::PvVERW_BEZ:= "" ::PvRECH_NR := "" ::PvRECHBETR:= 0.00 ::PvRECH_EL := 0.00 ::PvRECH_FL := 0.00 ::PvRECH_DAT:= CtoD("") ::PvEINGBETR:= 0.00 ::PvEING_DAT:= CtoD("") ::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 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 ) 1->(DbGoto(aZugang[14])) 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"+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 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 ENDIF RETURN self METHOD BestFF:Ordnen(cVar,cSuchArt) // cSuchArt:="F " wird per Referenz bergeben DEFAULT cVar TO "auftrnr" PRIVATE cVariable := cVar IF SELECT()=1 DO CASE CASE Upper(cVariable) == "AUFTRNR" cSuchArt := "" SET ORDER TO 1 CASE Upper(cVariable) == "NAME" cSuchArt := "V " SET ORDER TO 2 CASE Upper(cVariable) == "ANSP_NAME" cSuchArt := "A " SET ORDER TO 3 CASE Upper(cVariable) == "STRASSE" cSuchArt := "S " SET ORDER TO 4 OTHERWISE IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrX(Month(1->&cVariable),2,0)+ ; StrX(day(1->&cVariable),2,0) to x5 ELSEIF ValType(1->&cVariable) == "N" INDEX on Str(1->&cVariable) TO x5 ELSE INDEX on Upper(1->&cVariable) TO x5 ENDIF ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 SET ORDER TO 5 ENDCASE ELSEIF SELECT()=4 DO CASE CASE Upper(cVariable) == "P_NAME" OrdSetFocus("x2") ENDCASE ENDIF RETURN OrdNumber() // fr DischX: Kopieren vom Laptop in das Netzwerk METHOD BestFF:FallCaufM( cKopie, cKreis, cVer ) //15.08.2006 LOCAL cAufalt, n, aDataV := {}, cVersTemp, cAufTemp, cTip DEFAULT cVer TO cNetver // 15.08.2006 cAufalt := StrX( 1->auftrnr,E,0 ) //***************** // 18.4.2005: // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 21 // USE (cVer+"Best") DbUseArea(,,cVer+"Best",,.T.) SET INDEX TO (cVer+"xauftrnr") 21->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall IF 21->(Eof()) 21->(DbAppend()) ELSE 21->(Satzsp(oCB)) ENDIF FOR n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT USE // Versicherungseintr„ge in den Bestattungsfall kopieren: cVerstemp := "v_"+cAufalt //"ver2"+LTrim(Str(Int(Seconds()/10))) SELECT 2 COPY STRU TO (cVerstemp) aDataV := Array(FCount()) SELECT 12 USE (cVerstemp) EXCLUSIVE SELECT 2 FIND &cAufalt do while 2->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 12 12->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT SELECT 2 skip enddo SELECT 12 USE SELECT 22 // USE (cVer+"VV") DbUseArea(,,cVer+"VV",,.T.) SET INDEX TO (cVer+"xvvauf") 22->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall DO WHILE 22->auftrnr = Val(cAufalt) 22->(SatzDelete()) ENDDO APPEND FROM (cVersTemp) USE // Rechnungsdaten in den Bestattungsfall kopieren: SELECT 23 // USE (cVer+"AUFTR") DbUseArea(,,cVer+"AUFTR",,.T.) SET INDEX TO (cVer+"xaufauf") SELECT 26 // USE (cVer+"ART") DbUseArea(,,cVer+"ART",,.T.) SET INDEX TO (cVer+"xart_lei") cAuf3temp := "r_"+cAufalt // 5.6.04 //LTrim(StrX(1->auftrnr,E,0)) SELECT 3 COPY STRU TO (cAuf3temp) aDataV := Array(FCount()) SELECT 13 // Zwischendatei erzeugen und daraus die neue Rechnung USE (cAuf3temp) EXCLUSIVE SELECT 3 FIND &cAufalt do while 3->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 13 13->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT SELECT 3 skip enddo SELECT 13 IF .NOT. Bof() GO TOP ENDIF aData2 := Array(FCount()) DO WHILE .NOT. Eof() FOR n := 1 to FCount() aData2[n] := FieldGet( n ) NEXT SELECT 23 23->(DbSeek(cAufalt,.F.)) //09.11.2006 15:44 berschreibt vorhandenen Fall DO WHILE 23->auftrnr = Val(cAufalt) // Artikel-Daten korrigieren: cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) REPLACE 26->bestand WITH 26->bestand+1 REPLACE 26->mgjahr WITH 26->mgjahr-1 REPLACE 26->umsatz WITH 26->umsatz - 23->betrag REPLACE 26->umsatzeu WITH 26->umsatzeu - 23->betrageu REPLACE 26->umsneteu WITH 26->umsneteu - 23->betneteu DbRUnlock( Recno() ) // 23->(SatzDelete()) ENDDO APPEND BLANK FOR n := 1 to FCount() FieldPut( n, aData2[n] ) NEXT DbRUnlock( Recno() ) // ... und unlock // Artikel-Daten korrigieren: cArt := 23->zugr_z_st SELECT 26 FIND &cArt Satzsp( oCB ) REPLACE 26->bestand WITH 26->bestand-1 REPLACE 26->mgjahr WITH 26->mgjahr+1 REPLACE 26->umsatz WITH 26->umsatz + 23->betrag REPLACE 26->umsatzeu WITH 26->umsatzeu + 23->betrageu REPLACE 26->umsneteu WITH 26->umsneteu + 23->betneteu DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 23 USE SELECT 26 USE SELECT 1 FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) cTip := "Auftrag kopiert." DbSkip(0) ::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. ) 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 := AScan(oBest:BEArea,o) IF "Angeh"$::thisTab:cargo //29.04.2007 15:26 speichert Angeh”rigen, wenn umgeschaltet wird ::SwapPers("S") ENDIF AEval(aTab, {|x,i| ::BEArea[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::BEArea[n+ATail(aTab)] ::thisTab:maximize() IF Len(aTab) = 3 //.AND. "NOLTE"$Upper(AppName()) // die 3 TabPages in der Mitte DO CASE CASE aTab[1]+aTab[2]+aTab[3] > 0 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } CASE aTab[1]+aTab[2]+aTab[3] = 0 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2 } CASE aTab[1]+aTab[2]+aTab[3] < 0 ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ENDCASE ENDIF IF Len(aTab) = 6 .AND. Upper(AppName())$cAc // die 6 TabPages rechts DO CASE CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 6 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 30 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2, 1->eh_telp } CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 18 .AND. (::oFocLFSle:cargo="VA" .OR. ::aBP[7]==4) ::aBP := { 1->va_anr, 1->va_vname, 1->va_name, 1->va_str, 1->va_ort, "Vater", 4, ; IIf(IsFieldVar("va_telp"),1->va_telp,"") } CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = 18 .AND. (::oFocLFSle:cargo="MU" .OR. ::aBP[7]==5) ::aBP := { 1->mu_anr, 1->mu_vname, 1->mu_name, 1->mu_str, 1->mu_ort, "Mutter", 5, ; IIf(IsFieldVar("mu_telp"),1->mu_telp,"") } CASE aTab[1]+aTab[2]+aTab[3]+aTab[4]+aTab[5]+aTab[6] = -6 ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3, ::PvTELEFON } OTHERWISE ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } ENDCASE ENDIF RETURN self //RETURN DialogFF():TabMax(o,aTab) // ::aBP[7] wird vorgesetzt durch Anklicken der gewnschten TabPage - oder durch nTab // ::aBP wird in der Hauptmaske als Briefanschrift verwendet // ~ wird im Adress-Programm als Betreff/Ansprechpartner verwendet METHOD BestFF:TabDaten(cGkz,cBez,nTab) // holt sich die Daten aus der oberen der 3 TabPages in der Mitte LOCAL nRec DEFAULT cBez TO "" IIf( !Empty(nTab), ::aBP[7]:=nTab, ) IF !Empty(cGkz) .AND. !Empty(cBez) // 13.11.2005 fr bl_quit nRec := 5->(RecNo()) 5->(DbSeek(cGkz,.F.)) ::aBP := { 5->name1, 5->name2, "", 5->strasse, 5->plz_ort, cBez, 1 } 5->(DbGoto(nRec)) ELSE DO CASE CASE ::aBP[7] == 1 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } CASE ::aBP[7] == 2 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2, 1->eh_telp } CASE ::aBP[7] == 3 ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3, ::PvTELEFON } CASE ::aBP[7] == 4 // 28.05.2007 15:50 cAc ::aBP := { 1->va_anr, 1->va_vname, 1->va_name, 1->va_str, 1->va_ort, "Vater", 4, ; IIf(IsFieldVar("va_telp"),1->va_telp,"") } CASE ::aBP[7] == 5 // 28.05.2007 15:50 cAc ::aBP := { 1->mu_anr, 1->mu_vname, 1->mu_name, 1->mu_str, 1->mu_ort, "Mutter", 5, ; IIf(IsFieldVar("mu_telp"),1->mu_telp,"") } ENDCASE ENDIF RETURN self //04.09.2007 18:13: // in GKZ steht dann auáer verskz auch -R, -E, -V, -M, -A.X (= Angeh”riger X) // ::aBP wird im Rechnungs-Programm als Rechnungsadresse verwendet METHOD BestFF:AngDaten(cGkz) // holt sich die Daten von Angeh”rigen je nach GKZ-Inhalt LOCAL nRec LOCAL cBez := "" DEFAULT cGkz TO "-R " // fr alle F„lle IF cGkz[1]>"@" nRec := 5->(RecNo()) 5->(DbSuspendNotifications()) 5->(DbSeek(cGkz,.F.)) ::aBP := { 5->name1, 5->name2, "", 5->strasse, 5->plz_ort, cBez, 1, 5->tel } 5->(DbGoto(nRec)) 5->(DbResumeNotifications()) ELSEIF cGkz[1]="-" DO CASE CASE cGkz[2] == "R" // trivial: der Rechnungsempf„nger=Ansprechpartner ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1, 1->ansp_telp } CASE cGkz[2] == "E" ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2, 1->eh_telp } CASE cGkz[2] == "A" nRec := 4->(RecNo()) 4->(DbResumeNotifications()) 4->(DbSeek(StrZero(1->AUFTRNR,E,0) + Right(Trim(cGkz),1), .F. )) // .F., damit nur der Richtige gefunden wird IF 4->P_Perskz = Right(Trim(cGkz),1) ::aBP := { 4->P_ANREDE, 4->P_VORNAME, 4->P_NAME, 4->P_STRASSE, 4->P_PLZ_ORT, 4->P_VERW_BEZ, 3, 4->P_TELEFON } ELSE ::aBP := { "-", "-", "-", "-", "-", "-", "-", "-" } // dieser Angeh”riger existiert nicht ENDIF 4->(DbGoto(nRec)) 4->(DbResumeNotifications()) CASE cGkz[2] == "V" // 28.05.2007 15:50 cAc ::aBP := { 1->va_anr, 1->va_vname, 1->va_name, 1->va_str, 1->va_ort, "Vater", 4, ; IIf(IsFieldVar("va_telp"),1->va_telp,"") } CASE cGkz[2] == "M" // 28.05.2007 15:50 cAc ::aBP := { 1->mu_anr, 1->mu_vname, 1->mu_name, 1->mu_str, 1->mu_ort, "Mutter", 5, ; IIf(IsFieldVar("mu_telp"),1->mu_telp,"") } ENDCASE ENDIF RETURN self METHOD BestFF:FriedEF() // 06.12.2005: MuellX-Spezialit„t IF oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ) .AND. ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):vorigerwert != ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):value 1->(Satzsp(oCB)) IF 1->best_art = "E" ::XbpObjekt( ::singleZeile, "&"+"TO2" ):setData( 1->&TO2 := ::Beis_Fried ) ELSEIF SubStr(1->best_art,1,2) $ "FAF SAS UAU Fe Se F1F2F3F4" //26.03.2008 16:07 IF 1->best_art[2] = "A" ::XbpObjekt( ::singleZeile, "&"+"TO4" ):setData( 1->&TO4 := Trim(PadR( "anonym " + ::Beis_Fried, 28 )) ) ELSE ::XbpObjekt( ::singleZeile, "&"+"TO4" ):setData( 1->&TO4 := Trim(::Beis_Fried) ) ENDIF ENDIF 1->(DbRUnlock()) ELSE //IF oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"TO2" ) .OR. ; // oFocSle == oBest:XbpObjekt( oBest:SingleZeile, "&"+"TO4" ) //////// Test fr MuellX: Beis_Fried als MemberVar -> verteilt auf ortgrab/urnewo, je nach best_art // IF IsFieldVar("&TO4") .AND. FRIED == "Beis_Fried" IF 1->best_art="E" //.AND. !Empty(1->&TO2) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried:=1->&TO2) ELSEIF SubStr(1->best_art,1,2) $ "FAF SAS UAU Fe Se F1F2F3F4" //.AND. !Empty(1->&TO4) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried := ; IIf(1->&TO4="anonym",PadR(SubStr(1->&TO4,8),30),1->&TO4)) ELSEIF Empty(1->best_art) .OR. (Empty(1->&TO4) .AND. Empty(1->&TO2)) oBest:XbpObjekt( oBest:SingleZeile, "&"+"FRIED" ):setData(::Beis_Fried := Space(30)) ENDIF ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):vorigerwert := ; ::XbpObjekt( ::SingleZeile, "&"+"FRIED" ):value // ENDIF ENDIF RETURN self METHOD BestFF:FormularNotiz(cBL_Datei) // notiert, wenn ein Formular gedruckt wurde LOCAL nA, nOldArea := SELECT(), cNotiz := 1->notiz, cP IF cBL_Datei == Upper(cBL_Datei) cP := SET(43,1) // 01.07.2007 10:21 n”tig?? (hilft nicht bei Druck1Seite+(sofort)Ende+Druck) DbUseArea(.T.,,"bl_dir") nA := SELECT() IF DbLocate( {|| PadR(cBL_Datei,8) == Upper((nA)->name)} ) cNotiz += IIf(Upper(AppName())$"WERNERX.EXE",CRLF,"") + ; //01.03.2008 16:52 CRLF+DtoC(DATE())+": " + IIf(IsMemVar("cTKurz0").AND.Len(Trim(cTKurz0))>0, ; IIf(cTKurz0="!angebot","Kostenvoranschlag",Trim(cTKurz0)), Trim((nA)->beschreib)) + ; IIf( (cBL_Datei!="BL_A" .OR. Len(cBL_Datei)>5) .AND. ; cBL_Datei$"BL_FIRM-BL_RENT-BL_ORD-BL_HELL-BL_KAF1-BL_FRKI-BL_ALBR", ; " an "+Trim(5->name1)+" gedruckt.", ; IIf(cBL_Datei$"BL_CHEC".AND.Upper(AppName())$cAc, ; " fr "+aAdrKl[2]+"/"+aAdrKl[3]+"/"+aAdrKL[4]+" gedruckt.", ; IIf(cBL_Datei$"BL_V".AND.Upper(AppName())$cAc, ; " an "+Trim(12->name1)+" gedruckt."," gedruckt."))) IF Upper(AppName())$cAc .AND. cBL_Datei = "BL_ALBR" cNotiz += CRLF + IIf(cTKurz0="!versorg","Aktenzeichen: ","Mitgliedsnummer: ")+ Trim(oEdit:aTxBd[9]) ENDIF IF "POSTRENT"$Upper((nA)->beschreib) cNotiz += CRLF+"Nr.:"+cPR1+", "+cPR2+", "+cPR3+IIf(IsMemVar("cPR4"),", "+cPR4,"") //21.04.2008 20:48 cPR4 ENDIF ENDIF DbCloseArea() SELECT (nOldArea) 1->(Satzsp(oCB)) FOR i:=1 TO Len(::multizeile) // direkte Anzeige auch bei cAc ::multizeile[i]:setData( 1->notiz := cNotiz ) NEXT 1->(DbRUnlock()) SET(43,cP) ENDIF RETURN self