**BRegieAH.prg - Regie-Zentrum // Verwaltung der Kunden-Historie (Statistik-Diagramme) //+10.11.2008 09:01 eingefhrt fr MuellX (importiert von AW.EXE) #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Dmlb.ch" #include "Common.ch" #include "Thread.ch" //xbeP_User = 134217728 #define xbeU_RefreshHist xbeP_User + 1 #define xbeU_RefreshSuch xbeP_User + 2 #define xbeU_RefreshKunde xbeP_User + 3 #define xbeU_RefreshScan xbeP_User + 4 #define xbeU_ShowHistDaten xbeP_User + 5 #define xbeU_ShowScan xbeP_User + 6 #define xbeU_SwapHist xbeP_User + 7 #define xbeU_NeuHist xbeP_User + 8 #define xbeU_SyncHist xbeP_User + 9 #define xbeU_ShowKundDaten xbeP_User + 10 /* siehe: #define xbeP_User 134217728 */ //++26.07.2009 12:29+++++++++++++++++++++++++++++++++++++++++++++++++++++++ PROCEDURE StatistikVorbereiten() LOCAL nRec := RecNo() IF FErase(cDatver+"ArtTemp.DBF") = 0 FErase(cDatver+"ArtTemp.NTX") ENDIF SELECT 3 DbSort( cDatver+"ArtTemp", {"r_datum","zugr_z_st","auftrnr"} ) DbUseArea(,,"ArtTemp") OrdCreate("ArtTemp","ax","DtoS(r_datum)+zugr_z_st+StrX(auftrnr,E)") Datei("001") SELECT 1 DbSuspendNotifications() DbSort( cDatver+"BestTemp", {IIf(IsFieldVar("auftrdat"),"auftrdat","gestorben")} ) DbGoto(nRec) DbResumeNotifications() RETURN //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //------------------------------------------ /* 24.06.2008 17:47 neue Thread-Klasse fr die Historientabelle: */ CLASS HistThrd FROM Thread EXPORTED: VAR producerID VAR terminated 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,g) KundenHistorie(a,b,c,d,e,f,g) RETURN self INLINE METHOD atStart() RETURN self INLINE METHOD atEnd() // Tone(750,9) DbCloseAll() RETURN .T. ENDCLASS //------------------------------------------ /*25.06.2008 09:10 wird durch ::execute() im Historie-Thread ausgefhrt und von oSignal aus Thread1 heraus gesteuert --> aPos und aSize werden unten ohnehin neu gesetzt! */ //+10.11.2008 13:22 cKdKz ist GKZ, damit die Statistik fr Groákunden gemacht werden kann FUNCTION KundenHistorie( oDlg1, aFld_Bes, cAuf, cS_h, nAnf, nEnd ) //+02.08.2008 22:10 oDlg2 = DatenArea oben LOCAL oDlg, nEvent, mp1, mp2, oXbp, oBrowse LOCAL oFocus := SetAppFocus(), aEditControls := {}, lFlucht := .F. LOCAL oHelp, oVideo //*11.07.2008 14:44 LOCAL aPos, ASize // LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; // { XBP_PP_BGCLR , GRA_CLR_WHITE } } // LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } // LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; // { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } nBz := 23*nV //+31.07.2008 13:54 PUBLIC PRIVATE oCB, oKHDA, oHist, oEdit, oCtrl, nFontR := cBFont, cH := " ", nB := nBz //+13.08.2008 16:07 PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5:=0, DUM6:=0, DUM7:=0, DUM8, DUM9, cStadt //30.04.2007 17:56 PRIVATE nSB := 6 //+10.11.2008 13:38 Breite der Spalte in ABrowse PRIVATE oFocSle PRIVATE xCF //+09.01.2010 18:18 DEFAULT cS_h TO "S_HIST", nAnf TO -100, nEnd TO 299 //+03.08.2008 14:20 DEFAULT aFld_Bes TO {"GKZ","Rg-Empf."} // Makro-Variable fr den Maskenaufbau: PRIVATE FAM, STO1, STO2, STO3, TO0, TO1 PRIVATE TO2:=IIf("KSO"$upper(cDatver),"BEIFRIED","ORTGRAB"), TO3, TO4:="URNEWO" PRIVATE TD0, TD1, TD2, TD3, TD4, TZ0, TZ1, TZ2, TZ3, TZ4 PRIVATE TO5, TO6, TD5, TD6, TZ5, TZ6 //+01.03.2009 11:57 fr TDZ PRIVATE PR1, MU1, FL1, PR2, MU2, FL2, PR3, MU3, FL3, PR4, MU4, FL4 //23.04.2007 12:50 PRIVATE EHGD, EHSD, EHGO, EHSO, EHHEI, ANSPE, FRIED, NACHO, GRART, EHHD, EHHO, EHHR //+04.07.2009 12:20 PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9 //30.04.2007 17:56 /*10.11.2008 09:08 eigenes Fenster */ aPos := {oDlg1:cargo:currentpos()[1]+4,oDlg1:cargo:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske ASize := {oDlg1:currentsize()[1],oDlg1:cargo:currentsize()[2]} //14.04.2008 14:22 H”he wie Hauptmaske /**/ Datei(schdat:="1010010") //+ das reicht... SELECT 3 // DbSort( "ArtTemp", {"r_datum","zugr_z_st","auftrnr"}, {||1=1} ) SELECT 1 DO WHILE cH == " " /*29.06.2008 10:40 von :atstart() nach hierher verschoben: (Anlaufphase von oScrap abwarten!) */ //+ HIER Scopes plazieren (Jahr,Artikelgruppe,Kundengruppe etc) // DbSelectArea(1) // DbUseArea( , "FOXCDX", "Kunden", , .T. ) // OrdListAdd( "Kunden" ) // OrdSetFocus( "kk" ) /* kontrollierender Index */ // DbSeek(cKdKz,.F.) // DbSelectArea(7) // DbUseArea( , "FOXCDX", "MessWert", , .T. ) // OrdListAdd( "MessWert" ) // OrdSetFocus( "kk" ) /* kontrollierender Index */ // DbSetScope( SCOPE_BOTH, cKdKz ) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) // DbSelectArea(8) // DbUseArea( , "FOXCDX", "FUWert", , .T. ) // OrdListAdd( "FUWert" ) // OrdSetFocus( "kk" ) /* kontrollierender Index */ // DbSetScope( SCOPE_BOTH, cKdKz ) //+ nicht noch zus„tzlich Datum in Scope schreiben!! // DbGobottom() // DbSelectArea(7) /**/ // oHelp := MagicHelp():New() ///////**08.07.2008 10:12 msste berflssig sein, weil oDlg bereits im aufrufenden Thread ist **/ ////// /*14.04.2008 19:25 nH, nV ver„ndert wegen Resize */ ////// aPos := {oDlg1:currentpos()[1],oDlg1:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske ////// ASize := {oDlg1:currentsize()[1],oDlg1:currentsize()[2] - ; ////// IIf( oDlg1:isderivedfrom("XbpTabPage"), oDlg1:tabheight, 0 ) } //08.07.2008 18:19 ////// /**/ ///////**/ oDlg := AKDialog():new( AppDeskTop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:titlebar := .F. oDlg:sysmenu := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) // oDlg:tofront() // SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! // oDlg:lockUpdate(.T.) // damit der Bildaufbau unsichtbar bleibt oDlg:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) oCB := oDlg:drawingArea // fr alle F„lle oKHDA := oDlg:drawingArea oKHDA:cargo := oDlg aThrdFenster[4] := oDlg // jetzt folgt die Erzeugung der Eingabefelder oHist := HistorieFF():new( oKHDA,oKHDA:cargo, {}, {},,, nBz, cS_h , nAnf, nEnd, 7 ) /* jetzt ist oHist:BEArea[1] == oKHDA , also ist oHist:BEArea[1]:cargo == oDlg !! */ oEdit := oHist //* brauchen wir, weil oEdit in einigen Routinen steht... */ oHist:cAufBer := cAuf //+ 07.08.2009 16:29 oHist:CREATE( oKHDA,oKHDA:cargo, {}, {},,, nBz, cS_h , nAnf, nEnd, 7 ) AEval( oHist:editControls, {|x| oDlg:addEditControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder xCF := NIL //+09.01.2010 18:19 nBz := nB // oDlg:setModalState( XBP_DISP_APPMODAL ) // oHist:cSuche := cKdKz //+ fr sp„ter... oHist:aFldBes := aFld_Bes //+26.07.2009 22:07 oHist:oBrowseDlg := oKHDA //+11.09.2008 14:50 //+ mischt die Follow-Up-Daten eines Termins in die MessWert-Datei ein zur gemeinsamen Anzeige: // oHist:SwapInachE( oHist:aFU_Felder, 8, 7 ) oCtrl := XbpGetController():new( oDlg ) oCtrl:create() oCtrl:READ( 1, .F. ) * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) // oHelp:start() // oDlg:lockUpdate(.F.) oDlg:invalidateRect() //+ gibts eigentlich eh nicht: (mal sehen, ob sowas eine Fehlermeldung provozieren kann) IF Len(oHist:BrowseFeld) > 0 oHist:BrowseFeld[1]:refreshAll() ENDIF nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF ThreadObject():terminated == .T. // mal sehen, ob das klappt... IF ThreadObject():atEnd() ThreadObject():QUIT() ENDIF ENDIF IF nEvent == xbeU_RefreshHist // DbClearScope( SCOPE_BOTH ) // DbSetScope( SCOPE_BOTH, mp1 ) // ZumAnfang(7) IF Len(oHist:BrowseFeld) > 0 oHist:BrowseFeld[1]:refreshAll() ENDIF oDlg:invalidateRect() LOOP ENDIF IF nEvent == xbeU_SwapHist //+ swapt die FU-Felder von MessWert.dbf zur FUWert.dbf (und umgekehrt?) ////// IF mp2 > mp1 //+wenn mp2=8 und mp1=7 ////// (mp2)->(DbSeek( (mp1)->kunden_kz + DtoS((mp1)->fu_datum), .F. )) ////// IF (mp2)->(Eof()) //+ drfte eigentlich NIE (?) passieren ////// (mp2)->(DbAppend()) ////// ENDIF ////// ENDIF // IF (mp1)->kunden_kz == (mp2)->kunden_kz //+03.09.2008 10:19 // oHist:SwapInachE( oHist:aFU_Felder, mp1, mp2 ) // ENDIF // LOOP ENDIF // IF nEvent == xbeU_NeuHist //+ Legt neue Datens„tze fr die Messwerte an // oHist:NEU(mp1,7) // LOOP // ENDIF // IF nEvent == xbeU_SyncHist //+ Synchronisiert die Hist-Ansicht der MessDaten // oHist:SYNC(mp1) // LOOP // ENDIF IF nEvent == xbeM_LbDblClick .AND. oXbp:isDerivedFrom("XbpSle") // oHist:WerteTabelle() //// oHist:ShowZeile(oDlg2) //*13.07.2008 21:38 //// PostAppEvent( xbeU_RefreshKunde,, 7->kunden_kz, aThrdFenster[1]) //// IF oXbp:cargo = "ST" //// oHist:SwapInachE(oHist:aFU_Felder,7,8) //+11.09.2008 14:20 Eingaben in 8->speichern //// PostAppEvent( xbeU_ShowHistDaten,3, 7->kunden_kz, aThrdFenster[1]) //[1], weil dort die TabPage ist //// oHist:ShowTabelle( oDlg2, 600, 699, oXbp ) ////// oHist:ShowTeam( oDlg2, 500, 699, oXbp ) //// ELSE //// oHist:SwapInachE(oHist:aFU_Felder,7,8) //+11.09.2008 14:20 Eingaben in 8->speichern //// PostAppEvent( xbeU_ShowHistDaten,3, 7->kunden_kz, aThrdFenster[1]) //[1], weil dort die TabPage ist //// oHist:ShowTabelle( oDlg2, 300, 499 ) //// ENDIF //// LOOP ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN IF oXbp:IsderivedFrom("XbpSle") .AND. "SUCH"$Upper(oXbp:cargo) PostAppEvent( xbeP_Activate,,, oHist:XbpObjekt(oHist:DruckKnopf,"HistSuch")) ELSE PostAppEvent( xbeP_Activate,,, oXbp) ENDIF // CASE mp1 == xbeK_ESC // IF ValType(oVideo) == "O" // oVideo:stop() // oVideo:cargo:destroy() // oVideo := NIL // mp1 := 0 // LOOP // ENDIF // nFlucht := ConfirmBox( oCB, IIf(SET(43)==0,ConvToAnsiCP("Žnderungen speichern?"), ; // "Žnderungen speichern?"), ; // "SERIE fr RECHNUNG beenden.", ; // XBPMB_YESNOCANCEL, ; // XBPMB_QUESTION ) // IF nFlucht == XBPMB_RET_YES // lFlucht := .F. // PostAppEvent( xbeP_Close) // ELSEIF nFlucht == XBPMB_RET_NO // lFlucht := .T. // PostAppEvent( xbeP_Close) // ELSE // LOOP // ENDIF CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_HS.rtf"), "Bedienungshinweise", oKHDA, 680*nH, 460*nV ) // CASE mp1 == xbeK_F10 // lEinfg := .F. // PostAppEvent( xbeP_Activate,,, oHist:DruckKnopf[oHist:XbpNummer(oHist:DruckKnopf,"ENDE")] ) //// PostAppEvent( xbeP_Close,,,oDlg) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO cKdKz := oHist:cSuche //+25.08.2008 19:29 damit er sich in der LOOP wiederfindet oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() // oHist:destroy() oDlg:destroy() // oHelp:terminate() DbCloseAll() DO WHILE nEvent <> xbe_None nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO ENDDO SetAppFocus( oFocus ) IF lFlucht == .F. // ESC-Taste: lFlucht = .T. USE ELSE USE // schlieáen der TEMP-Datei ENDIF RETURN .T. //////FUNCTION SerieDruck( oDlg1 ) ////// LOCAL nZei := 6 ////// SET DEVICE TO PRINTW ////// 14->(DbGotop()) ////// @ 2,8 SAY "Liste der Serien-Leistungen:" ////// @ 4,8 SAY "Nr Art/Lstg Leistung VK-Preis/"+w_g ////// DO WHILE !Eof() ////// @ nZei,6 SAY 14->Zeile ////// @ nZei,10 SAY 14->art ////// @ nZei,18 SAY 14->&bZ1 ////// IF nBezZeil = 2 .AND. 14->(IsFieldVar("&bZ2")) ////// @ ++nZei,18 SAY 14->&bZ2 ////// ENDIF ////// @ nZei,65 SAY 14->(&v_p) ////// SKIP ////// nZei := IIf( nZei>60, 6, ++nZei ) ////// ENDDO //////// EJECT ////// SET DEVICE TO SCREEN ////// 14->(DbGotop()) ////// 14->(DbSkip(0)) //////RETURN .T. CLASS HistorieFF FROM DialogFF EXPORTED: VAR VArea VAR cSuche //*10.07.2008 16:47 auf Vorrat, um einmal selbst„ndig in der Historie zu bl„ttern... VAR cAufBer //+07.08.2009 16:03 Auftragsnummernbereich VAR aFU_Felder //+ FollowUp-Daten VAR aMessWerte //+ Array mit allen Messwerten fr die Tabelle VAR cWerteArt //+ 09.08.2009 21:01 aus AW entstanden VAR aHeader //+ Array mit den Spaltenk”pfen fr die Tabelle VAR aFooter VAR oDlgT //+11.09.2008 09:52 Fenster fr die ::ShowTabelle() VAR oShTb //+11.09.2008 09:55 Objekt, das die Tabelle darstellt VAR oBrowseDlg //+11.09.2008 14:52 Fenster fr ::oDlgT auf Tab in Thread1 (kommt als oDlg2 rein) VAR cGeschlecht //+13.09.2008 09:18 gewonnen aus kunden->geschlecht VAR nAlter //+13.09.2008 09:19 gewonnen aus kunden->alter VAR aGrenzen //+ enth„lt die Grenzwert-Linien-Daten fr das Diagramm VAR aTeamwerte //+ ein Wert fr alle Teampartner und alle Termine VAR aTeamdiff //+ die Differenz eines Wertes fr alle Teampartner und alle Termine VAR aTeam //+ Array mit kunden_kz aller Teampartner VAR aFldBes //+26.07.2009 22:05 z.B. {"GKZ","Rg an:"} METHOD INIT METHOD CREATE METHOD notify METHOD AHSuch METHOD ShowTabelle //+11.09.2008 09:50 METHOD DruckTabelle //+16.09.2008 13:35 Ausgabe auf Drucker //+siehe DialogFF() METHOD SwapInachE //+ um die FUWerte einzumischen METHOD SYNC //+ synchronisiert die MesswertDateien auf die KundenDatei METHOD NEU //+ berl„dt die DialogFF:NEU() METHOD SwapInachE //+ berl„dt die DialogFF:SwapInachE() - nur wegen der Abfrage, ob Datens„tze berhaupt existieren! METHOD BMI //+ berechnet den BMI nachdem H”he oder Gewicht eingegeben werden METHOD FettKg //+ berechnet die FettKilos nachdem Fett-% oder Gewicht eingegeben werden METHOD WerteTabelle //+ fllt das Array aMessWerte METHOD Grenzen //+ erzeugt eine Matrix fr die Grenzwert-Linien im Diagramm METHOD TeamTabelle //+ fllt das Array aTeamwerte METHOD TeamDiff //+ fllt das Array aTeamdiff mit Wochendifferenzen METHOD TeamKumul //+ fllt das Array aTeamdiff mit kumulierten Differenzwerten METHOD TeamProzEntw //+ fllt das Array aTeamdiff mit prozentualen Differenzwerten (zum Anfangswert) METHOD TeamBilden //+ bildet das Array aTeam mit allen kunden_kz aller Team-Mitglieder ENDCLASS METHOD HistorieFF: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 ) ::Fancy := "" //* 12.07.2008 12:50 cSerieBM ::VArea := nA ::cSuche := "" ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::aData3 := Array(8->(FCount())) //+19.08.2008 21:09 ::aStructure := 8->(DbStruct()) //+ Struktur der FUWert.dbf ::aFU_Felder := {} // Array mit allen Feldnamen AEval( ::aStructure, {|a| AAdd( ::aFU_Felder, a[1] ) } ) ::aStructure := 7->(DbStruct()) //+ Struktur der MessWert.dbf ::cGeschlecht := IIf(1->anrede="Herr","m",IIf(1->anrede="Frau","w","k")) ::nAlter := 1->jahre ::cWerteArt := "" // ::aTeam := {"T00","T01","T02","T03","T04","T05","T06","T07","T08","T09","T10","T11"} // ::TeamBilden() // bildet das ::aTeam-Array aus allen Leuten mit derselben Gruppe wie der aktuelle RETURN self METHOD HistorieFF: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 HistorieFF:notify( nEvent, mp1, mp2 ) LOCAL nRec, oFocus, i IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_DONE // Skip ist beendet IF !SetAppFocus():isDerivedFrom( "XbpBrowse" ) .AND. Len(::BrowseFeld) > 0 (::VArea)->(DbSuspendNotifications()) nRec := (::VArea)->(RecNo()) FOR i := 1 TO Len(::BrowseFeld) ::BrowseFeld[i]:refreshAll() NEXT (::VArea)->(DbGoto( nRec )) (::VArea)->(DbResetNotifications()) ENDIF ENDIF ENDIF RETURN self METHOD HistorieFF:AHSuch() LOCAL nRec := RecNo(), cKdKz := (::VArea)->kunden_kz DbClearScope() DbGotop() DbSeek( ::cSuche, .F., "an" ) IF !Found() DbSetScope( SCOPE_BOTH, cKdKz ) DbGoto(nRec) ELSE DbSetScope( SCOPE_BOTH, ::cSuche ) DbGotop() ENDIF FOR i := 1 TO Len(::BrowseFeld) ::BrowseFeld[i]:refreshAll() NEXT RETURN self /*04.08.2008 12:38 wird von Historie-Thread aufgerufen, ist plaziert auf einem TAB von Thread1 und steuert diesen TAB in Thread1 beim Beenden. nAnf und nEnd mssen nicht gesetzt werden, wenn DEFAULT. --> aPos und aSize werden unten gesetzt! sp„tere Planung: diese FUNCTION als METHOD in BRegieAHo*/ METHOD HistorieFF:ShowTabelle( oDlg1, nAnf, nEnd, oWert, nArt ) //FUNCTION KundenHistorie2( oDlg1, cKdKz, nRec, oDlg2, nAnf, nEnd ) //+02.08.2008 22:10 oDlg2 = DatenArea oben LOCAL oDlg, nEvent, mp1, mp2, oXbp //, oBrowse LOCAL oCtrl, oFocus := SetAppFocus(), aEditControls := {}, lFlucht LOCAL aDia := {0,0} //+09.11.2008 15:57 0..12=Zeile + 0=kein/1=Teilnehmer/2=Team - Diagramm LOCAL aPos, ASize, nB := nBz //+03.08.2008 17:49 // LOCAL lEditierbar := .F. // wenn .T., dann kann man die Hist_Notiz „ndern PRIVATE oCB, oAHDA, oEdit, nFontR := cBFont, cH2 := " " //+09.11.2008 21:38 // PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5:=0, DUM6:=0, DUM7:=0, DUM8, DUM9, cStadt //30.04.2007 17:56 DEFAULT nAnf TO 300, nEnd TO 399 //+03.08.2008 14:20 DO WHILE cH2 == " " // ::WerteTabelle() /*14.04.2008 19:25 nH, nV ver„ndert wegen Resize */ // aPos := {oDlg1:currentpos()[1],oDlg1:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske aPos := AbsolutePos(oDlg1) //:currentpos()[1],oDlg1:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske ASize := {oDlg1:currentsize()[1],oDlg1:currentsize()[2] - ; IIf( oDlg1:isderivedfrom("XbpTabPage"), oDlg1:tabheight, 0 ) } //08.07.2008 18:19 /**/ // ::oDlgT := AKDialog():new( oDlg1, oDlg1:setparent() ) ::oDlgT := AKDialog():new( AppDeskTop(), oDlg1:setparent() ) ::oDlgT:tasklist := .T. ::oDlgT:titlebar := .F. ::oDlgT:sysmenu := .F. ::oDlgT:border := XBPDLG_RAISEDBORDERTHIN_FIXED ::oDlgT:create(,, aPos, ASize ) ::oDlgT:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) oCB := ::oDlgT:drawingArea // fr alle F„lle oAHDA := ::oDlgT:drawingArea oAHDA:cargo := ::oDlgT nBz := 21*nV //+31.07.2008 13:54 // jetzt folgt die Erzeugung der Eingabefelder ::oShTb := HistorieFF():new( oAHDA,oAHDA:cargo, {}, {},,, nBz, "s_hist" , nAnf, nEnd, 1 ) /* jetzt ist oHist:BEArea[1] == oAHDA , also ist oHist:BEArea[1]:cargo == oDlg !! */ oEdit := ::oShTb //* brauchen wir, weil oEdit in einigen Routinen steht... */ IF nAnf = 300 .AND. nArt != NIL ::oShTb:WerteTabelle("BETNETEU",,Trim(::cSuche),1) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 300 ::oShTb:WerteTabelle("MENGE",,Trim(::cSuche),1) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 400 .AND. nArt != NIL ::oShTb:aFldBes := ::aFldBes //+26.07.2009 22:33 ::oShTb:WerteTabelle("gestorben","DtoS(gestorben)",Trim(::cSuche),nArt) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 400 ::oShTb:WerteTabelle("gestorben","DtoS(gestorben)",Trim(::cSuche),2) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 600 ::oShTb:TeamTabelle(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! AEval(::TextZeile, {|a,i| IIf( a:cargo==oWert:cargo, ::oShTb:aTeamwerte[1,1] := a:caption, ) } ) ELSEIF nAnf = 700 ::oShTb:TeamTabelle(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! AEval(::TextZeile, {|a,i| IIf( a:cargo==oWert:cargo, ::oShTb:aTeamwerte[1,1] := a:caption, ) } ) ::oShTb:TeamDiff(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 800 ::oShTb:TeamTabelle(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! AEval(::TextZeile, {|a,i| IIf( a:cargo==oWert:cargo, ::oShTb:aTeamwerte[1,1] := a:caption, ) } ) ::oShTb:TeamKumul(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ELSEIF nAnf = 900 ::oShTb:TeamTabelle(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! AEval(::TextZeile, {|a,i| IIf( a:cargo==oWert:cargo, ::oShTb:aTeamwerte[1,1] := a:caption, ) } ) ::oShTb:TeamProzEntw(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ENDIF ::oShTb:CREATE( oAHDA,oAHDA:cargo, {}, {},,, nBz, "s_hist" , nAnf, nEnd, 1 ) AEval( ::oShTb:editControls, {|x| ::oDlgT:addEditControl( x ) } ) AEval( ::oShTb:editControls, {|a,i| IIf(a:cargo!="hist_notiz",a:editable := .F.,) } ) // bis hierhin geht die Erzeugung der Eingabefelder nBz := nB ::oDlgT:setModalState( XBP_DISP_APPMODAL ) ////// oCtrl := XbpGetController():new( ::oDlgT ) ////// oCtrl:create() ////// oCtrl:READ( 1, .F. ) * Shortcuts initialisieren ::oDlgT:InitShortCuts( ::oDlgT ) ::oDlgT:invalidateRect() SetAppFocus( ::oShTb:BrowseFeld[1] ) //+23.08.2008 22:50 IF aDia[2] == 1 ::oShTb:BrowseFeld[1]:rowPos := aDia[1] ::oShTb:BrowseFeld[1]:nPointer := aDia[1] ::oShTb:BrowseFeld[1]:refreshAll() ::oShTb:BrowseFeld[1]:Diagramm() ELSEIF aDia[2] == 2 ::oShTb:aI1:={} AEval(::oShTb:aTeam,{|a,i| AAdd(oEdit:aI1,i+1)}) ::oShTb:BrowseFeld[1]:Diagramm(oEdit:aI1,.T.) ENDIF nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeU_SyncHist //+ Synchronisiert die Hist-Ansicht der MessDaten ::SYNC(mp1) LOOP ENDIF IF nEvent == xbeM_LbUp .AND. oXbp:isDerivedFrom("XbpPushButton") .AND. oXbp:caption = "Diagramm" aDia := {0,2} ENDIF IF nEvent == xbeM_LbDblClick .AND. ::oShTb:BrowseFeld[1]:colpos == 1 aDia := {::oShTb:BrowseFeld[1]:rowPos,1} ::oShTb:BrowseFeld[1]:Diagramm(,,,AScan(oEdit:aI2,"Summen")-1) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .AND. ::oShTb:BrowseFeld[1]:colpos == 1 aDia := {::oShTb:BrowseFeld[1]:rowPos,1} ::oShTb:BrowseFeld[1]:Diagramm(,,,AScan(oEdit:aI2,"Summen")-1) CASE mp1 == xbeK_ESC cH2 := "x" PostAppEvent( xbeP_Close,,,::oDlgT ) CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_AS.dbf"), "Bedienungshinweise", oAHDA, 680*nH, 460*nV ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO ::oDlgT:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() ::oDlgT:destroy() ::oShTb:destroy() DO WHILE nEvent <> xbe_None nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO IF cH2 == "D" nAnf := 700 ; nEnd := 799 cH2 := " " ELSEIF cH2 == "K" nAnf := 800 ; nEnd := 899 cH2 := " " ELSEIF cH2 == "T" nAnf := 600 ; nEnd := 699 cH2 := " " ELSEIF cH2 == "E" nAnf := 900 ; nEnd := 999 cH2 := " " ENDIF ENDDO // PostAppEvent( xbeU_ShowHistDaten,1, 7->kunden_kz, aThrdFenster[1]) //[1], weil dort die TabPage ist SetAppFocus( oFocus ) RETURN self METHOD HistorieFF:DruckTabelle(oWert) //FUNCTION Vorschau_Ausgabe( oPrinterPS, aSegments, aBlatt, cCP, aSchrift, nOrientierung ) LOCAL dummy2 := GraSegDrawMode( oPrinterPS, GRA_DM_RETAIN ) LOCAL nSegment := GraSegOpen( oPrinterPS ) LOCAL aPrinterPS := { oPrinterPS, PrinterPS(cDruckerName,nOrientierung) } //geREMt08.07.2007 14:35, weil Unsinn: ,.T.) } // .T. = _PIXEL 27.05.2007 10:38 LOCAL aPaper := aPrinterPS[2]:DEVICE():paperSize() //, aPoSZ := {0,0} LOCAL aFont := { XbpFont():new(aPrinterPS[1]), XbpFont():new(aPrinterPS[2]) } LOCAL i := 0, j := 0 aPoSZ[1] := 0 ; aPoSZ[2] := 0 // 20.09.2006 17:43 aPoSZ ist Public aFont[1]:CREATE("12.COURIER NEW") aFont[2]:CREATE("12.COURIER NEW") ASize( aSegments, 0 ) // fr BitMap-Druck siehe XbpPreview:printpage() //////// Blatt_Aufbau( aPrinterPS, aFont, aPaper, aPoSZ, aSchrift, aBlatt, cCP, aSegments, @nSegment ) ::oShTb:BrowseFeld[1]:Diagramm() GraSegClose( aPrinterPS[1] ) AAdd( aSegments, nSegment ) // aSeitZ[1]=len(aSegments) / aSeitZ[2]=aPoSZ / aSeitZ[3]=TEXT / aSeitZ[4]=FONT : IF !Empty( aSeitZ ) // GesamtSeitenZahl - Seitenzahlen bei Statistik-Drucken FOR i := 1 TO j := aSeitZ[1] // aSeitZ[1] = Anzahl Segmente GraSegOpen( aPrinterPS[1], GRA_SEG_MODIFIABLE, aSegments[i] ) FdrG( aPrinterPS, aFont, aPaper, AClone(aSeitZ[2]), ; Trim( aSeitZ[3] ), aSeitZ[4], aSchrift ) GraSegClose( aPrinterPS[1] ) NEXT ENDIF GraSegDrawMode( oPrinterPS, GRA_DM_DRAWANDRETAIN ) RETURN aSegments ///////*04.08.2008 12:38 wird von Historie-Thread aufgerufen, ist plaziert auf einem TAB von Thread1 ////// und steuert diesen TAB in Thread1 beim Beenden. ////// nAnf und nEnd mssen nicht gesetzt werden, wenn DEFAULT. ////// --> aPos und aSize werden unten gesetzt! ////// sp„tere Planung: diese FUNCTION als METHOD in BRegieAHo*/ //////METHOD HistorieFF:ShowTeam( oDlg1, nAnf, nEnd, oWert ) ////////FUNCTION KundenHistorie2( oDlg1, cKdKz, nRec, oDlg2, nAnf, nEnd ) //+02.08.2008 22:10 oDlg2 = DatenArea oben ////// LOCAL oDlg, nEvent, mp1, mp2, oXbp //, oBrowse ////// LOCAL oCtrl, oFocus := SetAppFocus(), aEditControls := {}, lFlucht //////// LOCAL oHelp, oVideo //*11.07.2008 14:44 ////// LOCAL aPos, ASize, nB := nBz //+03.08.2008 17:49 //////// LOCAL lEditierbar := .F. // wenn .T., dann kann man die Hist_Notiz „ndern ////// PRIVATE oCB, oAHDA, oEdit, nFontR := cBFont, cH2 := " " //////// PRIVATE DUM0, DUM1, DUM2, DUM3, DUM4, DUM5:=0, DUM6:=0, DUM7:=0, DUM8, DUM9, cStadt //30.04.2007 17:56 ////// DEFAULT nAnf TO 500, nEnd TO 699 //+03.08.2008 14:20 ////// //////DO WHILE cH2 == " " ////// //////// ::WerteTabelle() ////// /*14.04.2008 19:25 nH, nV ver„ndert wegen Resize */ ////// aPos := {oDlg1:currentpos()[1],oDlg1:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske ////// ASize := {oDlg1:currentsize()[1],oDlg1:currentsize()[2] - ; ////// IIf( oDlg1:isderivedfrom("XbpTabPage"), oDlg1:tabheight, 0 ) } //08.07.2008 18:19 ////// /**/ ////// ::oDlgT := AKDialog():new( oDlg1, oDlg1:setparent() ) ////// ::oDlgT:tasklist := .T. ////// ::oDlgT:titlebar := .F. ////// ::oDlgT:sysmenu := .F. ////// ::oDlgT:border := XBPDLG_RAISEDBORDERTHIN_FIXED ////// ::oDlgT:create(,, aPos, ASize ) ////// ::oDlgT:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) ////// oCB := ::oDlgT:drawingArea // fr alle F„lle ////// oAHDA := ::oDlgT:drawingArea ////// oAHDA:cargo := ::oDlgT ////// ////// nBz := 21*nV //+31.07.2008 13:54 //////// jetzt folgt die Erzeugung der Eingabefelder ////// ::oShTb := HistorieFF():new( oAHDA,oAHDA:cargo, {}, {},,, nBz, "s_hist" , nAnf, nEnd, 7 ) ///////* jetzt ist oHist:BEArea[1] == oAHDA , also ist oHist:BEArea[1]:cargo == oDlg !! */ ////// oEdit := ::oShTb //* brauchen wir, weil oEdit in einigen Routinen steht... */ ////// IF nAnf = 300 ////// ::oShTb:WerteTabelle() //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ////// ELSEIF nAnf = 500 ////// ::oShTb:TeamTabelle(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ////// ELSEIF nAnf = 700 ////// ::oShTb:TeamDiff(oWert) //+ vor ::create(), weil das Array dadurch erst aufgebaut wird! ////// ENDIF ////// ::oShTb:CREATE( oAHDA,oAHDA:cargo, {}, {},,, nBz, "s_hist" , nAnf, nEnd, 7 ) ////// AEval( ::oShTb:editControls, {|x| ::oDlgT:addEditControl( x ) } ) ////// AEval( ::oShTb:editControls, {|a,i| IIf(a:cargo!="hist_notiz",a:editable := .F.,) } ) //////// bis hierhin geht die Erzeugung der Eingabefelder ////// nBz := nB //////// ::oDlgT:setModalState( XBP_DISP_APPMODAL ) ////// //////////// oCtrl := XbpGetController():new( ::oDlgT ) //////////// oCtrl:create() //////////// oCtrl:READ( 1, .F. ) ////// * Shortcuts initialisieren ////// ::oDlgT:InitShortCuts( ::oDlgT ) ////// ////// ::oDlgT:invalidateRect() ////// SetAppFocus( ::oShTb:BrowseFeld[1] ) //+23.08.2008 22:50 ////// ////// nEvent := xbe_None ////// DO WHILE nEvent <> xbeP_Close ////// nEvent := AppEvent( @mp1, @mp2, @oXbp ) ////// ////// IF nEvent == xbeU_SyncHist //+ Synchronisiert die Hist-Ansicht der MessDaten ////// ::SYNC(mp1) ////// LOOP ////// ENDIF ////// ////// IF nEvent == xbeP_Keyboard ////// DO CASE ////// CASE mp1 == xbeK_RETURN .AND. ::oShTb:BrowseFeld[1]:colpos == 1 ////// ::oShTb:BrowseFeld[1]:Diagramm() ////// CASE mp1 == xbeK_ESC ////// cH2 := " " ////// nEvent := xbeP_Close ////// CASE mp1 == xbeK_F1 ////// ModalDialog( (cDatver+"f1_AS.dbf"), "Bedienungshinweise", oAHDA, 680*nH, 460*nV ) ////// ENDCASE ////// ENDIF ////// oXbp:handleEvent( nEvent, mp1, mp2 ) ////// ENDDO ////// ////// ::oDlgT:setModalState( XBP_DISP_MODELESS ) ////// DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() ////// ::oDlgT:destroy() ////// ::oShTb:destroy() ////// ////// DO WHILE nEvent <> xbe_None ////// nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ////// ENDDO //////ENDDO ////// ////// PostAppEvent( xbeU_ShowHistDaten,1, 7->kunden_kz, aThrdFenster[1]) //[1], weil dort die TabPage ist ////// SetAppFocus( oFocus ) ////// //////RETURN self //+16.08.2008 21:36 synchronisiert die Messwerte mit dem Kunden bei Satz-Bewegung in Thread1 METHOD HistorieFF:SYNC( cKdKz ) LOCAL nA := ::VArea //+03.09.2008 13:29 wurde doch schon beim Speichern() in BestP() gemacht durch xbeU_SwapHist ////// (nA)->(DbCommit()) ////// (nA+1)->(DbCommit()) ////// IF (nA)->kunden_kz == cKdKz .AND. (nA+1)->kunden_kz == cKdKz //+02.09.2008 22:43 ////// ::SwapInachE(::aFU_Felder,nA,nA+1) ////// ENDIF 1->(DbSeek(cKdKz,.F.)) ::cGeschlecht := IIf(1->anrede="Herr","m",IIf(1->anrede="Frau","w","k")) // ::cGeschlecht := 1->geschlecht ::nAlter := 1->alter (nA)->(DbSkip(0)) //+10.09.2008 15:39 (nA)->(DbClearScope()) (nA+1)->(DbSkip(0)) //+10.09.2008 15:39 (nA+1)->(DbClearScope()) (nA)->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) (nA)->(DbGotop()) (nA+1)->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) (nA+1)->(DbGobottom()) IF (nA)->kunden_kz == cKdKz .AND. (nA+1)->kunden_kz == cKdKz //+02.09.2008 20:50 ::SwapInachE(::aFU_Felder,nA+1,nA) AEval( ::singleZeile, {|a,i| ::XbpObjektSet( , a:cargo ) } ) ENDIF ::cSuche := cKdKz //+25.08.2008 19:27 // AEval( ::singleZeile, {|a,i| ::XbpObjektSet( , a:cargo, a:value ) } ) // AEval( ::singleZeile, {|a,i| ::XbpObjektGet( , a:cargo ) } ) IIf( ValType(::oDlgT)=="O", PostAppEvent( xbeP_Close,,, ::oDlgT ), ) RETURN self //+16.08.2008 11:00 legt neue Messdatens„tze an in MessWert.dbf und FUWert.dbf METHOD HistorieFF:Neu( aFeld ) LOCAL nOldArea := SELECT(), nA := ::VArea, cKdKz := DbScope(SCOPE_TOP) DEFAULT aFeld TO {{"KUNDEN_KZ",cKdKz},{"FU_DATUM",DATE()}} //+ ersteinmalschaun ob 7er-Satz schon existiert (MessWert.dbf): IF Trim((nA)->kunden_kz) != Trim(cKdKz) // 7 = MessWert.dbf, Kandidat noch nciht angelegt? ::DialogFF:Neu( {aFeld[1],{"ST_DATUM",DATE()}}, ::VArea ) //+ neuen Start-Eintrag erzeugen ELSEIF (nA+1)->kunden_kz == (nA)->kunden_kz //+ wenn 7er-Satz schon existiert, dann k”nnte da ja schon etwas stehen... ::SwapInachE( ::aFU_Felder, (nA), (nA+1)) //+ bisherige Eingabe aus 7 nach 8 verschieben ENDIF SELECT (nA+1) // nA+1 = 8 = FUWerte.dbf DbSeek( cKdKz+DtoS(DATE()), .F. ) //+ gibt es heute schon einen FU-Eintrag? IF Eof() //+ heute gibt es noch keinen Eintrag ::DialogFF:Neu( aFeld, SELECT() ) //+ neuen 8er-Eintrag erzeugen ENDIF SELECT &nOldArea ::swapInachE( ::aFU_Felder, nA+1, nA ) // 8er-Satz in 7 einkopieren ... AEval( ::singleZeile, {|a,i| c:=a:cargo, ::XbpObjektSet( , a:cargo, (nA)->&c ) } ) //+ ...und anzeigen RETURN self //+02.09.2008 14:22 berl„dt die DialogFF-Methode, um den Swap vorzubereiten: METHOD HistorieFF:swapInachE( aFelderI, nAI, nAE ) //02.09.2008 14:33, aFelderE ) LOCAL nOldArea := SELECT(), cKdKz := DbScope(SCOPE_TOP) PRIVATE cI, cE DEFAULT aFelderI TO ::aFU_Felder //+02.09.2008 14:33 //+ wenn kein 7er-Messwert-Satz zu diesem Kunden oder kein 8er-FUWert-Satz IF (::VArea)->(Eof()) .OR. (::VArea)->kunden_kz != cKdKz .OR. (::VArea+1)->kunden_kz != cKdKz Tone(500,3) RETURN self ENDIF SELECT (nAE) //+15.08.2008 21:51 damit in XbpGetn automatisches SatzSp() ////// IF Empty(aFelderE) (nAE)->(DbRLock()) FOR i := 1 TO Len(aFelderI) cI := aFelderI[i] (nAE)->&cI := (nAI)->&cI NEXT (nAE)->(DbRUnLock()) ////// ELSE ////// (nAE)->(DbRLock()) ////// FOR i := 1 TO Len(aFelderI) ////// cI := aFelderI[i] ////// cE := aFelderE[i] // aFelderE darf mehr Felder haben als aFelderI ////// (nAE)->&cE := (nAI)->&cI ////// NEXT ////// (nAE)->(DbRUnLock()) ////// ENDIF SELECT &nOldArea RETURN self //+ berechnet den BMI, nachdem H”he oder Gewicht eingegeben werden (immer in der Area 7 = ::VArea) METHOD HistorieFF:BMI(oXbp) LOCAL nA := ::VArea DEFAULT oXbp TO oCtrl:lastXbp (nA)->(Satzsp(oCB)) DO CASE CASE oXbp:cargo = "ST_HOEHECM" .AND. !Empty((nA)->st_hoehecm) ::XbpObjektSet(,"ST_BMI",(nA)->st_bmi := (nA)->st_gew_kg*10000/((nA)->st_hoehecm*(nA)->st_hoehecm)) CASE oXbp:cargo = "ST_GEW_KG" .AND. !Empty((nA)->st_hoehecm) ::XbpObjektSet(,"ST_BMI",(nA)->st_bmi := (nA)->st_gew_kg*10000/((nA)->st_hoehecm*(nA)->st_hoehecm)) CASE oXbp:cargo = "FU_HOEHECM" .AND. !Empty((nA)->fu_hoehecm) ::XbpObjektSet(,"FU_BMI",(nA)->fu_bmi := (nA)->fu_gew_kg*10000/((nA)->fu_hoehecm*(nA)->fu_hoehecm)) CASE oXbp:cargo = "FU_GEW_KG" .AND. !Empty((nA)->fu_hoehecm) ::XbpObjektSet(,"FU_BMI",(nA)->fu_bmi := (nA)->fu_gew_kg*10000/((nA)->fu_hoehecm*(nA)->fu_hoehecm)) CASE oXbp:cargo = "Z_HOEHECM" .AND. !Empty((nA)->z_hoehecm) ::XbpObjektSet(,"Z_BMI",(nA)->z_bmi := (nA)->z_gew_kg*10000/((nA)->z_hoehecm*(nA)->z_hoehecm)) CASE oXbp:cargo = "Z_GEW_KG" .AND. !Empty((nA)->z_hoehecm) ::XbpObjektSet(,"Z_BMI",(nA)->z_bmi := (nA)->z_gew_kg*10000/((nA)->z_hoehecm*(nA)->z_hoehecm)) ENDCASE (nA)->(DbRUnlock()) // (nA)->(DbSkip(0)) RETURN self //+25.08.2008 19:55 berechnet die FettKg aus dem Gewicht und den Fett-% METHOD HistorieFF:FettKg(oXbp) LOCAL nA := ::VArea DEFAULT oXbp TO oCtrl:lastXbp (nA)->(Satzsp(oCB)) DO CASE CASE oXbp:cargo = "ST_F_PRO" ::XbpObjektSet(,"ST_F_KG",(nA)->st_f_kg := (nA)->st_gew_kg*(nA)->st_f_pro/100 ) CASE oXbp:cargo = "ST_GEW_KG" ::XbpObjektSet(,"ST_F_KG",(nA)->st_f_kg := (nA)->st_gew_kg*(nA)->st_f_pro/100 ) CASE oXbp:cargo = "FU_F_PRO" ::XbpObjektSet(,"FU_F_KG",(nA)->fu_f_kg := (nA)->fu_gew_kg*(nA)->fu_f_pro/100 ) CASE oXbp:cargo = "FU_GEW_KG" ::XbpObjektSet(,"FU_F_KG",(nA)->fu_f_kg := (nA)->fu_gew_kg*(nA)->fu_f_pro/100 ) CASE oXbp:cargo = "Z_F_PRO" ::XbpObjektSet(,"Z_F_KG",(nA)->z_f_kg := (nA)->z_gew_kg*(nA)->z_f_pro/100 ) CASE oXbp:cargo = "Z_GEW_KG" ::XbpObjektSet(,"Z_F_KG",(nA)->z_f_kg := (nA)->z_gew_kg*(nA)->z_f_pro/100 ) ENDCASE (nA)->(DbRUnlock()) // (nA)->(DbSkip(0)) RETURN self //+10.11.2008 12:15 Wertetabelle fr Bestatterums„tze: //+ im Feld mit Namen cFeld steht der Wert fr die Tabelle, in cScope z.B. das Jahr METHOD HistorieFF:WerteTabelle(cFeld,cIndex,cScope,nArt) //+24.07.2009 17:54 nArt LOCAL nOldArea := SELECT(), nMonat, i, nWert, nRec LOCAL aArt := Array(15) // eine Zeile der ::aMesswerte LOCAL cScopeT, cScopeB, n, j, cPict := cPict2 := "999999.99 EUR" LOCAL cAufT := IIf((i:=At("-",oHist:cAufBer))>0,Left(oHist:cAufBer,i-1),oHist:cAufBer) LOCAL cAufB := IIf((i:=At("-",oHist:cAufBer))>0,Right(oHist:cAufBer,Len(oHist:cAufBer)-i),oHist:cAufBer) LOCAL cArtNr := "" //+08.08.2009 21:30 =zugr_z_st, wg mehrerer Zeilen ohne ArtNr LOCAL nJahr DEFAULT cFeld TO "betneteu" //+ wird sp„ter geUpper()t DEFAULT cIndex TO "DtoS(r_datum)+zugr_z_st+StrX(auftrnr,E)" DEFAULT cScope TO Str(Year(DATE()),4) DEFAULT nArt TO 1 PRIVATE cF := cFeld //+23.08.2009 22:35 Suchfeld cScopeT := IIf((i:=At("-",cScope))>0,Left(cScope,i-1),cScope) cScopeB := IIf((i:=At("-",cScope))>0,Right(cScope,Len(cScope)-i),cScope) // IIf(cScopeT != cScopeB .AND. nArt=2, nArt := 3,) ThreadObject():setPriority(PRIORITY_TIME_CRITICAL) //+12.11.2008 09:47 ::aMessWerte := {} // initialisieren bzw. L”schen des vorherigen Inhalts cFeld := Upper(cFeld) IF nArt = 1 //+ Monats/Jahres-Statistik des Umsatzes der einzelnen Artikel DbUseArea(.T.,,"ArtTemp","at") // OrdListAdd("ArtTemp") OrdCreate("ArtTemp","ax",cIndex) OrdSetFocus("ax") DbSetScope( SCOPE_TOP, cScopeT+" " ) DbSetScope( SCOPE_BOTTOM, cScopeB+"zzzz" ) IF cScopeT = cScopeB // šbersicht: Monatsums„tze eines Jahres ::aI2 := Array(15) //+ aI2+aI1 hierher und ge„ndert ::aI2[1] := cScope+" Artikel" ::aI2[14] := "Summen" ::aI2[15] := "Artikel-Bez." ::aI1 := Array(7,15) // SummenZeile + 07.08.2009 21:10 2-dim AEval(::aI1,{|a,i|AFill(a,0)}) ::aI1[1,1] := "Sum FL-Brutto" ::aI1[2,1] := "Sum EL-Netto" ::aI1[3,1] := "Sum EL-MwSt" ::aI1[4,1] := "Sum EL-Brutto" ::aI1[5,1] := "Sum EL-EK-Pr" ::aI1[6,1] := "Sum EL-Gewinn" ::aI1[7,1] := "Sum EL/FL-Fehl" FOR nMonat := 1 TO 12 LOCATE FOR Month(r_datum) == nMonat ::aI2[nMonat+1] := IIf(!Eof(),CMonth(r_datum),"--------") DO WHILE Month(at->r_datum) == nMonat .AND. !at->(Eof()) IF at->rn = "4" DbSkip() LOOP ENDIF cArtNr := IIf( at->zugr_z_st!=" ", at->zugr_z_st, cArtNr ) DO CASE CASE at->auftrnr > Val(cAufB) .OR. at->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP CASE cFeld == "MENGE" nWert := IIf(IsFieldVar("menge"),at->menge,1) cPict := "999999" CASE cFeld == "BETNETEU" nWert := IIf(IsFieldVar("betneteu"),at->betneteu,at->betrageu) cPict := "999999.99 EUR" CASE cFeld == "GES_PRNET" nWert := IIf(IsFieldVar("ges_prnet"),at->ges_prnet,at->betrageu) cPict := "999999.99 EUR" CASE cFeld == "GEWINNEU" nWert := IIf(IsFieldVar("gewinneu"),at->gewinneu,1) cPict := "999999.99 EUR" ENDCASE cPict2 := "9"+cPict IF cFeld == "BETNETEU" IF at->kennz = "1" //+ EL-Netto ::aI1[2,nMonat+1] += nWert ::aI1[2,14] += nWert IF at->(IsFieldVar("mwst_satz")) ::aI1[3,nMonat+1] += nWert * at->mwst_satz / 100 //+ EL-MwSt ::aI1[3,14] += nWert * at->mwst_satz / 100 ELSE ::aI1[3,nMonat+1] += nWert * IIf(at->mwst_schl="2",7,19) / 100 //+ EL-MwSt ::aI1[3,14] += nWert * IIf(at->mwst_schl="2",7,19) / 100 ENDIF ::aI1[4,nMonat+1] += at->betrageu //+ EL-Brutto ::aI1[4,14] += at->betrageu 6->(DbSeek(cArtNr,.F.)) IF !6->(Eof()) ::aI1[5,nMonat+1] += 6->ek_preiseu //+ EL-EK ::aI1[5,14] += 6->ek_preiseu ::aI1[6,nMonat+1] += nWert - 6->ek_preiseu //+ EL-Gewinn ::aI1[6,14] += nWert - 6->ek_preiseu ELSE //+ wenn Artikel nicht in der ArtikelDatei: ::aI1[5,nMonat+1] += at->betrageu //+ EL-EK ::aI1[5,14] += at->betrageu ::aI1[6,nMonat+1] += nWert - at->betrageu //+ EL-Gewinn ::aI1[6,14] += nWert - at->betrageu ENDIF ELSEIF at->kennz = "2" //+ FL ::aI1[1,nMonat+1] += nWert ::aI1[1,14] += nWert ELSE //+ EL/FL-Fehler ::aI1[7,nMonat+1] += nWert ::aI1[7,14] += nWert ENDIF ELSEIF at->kennz == "1" //+ EL ::aI1[2,nMonat+1] += nWert ::aI1[2,14] += nWert ELSEIF at->kennz == "2" //+ FL ::aI1[1,nMonat+1] += nWert ::aI1[1,14] += nWert ELSE //+ EL/FL-Fehler ::aI1[7,nMonat+1] += nWert ::aI1[7,14] += nWert ENDIF i := AScan( ::aMessWerte, {|a| a[1] == cArtNr } ) //zugr_z_st } ) IF i > 0 //+ wenn der Artikel bereits im Array ist: cWert := ::aMessWerte[i,nMonat+1] nVal := IIf(::aMessWerte[i,nMonat+1]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) ::aMessWerte[i,nMonat+1] := Transform( nVal + nWert,cPict) cWert := ::aMessWerte[i,14] nVal := IIf(::aMessWerte[i,14]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) ::aMessWerte[i,14] := Transform( nVal + nWert,cPict2) ELSE //+ Array muss um diesen Artikel erweitert werden: AFill(aArt,Transform(0,cPict)) //+ "0,00 EUR") aArt[1] := cArtNr //at->zugr_z_st aArt[15] := at->bezeich aArt[nMonat+1] := Transform( nWert, cPict ) aArt[14] := Transform( nWert, cPict ) AAdd(::aMessWerte,AClone(aArt)) ENDIF DbSkip() ENDDO NEXT DbCloseArea() ASort( ::aMessWerte,,, {|a1,a2| a1[1] < a2[1] } ) // AEval(::aI1,{|a,x|a:=Transform(a,cPict2)},2,13,.T.) AEval(::aI1,{|a,i|AEval(a,{|b,x|b:=Transform(b,cPict2)},2,13,.T.)}) //+07.08.2009 21:13 AEval(::aI1,{|a,i|AAdd( ::aMessWerte, AClone(a) ) } ) //+07.08.2009 21:13 ELSE // šbersicht: Jahresums„tze aller Artikel // ::aI2 := Array(15) // ::aI2[1] := "Artikel" // ::aI2[14] := "Summen" // ::aI2[15] := cScope ::aI2 := {} // šberschriften 12.08.2009 11:58 hierher + ge„ndert AAdd(::aI2,"Artikel") n := Val(cScopeB)-Val(cScopeT)+4 // zugr_z_st+(vonJahr...bisJahr)+Summe+Bezeichnung ::aI1 := Array(7,n) // SummenZeile + 12.08.2009 11:582-dim AEval(::aI1,{|a,i|AFill(a,0)}) ::aI1[1,1] := "Sum FL-Brutto" ::aI1[2,1] := "Sum EL-Netto" ::aI1[3,1] := "Sum EL-MwSt" ::aI1[4,1] := "Sum EL-Brutto" ::aI1[5,1] := "Sum EL-EK-Pr" ::aI1[6,1] := "Sum EL-Gewinn" ::aI1[7,1] := "Sum EL/FL-Fehl" j := 0 aArt := Array(n) // Zeilen // ::aI1 := Array(n) // SummenZeile // AFill(::aI1,0) // ::aI1[1] := "Summen" FOR nJahr := Val(cScopeT) TO Val(cScopeB) ++j LOCATE FOR Year(r_datum) == nJahr AAdd(::aI2,IIf(!Eof(),Str(nJahr,4,0),"--------")) DO WHILE Year(r_datum) == nJahr .AND. !Eof() IF at->rn = "4" DbSkip() LOOP ENDIF cArtNr := IIf( at->zugr_z_st!=" ", at->zugr_z_st, cArtNr ) DO CASE CASE at->auftrnr > Val(cAufB) .OR. at->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP CASE cFeld == "MENGE" nWert := IIf(IsFieldVar("menge"),at->menge,1) cPict := "999999" CASE cFeld == "BETNETEU" nWert := IIf(IsFieldVar("betneteu"),at->betneteu,at->betrageu) cPict := "999999.99 EUR" CASE cFeld == "GES_PRNET" nWert := IIf(IsFieldVar("ges_prnet"),at->ges_prnet,at->betrageu) cPict := "999999.99 EUR" CASE cFeld == "GEWINNEU" nWert := IIf(IsFieldVar("gewinneu"),at->gewinneu,1) cPict := "999999.99 EUR" ENDCASE cPict2 := "9"+cPict IF cFeld == "BETNETEU" IF at->kennz = "1" //+ EL-Netto ::aI1[2,j+1] += nWert ::aI1[2,n-1] += nWert IF at->(IsFieldVar("mwst_satz")) ::aI1[3,j+1] += nWert * at->mwst_satz / 100 //+ EL-MwSt ::aI1[3,n-1] += nWert * at->mwst_satz / 100 ELSE ::aI1[3,j+1] += nWert * IIf(at->mwst_schl="2",7,19) / 100 //+ EL-MwSt ::aI1[3,n-1] += nWert * IIf(at->mwst_schl="2",7,19) / 100 ENDIF ::aI1[4,j+1] += at->betrageu //+ EL-Brutto ::aI1[4,n-1] += at->betrageu 6->(DbSeek(cArtNr,.F.)) IF !6->(Eof()) ::aI1[5,j+1] += 6->ek_preiseu //+ EL-EK ::aI1[5,n-1] += 6->ek_preiseu ::aI1[6,j+1] += nWert - 6->ek_preiseu //+ EL-Gewinn ::aI1[6,n-1] += nWert - 6->ek_preiseu ELSE //+ wenn Artikel nicht in der ArtikelDatei: ::aI1[5,j+1] += at->betrageu //+ EL-EK ::aI1[5,n-1] += at->betrageu ::aI1[6,j+1] += nWert - at->betrageu //+ EL-Gewinn ::aI1[6,n-1] += nWert - at->betrageu ENDIF ELSEIF at->kennz = "2" //+ FL ::aI1[1,j+1] += nWert ::aI1[1,n-1] += nWert ELSE //+ EL/FL-Fehler ::aI1[7,j+1] += nWert ::aI1[7,n-1] += nWert ENDIF ELSEIF at->kennz == "1" //+ EL ::aI1[2,j+1] += nWert ::aI1[2,n-1] += nWert ELSEIF at->kennz == "2" //+ FL ::aI1[1,j+1] += nWert ::aI1[1,n-1] += nWert ELSE //+ EL/FL-Fehler ::aI1[7,j+1] += nWert ::aI1[7,n-1] += nWert ENDIF i := AScan( ::aMessWerte, {|a| a[1] == cArtNr } ) //zugr_z_st } ) IF cFeld = "MENGE" .AND. !IsFieldVar("MENGE") // ++::aI1[j+1] // ++::aI1[n-1] IF i > 0 //+ wenn der Eintrag bereits im Array ist: ++::aMessWerte[i,j+1] ++::aMessWerte[i,n-1] ELSE //+ Array muss um diesen Eintrag erweitert werden: AFill(aArt,0) aArt[1] := cArtNr //zugr_z_st ++aArt[j+1] ++aArt[n-1] aArt[n] := bezeich AAdd(::aMessWerte,AClone(aArt)) ENDIF ELSE // ::aI1[j+1] += nWert // ::aI1[n-1] += nWert IF i > 0 //+ wenn der Eintrag bereits im Array ist: ::aMessWerte[i,j+1] += nWert ::aMessWerte[i,n-1] += nWert ELSE //+ Array muss um diesen Eintrag erweitert werden: AFill(aArt,0) aArt[1] := cArtNr //zugr_z_st aArt[j+1] += nWert aArt[n-1] += nWert aArt[n] := bezeich AAdd(::aMessWerte,AClone(aArt)) ENDIF ENDIF DbSkip() ENDDO NEXT AAdd(::aI2,"Summen") AAdd(::aI2,"Bezeichnung") DbCloseArea() IF cFeld = "MENGE" AEval(::aMesswerte,{|a,i|AEval(a,{|b,x|b:=Str(b,5,0)},2,n-2,.T.)}) ELSE AEval(::aMesswerte,{|a,i|AEval(a,{|b,x|b:=Transform(b,cPict)},2,n-2,.T.)}) ENDIF ASort( ::aMessWerte,,, {|a1,a2| a1[1] < a2[1] } ) // AEval(::aI1,{|a,x|a:=Transform(a,cPict2)},2,n-2,.T.) // AAdd(::aMessWerte,AClone(::aI1)) AEval(::aI1,{|a,i|AEval(a,{|b,x|b:=Transform(b,cPict2)},2,13,.T.)}) //+07.08.2009 21:13 AEval(::aI1,{|a,i|AAdd( ::aMessWerte, AClone(a) ) } ) //+07.08.2009 21:13 ENDIF ELSEIF nArt = 2 //+24.07.2009 19:00 IF cScopeT = cScopeB // šbersicht: Sterbef„lle eines Jahres pro Monat+Altersklasse ::aI2 := Array(14) ::aI2[1] := "Alter" ::aI2[14] := cScope ::aI1 := Array(12,14) // SummenZeile + 12.08.2009 11:582-dim AEval(::aI1,{|a,i|AFill(a,0)}) ::aI1[1,1] := "Sum 0-9Jahre" ::aI1[2,1] := "Sum 10-19Jahre" ::aI1[3,1] := "Sum 20-29Jahre" ::aI1[4,1] := "Sum 30-39Jahre" ::aI1[5,1] := "Sum 40-49Jahre" ::aI1[6,1] := "Sum 50-59Jahre" ::aI1[7,1] := "Sum 60-69Jahre" ::aI1[8,1] := "Sum 70-79Jahre" ::aI1[9,1] := "Sum 80-89Jahre" ::aI1[10,1] := "Sum 90-99Jahre" ::aI1[11,1] := "Sum 100-109Jahre" ::aI1[12,1] := "Sum 110-119Jahre" SELECT 1 nRec := RecNo() DbSuspendNotifications() OrdCreate("BestTemp","sdx",cIndex) OrdSetFocus("sdx") DbSetScope( SCOPE_TOP, cScopeT ) DbSetScope( SCOPE_BOTTOM, cScopeB+"zzzz" ) ::aMesswerte := Array(121,14) AEval(::aMesswerte,{|a,i|AFill(a,0)}) ::aMesswerte[121,1] := "Summen" FOR nMonat := 1 TO 12 LOCATE FOR Month(gestorben) == nMonat ::aI2[nMonat+1] := IIf(!Eof(),CMonth(1->gestorben),"--------") DO WHILE Month(gestorben) == nMonat .AND. !Eof() IF 1->auftrnr > Val(cAufB) .OR. 1->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP ENDIF i := Max(Min(Int(Int((1->gestorben - 1->geb_datum)/365.25)/10),11),0) // IF i > 10 // IIf(i=1,,) // ENDIF // ::aMesswerte[i+1,1] := Str(i * 10,3,0)+" bis "+Str(i * 10+9,3,0)+" Jahre" // ++::aMesswerte[i+1,nMonat+1] // ++::aMesswerte[i+1,14] // ++::aMesswerte[13,nMonat+1] // ++::aMesswerte[13,14] k := Min(119,Int((1->gestorben - 1->geb_datum)/365.25)) IIf(k<0,k:=119,) ::aMesswerte[k+1,1] := Str(k,3,0)+" Jahre" ++::aMesswerte[k+1,nMonat+1] ++::aMesswerte[k+1,14] ++::aMesswerte[121,nMonat+1] ++::aMesswerte[121,14] ++::aI1[i+1,nMonat+1] ++::aI1[i+1,14] DbSkip() ENDDO NEXT AEval(::aI1,{|a,i|AAdd( ::aMessWerte, AClone(a) ) } ) //+07.08.2009 21:13 ELSE //+12.08.2009 11:38 Sterbef„lle mehrerer Jahre pro Jahr+Altersklasse ::aI2 := {} AAdd(::aI2,"Alter") SELECT 1 nRec := RecNo() DbSuspendNotifications() OrdCreate("BestTemp","sdx",cIndex) OrdSetFocus("sdx") DbSetScope( SCOPE_TOP, cScopeT ) DbSetScope( SCOPE_BOTTOM, cScopeB+"zzzz" ) n := Val(cScopeB)-Val(cScopeT)+3 ::aI1 := Array(12,n) // SummenZeile + 12.08.2009 11:582-dim AEval(::aI1,{|a,i|AFill(a,0)}) ::aI1[1,1] := "Sum 0-9Jahre" ::aI1[2,1] := "Sum 10-19Jahre" ::aI1[3,1] := "Sum 20-29Jahre" ::aI1[4,1] := "Sum 30-39Jahre" ::aI1[5,1] := "Sum 40-49Jahre" ::aI1[6,1] := "Sum 50-59Jahre" ::aI1[7,1] := "Sum 60-69Jahre" ::aI1[8,1] := "Sum 70-79Jahre" ::aI1[9,1] := "Sum 80-89Jahre" ::aI1[10,1] := "Sum 90-99Jahre" ::aI1[11,1] := "Sum 100-109Jahre" ::aI1[12,1] := "Sum 110-119Jahre" j := 0 ::aMesswerte := Array(121,n) AEval(::aMesswerte,{|a,i|AFill(a,0)}) ::aMesswerte[121,1] := "Summen" FOR nJahr := Val(cScopeT) TO Val(cScopeB) ++j LOCATE FOR Year(gestorben) == nJahr AAdd(::aI2,IIf(!Eof(),Str(nJahr,4,0),"--------")) DO WHILE Year(gestorben) == nJahr .AND. !Eof() IF 1->auftrnr > Val(cAufB) .OR. 1->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP ENDIF i := Max(Min(Int(Int((1->gestorben - 1->geb_datum)/365.25)/10),11),0) // IF i > 10 // IIf(i=1,,) // ENDIF // ::aMesswerte[i+1,1] := Str(i * 10,3,0)+" bis "+Str(i * 10+9,3,0)+" Jahre" // ++::aMesswerte[i+1,j+1] // ++::aMesswerte[i+1,n] // ++::aMesswerte[13,j+1] // ++::aMesswerte[13,n] k := Min(119,Int((1->gestorben - 1->geb_datum)/365.25)) IIf(k<0,k:=119,) ::aMesswerte[k+1,1] := Str(k,3,0)+" Jahre" ++::aMesswerte[k+1,j+1] ++::aMesswerte[k+1,n] ++::aMesswerte[121,j+1] ++::aMesswerte[121,n] ++::aI1[i+1,j+1] ++::aI1[i+1,n] DbSkip() ENDDO NEXT AAdd(::aI2,"Summen") AEval(::aI1,{|a,i|AAdd( ::aMessWerte, AClone(a) ) } ) //+07.08.2009 21:13 ENDIF DbClearScope() OrdSetFocus(1) DbGoto(nRec) DbResumeNotifications() AEval(::aMesswerte,{|a,i|AEval(a,{|n,x|n:=Str(n,5,0)},2,,.T.)}) ELSEIF nArt = 4 .OR.(nArt > 40 .AND. nArt <=49) //+24.07.2009 19:00 Sterbef„lle pro Friedhof 23.08.2009 22:36 cF := IIf(nArt=4,"gestorben",{"auftrdat","gestorben","&TD1","&TD2","&TD3","&TD4","X","abr_datum"}[nArt-40]) ::aI2 := {} AAdd(::aI2,"Friedhof") SELECT 1 nRec := RecNo() DbSuspendNotifications() IF cF = "X" OrdCreate("BestTemp","sdx","PadR(Trim(DtoS(&TD2))+Trim(DtoS(&TD4)),8)") //cIndex) ELSE OrdCreate("BestTemp","sdx","DtoS(&cF)") //cIndex) ENDIF OrdSetFocus("sdx") DbSetScope( SCOPE_TOP, cScopeT ) DbSetScope( SCOPE_BOTTOM, cScopeB+"zzzz" ) n := Val(cScopeB)-Val(cScopeT)+3 j := 0 aArt := Array(n) ::aI1 := Array(n) AFill(::aI1,0) ::aI1[1] := "Summen" FOR nJahr := Val(cScopeT) TO Val(cScopeB) ++j IF cF = "X" // LOCATE FOR Year(&TD2) == nJahr .OR. Year(&TD4) == nJahr DbLocate( {|| Year(&TD2) == nJahr .OR. Year(&TD4) == nJahr } ) ELSE // LOCATE FOR Year(&cF) == nJahr DbLocate( {|| Year(&cF) == nJahr } ) ENDIF AAdd(::aI2,IIf(!Eof(),Str(nJahr,4,0),"--------")) DO WHILE IIf(cF="X",Year(&TD2)=nJahr .OR. Year(&TD4)=nJahr,Year(&cF) == nJahr) .AND. !Eof() IF 1->auftrnr > Val(cAufB) .OR. 1->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP ENDIF IF IsFieldVar(TO4) i := AScan( ::aMessWerte, {|a| Upper(Trim(a[1])) $ Upper(&TO2+&TO4) } ) ELSE i := AScan( ::aMessWerte, {|a| Upper(Trim(a[1])) = Upper(Trim(&TO2)) } ) ENDIF IF i > 0 //+ wenn der Friedhof bereits im Array ist: ++::aMessWerte[i,j+1] ++::aI1[j+1] ++::aMessWerte[i,n] ++::aI1[n] ELSE //+ Array muss um diesen Friedhof erweitert werden: AFill(aArt,0) IF IsFieldVar(TO4) aArt[1] := AllTrim(&TO2)+AllTrim(&TO4) ELSE aArt[1] := AllTrim(&TO2) ENDIF ++aArt[j+1] ++::aI1[j+1] ++aArt[n] ++::aI1[n] AAdd(::aMessWerte,AClone(aArt)) ENDIF DbSkip() ENDDO NEXT ASort( ::aMessWerte,,, {|a1,a2| a1[1] < a2[1] } ) AAdd(::aMessWerte,AClone(::aI1)) AAdd(::aI2,"Summen") DbClearScope() OrdSetFocus(1) DbGoto(nRec) DbResumeNotifications() AEval(::aMesswerte,{|a,i|AEval(a,{|n,x|n:=Str(n,5,0)},2,,.T.)}) ELSEIF nArt = 5 //+24.07.2009 19:00 Inhalte in beliebigem Feld pro Monat/Jahr ::aI2 := {} cF := ::aFldBes[1] cB := ::aFldBes[2] AAdd(::aI2,::aFldBes[2]) SELECT 1 nRec := RecNo() DbSuspendNotifications() OrdCreate("BestTemp","sdx",cIndex) OrdSetFocus("sdx") DbSetScope( SCOPE_TOP, cScopeT ) DbSetScope( SCOPE_BOTTOM, cScopeB+"zzzz" ) n := Val(cScopeB)-Val(cScopeT)+3 j := 0 aArt := Array(n) ::aI1 := Array(n) AFill(::aI1,0) ::aI1[1] := "Summen" FOR nJahr := Val(cScopeT) TO Val(cScopeB) ++j LOCATE FOR Year(gestorben) == nJahr AAdd(::aI2,IIf(!Eof(),Str(nJahr,4,0),"--------")) DO WHILE Year(gestorben) == nJahr .AND. !Eof() IF 1->auftrnr > Val(cAufB) .OR. 1->auftrnr < Val(cAufT) //+07.08.2009 16:35 DbSkip() LOOP ENDIF i := AScan( ::aMessWerte, {|a| Upper(Trim(a[1])) == Upper(Trim(&cF)) } ) IF i > 0 //+ wenn der Eintrag bereits im Array ist: ++::aMessWerte[i,j+1] ++::aI1[j+1] ++::aMessWerte[i,n] ++::aI1[n] ELSE //+ Array muss um diesen Eintrag erweitert werden: AFill(aArt,0) aArt[1] := AllTrim(&cF) ++aArt[j+1] ++::aI1[j+1] ++aArt[n] ++::aI1[n] AAdd(::aMessWerte,AClone(aArt)) ENDIF DbSkip() ENDDO NEXT ASort( ::aMessWerte,,, {|a1,a2| a1[1] < a2[1] } ) AAdd(::aMessWerte,AClone(::aI1)) AAdd(::aI2,"Summen") DbClearScope() OrdSetFocus(1) DbGoto(nRec) DbResumeNotifications() AEval(::aMesswerte,{|a,i|AEval(a,{|n,x|n:=Str(n,5,0)},2,,.T.)}) ENDIF ThreadObject():setPriority(PRIORITY_NORMAL) //+12.11.2008 09:48 SELECT &nOldArea RETURN self //////METHOD HistorieFF:WerteTabelle(cFF) ////// LOCAL nOldArea := SELECT(), nRec := 8->(RecNo()), aStruct, n, s := 0, smax //+s=Spalte ////// DEFAULT cFF TO "S_FU0" ////// ////// DbUseArea( .T.,"SDFNTX", "s_.tak", "sv", .T. ) // .T./.T. bedeutet : NEW Area/shared ////// OrdListAdd("xFldPos") // 9.2.2005: weil schon in ineux geindext ////// DbSetScope( SCOPE_BOTH, PadR(Upper(cFF),8) ) // 8.2.2005 ////// //+ um die Gr”áe der ::aMesswerte zu bestimmen: ////// SELECT 8 ////// DbSuspendNotifications() ////// DbGotop() ////// DO WHILE !8->(Eof()) ////// ++s ////// DbSkip() ////// ENDDO ////// smax := s ////// s := 0 ////// aStruct := DbStruct() ////// DbGotop() ////// //+ ////// ::aMesswerte := Array( Len(aStruct), smax+3 ) ////// //+ Zeilenk”pfe und Startwerte kommen aus Messwert.dbf (7) ////// SELECT 7 ////// ++s; z := 0 //////////////////////////// sv->(DbLocate( {||sv->FIELD_POS == 120 } )) //////////////////////////// DO WHILE sv->FIELD_POS < 155 // die Felder ST_... ////// sv->(DbLocate( {|| Trim(sv->TEXT) == "S T A R T :" } )) ////// sv->(DbSkip()) ////// DO WHILE sv->FIELD_TYPE $ "CND" // die Felder ST_... ////// cFeld := Trim(sv->FIELD_NAME) ////// IF !7->(IsFieldVar(cFeld)) ////// sv->(DbSkip()) ////// LOOP ////// ENDIF ////// ++z ////// ::aMesswerte[z,s] := Trim(sv->TEXT) // die 'Prompts', d.h. 1.Spalte der Tabelle ////// DO CASE ////// CASE sv->FIELD_TYPE == "C" ////// ::aMesswerte[z,s+1] := Trim(7->(&cFeld)) ////// CASE sv->FIELD_TYPE == "N" ////// ::aMesswerte[z,s+1] := Trim(Transform( 7->(&cFeld), sv->ZAHL_FORM )) ////// CASE sv->FIELD_TYPE == "D" ////// ::aMesswerte[z,s+1] := DtoC(7->(&cFeld)) ////// ENDCASE ////// sv->(DbSkip()) ////// ENDDO ////// ++s //+ weil s zweimal verwendet wurde (Text und Startwerte) ////// //+ Zielwerte kommen auch aus Messwert.dbf (7) ////// z := 0 ////////////////////////////// sv->(DbLocate( {||sv->FIELD_POS == 220 } )) ////////////////////////////// DO WHILE sv->FIELD_POS < 255 // die Felder Z_... ////// sv->(DbLocate( {|| Trim(sv->TEXT) == "Z I E L :" } )) ////// sv->(DbSkip()) ////// DO WHILE sv->FIELD_TYPE $ "CND" // die Felder Z_... ////// cFeld := Trim(sv->FIELD_NAME) ////// IF !7->(IsFieldVar(cFeld)) ////// sv->(DbSkip()) ////// LOOP ////// ENDIF ////// ++z ////// DO CASE ////// CASE sv->FIELD_TYPE == "C" ////// ::aMesswerte[z,smax+3] := Trim(7->(&cFeld)) ////// CASE sv->FIELD_TYPE == "N" ////// ::aMesswerte[z,smax+3] := Trim(Transform( 7->(&cFeld), sv->ZAHL_FORM )) ////// CASE sv->FIELD_TYPE == "D" ////// ::aMesswerte[z,smax+3] := DtoC(7->(&cFeld)) ////// ENDCASE ////// sv->(DbSkip()) ////// ENDDO ////// //+ Jetzt kommen die FU_...-Werte aus der FUWerte.dbf (8): ////// SELECT 8 ////// DO WHILE !8->(Eof()) ////// ++s; z := 0 ////////////////////////////////// sv->(DbLocate( {||sv->FIELD_POS == 160 } )) ////////////////////////////////// DO WHILE sv->FIELD_POS < 195 ////// sv->(DbLocate( {|| Trim(sv->TEXT) == "W E R T E :" } )) ////// sv->(DbSkip()) ////// DO WHILE sv->FIELD_TYPE $ "CND" // die Felder ST_... ////// cFeld := Trim(sv->FIELD_NAME) ////// IF !8->(IsFieldVar(cFeld)) ////// sv->(DbSkip()) ////// LOOP ////// ENDIF ////// ++z ////// DO CASE ////// CASE sv->FIELD_TYPE == "C" ////// ::aMesswerte[z,s] := Trim(8->(&cFeld)) ////// CASE sv->FIELD_TYPE == "N" ////// ::aMesswerte[z,s] := Trim(Transform( 8->(&cFeld), sv->ZAHL_FORM )) ////// CASE sv->FIELD_TYPE == "D" ////// ::aMesswerte[z,s] := DtoC(8->(&cFeld)) ////// ENDCASE ////// sv->(DbSkip()) ////// ENDDO ////// 8->(DbSkip()) ////// ENDDO ////// sv->(DbCloseArea()) ////// DbGoto(nRec) ////// DbResumeNotifications() ////// SELECT &nOldArea //////RETURN self //#define GRA_CLR_WHITE 0 //#define GRA_CLR_BLACK 1 //#define GRA_CLR_BLUE 2 //#define GRA_CLR_RED 3 //#define GRA_CLR_PINK 4 //#define GRA_CLR_GREEN 5 //#define GRA_CLR_CYAN 6 //#define GRA_CLR_YELLOW 7 //+ berechnet die Grenzwerte zu einer ::aMesswerte-Zeile, abh„ngig von Geschlecht und Alter METHOD HistorieFF:Grenzen(nZeile) DO CASE CASE "Fett-Prozent"$::aMesswerte[nZeile,1] IF ::cGeschlecht = "w " // sp„ter erweitern auf athletisch IIf(::nAlter=5, ::aGrenzen := {{14,5},{22,7},{26,3}}, ) IIf(::nAlter=6, ::aGrenzen := {{14,5},{23,7},{27,3}}, ) IIf(::nAlter=7, ::aGrenzen := {{15,5},{25,7},{29,3}}, ) IIf(::nAlter=8, ::aGrenzen := {{15,5},{26,7},{30,3}}, ) IIf(::nAlter=9, ::aGrenzen := {{16,5},{27,7},{31,3}}, ) IIf(::nAlter=10, ::aGrenzen := {{16,5},{28,7},{32,3}}, ) IIf(::nAlter>10.AND.::nAlter<14, ::aGrenzen := {{16,5},{29,7},{33,3}}, ) IIf(::nAlter>13.AND.::nAlter<18, ::aGrenzen := {{16,5},{30,7},{34,3}}, ) IIf(::nAlter=18, ::aGrenzen := {{17,5},{31,7},{36,3}}, ) IIf(::nAlter=19, ::aGrenzen := {{19,5},{32,7},{37,3}}, ) IIf(::nAlter>19.AND.::nAlter<25, ::aGrenzen := {{18.2,5},{22.1,7},{25.0,7},{29.6,3}}, ) IIf(::nAlter>24.AND.::nAlter<30, ::aGrenzen := {{18.9,5},{22.0,7},{25.4,7},{29.8,3}}, ) IIf(::nAlter>29.AND.::nAlter<35, ::aGrenzen := {{19.7,5},{22.7,7},{26.4,7},{30.5,3}}, ) IIf(::nAlter>34.AND.::nAlter<40, ::aGrenzen := {{21.1,5},{24.0,7},{27.7,7},{31.5,3}}, ) IIf(::nAlter>39.AND.::nAlter<45, ::aGrenzen := {{22.6,5},{25.6,7},{29.3,7},{32.8,3}}, ) IIf(::nAlter>44.AND.::nAlter<50, ::aGrenzen := {{24.3,5},{27.3,7},{30.9,7},{34.1,3}}, ) IIf(::nAlter>49.AND.::nAlter<55, ::aGrenzen := {{25.2,5},{28.2,7},{31.8,7},{35.1,3}}, ) IIf(::nAlter>54.AND.::nAlter<60, ::aGrenzen := {{26.6,5},{29.7,7},{33.1,7},{36.2,3}}, ) IIf(::nAlter>59.AND.::nAlter<99, ::aGrenzen := {{27.4,5},{30.7,7},{34.0,7},{37.3,3}}, ) ELSEIF ::cGeschlecht = "m " IIf(::nAlter=5, ::aGrenzen := {{12,5},{19,7},{23,3}}, ) IIf(::nAlter=6, ::aGrenzen := {{12,5},{20,7},{24,3}}, ) IIf(::nAlter=7, ::aGrenzen := {{13,5},{20,7},{25,3}}, ) IIf(::nAlter=8, ::aGrenzen := {{13,5},{21,7},{26,3}}, ) IIf(::nAlter=9, ::aGrenzen := {{13,5},{22,7},{27,3}}, ) IIf(::nAlter=10, ::aGrenzen := {{13,5},{23,7},{28,3}}, ) IIf(::nAlter=11, ::aGrenzen := {{13,5},{23,7},{28,3}}, ) IIf(::nAlter=12, ::aGrenzen := {{12,5},{23,7},{28,3}}, ) IIf(::nAlter=13, ::aGrenzen := {{12,5},{22,7},{27,3}}, ) IIf(::nAlter=14, ::aGrenzen := {{11,5},{21,7},{26,3}}, ) IIf(::nAlter=15, ::aGrenzen := {{10,5},{21,7},{25,3}}, ) IIf(::nAlter>15.AND.::nAlter<19, ::aGrenzen := {{10,5},{20,7},{24,3}}, ) IIf(::nAlter=19, ::aGrenzen := {{9,5},{20,7},{24,3}}, ) IIf(::nAlter>19.AND.::nAlter<25, ::aGrenzen := {{10.8,5},{14.9,7},{19.0,7},{23.3,3}}, ) IIf(::nAlter>24.AND.::nAlter<30, ::aGrenzen := {{12.8,5},{16.5,7},{20.3,7},{24.3,3}}, ) IIf(::nAlter>29.AND.::nAlter<35, ::aGrenzen := {{14.5,5},{18.0,7},{21.5,7},{25.2,3}}, ) IIf(::nAlter>34.AND.::nAlter<40, ::aGrenzen := {{16.1,5},{19.3,7},{22.6,7},{26.1,3}}, ) IIf(::nAlter>39.AND.::nAlter<45, ::aGrenzen := {{17.5,5},{20.5,7},{23.6,7},{26.9,3}}, ) IIf(::nAlter>44.AND.::nAlter<50, ::aGrenzen := {{18.6,5},{21.5,7},{24.5,7},{27.6,3}}, ) IIf(::nAlter>49.AND.::nAlter<55, ::aGrenzen := {{19.2,5},{22.1,7},{25.1,7},{28.2,3}}, ) IIf(::nAlter>54.AND.::nAlter<60, ::aGrenzen := {{19.8,5},{22.7,7},{25.6,7},{28.7,3}}, ) IIf(::nAlter>59.AND.::nAlter<99, ::aGrenzen := {{20.2,5},{23.3,7},{26.2,7},{29.3,3}}, ) ELSEIF ::cGeschlecht = "wa" // sp„ter erweitern auf athletisch ::aGrenzen := {{11,5},{14.5,7},{18,3}} ELSEIF ::cGeschlecht = "ma" // sp„ter erweitern auf athletisch ::aGrenzen := {{5,5},{10,7},{15,3}} ENDIF CASE "Wasser-Prozent"$::aMesswerte[nZeile,1] IF ::cGeschlecht = "w" IIf(::nAlter<15, ::aGrenzen := {{65,7},{70.5,5},{75,7}}, ) IIf(::nAlter>14, ::aGrenzen := {{50,7},{52.5,5},{55,7}}, ) ELSEIF ::cGeschlecht = "m" IIf(::nAlter<15, ::aGrenzen := {{65,7},{70.5,5},{75,7}}, ) IIf(::nAlter>14, ::aGrenzen := {{60,7},{62.5,5},{65,7}}, ) ENDIF CASE "Knochenmasse"$::aMesswerte[nZeile,1] IF ::cGeschlecht = "w" IIf(Val(::aMesswerte[4,2])<=50, ::aGrenzen := {{1.95,5}}, ) IIf(Val(::aMesswerte[4,2])>50.AND.Val(::aMesswerte[4,2])<=75, ::aGrenzen := {{2.40,5}}, ) IIf(Val(::aMesswerte[4,2])>75, ::aGrenzen := {{2.95,5}}, ) ELSEIF ::cGeschlecht = "m" IIf(Val(::aMesswerte[4,2])<=50, ::aGrenzen := {{2.65,5}}, ) IIf(Val(::aMesswerte[4,2])>50.AND.Val(::aMesswerte[4,2])<=75, ::aGrenzen := {{3.29,5}}, ) IIf(Val(::aMesswerte[4,2])>75, ::aGrenzen := {{3.69,5}}, ) ENDIF CASE "Viszeral"$::aMesswerte[nZeile,1] ::aGrenzen := {{4,5},{9,7},{13,3}} ENDCASE RETURN ::aGrenzen /*Die Teamtabelle ::aTeamwerte ist so aufgebaut: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, Wert1 , Wert2 , Wert3 , Wert4 , ... } { T01, Wert1 , Wert2 , Wert3 , Wert4 , ... } ... } */ METHOD HistorieFF:TeamTabelle(oXbp) // oXbp ist ein ST_~-Feld von Gewicht, Fett-%, ... LOCAL s := 0, y, z, cKdKz := 7->(DbScope(SCOPE_TOP)), nOldArea := SELECT() LOCAL nA := ::VArea, nRec := 8->(RecNo()) PRIVATE cF7, cF8 IF ValType(oXbp)!="O" .OR. oXbp:cargo == NIL RETURN self ENDIF 7->(DbSuspendNotifications()) 8->(DbSuspendNotifications()) SELECT 8 DbGotop() DO WHILE !8->(Eof()) ++s DbSkip() ENDDO smax := s IF smax > 1 // der aktuelle Teilnehmer bestimmt den Zeitrahmen! s := 1 //+ erste Spalte berspringen wg. kunden_kz (= Team-Mitglied) ::aTeamwerte := Array(Len(::aTeam)+1,smax+3) //+ erste Zeile mit den Datums-Angaben fllen: ::aTeamwerte[1,++s] := DtoC(7->st_datum) SELECT 8 DbGotop() DO WHILE !8->(Eof()) ::aTeamwerte[1,++s] := DtoC(8->fu_datum) DbSkip() ENDDO 7->(DbClearScope()) 8->(DbClearScope()) FOR y := 1 TO Len(::aTeam) z := y+1 s := 0 7->(DbSeek(::aTeam[y],.F.)) 8->(DbSeek(::aTeam[y],.F.)) ::aTeamwerte[z,++s] := ::aTeam[y] // die 'Prompts', d.h. 1.Spalte der Tabelle cF7 := Trim(oXbp:cargo) //+ Sp„tanf„nger bekommen die ersten Termine mit " " vorgefllt ... //+ ... und erst dann ihre Startwerte: DO WHILE s < Len(::aTeamwerte[1]) .AND. Trim(::aTeam[y]) = Trim(7->kunden_kz) .AND. ; ::aTeamwerte[1,s+1] != NIL .AND. 7->st_datum > CtoD(::aTeamwerte[1,s+1]) ::aTeamwerte[z,s+1] := " " ++s ENDDO DO CASE CASE ValType(7->(&cF7)) == "C" ::aTeamwerte[z,++s] := Trim(7->(&cF7)) CASE ValType(7->(&cF7)) == "N" ::aTeamwerte[z,++s] := Trim(Transform( 7->(&cF7), oXbp:picture )) CASE ValType(7->(&cF7)) == "D" ::aTeamwerte[z,++s] := DtoC(7->(&cF7)) ENDCASE cF8 := 8->(FieldName(7->(FieldPos(cF7)))) // aus ST_~ mach FU_~ DO WHILE Trim(::aTeam[y]) = Trim(8->kunden_kz) //+ Schw„nzer bekommen ihre Fehltermine mit vorigen Werten gefllt DO WHILE s < Len(::aTeamwerte[1]) .AND. Trim(::aTeam[y]) = Trim(8->kunden_kz) .AND. ; ::aTeamwerte[1,s+1] != NIL .AND. 8->fu_datum > CtoD(::aTeamwerte[1,s+1]) ::aTeamwerte[z,s+1] := ::aTeamwerte[z,s] ++s ENDDO DO CASE CASE ValType(8->(&cF8)) == "C" ::aTeamwerte[z,++s] := Trim(8->(&cF8)) CASE ValType(8->(&cF8)) == "N" ::aTeamwerte[z,++s] := Trim(Transform( 8->(&cF8), oXbp:picture )) CASE ValType(8->(&cF8)) == "D" ::aTeamwerte[z,++s] := DtoC(8->(&cF8)) ENDCASE 8->(DbSkip()) ENDDO //+ Schw„nzer bekommen ihre Fehltermine mit vorigen Werten gefllt DO WHILE s < Len(::aTeamwerte[1]) .AND. ::aTeamwerte[1,s+1] != NIL ::aTeamwerte[z,s+1] := ::aTeamwerte[z,s] ++s ENDDO NEXT (nA)->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) (nA)->(DbGotop()) (nA+1)->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) ELSE ::aTeamwerte := Array(Len(::aTeam)+1,2) AEval( ::aTeamwerte, {|a,i| IIf(i>1,a[1] := ::aTeam[i-1],a[1]:=" "), a[2]:=" " } ) ENDIF 8->(DbGoto(nRec)) 8->(DbResumeNotifications()) 7->(DbResumeNotifications()) SELECT &nOldArea RETURN self /*Die Teamtabelle ::aTeamwerte ist so aufgebaut: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, Wert1 , Wert2 , Wert3 , Wert4 , ... } { T01, Wert1 , Wert2 , Wert3 , Wert4 , ... } ... } daraus ergibt sich die Differenztabelle ::aTeamdiff so: (Differenz vom letzten Termin an bilden, weil die Werte ja gleich mit der Differenz ersetzt werden! { { NIL, Datum1, Datum2 , Datum3 , Datum4, ... } { T00, , Wert2-1 , Wert3-2 , Wert4-3 , ... } { T01, , Wert2-1 , Wert3-2 , Wert4-3 , ... } ... } */ METHOD HistorieFF:TeamDiff(oXbp) LOCAL nDiff, nVal1, nVal2, cWert ::aTeamdiff := AClone(::aTeamwerte) FOR i := 2 TO Len(::aTeamdiff) //+ die Teilnehmer FOR j := Len(::aTeamdiff[i]) TO 3 STEP -1 //+ die Termine cWert := ::aTeamdiff[i,j-1] nVal1 := IIf(::aTeamdiff[i,j-1]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) cWert := ::aTeamdiff[i,j] nVal2 := IIf(::aTeamdiff[i,j]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) ::aTeamdiff[i,j] := IIf( nVal1!=0 .AND. nVal2!=0, ; Trim(Transform( nVal2-nVal1, oXbp:picture )), " " ) NEXT ::aTeamdiff[i,2] := " " NEXT RETURN self /*Die Teamtabelle ::aTeamwerte ist so aufgebaut: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, Wert1 , Wert2 , Wert3 , Wert4 , ... } { T01, Wert1 , Wert2 , Wert3 , Wert4 , ... } ... } daraus ergibt sich die Tabelle der kumulierten Werte ::aTeamdiff so: 1. Differenz vom letzten Termin an bilden, weil die Werte ja gleich mit der Differenz ersetzt werden! { { NIL, Datum1, Datum2 , Datum3 , Datum4, ... } { T00, , Wert2-1 , Wert3-2 , Wert4-3 , ... } { T01, , Wert2-1 , Wert3-2 , Wert4-3 , ... } ... } 2. Differenz-Werte vom dritten Termin an addieren/kumulieren: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, , Wert2-1 , Wert3-2+, Wert4-3+, ... } Wert2-1 Wert3-2+ Wert2-1 { T01, , Diff1 , Diff2+, Diff3+, ... } Diff1 Diff2+ Diff1 ... } */ METHOD HistorieFF:TeamKumul(oXbp) LOCAL nDiff, nVal1, nVal2, cWert ::aTeamdiff := AClone(::aTeamwerte) FOR i := 2 TO Len(::aTeamdiff) FOR j := Len(::aTeamdiff[i]) TO 3 STEP -1 cWert := ::aTeamdiff[i,j-1] nVal1 := IIf(::aTeamdiff[i,j-1]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) cWert := ::aTeamdiff[i,j] nVal2 := IIf(::aTeamdiff[i,j]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) ::aTeamdiff[i,j] := IIf( nVal1!=0 .AND. nVal2!=0, ; Trim(Transform( nVal2-nVal1, oXbp:picture )), " " ) NEXT ::aTeamdiff[i,2] := " " NEXT FOR i := 2 TO Len(::aTeamdiff) FOR j := 4 TO Len(::aTeamdiff[i])-1 //+ 09.11.2008 17:45 -1 !! cWert := ::aTeamdiff[i,j-1] nVal1 := IIf(Len(LTrim(cWert))>0.AND.LTrim(cWert)[1]="-",-1,1)*(Abs(Val(cWert)) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100) cWert := ::aTeamdiff[i,j] nVal2 := IIf(Len(LTrim(cWert))>0.AND.LTrim(cWert)[1]="-",-1,1)*(Abs(Val(cWert)) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100) ::aTeamdiff[i,j] := Trim(Transform( nVal2+nVal1, oXbp:picture )) NEXT // ::aTeamdiff[i,2] := " " NEXT RETURN self //+ die prozentuale Entwicklung bezogen auf den Startwert: /*Die Teamtabelle ::aTeamwerte ist so aufgebaut: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, Wert1 , Wert2 , Wert3 , Wert4 , ... } { T01, Wert1 , Wert2 , Wert3 , Wert4 , ... } ... } 1. daraus ergibt sich die prozentuale Entwicklung durch den Bezug auf den Anfangswert: { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, , Wert2:1, Wert3:1, Wert4:1 , ... } { T01, , Wert2:1, Wert3:1, Wert4:1 , ... } ... } 2. daraus ergibt sich die prozentuale Differenz-Entwicklung durch die Differenz zu 100% (=1): { { NIL, Datum1, Datum2, Datum3, Datum4, ... } { T00, , Wert2:1-1, Wert3:1-1, Wert4:1-1 , ... } { T01, , Wert2:1-1, Wert3:1-1, Wert4:1-1 , ... } ... } */ //+08.11.2008 11:19 prozentuale Entwicklung der Werte (bezogen auf den Startwert) METHOD HistorieFF:TeamProzEntw(oXbp) LOCAL nDiff, nVal1, nVal2, cWert, nStart ::aTeamdiff := AClone(::aTeamwerte) FOR i := 2 TO Len(::aTeamdiff) //+ der Startwert steht AB der 2.Spalte (einige haben sp„ter angefangen)! nStart := AScan(::aTeamdiff[i], {|x|Len(AllTrim(x))>0}, 2 ) FOR j := Len(::aTeamdiff[i]) TO nStart+1 STEP -1 cWert := ::aTeamdiff[i,nStart] nVal1 := IIf(::aTeamdiff[i,nStart]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) cWert := ::aTeamdiff[i,j] //+ der Wert in dieser Woche nVal2 := IIf(::aTeamdiff[i,j]!=NIL,Val(cWert) + ; Val(SubStr(cWert,At(",",cWert)+1,1))/10 + ; Val(SubStr(cWert,At(",",cWert)+2,1))/100,0) ::aTeamdiff[i,j] := IIf( nVal1!=0 .AND. nVal2!=0, ; Trim(Transform( 100*nVal2/nVal1-100, "999.99 %" )), " " ) NEXT ::aTeamdiff[i,nStart] := " " NEXT RETURN self //+ mindestens ein Datensatz bei MessWert.dbf und FUWert.dbf ! METHOD HistorieFF:TeamBilden() LOCAL cGruppe := 1->gruppe, nOldArea := SELECT(), nRec, cTag LOCAL nRec7 := 7->(RecNo()), nRec8 := 8->(RecNo()), cKdKz := 1->kunden_kz ::aTeam := {} 7->(DbSuspendNotifications()) 7->(DbClearScope()) 8->(DbSuspendNotifications()) 8->(DbClearScope()) SELECT 1 DbSuspendNotifications() cTag := OrdSetFocus(0) nRec := RecNo() DbGotop() IF DbLocate( {|| 1->gruppe == cGruppe } ) IF 7->(DbSeek(1->kunden_kz,.F.)) AAdd( ::aTeam, 1->kunden_kz ) ENDIF ENDIF DO WHILE DbContinue() IF 7->(DbSeek(1->kunden_kz,.F.)) AAdd( ::aTeam, 1->kunden_kz ) ENDIF ENDDO ASort( ::aTeam ) DbGoto(nRec) OrdSetFocus(cTag) DbResumeNotifications() SELECT &nOldArea 7->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) 7->(DbGotop()) 8->(DbSetScope( SCOPE_BOTH, cKdKz )) //+ festsetzen auf das KundenKz aus Thread1 (nur 1 Datensatz!) 8->(DbGoto(nRec8)) 8->(DbResumeNotifications()) 7->(DbResumeNotifications()) RETURN self