//bestp8.prg/////////////////////////////////////////////////////////////////// // 06.11.2005: E ersetzt 6: aus StrX(1->auftrnr,6,0) wird StrX(1->auftrnr,E,0) #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Font.ch" #include "dmlb.ch" #include "Set.ch" #include "Dmlb.ch" #include "Directry.ch" //23.05.2007 12:44 fr Email #include "Common.ch" #include "Thread.ch" //xbeP_User = 134217728 #define xbeU_RefreshHist xbeP_User + 1 #define xbeU_RefreshSuch xbeP_User + 2 #define xbeU_RefreshAnlief xbeP_User + 3 #define xbeU_RefreshScan xbeP_User + 4 #define xbeU_ShowHistDaten xbeP_User + 5 #define xbeU_ShowScan xbeP_User + 6 #define xbeU_RefreshPLZ xbeP_User + 7 #define xbeU_RefreshApp xbeP_User + 31 #define xbeU_ShowAnlief xbeP_User + 32 #define xbeU_RefreshRechng xbeP_User + 33 /* siehe: #define xbeP_User 134217728 */ //------------------------------------------ /* 24.06.2008 17:47 neue Thread-Klasse fr die AnliefererVerwaltung: */ CLASS AnliefThrd FROM Thread EXPORTED: VAR producerID VAR terminated VAR nRec VAR cBildDateiName INLINE METHOD init() ::thread:init() ::producerID := ThreadID() ::terminated := .F. RETURN INLINE METHOD terminate() RETURN ::terminated := .T. EXPORTED: INLINE METHOD execute(a,b,c,d,e,f) Bestp(a,b,c,d,e,f) RETURN self INLINE METHOD atStart() nRec := RecNo() RETURN self INLINE METHOD atEnd() nRec := RecNo() DbCloseAll() RETURN self ENDCLASS //------------------------------------------ PROCEDURE bestp( cTitel, cS_b, oDlg1 ) LOCAL nEvent, mp1, mp2, aFelder := {}, ID_SLE_PRIMKEY := 1 LOCAL oDlg, oXbp, oHelp, oSignal /*24.06.2008 22:11*/ LOCAL drawingArea, aEditControls := {} //, aCrtSize := SetAppWindow():currentsize() // 07.04.2008 18:58 LOCAL aData1[ FCount() ] LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_COMPOUNDNAME, FONT_DEFFIXED_SMALL} , ; //22.03.2008 22:27 { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } LOCAL 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) LOCAL lHideAnl := .F. //+20.10.2009 19:26 PRIVATE cV := " ", cVur := "11" //IIf(cS_b=="s_best","11","12") //12.04.2008 16:43 PRIVATE cTN, cTK, cTS, cTF // Text-Neu/Kopie/Such/Feldsuch PRIVATE nFontR := IIf( nV<=1, FONT_DEFFIXED_SMALL, FONT_DEFFIXED_MEDIUM ) PRIVATE nXmod:=nXehe:=nYehe:=int(350*nV), nYmod:=int(250*nV) PRIVATE cFeldC, cFeldN, cFeldD, aFeld[FCount()] PRIVATE cString := cStringN := cStringK := cStringS := cStringF := Space(E) PRIVATE cStringFM := cStringFJ := "" // 17.10.2004 PRIVATE oCB, oBEDA, oFocSle := SetAppFocus() // PRIVATE, weil sie in Funktionen verwendet werden!! PRIVATE cFont, oFont, nVers := 1, oSleSuch, oCtrl, oEdit PRIVATE aF1a, aF1b, aF2, aF3 PRIVATE aAdrKl := {"","","",""}, aAdrGr := {"","","",""} // 6.5.04 Adresse fr Kuvert PRIVATE cVariable := "vorname", nSpinJahr := Year(DATE()), nSpinMonat := Month(DATE()) // Makro-Variable fr den Maskenaufbau: PRIVATE FAM, STO1, STO2, STO3, TO0, TO1, TO2, TO3, TO4, TD0, TD1, TD2, TD3, TD4, TZ0, TZ1, TZ2, TZ3, TZ4 PRIVATE PR1, MU1, FL1, PR2, MU2, FL2, PR3, MU3, FL3, PR4, MU4, FL4 //23.04.2007 12:50 PRIVATE EHGD, EHSD, EHGO, EHSO, EHHEI, ANSPE, FRIED, NACHO, GRART PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9, cStadt //30.04.2007 17:56 PRIVATE cBU1, cBU2, cSTN //19.04.2006 09:44 PRIVATE oVideo, oFocus //25.06.2006 15:32 PRIVATE nB := nBz //24.04.2007 09:20 hier wird testhalber der Zeilen-Schritt gespeichert PRIVATE PS1, PS2, ANAM //29.03.2008 12:14 die variablen Texte in ~VVo, z.B. Versicherungsnummern PRIVATE nA //*11.07.2008 10:50 damit es einmal deklariert ist... DEFAULT cS_b TO "s_scrap" cProgTyp := "n" // 14.09.2005 fr alle F„lle PUBLIC aBC := {150,150,250} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCR := {250,150,150} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCY := {250,250, 50} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCG := {150,250,150} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che PUBLIC aBCB := {150,150,250} //+04.08.2008 22:06 Farben-Hilfsvariable fr cBildDatei-Fl„che ErrorBlock( {|e| FehlerBehandlung(e) } ) // e = Error-Objekt //in SCRAPX nur einen Zugangspunkt?:///////////////////////////////////////////////////////////////// // aZugang-Felder (fest gesetzt in AppName.prg): // 1: Bestattungsf„lle bearbeiten // 2: Versicherungsanschreiben // 3: Rechnung // 4: 0...9: 10 Nummernkreise als Unter-Array // 5: Adressverwaltung // 6: Artikelverwaltung // 7: Kontrollbersicht // 8: Formularverwaltung // 9: Terminverwaltung // 10: Kasse // 11: // 12: // 13: Trauerdruck IF Val(cRS) < aZugang[1] AlertBox( , "Rohstoff-Annahme bearbeiten;" + ; ";Sie haben dazu NICHT die Berechtigung!", ; { } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Scrap = Schrott." ) RETURN ENDIF /////////////////////////////////////////////////////////////////////////////////// PostAppEvent( xbeU_RefreshApp,99,cBK, aThrdFenster[1]) //+20.08.2012 17:17 DO WHILE cV == " " // cV!=" " zum Umschalten der Filiale/des Mandanten Datei("11") //+01.06.2009 10:09 SELECT 1 IF !Empty(cPubAuf) FIND &cPubAuf IF Eof() GO BOTTOM ENDIF ELSE GO TOP ENDIF cV := "B" //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ aPos := {oDlg1:currentPos()[1],oDlg1:currentPos()[2]+30} //+ ganz links unten in der Parent-Tab: ASize := {oDlg1:currentsize()[1],oDlg1:currentsize()[2] - ; IIf( oDlg1:isderivedfrom("XbpTabPage"), oDlg1:tabheight, 28 ) } //08.07.2008 18:19 //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+01.06.2009 10:01 Parent und Owner sind jetzt bestimmt durch den Anlieferer-Tab: oDlg := AKDialog():new( AppDeskTop(), oDlg1:setParent(), aPos, ASize,aPP , .F.) oDlg:taskList := .T. oDlg:movewithOwner := .T. //+01.06.2009 21:22 oDlg:title := cTitel + " *" oDlg:titlebar := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED /**/ oDlg:create() SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oBestMaske := oDlg oCB := oDlg:drawingArea oBEDA := oDlg:drawingArea oBEDA:cargo := oDlg drawingArea := oDlg:drawingArea oBEDA:setColorBG( XBPSYSCLR_TRANSPARENT ) aThrdFenster[2] := oDlg //+01.06.2009 09:28 2 statt 1 nBz := IIf(cS_b = "s_bes2", 24*nV, 23*nV ) //13.04.2008 16:36 // jetzt folgt die Erzeugung der Eingabefelder oScrap := BestFF():new( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 299, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 /* jetzt ist oScrap:BEArea[1] == oBEDA , also ist oScrap:BEArea[1]:cargo == oDlg !! */ oBest := oScrap /* damit nicht alle oBest ver„ndert werden mssen */ oEdit := oBest // wegen DialogFF:create(IsMemberVar) 14.4.2005 oEdit:cS_b := cS_b //10.10.2006 22:27 zum Umschalten der 'Skins' oScrap:CREATE( oBEDA,oDlg, , ,,, nBz, cS_b, -100, 299, 1 ) //aPos+aSize nicht gebraucht 06.04.2008 10:28 AEval( oScrap:editControls, {|x| oDlg:addEditControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:childFromName( 1->(FieldPos( "ANUMMER" )) ):disable() oEdit:SubMenu[1]:checkItem(1,!oEdit:Sperre) nBz := nB //24.04.2007 09:21 hier wird testhalber der Zeilenschritt zurckgesetzt //------------------------------------------ // SetAppWindow(oDlg) // eventuell aktivieren, wenn HauptAnwendungsfenster SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oDlg:setModalState( XBP_DISP_APPMODAL ) /* * oBestMaske:aData1 := SatzGetBest() // fr die Ver„nderungsabfrage (sp„ter mal..) */ //------------------------------------------ // das Ende des Hauptprogramms: * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) 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" DbSkip(0) // damit er ein Notify macht /* 09.07.2008 08:56 dann wird der Such-Thread gestartet: */ oBest:FeldSuche(oBest:XbpObjekt(,"name")) oDlg:invalidateRect() nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+ 08.06.2009 18:01 Ausschalten von auáen: IF ThreadObject():terminated == .T. ThreadObject():atEnd() ThreadObject():QUIT() ENDIF //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ IF nEvent = xbeP_Close .AND. Val(cV)=0 IF Empty(mp1) y := AppQuit(oDlg) IF y == 3 .OR. ( y == 2 .AND. !Empty("NurWindows") ) nEvent := 0 LOOP ENDIF ELSE // wenn Abbruch durch AppQuit, dann mp1!=NIL ENDIF ENDIF //+20.10.2009 19:26 wenn HistDaten, dann keine AnlDaten: IF lHideAnl = .T. .AND. nEvent != xbeU_ShowHistDaten .AND. nEvent != xbeU_ShowScan LOOP ENDIF IF nEvent = xbeU_RefreshAnlief IF oBest:EditAnliefNr == 1->anummer i := AlertBox( , "Anliefererdaten erst speichern?;" + ; ";bei NEIN gehen die Daten verloren!", ; { "JA", "NEIN", "abbrechen" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "ACHTUNG!" ) IF i == XBPMB_RET_YES oBest:Speichern() ELSEIF i == XBPMB_RET_NO oBest:Rueckgaengig() ELSE LOOP ENDIF ENDIF IF ValType(mp1) == "C" //+01.06.2009 21:44 oDlg:Show() SetAppFocus(oBest:oFocLFSle) ELSEIF ValType(mp1) == "N" //* 1->(DbGoto( mp1 )) //* aus oSuch ELSEIF ValType(mp2) == "C" //* 13.07.2008 13:19 DbSeek(mp2,.F.) //* aus oHist ENDIF oDlg:readData() oBest:SatzLesen(0) /*29.06.2008 09:29 fr ::Rueckgaengig() */ oBest:SatzLesen(1) /*06.08.2008 22:59 fr ::HistSchreiben() */ LOOP ENDIF IF nEvent = xbeU_ShowScan oBest:ShowScan(mp1,mp2) LOOP ENDIF IF nEvent = xbeU_ShowHistDaten IF mp1 == 3 oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,"HistDaten"),{-1,+1,0}) lHideAnl := .T. ELSEIF mp1 == 1 oBest:TabMax(oBest:XbpObjekt(oBest:TabSeite,"AnlDaten"),{-1,-2,0}) lHideAnl := .F. ENDIF LOOP ENDIF IF nEvent == xbeP_Keyboard //++++++++++++++++++++++++++++++++++++++++++++++++++++ oApp:TLKS := Time() //+30.05.2009 17:57 TLKS = Time of last keystroke //++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 ELSE cFktT := 0 ENDIF IF mp1 == xbeK_HOME .AND. IsMemberVar(oXbp,"value") .AND. oXbp:cargo="NAME" oBest:Wochentag() // beim Start Wochentage setzen 15.4.2005 ENDIF // Buchstaben-Tasten wirken nur, wenn der Auftrag als editierbar markiert ist: IF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. ValType(oXbp:cargo) == "C" ; .AND. oXbp:cargo != "cString" .AND. oEdit:Sperre == .T. ; .AND. !oBest:EditAnliefNr == 1->anummer ; .AND. !oBest:EditAnliefNr > Replicate("9",E) //+05.07.2018 18:01 Valtype() IF "//alt//"$1->zusatz .AND. !1->benutzer $ "MD YYY" //+11.07.2010 22:08 AlertBox( , "Diese Daten darf nur MD „ndern!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Anlieferer eingeben/„ndern?",IIf("//alt//"$1->zusatz .OR. "//gesperrt//"$1->zusatz,GRA_CLR_RED,)) //+11.07.2010 21:32 ELSEIF cBK != 1->benutzer //+18.08.2012 21:47 AlertBox( , "Diese Daten sind gerade fr "+1->benutzer+" reserviert!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Anlieferer eingeben/„ndern?",GRA_CLR_CYAN) ELSEIF AlertBox( , "Wollen Sie Daten eingeben oder „ndern:;" + ; ";", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Anlieferer eingeben/„ndern?",IIf("//alt//"$1->zusatz .OR. "//gesperrt//"$1->zusatz,GRA_CLR_RED,)) = 1 //+11.07.2010 21:32 oBest:EditAnliefNr := 1->anummer SELECT 1 //+25.03.2009 12:44 fr alle F„lle ! oBest:SatzLesen(0) /*29.06.2008 09:29 fr ::Rueckgaengig() */ mp1 := 0 //02.07.2006 11:47 oBest:killTip() //+ 13.08.2008 08:57 fr 'diese Nr ist noch frei' ELSE LOOP ENDIF ELSEIF (mp1=xbeK_BS .OR. mp1=xbeK_DEL .OR. (mp1>31 .AND. mp1<128)) ; .AND. oXbp:cargo != "cString" .AND. oBest:EditAnliefNr > Replicate("9",E) AlertBox( , "Dieser Auftrag wird bereits bearbeitet von "+1->benutzer+" !" + ; ";", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "" ) //+15.11.2009 17:41 LOOP ENDIF DO CASE CASE mp1 = xbeK_DOWN .AND. oXbp:isDerivedFrom( "XbpComboBox" ) PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) // - wie LOOP CASE mp1 = xbeK_UP .AND. oXbp:isDerivedFrom( "XbpComboBox" ) PostAppEvent( xbeP_Keyboard, xbeK_SH_TAB,, oXbp ) // - wie LOOP CASE mp1 != xbeK_ESC .AND. mp1 != xbeK_F10 .AND. mp1 = xbeK_TAB ; .AND. oXbp:isDerivedFrom( "XbpMle" ) oXbp:KEYBOARD( mp1 ) LOOP CASE mp1 == xbeK_ESC .or. mp1 == xbeK_F10 IF ValType(oVideo) == "O" oVideo:stop() oVideo:cargo:destroy() oVideo := NIL mp1 := 0 SetAppFocus( oFocSLE ) LOOP ENDIF y := AppQuit(oDlg) IF y == 3 .OR. ( y == 2 .AND. !Empty("NurWindows") ) LOOP ENDIF CASE mp1 == xbeK_ALT_F7 //+08.02.2011 19:16 oBest:XbpObjekt(,"perskonto"):editable := .T. //+08.02.2011 19:18 CASE mp1 == xbeK_CTRL_F7 //04.09.2007 10:37 //14.09.2007 15:52 'gel”schte' Auftr„ge werden enabled: IF oBest:Codewort( oBEDA, "s_best", 840, 859, cDatver+"param", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; > "4" y := oBest:XbpNummer(oBest:singleZeile,"ADATUM") z := Len(oBest:singleZeile)-y // ::XbpNummer(::singleZeile,"PvSALDO") AEval( oBest:singleZeile, {|a,i| a:enable() }, y, z-y ) AEval( oBest:ListBox, {|a,i| a:enable() } ) IIf(ValType(oBest:XbpObjekt(oBest:multiZeile,"NOTIZ",.F.))="O", ; oBest:XbpObjekt(oBest:multiZeile,"NOTIZ",.F.):enable(),) //*14.07.2008 15:17 IIf(ValType(oBest:XbpObjekt(oBest:multiZeile,"notiz",.F.))="O", ; oBest:XbpObjekt(oBest:multiZeile,"notiz",.F.):enable(),) //*14.07.2008 15:18 IIf(lLogBook,oBest:TLog:write():writeLogFile(),) //16.09.2007 22:27 ENDIF CASE mp1 == xbeK_F4 IF oXbp:cargo$"strasse-ort-plz" oXbp:getData() oBest:aI1:={oBest:XbpObjekt(,"strasse"),oBest:XbpObjekt(,"ort"),oBest:XbpObjekt(,"plz")} Plc(1->strasse,1->ort,1->plz) ENDIF LOOP CASE mp1 == xbeK_ALT_R PostAppEvent( xbeU_RefreshApp,6,1->anummer, aThrdFenster[1] ) // ”ffnet das Rechnungsfenster CASE mp1 == xbeK_ALT_M PostAppEvent( xbeU_RefreshApp,7,1->anummer, aThrdFenster[1] ) // ”ffnet das MaterialFenster CASE mp1 == xbeK_F12 oDlg:hide() CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1.dbf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_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,,,aThrdFenster[2] ) ENDIF CASE mp1 == xbeK_ALT_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,,,aThrdFenster[2] ) ENDIF ENDIF CASE mp1 == xbeK_ALT_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,,,aThrdFenster[2] ) ENDIF ENDIF CASE mp1 == xbeK_ALT_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,,,aThrdFenster[2] ) ENDIF CASE mp1 == xbeK_CTRL_F2 //+27.06.2009 18:44 ScreenDump Win_Clip_File(AppDeskTop(),cDatver+"CLIPS\S_"+Left(Time(),2)+SubStr(Time(),4,2)+Right(Time(),2) ) LOOP CASE mp1 == Asc("+") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +1 ) CASE mp1 == Asc("-") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -1 ) CASE mp1 == Asc("*") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, +7 ) CASE mp1 == Asc("_") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, -7 ) CASE mp1 == Asc("#") .AND. oXbp:isderivedfrom("XbpSle") .AND. ; IsMemberVar( oXbp, "value" ) .AND. ValType(oXbp:value)=="D" oEdit:DatumSet( oXbp, 0 ) ENDCASE ENDIF //+ PLZ/Ort wurde gesucht: in SLE einsetzen (steht in oBest:aI1, beim Aufrufen von PLC() gesetzt) IF nEvent == xbeU_RefreshPLZ IF mp1 != NIL Satzsp(oCB) oBest:aI1[1]:setData(mp1[1]) oBest:aI1[2]:setData(mp1[2]) oBest:aI1[3]:setData(mp1[3]) oBest:aI1[1]:getData() oBest:aI1[2]:getData() oBest:aI1[3]:getData() DbRUnlock() ENDIF oBest:oPLZThrd := NIL //+ fr alle F„lle SetAppFocus(oFocSle) ELSE oXbp:handleEvent( nEvent, mp1, mp2 ) ENDIF ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) BestGeaendert() cPubAuf := 1->anummer SELECT 20 DbUseArea( , "DBFNTX", "C:\HDBE\param" ) // in c:\hdbe // DO WHILE !FLock() //+19.08.2012 15:24 // Sleep(1) // ENDDO Satzsp(oCB) 20->pubauf := cPubAuf DbCloseArea() DbUseArea( , "DBFNTX", cDatver+"param" ) // im server // DO WHILE !FLock() //+19.08.2012 15:24 // Sleep(1) // ENDDO Satzsp(oCB) IF 20->(IsFieldVar("font0")) .AND. !Empty(cBfont) //23.03.2008 11:49 speichert zuletzt eingestellten BenutzerFont 20->&("font"+cBNr) := cBfont ENDIF IF oDlg:currentpos()[1]>= -10 .AND. 20->(IsFieldVar("bestP1_0")) //22.06.2008 10:55 weil sonst bei minimieren negativ (-32000) 20->&("bestP1_"+cBNr) := nBestP1 := oDlg:currentPos()[1] 20->&("bestP2_"+cBNr) := nBestP2 := oDlg:currentPos()[2] 20->&("bestS1_"+cBNr) := nBestS1 := oDlg:currentSize()[1] 20->&("bestS2_"+cBNr) := nBestS2 := oDlg:currentSize()[2] ENDIF DbCloseArea() //+ Area 20 Sleep(10) SELECT 1 1->(DbSkip(0)) IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF 1->benutzer == cBK .AND. oScrap:lUser == .T. //+20.08.2012 21:05 Satzsp(oCB) oBest:XbpObjektSet(,"BENUTZER",1->benutzer := " ") //+17.09.2012 19:39 DbRUnlock() DbCommit() //+20.08.2012 21:05 vorsichtshalber ENDIF ENDIF 1->(DbRUnlock()) oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() //+19.08.2012 16:10 testhalber oDlg:destroy() DbCloseAll() //+ 30.07.2008 10:36 IF Val(cV) > 0 // ”ffnet einen anderen Satz Dateien (siehe eurov) IF cV="1" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Sonne"$cFirma cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma ELSEIF cV="2" .AND. "SONNEX.EXE"$Upper(Appname()) .AND. "Tier"$cFirma2 cTitel := "Bestattungs-Verwaltungs-Regie - "+cFirma2 ENDIF IF Val(cV)<5 DatVerUm(Val(cV)) // hier wird in ein anderes Arbeitsverzeichnis umgeschaltet ELSEIF "."$cV // ...aber gr”áer als 5 (fr BergX-Filialenumschaltung DO CASE CASE Val(cV) = 5 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 5 .AND. Val(cV) < 6 // 06.03.2007 10:11 fr BergX n := (Val(cV)-5)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 6 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 6 .AND. Val(cV) < 7 // 25.02.2007 19:39 fr BergX n := (Val(cV)-6)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\") CASE Val(cV) = 7 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 7 .AND. Val(cV) < 8 // 06.03.2007 10:11 fr BergX n := (Val(cV)-7)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_zum_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 8 .AND. cV[3] == "a" // 06.03.2007 10:11 fr BergX cDummyD := cDatver FOR n := 1 TO 9 CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden kopiert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") NEXT cDatver := cDummyD SET DEFAULT TO &cDatver CASE Val(cV) > 8 .AND. Val(cV) < 9 // 25.02.2007 19:39 fr BergX n := (Val(cV)-8)*10 @ 10,5 SAY "Daten werden kopiert..." cDatver := Trim(cDatver) BDaten_vom_Stick(SubStr(cDatver,1,2),SubStr(cDatver,3,Len(cDatver)-4)+Str(n,1)+"\","dateien2") CASE Val(cV) = 9.1 // zurckstellen auf 'Arbeiten auf dem PC/Server' USE param EXCLUSIVE cDatver := param->netver SET DEFAULT TO &cDatver param->datver := cDatver[1] + SubStr(param->datver,2) param->netver1 := cDatver[1] + SubStr(param->netver1,2) param->netver2 := cDatver[1] + SubStr(param->netver2,2) param->netver3 := cDatver[1] + SubStr(param->netver3,2) param->netver4 := cDatver[1] + SubStr(param->netver4,2) param->netver5 := cDatver[1] + SubStr(param->netver5,2) param->netver6 := cDatver[1] + SubStr(param->netver6,2) param->netver7 := cDatver[1] + SubStr(param->netver7,2) param->netver8 := cDatver[1] + SubStr(param->netver8,2) param->netver9 := cDatver[1] + SubStr(param->netver9,2) USE DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.2 // umstellen auf 'Arbeiten auf dem USB-Stick' mit Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert das USB-Laufwerk IF cDrive$"DEFGHIJK" FOR n := 1 TO 9 // kopiert notwendige Programmdateien in die Stickverzeichnisse @ 3,5 SAY "Ich bereite den USB-Stick fr die Arbeit vor....."+Str(n,1) COPY FILE (cDatver+"bl_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.tak") COPY FILE (cDatver+"bl_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_.sdf") COPY FILE (cDatver+"bl_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"bl_dir.dbf") COPY FILE (cDatver+"xBlFName.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xBlFName.ntx") COPY FILE (cDatver+"s_.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.tak") COPY FILE (cDatver+"s_.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_.sdf") COPY FILE (cDatver+"s_dir.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"s_dir.dbf") COPY FILE (cDatver+"xFldPos.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xFldPos.ntx") COPY FILE (cDatver+"hilfetip.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"hilfetip.dbf") COPY FILE (cDatver+"xHTip.ntx") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"xHTip.ntx") COPY FILE (cDatver+"FExport.dbf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"FExport.dbf") COPY FILE (cDatver+"dateien1.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.tak") COPY FILE (cDatver+"dateien1.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien1.sdf") COPY FILE (cDatver+"dateien2.tak") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.tak") COPY FILE (cDatver+"dateien2.sdf") TO (cDrive+SubStr(cDatver,2,Len(cDatver)-3)+Str(n,1)+"\"+"dateien2.sdf") NEXT cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE param EXCLUSIVE // „ndert die c:\hdbe\param auf das Stick-Laufwerk param->datver := cDrive + SubStr(param->datver,2) param->netver1 := cDrive + SubStr(param->netver1,2) param->netver2 := cDrive + SubStr(param->netver2,2) param->netver3 := cDrive + SubStr(param->netver3,2) param->netver4 := cDrive + SubStr(param->netver4,2) param->netver5 := cDrive + SubStr(param->netver5,2) param->netver6 := cDrive + SubStr(param->netver6,2) param->netver7 := cDrive + SubStr(param->netver7,2) param->netver8 := cDrive + SubStr(param->netver8,2) param->netver9 := cDrive + SubStr(param->netver9,2) USE cDummyD := cDatver FOR n := 1 TO 9 // macht in allen Stick-Verzeichnissen einen Prflauf CLEAR @ 5+n,5 SAY Str(n,1)+"-Daten werden indiziert..." cDatver := SubStr(cDatver,1,Len(cDatver)-2)+Str(n,1)+"\" SET DEFAULT TO &cDatver ineux(.F.) NEXT cDatver := cDummyD SET DEFAULT TO &cDatver ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.3 // umstellen auf 'Arbeiten auf dem USB-Stick' ohne Prflauf cDrive := USBDrive(SubStr(cDatver,3)) // lokalisiert ds Stick-Laufwerk IF cDrive$"DEFGHIJK" // kopiert keine Prog-Dateien + kein Prflauf cDatver := cDrive + SubStr(cDatver,2) SET DEFAULT TO &cDatver USE param EXCLUSIVE // „ndert die c:\hdbe\param auf das Stick-Laufwerk param->datver := cDrive + SubStr(param->datver,2) param->netver1 := cDrive + SubStr(param->netver1,2) param->netver2 := cDrive + SubStr(param->netver2,2) param->netver3 := cDrive + SubStr(param->netver3,2) param->netver4 := cDrive + SubStr(param->netver4,2) param->netver5 := cDrive + SubStr(param->netver5,2) param->netver6 := cDrive + SubStr(param->netver6,2) param->netver7 := cDrive + SubStr(param->netver7,2) param->netver8 := cDrive + SubStr(param->netver8,2) param->netver9 := cDrive + SubStr(param->netver9,2) USE ENDIF DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) CASE Val(cV) = 9.5 // kopieren in das Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.55 // kopieren in das Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird zur Email kopiert..." BDaten_zur_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.6 // kopieren vom Email-Verzeichnis @ 10,5 SAY cFirma+"-Daten werden aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3)) CASE Val(cV) = 9.66 // kopieren vom Email-Verzeichnis - Kasse @ 10,5 SAY cFirma+"-Kasse wird aus der Email kopiert..." BDaten_von_Email(SubStr(cDatver,1,2),SubStr(cDatver,3),"dateien2") CASE Val(cV) = 9.9 // Prflauf dieser Filiale DbCloseAll() ineux("T") DatVerUm( 1 + Val(cDatver[Len(cDatver)-1])/10 ) ENDCASE ELSE DO CASE CASE cV == "5" DATEN_Backup() CASE cV == "6" DATEN_Restore() CASE cV == "7" @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server() CASE cV == "8" @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server() ineux(.F.) CASE cV == "9" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_zum_Server(,"\HDBDIENST") CASE cV == "10" //19.11.2006 19:08 fr BleinX @ 10,5 SAY "Daten werden kopiert..." Daten_vom_Server(,"\HDBDIENST") ineux(.F.) CASE cV == "11" cS_b := "s_scrap" CASE cV == "12" //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ DbCloseAll() IIf(ValType(oBest:oSuchThrd)=="O",{oBest:oSuchThrd:terminate(), ; PostAppEvent( 1048632 ,,, aThrdFenster[3] ), ; //+22.03.2010 22:32 ThreadWait({oBest:oSuchThrd},10), ; oBest:oSuchThrd := NIL},) //+27.02.2010 18:36 oBest:oSuchThrd := NIL aThrdFenster[3] := NIL IIf(ValType(oBest:oScanThrd)=="O",{oBest:oScanThrd:terminate(), ; PostAppEvent( 1048632 ,,, aThrdFenster[4] ), ; //+22.03.2010 22:32 ThreadWait({oBest:oScanThrd},10), ; oBest:oScanThrd := NIL},) //+27.02.2010 18:36 aThrdFenster[4] := NIL IIf(ValType(oBest:oHistThrd)=="O",{oBest:oHistThrd:terminate(), ; PostAppEvent( 1048632 ,,, aThrdFenster[5] ), ; //+22.03.2010 22:32 ThreadWait({oBest:oHistThrd},10), ; oBest:oHistThrd := NIL},) //+27.02.2010 18:36 aThrdFenster[5] := NIL IIf(ValType(oBest:oStatistikThrd)=="O",{oBest:oStatistikThrd:terminate(), ; PostAppEvent( 1048632 ,,, aThrdFenster[8] ), ; //+22.03.2010 22:32 ThreadWait({oBest:oStatistikThrd},10), ; oBest:oStatistikThrd := NIL},) //+23.03.2010 21:07 aThrdFenster[8] := NIL //+19.08.2012 15:46 6 statt 5 // IIf(ValType(oBest:oPLZThrd)=="O",{oBest:oPLZThrd:terminate(), ; // ThreadWait({oBest:oPLZThrd}), ; // oBest:oPLZThrd := NIL},) //+27.02.2010 18:36 aThrdFenster[2]:hide() cRS := "0" ; cBNr := "0" aThrdFenster[2] := NIL ThreadObject():setInterval(NIL) PostAppEvent( xbeU_RefreshApp,NIL,2, aThrdFenster[1] ) ThreadObject():QUIT() ENDCASE DatVerUm(IIf(Upper(cDatver)=="C:\HDBE\",0,1)) //28.04.2008 09:55 ENDIF cV := " " DO WHILE nEvent <> xbe_None //+13.11.2008 09:39 nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO ENDIF ENDDO SET DATE TO GERMAN RETURN //------------------------------------------ //+23.06.2009 13:23 jetzt mit AlertBox (ist alwaysontop) FUNCTION FehlerBehandlung(oError) LOCAL oFenster := SetAppFocus() LOCAL cFehler := "Fehlerart: "+oError:description +";"+ ; "in Operation: "+oError:operation +";"+ ; IIf(!Empty(oError:filename), "Datei: "+oError:filename +";","") + ; "aufgerufen von:" +";"+ ; IIf( !Empty(ProcName(1)), ProcName(1)+"("+LTrim(Str(ProcLine(1)))+")"+";","")+; IIf( !Empty(ProcName(2)), ProcName(2)+"("+LTrim(Str(ProcLine(2)))+")"+";","")+; IIf( !Empty(ProcName(3)), ProcName(3)+"("+LTrim(Str(ProcLine(3)))+")"+";","")+; IIf( !Empty(ProcName(4)), ProcName(4)+"("+LTrim(Str(ProcLine(4)))+")"+";","")+; IIf( !Empty(ProcName(5)), ProcName(5)+"("+LTrim(Str(ProcLine(5)))+")"+";","")+; IIf( !Empty(ProcName(6)), ProcName(6)+"("+LTrim(Str(ProcLine(6)))+")"+";","")+; IIf( !Empty(ProcName(7)), ProcName(7)+"("+LTrim(Str(ProcLine(7)))+")"+";","")+; IIf( !Empty(oError:filename), "Die Datei "+oError:Filename+" fehlt/ist gesperrt!"+";","") //+30.09.2012 18:29 neu: can's IF oError:canRetry .AND. oError:tries < 5 IF AlertBox( , cFehler, ; { "Wiederholen mit ", "Datenretten + Ende mit " } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Ein m”glicherweise korrigierbarer Fehler ist aufgetreten!" ) = 1 RETURN .T. ENDIF ENDIF IF oError:canDefault .AND. Empty(oError:Filename) IF AlertBox( , cFehler, ; { "Ignorieren mit ", "Datenretten + Ende mit " } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Ein m”glicherweise ignorierbarer Fehler ist aufgetreten!" ) = 1 RETURN .F. ENDIF ENDIF IF oError:canSubstitute IF AlertBox( , cFehler, ; { "Vertuschen mit ", "Datenretten + Ende mit " } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Ein m”glicherweise vertuschbarer Fehler ist aufgetreten!" ) = 1 // IF "VARIABLE HAT FALSCHEN TYP"$Upper(oError:description) ... fr sp„ter ... RETURN oError:description // mal schauen, was das in der Praxis beringt... ENDIF ENDIF IF oError:severity > 1 IF AlertBox( , cFehler, ; { "Ignorieren mit ", "Datenretten + Ende mit " } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Ein Fehler ist aufgetreten!" ) = 2 DbCloseAll() USE AK_F_LOG new APPEND BLANK AK_F_LOG->datum := DATE() AK_F_LOG->zeit := Time() AK_F_LOG->logtext := DtoC(DATE()) +CRLF+ ; Time() +CRLF+ ; cFehler +CRLF+ ; "Benutzer: "+cBK+"/"+cRS +CRLF+ ; "Thread: " + LTrim(Str(ThreadId())) + "/"+ThreadObject():ClassName() USE BREAK() ENDIF ENDIF RETURN .F. //------------------------------------------ FUNCTION Fallsuche() RETURN .T. FUNCTION NeuerFall() RETURN .T. //------------------------------------------ //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: VAR aBP // Betreffperson, je nach TAB: Ansprechpartner/Ehepartner/Angeh”riger VAR EditAnliefNr // =aktuelle Auftrnr, wenn editierbar VAR Fall_geloescht // wenn .T. wird Listbox-Letzte30 neu gefllt VAR cS_b // = "s_best" (bei Flues auch "s_bes2") VAR TLog // TransaktionenLogbuch-Objekt VAR oHistThrd /* das Thread-Objekt des Historien-Programms 24.06.2008 16:16 */ VAR oSuchThrd /* das Thread-Objekt des AnliefSuch-Programms 08.07.2008 10:53 */ VAR oScanThrd /* das Thread-Objekt des Bild-Darstellungs-Programms 09.07.2008 18:31 */ VAR oPLZThrd //+21.10.2008 22:19 VAR oStatistikThrd //+26.01.2010 14:03 das Thread-Objekt des Rechnungs-Statistik-Programms VAR lUser //+20.08.2012 14:33 zur Unterscheidung desselben Users auf verschiedenen PCs METHOD INIT METHOD CREATE METHOD notify // managt z.B. ::PaintTip, ::WochenTag METHOD NeueNummer /* sucht eine freie Nummer zu einem vorgegebenen Nummernkreis */ METHOD FeldSuche //* Suche nach einem beliebigen Feld, in das man vorher geklickt hat METHOD Aendern /* l„sst den Datensatz „ndern durch z.B.:'EditAnliefNr:=1->anummer' 29.06.2008 08:32*/ METHOD Rueckgaengig /* macht die Žnderungen rckg„ngig: kopiert ::aData0 wieder in den Datensatz */ METHOD Speichern /* manifestiert die Žnderung und teilt sie anderen Threads mit */ METHOD PflichtFelder //* kontrolliert, ob vor dem Speichern die Pflichtfelder ausgefllt sind METHOD HistSchreiben //* schreibt Daten in Historie.dbf, wenn ver„ndert METHOD ShowScan //* zeigt die gescannten Objekte auf der mittleren TabPage METHOD ShowHist //* zeigt die Historie zu diesem Anlieferer auf der rechten TabPage METHOD ShowAbrech //+26.01.2010 13:57 zeigt die bisherigen Abrechnungen im Suchfenster METHOD GoAbrech //+12.07.2010 09:53 Methode fr die -Kn”pfe: zur Abrechnung gehen METHOD ZumAnfang //* ersetzen die Funktionen aus bestf8.prg 12.07.2008 22:13 METHOD Zurueck //* METHOD Vorwaerts //* METHOD ZumEnde //* METHOD AnliefSuche /* Suche des Anliefers nach jedem beliebigen Feld */ METHOD AnliefLoeschen // markiert den Anlieferer als gel”scht in 1->notiz METHOD NamenSuche // sucht nach cSuch:=1->name bei der Neueingabe (findet gleiche Namen) METHOD DruckAlle // druckt Briefe an alle, die eine Filterbedingung erfllen METHOD Ordnen // Index nach beliebigem Feld METHOD ProgEntpacken // BergX.ZIP in cDatver\POST entpacken nach \hdbe\Prog METHOD TabMax // berl„dt Parent, damit Betreffperson umgeschaltet wird METHOD TabDaten // holt die Daten aus der obersten TabPage METHOD FormularNotiz // vermerkt Formularausdrucke im Notizfeld, wenn BL_UPPERCASE METHOD BenutzerBereinigung // 30.09.2012 16:08 l”scht alle Eintr„ge dieses Benutzers + aktueller Fall ist seiner 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 ) ::aStructure := 1->(DbStruct()) ::VArea := nA ::aIndex := { "Anlieferer-Nummer", "Anlieferer-Name", cVariable } ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::aFelder := {} // Array mit allen Feldnamen AEval( ::aStructure, {|a| AAdd( ::aFelder, a[1] ) } ) ::aData0 := Array(FCount()) // Array mit allen Feldinhalten, vor der Ver„nderung fr ::Rueckgaengig() AEval( ::aStructure, {|a,i,c| c:=a[1], ::aData0[i] := &c } ) ::aData1 := Array(FCount()) // Array mit allen Feldinhalten, vor der Ver„nderung AEval( ::aStructure, {|a,i,c| c:=a[1], ::aData1[i] := &c } ) ::aData2 := Array(FCount()) // Array mit allen Feldinhalten, nach der Ver„nderung ::EditAnliefNr := "" // beim Start ist noch kein Auftrag editierbar IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) ::EditAnliefNr := "" ELSEIF 1->benutzer != cBK ::EditAnliefNr := "1"+Replicate("0",E) ENDIF ENDIF ::Fall_geloescht := .F. // beim Start ist noch kein Auftrag gel”scht 26.06.2006 16:01 ::cS_b := "s_scrap" // s_best o.„. ::TLog := TLogWriter():new( "TLog.dbf" ) //16.09.2007 19:31 TXT-Datei zur Tarnung als .dbf ::lUser := .F. //+20.08.2012 14:32 .T. heiát: eingeloggter Benutzer besitzt diesen Datensatz 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, oldcolbg DbSuspendNotifications() IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_PROLOG // Skip wird starten /* Nummernkreis-abh„ngiger Zugang: */ IF Val(cRS) >= aZugang[4,Val(1->anummer[1])+1] /* wenn Rechte ausreichen... */ ASize( aZugang, 13 ) AAdd( aZugang, 1->(Recno()) ) /* ... wird Recno() in aZugang[14] gespeichert */ ENDIF /* damit ein Benutzer den Auftrag automatisch wieder entsperrt: */ IF 1->benutzer == cBK .AND. ::lUser //+19.08.2012 13:44 wenn es Dein Anlieferer ist Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := " ") DbRUnlock() DbCommit() //+20.08.2012 19:36 vorsichtshalber ::lUser := .F. //+20.08.2012 14:25 ENDIF ENDIF /////////////////////////////////////////////////////////////////////////////////// // hier wurde frher die Historie geschrieben, // jetzt wird die Historie nur dann geschrieben, // -wenn geklickt wird // -wenn mit den Pfeiltasten gewandert wird (oder den entsprechenden ShortCuts) /////////////////////////////////////////////////////////////////////////////////// // wenn der Satzzeiger am Ziel ist: IF mp1 == DBO_MOVE_DONE .OR. mp1 == DBO_GOBOTTOM .OR. mp1 == DBO_GOTOP /*29.03.2008 18:00 Anlieferer und Anlieferernr. zum Weitergeben: */ oBEDA:cargo:setTitle( Stuff( oBEDA:cargo:title, At("*",oBEDA:cargo:title), 100, "* "+Trim(1->name)+", "+Trim(1->vorname)+" - "+1->anummer ) ) /**/ /**/ /* ein Benutzer den Auftrag automatisch fr sich sperrt: */ IF 1->(IsFieldVar("benutzer")) //30.07.2007 14:17 IF Empty(1->benutzer) /* wenn Auftrag frei ist */ Satzsp(oCB) ::XbpObjektSet(,"BENUTZER",1->benutzer := cBK) DbRUnlock() DbCommit() //+20.08.2012 12:55 vorsichtshalber ::EditAnliefNr := "" ::lUser := .T. //+18.08.2012 23:29 das ist Dein Anlieferer ELSEIF cBK == 1->benutzer .AND. !::lUser .AND. oBEDA:cargo:isVisible() //+18.08.2012 22:31 20.08.2012 19:25 AlertBox( , "Dieser Anlieferer ist schon fr Dich="+1->benutzer+" reserviert!;" + ; "Du darfst/kannst HIER seine Daten nicht ver„ndern!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Achtung: Schon auf anderem PC eingeloggt?",GRA_CLR_CYAN) ::EditAnliefNr := "1"+Replicate("0",E) /*...1000000 in die anummer == kann nicht ver„ndert werden*/ ::lUser := .F. //+18.08.2012 23:29 dieser Anlieferer geh”rt Dir nicht ELSEIF 1->benutzer != cBK /* wenn Auftrag schon besetzt ist... */ ::EditAnliefNr := "1"+Replicate("0",E) /*...1000000 in die anummer*/ ::lUser := .F. //+18.08.2012 23:29 dieser Anlieferer geh”rt Dir nicht ENDIF ENDIF //14.09.2007 15:52 'gel”schte' Anlieferer werden disabled: y := ::XbpNummer(::singleZeile,"ADATUM") z := Len(::singleZeile)-y // ::XbpNummer(::singleZeile,"PvSALDO") IF "g e l ” s c h t"$1->notiz //+30.09.2012 21:57 AEval( ::singleZeile, {|a,i| a:disable() }, y, z-y ) /*alle ab adatum disabled */ AEval( ::singleZeile, {|a,i| a:disable() } ) //+30.09.2012 21:57 , y, z-y ) /*alle ab adatum disabled */ AEval( ::ListBox, {|a,i| a:disable() } ) /*alle disabled */ IIf(ValType(::XbpObjekt(::multiZeile,"NOTIZ",.F.))="O",::XbpObjekt(::multiZeile,"NOTIZ",.F.):disable(),) IIf(ValType(::XbpObjekt(::multiZeile,"notiz",.F.))="O",::XbpObjekt(::multiZeile,"notiz",.F.):disable(),) ELSE /* hier vielleicht noch eine Abfrage, ob ein Feld disabled ist, dann... */ //+30.09.2012 22:14 AEval( ::singleZeile, {|a,i| a:enable() }, y, z-y ) AEval( ::singleZeile, {|a,i| a:enable() }, 2 ) //+30.09.2012 22:14 , z-y ) AEval( ::ListBox, {|a,i| a:enable() } ) /*alle disabled */ IIf(ValType(::XbpObjekt(::multiZeile,"NOTIZ",.F.))="O",::XbpObjekt(::multiZeile,"NOTIZ",.F.):enable(),) IIf(ValType(::XbpObjekt(::multiZeile,"notiz",.F.))="O",::XbpObjekt(::multiZeile,"notiz",.F.):enable(),) ENDIF //+07.06.2009 09:07 damit der SuchThrd synchronisiert wird: IIf(ValType(aThrdFenster[3])=="O",PostAppEvent( xbeU_RefreshSuch, RecNo(), , aThrdFenster[3] ),) //* refresht die Suchtabelle 01.06.2009 09:29 18.10.2012 10:59 IIf(ValType(aThrdFenster[4])=="O",PostAppEvent( xbeU_RefreshHist, 1->anummer, , aThrdFenster[4] ),) //+02.03.2010 18:41 IIf(ValType(aThrdFenster[6])=="O",PostAppEvent( xbeU_RefreshRechng, , , aThrdFenster[6] ),) //+02.03.2010 19:28 /* schaltet die Farben je nach Nummernkreis: ----- noch fr ScrapX umbauen!!!!! */ IF ::lUser //+20.08.2012 17:49 wenn Dir der Anlieferer alleine geh”rt ::BEArea[1]:cargo:oIconbar:setColorBG( GraMakeRGBColor({175,175,175}) ) ELSE ::BEArea[1]:cargo:oIconbar:setColorBG( GRA_CLR_CYAN ) ENDIF IF "//alt//"$1->zusatz ::BEArea[aBea[1]]:setColorFG( GRA_CLR_YELLOW ) oldcolbg := ::BEArea[aBea[1]]:setColorBG( GRA_CLR_RED ) ELSEIF "//gesperrt//"$1->zusatz ::BEArea[aBea[1]]:setColorFG( GRA_CLR_BLUE ) oldcolbg := ::BEArea[aBea[1]]:setColorBG( GRA_CLR_YELLOW ) ELSE ::BEArea[aBea[1]]:setColorFG( GRA_CLR_BLACK ) ::BEArea[aBea[1]]:setColorBG( GraMakeRGBColor(aC[1]) ) ENDIF IF !Empty(1->uidn_nr) //+30.05.2010 18:48 fr Brutto-Anlieferer oEdit:XbpObjekt(oEdit:TextZeile,"uidn_nr"):setColorBG( GRA_CLR_RED ) ELSE oEdit:XbpObjekt(oEdit:TextZeile,"uidn_nr"):setColorBG( GraMakeRGBColor({200,175,150}) ) ENDIF IF (DtoC(1->voll_dat)!=" " .AND. DATE() > (1->voll_dat)) .OR. ; //+19.10.2010 14:39 Vollmach „lter als ein Jahr (DtoC(1->voll_dat1)!=" " .AND. DtoC(1->voll_dat)=" " .AND. DATE()-(1->voll_dat1) > 366) oEdit:XbpObjekt(oEdit:TextZeile,"voll_dat1"):setColorBG( GRA_CLR_CYAN ) ELSE oEdit:XbpObjekt(oEdit:TextZeile,"voll_dat1"):setColorBG( GraMakeRGBColor({200,175,150}) ) ENDIF ::SatzLesen(1) /* 28.06.2008 18:31 liest den aktuellen Datensatz in ::aData1 ein */ ENDIF ENDIF /* wird bei ScrapX nicht gebraucht: ::WochenTag() // 14.4.2005 zeigt fr TD1-4 den Wochentag an*/ DbResumeNotifications() RETURN self /* sucht eine neue Nummer zu einem vorgegebenen Nummernkreis */ METHOD BestFF:NeueNummer( cKreis ) LOCAL nRec := RecNo() LOCAL cItem := " " DEFAULT cKreis TO "X" IF !::Speichern() //+06.08.2008 23:02 RETURN "Erst den laufenden Fall abschlieáen!" ENDIF //+05.08.2008 22:21 erst einmal eine leere Nummer suchen (falls vorhanden): DbSuspendNotifications() OrdSetFocus(2) DbSeek(" ",.F.,"na") DO WHILE (anummer == "000000" .OR. anummer == "999999") .AND. !Eof() DbSkip() IF anummer != "000000" .AND. anummer != "999999" .AND. name[1] < "A" .AND. !Eof() OrdSetFocus(1) DbResumeNotifications() RETURN "Diese Nummer ist noch frei!" ENDIF ENDDO OrdSetFocus(1) IF cKreis == "X" /* egal welche Nummer? */ DbGobottom() /* dann gehe ans Ende */ cItem := StrX(Val(1->anummer)+1,6) /* nimm einfach 1 h”her als die h”chste Nummer */ ELSEIF cKreis == "0" .OR. Val(cKreis) > 0 OrdSetFocus(1) DbSeek( Str(Val(cKreis)+1,1)+"00000", .T., 1 ) /* Softseek findet ersten h”heren Wert */ DbSkip(-1) /* zurck in den richtige Nummernkreis */ IF 1->anummer[1] == cKreis /* ist es auch wirklich der richtige? */ cItem := StrX(Val(1->anummer)+1,6) /* dann z„hle eins hoch */ ELSE /* nein? : */ cItem := cKreis + "00001" /* dann baue die erste Nummer selber auf */ ENDIF DbGoto(nRec) ENDIF DbResumeNotifications() RETURN IIf( cItem[1]=cKreis, cItem, "Keine geeignete Nummer gefunden!" ) //* 08.07.2008 10:21 Suche nach einem beliebigen Feld , in das man vorher geklickt hat METHOD BestFF:FeldSuche(oFeld) LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. IF !Empty( ::oSuchThrd ) AEval( aInfo, {|a,i| IIf( a[1] == ::oSuchThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF DEFAULT oFeld TO oFocSle //+17.07.2008 17:24 fr alle F„lle Historie IF ::Speichern() DbCommit() ::EditAnliefNr := "" // macht wieder !editable ENDIF //* das Suchfeld steht in oFocSle, weil vorher dahin geklickt wurde IF !lThreadIstAktiv ::oSuchThrd := SuchThrd():new() ::oSuchThrd:start( , ::XbpObjekt(::BEArea,"THREAD3-1"), RecNo(), oFeld ) ::oSuchThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshSuch, RecNo(), oFeld, aThrdFenster[3] ) //* refresht die Suchtabelle 01.06.2009 09:29 ENDIF ::TabMax(::XbpObjekt(::TabSeite,"Suchen"),{+1,+2,0}) RETURN self /*29.06.2008 08:33 Auftrag auf 'darf ge„ndert werden' setzen: */ METHOD BestFF:Aendern(cNr) ::SatzLesen(0) /* fr ::Rueckgaengig() */ RETURN ::EditAnliefNr := cNr /*29.06.2008 08:33 Auftrag wieder auf Zustand vor der Žnderung setzen: */ METHOD BestFF:Rueckgaengig() ::SatzLesen(2) /*28.06.2008 18:30 liest den aktuellen Datensatz in ::aData2 ein */ IF !ACompare( ::aData1, ::aData2, FieldPos("benutzer") ) .AND. ; 1->anummer > "000000" .AND. 1->anummer < "999999" /*? 999999 ?*/ /* wenn der Datensatz ver„ndert wurde */ IF AlertBox( , "Eingaben zu diesem Anlieferer rckg„ngig machen?;" + ; "; berschreibt mit vorigen Werten" + ; "; Daten beibehalten und weiter eingeben", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "ACHTUNG!" ) = 1 ::SatzSchreiben(0) /* schreibt ::aData0 in die Datei */ ::oOwner:readData() /* damit es wieder dargestellt wird */ ENDIF ELSE //+17.07.2008 17:18 soll hier gesagt werden, dass nichts rckg„ngig zu machen ist?? ENDIF RETURN ::EditAnliefNr := "" /* macht wieder !editable */ /*29.06.2008 08:33 Auftrag wird mit oHistThrd abgeglichen und wieder als !editable' markiert: */ METHOD BestFF:Speichern() LOCAL lGespeichert := .F. IF ::PflichtFelder() DbCommit() /* l”st Notification aus, der Rest passiert in ::notify() */ ::SatzLesen(0) /* macht ::Rueckgaengig unm”glich */ ::EditAnliefNr := "" // macht wieder !editable PostAppEvent( xbeU_RefreshSuch, RecNo(),, aThrdFenster[3] ) //* refresht die Suchtabelle 01.06.2009 09:29 lGespeichert := .T. ::HistSchreiben() ELSE //+15.11.2009 17:59 MsgBox( "* Pflichtfelder mssen ausgefllt werden!", "Angaben unvollst„ndig!" ) AlertBox( , "* Pflichtfelder mssen ausgefllt werden!" + ; ";", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Angaben unvollst„ndig!" ) //+15.11.2009 17:41 ENDIF RETURN lGespeichert METHOD BestFF:PflichtFelder() LOCAL lPflichtOK := .T. IF !1->anummer$"000000 999999" .AND. !"g e l ” s c h t"$1->notiz .AND. !1->(Eof()) //+12.07.2009 20:54 FOR i := 1 TO Len(::aBeschreib) IF "*"$::aBeschreib[i] c := FieldGet(i) DO CASE CASE ValType(c) == "C" lPflichtOk := (Len(Trim(c)) != 0) CASE ValType(c) == "N" lPflichtOK := (c != 0) CASE ValType(c) == "D" lPflichtOK := (DtoC(c)!=" ") ENDCASE IF !lPflichtOK EXIT ENDIF ENDIF NEXT ENDIF RETURN lPflichtOK //*12.07.2008 21:39 Datensatz von Anlief.dbf in die Historie.dbf schreiben, wenn er ge„ndert wurde: METHOD BestFF:HistSchreiben() LOCAL n /* 25.06.2008 19:16 ist der Datensatz ver„ndert worden? -> Historie updaten */ ::SatzLesen(2) /*28.06.2008 18:30 liest den aktuellen Datensatz in ::aData2 ein */ //* ACompare() nimmt beim Vergleich den Benutzer aus: IF !ACompare( ::aData1, ::aData2, FieldPos("benutzer") ) .AND. ; 1->anummer > "000000" .AND. 1->anummer < "999999" /*? 999999 ?*/ /* wenn der Datensatz ver„ndert wurde */ DbSelectArea( 2 ) 2->(DbSuspendNotifications()) 2->(DbSeek( ::aData2[1], .F., "an" )) IF 2->(Eof()) 2->(DbAppend()) FOR n := 1 to Len(::aData2) FieldPut( n, ::aData2[n] ) /* neu anlegen */ NEXT 2->hdatum := DATE() 2->huhrzeit := Time() 2->typ := "NEU" 2->betr_fldr := "Neuanlage dieses Anlieferers am " + DtoC(DATE()) + " ." /* wenn noch gar keiner da war */ ELSE /* hier msste wohl noch abgefangen werden, wenn innerhalb eines Tages bzw. einer Sitzung durch Unterbrechungen mehrere 'Žnderungen' protokolliert werden */ DO WHILE DATE() > 2->hdatum .AND. !2->(Eof()) 2->(DbSkip()) ENDDO IF DATE() == 2->hdatum .AND. 1->anummer == 2->anummer //* wenn derselbe Anlieferer und derselbe Tag, dann berschreiben, //+ aber nur, wenn es sich um eine Žnderung handelt (nicht am Neuanlagetag) IF 2->typ == "NEU" //+ wenn NEU, dann keine Einzel„nderungen protokollieren ::SatzLesen(1) /*06.08.2008 22:31 liest den aktuellen Datensatz in ::aData1 ein, damit es hier wieder beginnt */ RETURN self ENDIF 2->(Satzsp(oBEDA)) ELSE //* sonst neuen Historie-Satz anlegen: 2->(DbAppend()) ENDIF FOR n := 1 to Len(::aData2) FieldPut( n, ::aData2[n] ) /* berschreiben / neu anlegen */ NEXT 2->hdatum := DATE() 2->huhrzeit := Time() 2->typ := "Žnderung" 2->betr_fldr += IIf( Len(Trim(2->betr_fldr))>2 .AND. ; Right(Trim(2->betr_fldr),2) != Chr(13)+Chr(10), CRLF, "" ) + ; "Žnderung der Anlieferer-Daten am " + DtoC(DATE()) + " durch " + cBK +":" 2->bearbeiter := cBK FOR n := 1 TO Len(::aData1) /* Žnderungen protokollieren: */ IF ::aData1[n] != ::aData2[n] .AND. n != 1->(FieldPos("benutzer")) IF ValType( ::aData1[n] ) == "C" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + Trim(::aData1[n]) + " zu " + Trim(::aData2[n]) ELSEIF ValType( ::aData1[n] ) == "N" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + Str(::aData1[n]) + " zu " + Str(::aData2[n]) ELSEIF ValType( ::aData1[n] ) == "D" 2->betr_fldr += CRLF + ::aStructure[n,1] + " von " + DtoC(::aData1[n]) + " zu " + DtoC(::aData2[n]) ELSE 2->betr_fldr += CRLF + "Notizen erg„nzt" ENDIF ENDIF NEXT //* erst am Ende noch ein CRLF, wenn da noch keines steht. IF Right(Trim(2->betr_fldr),2) != Chr(13)+Chr(10) 2->betr_fldr += CRLF ENDIF ENDIF 2->(DbRUnlock()) 2->(DbResumeNotifications()) IF ValType(oHist) == "O" .AND. 1->anummer < "999999" /* Meldung an Historie: Es gibt was Neues: */ PostAppEvent( xbeU_RefreshHist, 1->anummer, RecNo(), aThrdFenster[4] ) //+01.06.2009 09:29 ENDIF DbSelectArea( 1 ) ENDIF /**/ ::SatzLesen(1) /*06.08.2008 22:31 liest den aktuellen Datensatz in ::aData1 ein, damit es hier wieder beginnt */ RETURN self //+01.09.2009 22:18 ge„ndert, „hnlich wie aaa\bestp METHOD BestFF:ShowScan(cDateiName,nRec1) //+20.10.2009 21:05 nRec LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. //:= IIf( Empty(::oScanThrd), .F., aInfo[Min(Len(aInfo),::oScanThrd:threadid),2] != NIL ) LOCAL nRec := IIf(nRec1!=NIL,nRec1,RecNo()) //+20.10.2009 21:05 IF !Empty( ::oScanThrd ) AEval( aInfo, {|a,i| IIf( a[1] == ::oScanThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF IF ::Speichern() //+26.01.2010 13:51 jetzt hier auch DbCommit() ::EditAnliefNr := "" // macht wieder !editable ENDIF IF !lThreadIstAktiv ::oScanThrd := ScanThrd():new() ::oScanThrd:start( , ::XbpObjekt(::BEArea,"THREAD5-1"), nRec, cDateiName ) ::oScanThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshScan, nRec, cDateiName, aThrdFenster[5] ) //*01.06.2009 09:30 5 statt 4 ?:die Suchtabelle ENDIF IF !(ValType(cDateiName) == "C" .AND. cDateiName = "_") ::TabMax(::XbpObjekt(::TabSeite,"Vorschau"),{-1,+1,+2,0}) ENDIF RETURN self METHOD BestFF:ShowHist() LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. IF !Empty( ::oHistThrd ) AEval( aInfo, {|a,i| IIf( a[1] == ::oHistThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF IF ::Speichern() DbCommit() ::EditAnliefNr := "" // macht wieder !editable ENDIF IF !lThreadIstAktiv ::oHistThrd := HistThrd():new() ::oHistThrd:start( , ::XbpObjekt(::BEArea,"THREAD4-1"), 1->anummer, RecNo(), ::XbpObjekt(::BEArea,"THREAD4-2") ) ::oHistThrd:setInterval(10) ELSE PostAppEvent( xbeU_RefreshHist, 1->anummer, RecNo(), aThrdFenster[4] ) //*01.06.2009 09:30 4 statt 3 ?:refresht die Suchtabelle ENDIF ::TabMax(::XbpObjekt(::TabSeite,"Historie"),{-1,-2,+1,0}) RETURN self //+26.01.2010 13:56 zeigt im Suchfenster die bisherigen Abrechnungen dieses Anlieferers METHOD BestFF:ShowAbrech(cAuf) LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F., lThreadExistiert := .F. //+16.09.2012 10:33 DEFAULT cAuf TO "-alle-" //+23.03.2010 20:55 IF !Empty( ::oStatistikThrd ) // AEval( aInfo, {|a,i| IIf( a[1] == ::oRechngThrd:threadid .AND. a[3] != NIL, ; // lThreadIstAktiv := .T.,) } ) //+16.09.2012 10:23 Thread kann existieren ohne aktiv zu sein, dann muss er gestartet werden, aber nicht erzeugt AEval( aInfo, {|a,i| IIf( a[1] == ::oStatistikThrd:threadid .AND. a[3] != NIL, ; {lThreadIstAktiv := .T.,lThreadExistiert := .T.}, ; IIf( a[1] == ::oStatistikThrd:threadid, lThreadExistiert := .T.,) ) } ) ENDIF IF ::Speichern() DbCommit() ::EditAnliefNr := "" // macht wieder !editable ENDIF IF !lThreadIstAktiv IF !lThreadExistiert IF Len(cStickVer) > 7 ::oStatistikThrd := StatThrd():new() ELSE ::oStatistikThrd := RechLThrd():new() //+16.09.2012 14:55: muss ge„ndert werden in StatL~ ENDIF ENDIF ::oStatistikThrd:start( , 1->anummer, cAuf, ::XbpObjekt(::BEArea,"Thread6-1"),"bl_r" ) //+23.03.2010 20:55 cAuf ::oStatistikThrd:setInterval(NIL) ELSE // wenn der Thread aktiv ist, dann braucht er nicht gestartet zu werden! PostAppEvent( xbeP_Close,,,aThrdFenster[8]) sleep(10) ::oStatistikThrd := StatThrd():new() ::oStatistikThrd:start( , 1->anummer, cAuf, ::XbpObjekt(::BEArea,"Thread6-1"),"bl_r" ) //+23.03.2010 20:55 cAuf ::oStatistikThrd:setInterval(NIL) // PostAppEvent( xbeU_RefreshHist, 1->anummer, RecNo(), aThrdFenster[4] ) //*01.06.2009 09:30 4 statt 3 ?:refresht die Suchtabelle ENDIF ::TabMax(::XbpObjekt(::TabSeite,"StatistikA"),{-1,-2,-3,0}) RETURN self //+12.07.2010 09:45 ruft die Abrechnung auf METHOD BestFF:GoAbrech() IF cBK != 1->benutzer //+18.08.2012 22:31 AlertBox( , "Dieser Anlieferer ist fr "+1->benutzer+" reserviert!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",GRA_CLR_CYAN) RETURN self ELSEIF "//alt//" $ 1->zusatz .AND. !1->benutzer $ "MD YYY" AlertBox( , "Diese Abrechnungen darf nur MD „ndern!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$1->zusatz .OR. "//gesperrt//"$1->zusatz,GRA_CLR_RED,)) //+11.07.2010 21:32 RETURN self ELSEIF "//alt//" $ 1->zusatz .AND. 1->benutzer $ "MD YYY" .AND. ; AlertBox( , "Dieser Lieferant ist als ALT markiert!!;" + ; ";", ; { "JA", "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$1->zusatz .OR. "//gesperrt//"$1->zusatz,GRA_CLR_RED,)) = 2 //+11.07.2010 21:32 RETURN self ELSEIF "//gesperrt//" $ 1->zusatz .AND. ; AlertBox( , "Dieser Lieferant ist als gesperrt markiert!!;" + ; ";", ; { "JA", "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$1->zusatz .OR. "//gesperrt//"$1->zusatz,GRA_CLR_RED,)) = 2 //+11.07.2010 21:32 RETURN self ENDIF IF 1->name[1]<"A" .OR. 1->ausw_nr[1]<"0" .OR. DtoC(1->ausw_scn_v)=" " AlertBox(,"Legitimation: Name, Ausw-Nr oder Scandatum fehlt",,,"A C H T U N G !") ENDIF aThrdFenster[2]:hide() // PostAppEvent( 134217759,6,1->anummer, aThrdFenster[1])}) } PostAppEvent( xbeU_RefreshApp,6,1->anummer, aThrdFenster[1]) RETURN self METHOD BestFF:ZumAnfang( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoTop()) ENDIF ELSE (nA)->(DbGoTop()) (nA)->(DbSkip(0) ) ENDIF RETURN .T. METHOD BestFF:Zurueck( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) IF ! (nA)->(Bof()) (nA)->(DbSkip(-1)) IF (nA)->(Bof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(1)) (nA)->(DbGoTop()) (nA)->(DbResetNotifications()) ENDIF ENDIF ENDIF ELSE (nA)->(DbSkip(-1) ) ENDIF RETURN .T. METHOD BestFF:Vorwaerts( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) IF ! (nA)->(Eof()) (nA)->(DbSkip(1)) IF (nA)->(Eof()) (nA)->(DbSuspendNotifications()) (nA)->(DbSkip(-1)) (nA)->(DbGobottom()) (nA)->(DbResetNotifications()) ENDIF ENDIF ENDIF ELSE (nA)->(DbSkip(1) ) ENDIF RETURN .T. METHOD BestFF:ZumEnde( nA ) DEFAULT nA TO 1 IF nA == 1 IF ::Speichern() (nA)->(DbRUnlock( Recno() ) ) (nA)->(DbGoBottom()) ENDIF ELSE (nA)->(DbGoBottom()) ENDIF RETURN .T. //* 12.07.2008 23:04 wird bereits anders gemacht: (oSuchThrd) /* der gesuchte Text wird in die Variable 1->such_ein eingegeben: */ METHOD BestFF:AnliefSuche( cSuchArt ) //, cKreis ) LOCAL cSuch := cAuf := "" // IIf(Empty(cKreis),Space(E),cKreis) LOCAL cString := IIf(Empty(cSuchArt),"cStringS","cStringF") LOCAL oFocus := IIf(!Empty(::oFocLFSle),::oFocLFSle,::oFocLFSle := oCtrl:lastXbp) LOCAL nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd, nAnzahl LOCAL cTitle := "Suchen nach:" /* cVariable ist Private von bestP8 */ /* 1->such_ein enth„lt den gesuchten Text */ y := ::XbpNummer( ::SingleZeile, "such_ein" ) ::singleZeile[y]:getdata() DbSkip(0) DbSuspendNotifications() DO CASE CASE Upper(cSuchArt) = "N " cTitle := "Anlieferer-Namen eingeben:" CASE Upper(cSuchArt) = "F " IF !Empty(::oFocLFSle:cargo) cVariable := IIf( ::oFocLFSle:cargo[1]=="&", &(SubStr(::oFocLFSle:cargo,2)), ::oFocLFSle:cargo ) IF !IsFieldVar(cVariable) //09.10.2006 14:44 cVariable := "name" ::oFocLFSle := ::XbpObjekt( ::singleZeile, "name" ) ENDIF ::SuchFeld := ::aBeschreib[AScan(::aFelder,Trim(cVariable))] // 17.4.2005 ELSE cVariable := "anummer" ::SuchFeld := "AnliefererNummer" ENDIF DO CASE CASE cVariable == "name" cSuchArt := "N " cTitle := "AnLieferer-Namen eingeben:" OrdSetFocus( "na" ) /* kontrollierender Index */ OTHERWISE cTitle := ::Suchfeld + " eingeben:" // 17.4.2005 IF ValType(1->&cVariable) == "D" OrdCreate( "AnLief", "x3", Str(Year(1->&cVariable),4,0) + ; StrX(Month(1->&cVariable),2,0) + StrX(day(1->&cVariable),2,0) ) ELSEIF ValType(1->&cVariable) == "N" OrdCreate( "AnLief", "x3", Str(1->&cVariable) ) ELSE // "C"-Felder (Index fr Memo-Felder ist NICHT m”glich) OrdCreate( "AnLief", "x3", Upper(1->&cVariable) ) ENDIF ::aIndex[3] := cVariable OrdSetFocus( "x3" ) /* kontrollierender Index */ DbGoto( nRec ) ENDCASE OTHERWISE cTitle := "Anlieferer-Nr. eingeben:" ENDCASE /* Eingabe von Alpha-Zeichen werden als NAME verstanden, wenn nichts Anderes bestimmt ist: */ IF Empty(cSuchArt) .AND. Len(cStringS)>0 .AND. Asc(cStringS[1])>64 // 10.11.2005 "Lenzomatic" VerstorbenenNamen suchen cSuchArt := "N " ENDIF DO WHILE .T. y := ::XbpNummer( ::SingleZeile, "such_ein" ) cSuch := ::singleZeile[y]:getdata() IF Empty( cSuch) .AND. !Upper(cSuchArt)=="R " // 14.11.2004 cTip := cTitle EXIT ELSEIF Val(cSuch) > Val(Replicate("9",E)) // 999999 cTip := "Zu lang! Neue Anlieferer-Nr. :" EXIT ENDIF cSuch := IIf(Val(cSuch)>0 .AND. Empty(cSuchArt), StrX(Val(cSuch),E,0), Trim(cSuch) ) cSuch := IIf(Upper(cSuchArt)=="F " .AND. ValType(1->&cVariable)=="N", ; Str(Val(cSuch),FieldInfo(FieldPos(cVariable),FLD_LEN), ; FieldInfo(FieldPos(cVariable),FLD_DEC) ), ; cSuch ) nRec := RecNo() DO CASE CASE Upper(cSuchArt) = "F " OrdSetFocus( "x3" ) /* kontrollierender Index */ DbSeek( Upper(cSuch), .T. ) nAnf := 930; nEnd := 959 CASE Upper(cSuchArt) = "N " OrdSetFocus( "na" ) /* kontrollierender Index */ DbSeek( Upper(cSuch), .T. ) nAnf := 930; nEnd := 959 OTHERWISE OrdSetFocus( "an" ) /* kontrollierender Index */ DbGoto( nRec ) // weil unzul„ssige Eingabe cTip := "Anlieferer nicht gefunden." ::SuchFeld := "AnliefererNummer" // 01.05.2005 EXIT ENDCASE IF !Empty(cSuchArt) IF oBest:Such( oBEDA, ::cS_b, nAnf, nEnd, 1, 1->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {} ) cAuf := "" // .T. == mit ESC ausgestiegen ELSE cAuf := 1->anummer ENDIF ENDIF IF val(cAuf) == 1->anummer // wenn gefunden cTip := "Anlieferer gefunden." EXIT ELSEIF cAuf == "" // wenn nicht gefunden, gehe zum Ausgangspunkt DbGoto( nRec ) cTip := "Anlieferer nicht gefunden." ::SuchFeld := "AnliefererNummer" OrdSetFocus( "an" ) /* kontrollierender Index */ EXIT ELSE DbGoto( nRec ) cTip := "Andere Anlieferer-Nr. :" EXIT ENDIF ENDDO ::XbpObjekt( ::SingleZeile, "such_ein" ):setdata(such_ein:="") //02.07.2006 11:24 SET FILTER TO // 17.10.2004 oBEDA:cargo:readdata() // 14.11.2004 DbResumeNotifications() DbSkip(0) oCtrl:lastXbp := oBest:oFocLFSle // 29.10.2004 RETURN cTip /* ... */ METHOD BestFF:AnliefLoeschen( lCodeWort ) //*14.07.2008 15:11 LOCAL nAuf := Val(1->anummer) DEFAULT lCodeWort TO .T. IF Val(cRS) < 5 .AND. lCodeWort // wenn nicht berechtigt, ntzt auch kein Codewort AlertBox( , "Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?;" + ; ";Sie haben dazu NICHT die Berechtigung!", ; { } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Anlieferer l”schen." ) RETURN ELSEIF Upper(AppName())$cAc .AND. lCodeWort // z.Zt. nur fr cAc IF oEdit:Codewort( oBEDA, "s_best", 840, 859, cDatver+"param", 9, , ; {300*nH,200*nV}, {300*nH,300*nV}, , "Mit Codewort best„tigen:" ) ; < "5" RETURN ENDIF ENDIF IF AlertBox( , "Anlieferer Nr. "+StrX(nAuf,E,0)+" als gel”scht markieren?;" + ; ";", ; { "JA", "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Anlieferer l”schen." ) = 1 SELECT 1 Satzsp(oCB) 1->notiz := "== A N L I E F E R E R =="+CRLF+"=== g e l ” s c h t ===" + CRLF + 1->notiz DbRUnlock() 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:NamenSuche(cName,cVorname,cStrasse,nA) // zur Kontrolle, ob Verstorbener bereits in Datei enthalten LOCAL nOldOrder := OrdNumber() LOCAL nRec := Recno() LOCAL lUnique := .T. LOCAL cTitel, cAnl := 1->anummer, lFlucht //+23.09.2012 18:10 DEFAULT cVorname TO "", cStrasse TO "", nA TO SELECT() //+17.03.2009 20:37 IF !Empty( cName ) DbSuspendNotifications() OrdSetFocus( 2 ) // 1 = Nummer, 2 = Name //seit ~.09.2012 14:29:2 = Name+Vorname //+23.09.2012 18:11 SatzDelete() // damit er sich nicht selber findet DbSetFilter({|| (nA)->anummer != cAnl }) //+23.09.2012 18:12 IF !DbSeek(Upper(cName),.T.) // wenn nicht gefunden, cTitel := "Dieser Name existiert noch nicht!" ELSEIF DbSeek(Upper(cName+cVorname+cStrasse),.T.) cTitel := "A C H T U N G: Gleiche Daten bereits vorhanden!" lUnique := .F. ELSEIF DbSeek(Upper(cName+cVorname),.T.) cTitel := "Dieser Name+Vorname ist bereits vorhanden!" lUnique := .F. ELSEIF DbSeek(Upper(cName),.T.) cTitel := "Dieser Name ist bereits vorhanden!" lUnique := .F. ENDIF IF !lUnique lFlucht := oBest:Such( ::oParent, "s_best", 930, 939, nA, (nA)->(RecNo()), ; {10,30*nV}, {425*nH,175*nV}, {}, cTitel+" - mit Neueingabe l”schen" ) //+23.09.2012 18:32 lFlucht IF cTitel = "A C H T U N G" .OR. lFlucht //+23.09.2012 18:31 lFlucht DbClearFilter() //+23.09.2012 18:13 OrdSetFocus( nOldOrder ) DbGoTo( nRec ) // immer zurck zum Eingabefall! (weil er recalled werden muss!) //+23.09.2012 18:13 SatzRecall() // damit er wieder da ist DbResetNotifications() Loeschen( ::oParent, (nA)->anummer, .F. ) RETURN cTitel ENDIF ENDIF DbClearFilter() //+23.09.2012 18:13 OrdSetFocus( nOldOrder ) DbGoTo( nRec ) // immer zurck zum Eingabefall! (weil er recalled werden muss!) //+23.09.2012 18:13 SatzRecall() // damit er wieder da ist DbResetNotifications() ENDIF RETURN cTitel 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:Ordnen(cVar,cSuchArt) // cSuchArt:="F " wird per Referenz bergeben DEFAULT cVar TO "anummer" PRIVATE cVariable := cVar IF SELECT()=1 DO CASE CASE Upper(cVariable) == "ANUMMER" cSuchArt := "" SET ORDER TO 1 CASE Upper(cVariable) == "NAME" cSuchArt := "V " SET ORDER TO 2 CASE Upper(cVariable) == "ANSP_NAME" cSuchArt := "A " SET ORDER TO 3 CASE Upper(cVariable) == "STRASSE" cSuchArt := "S " SET ORDER TO 4 OTHERWISE IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrX(Month(1->&cVariable),2,0)+ ; StrX(day(1->&cVariable),2,0) to x5 ELSEIF ValType(1->&cVariable) == "N" INDEX on Str(1->&cVariable) TO x5 ELSE INDEX on Upper(1->&cVariable) TO x5 ENDIF ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 SET ORDER TO 5 ENDCASE ELSEIF SELECT()=4 DO CASE CASE Upper(cVariable) == "P_NAME" OrdSetFocus("x2") ENDCASE ENDIF RETURN OrdNumber() // 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 // o ist das TabPage-Objekt // aTab ist ein Array mit den relativen ::BEArea-Positionen // ATail(aTab) (=aTab[3]) ist immer 0 (=Position von ::thisTab) METHOD BestFF:TabMax(o,aTab) // berl„dt DialogFF:TabMax // XXXXXruft es dann auf LOCAL n := AScan(::TabSeite,o) AEval(aTab, {|x,i| ::TabSeite[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::TabSeite[n+ATail(aTab)] ::thisTab:maximize() 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 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 //+30.09.2012 16:11 fr den Fall, dass noch weitere Eintr„ge dieses Benutzers beim letzten Abbruch METHOD BestFF:BenutzerBereinigung() LOCAL nOldArea := SELECT(), nRec := 1->(RecNo()) SELECT 1 1->(DbSuspendNotifications()) DbGotop() LOCATE FOR cBK == AllTrim(1->benutzer) DO WHILE !Eof() IF nRec != RecNo() Satzsp(oCB) 1->benutzer := "" DbUnlock() ENDIF CONTINUE ENDDO DbGoto(nRec) ::lUser := .T. // jetzt ist es Dein Anlieferer ::EditAnliefNr := "" // jetzt darfst Du ihn auch „ndern k”nnen 1->(DbResumeNotifications()) SELECT &nOldArea RETURN self //+17.09.2012 13:47 kopiert den Datensatz mit 2->anummer = 1->anummer+1 in die anlief.dbf, // wenn diese anummer frei ist: FUNCTION AnliefSatzAusHistorie() LOCAL anla := Val(1->anummer), anlh := anla + 1 LOCAL rec1 := 1->(RecNo()), rec2 := 2->(RecNo()) LOCAL nOldArea := SELECT() 1->(DbSuspendNotifications()) 2->(DbSuspendNotifications()) //feststellen, ob anlh==anla+1 in anlief.dbf wirklich fehlt: IF 1->(DbSeek(StrZero(anlh,6,0),.F.)) AlertBox( , "Der Anlieferer mit der Nummer "+StrZero(anlh,6,0)+" existiert!" + ; "Er kann nicht berschrieben werden;", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Der gewnschte Datensatz existiert schon in der AnliefererDatei!" ) //+15.11.2009 17:41 1->(DbGoto(rec1)) 1->(DbResumeNotifications()) 2->(DbResumeNotifications()) RETURN .F. ENDIF //feststellen, ob anlh==anla+1 in historie.dbf wirklich existiert: IF !2->(DbSeek(StrZero(anlh,6,0),.F.)) AlertBox( , "Der Anlieferer mit der Nummer "+StrZero(anlh,6,0)+" existiert nicht in der Historie!" + ; "Er kann nicht kopiert werden;", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Der gewnschte Datensatz existiert nicht in der HistorienDatei!" ) //+15.11.2009 17:41 1->(DbGoto(rec1)) 2->(DbGoto(rec2)) 1->(DbResumeNotifications()) 2->(DbResumeNotifications()) RETURN .F. ENDIF //den letzten (neuesten) Datensatz mit anummer = anlh in der Historie finden SELECT 2 DO WHILE 2->anummer == StrZero(anlh,6,0) .AND. !2->(Eof()) //+06.09.2013 19:21 eof() 2->(DbSkip()) ENDDO //der letzte Skip war einer zuviel: 2->(DbSkip(-1)) //aktuellen HistorieDatensatz in eine tempor„re Datei speichern: COPY TO &("Hist"+StrZero(anlh,6,0)) NEXT 1 VIA "FOXCDX" SELECT 1 APPEND FROM &("Hist"+StrZero(anlh,6,0)) VIA "FOXCDX" //wenn der Index es nicht bringt, dann folgende Zeilen aktivieren: // FErase( cDatver+"AnLief.cdx" ) // damit der Index nicht nur berschrieben wird // OrdCreate( cDatver + "AnLief", "an", "ANUMMER" ) // OrdCreate( cDatver + "AnLief", "na", "NAME+VORNAME" ) //+16.09.2012 17:25 +VORNAME, wegen SuchThread! 1->(DbGoto(rec1)) 1->(Satzsp(oCB)) 1->benutzer := cBK 1->(DbRUnlock()) 2->(DbGoto(rec2)) 1->(DbResumeNotifications()) 2->(DbResumeNotifications()) SELECT &nOldArea 1->(DbSkip()) RETURN .T. //14.07.2008 08:26 vorl„ufiges Backup/Restore///////////////////////////////////////////////////////////// FUNCTION DATEN_Backup() LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0 LOCAL cNetverX := "C:\HDBE_BAK\" + DtoS(date()) + "\" //*14.07.2008 08:12 CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() IF !FExists(cNetverX,"D") //18.10.2007 17:32 // Verzeichnis neu erstellen: RunShell( "/C MD "+cNetverX ) ENDIF // vom cDatver zum Stick bzw. in das cNetverX kopieren: FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) COPY FILE (cDatver+aName[i]) TO (cNetverX+aName[i]) ENDIF NEXT ENDIF Tone(1000,9) RETURN .T. FUNCTION DATEN_Restore() LOCAL aName := {}, i, cAltName := " ", nDrive LOCAL cNetverX := "C:\HDBE_BAK\" + DtoS(date()) + "\" //*14.07.2008 08:13 CLOSE ALL // vorsichtshalber ! IF ConfirmBox( oBEDA, ; "Sollen WIRKLICH die Daten des letzten"+CRLF+ ; "Backups restauriert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Original-Daten sichern, aber nur ein Backup pro Tag : IF !FExists(cDatver+DtoS(DATE()),"D") // Backup-Verzeichnis erzeugen mit heutigem Datum als Name: RunShell( "/C MD "+cDatver+DtoS(DATE()) ) // Backup der Dateien: @ 10,5 SAY "Daten werden zuerst gesichert..." FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) COPY FILE (cDatver+aName[i]) TO (cDatver+DtoS(DATE())+"\"+aName[i]) ENDIF NEXT ENDIF //* letztes Backup-Verzeichnis ermitteln: DO WHILE !FExists( SubStr(cNetverX,1,Len(cNetverx)-1), "D" ) // == "C:\HDBE_BAK\" + DtoS(date()) IF Year(DATE()) > Val(SubStr(cNetverX,13,4)) .AND. ConfirmBox( oBEDA, ; "Soll weitergesucht werden?", ; "Kein Backup gefunden!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird restored ENDIF cNetverX := "C:\HDBE_BAK\" + DtoS(date()-1) +"\" ENDDO FOR i := 1 TO Len(aName) IF FExists( cNetver+aName[i] ) COPY FILE (cNetverX+aName[i]) TO (cDatver+aName[i]) ENDIF NEXT ENDIF //+15.11.2009 18:01 MsgBox("Im Verzeichnis "+cDatver+DtoS(DATE())+" wurde vorher eine Sicherung angelegt!", ; //+15.11.2009 18:01 "Daten aus Backup restauriert!") AlertBox( , "Im Verzeichnis "+cDatver+DtoS(DATE())+" wurde vorher eine Sicherung angelegt!" + ; ";", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Daten aus Backup restauriert!" ) //+15.11.2009 17:41 Tone(1000,9) RETURN .T. //+27.06.2009 17:11 Backup der *.bmp/*.jpg in den Verzeichnissen scans und scans2 //+ auf einen USB-Drive in dessen Verzeichnise \scan_bak\scans und \scan_bak\scans2 PROCEDURE Scans_Backup() LOCAL cBUD := StickDrive("\scan_bak") //+ BackUpDrive LOCAL dDate, aDateien := {}, i IF Asc(cBUD) > 68 //+ Datum der neuesten Dateien im Backup-Verzeichnis ermitteln: dDate := DirDatum(cBUD+":\scan_bak\scans\*.bmp") //+ Namen der zu kopierenden Dateien ermitteln: DirDatum(cDatver+"scans\*.bmp",dDate,@aDateien) //+ Dateien kopieren: FOR i := 1 TO Len(aDateien) IF FExists( cDatver+"scans\"+aDateien[i] ) COPY FILE (cDatver+"scans\"+aDateien[i]) TO (cBUD+":\scan_bak\scans\"+aDateien[i]) ENDIF NEXT //+++ dieses Procedere wiederholen fr jpg: dDate := DirDatum(cBUD+":\scan_bak\scans\*.jpg") DirDatum(cDatver+"scans\*.jpg",dDate,@aDateien) FOR i := 1 TO Len(aDateien) IF FExists( cDatver+"scans\"+aDateien[i] ) COPY FILE (cDatver+"scans\"+aDateien[i]) TO (cBUD+":\scan_bak\scans\"+aDateien[i]) ENDIF NEXT //++++++++++ dieses Procedere wiederholen fr scans2: //+ Datum der neuesten Dateien im Backup-Verzeichnis ermitteln: dDate := DirDatum(cBUD+":\scan_bak\scans2\*.bmp") //+ Namen der zu kopierenden Dateien ermitteln: DirDatum(cDatver+"scans2\*.bmp",dDate,@aDateien) //+ Dateien kopieren: FOR i := 1 TO Len(aDateien) IF FExists( cDatver+"scans2\"+aDateien[i] ) COPY FILE (cDatver+"scans2\"+aDateien[i]) TO (cBUD+":\scan_bak\scans2\"+aDateien[i]) ENDIF NEXT //+++ dieses Procedere wiederholen fr jpg: dDate := DirDatum(cBUD+":\scan_bak\scans2\*.jpg") DirDatum(cDatver+"scans2\*.jpg",dDate,@aDateien) FOR i := 1 TO Len(aDateien) IF FExists( cDatver+"scans2\"+aDateien[i] ) COPY FILE (cDatver+"scans2\"+aDateien[i]) TO (cBUD+":\scan_bak\scans2\"+aDateien[i]) ENDIF NEXT ENDIF RETURN