//bestp6.prg/////////////////////////////////////////////////////////////////// // #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Font.ch" #include "dmlb.ch" #include "Set.ch" #include "Dmlb.ch" #include "Common.ch" PROCEDURE bestp( cTitel ) LOCAL nEvent, mp1, mp2, aFelder := {}, ID_SLE_PRIMKEY := 1 LOCAL oDlg, oXbp, oHelp LOCAL drawingArea, aEditControls := {} 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_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } // tats„chliche Bildschirmaufl”sung: nV kommt seit 27.2.2004 aus EUROV LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nW := nBSh/600 LOCAL n5 := int(5*nV) LOCAL n10 := int(10*nV) LOCAL n15 := int(15*nV) LOCAL n20 := int(20*nV) LOCAL n30 := int(30*nV) LOCAL nRo := int(505*nV) // oberstes Eingabefeld =505 LOCAL nBo := nRo LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 // LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 // // LOCAL cDeko, aDeko, bAction, cSTATUS, aSTATUS // fr die ComboBox LOCAL cVerst0 := cVerst1 := cVerst2 := cVerst3 := Trim(" ") LOCAL oBestMenu := SetAppFocus() LOCAL aPos := {} , aSize := {} , y := 0// Parameter fr XbpSle/XbpStatic LOCAL nFa := 0, cNr := Space(6) PRIVATE cV := " ", 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(6) PRIVATE cStringFM := cStringFJ := "" // 17.10.2004 PRIVATE oCB, oBEDA, oFocSle := SetAppFocus() // PRIVATE, weil sie in Funktionen verwendet werden!! PRIVATE cFont, oFont, nVers := 1, oSleSuch, oBest, oCtrl, oEdit PRIVATE aF1a, aF1b, aF2, aF3 PRIVATE aAdrKl := {"","","",""}, aAdrGr // 6.5.04 Adresse fr Kuvert PRIVATE cVariable := "vorname" // Makro-Variable fr den Maskenaufbau: PRIVATE FAM, STO1, STO2, STO3, TO1, TO2, TO3, TO4, TD1, TD2, TD3, TD4, TZ1, TZ2, TZ3, TZ4 PRIVATE EHGD, EHSD, EHGO, EHSO, EHHEI, ANSPE, FRIED, NACHO, GRART PRIVATE DUM1, DUM2, DUM3, DUM4, DUM5, DUM6, DUM7, DUM8, DUM9, cStadt := "" PRIVATE cBU1, cBU2, cSTN //19.04.2006 09:44 PRIVATE oVideo, oFocus //25.06.2006 15:32 cProgTyp := "n" // 14.09.2005 fr alle F„lle //**************Test fr DbSuspendNotifications 20.3.04 : // cBegleit := {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} // 3.5.2005 geREMt DO WHILE cV == " " // cV!=" " zum Umschalten der Filiale/des Mandanten //////// IF IsFieldVar("perskz") // mal sehen, ob man das beim Verlassen //////// SELECT 4 // auf arb.dbf umswitchen muss... //////// DbUseArea( , "FOXCDX", "Personen" ) // //////// OrdListAdd( "Personen" ) // //////// SELECT 1 // //////// DbSetRelation( 4, {|| StrZero(1->auftrnr,6,0)+1->perskz } ) // Scope siehe s_.tak bei Tab-Page //////// ENDIF //////// // cDatver mit einbauen, da FExists() wie FErase() eine Low-Level-Funktion ist! : IF !FExists( cDatver+"s_best.dbf" ) .AND. FExists( cDatver+"s_.tak" ) .AND. ; FExists( cDatver+"bl_.tak" ) IF ConfirmBox( SetAppWindow(), "Abbrechen mit ", ; "Screen/Blatt-Dateien erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES TXT_zu_DBF() // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ELSE RETURN ENDIF ELSEIF !FExists( cDatver+"s_best.dbf" ) ModalFen( "Bildschirmbeschreibung fehlt! ; " + ; "(Dateiname: s_.tak oder s_best.dbf) ; " + ; "Das Programm wird abgebrochen! ", ; "A C H T U N G !", ; SetAppWindow() ) RETURN ENDIF IF !Upper(AppName()) $ "BRAUCKX.EXE" .AND. Trim(Upper(cDatver)) != "C:\HDBE\" COPY FILE (cDatver+"FExport.dbf") TO C:\HDBE\FExport.dbf // 19.12.2004 ENDIF SELECT 1 IF !Empty(cPubAuf) FIND &cPubAuf IF Eof() GO BOTTOM ENDIF ELSE GO TOP ENDIF // IF Alias(1)="VBEST" // 15.2.2005 geremt // cV := "V" // ELSE cV := "B" // ENDIF oHelp := MagicHelp():New() oDlg := AKDialog():new( AppDesktop(), SetAppWindow(), {n5,n30}, {nBSb-n10,nBSh-n30}, , .F.) oDlg:taskList := .T. oDlg:title := cTitel 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 ) ////////////////////////////////////////////////////////////////////////////////////// // Die Strukturerweiterungen sollten nur noch in INEUX erfolgen!! // 26.08.2005 ////////////////////////////////////////////////////////////////////////////////////// ////// IF !IsFieldVar( "auftrdat" ) // 31.12.2004 - wird bei Feldsuche/z„hlen gebraucht ////// USE ////// COPY FILE (cDatver+"best.dbf") TO (cDatver+"bestK.dbf") ////// COPY FILE (cDatver+"best.dbt") TO (cDatver+"bestK.dbt") ////// oDlg:StrukturErweiterung( "best", {{"auftrdat","D",8,0}}, 1 ) ////// USE best ////// index on str(auftrnr,6,0) to xauftrnr ////// index on Upper( name ) to xname ////// index on Upper( ansp_name ) to xanspnam ////// index on Upper( strasse ) to xstrasse ////// SET INDEX TO xauftrnr,xname,xanspnam,xstrasse ////// IF !Empty(cPubAuf) ////// FIND &cPubAuf ////// IF Eof() ////// GO BOTTOM ////// ENDIF ////// ELSE ////// GO TOP ////// ENDIF ////// ENDIF /////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////// //////// IF !IsFieldVar( "perskz" ) .AND. !Upper(AppName()) $ "BRAUCKX.EXE" // 16.05.2005 - fr die Anbindung der Personen.dbf //////// USE //////// COPY FILE (cDatver+"best.dbf") TO (cDatver+"bestP.dbf") //////// COPY FILE (cDatver+"best.dbt") TO (cDatver+"bestP.dbt") //////// oDlg:StrukturErweiterung( "best", {{"perskz","C",1,0}}, 1 ) //////// USE best //////// index on str(auftrnr,6,0) to xauftrnr //////// index on Upper( name ) to xname //////// index on Upper( ansp_name ) to xanspnam //////// index on Upper( strasse ) to xstrasse //////// SET INDEX TO xauftrnr,xname,xanspnam,xstrasse //////// IF !Empty(cPubAuf) //////// FIND &cPubAuf //////// IF Eof() //////// GO BOTTOM //////// ENDIF //////// ELSE //////// GO TOP //////// ENDIF //////// ENDIF /////////////////////////////////////////////////////////////////////////////////////////// // jetzt folgt die Erzeugung der Eingabefelder oBest := BestFF():new( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, "s_best", -100, 499, 1 ) oEdit := oBest // wegen DialogFF:create(IsMemberVar) 14.4.2005 oBest:CREATE( oBEDA,oDlg, {0,0}, {nBSb-n10,nBSh-n30-n30},,, nBz, "s_best", -100, 499, 1 ) AEval( oBest:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oBest:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder //////// IF !Upper(AppName())$"SCHIERX.EXE" oDlg:childFromName( 1->(FieldPos( "auftrnr" )) ):disable() //////// ENDIF //------------------------------------------ // SetAppWindow(oDlg) // eventuell aktivieren, wenn HauptAnwendungsfenster SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! oDlg:setModalState( XBP_DISP_APPMODAL ) // SetTimerEvent(100, {|| DispOutAt(10,10, Time()) } ) // klappt so nicht... 15.4.2005 //* oBestMaske:aData1 := SatzGetBest() // fr die Ver„nderungsabfrage (sp„ter mal..) *// // 15.4.2005: oCtrl:= wurde direkt vor den EventLoop verschoben (ohne Wirkung) //------------------------------------------ // das Ende des Hauptprogramms: * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) // oHelp:start() // oDlg:childFromName( 1->(FieldPos( "name" )) ):setInputFocus() 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" oHelp:start() // nEvent := AppEvent( @mp1, @mp2, @oXbp ) nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent = xbeP_Close .AND. Val(cV)=0 IF Empty(mp1) y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) nEvent := 0 LOOP ENDIF ELSE // wenn Abbruch durch AppQuit, dann mp1!=NIL ENDIF ENDIF // IF nEvent == xbeM_LbDblClick .and. oXbp:isDerivedFrom( "XbpListBox" ) IF nEvent == xbeLB_ItemSelected // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) oBest:singleZeile[y]:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cStringS := LTrim( oBest:singleZeile[y]:getData() ) SetAppFocus(oBest:singleZeile[y]) y := oBest:XbpNummer( oBest:DruckKnopf, "suche Nr." ) PostAppEvent( xbeP_Activate,,, oBest:DruckKnopf[y] ) ENDIF // IF nEvent == xbeM_LbClick .and. oXbp:isDerivedFrom( "XbpListBox" ) IF nEvent == xbeLB_ItemMarked // 01.05.2005 y := AScan( oBest:ListBox, oXbp ) cItem := oBest:ListBox[y]:getItem( oBest:ListBox[y]:getData()[1] ) y := oBest:XbpNummer( oBest:SingleZeile, "cStringS" ) // oBest:singleZeile[y]:setData( LTrim( SubStr( cItem, 1, At( "-", cItem )-1 ) ) ) // cStringS := LTrim( oBest:singleZeile[y]:getData() ) oBest:singleZeile[y]:setData( SubStr( cItem, 1, At( "-", cItem )-1 ) ) cStringS := oBest:singleZeile[y]:getData() SetAppFocus(oBest:singleZeile[y]) ENDIF IF nEvent == xbeP_Keyboard //////// IF mp1 == xbeK_HOME .AND. IsMemberVar(oXbp,"value") .AND. oXbp:cargo="NAME" //////// oBest:Wochentag() // beim Start Wochentage setzen 15.4.2005 //////// ENDIF IF mp1 == xbeK_RETURN // 04.08.2004 oBest:killTip() ENDIF // Buchstaben-Tastaturen wirken nur, wenn der Auftrag als editierbar markiert ist:06.06.2006 10:59 IF mp1>31 .AND. mp1<128 .AND. oXbp:cargo != "cString" .AND. cAdrBM=" " ; .AND. !oBest:EditAuftragnr == 1->auftrnr // 10.06.2006 12:05 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Auftragsdaten eingeben/„ndern?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES oBest:EditAuftragnr := 1->auftrnr ELSE LOOP ENDIF ENDIF DO CASE // CASE mp1 == xbeK_RETURN .AND. oXbp == oSleSuch // SetAppFocus( oDlg:childFromName( 1->(FieldPos( "name" )) ) ) // LOOP CASE mp1 != xbeK_ESC .AND. mp1 != xbeK_F10 .AND. mp1 = xbeK_TAB ; .AND. oXbp:isDerivedFrom( "XbpMle" ) oXbp:KEYBOARD( mp1 ) LOOP CASE mp1 == xbeK_ESC .or. mp1 == xbeK_F10 y := AppQuit(oDlg) IF y == XBPMB_RET_CANCEL .OR. ( y == XBPMB_RET_NO .AND. !Empty("NurWindows") ) LOOP ENDIF CASE mp1 == xbeK_ALT_D .OR. mp1 == xbeK_CTRL_D // Satzsp( oDlg ); Gather( aEditControls ) // Trckng( 1, RecNo(), aData1, cV ) cAuf := strX( Auftrnr,6,0 ) BlattDRG( "Bl_b",, oBEDA,,, "P", "O", @nAnz, @nt ) // Scatter ( aEditControls ) // aData1 := SatzGetBest( Select(), RecNo() ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_F11 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Screen/Blatt-Dateien erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES TXT_zu_DBF() // (in BRegieFVo): macht aus s_.txt/bl_.txt einzelne Dateien ENDIF CASE mp1 == xbeK_ALT_F12 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Summen in Best-Datei erzeugen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES SummenSetzen() // (in Bestf6): setzt die RechBetr + Summen in der Best.dbf ENDIF CASE mp1 == xbeK_ALT_F7 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Rechnungsnummern l”schen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) 1->rechnr := "" 1->rechnrn := "" 1->rechnrn2 := "" 1->rechnrn3 := "" 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_ALT_F8 IF ConfirmBox( oBEDA, "Abbrechen mit ", ; "Rechnungsnummern 1234-setzen?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES Satzsp(oBEDA) 1->rechnr := IIf(Empty(1->rechnr),"1",1->rechnr) 1->rechnrn := IIf(Empty(1->rechnrn),"2",1->rechnrn) 1->rechnrn2 := IIf(Empty(1->rechnrn2),"3",1->rechnrn2) 1->rechnrn3 := IIf(Empty(1->rechnrn3),"4",1->rechnrn3) 1->(DbSkip(0)) DbRUnlock() ENDIF CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1.dbf"), "Bedienungshinweise", oBEDA, 600*nV, 480*nV ) SetAppFocus( oFocSle ) CASE mp1 == xbeK_ALT_X oDlg:writeData() REH := "Rech3Eingabe(StrX(1->auftrnr,6,0),oBEDA,nFontR,[bl_Ur])" REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Y .AND. Upper(AppName())="RAGUSEX.EXE" oDlg:writeData() REH := "Rech3EingabeH(StrX(1->auftrnr,6,0),oBEDA,nFontR,[bl_Uhr])" REH := &REH oDlg:readData() CASE mp1 == xbeK_ALT_Z cBuffer := Trim( " " ) FOR i := 1 TO Len( oBest:editControls ) xWert := oBest:editControls[i]:getData() xWert := IIf(ValType(xWert)="N",Str(xWert),IIf(ValType(xWert)="D",DtoC(xWert),xWert)) cBuffer := cBuffer + Chr(13)+Chr(10)+xWert NEXT oClipBoard := XbpClipBoard():new():create() oClipboard:open() oClipboard:setbuffer( cBuffer ) oClipboard:close() oClipboard:destroy() ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:writeData() // wird das berhaupt gebraucht?? -->> wohl doch!! (wegen MLE) //////// IF 4->(Alias()) == "PERSONEN" //////// oBest:SwapPers("S") //////// ENDIF BestGeaendert() __SETFUNCTION( 9, strX( 1->AUFTRNR,6,0 ) ) cPubAuf := StrX( 1->auftrnr,6,0 ) SELECT 20 USE mwstdat Satzsp(oDlg) 20->pubauf := cPubAuf USE SELECT 1 oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() oDlg:destroy() 1->(DbSkip(0)) IF Upper(AppName()) == "DISCHX.EXE" // Trckng( 1, RecNo(), oBest:aData1, cV, oBest:aData2 ) // Tracking nur bei KSOx, Dischx ENDIF 1->(DbRUnlock()) 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 DatVerUm(Val(cV)) // hier wird in ein anderes Arbeitsverzeichnis umgeschaltet cV := " " ENDIF ENDDO //+11.02.2014 18:37 bringt sonst Fehlermeldung oHelp:terminate() SetAppFocus( oBestMenu ) SET DATE TO GERMAN SET ORDER TO 1 RETURN //------------------------------------------ FUNCTION FehlerBehandlung(oError) LOCAL cFehler := "Fehlerart: "+oError:description +CRLF+ ; "in Operation: "+oError:operation +CRLF+ ; IIf(!Empty(oError:filename), "Datei: "+oError:filename +CRLF,"") + ; "aufgerufen von:" +CRLF+ ; IIf( !Empty(ProcName(1)), ProcName(1)+"("+LTrim(Str(ProcLine(1)))+")"+CRLF,"")+; IIf( !Empty(ProcName(2)), ProcName(2)+"("+LTrim(Str(ProcLine(2)))+")"+CRLF,"")+; IIf( !Empty(ProcName(3)), ProcName(3)+"("+LTrim(Str(ProcLine(3)))+")"+CRLF,"")+; IIf( !Empty(ProcName(4)), ProcName(4)+"("+LTrim(Str(ProcLine(4)))+")"+CRLF,"")+; IIf( !Empty(ProcName(5)), ProcName(5)+"("+LTrim(Str(ProcLine(5)))+")"+CRLF,"")+; "Wiederholen mit , Datenretten + Ende mit " IF oError:severity > 1 IF ConfirmBox( oBEDA, ; cFehler, ; "Ein Fehler ist aufgetreten!", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO DbCloseAll() USE AK_F_LOG new APPEND BLANK AK_F_LOG->datum := DATE() AK_F_LOG->zeit := Time() AK_F_LOG->logtext := DtoC(DATE()) +CRLF+ ; Time() +CRLF+ ; cFehler USE BREAK() ENDIF ENDIF RETURN .F. //------------------------------------------ //------------------------------------------ FUNCTION Fallsuche() RETURN .T. FUNCTION NeuerFall() RETURN .T. //------------------------------------------ CLASS BestFF FROM DialogFF EXPORTED: // von DialogFF geerbt: // VAR VArea // enth„lt die Area der best.dbf (=1) // VAR aStructure // enth„lt die Struktur der best.dbf // VAR aFelder // enth„lt alle Feldbezeichnungen der best.dbf // VAR aData1 // enth„lt alle Feldinhalte des augenblicklichen Datensatzes // VAR aData2 // // VAR aIndex // enth„lt die Namen der Indexdateien VAR aBP // Betreffperson, je nach TAB: Ansprechpartner/Ehepartner //////// VAR SWT // SterbeWochentag //////// VAR TW1 // Wochentag von Termin1 //////// VAR TW2 // //////// VAR TW3 // //////// VAR TW4 // //////// VAR PvAUFTRNR // 3.5.2005 fr die Personen.dbf in Area 4 //////// VAR PvPERSKZ //////// VAR PvANREDE //////// VAR PvNAME //////// VAR PvVORNAME //////// VAR PvGEBNAME //////// VAR PvSTRASSE //////// VAR PvPLZ_ORT //////// VAR PvTELEFON //////// VAR PvFAX //////// VAR PvEMAIL //////// VAR PvGEB_DAT //////// VAR PvSTB_DAT //////// VAR PvVERW_BEZ //////// VAR PvRECH_NR //////// VAR PvRECHBETR //////// VAR PvRECH_DAT //////// VAR PvEINGBETR //////// VAR PvEING_DAT //////// VAR PvSALDO //////// VAR PvBILD //////// VAR PvNOTIZ //////// VAR PvSUCH VAR EditAuftragnr // =aktuelle Auftrnr, wenn editierbar METHOD INIT METHOD CREATE METHOD notify // managt z.B. ::PaintTip, ::WochenTag METHOD SwapZero // l”scht Felder in einer Datei METHOD SwapInachE // kopiert Daten von einer in die andere Datei METHOD FExport // erzeugt die FExport.DBF mit Daten des aktuellen Falles METHOD AnsprechPartner // fllt die Ansprechpartner-Daten aus mit den Daten des Ehepartners/Verstorbenen METHOD EhePartner // fllt die Ehepartner-Daten aus mit den Daten des Ansprechpartners/Verstorbenen METHOD NeuerFall // legt neuen Bestattungsauftrag an, gibt Nr. in jetziger Gruppe vor METHOD Fallsuche // sucht nach cSuch, wobei nach jedem Feld geindext werden kann METHOD Anzahl // z„hlt wie oft cSuch in der eingestellten Zeit vorkommt METHOD Letzte30 // fllt Array mit den Daten der letzten 30 Auftr„ge in der Datei METHOD ZumBlockAnfang // geht zum Anfang eines Auftragsnummern-Blocks - z.B. 100000 METHOD ZumBlockEnde // geht zum Ende eines Auftragsnummern-Blocks - z.B. 199999 METHOD Anschrift // gibt aAdr zurck, je nachdem ob Area=5,12,1 METHOD MonatsSumme // Anzahl Tr„ger im Monat (fr Bergx) METHOD DruckAlle // druckt Briefe an alle, die eine Filterbedingung erfllen METHOD RDatum // altes/neues Rechnungsdatum //////// METHOD Lupe // Scope //////// METHOD Wochentag // Wochentag zum Datum METHOD Ordnen // Index nach beliebigem Feld //////// METHOD FallCaufM // kopiert Bestattungsf„lle von C:\HDBE auf M:\HDBE //////// METHOD SwapPers // kopiert aus Personen.dbf in Member-Vars und umgekehrt //////// METHOD PersVor // Navigation der Personen.dbf //////// METHOD PersRueck // //////// METHOD PersLoesch // Loeschen des aktuellen Angeh”rigen-Eintrages //////// METHOD PersSuche // Suche nach einem Feld der Personen-Datei METHOD TabMax // berl„dt Parent, damit Betreffperson umgeschaltet wird METHOD TabDaten // holt die Daten aus der obersten TabPage METHOD FormularNotiz // vermerkt Drucke im Notizfeld, wenn BL_GGGroábuchstaben ENDCLASS METHOD BestFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) //////// ::SWT := "" //////// ::TW1 := "" //////// ::TW2 := "" //////// ::TW3 := "" //////// ::TW4 := "" //////// ::PvAUFTRNR := 000000 //////// ::PvPERSKZ := "@" //////// ::PvANREDE := "" //////// ::PvNAME := "" //////// ::PvVORNAME := "" //////// ::PvGEBNAME := "" //////// ::PvSTRASSE := "" //////// ::PvPLZ_ORT := "" //////// ::PvTELEFON := "" //////// ::PvFAX := "" //////// ::PvEMAIL := "" //////// ::PvGEB_DAT := CtoD("") //////// ::PvSTB_DAT := CtoD("") //////// ::PvVERW_BEZ:= "" //////// ::PvRECH_NR := "" //////// ::PvRECHBETR:= 0.00 //////// ::PvRECH_DAT:= CtoD("") //////// ::PvEINGBETR:= 0.00 //////// ::PvEING_DAT:= CtoD("") //////// ::PvSALDO := 0.00 //////// ::PvBILD := "" //////// ::PvNOTIZ := "" //////// ::PvSuch := "" ::aStructure := 1->(DbStruct()) ::VArea := nA ::aIndex := { "Auftragsnummer", "Verstorbenen-Namen", ; "Ansprechpartner-Namen", "Verstorbenen-Straáe", cVariable } ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::aFelder := {} // Array mit allen Feldnamen AEval( ::aStructure, {|a| AAdd( ::aFelder, a[1] ) } ) ::aData1 := {} // Array mit allen Feldinhalten, vor der Ver„nderung AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) ::aData2 := {} // Array mit allen Feldinhalten, nach der Ver„nderung ::EditAuftragnr := 0 // beim Start ist noch kein Auftrag editierbar 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 IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_PROLOG // Skip wird starten AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData2, &c ) } ) //////// IF 1->(IsFieldVar("perskz")) // A...Z - fr Rechnungen an angeh”rige Personen //////// ::SwapPers("S") // 5.5.2005 //////// ENDIF ENDIF IF mp1 == DBO_MOVE_DONE .OR. mp1 == DBO_GOBOTTOM .OR. mp1 == DBO_GOTOP // Skip ist beendet AEval( ::aStructure, {|a,i,c| c:=a[1], AAdd( ::aData1, &c ) } ) //////// IF 1->(IsFieldVar("perskz")) //////// 4->(DbSetScope( SCOPE_BOTH, StrZero(1->auftrnr,6,0) )) //////// 4->(DbGotop()) //////// IIf(!Empty(1->perskz),4->(DbSeek(StrZero(1->auftrnr,6,0)+1->perskz),.F.),4->(DbGobottom()) ) //////// // 4->(DbGobottom()) //////// ::SwapPers("L") // 5.5.2005 //////// ENDIF ENDIF ENDIF xIndex := ::aIndex[Max(OrdNumber(),1)] // 17.4.2005: Zwischenschritt ist Quatsch! cIndex:=IIF(ValType(xIndex)=="D",DtoC(xIndex),IIf(ValType(xIndex)=="N",Str(xIndex),xIndex)) IF Upper(AppName())$"MENGX.EXE" ::PaintTip( "Sortiert nach "+"ï"+Trim(cIndex)+"ï"+"." ; +" - Bereich: "+cTop+" bis "+cBot, {215,565} ) // 10.2.2005 ELSE // ::PaintTip( "Sortiert nach "+"ï"+Trim(cIndex)+"ï"+".", {215,565} ) // 19.12.2004 (aus:{20,550}) ::PaintTip( "Sortiert nach "+"ï"+::SuchFeld+"ï"+".", {215,565} ) // 19.12.2004 (aus:{20,550}) ENDIF //////// ::WochenTag() // 14.4.2005 zeigt fr TD1-4 den Wochentag an RETURN self METHOD BestFF:swapZero( aFelder, nA1 ) PRIVATE c (nA1)->(DbRLock()) FOR i := 1 TO Len(aFelder) c := aFelder[i] IF ValType( (na1)->&c ) = "C" (nA1)->&c := "" ELSEIF ValType( (na1)->&c ) = "N" (nA1)->&c := 0 ELSEIF ValType( (na1)->&c ) = "D" (nA1)->&c := CtoD("") ENDIF NEXT (nA1)->(DbRUnLock()) RETURN self METHOD BestFF:swapInachE( aFelderI, nAI, nAE, aFelderE ) PRIVATE cI, cE // FExport.dbf hat nur String-Felder!!! IF Empty(aFelderE) (nAE)->(DbRLock()) FOR i := 1 TO Len(aFelderI) // aFelderE darf mehr Felder haben als aFelderI cI := aFelderI[i] DO CASE CASE ValType((nAI)->&cI)="C" (nAE)->&cI := (nAI)->&cI CASE ValType((nAI)->&cI)="N" IF (nAI)->&cI != Int((nAI)->&cI) // wenn dezimal, dann mit 2 Stellen: (nAE)->&cI := Str((nAI)->&cI,10,2) ELSE (nAE)->&cI := Str((nAI)->&cI) ENDIF CASE ValType((nAI)->&cI)="D" (nAE)->&cI := DtoC((nAI)->&cI) ENDCASE NEXT (nAE)->(DbRUnLock()) ELSE (nAE)->(DbRLock()) FOR i := 1 TO Len(aFelderI) cI := aFelderI[i] cE := aFelderE[i] DO CASE CASE ValType((nAI)->&cI)="C" (nAE)->&cE := (nAI)->&cI CASE ValType((nAI)->&cI)="N" IF (nAI)->&cI != Int((nAI)->&cI) // wenn dezimal, dann mit 2 Stellen: (nAE)->&cE := Str((nAI)->&cI,10,2) ELSE (nAE)->&cE := Str((nAI)->&cI) ENDIF CASE ValType((nAI)->&cI)="D" (nAE)->&cE := DtoC((nAI)->&cI) ENDCASE NEXT (nAE)->(DbRUnLock()) ENDIF RETURN self METHOD BestFF:FExport( nA1, aFelder1a, aFelder1b, nA2, aFelder2, nA3, aFelder3 ) LOCAL aFelderE1a := { "auftrnr", "Vanrede", "Vvorname", "Vname", "Vgebname", "Vstrasse", "Vort", ; "Vberuf", "Vkonfess", "Vstaatsang", "Vgebdatum", "Vgebort", ; "Vtodesurs", "Vstrbdatum", "Stheim", "Ststrasse", "Stort", ; "Vbeziehung" } LOCAL aFelderE1b := { "Aanrede", "Avorname", "Aname", "Astrasse", "Aort", ; "Abeziehung", "Atelefon", "Abank", "Akonto", "Ablz", "Akontoinh", ; "bestart", "friedhof", "beerddat", "grabart", "kirche" } LOCAL aFelderE2 := { "Fname1", "Fname2", "Fstrasse", "Fort", "Firmenbez", ; "Fpolbetrag", "Fbezbetrag", "Fbezdatum", "Fzahlenan", ; "Ftext1", "Ftext2", "Ftext3", "Ftext4", ; "Fanl1", "Fanl2", "Fanl3", "Fanl4", "Fanl5", "Fanl6" } LOCAL aFelderE3 := { "Rartnr", "Rartbez", "Rpreis", "Reigfremd", "Rmwstproz", "Rnachtrag" } LOCAL nOldArea := SELECT() // SELECT 9 DbUseArea( .T.,, "C:\HDBE\FExport", "fe", .F. ) // 14.1.2005 fe-> statt 9-> // USE C:\HDBE\FExport EXCLUSIVE ZAP fe->(DbAppend()) ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) IF nA2 = 2 (nA2)->(DbSeek( StrX(1->auftrnr,6,0) )) DO WHILE (nA2)->auftrnr == (nA1)->auftrnr ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) ::swapInachE( aFelder2, nA2, SELECT("fe"), aFelderE2 ) (nA2)->(DbSkip()) IIf( (nA2)->auftrnr == (nA1)->auftrnr, fe->(DbAppend()),) ENDDO ELSEIF nA2 = 5 // 19.12.2004 IIf( Len(aFelder2)>5, ARemove( aFelder2, 6, Len(aFelder2)-5 ), ) ::swapInachE( aFelder2, nA2, SELECT("fe"), aFelderE2 ) ENDIF fe->(DbGotop()) IIf( nA3 = 3, (nA3)->(DbSeek( StrX(1->auftrnr,6,0) )), ) DO WHILE (nA3)->auftrnr == (nA1)->auftrnr .AND. nA2 != 5 // 9.4.2005, aus Adresseingabe ::swapInachE( aFelder3, nA3, SELECT("fe"), aFelderE3 ) fe->(DbSkip()) IF fe->(Eof()) fe->(DbAppend()) ::swapInachE( aFelder1a, nA1, SELECT("fe"), aFelderE1a ) ::swapInachE( aFelder1b, nA1, SELECT("fe"), aFelderE1b ) ENDIF (nA3)->(DbSkip()) ENDDO fe->(DbCloseArea()) SELECT &nOldArea RETURN self METHOD BestFF:AnsprechPartner() LOCAL Wahl := ConfirmBox( ::BEArea[1], "Ist Ansprechpartner = Ehepartner?", ; "Ansprechpartner „ndern", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF Wahl == XBPMB_RET_YES Satzsp( ::BEArea[1] ) // DbSkip(0) IF 1->anrede = "Herr" 1->ansp_anr := "Frau" 1->ansp_bez := "Ehefrau" ELSEIF 1->anrede = "Frau" 1->ansp_anr := "Herr" 1->ansp_bez := "Ehemann" ENDIF 1->ansp_name := 1->name 1->ansp_vname := 1->eh_vname 1->ansp_str := 1->strasse 1->ansp_ort := 1->plz_ort // DbSkip(0) DbRUnlock(RecNo()) ENDIF RETURN self METHOD BestFF:Ehepartner() LOCAL Wahl := ConfirmBox( ::BEArea[1], "Ist Ehepartner = Ansprechpartner?", ; "Ehepartner „ndern", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) Satzsp( ::BEArea[1] ) // DbSkip(0) IF Wahl == XBPMB_RET_NO IF 1->anrede = "Herr" 1->eh_anr := "Frau" ELSEIF 1->anrede = "Frau" 1->eh_anr := "Herr" ENDIF 1->eh_name := 1->name 1->eh_str := 1->strasse 1->eh_ort := 1->plz_ort ELSEIF Wahl == XBPMB_RET_YES 1->eh_telp := 1->ansp_telp 1->eh_anr := 1->ansp_anr 1->eh_name := 1->ansp_name 1->eh_vname := 1->ansp_vname 1->eh_str := 1->ansp_str 1->eh_ort := 1->ansp_ort ENDIF // DbSkip(0) DbRUnlock(RecNo()) RETURN self METHOD BestFF:NeuerFall( cKopie, cKreis ) LOCAL cAuf := IIf(Empty(cKreis),Space(6),cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 LOCAL y, cString := cAuf, aStrings := {}, cTip DbSkip(0) IF auftrnr=0 DELETE ENDIF cAufalt := StrX( 1->auftrnr,6,0 ) DO WHILE .T. // cAufneu := ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) y := ::XbpNummer( ::SingleZeile, IIf(Empty(cKopie),"cStringN","cStringK") ) cAufneu := ::singleZeile[y]:getdata() //************IIf(cAuf... !!!!!! cAufneu := IIf( Val(cAufneu)>0, StrX(Val(cAufneu),6,0), cAufneu ) IF Empty( cAufneu) .OR. Val(cAufneu) = 0 RETURN cTip := "Auftrag-Nr. eingeben:" ELSEIF Val(cAufneu) > 999999 cAuf := Space(6) RETURN cTip := "Zu lang! Neue Auftrag-Nr. :" ENDIF cAufneu := IIf( !Empty(cKopie), cKopie+cAufneu, cAufneu ) cAuf := IIf( Upper( Substr( cAufneu,1,1 ))="B", Substr( Padr(cAufneu,8),3,6), Padl(cAufneu,6 )) // cAuf := Padl( Trim( cAuf ), 6 ) cAuf := StrX(Val(cAuf),6,0) 1->(DbSeek( cAuf )) IF Found() .AND. VAL( cAuf ) > 0 cAuf := Space(6) RETURN cTip := "Schon belegt! Neue Auftrag-Nr. :" ELSEIF VAL( cAuf ) < 1000000 EXIT // ELSE // cAuf := Space(6) // RETURN cTip := "Zu lang! Neue Auftrag-Nr. :" ENDIF ENDDO // oBestMaske:aData1 := SatzGetBest() IF VAL( cAufneu ) > 0 .AND. Val( cAufneu ) < 1000000 1->(DbAppend()) REPLACE 1->AUFTRNR WITH Val( cAuf ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF // aData1[1] := Val( cAuf ) IF IsFieldVar("todesurs") REPLACE todesurs with "natrlicher Tod" ENDIF REPLACE staatsan with "deutsch" // IF Upper(AppName())="MUELLX.EXE" // REPLACE plz_ort WITH "Essen" // REPLACE ansp_ort WITH "Essen" // REPLACE eh_ort WITH "Essen" // REPLACE geb_in WITH "Essen" // REPLACE verst_in WITH "Essen" // ENDIF IF IsMemVar("cStadt") REPLACE plz_ort WITH cStadt REPLACE ansp_ort WITH cStadt REPLACE eh_ort WITH cStadt REPLACE geb_in WITH ORTohnePLZ(cStadt) // REPLACE verst_in WITH cStadt // heiát nicht berall gleich!!! ENDIF cTip := "Neue Auftrag-Nr.: "+cAuf+" angelegt." ELSEIF Upper( Substr( cAufneu,1,1 ) ) = "B" // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) FOR n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT 1->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 1->AUFTRNR WITH Val( Substr( Padr( cAufneu, 8 ),3,6 ) ) IF IsFieldVar("auftrdat") // 20.11.2004 1->auftrdat := DATE() ENDIF IF 1->(IsFieldVar("rechnr")) IF ValType(1->rechnr)=="C" REPLACE 1->RECHNR WITH "" // 30.1.2004 REPLACE 1->RECHNRN WITH "" // damit neue Auftr„ge nicht schon alte Rg-Nrn haben REPLACE 1->RECHNRN2 WITH "" REPLACE 1->RECHNRN3 WITH "" ENDIF ENDIF ////// FIND &cAufalt // 5.6.04 // Versicherungseintr„ge in den Bestattungsfall kopieren: cVerstemp := "v_"+cAufalt //"ver2"+LTrim(Str(Int(Seconds()/10))) SELECT 2 COPY STRU TO (cVerstemp) aDataV := Array(FCount()) SELECT 12 USE (cVerstemp) EXCLUSIVE SELECT 2 FIND &cAufalt do while 2->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 12 12->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 12->AUFTRNR WITH Val( Substr( cAufneu,3,6 ) ) REPLACE 12->&b_b_g WITH 0 // 5.6.04 : noch kein Zahlungseingang SELECT 2 skip enddo SELECT 12 USE SELECT 2 APPEND FROM (cVersTemp) // Rechnungsdaten in den Bestattungsfall kopieren: cAuf3temp := "r_"+cAufalt // 5.6.04 //LTrim(StrX(1->auftrnr,6,0)) SELECT 3 COPY STRU TO (cAuf3temp) aDataV := Array(FCount()) SELECT 13 // Zwischendatei erzeugen und daraus die neue Rechnung USE (cAuf3temp) EXCLUSIVE SELECT 3 FIND &cAufalt do while 3->auftrnr=val(cAufalt) .and. .not. eof() For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT SELECT 13 13->(DbAppend()) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 13->AUFTRNR WITH Val( Substr( cAufneu,3,6 ) ) REPLACE 13->rn WITH " " // 5.6.04 : alles in die 1.Rg REPLACE 13->ttmm WITH " " // 18.4.2005 : noch nicht gedruckt SELECT 3 skip enddo SELECT 13 IF .NOT. Bof() GO TOP ENDIF aData2 := Array(FCount()) nGS := 0 DO WHILE .NOT. Eof() FOR n := 1 to FCount() aData2[n] := FieldGet( n ) NEXT SELECT 3 APPEND BLANK FOR n := 1 to FCount() FieldPut( n, aData2[n] ) NEXT DbRUnlock( Recno() ) // ... und unlock nGS := nGS + 3->&b_g // Artikel-Daten korrigieren: cArt := 3->zugr_z_st SELECT 6 FIND &cArt Satzsp( oCB ) REPLACE 6->bestand WITH 6->bestand-1 REPLACE 6->mgjahr WITH 6->mgjahr+1 REPLACE 6->umsatz WITH 6->umsatz + 3->betrag REPLACE 6->umsatzeu WITH 6->umsatzeu + 3->betrageu DbRUnlock( Recno() ) // SELECT 13 SKIP ENDDO USE SELECT 1 // FIND &( Padl( Substr( cAufneu,3,6 ), 6) ) IF Upper(AppName())$"KOMPAKTX.EXE" REPLACE 1->&r_b_0 WITH nGS ELSE REPLACE 1->&r_b_0 WITH nGS REPLACE 1->&r_s WITH nGS REPLACE 1->&t_l WITH nGS REPLACE 1->&v_m WITH 0 REPLACE 1->&r_b_1 WITH 0 REPLACE 1->&r_b_2 WITH 0 REPLACE 1->&r_b_3 WITH 0 // Rechbetr( 0, nGS, oDlg1 ) ENDIF FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) cTip := "Auf neue Auftrag-Nr.: "+cAuf+" kopiert." ENDIF DbSkip(0) RETURN cTip METHOD BestFF:Fallsuche( cSuchArt, cKreis ) LOCAL cSuch := cAuf := IIf(Empty(cKreis),Space(6),cKreis) LOCAL cString := IIf(Empty(cSuchArt),"cStringS","cStringF") // LOCAL oFocus := SetAppFocus(), nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd LOCAL oFocus := IIf(!Empty(::oFocLFSle),::oFocLFSle,::oFocLFSle := oCtrl:lastXbp) LOCAL nRec := RecNo(), lSuch, y, cTip, nAnf, nEnd, nAnzahl LOCAL cTitle := "Auftrags-Nr. (oder ïv ï+Verstorbener/ïa ï+Auftraggeber):" // cVariable ist Private von bestP6 //////// IIf(IsFieldVar("perskz"),::SwapPers("S"),) // 9.5.2005 DbSuspendNotifications() // ; ++cBegleit[SELECT()] DbSkip(0) DO CASE CASE Upper(cSuchArt) = "V " cTitle := "Verstorbenen-Namen eingeben:" CASE Upper(cSuchArt) = "A " cTitle := "Ansprechpartner-Namen eingeben:" CASE Upper(cSuchArt) = "S " cTitle := "Verstorbenen-Straáe eingeben:" CASE Upper(cSuchArt) = "R " // 16.10.2004 cTitle := "Rechnungs-Nr.:" cString := cVariable := "rechnr" ::oFocLFSle := ::XbpObjekt( ::SingleZeile, cVariable ) // 14.11.2004 INDEX on Upper(1->&cVariable) TO x5 ::aIndex[5] := cVariable SET INDEX TO xauftrnr,xname,xanspnam,xstrasse,x5 DbGoto( nRec ) CASE Upper(cSuchArt) = "F " IF !Empty(::oFocLFSle:cargo) cVariable := IIf( ::oFocLFSle:cargo[1]=="&", &(SubStr(::oFocLFSle:cargo,2)), ::oFocLFSle:cargo ) ::SuchFeld := ::aBeschreib[AScan(::aFelder,Trim(cVariable))] // 17.4.2005 ELSE cVariable := "AUFTRNR" ::SuchFeld := "AuftragsNummer" ENDIF DO CASE CASE cVariable == "NAME" cSuchArt := "V " cTitle := "Verstorbenen-Namen eingeben:" CASE cVariable == "ANSP_NAME" cSuchArt := "A " cTitle := "Ansprechpartner-Namen eingeben:" CASE cVariable == "STRASSE" cSuchArt := "S " cTitle := "Verstorbenen-Straáe eingeben:" OTHERWISE // cTitle := cVariable + " eingeben:" cTitle := ::Suchfeld + " eingeben:" // 17.4.2005 IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrZero(Month(1->&cVariable),2,0)+ ; StrZero(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 DbGoto( nRec ) ENDCASE OTHERWISE cTitle := "Auftrag-Nr. eingeben:" ENDCASE DO WHILE .T. y := ::XbpNummer( ::SingleZeile, cString ) cSuch := ::singleZeile[y]:getdata() IF Empty( cSuch) .AND. !Upper(cSuchArt)=="R " // 14.11.2004 cTip := cTitle EXIT ELSEIF Val(cSuch) > 999999 cTip := "Zu lang! Neue Auftrag-Nr. :" EXIT ENDIF cSuch := IIf(Val(cSuch)>0 .AND. Empty(cSuchArt), StrX(Val(cSuch),6,0), Trim(cSuch) ) cSuch := IIf(Upper(cSuchArt)=="F " .AND. ValType(1->&cVariable)=="N", ; Str(Val(cSuch),FieldInfo(FieldPos(cVariable),FLD_LEN), ; FieldInfo(FieldPos(cVariable),FLD_DEC) ), ; cSuch ) nRec := RecNo() DO CASE CASE Val(cSuch) > 0 .AND. Empty(cSuchArt) // .or. Trim(cSuch) == "" SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := Padl(cSuch,6) lSuch := DbSeek( cAuf, .F. ) ::SuchFeld := "AuftragsNummer" // 01.05.2005 IF lSuch == .F. DbGoto(nRec) cSuch := cAuf //:= Space(6) cTip := "Auftrag nicht vorhanden." ::Letzte30( ::thisTab, cAuf, cTip, {435,235} ) EXIT ENDIF CASE Trim(cSuch)=="" .AND. !Upper(cSuchArt)=="R " // 14.11.2004 SET ORDER TO 1 // Index nach Auftrnr DbSkip(0) cAuf := StrX(1->auftrnr,6,0) ::SuchFeld := "AuftragsNummer" // 01.05.2005 CASE Upper(cSuchArt) = "R " // 16.10.2004 : Suchen von Rechnungsnummern SET ORDER TO 5 DbSkip(0) cSuch := IIf(Empty(cSuch),RechnungsNr("9999"),cSuch) // 14.11.2004 DbSeek( Upper(cSuch), .T. ) // DbSkip(-1) nAnf := 940; nEnd := 950 CASE Upper(cSuchArt) = "F " SET ORDER TO 5 nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + IIf(Upper(AppName())$"MUELLX.EXE-KREMERX.EXE-DISCHX.EXE-SCHIERX.EXE", ; "/ Anzahl: "+LTrim(Str(nAnzahl)),"") ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSeek( Upper(cSuch), .T. ) nAnf := 920; nEnd := 929 CASE Upper(cSuchArt) = "V " SET ORDER TO 2 // Index nach Verstorbenem nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + IIf(Upper(AppName())$"MUELLX.EXE-KREMERX.EXE-DISCHX.EXE-SCHIERX.EXE", ; "/ Anzahl: "+LTrim(Str(nAnzahl)),"") ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 900; nEnd := 909 CASE Upper(cSuchArt) = "A " SET ORDER TO 3 // Index nach Auftraggeber nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + IIf(Upper(AppName())$"MUELLX.EXE-KREMERX.EXE-DISCHX.EXE-SCHIERX.EXE", ; "/ Anzahl: "+LTrim(Str(nAnzahl)),"") ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 910; nEnd := 919 CASE Upper(cSuchArt) = "S " SET ORDER TO 4 // Index nach Straáe nAnzahl := ::Anzahl( cSuch ) // 14.11.2004 inkl. DbSeek( Upper(cSuch), .T. ) cStringF := cStringF + IIf(Upper(AppName())$"MUELLX.EXE-KREMERX.EXE-DISCHX.EXE-SCHIERX.EXE", ; "/ Anzahl: "+LTrim(Str(nAnzahl)),"") ::XbpObjekt( ::SingleZeile, "cStringF" ):setdata() // DbSkip(0) // DbSeek( Upper(cSuch), .T. ) nAnf := 900; nEnd := 909 OTHERWISE SET ORDER TO 1 // Index nach Auftrnr DbGoto( nRec ) // weil unzul„ssige Eingabe cTip := "Auftrag nicht gefunden." ::SuchFeld := "AuftragsNummer" // 01.05.2005 EXIT ENDCASE IF !Empty(cSuchArt) IF oBest:Such( oBEDA, "s_best", nAnf, nEnd, 1, 1->(RecNo()), ; {10*nV,30*nV}, {425*nV,175*nV}, {} ) cAuf := "" // .T. == mit ESC ausgestiegen ELSE cAuf := StrX(1->auftrnr,6,0) ENDIF ENDIF IF val(cAuf) == 1->Auftrnr // wenn gefunden cTip := "Auftrag gefunden." EXIT ELSEIF cAuf == "" // wenn nicht gefunden, gehe zum Ausgangspunkt DbGoto( nRec ) cTip := "Auftrag nicht gefunden." EXIT ELSE DbGoto( nRec ) cTip := "Andere Auftrag-Nr. :" EXIT ENDIF ENDDO SET FILTER TO // 17.10.2004 IF Upper(cSuchArt) == "R " oBEDA:cargo:readdata() // 14.11.2004 SET ORDER TO 1 ENDIF DbResumeNotifications() // ; --cBegleit[SELECT()] DbSkip(0) // IIf(!Empty(::oFocLFSle:cargo),SetAppFocus( ::oFocLFSle ),SetAppFocus( oFocus )) oCtrl:lastXbp := oBest:oFocLFSle // 29.10.2004 RETURN cTip METHOD BestFF:Anzahl( cSuch ) LOCAL nAnzahl //// PRIVATE cDatAnz := "IIf(!Empty(1->beerd_dat),1->beerd_dat,IIf(!Empty(1->gestorben),1->gestorben,IIf(!Empty(1->auftrdat),1->auftrdat,DATE())))" // 20.11.2004 // PRIVATE cDatAnz := "IIf(!Empty(1->auftrdat),1->auftrdat,IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))" // 01.12.2004 //// PRIVATE cDatAnz := "IIf(!Empty(1->gestorben),1->gestorben,1->auftrdat)" // 01.12.2004 DO CASE // 17.10.2004 CASE Val(cStringFM)=0 .AND. Val(cStringFJ)>0 SET FILTER TO Year(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFJ) CASE Val(cStringFM)>0 .AND. Val(cStringFJ)=0 SET FILTER TO Month(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFM) CASE Val(cStringFM)>0 .AND. Val(cStringFJ)>0 SET FILTER TO Month(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFM) .AND. ; Year(IIf(!Empty(1->auftrdat),1->auftrdat, ; IIf(!Empty(1->gestorben),1->gestorben,1->beerd_dat))) == Val(cStringFJ) // CASE Val(cStringFM)=0 .AND. Val(cStringFJ)>0 // SET FILTER TO Year(&cDatAnz) == Val(cStringFJ) // CASE Val(cStringFM)>0 .AND. Val(cStringFJ)=0 // SET FILTER TO Month(&cDatAnz) == Val(cStringFM) // CASE Val(cStringFM)>0 .AND. Val(cStringFJ)>0 // SET FILTER TO Month(&cDatAnz) == Val(cStringFM) .AND. ; // Year(&cDatAnz) == Val(cStringFJ) OTHERWISE SET FILTER TO ENDCASE DbSkip(0) DO CASE // 01.12.2004 CASE cSuch="!" cSuch := SubStr(cSuch,2) COUNT TO nAnzahl CASE ValType(1->&cVariable) == "C" //7.11.2004 COUNT FOR Upper(1->&cVariable) = Upper(cSuch) TO nAnzahl // 17.10.2004 DbSeek( Upper(cSuch), .T. ) CASE ValType(1->&cVariable) == "D" COUNT FOR DtoC(1->&cVariable) = cSuch TO nAnzahl // 7.11.2004 DbSeek( Str(Year(CtoD(cSuch)),4,0)+StrZero(Month(CtoD(cSuch)),2,0)+ ; StrZero(Day(CtoD(cSuch)),2,0), .T. ) CASE ValType(1->&cVariable) == "N" COUNT FOR 1->&cVariable = Val(cSuch) TO nAnzahl // 7.11.2004 DbSeek( Upper(cSuch), .T. ) ENDCASE SET FILTER TO RETURN nAnzahl METHOD BestFF:Letzte30( oDlg1, cString, cTip, aTipPos ) LOCAL aStrings := {} LOCAL nRec := RecNo() LOCAL n := AScan( oDlg1:childlist(), {|x| x:isDerivedFrom("XbpListbox")} ) LOCAL nL := ::XbpNummer( ::ListBox, oDlg1:childlist()[n]:cargo ) ::PaintTip(cTip,aTipPos) DBSuspendNotifications() //; ++cBegleit[SELECT()] SET ORDER TO 0 GO BOTTOM ::ListBox[nL]:CLEAR() DO WHILE !Bof() .AND. Len(aStrings) <= 30 DO CASE CASE !Empty(cString) .AND. PadL(cString,6)[1]!=StrX(1->auftrnr,6,0)[1] //11.2.04 // --i // Auftrnr aus falscher Gruppe berspringen CASE !Empty(1->name) AAdd( aStrings, StrX(1->auftrnr,6,0)+" - "+Trim(1->name)+", "+Trim(1->vorname)+", "+ ; Trim(1->strasse)) CASE !Empty(1->ansp_name) AAdd( aStrings, StrX(1->auftrnr,6,0)+" - "+Trim(1->ansp_name)+", "+Trim(1->ansp_vname)+ ; ", "+Trim(1->ansp_str)) OTHERWISE IF 1->(IsFieldVar("gkz")) AAdd( aStrings, StrX(1->auftrnr,6,0)+" - "+1->gkz ) ELSEIF 1->(IsFieldVar("schladr")) AAdd( aStrings, StrX(1->auftrnr,6,0)+" - "+1->schladr ) ENDIF ENDCASE DbSkip(-1) ENDDO cString := IIf( (Val(cString)>0 .OR. "Kopie"$oDlg1:cargo) .AND. Len(aStrings)>0, ; IIf("akzept"$cTip,StrX(Val(Left(aStrings[1],6))+1,6,0),Space(6)), ; cString ) //11.2.04 SET ORDER TO 1 AEval( aStrings, {|c| ::ListBox[nL]:addItem(c) } ) ::ListBox[nL]:setData( {1}, .T. ) GO nRec DbResumeNotifications() //; --cBegleit[SELECT()] //RETURN Trim(cString) RETURN cString METHOD BestFF:ZumBlockAnfang(cAuf) LOCAL nOldArea := SELECT() SELECT 1 cAuf := IIf( Val(cAuf[1])!=0, cAuf[1]+"00000", " " ) SET ORDER TO 1 DbSeek( cAuf, .T. ) SELECT (nOldArea) RETURN self METHOD BestFF:ZumBlockEnde(cAuf) LOCAL nOldArea := SELECT() SELECT 1 cAuf := cAuf[1]+"99999" SET ORDER TO 1 // DbSuspendNotifications() //; ++cBegleit[SELECT()] DbSeek( cAuf, .T. ) // DbResumeNotifications() //; --cBegleit[SELECT()] IIf( Val(cAuf[1]) != Val(StrX(field->auftrnr,6,0)[1]), DbSkip(-1), DbSkip(0) ) SELECT (nOldArea) RETURN self METHOD BestFF:Anschrift(nA) LOCAL aAdr DO CASE CASE nA = 5 aAdr := {5->name1,5->name2,5->strasse,5->plz_ort} CASE nA = 12 aAdr := {12->name1,12->name2,12->strasse,12->plz_ort} OTHERWISE aAdr := {1->ansp_anr,Trim(1->ansp_vname)+" "+1->ansp_name,1->ansp_str,1->ansp_ort} ENDCASE RETURN aAdr METHOD BestFF:MonatsSumme(cFeld,cDatum1,cDatum2,cBedingung,nPP) // nPP = EUR/Tr„ger LOCAL nMSumme, nRec := 1->(RecNo()), nA := SELECT() DEFAULT cBedingung TO "1->traeger$[jJ]" // Tr„gerprovision fr BergX (nA)->(DbSuspendNotifications()) SELECT 1 1->(DbSuspendNotifications()) 1->(DbSetFilter({|| 1->beerd_dat>=CtoD(cDatum1) .AND. 1->beerd_dat<=CtoD(cDatum2)})) 1->(DbGotop()) // SUM Anztrae TO nMSumme FOR traeger = "j" //&cBedingung SUM &cFeld TO nMSumme FOR &cBedingung 1->(DbClearFilter()) 1->(DbGoto(nRec)) 1->(DbResumeNotifications()) IF !Empty(nPP) SELECT 3 DbSuspendNotifications() DbSeek(StrX(1->auftrnr,6,0),.F.) IIf( Eof(),DbAppend(),) IF 3->bezeich = "Tr„gerprovision" .OR. Empty(3->bezeich) Satzsp(oBEDA) 3->auftrnr := 1->auftrnr 3->zeile := " 1" 3->kennz := "1" 3->mwst_schl := "3" 3->zugr_z_st := "1" 3->bezeich := "Tr„gerprovision vom "+cDatum1+" - "+cDatum2 3->&b_g := nMSumme * nPP + nMSumme*nPP*0.16 3->(DbRUnlock()) ENDIF DbResumeNotifications() ENDIF SELECT &nA (nA)->(DbResumeNotifications()) RETURN nMSumme METHOD BestFF:DruckAlle( cBlDatei, bFilter ) LOCAL nRec := RecNo() DbSuspendNotifications() DbSetFilter(bFilter) DbGotop() DO WHILE !Eof() Satzsp( oBEDA ) BlattDRG( cBlDatei,, oBEDA,,, "P", "O", @nAnz, @nt ) DbRUnLock() DbSkip() ENDDO DbClearFilter() DbGoto(nRec) DbResumeNotifications() RETURN self METHOD BestFF:RDatum(nt) // 23.8.04 : in bl_a statt date() LOCAL dDatum := DATE(), nAuf, nOldArea := SELECT(), nRec DbSelectArea(3) DbSeek(StrX(1->auftrnr,6,0),.F.) IF 1->auftrnr != 3->auftrnr RETURN(dDatum) ENDIF nRec := RecNo() IF Empty(3->ttmm) IF Upper(AppName())$"KREMERX.EXE" dDatum := DATE() ELSE dDatum := IIf( nt=0, IIf(!Empty(1->beerd_dat),1->beerd_dat,DATE()), DATE() ) ENDIF ELSE IF nt!=0 DbSuspendNotifications() DO WHILE 1->auftrnr == 3->auftrnr IF nt != Val(3->rn) 3->(DbSkip()) LOOP ENDIF ENDDO IF 1->auftrnr != 3->auftrnr GO nRec ENDIF ENDIF dDatum := CtoD( SubStr(3->ttmm,1,2)+"."+SubStr(3->ttmm,3,2)+"."+ ; IIf( !Empty(1->beerd_dat),Str(Year(1->beerd_dat)), ; IIf(Month(DATE()) >= Val(SubStr(3->ttmm,3,2)), Str(Year(DATE()),4), ; Str(Year(DATE())-1,4) )) ) IF nt!=0 GO nRec DbResumeNotifications() ENDIF ENDIF DbSelectArea(nOldArea) RETURN dDatum //////// ////////METHOD BestFF:Lupe( aA, cTop, cBot ) //////// FOR nA := aA[1] TO aA[Len(aA)] //////// (nA)->(DbSetScope( SCOPE_TOP, cTop )) //////// (nA)->(DbSetScope( SCOPE_BOTTOM, cBot )) //////// NEXT ////////RETURN self //////// ////////METHOD BestFF:Wochentag() //////// IF Upper(AppName())$"DISCHX.EXE-SANDERX.EXE-SCHIERX.EXE-MUELLX.EXE" //.AND. Upper(cDatver)="C:\HDBE\" //////// IF IsFieldVar("GESTORBEN") //////// oBest:XbpObjekt( oBest:SingleZeile, "SWT" ):setData(::SWT:=CDoW(1->GESTORBEN)) //////// ENDIF //////// IF IsFieldVar("&TD1") //////// oBest:XbpObjekt( oBest:SingleZeile, "TW1" ):setData(::TW1:=CDoW(1->&TD1)) //////// ENDIF //////// IF IsFieldVar("&TD2") //////// oBest:XbpObjekt( oBest:SingleZeile, "TW2" ):setData(::TW2:=CDoW(1->&TD2)) //////// ENDIF //////// IF IsFieldVar("&TD3") //////// oBest:XbpObjekt( oBest:SingleZeile, "TW3" ):setData(::TW3:=CDoW(1->&TD3)) //////// ENDIF //////// IF IsFieldVar("&TD4") //////// oBest:XbpObjekt( oBest:SingleZeile, "TW4" ):setData(::TW4:=CDoW(1->&TD4)) //////// ENDIF //////// ENDIF ////////RETURN self //////// METHOD BestFF:Ordnen(cVar,cSuchArt) // cSuchArt:="F " wird per Referenz bergeben DEFAULT cVar TO "auftrnr" PRIVATE cVariable := cVar DO CASE CASE Upper(cVariable) == "AUFTRNR" cSuchArt := "" SET ORDER TO 1 CASE Upper(cVariable) == "NAME" cSuchArt := "V " SET ORDER TO 2 CASE Upper(cVariable) == "ANSP_NAME" cSuchArt := "A " SET ORDER TO 3 CASE Upper(cVariable) == "STRASSE" cSuchArt := "S " SET ORDER TO 4 OTHERWISE IF ValType(1->&cVariable) == "D" INDEX on Str(Year(1->&cVariable),4,0)+StrZero(Month(1->&cVariable),2,0)+ ; StrZero(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 RETURN OrdNumber() //////// ////////METHOD BestFF:FallCaufM( cKopie, cKreis ) //////// LOCAL cAufalt, n, aDataV := {}, cVersTemp, cAufTemp, cTip ////////////// LOCAL cAuf := IIf(Empty(cKreis),Space(6),cKreis), cAufneu, cAufalt // NummernKreis 11.2.04 ////////////// LOCAL y, cString := cAuf, aStrings := {}, cTip ////////////// DbSkip(0) ////////////// IF auftrnr=0 ////////////// DELETE ////////////// ENDIF //////// cAufalt := StrX( 1->auftrnr,6,0 ) //////// //////////***************** // 18.4.2005: ////////// Vorvertrag als Bestattungsfall kopieren: //////// FIND &cAufalt //////// aDataV := Array(FCount()) //////// FOR n := 1 to FCount() //////// aDataV[n] := FieldGet( n ) //////// NEXT //////// //////// SELECT 21 //////// USE (cNetver+"Best") //////// SET INDEX TO (cNetver+"xauftrnr") //////// 21->(DbAppend()) //////// FOR n := 1 to FCount() //////// FieldPut( n, aDataV[n] ) //////// NEXT //////// USE ////////// Versicherungseintr„ge in den Bestattungsfall kopieren: //////// cVerstemp := "v_"+cAufalt //"ver2"+LTrim(Str(Int(Seconds()/10))) //////// SELECT 2 //////// COPY STRU TO (cVerstemp) //////// aDataV := Array(FCount()) //////// SELECT 12 //////// USE (cVerstemp) EXCLUSIVE //////// SELECT 2 //////// FIND &cAufalt //////// do while 2->auftrnr=val(cAufalt) .and. .not. eof() //////// For n := 1 to FCount() //////// aDataV[n] := FieldGet( n ) //////// NEXT //////// SELECT 12 //////// 12->(DbAppend()) //////// For n := 1 to FCount() //////// FieldPut( n, aDataV[n] ) //////// NEXT //////// SELECT 2 //////// skip //////// enddo //////// SELECT 12 //////// USE //////// SELECT 22 //////// USE (cNetver+"VV") //////// SET INDEX TO (cNetver+"xvvauf") //////// APPEND FROM (cVersTemp) //////// USE ////////// Rechnungsdaten in den Bestattungsfall kopieren: //////// SELECT 23 //////// USE (cNetver+"AUFTR") //////// SET INDEX TO (cNetver+"xaufauf") //////// SELECT 26 //////// USE (cNetver+"ART") //////// SET INDEX TO (cNetver+"xart_lei") //////// cAuf3temp := "r_"+cAufalt // 5.6.04 //LTrim(StrX(1->auftrnr,6,0)) //////// SELECT 3 //////// COPY STRU TO (cAuf3temp) //////// aDataV := Array(FCount()) //////// SELECT 13 // Zwischendatei erzeugen und daraus die neue Rechnung //////// USE (cAuf3temp) EXCLUSIVE //////// SELECT 3 //////// FIND &cAufalt //////// do while 3->auftrnr=val(cAufalt) .and. .not. eof() //////// For n := 1 to FCount() //////// aDataV[n] := FieldGet( n ) //////// NEXT //////// SELECT 13 //////// 13->(DbAppend()) //////// For n := 1 to FCount() //////// FieldPut( n, aDataV[n] ) //////// NEXT //////// SELECT 3 //////// skip //////// enddo //////// SELECT 13 //////// IF .NOT. Bof() //////// GO TOP //////// ENDIF //////// aData2 := Array(FCount()) //////// DO WHILE .NOT. Eof() //////// FOR n := 1 to FCount() //////// aData2[n] := FieldGet( n ) //////// NEXT //////// SELECT 23 //////// APPEND BLANK //////// FOR n := 1 to FCount() //////// FieldPut( n, aData2[n] ) //////// NEXT //////// DbRUnlock( Recno() ) // ... und unlock //////// // Artikel-Daten korrigieren: //////// cArt := 23->zugr_z_st //////// SELECT 26 //////// FIND &cArt //////// Satzsp( oCB ) //////// REPLACE 26->bestand WITH 26->bestand-1 //////// REPLACE 26->mgjahr WITH 26->mgjahr+1 //////// REPLACE 26->umsatz WITH 26->umsatz + 23->betrag //////// REPLACE 26->umsatzeu WITH 26->umsatzeu + 23->betrageu //////// DbRUnlock( Recno() ) //////// // //////// SELECT 13 //////// SKIP //////// ENDDO //////// USE //////// SELECT 23 //////// USE //////// SELECT 26 //////// USE //////// SELECT 1 //////// //////// FErase( cDatver+cVerstemp+".dbf" ) //////// FErase( cDatver+cAuf3temp+".dbf" ) //////// cTip := "Auftrag kopiert." //////// DbSkip(0) ////////RETURN cTip //////// ////////METHOD BestFF:SwapPers(cLS) //////// LOCAL nOldArea := SELECT(), nRec4 := 4->(RecNo()) //////// LOCAL cPersKZ := "@" //////// DbSuspendNotifications() //////// SELECT 4 //////// IF Upper(cLS) = "L" //////// IF 1->auftrnr == 4->P_AUFTRNR // wenn synchron //////// ::PvAUFTRNR := 4->P_AUFTRNR //////// ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:=4->P_PERSKZ) //////// ELSE //////// ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ:="@") //////// ENDIF //////// ::XbpObjekt(::singleZeile,"PvANREDE"):setData(::PvANREDE:=4->P_ANREDE) //////// ::XbpObjekt(::singleZeile,"PvNAME"):setData(::PvNAME:=4->P_NAME) //////// ::XbpObjekt(::singleZeile,"PvVORNAME"):setData(::PvVORNAME:=4->P_VORNAME) //////// ::XbpObjekt(::singleZeile,"PvGEBNAME"):setData(::PvGEBNAME:=4->P_GEBNAME) //////// ::XbpObjekt(::singleZeile,"PvSTRASSE"):setData(::PvSTRASSE:=4->P_STRASSE) //////// ::XbpObjekt(::singleZeile,"PvPLZ_ORT"):setData(::PvPLZ_ORT:=4->P_PLZ_ORT) //////// ::XbpObjekt(::singleZeile,"PvTELEFON"):setData(::PvTELEFON:=4->P_TELEFON) //////// ::XbpObjekt(::singleZeile,"PvFAX"):setData(::PvFAX:=4->P_FAX) //////// ::XbpObjekt(::singleZeile,"PvEMAIL"):setData(::PvEMAIL:=4->P_EMAIL) //////// ::XbpObjekt(::singleZeile,"PvGEB_DAT"):setData(::PvGEB_DAT:=4->P_GEB_DAT) //////// ::XbpObjekt(::singleZeile,"PvSTB_DAT"):setData(::PvSTB_DAT:=4->P_STB_DAT) //////// ::XbpObjekt(::singleZeile,"PvVERW_BEZ"):setData(::PvVERW_BEZ:=4->P_VERW_BEZ) //////// ::XbpObjekt(::singleZeile,"PvRECH_NR"):setData(::PvRECH_NR:=4->P_RECH_NR) //////// ::XbpObjekt(::singleZeile,"PvRECHBETR"):setData(::PvRECHBETR:=4->P_RECHBETR) //////// ::XbpObjekt(::singleZeile,"PvRECH_DAT"):setData(::PvRECH_DAT:=4->P_RECH_DAT) //////// ::XbpObjekt(::singleZeile,"PvEINGBETR"):setData(::PvEINGBETR:=4->P_EINGBETR) //////// ::XbpObjekt(::singleZeile,"PvEING_DAT"):setData(::PvEING_DAT:=4->P_EING_DAT) //////// ::XbpObjekt(::singleZeile,"PvSALDO"):setData(::PvSALDO:=4->P_SALDO) ////////// ::XbpObjekt(::multiZeile,"PvBILD"):setData() //////// ::XbpObjekt(::multiZeile,"PvNOTIZ"):setData(::PvNOTIZ:=4->P_NOTIZ) //////// nRec4 := 4->(RecNo()) // der jetzige Satz in Area4 ... //////// 1->(Satzsp(oCB)) // ... geht hier verloren ... //////// 4->(DbGoto(nRec4)) // ... und wird hier wieder angepeilt //////// 1->perskz := ::PvPERSKZ //////// 1->(DbRUnlock()) //////// ELSEIF Upper(cLS) = "S" .AND. !Empty(1->auftrnr) //////// IF 1->auftrnr == 4->P_AUFTRNR //////// ::PvPERSKZ := IIf( ::PvPERSKZ$" @", "A", ::PvPERSKZ ) //////// 4->(Satzsp(oCB)) // weil getData auf Pv... wirkt, nicht auf P_... //////// 4->P_AUFTRNR := 1->auftrnr // ist doch schon, oder?? //////// 4->P_PERSKZ := ::XbpObjekt(::singleZeile,"PvPERSKZ"):getData() //////// 4->P_ANREDE := ::XbpObjekt(::singleZeile,"PvANREDE"):getData() //////// 4->P_NAME := ::XbpObjekt(::singleZeile,"PvNAME"):getData() //////// 4->P_VORNAME := ::XbpObjekt(::singleZeile,"PvVORNAME"):getData() //////// 4->P_GEBNAME := ::XbpObjekt(::singleZeile,"PvGEBNAME"):getData() //////// 4->P_STRASSE := ::XbpObjekt(::singleZeile,"PvSTRASSE"):getData() //////// 4->P_PLZ_ORT := ::XbpObjekt(::singleZeile,"PvPLZ_ORT"):getData() //////// 4->P_TELEFON := ::XbpObjekt(::singleZeile,"PvTELEFON"):getData() //////// 4->P_FAX := ::XbpObjekt(::singleZeile,"PvFAX"):getData() //////// 4->P_EMAIL := ::XbpObjekt(::singleZeile,"PvEMAIL"):getData() //////// 4->P_GEB_DAT := ::XbpObjekt(::singleZeile,"PvGEB_DAT"):getData() //////// 4->P_STB_DAT := ::XbpObjekt(::singleZeile,"PvSTB_DAT"):getData() //////// 4->P_VERW_BEZ:= ::XbpObjekt(::singleZeile,"PvVERW_BEZ"):getData() //////// 4->P_RECH_NR := ::XbpObjekt(::singleZeile,"PvRECH_NR"):getData() //////// 4->P_RECHBETR:= ::XbpObjekt(::singleZeile,"PvRECHBETR"):getData() //////// 4->P_RECH_DAT:= ::XbpObjekt(::singleZeile,"PvRECH_DAT"):getData() //////// 4->P_EINGBETR:= ::XbpObjekt(::singleZeile,"PvEINGBETR"):getData() //////// 4->P_EING_DAT:= ::XbpObjekt(::singleZeile,"PvEING_DAT"):getData() //////// 4->P_SALDO := ::XbpObjekt(::singleZeile,"PvSALDO"):getData() ////////// 4->P_BILD := ::XbpObjekt(::multiZeile,"PvBILD"):getData() //////// 4->P_NOTIZ := ::XbpObjekt(::multiZeile,"PvNOTIZ"):getData() //////// 4->(DbRUnlock()) //////// nRec4 := 4->(RecNo()) // der jetzige Satz in Area4 ... //////// 1->(Satzsp(oCB)) // ... geht hier verloren ... //////// 4->(DbGoto(nRec4)) // ... und wird hier wieder angepeilt //////// 1->perskz := ::PvPERSKZ //////// 1->(DbRUnlock()) //////// ENDIF //////// ELSEIF Upper(cLS) = "A" .AND. !Empty(1->auftrnr) //////// 4->(DbGotop()) //////// DO WHILE Asc(4->P_PERSKZ)>64 .AND. !Eof() //////// cPersKZ := 4->P_PERSKZ // PersKZ des letzten Eintrags feststellen //////// 4->(Dbskip()) //////// ENDDO //////// 4->(DbClearScope()) //////// 4->(DbAppend()) //////// ::PvAUFTRNR := 4->P_AUFTRNR := 1->auftrnr //////// ::PvPERSKZ := Chr(Asc(cPersKZ)+1) //////// ::XbpObjekt(::singleZeile,"PvPERSKZ"):setData(::PvPERSKZ) //////// 4->(Satzsp(oCB)) //////// 4->P_PERSKZ := ::XbpObjekt(::singleZeile,"PvPERSKZ"):getData() //////// 4->(DbRUnlock()) //////// 4->(DbSetScope( SCOPE_BOTH, StrZero(1->auftrnr,6,0) )) //////// 4->(DbSeek( StrZero(::PvAUFTRNR,6,0) + ::PvPERSKZ )) //////// ENDIF //////// SELECT (nOldArea) //////// DbResumeNotifications() ////////RETURN self //////// ////////METHOD BestFF:PersVor() //////// ::SwapPers("S") //////// IF !4->(Eof()) //////// 4->(DbSkip()) //////// IF 4->(Eof()) //////// 4->(DbSuspendNotifications()) //////// 4->(DbSkip(-1) ) // Append-Situation vermeiden //////// 4->(DbResetNotifications()) //////// 4->(DbGobottom()) // Notification ausl”sen //////// ENDIF //////// ENDIF //////// ::SwapPers("L") ////////RETURN self //////// ////////METHOD BestFF:PersRueck() //////// ::SwapPers("S") //////// IF !4->(Bof()) //////// 4->(DbSkip(-1)) //////// IF 4->(Bof()) //////// 4->(DbSuspendNotifications()) //////// 4->(DbSkip(1) ) // Append-Situation vermeiden //////// 4->(DbResetNotifications()) //////// 4->(DbGoTop()) // Notification ausl”sen //////// ENDIF //////// ENDIF //////// ::SwapPers("L") ////////RETURN self //////// ////////METHOD BestFF:PersLoesch() //////// 4->(Satzsp(oCB)) //////// 4->(DbDelete()) //////// IF !4->(Bof()) //////// 4->(DbSkip(-1)) //////// ELSE //////// 4->(DbSkip()) //////// ENDIF //////// ::SwapPers("L") ////////RETURN self //////// ////////METHOD BestFF:PersSuche( oXbp, nAnf, nEnd ) //////// LOCAL nRec1 := 1->(RecNo()), nRec4 := 4->(RecNo()) //////// PRIVATE cPFeld := Stuff(IIf(oXbp:cargo="Pv",oXbp:cargo,"PvAUFTRNR"),2,1,"_") //////// nAnf := IIf(cPFeld=="P_AUFTRNR",nAnf+10,nAnf) //////// nEnd := IIf(cPFeld=="P_AUFTRNR",nEnd+10,nEnd) //////// DbClearRelation() // weil neuer Index in Area4 erzeugt wird //////// 1->(DbSuspendNotifications(.T.)) //////// SELECT 4 //////// 4->(DbSuspendNotifications()) //////// IF ValType(&cPFeld) == "N" //////// OrdCreate("Personen","x2","StrZero(&cPFeld)") //////// ELSEIF ValType(&cPFeld) == "D" //////// OrdCreate("Personen","x2","DtoS(&cPFeld)") //////// ELSE //////// OrdCreate("Personen","x2","Upper(&cPFeld)") //////// ENDIF //////// IIf(cPFeld=="P_AUFTRNR",OrdSetFocus("ap"),OrdSetFocus("x2")) // x2 wird kontrollierender Index //////// DbGoto(nRec4) // zum Suchstart wieder auf den Start-Satz der Area4 //////// IF ::Such( oBEDA, "s_best", nAnf, nEnd, 4, nRec4, {10*nV,30*nV}, {425*nV,175*nV}, {} ) //////// 4->(DbResumeNotifications()) //////// 4->(OrdSetFocus("ap")) //////// SELECT 1 //////// 1->(DbResumeNotifications(.T.)) //////// DbGoto(nRec1) // wenn ::Such .T. liefert, ist es mit ESC verlassen worden //////// DbSetRelation( 4, {|| StrZero(1->auftrnr,6,0)+1->perskz } ) ////////// DbGoto(RecNo()) //////// ELSE //////// 4->(DbResumeNotifications()) //////// 4->(OrdSetFocus("ap")) //////// nRec4 := RecNo() // >>>>>>> der gesuchte/gefundene Satz in Area4 //////// ::SwapPers("L") //////// SELECT 1 //////// 1->(DbResumeNotifications(.T.)) //////// DbSeek(StrX(4->P_AUFTRNR,6,0),.F.) // danach ist 1->auftrnr == 4->auftrnr //////// DbSetRelation( 4, {|| StrZero(1->auftrnr,6,0)+1->perskz } ) ////////// DbGoto(RecNo()) //////// ENDIF ////////// 4->(DbResumeNotifications()) ////////// 4->(OrdSetFocus("ap")) ////////// 1->(DbResumeNotifications(.T.)) //////// 4->(DbSetScope( SCOPE_BOTH, StrZero(1->auftrnr,6,0) )) //////// 4->(DbGoto(nRec4)) //////// ::SwapPers("L") ////////// 4->(FieldGet(1)) ////////// ::SwapPers("L") ////////// DbSkip(0) ////////RETURN self // o ist das TabPage-Objekt // aTab ist ein Array mit den relativen ::BEArea-Positionen // ATail(aTab) (=aTab[3]) ist immer 0 (=Position von ::thisTab) METHOD BestFF:TabMax(o,aTab) // berl„dt DialogFF:TabMax // XXXXXruft es dann auf LOCAL n := AScan(oBest:BEArea,o) AEval(aTab, {|x,i| ::BEArea[n+x]:minimize()}, 1, Len(aTab)-1 ) ::thisTab := ::BEArea[n+ATail(aTab)] ::thisTab:maximize() IF Len(aTab) = 2 //.AND. "NOLTE"$Upper(AppName()) // die 3 TabPages in der Mitte DO CASE CASE aTab[1]+aTab[2] > 0 ::aBP := { 1->ansp_anr, 1->ansp_vname, 1->ansp_name, 1->ansp_str, 1->ansp_ort, 1->ansp_bez, 1 } CASE aTab[1]+aTab[2] = 0 ::aBP := { 1->eh_anr, 1->eh_vname, 1->eh_name, 1->eh_str, 1->eh_ort, ; IIf( 1->anrede = "H", "Ehefrau", "Ehemann" ), 2 } // CASE aTab[1]+aTab[2]+aTab[3] < 0 // ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ENDCASE ENDIF 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 2 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 } 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 } // CASE ::aBP[7] == 3 // ::aBP := { ::PvANREDE, ::PvVORNAME, ::PvNAME, ::PvSTRASSE, ::PvPLZ_ORT, ::PvVERW_BEZ, 3 } ENDCASE ENDIF RETURN self METHOD BestFF:FormularNotiz(cBL_Datei) // notiert, wenn ein Formular gedruckt wurde LOCAL nA, nOldArea := SELECT() IF cBL_Datei == Upper(cBL_Datei) DbUseArea(.T.,,"bl_dir") nA := SELECT() IF DbLocate( {|| PadR(cBL_Datei,8) == Upper((nA)->name)} ) 1->(Satzsp(oCB)) 1->notiz += CRLF+DtoC(DATE())+": "+Trim((nA)->beschreib)+ ; IIf(cBL_Datei$"BL_FIRM-BL_RENT-BL_ORD-BL_HELL-BL_KAF1", ; " an "+Trim(5->name1)+" gedruckt."," gedruckt.") IF "POSTRENT"$Upper((nA)->beschreib) 1->notiz += CRLF+"Nr.:"+cPR1+", "+cPR2+", "+cPR3 ENDIF 1->(DbRUnlock()) ENDIF DbCloseArea() SELECT (nOldArea) ::multizeile[1]:setData( 1->notiz ) ENDIF RETURN self