**BRegieTE.prg - Regie-Zentrum fr Bestattungsverwaltung // Verwaltung der Termine #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Dmlb.ch" #include "Common.ch" FUNCTION TerminEingabe( oDlg1 ) LOCAL oDlg, nEvent, mp1, mp2, oXbp, oBrowse, dDatum := CtoD(" "), cTx := Space(20) LOCAL oCtrl, oFocus := SetAppFocus(), aEditControls := {} 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 } } 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 nBo := 400*nV //, nBz := 25*nV LOCAL nOldArea := Select() PRIVATE oCB, oTEDA, oSle0, oSle, oTEdit SELECT 9 IF Upper(AppName())$"MENGX.EXE" cTerm := cNetver + "Term" USE (cTerm) SET INDEX TO (cNetver+"xterm") ELSE USE Term INDEX xterm ENDIF // dDatum := 9->datum GO TOP oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "Eingabe/Žnderung von Terminen" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10,int(30*nV)}, {int(770*nH),int(500*nV)} ) //+28.07.2013 13:30 alle nHs eingesetzt 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( GRA_CLR_BROWN ) oDlg:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) oCB := oDlg:drawingArea oTEDA := oDlg:drawingArea oTEDA:cargo := oDlg nBo := Int(255*nV) // Lage des Mittelstreifens nSBy := 45 nSEy := 45 cArtLei := Trim(" ") oXbp := XbpStatic():new( oDlg:drawingArea, , {int(5*nV),nBo}, {int(50*nV),int(25*nV)}) oXbp:caption := "Suchtext:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:helpLink := MagicHelpLabel():New(490) oXbp:create() oSle0 := XbpGet():new( oDlg:drawingArea, , {int(60*nH),nBo}, {int(80*nH),int(25*nV)}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oSle0:bufferLength := 10 oSle0:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oSle0:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oSle0:group := XBP_WITHIN_GROUP oSle0:dataLink := {|x| IIf( PCOUNT()==0, cTx, cTx := x ) } oSle0:helpLink := MagicHelpLabel():New(490) oSle0:create() oDlg:addEditControl( oSle0 ) oXbp := XbpStatic():new( oDlg:drawingArea, , {int(145*nH),nBo}, {int(60*nH),int(25*nV)}) oXbp:caption := "Suchdatum:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:helpLink := MagicHelpLabel():New(491) oXbp:create() oSle := XbpGet():new( oDlg:drawingArea, , {int(210*nH),nBo}, {int(80*nH),int(25*nV)}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oSle:bufferLength := 10 oSle:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oSle:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oSle:group := XBP_WITHIN_GROUP // oSle:dataLink := {|x| IIf( PCOUNT()==0, DtoC(dDatum), dDatum := CtoD(x) ) } oSle:dataLink := {|x| IIf( PCOUNT()==0, dDatum, dDatum := (x) ) } oSle:helpLink := MagicHelpLabel():New(491) oSle:create() //:setData() oDlg:addEditControl( oSle0 ) // jetzt folgt die Erzeugung der Eingabefelder oTEdit := TerminFF():new( oTEDA,oDlg, {330*nH,0}, {440*nH,475*nV},,, nBz, "s_term", -100, 299, 9 ) oTEdit:CREATE( oTEDA,oDlg, {330*nV,0}, {440*nV,475*nV},,, nBz, "s_term", -100, 299, 9 ) AEval( oTEdit:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oTEdit:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:setModalState( XBP_DISP_APPMODAL ) oCtrl := XbpGetController():new( oDlg ) oCtrl:create() oCtrl:READ( , .F. ) // oFocus := SetAppFocus( oSle0 ) * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) oDlg:lockUpdate(.F.) oDlg:invalidateRect() DbGotop() oTEdit:BrowseFeld[1]:refreshAll() DbSeek(Str(Year(DATE()),4,0)+Str(Month(DATE()),2,0)+Str(day(DATE()),2,0),.T.) DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN IF oXbp == oSle0 PostAppEvent( xbeP_Activate,,, oTEdit:DruckKnopf[9]) ENDIF IF oXbp == oSle PostAppEvent( xbeP_Activate,,, oTEdit:DruckKnopf[8]) ENDIF // PostAppEvent( xbeP_Activate,,, oXbp) CASE mp1 == xbeK_ESC PostAppEvent( xbeP_Close) CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_AE.dbf"), "Bedienungshinweise", oTEDA, 680*nH, 460*nV ) CASE mp1 == xbeK_F10 lEinfg := .F. PostAppEvent( xbeP_Close,,,oDlg) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient(oTEdit) oTEdit:destroy() oDlg:destroy() SetAppFocus( oFocus ) USE Select &nOldArea RETURN .T. FUNCTION TerminNeu(oDlg1) 9->(DbAppend()) 9->datum := DATE() // 9->(DbGotop()) 9->(DbSkip(0)) SetAppFocus( oDlg1:setParent():childFromName( 6->(FieldPos( "art_lei" )) ) ) RETURN .T. FUNCTION TerminEntf(oDlg1) IF ConfirmBox( oDlg1, "Soll der Datensatz gel”scht werden?", ; "Datensatz l”schen", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES Satzsp(oCB) 9->(DbDelete()) 9->(DbSkip(-1)) RETURN .T. ENDIF RETURN .T. FUNCTION TerminSuch( oDlg1, cSuchFeld ) LOCAL oDlg, nEvent, mp1, mp2, oBrowse, cArtLei := Trim(" ") 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 nOldArea := Select(), oFocus := SetAppFocus() LOCAL lFlucht := .F., nRec := RecNo(), cDatum PRIVATE oCB (nOldArea)->(DbSuspendNotifications()) SELECT 9 oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "Termine suchen" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10*nH,30*nV}, {int(330*nH),int(250*nV)} ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg 9->(DbSuspendNotifications()) IF Upper(cSuchFeld) = "TX" cSuchFeld := oSle0:getData() 9->(DbSetFilter( {|| IIf( !Empty(cSuchFeld),Upper(Trim(cSuchFeld))," " )$Upper(9->tx + ; IIf( IsFieldVar("tx2"), 9->tx2, " " )) } )) IIf( !(9)->(Bof()), 9->(DbGotop()), ) ELSEIF Upper(cSuchFeld) = "DATUM" cDatum := Trim( DtoC(oSle:getData()) ) 9->(DbSeek( SubStr(cDatum,7,4)+SubStr(cDatum,4,2)+SubStr(cDatum,1,2), .T. )) ELSE oDlg:destroy() (9)->(DbResetNotifications()) Select &nOldArea (nOldArea)->(DbResetNotifications()) (nOldArea)->(DbSkip(0) ) SetAppFocus( oFocus ) RETURN .F. ENDIF // jetzt folgt die Erzeugung der Eingabefelder oBrowse := terminFF():new( oCB,oDlg, {330*nH,0}, {440*nH,475*nV},,, 25*nV, "s_term",300,399, 9 ) oBrowse:CREATE( oCB,oDlg, {330*nH,0}, {440*nH,475*nV},,, 25*nV, "s_term",300,399, 9 ) // 5->(DbSuspendNotifications()) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() SetAppFocus( oBrowse:BrowseFeld[1] ) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) // IF nEvent == xbeM_LbDblClick .AND. SetAppFocus():isDerivedFrom( "XbpBrowse" ) // IF nEvent == xbeM_LbDblClick .AND. oXbp:isDerivedFrom( "XbpColumn" ) IF nEvent == xbeBRW_ItemSelected PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO 9->(DbResetNotifications()) oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() /// 9->(DbClearFilter()) Select &nOldArea (nOldArea)->(DbResetNotifications()) IF lFlucht = .T. (nOldArea)->(DbGoto(nRec)) ENDIF (nOldArea)->(DbSkip(0) ) SetAppFocus( oFocus ) RETURN .T. //--------------------------------------------------------------------------------- PROCEDURE TerminEintrag( cAuf, oDlg1, cBO, cBD, cBZ, cMO, cMD, cMZ, ; cU1O, cU1D, cU1Z, cU2O, cU2D, cU2Z ) // z.Zt.(23.3.03) nur fr Menge!! LOCAL nOldArea := SELECT() (nOldArea)->(DbSuspendNotifications()) SELECT 9 IF Upper(AppName())$"MENGX.EXE" cTerm := cNetver + "Term" USE (cTerm) SET INDEX TO (cNetver+"xterm"),(cNetver+"xaufterm") ELSE USE term SET INDEX TO xterm, xaufterm ENDIF SET ORDER TO 2 IF !Empty(1->&cBD) FIND &cAuf DO WHILE SubStr(9->TX,1,6) == cAuf IF "Beerdigung"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,1,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cBD REPLACE 9->tx WITH cAuf + " " + Trim(1->name) + "-" + "Beerdigung, " + Trim(1->&cBO) + ; ", " + IIf( Empty(1->&cBZ), "Uhrzeit FEHLT !", Str(1->&cBZ,5,2)+" Uhr" ) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cMD) FIND &cAuf DO WHILE SubStr(9->TX,1,6) == cAuf IF "Seelenamt"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,1,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cMD REPLACE 9->tx WITH cAuf + " " + Trim(1->name) + "-" + "Seelenamt, " + Trim(1->&cMO) + ; ", " + IIf( Empty(1->&cMZ), "Uhrzeit FEHLT !", Str(1->&cMZ,5,2)+" Uhr" ) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cU1D) FIND &cAuf DO WHILE SubStr(9->TX,1,6) == cAuf IF "Urne1"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,1,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cU1D REPLACE 9->tx WITH cAuf + " " + Trim(1->name) + "-" + "Urne1, " + Trim(1->&cU1O) + ; ", " + IIf( Empty(1->&cU1Z), "Uhrzeit FEHLT !", Str(1->&cU1Z,5,2)+" Uhr" ) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cU2D) .AND. !(cU2D==cU1D) FIND &cAuf DO WHILE SubStr(9->TX,1,6) == cAuf IF "Urne2"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,1,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cU2D REPLACE 9->tx WITH cAuf + " " + Trim(1->name) + "-" + "Urne2, " + Trim(1->&cU2O) + ; ", " + IIf( Empty(1->&cU2Z), "Uhrzeit FEHLT !", Str(1->&cU2Z,5,2)+" Uhr" ) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF USE SELECT &nOldArea (nOldArea)->(DbResumeNotifications()) RETURN //--------------------------------------------------------------------------------- PROCEDURE TerminEintragZ( cAuf, oDlg1, cBO, cBD, cBZ, cMO, cMD, cMZ, ; cU1O, cU1D, cU1Z, cU2O, cU2D, cU2Z ) // z.Zt.(2.6.03) nur fr Klemmer!! LOCAL nOldArea := SELECT() (nOldArea)->(DbSuspendNotifications()) SELECT 9 IF Upper(AppName())$"MENGX.EXE" cTerm := cNetver + "Term" USE (cTerm) SET INDEX TO (cNetver+"xterm"),(cNetver+"xaufterm") ELSE USE term SET INDEX TO xterm, xaufterm ENDIF SET ORDER TO 2 IF !Empty(1->&cBD) FIND &(Str(1->&cBZ,5,2)+" Uhr, "+cAuf) DO WHILE SubStr(9->TX,12,6) == cAuf IF "Beerdigung"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,12,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cBD REPLACE 9->tx WITH IIf( Empty(1->&cBZ), "????? Uhr", Str(1->&cBZ,5,2)+" Uhr" )+", " + ; cAuf + " " + Trim(1->name) + "-" + "Beerdigung, " + Trim(1->&cBO) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cMD) FIND &(Str(1->&cMZ,5,2)+" Uhr, "+cAuf) DO WHILE SubStr(9->TX,12,6) == cAuf IF "Seelenamt"$9->TX .OR. "Kirche"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,12,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cMD REPLACE 9->tx WITH IIf( Empty(1->&cMZ), "????? Uhr", Str(1->&cMZ,5,2)+" Uhr" )+", " + ; cAuf + " " + Trim(1->name) + "-" + "Kirche, " + Trim(1->&cMO) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cU1D) FIND &(Str(1->&cU1Z,5,2)+" Uhr, "+cAuf) DO WHILE SubStr(9->TX,12,6) == cAuf IF "Urne1"$9->TX .OR. "Urne,"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,12,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cU1D REPLACE 9->tx WITH IIf( Empty(1->&cU1Z), "????? Uhr", Str(1->&cU1Z,5,2)+" Uhr" )+", " + ; cAuf + " " + Trim(1->name) + "-" + "Urne, " + Trim(1->&cU1O) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF IF !Empty(1->&cU2D) .AND. !(cU2D==cU1D) FIND &(Str(1->&cU2Z,5,2)+" Uhr, "+cAuf) DO WHILE SubStr(9->TX,12,6) == cAuf IF "Urne2"$9->TX EXIT ENDIF SKIP ENDDO IF 9->(Eof()) .OR. SubStr(9->TX,12,6) != cAuf APPEND BLANK ELSE Satzsp(oDlg1) ENDIF REPLACE 9->datum WITH 1->&cU2D REPLACE 9->tx WITH IIf( Empty(1->&cU2Z), "????? Uhr", Str(1->&cU2Z,5,2)+" Uhr" )+", " + ; cAuf + " " + Trim(1->name) + "-" + "Urne-2, " + Trim(1->&cU2O) REPLACE 9->kennz WITH IIf("olumb"$1->&cU1O .OR. "olumb"$1->&cU2O, ; "C", Upper(1->best_art) ) ENDIF USE SELECT &nOldArea (nOldArea)->(DbResumeNotifications()) RETURN //--------------------------------------------------------------------------------- CLASS TerminFF FROM DialogFF EXPORTED: VAR VArea METHOD INIT METHOD CREATE METHOD notify METHOD DatumsGrenze ENDCLASS METHOD TerminFF: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 := cTermBM ::VArea := nA ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) RETURN self METHOD TerminFF: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 TerminFF: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 TerminFF:DatumsGrenze( nScope1, dValue1, nScope2, dValue2 ) LOCAL xValue1, xValue2 DEFAULT nScope1 TO 1, dValue1 TO CtoD("01.01."+Str(Year(DATE()),4,2)), ; nScope2 TO 2, dValue2 TO CtoD("12.31."+Str(Year(DATE()),4,2)) xValue1 := Str(Year(dValue1),4,0)+Str(Month(dValue1),2,0)+Str(day(dValue1),2,0) xValue2 := Str(Year(dValue2),4,0)+Str(Month(dValue2),2,0)+Str(day(dValue2),2,0) DbSuspendNotifications() DbSetScope( nScope1, xValue1 ) DbSetScope( nScope2, xValue2 ) DbGotop() DbResumeNotifications() IF Len(::BrowseFeld)>0 ::BrowseFeld[1]:refreshAll() ENDIF RETURN self