// Best4f.prg - Funktionen zu Best4p.prg #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Common.ch" #define xbeUser_FileMarked xbeP_User + 1 #define xbeUser_FileSelected xbeP_User + 2 STATIC oListBox := NIL //+26.11.2011 22:39 PROCEDURE RunDosWin(oOwner, cProc, aWinSize, aWinPos, cTitle, optP1,optP2,optP3,optP4,optP5) LOCAL oDosWin LOCAL oOldWin LOCAL oOldFocus := SetAppFocus() LOCAL aSizeDesktop, aPos aSizeDesktop := AppDesktop():currentSize() #define DEF_FONTHEIGHT aSizeDesktop[2]/28 #define DEF_FONTWIDTH aSizeDesktop[1]/80 #define DEF_ROWS 25 #define DEF_COLS 80 aPos := { (aSizeDesktop[1]-(DEF_COLS * DEF_FONTWIDTH)) /2, ; (aSizeDesktop[2]-(DEF_ROWS * DEF_FONTHEIGHT)) /2 } aWinSize := { DEF_COLS, DEF_ROWS } aWinPos := aPos oDosWin := XbpCrt():New(AppDeskTop(),oOwner,aWinPos,aWinSize[2],aWinSize[1],cTitle,.f. ) IF aWinPos[1] = 0 .AND. aWinPos[2] = 0 ScreenCenter(oDosWin,.t.) ENDIF oDosWin:FontWidth := DEF_FONTWIDTH oDosWin:FontHeight := DEF_FONTHEIGHT oDosWin:FontName := "8.Arial" oDosWin:Create() oDosWin:SetModalState(XBP_DISP_APPMODAL) oOldWin := SetAppWindow(oDosWin) oDosWin:Show() oDosWin:Close := {||PostAppEvent(xbeK_PGDN)} SetAppFocus(oDosWin) SetCursor(1) &cProc(optP1,optP2,optP3,optP4,optP5) oDosWin:Hide() oDosWin:SetModalState(XBP_DISP_MODELESS) SetAppWindow(oOldWin) oDosWin:Destroy() if oOldFocus <> NIL SetAppFocus(oOldFocus) endif RETURN FUNCTION ScreenCenter(oXbp, lSet) LOCAL aParentSize := oXbp:SetParent():CurrentSize() LOCAL aWinSize := oXbp:CurrentSize() LOCAL aNewPos := {0,0} // DEFAULT lSet TO .T. aNewPos[1] := (aParentSize[1]-aWinSize[1])/2 aNewPos[2] := (aParentSize[2]-aWinSize[2])/2 if lSet oXbp:SetPos(aNewPos) endif RETURN aNewPos /// -------------------------------------- FUNCTION AppQuit( oDlg1, aEditControls, aData1, cV ) LOCAL nV := AppDesktop():currentSize()[1]/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL y := ConfirmBox( oCB, "Best„tigen mit J?", ; "Programm sofort beenden.", ; XBPMB_YESNOCANCEL, ; XBPMB_QUESTION ) IF y == XBPMB_RET_YES Satzsp(oDlg1) 1->stern := "" //+06.12.2020 21:10 entsperrt den Datensatz wieder fr die anderen Nutzer Gather( aEditControls ) cPubAuf := Str( 1->auftrnr,6,0 ) SELECT 20 USE mwstdat EXCLUSIVE 20->pubauf := cPubAuf // hier k”nnten die individuellen Farben abgespeichert werden ... 10.11.2019 16:08 20->zcodewort9 := Str(nBGFarbe) //+22.11.2019 10:17 20->zcodewort8 := Str(nFeldBGFarbe) //+22.11.2019 10:17 20->zcodewort7 := cBFont //+25.11.2019 12:55 USE SELECT 1 1->(DbCommit()) Trckng( 1, RecNo(), aData1, cV ) 1->(DbRUnlock()) DbCloseAll() /* 03.07.2008 13:15 wieder ausgeschaltet */ ///* 22.05.2008 21:13 Anzeige der Hilfe fr die šbertragung: */ // ModalDialog( (cDatver+"f1_trans.dbf"), "Bedienungshinweise fr die Daten-šbertragung", oCB:cargo, 600*nV, 480*nV ) ///**/ QUIT ELSEIF y == XBPMB_RET_NO .AND. !IsMemVar( "NurWindows" ) PostAppEvent( xbeP_Close, 1,, oDlg1 ) ENDIF RETURN y //////PROCEDURE AppQuit() ////// LOCAL nButton, oXbp := SetAppFocus() ////// ////// nButton := ConfirmBox( , ; ////// "Wollen Sie das Programm beenden ?", ; ////// "Beenden", ; ////// XBPMB_YESNO , ; ////// XBPMB_QUESTION+XBPMB_APPMODAL+XBPMB_MOVEABLE ) ////// IF nButton == XBPMB_RET_YES ////// CLOSE ALL ////// QUIT ////// ENDIF ////// SetAppFocus( oXbp ) //////RETURN FUNCTION IsIndexUnique( nOrder, xIndexValue ) LOCAL nOldOrder := OrdNumber() LOCAL nRecno := Recno() LOCAL lUnique := .F. OrdSetFocus( nOrder ) lUnique := ! DbSeek( xIndexValue ) OrdSetFocus( nOldOrder ) DbGoTo( nRecno ) RETURN lUnique FUNCTION Satzsp( oDlg1, nRl ) DO WHILE nRl == NIL IF DbRlock( Recno() ) nRl := 1 ELSE ModalFen( ,,oDlg1 ) ENDIF ENDDO RETURN (.T.) FUNCTION ZumAnfang() IF !Raus_aus_Auftrag() //+13.12.2020 15:30 msgbox("?aus") ENDIF IIF( 1->Auftrnr>0, , 1->(DbDelete()) ) 1->(DbRUnlock( Recno() ) ) 1->(DbGoTop()) IF !Rein_in_Auftrag() //+13.12.2020 15:30 msgbox("?in") ENDIF RETURN .T. FUNCTION Zurueck() IF !Raus_aus_Auftrag() //+13.12.2020 15:30 msgbox("?aus") ENDIF IIF( 1->Auftrnr>0, , 1->(DbDelete()) ) 1->(DbRUnlock( Recno() ) ) 1->(DbSkip(-1)) IF !Rein_in_Auftrag() //+13.12.2020 15:30 msgbox("?in") ENDIF RETURN .T. FUNCTION Vorwaerts() IF !Raus_aus_Auftrag() //+13.12.2020 15:30 msgbox("?aus") ENDIF IIF( 1->Auftrnr>0, , 1->(DbDelete()) ) 1->(DbRUnlock( Recno() ) ) VorSkip() IF !Rein_in_Auftrag() //+13.12.2020 15:30 msgbox("?in") ENDIF RETURN .T. FUNCTION ZumEnde() IF !Raus_aus_Auftrag() //+13.12.2020 15:30 msgbox("?aus") ENDIF IIF( 1->Auftrnr>0, , 1->(DbDelete()) ) 1->(DbRUnlock( Recno() ) ) 1->(DbGoBottom()) IF !Rein_in_Auftrag() //+13.12.2020 15:30 msgbox("?in") ENDIF RETURN .T. FUNCTION VorSkip() IF ! Eof() 1->(DbSkip(1) ) IF Eof() 1->(DbSuspendNotifications()) 1->(DbSkip(-1) ) // Append-Situation vermeiden 1->(DbResetNotifications()) 1->(DbGobottom()) // Notification ausl”sen ENDIF ENDIF RETURN (.T.) PROCEDURE HiliteSle( oXbpSle ) LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , nFeldBGFarbe } } IF nFeldBGFarbe == GRA_CLR_RED aPP := { { XBP_PP_FGCLR , GRA_CLR_WHITE } , ; { XBP_PP_BGCLR , nFeldBGFarbe } } ENDIF oXbpSle:setPresParam( aPP ) oFocSle := SetAppFocus( ) RETURN PROCEDURE DeHiliteSle( oXbpSle ) LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } oXbpSle:setPresParam( aPP ) RETURN PROCEDURE Loeschen( oDlg1, nAuf ) LOCAL cAuf := Str( nAuf,6,0 ) nLoe := ConfirmBox( oDlg1, "ohne Vers + Rechn.: ", ; "Gesamt-Auftrag "+Str(nAuf,6,0)+" l”schen?:", ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON3 ) DO CASE CASE nLoe = XBPMB_RET_YES .AND. 2->(Alias()) == "VV" //28.06.2026 18:39 SELECT 2 FIND &cAuf DO WHILE 2->auftrnr == nAuf .and. !Eof() SatzDelete() DbSkip() ENDDO SELECT 3 FIND &cAuf DO WHILE 3->auftrnr == nAuf .and. !Eof() SatzDelete() DbSkip() ENDDO /* 27.05.2008 09:04 korrigieren der T-Dateien: */ SELECT 11 IF Upper(Alias(1))=="BEST" USE tvv EXCLUSIVE DO WHILE !Eof() DELETE FOR 11->auftrnr == nAuf ENDDO PACK USE tauftr EXCLUSIVE DO WHILE !Eof() DELETE FOR 11->auftrnr == nAuf ENDDO PACK USE tbest EXCLUSIVE ELSE USE tvbest EXCLUSIVE ENDIF DO WHILE !Eof() DELETE FOR 11->auftrnr == nAuf ENDDO PACK USE /**/ SELECT 1 Satzdelete() SKIP 0 CASE nLoe = XBPMB_RET_NO /* 27.05.2008 09:04 korrigieren der Tbest-Datei: */ SELECT 11 IF Upper(Alias(1))=="BEST" USE tbest EXCLUSIVE ELSE USE tvbest EXCLUSIVE ENDIF DO WHILE !Eof() DELETE FOR 11->auftrnr == nAuf ENDDO PACK USE /**/ SELECT 1 Satzdelete() SKIP 0 ENDCASE RETURN // Typ der Eingabemaske (nur noch bei Versicherungen) FUNCTION TypSetzen( cTyp, nProg ) LOCAL nOldArea := SELECT() cTyp := Stuff( cF09, nProg, 1, cTyp ) USE c:\hdbe\mwstdat EXCLUSIVE NEW f09 := cTyp USE SELECT &nOldArea cF09 := cTyp RETURN cTyp /* * Prozedur, die Daten aus einem modalen Dialog abfragt */ //PROCEDURE Modal() PROCEDURE Suchen( oDlg1, aData1, nXsize, nYsize, aEditControls ) LOCAL cAuf := Space(6) LOCAL cTitle := "Auftrag-Nr. oder Verst.-Name eingeben : (oder V,S,A,F + Leerschritt + Suchwort)" LOCAL cDateiFeld := IIf(ValType(oFocsle)=="O",oFocsle:cargo,oDlg1:childlist()[1]:childlist()[23]:cargo) //+22.09.2018 18:24 IIf(ValType(oFocSle)!="O", oFocSle := oDlg1:childlist()[1]:childlist()[23],) //+22.09.2018 18:36 Name //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //+24.09.2018 17:32 jeder Modus aus VSAF hat jetzt eigenen Knopf: oFocBut := SetAppFocus() IF oFocBut:isderivedfrom("XbpPushButton") DO CASE CASE oFocBut:caption == "V" cAuf := "V_" CASE oFocBut:caption == "S" cAuf := "S_" CASE oFocBut:caption == "A" cAuf := "A_" CASE oFocBut:caption == "F" cAuf := "F_" ENDCASE ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 1->(DbsuspendNotifications()) //+26.12.2013 21:22 damit keine 'doppelten oder verschobenen F„lle' mehr passieren DO WHILE .T. // cAuf := Padl( Trim( ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) ), 6 ) // FIND &cAuf //** Alpha-Suche - Anfang : cSuch := LTrim( ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) ) IF !Raus_aus_Auftrag() //+13.12.2020 15:30 msgbox("?") ENDIF cAuf := IIf(Upper(Alias(1))=="BEST",Str( 1->auftrnr,6,0 ),StrZero( 1->auftrnr,6,0 )) //29.08.2007 09:18 IF Val(Substr(cSuch,1,1)) > 0 .OR. SubStr(cSuch,1,1)=="0" // .or. Trim(cSuch) == "" cAuf := IIf(Upper(Alias(1))=="BEST",Padl(cSuch,6),Padl(cSuch,6,"0")) //29.08.2007 09:18 // cAuf =Padl(cSuch,6) SET ORDER TO 1 //+23.11.2018 18:51 vorsichtshalber, weil es die Suche nach der Auftragsnummer ist FIND &cAuf ELSEIF Trim(cSuch)=="" SET ORDER TO 1 // weil die Suche praktisch abgebrochen wurde durch keine Sucheingabe cAuf := IIf(Upper(Alias(1))=="BEST",Str( 1->auftrnr,6,0 ),StrZero( 1->auftrnr,6,0 )) //29.08.2007 09:18 ELSE cAuf := Bestsuch( cSuch, cAuf, oDlg1, cDateiFeld ) //+18.09.2018 13:57 SET ORDER TO 1 //+23.11.2018 18:51 vorsichtshalber, weil es die Suche nach der Auftragsnummer ist FIND &cAuf ENDIF **// Alpha-Suche - Ende. IF val(cAuf) == 1->Auftrnr .or. cAuf == "" EXIT ELSE cAuf := Space(6) cTitle := "Andere Auftrag-Nr. :" ENDIF ENDDO IF !Rein_in_Auftrag() //+13.12.2020 15:27 msgbox("?") ENDIF 1->(DbResumeNotifications()) //+26.12.2013 21:22 damit keine 'doppelten oder verschobenen F„lle' mehr passieren aData1 := SatzGet( Select(), RecNo() ) SetAppFocus( oDlg1 ) RETURN //+13.12.2020 15:07 vor dem Verlassen eines Auftrags: // 1->stern als Flag, dass/ob der Fall schon besetzt ist: FUNCTION Raus_aus_Auftrag(scatt) IF 1->stern == cPCNr // wenn ich diesen Auftrag fr mich (=meine cPCNr) gesperrt habe // 22.08.2021 16:53 geREMt IF Satzsp(oBest:cargo) Satzsp(oBest:cargo) 1->stern := "" // diesen Auftrag entsperren DbRUnlock(RecNo()) // ENDIF ELSEIF 1->stern != cPCNr //.OR. Len(Trim(1->stern)) == 0 // wenn der Auftrag nicht von mir gesperrt ist IF aBut[1]:cargo == "disabled" AEval(aEC, {|o| IIf(o:isderivedfrom("XbpSle") .OR. o:isderivedfrom("XbpMle"),o:enable(),), IIf(o:cargo=="AUFTRNR",o:disable(),) } ) AEval(aBut, {|o| o:enable(), o:cargo := NIL } ) IF scatt != NIL AEval(aButK, {|o| o:enable(), o:cargo := NIL } ) ENDIF ENDIF ELSE // darf nicht sein, denn 1->stern ist entweder ==cPCNr (mein Auftrag) oder !=cPCNr (nicht mein Auftrag) msgbox("Out-UUUps-" + 1->stern ) ENDIF nAufSperre := 0 //26.08.2021 16:25 entsperrt den Auftrag RETURN .T. //+13.12.2020 15:08 nach dem eintritt in einen Auftrag: // 1->stern als Flag, dass/ob der Fall schon besetzt ist: FUNCTION Rein_in_Auftrag(scatt) LOCAL cX := "" IF nAufSperre == 1->auftrnr // wenn dieser Auftrag schon von mir gesperrt RETURN .T. ELSEIF nAufSperre != 0 // 25.08.2021 15:18 wenn ich schon einen anderen Auftrag gesperrt habe // msgbox("Es ist bereits "+Str(nAufSperre)+" gesperrt!"+Chr(13)+Chr(10)+; // "Aktueller Auftrag: " + Str(1->auftrnr) + " !") RETURN .F. // verhindert das Sperren des aktuellen Auftrags, weil ich schon einen anderen gesperrt habe. ENDIF nAufSperre := 1->auftrnr // 25.08.2021 15:21 l„dt diesen Auftrag in die Sperr-Variable IF Len(Trim(1->stern)) == 0 // wenn der Auftrag nicht bereits gesperrt ist Satzsp(oBest:cargo) 1->stern := cPCNr // Sperre setzen mit meiner cPCNr DbRUnlock(RecNo()) IF aBut[1]:cargo == "disabled" AEval(aEC, {|o| IIf(o:isderivedfrom("XbpSle") .OR. o:isderivedfrom("XbpMle"),o:enable(),), IIf(o:cargo=="AUFTRNR",o:disable(),) } ) AEval(aBut, {|o| o:enable(), o:cargo := NIL } ) IF scatt != NIL AEval(aButK, {|o| o:enable(), o:cargo := NIL } ) ENDIF ENDIF ELSEIF 1->stern != cPCNr // wenn der Auftrag bereits gesperrt ist und nicht ICH ihn besitze AEval(aEC, {|o| IIf(o:isderivedfrom("XbpSle") .OR. o:isderivedfrom("XbpMle"),o:disable(),) } ) AEval(aBut, {|o| o:disable(), o:cargo := "disabled" } ) IF scatt != NIL AEval(aButK, {|o| o:disable(), o:cargo := "disabled" } ) ENDIF cX := "X" ELSEIF 1->stern == cPCNr // wenn der Auftrag schon/noch von mir gesperrt ist IF aBut[1]:cargo == "disabled" AEval(aEC, {|o| IIf(o:isderivedfrom("XbpSle") .OR. o:isderivedfrom("XbpMle"),o:enable(),), IIf(o:cargo=="AUFTRNR",o:disable(),) } ) AEval(aBut, {|o| o:enable(), o:cargo := NIL } ) IF scatt != NIL AEval(aButK, {|o| o:enable(), o:cargo := NIL } ) ENDIF ENDIF ELSE // darf nicht sein, ... msgbox("In-UUUps-" + 1->stern ) ENDIF // oBest:cargo:title := SubStr(oBest:cargo:title,1,Len(oBest:cargo:title)-3) + " *" + 1->stern + cX // cX 22.08.2021 16:49 oBest:cargo:title := SubStr(oBest:cargo:title,1,At("*",oBest:cargo:title)-2) + " *" + 1->stern + cX // cX 22.08.2021 16:49 oBest:cargo:configure() IF scatt != NIL // damit aus der Kontrollbersicht heraus der gesperrte Fall aufgebaut wird Scatter(aEC) ENDIF RETURN .T. FUNCTION Modaldialog( cString, cTitle, oDlg1, nXsize, nYsize, aText, cFont ) LOCAL nEvent, mp1, mp2, oXbp, mp1l, mp2l, oXbpl, lExit, nOldArea LOCAL oDlg, oSle, oMle, oFocus := SetAppFocus(), aPos, aSize, oCB //-26.11.2011 22:39, oListbox //, drawingArea LOCAL cDatei := cString, aStrings := {}, nRec, cItem LOCAL nV := AppDeskTop():currentsize()[1]/800 LOCAL lListB := IIf( nXsize < Int(450*nV), .T., .F. ) //+13.02.2010 17:34 LOCAL cStringRTF := IIf(ValType(cString)=="C" .AND. Len(cString)>6, SubStr(cString,1,Len(cString)-4)+".rtf", "") //03.02.2025 18:20 DEFAULT cFont TO "10.Times New Roman" drawingArea := oDlg1:drawingArea /*15.06.2008 14:33 wieder entREMt */ aSize := drawingArea:currentSize() // aSize := oDlg1:currentSize() /*15.06.2008 14:33 geREMt aSize[1] := IIf( aSize[1]auftrnr,6,0)+" - "+Trim(1->vorname)+" "+Trim(1->name)) SKIP -1 ENDDO // NEXT SET ORDER TO 1 //+21.02.2010 14:08 umgebaut (Fehlermeldung in Usergroup)+++++++++ //+ AEval( aStrings, {|c| oListBox:addItem(c) } ) FOR i := 1 TO Len(aStrings) oListBox:addItem(aStrings[i]) Sleep(1) //+23.02.2010 08:58 Vista-Problem ! NEXT //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ oListBox:setData( {1}, .T. ) GO nRec DbResumeNotifications() //+13.02.2010 16:37 wegen Windows7 (s.o.) /*+13.02.2010 17:36 //////// ENDIF ////////// aPos := { 12, ( aSize[2] - Int(20*nV) ) / 2 } //////// IF ValType(aText) == "A" //05.03.2008 12:25 */ ELSEIF ValType(aText) == "A" //+13.02.2010 17:36 FOR i := 1 TO Len(aText) //+ aPos := { Int(12*nV), Int(nYSize-50-25*i*nV) } aPos := { Int(12*nV), Int(nYSize-(50+25*i)*nV) } //+13.02.2010 17:38 oXbp := XbpStatic():new( oCB, , aPos, { aSize[1] - Int(20*nV), Int(24*nV) } ) oXbp:caption := aText[i] oXbp:create() NEXT ENDIF aPos := { Int(12*nV), Int(48*nV) } oSle := XbpSle():new( oCB, , aPos, { aSize[1] - Int(20*nV), Int(24*nV) } ) oSle:TabStop := .T. oSle:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oSle:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oSle:dataLink := {|x| IIf( PCOUNT()==0, Trim( cString ), cString := x ) } oSle:create() oSle:setData( AllTrim(cString) ) //+24.09.2018 20:38 AllTrim() oSle:setName( 111 ) PostAppEvent( xbeP_Keyboard, xbeK_END,, oSle ) //+24.09.2018 17:43 oDlg:lockupdate(.F.) //+27.11.2011 09:20 oDlg:invalidateRect() //+27.11.2011 09:30 ENDIF //+13.02.2010 17:38IF nXsize > Int(449*nV) IF lListB == .F. //+13.02.2010 17:39 nXsize > Int(449*nV) IF ".RTF"$Upper(cStringRTF) .AND. FExists(cStringRTF) //03.02.2025 18:23 wenn als .rtf-Datei vorhanden cString := cStringRTF ENDIF cString := MemoRead( cString ) oMle := XbpMle():new( oCB,, {Int(30*nV),Int(40*nV)}, {nXsize-Int(60*nV),nYsize-Int(70*nV)}, ; { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD },{ XBP_PP_COMPOUNDNAME, cFont } } ) oMle:FORMAT := 3 //03.02.2025 18:33 wegen rtf oMle:dataLink := {|x| IIf( x==NIL, cString, cString := x ) } oMle:wordWrap := .T. oMle:horizScroll := IIf( Upper(cString) = "C:\HDBE\", .T., .F. ) Sleep(1) oMle:create() Sleep(1) oMle:setData() Sleep(1) ENDIF aPos := { ( aSize[1]-Int(72*nV) ) / 2, Int(12*nV) } oXbpBok := XbpPushbutton():new( oDlg:drawingArea,, aPos, {Int(72*nV),Int(24*nV)} ) oXbpBok:caption := "OK" oXbpBok:TabStop := .T. oXbpBok:create() oXbpBok:activate := {|| IIf( nXsize < Int(450*nV), cString := LTrim( oSle:getData() ), ), ; PostAppEvent( xbeP_Close ) } //+13.02.2010 17:39 IF nXsize > Int(449*nV) IF lListB == .F. //+13.02.2010 17:40 nXsize > Int(449*nV) oFocus := SetAppFocus( oMle ) ENDIF oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() //+13.02.2010 17:40 IF nXsize < Int(450*nV) IF lListB == .T. //+13.02.2010 17:40 nXsize < Int(450*nV) SetAppFocus( oSle ) ENDIF nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick .and. oXbp:isDerivedFrom( "XbpListBox" ) cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) cString := LTrim( oSle:getData() ) PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDIF IF nEvent == xbeM_LbClick .and. oXbp:isDerivedFrom( "XbpListBox" ) cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) ENDIF IF nEvent == xbeP_User cItem := oListBox:getItem( oListBox:getData()[1] ) oSle:setData( LTrim( Substr( cItem, 1, At( "-", cItem )-1 ) ) ) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC IF oXbp:isDerivedFrom( "XbpSle" ) oXbp:setData( " " ) cString := "" ENDIF PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_RETURN IF oXbp:isDerivedFrom( "XbpPushbutton" ) PostAppEvent( xbeP_Activate,,, oXbp ) ELSEIF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) cString := LTrim( oSle:getData() ) PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDIF CASE mp1 == xbeK_F10 IF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) cString := oSle:getData() ENDIF PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpSle" ) SetAppFocus( oListBox ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpListBox" ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpSle" ) SetAppFocus( oListBox ) PostAppEvent( xbeP_User ) CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpListBox" ) PostAppEvent( xbeP_User ) CASE (mp1 == xbeK_ALT_W .or. mp1 == xbeK_CTRL_W) .and. oXbp:isDerivedFrom( "XbpMle" ) cString := oMle:getdata() Memowrit( cDatei, cString ) oXbp:enable() CASE mp1 == xbeK_ALT_D .and. oXbp:isDerivedFrom( "XbpMle" ) cString := oMle:getdata() SET DEVICE TO printw @ 1,1 SAY cString SET DEVICE TO SCREEN CASE mp1 >= 32 .and. mp1 <= 255 // IF LastAppEvent( @mp1l, @mp2l, @oXbpl ) == xbeP_Keyboard .and. (mp1l >=32 .and. mp1l <= 255 ) IF oXbp:isDerivedFrom( "XbpListBox" ) SetAppFocus ( oSle ) oSle:CLEAR() PostAppEvent( xbeP_Keyboard, mp1, mp2, oSle ) // oSle:setData ( Chr(mp1) ) ENDIF ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO //+13.02.2010 17:43 IF nXsize<450 IF lListB == .T. //+13.02.2010 17:43 nXsize<450 // cString := oSle:getData() ELSE cString := oMle:getData() ENDIF oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN LTrim( cString ) //+30.08.2012 10:38 FUNCTION ModaldialogA( aEingabe, cTitle, oDlg1, nXsize, nYsize, aAnzahl, cDate ) //+23.07.2008 10:51 ==@zDate FUNCTION ModaldialogA( aEingabe, cTitle, oDlg1, nXsize, nYsize, aAnzahl, cDate, cDate14, cDate8 ) //+30.08.2012 10:38 ==@zDate,@zDate14,@zDate8 LOCAL nEvent, mp1, mp2, oXbp, mp1l, mp2l, oXbpl, lExit, nOldArea LOCAL oDlg, oSle, oMle, oFocus := SetAppFocus(), aPos, aSize, oCB, oListbox //, drawingArea // LOCAL cDatei := cString, aStrings := {}, nRec, cItem LOCAL nV := AppDeskTop():currentsize()[1]/800 LOCAL i, n := 0, aSle := IIf(cDate==NIL,Array(7),Array(10)) //+23.07.2008 10:53 30.08.2012 11:05 8->10 LOCAL lFluchtM := .F. //+21.10.2018 19:38 drawingArea := oDlg1:drawingArea /*15.06.2008 14:33 weil oDlg1 das Window ist, nicht die DA ! */ aSize := drawingArea:currentSize() // aSize := oDlg1:currentSize() /*15.06.2008 14:33 geREMt AEval( aEingabe, {|a,x| IIf(!Empty(a),++n,) } ) nYsize := nYSize + 50 + 25*n aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+Int(20*nV) ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oCB := oDlg:drawingArea n := 1 IF !"Daten bertragen"$cTitle .AND. !"Notizen vergleichen"$cTitle //22.05.2008 17:58 + 15.09.2019 15:13 aPos := { Int(12*nV), Int(nYSize-50-25*n++*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(130*nV), Int(24*nV) } ) oXbp:caption := "(Hilfe mit F1)" oXbp:create() aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(130*nV), Int(24*nV) } ) oXbp:caption := "Anzahl der Ausdrucke:" oXbp:create() ENDIF IF ValType(aEingabe) == "A" //05.03.2008 12:25 // FOR i := 1 TO Len(aEingabe) IF !Empty(aEingabe[1]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[1]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[1] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[1]:TabStop := .T. aSle[1]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[1]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[1]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[1], aAnzahl[1] := x ) } aSle[1]:create() aSle[1]:setData( aAnzahl[1] ) ENDIF IF !Empty(aEingabe[2]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[2]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[2] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[2]:TabStop := .T. aSle[2]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[2]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[2]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[2], aAnzahl[2] := x ) } aSle[2]:create() aSle[2]:setData( aAnzahl[2] ) ENDIF IF !Empty(aEingabe[3]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[3]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[3] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[3]:TabStop := .T. aSle[3]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[3]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[3]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[3], aAnzahl[3] := x ) } aSle[3]:create() aSle[3]:setData( aAnzahl[3] ) ENDIF IF !Empty(aEingabe[4]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[4]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[4] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[4]:TabStop := .T. aSle[4]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[4]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[4]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[4], aAnzahl[4] := x ) } aSle[4]:create() aSle[4]:setData( aAnzahl[4] ) ENDIF IF !Empty(aEingabe[5]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[5]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[5] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[5]:TabStop := .T. aSle[5]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[5]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[5]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[5], aAnzahl[5] := x ) } aSle[5]:create() aSle[5]:setData( aAnzahl[5] ) ENDIF IF !Empty(aEingabe[6]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[6]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[6] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[6]:TabStop := .T. aSle[6]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[6]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[6]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[6], aAnzahl[6] := x ) } aSle[6]:create() aSle[6]:setData( aAnzahl[6] ) ENDIF IF !Empty(aEingabe[7]) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := aEingabe[7]+" :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[7] := XbpSle():new( oCB, , aPos, { Int(20*nV), Int(24*nV) } ) aSle[7]:TabStop := .T. aSle[7]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[7]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[7]:dataLink := {|x| IIf( PCOUNT()==0, aAnzahl[7], aAnzahl[7] := x ) } aSle[7]:create() aSle[7]:setData( aAnzahl[7] ) ENDIF IF ValType(cDate) == "C" n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := "Datum :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[8] := XbpSle():new( oCB, , aPos, { Int(65*nV), Int(24*nV) } ) aSle[8]:TabStop := .T. aSle[8]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[8]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[8]:dataLink := {|x| IIf( PCOUNT()==0, cDate, cDate := x ) } aSle[8]:create() aSle[8]:setData( cDate ) //+30.08.2012 10:41 Zahldatum + Skontodatum: n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := "Zahl-Datum :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[9] := XbpSle():new( oCB, , aPos, { Int(65*nV), Int(24*nV) } ) aSle[9]:TabStop := .T. aSle[9]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[9]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[9]:dataLink := {|x| IIf( PCOUNT()==0, cDate14, cDate14 := x ) } aSle[9]:create() aSle[9]:setData( cDate14 ) n++ aPos := { Int(12*nV), Int(nYSize-50-25*n*nV) } oXbp := XbpStatic():new( oCB, , aPos, { Int(100*nV), Int(24*nV) } ) oXbp:caption := "Skonto-Datum :" oXbp:create() aPos := { Int(120*nV), Int(nYSize-50-25*n*nV) } aSle[10] := XbpSle():new( oCB, , aPos, { Int(65*nV), Int(24*nV) } ) aSle[10]:TabStop := .T. aSle[10]:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } aSle[10]:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } aSle[10]:dataLink := {|x| IIf( PCOUNT()==0, cDate8, cDate8 := x ) } aSle[10]:create() aSle[10]:setData( cDate8 ) ENDIF // oSle:setName( 111 ) // NEXT ENDIF aPos := { ( nXSize-Int(72*nV) ) / 2, Int(12*nV) } oXbpBok := XbpPushbutton():new( oDlg:drawingArea,, aPos, {Int(72*nV),Int(24*nV)} ) oXbpBok:caption := "OK" oXbpBok:TabStop := .T. oXbpBok:create() oXbpBok:activate := {|| AEval( aSle, {|a,x| IIf(x==8,cDate:=a:getData(), ; IIf(x==9,cDate14:=a:getData(), ; IIf(x==10,cDate8:=a:getData(), ; IIf(ValType(a)=="O",aAnzahl[x]:=a:getData(),)))) } ), ; PostAppEvent( xbeP_Close ) } oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() SetAppFocus( aSle[1] ) nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC IF oXbp:isDerivedFrom( "XbpSle" ) oXbp:setData( " " ) cString := "" ENDIF lFluchtM := .T. PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_TAB .AND. Len(aSle)>=10 //+15.05.2017 09:40 len IF oXbp == aSle[8] .AND. oXbp:changed aSle[9]:setData( cDate14 := DtoC(CtoD(aSle[8]:editbuffer())+14) ) aSle[10]:setData( cDate8 := DtoC(CtoD(aSle[8]:editbuffer())+8) ) ENDIF CASE mp1 == xbeK_RETURN IF oXbp:isDerivedFrom( "XbpPushbutton" ) PostAppEvent( xbeP_Activate,,, oXbp ) ELSEIF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) // cString := LTrim( oSle:getData() ) // PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDIF CASE mp1 == xbeK_F10 PostAppEvent( xbeP_Activate,,, oXbpBok ) // IF oXbp:isDerivedFrom( "XbpSle" ) .or. oXbp:isDerivedFrom( "XbpListBox" ) // cString := oSle:getData() // ENDIF // PostAppEvent( xbeP_Close ) CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpSle" ) PostAppEvent( xbeP_Keyboard, xbeK_TAB,, oXbp ) ////// SetAppFocus( oListBox ) ////// PostAppEvent( xbeP_User ) ////// CASE mp1 == xbeK_DOWN .and. oXbp:isDerivedFrom( "XbpListBox" ) ////// PostAppEvent( xbeP_User ) CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpSle" ) PostAppEvent( xbeP_Keyboard, xbeK_SH_TAB,, oXbp ) ////// SetAppFocus( oListBox ) ////// PostAppEvent( xbeP_User ) ////// CASE mp1 == xbeK_UP .and. oXbp:isDerivedFrom( "XbpListBox" ) ////// PostAppEvent( xbeP_User ) ////// CASE (mp1 == xbeK_ALT_W .or. mp1 == xbeK_CTRL_W) .and. oXbp:isDerivedFrom( "XbpMle" ) ////// cString := oMle:getdata() ////// Memowrit( cDatei, cString ) ////// oXbp:enable() ////// CASE mp1 == xbeK_ALT_D .and. oXbp:isDerivedFrom( "XbpMle" ) ////// cString := oMle:getdata() ////// SET DEVICE TO printw ////// @ 1,1 SAY cString ////// SET DEVICE TO SCREEN ////// CASE mp1 >= 32 .and. mp1 <= 255 //////// IF LastAppEvent( @mp1l, @mp2l, @oXbpl ) == xbeP_Keyboard .and. (mp1l >=32 .and. mp1l <= 255 ) ////// IF oXbp:isDerivedFrom( "XbpListBox" ) ////// SetAppFocus ( oSle ) ////// oSle:CLEAR() ////// PostAppEvent( xbeP_Keyboard, mp1, mp2, oSle ) //////// oSle:setData ( Chr(mp1) ) ////// ENDIF CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_ModA.dbf"), "Bedienungshinweise", oDlg, 600*nV, 480*nV ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO IF lFluchtM = .T. //+22.07.2019 18:35 statt := jetzt nur noch = (wie es sein soll!!) IF ValType(aAnzahl[1])=="C" aAnzahl := {"n","n","n","n","n","n","n"} //+22.07.2019 18:34 ESC heiát: nicht bertragen ELSE aAnzahl := {0,0,0,0,0,0,0} //+21.10.2018 19:39 ESC heiát: nicht drucken ENDIF ENDIF //////IF nXsize<450 //////// cString := oSle:getData() //////ELSE ////// cString := oMle:getData() //////ENDIF oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN aAnzahl FUNCTION NeuVB( oDlg1, aData1, nXsize, nYsize ) LOCAL cAuf := Space(6), cAufneu, cAufalt LOCAL cTitle := "Neue Auftrag-Nr. eingeben :" /* 27.05.2008 15:37 cFilialnummer ist die 3. Stelle der Auftragsnummer: */ LOCAL cFilialNummer DO CASE CASE Trim(Upper(cOBVer))$"T:\HDBE\MS\ MS" cFilialNummer := "01" CASE Trim(Upper(cOBVer))$"T:\HDBE\E\ E" cFilialNummer := "2" CASE Trim(Upper(cOBVer))$"T:\HDBE\DU\ DU" cFilialNummer := "34" CASE Trim(Upper(cOBVer))$"T:\HDBE\GE\ GE" cFilialNummer := "56" CASE Trim(Upper(cOBVer))$"T:\HDBE\HE\ HE" cFilialNummer := "7" CASE Trim(Upper(cOBVer))$"T:\HDBE\DO\ DO" cFilialNummer := "8" OTHERWISE cFilialNummer := "0123456789" ENDCASE /**/ SET DELETED on IF 1->Auftrnr=0 DELETE ENDIF cAufalt := IIf(Upper(Alias(1))=="BEST",Str( 1->auftrnr,6,0 ),StrZERO( 1->auftrnr,6,0 )) //29.08.2007 09:31 DO WHILE .T. cAufneu := ModalDialog( cAuf, cTitle, oDlg1, nXsize, nYsize ) cAufneu := IIf( Trim(cAufneu)=="", IIf(Upper(Alias(1))=="BEST",Str( 1->auftrnr,6,0 ),StrZERO( 1->auftrnr,6,0 )), cAufneu ) //29.08.2007 09:31 IF Val(cAufneu) == 1->auftrnr /* 27.05.2008 08:38 weil Satzzeiger ver„ndert:, wenn gesuchte Nr schon existiert: ( fhrt sonst zu unkorrigierbarem Fehler beim Trckng() ! ) */ RETURN aData1 := SatzGet( Select(), RecNo() ) ENDIF cAuf := IIf( Upper( Substr( cAufneu,1,1 ))="B", Substr( Padr(cAufneu,8),3,6), ; IIf(Upper(Alias(1))=="BEST",Padl(cAufneu,6 ),Padl(cAufneu,6,"0" ))) //29.08.2007 09:34 cAuf := Padl( Trim( cAuf ), 6 ) FIND &cAuf IF Found() .AND. VAL( cAuf ) > 0 cAuf := Space(6) cTitle := "Schon belegt! Neue Auftrag-Nr. :" ELSEIF VAL( cAuf ) < 1000000 /* 27.05.2008 15:28 Filialen sollen gewarnt werden, wenn Auftrag ihnen nicht zugeh”rt: */ IF cAuf[3]$cFilialNummer .OR. ; ConfirmBox( oDlg1, "anlegen mit - abbrechen mit /", ; "Auftrag "+cAuf+" ist nicht aus dieser Filiale!", ; XBPMB_YESNOCANCEL, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON3 ) = XBPMB_RET_YES EXIT ENDIF /**/ ELSE cAuf := Space(6) cTitle := "Zu lang! Neue Auftrag-Nr. :" ENDIF ENDDO aData1 := SatzGet( Select(), RecNo() ) IF VAL( cAufneu ) > 0 // neuen Fall mit der eingegebenen Nummer anlegen 1->(DbAppend()) aData1 := SatzGet( Select(), RecNo() ) REPLACE 1->AUFTRNR WITH Val( cAuf ) aData1[1] := Val( cAuf ) REPLACE todesurs with "natrlicher Tod" REPLACE staatsan with "deutsch" /*klappt hier nicht! //23.06.2026 14:10^vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv IF AppKeyState(65553)==1 AEval( aEC, {|o| o:setData() } ) AEval( aEC, {|o| o:getData() } ) FallImport() ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */ ELSEIF Upper( Substr( cAufneu,1,1 ) ) = "B" // kopieren des aktuellen Falles auf diesen neuen Fall // Vorvertrag als Bestattungsfall kopieren: FIND &cAufalt aDataV := Array(FCount()) For n := 1 to FCount() aDataV[n] := FieldGet( n ) NEXT 1->(DbAppend()) aData1 := SatzGet( Select(), RecNo() ) For n := 1 to FCount() FieldPut( n, aDataV[n] ) NEXT REPLACE 1->AUFTRNR WITH Val( Substr( Padr( cAufneu, 8 ),3,6 ) ) // REPLACE 1->&r_b_0 WITH 0 // REPLACE 1->&r_b_0h WITH 0 REPLACE 1->&r_b_1 WITH 0 REPLACE 1->&r_b_1h WITH 0 REPLACE 1->&r_b_2 WITH 0 REPLACE 1->&r_b_2h WITH 0 // REPLACE 1->&r_b_3 WITH 0 // REPLACE 1->&r_b_3h WITH 0 // REPLACE 1->&r_s WITH 0 // REPLACE 1->&r_sh WITH 0 FIND &cAufalt // Versicherungseintr„ge in den Bestattungsfall kopieren: cVerstemp := "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 ) ) SELECT 2 skip enddo SELECT 12 USE SELECT 2 APPEND FROM (cVersTemp) // Rechnungsdaten in den Bestattungsfall kopieren: cAuf3temp := "auf3"+LTrim(Str(Int(Seconds()/10))) SELECT 3 COPY STRU TO (cAuf3temp) aDataV := Array(FCount()) SELECT 13 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 ) ) SELECT 3 skip enddo SELECT 13 USE SELECT 3 APPEND FROM ( cAuf3Temp ) SELECT 1 IF Upper(Alias(1))=="BEST" FIND &( Padl( Substr( cAufneu,3,6 ), 6) ) ELSE FIND &( Padl( Substr( cAufneu,3,6 ), 6,"0") ) ENDIF FErase( cDatver+cVerstemp+".dbf" ) FErase( cDatver+cAuf3temp+".dbf" ) /* 27.05.2008 09:38 T-Dateien ohne Frage bespielen: */ TTausBEST(0) ENDIF SetAppFocus ( oDlg1 ) RETURN aData1 PROCEDURE F1( cDatei, cTitle, oDlg1, nXsize, nYsize ) ModalDialog( cDatei, cTitle, oDlg1, nXsize, nYsize ) SetAppFocus ( oDlg1 ) RETURN FUNCTION Ehe( oDlg1, aEditcontrols, nXsize, nYsize ) LOCAL aEhe := {} LOCAL cTitle := "Ehe-Partner :" aEhe := IIf( 1->EH_NAME = " " , ; { XbpObjekt(aEditcontrols,"NAME"):getdata()," "," ", ; XbpObjekt(aEditcontrols,"STRASSE"):getdata(), ; XbpObjekt(aEditcontrols,"PLZ_ORT"):getdata(),CtoD(" "),CtoD(" ") } , ; { 1->EH_NAME,1->EH_VNAME,1->EH_GEBN, ; 1->EH_STR,1->EH_ORT,1->EH_GEBD, ; 1->EH_GEST } ) aEhe := EheDialog( aEhe, cTitle, oDlg1, nXsize, nYsize ) SetAppFocus ( oDlg1 ) RETURN aEditcontrols FUNCTION Ehedialog( aEhe, cTitle, oDlg1, nXsize, nYsize ) LOCAL nEvent, mp1, mp2, oXbp, lExit, aEditControls := {} LOCAL oDlg, oSle, oFocus, aPos, aSize //, drawingArea LOCAL nBo := nYsize - 50 // tats„chliche Bildschirmaufl”sung: 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 n5 := 5*nV LOCAL n10 := 10*nV LOCAL nBl1 := int(60*nV) // L„nge des Bezeichnungsfeldes LOCAL nBl2 := int(50*nV) // L„nge des Bezeichnungsfeldes LOCAL nBl3 := int(30*nV) // L„nge des Bezeichnungsfeldes LOCAL nBl4 := int(20*nV) // L„nge des Bezeichnungsfeldes LOCAL nBh := int(20*nV) // H”he des Bezeichnungsfeldes =20 LOCAL nBz := int(25*nV) // Zeilenh”he des Bezeichnungsfeldes =25 LOCAL nR1 := 5 // linker Rand Bezeichnungsfeld LOCAL nR2 := int(70*nV) // linker Rand EingabeFeld LOCAL nFl1 := int(170*nV) // L„nge des Eingabefeldes LOCAL nFl2 := int(120*nV) // L„nge des Eingabefeldes LOCAL nFl3 := int(80*nV) // L„nge des Eingabefeldes LOCAL nFl4 := int(60*nV) // L„nge des Eingabefeldes LOCAL nFl5 := int(30*nV) // L„nge des Eingabefeldes LOCAL nFa := 0 LOCAL nT1 := int(200*nV) // Linker Rand Taste LOCAL nT2 := int(430*nV) // Linker Rand Taste LOCAL nT3 := int(490*nV) // Linker Rand Taste LOCAL nT4 := int(550*nV) // Linker Rand Taste LOCAL nT5 := int(610*nV) // Linker Rand Taste LOCAL nT6 := int(670*nV) // Linker Rand Taste LOCAL nT7 := int(730*nV) // Linker Rand Taste LOCAL nTl := int(40*nV) // Linker Rand Taste drawingArea := oDlg1:drawingArea aSize := drawingArea:currentSize() aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+20 ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oDlg:Close := {|| lExit := .T. } drawingArea := oDlg:drawingArea oXbp := XbpStatic():new( drawingarea, , {nR1-n5,nR1-n5}, {nXSize-n10,nYSize-nBl3},) oXbp:clipSiblings := .T. oXbp:type := XBPSTATIC_TYPE_GROUPBOX oXbp:create() nBo := nBo-nBz oSle := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oSle:caption := "Name:" oSle:clipSiblings := .T. oSle:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oSle:create() nFa := 28 ; nFl := nFa*6 oSle := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl1,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oSle:bufferLength := nFa oSle:TabStop := .T. oSle:clipSiblings := .T. 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, Trim( 1->EH_NAME ), 1->EH_NAME := x ) } oSle:create():setData( TRIM(aEhe[1]) ) AAdd ( aEditControls, oSle ) nBo := nBo-nBz oXbp := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oXbp:caption := "Vorname:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:create() nFa := 28 ; nFl := nFa*6 oXbp := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl1,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( 1->EH_VNAME ), 1->EH_VNAME := x ) } oXbp:create():setData( TRIM(aEhe[2]) ) AAdd ( aEditControls, oXbp ) nBo := nBo-nBz oXbp := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oXbp:caption := "Geb.-Name:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:create() nFa := 28 ; nFl := nFa*6 oXbp := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl1,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( 1->EH_GEBN ), 1->EH_GEBN := x ) } oXbp:create():setData( TRIM(aEhe[3]) ) AAdd ( aEditControls, oXbp ) nBo := nBo-nBz oXbp := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oXbp:caption := "Straáe:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:create() nFa := 28 ; nFl := nFa*6 oXbp := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl1,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( 1->EH_STR ), 1->EH_STR := x ) } oXbp:create():setData( TRIM(aEhe[4]) ) AAdd ( aEditControls, oXbp ) nBo := nBo-nBz oXbp := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oXbp:caption := "PLZ/Ort:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:create() nFa := 28 ; nFl := nFa*6 oXbp := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl1,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( 1->EH_ORT ), 1->EH_ORT := x ) } oXbp:create():setData( TRIM(aEhe[5]) ) AAdd ( aEditControls, oXbp ) nBo := nBo-nBz oXbp := XbpStatic():new( drawingarea, , {nR1,nBo}, {nBl1,nBh} ) oXbp:caption := "geb/gest:" oXbp:clipSiblings := .T. oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT oXbp:create() nFa := 10 ; nFl := nFa*7 oXbp := XbpSLE():new( drawingarea, , {nR2,nBo}, {nFl3,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, ; IIf( DtoC( 1->EH_GEBD )=" ", trim(" "), DtoC( 1->EH_GEBD )), ; IIf( len(x)<7, 1->EH_GEBD := CtoD(x+str(year(date(),4,0))), ; 1->EH_GEBD := CtoD(x) ) ) } oXbp:create():setData( IIf( ValType(aEhe[6])=="D", ; IIf( DtoC(aEhe[6])=" ", TRIM(" "), DtoC(aEhe[6])), ) ) AAdd ( aEditControls, oXbp ) nFa := 10 ; nFl := nFa*7 oXbp := XbpSLE():new( drawingarea, , {nR2+nFl1-nFl3,nBo}, {nFl3,nBh}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } ) oXbp:bufferLength := nFa oXbp:clipSiblings := .T. oXbp:setInputFocus := {|mp1,mp2,obj| HiliteSle( obj ) } oXbp:killInputFocus := {|mp1,mp2,obj| DeHiliteSle( obj ) } oXbp:group := XBP_WITHIN_GROUP oXbp:dataLink := {|x| IIf( PCOUNT()==0, ; IIf( DtoC( 1->EH_GEST )=" ", trim(" "), DtoC( 1->EH_GEST )), ; IIf( len(x)<7, 1->EH_GEST := CtoD(x+str(year(date(),4,0))), ; 1->EH_GEST := CtoD(x) ) ) } oXbp:create():setData( IIf( ValType(aEhe[7])=="D", ; IIf( DtoC(aEhe[7])=" ", TRIM(" "), DtoC(aEhe[7])), ) ) AAdd ( aEditControls, oXbp ) oXbpBok := XbpPushbutton():new( drawingarea, , {nXSize/2-36,20}, {72,24} ) oXbpBok:caption := "OK" oXbpBok:activate := {|| Satzsp(), Gather( aEditControls ), DbRUnlock(), ; PostAppEvent( xbeP_Close ) } oXbpBok:TabStop := .T. oXbpBok:group := XBP_WITHIN_GROUP oXbpBok:create() oFocus := SetAppFocus( oSle ) oDlg:setModalState( XBP_DISP_APPMODAL ) lExit := .F. nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .AND. oXbp == oXbpBok PostAppEvent( xbeP_Activate,,, oXbpBok ) CASE mp1 == xbeK_ESC .OR. mp1 == xbeK_F10 .OR. mp1 == xbeK_PGDN PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN aEhe //------------------------------------------------- FUNCTION ModalFen( cString, cTitle, oDlg1, nXsize, nYsize ) LOCAL nEvent, mp1, mp2, oXbp, lExit LOCAL oDlg, oSle, oMle, oFocus, aPos, ASize, nSemi := 0 //, drawingArea nXsize := IIf( nXSize<>NIL, nXSize, 300 ) nYsize := IIf( nYsize<>NIL, nYsize, 300 ) nY := Int(nYSize*.75) nBz := 30 cTitle := IIf( cTitle<>NIL, cTitle, "A C H T U N G !" ) cString := IIf( cString<>NIL, cString, "Datensatz "+LTrim(Str(Recno()))+" ist z.Zt. gesperrt!" ) oDlg1 := IIf( oDlg1<>NIL, oDlg1, AppDesktop() ) // aRL := DbRLockList() // IF Len(aRL)>0 // FOR i=1 to Len(aRL) // cString := cString+LTrim(Str( aRL[i] ) ) // NEXT // ENDIF drawingArea := oDlg1:drawingArea //* aSize := drawingArea:currentSize() aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+20 ) / 2 } oDlg := AKDialog():new( AppDesktop(), oDlg1, aPos, {nXsize,nYsize} ) oDlg:title := cTitle oDlg:taskList := .T. oDlg:minButton := .F. oDlg:maxButton := .F. oDlg:create() oDlg:drawingArea:setColorBG( GRA_CLR_YELLOW ) oFocus := SetAppFocus( oDlg ) DO WHILE (nSemi := IIf( At( ";", cString )>0 , At( ";", cString ), Len(cString)+1 ) ) > 1 oXbp := XbpStatic():new( oDlg:drawingarea, , {20, nY := nY - nBz }, {nXsize-40,30} ) oXbp:caption := Left( cString, nSemi-1 ) cString := IIf( nSemi>Len(cString), "", SubStr( cString, nSemi+1 ) ) oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_CENTER oXbp:create() ENDDO aSize := oDlg:drawingArea:currentSize() aPos := { ( aSize[1]-72 ) / 2, 12 } oXbpBok := XbpPushbutton():new( oDlg:drawingArea,, aPos, {72,24} ) oXbpBok:caption := "OK" oXbpBok:TabStop := .T. oXbpBok:create() oXbpBok:activate := {|| PostAppEvent( xbeP_Close ) } oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC cString := "ESC" PostAppEvent( xbeP_Activate,,, oXbpBok ) CASE mp1 == xbeK_RETURN .OR. mp1 == xbeK_F10 cString := "!" PostAppEvent( xbeP_Activate,,, oXbpBok ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) RETURN Trim( cString ) ////16.03.2023 16:45 vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ////FUNCTION ModalFen( cString, cTitle, oDlg1, nXsize, nYsize ) //FUNCTION ListboxFenster( aInditxt, oDlg1, cFormName) // LOCAL nEvent, mp1, mp2, oXbp, lExit // LOCAL oDlgLF, oFocus, aPos //, drawingArea // LOCAL drawingArea := oDlg1:drawingArea, oDlgDA //* 16.03.2023 18:34 oDlgDA // LOCAL aSize := drawingArea:currentSize() // LOCAL nXsize := ASize[1]*0.6 // LOCAL nYsize := ASize[2]*0.8 // LOCAL nText := 0 // LOCAL cTitle := "W„hlen Sie eine Formularart aus ! - (Edit mit ALT-Taste)" // oDlg1 := IIf( oDlg1<>NIL, oDlg1, AppDesktop() ) // // drawingArea := oDlg1:drawingArea //* // aSize := drawingArea:currentSize() // // aPos := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize+20 ) / 2 } // // oDlgLF := AKDialog():new( AppDesktop(), oDlg1, aPos, {nXsize,nYsize} ) // oDlgLF:title := cTitle // oDlgLF:taskList := .T. // oDlgLF:minButton := .F. // oDlgLF:maxButton := .F. // oDlgLF:create() // oDlgLF:lockupdate(.T.) //+27.11.2011 09:20 // oDlgDA = oDlgLF:drawingArea // oDlgDA:setColorBG( GRA_CLR_YELLOW ) // // oFocus := SetAppFocus( oDlgLF ) // // aSize := oDlgDA:currentSize() // oListBox := XbpListBox():new( oDlgDA,,{Int(12*nV),Int(12*nV)},{aSize[1]-Int(20*nV),aSize[2]-Int(20*nV)}) // Sleep(2) //+16.08.2012 10:56 Vista-Problem ! // oListBox:setFontCompoundName( cBFont ) // oListBox:create() // Sleep(2) //+16.08.2012 10:56 Vista-Problem ! // // FOR i := 1 TO Len(aInditxt) // oListBox:addItem(ConvToOEMCP(aInditxt[i])) //// oListBox:addItem(aInditxt[i]) // Sleep(2) //+23.02.2010 08:58 Vista-Problem ! // NEXT ////++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // oListBox:setData( {1}, .T. ) // // // oDlgLF:lockupdate(.F.) //+27.11.2011 09:20 // oDlgLF:invalidateRect() //+27.11.2011 09:30 // // oDlgLF:setModalState( XBP_DISP_APPMODAL ) // oDlgLF:show() // SetAppFocus(oListBox) // // nEvent := xbe_None // DO WHILE nEvent <> xbeP_Close // nEvent := AppEvent( @mp1, @mp2, @oXbp ) //// IF nEvent == xbeM_LbDown //// nText := oXbp:cargo //// ENDIF // // IF nEvent == xbeM_LbDblClick .and. oXbp:isDerivedFrom( "XbpListBox" ) // cFormName := oListBox:getItem( oListBox:getData()[1] ) // nText := oListBox:getData()[1] // nEvent := xbeP_Close // ENDIF // IF nEvent == xbeM_LbClick .and. oXbp:isDerivedFrom( "XbpListBox" ) // cFormName := oListBox:getItem( oListBox:getData()[1] ) // nText := oListBox:getData()[1] // nEvent := xbeP_Close // ENDIF //// IF nEvent == xbeP_User //// cFormName := oListBox:getItem( oListBox:getData()[1] ) //// nText := oListBox:getData()[1] //// ENDIF // // IF nEvent == xbeP_Keyboard // DO CASE // CASE mp1 == xbeK_ESC // cString := "ESC" // cFormName := "" // nText := 0 //oListBox:getData()[1] // nEvent := xbeP_Close // CASE mp1 == xbeK_RETURN .OR. mp1 == xbeK_F10 // cString := "!" // cFormName := oListBox:getItem( oListBox:getData()[1] ) // nText := oListBox:getData()[1] // nEvent := xbeP_Close // CASE mp1 == xbeK_DOWN //.and. oXbp:isDerivedFrom( "XbpListBox" ) // // PostAppEvent( xbeP_User ) // CASE mp1 == xbeK_UP //.and. oXbp:isDerivedFrom( "XbpListBox" ) // // PostAppEvent( xbeP_User ) // ENDCASE // ENDIF // oXbp:handleEvent( nEvent, mp1, mp2 ) // ENDDO // // oDlgLF:setModalState( XBP_DISP_MODELESS ) // //// oListBox:destroy() // sleep(5) // oDlgLF:destroy() //// SetAppFocus( oFocus ) //RETURN nText ////^^ListboxFenster^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ // FUNCTION Bs( cFeld ) cBs1 := "{|x| IIf( PCOUNT()==0, Trim(" cBs2 := ")," cBs3 := ":= x ) }" cBs := cBs1+cFeld+cBs2+cFeld+cBs3 RETURN cBs **KHSuche.prg - Suche des Sterbeortes in der Bestattungsverwaltung // aus der Datei der Versicherungs-Adressen FUNCTION Krankenhaus( cVerskz, oDlg1, cVerst0, cVerst1, cVerst2, cVerst3, lSoft ) LOCAL oDlg, nEvent, mp1, mp2, oSle, oPbSuch, oXbp LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: LOCAL nH := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nV := nBSh/600 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nOldArea := Select() LOCAL lFlucht := .F. LOCAL cSuch, oCB //27.11.2022 18:35 DEFAULT cVerskz TO "KH " DEFAULT lSoft TO .F. //27.11.2022 11:06 SoftSeek ausschalten IF Upper(cVerskz) = "KH" cTitle := "Krankenhaus-Adressen suchen" ELSEIF Upper(cVerskz) = "KRE" cTitle := "Krematorium suchen" ELSEIF Upper(cVerskz) = "FH" cTitle := "Friedhof suchen" ELSE cTitle := "Adresse suchen" ENDIF // cVerskz := Upper( IIf( Len( cVerskz ) = 0, cVerskz := "KH", cVerskz ) ) SELECT 5 IF Len(cVerskz)>5 //27.11.2022 18:35 fr Auswahlfenster nach (Teilen von) 5->Name1/2 // cVerskz += " " cSuch := IIf(" "$cVerskz, Upper(SubStr(cVerskz,1,At(" ",cVerskz))), cVerskz) DbSetFilter( {|| cSuch $ Upper(5->name1 + 5->name2) } ) DbGotop() ELSE IF lSoft DbSeek( cVerskz, .T. ) //27.11.2022 11:05 SoftSeek eingeschaltet ELSE FIND &cVerskz // wie bisher (vor 27.11.2022 18:39) ENDIF ENDIF // cFont := IIf( nBSb < 700, "8.Arial", "10.Arial" ) oDlg := AKDialog():new( AppDesktop(), oDlg1 ) oDlg:tasklist := .T. oDlg:title := "Krankenhaus-Adressen suchen:" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10,10}, {int(770*nH),int(500*nV)} ) // oDlg:drawingArea:setFontCompoundName( cFont ) oDlg:drawingArea:setColorBG( GRA_CLR_BLUE ) oCB := oDlg:drawingArea APPBROWSE ; PARENT oDlg:drawingArea ; POSITION TOP ; FONT &cFont ; SIZE 100,100 PERCENT APPFIELD verskz CAPTION "Kennz" WIDTH 5 APPFIELD name1 CAPTION "Name1" WIDTH 15 APPFIELD name2 CAPTION "Name2" WIDTH 15 APPFIELD strasse CAPTION "Straáe" WIDTH 15 APPFIELD plz_ort CAPTION "PLZ Ort" WIDTH 15 APPFIELD tel CAPTION "Telefon" WIDTH 10 APPFIELD abrname CAPTION "Name in der Aufstellung" WIDTH 20 APPFIELD gruppe CAPTION "Gruppe" WIDTH 2 APPDISPLAY MODELESS oFocus := SetAppFocus( ) oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick 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 oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() SetAppFocus( oFocus ) IF lFlucht == .F. cVerst0 := Trim(5->verskz) cVerst1 := Trim(5->name1) cVerst2 := Trim(5->strasse) IF (cVerst0 = "FH" .OR. cVerst0 = "KRE") .AND. Val(5->plz_ort) > 0 cVerst3 := Trim(SubStr(5->plz_ort,At(" ",5->plz_ort)+1)) ELSE cVerst3 := Trim(5->plz_ort) ENDIF ENDIF 5->(DbClearFilter()) Select &nOldArea RETURN .T. FUNCTION Ansprech( oDlg, aEditcontrols, nXehe, nYehe ) XbpObjekt(aEditcontrols,"ANSP_NAME"):setdata( XbpObjekt(aEditcontrols,"NAME"):getdata() ) XbpObjekt(aEditcontrols,"ANSP_STR"):setdata( XbpObjekt(aEditcontrols,"STRASSE"):getdata() ) XbpObjekt(aEditcontrols,"ANSP_ORT"):setdata( XbpObjekt(aEditcontrols,"PLZ_ORT"):getdata() ) RETURN aEditcontrols FUNCTION BestSuch( cSuch, cAuf, oDlg1, cDateiFeld ) LOCAL oDlg, nEvent, mp1, mp2 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 // 13.07.2024 11:38 statt Vorzeile die beiden Nachzeilen (wg Baumann-Curve-Monitor) LOCAL nH := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nV := nBSh/600 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nOldArea := Select() LOCAL lFlucht := .F. PRIVATE oCB PRIVATE cDatei := Alias(1) PRIVATE cVariable := cDateiFeld //+18.09.2018 14:06 DO CASE CASE Upper(Substr(cSuch,1,2)) = "V " SELECT 11 USE (cDatei) cIndex := IIf(Upper(cDatei)="V",("xvname"),("xname")) SET INDEX TO (cIndex) CASE Upper(Substr(cSuch,1,2)) = "V_" SELECT 11 USE (cDatei) cIndex := IIf(Upper(cDatei)="V",("xvname"),("xnamevor")) SET INDEX TO (cIndex) // INDEX ON Upper(name+vorname) TO C:\HDBE\btemp CASE Upper(Substr(cSuch,1,2)) = "A " SELECT 11 USE (cDatei) // INDEX ON Upper(ansp_name+ansp_vname) TO C:\HDBE\btemp SET INDEX TO xanspnam //+18.09.2018 14:02 CASE Upper(Substr(cSuch,1,2)) = "A_" SELECT 11 USE (cDatei) // INDEX ON Upper(ansp_name+ansp_vname) TO C:\HDBE\btemp SET INDEX TO xanspvor //+18.09.2018 14:02 CASE Upper(Substr(cSuch,1,2)) = "S " .OR. Upper(Substr(cSuch,1,2)) = "S_" SELECT 11 USE (cDatei) // INDEX ON Upper(strasse+plz_ort) TO C:\HDBE\btemp SET INDEX TO xstrasse //+18.09.2018 14:02 //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //+18.09.2018 21:20 Feldsuche nach dem Feld des vorigen Focus : CASE Upper(Substr(cSuch,1,2)) = "F " .OR. Upper(Substr(cSuch,1,2)) = "F_" /*02.05.2025 18:36 ist vielleicht bei SSDs nicht mehr n”tig? DO WHILE oThread_BI:active // damit die Puffer-Fllung abgewartet wird sleep(100) ENDDO*/ IF ValType(cVariable)!="C" msgbox("Markieren Sie vorher das Feld, nach dem Sie suchen!") RETURN cAuf ENDIF SELECT 11 USE (cDatei) IF ValType(11->&cVariable)=="D" cSuch := SubStr(cSuch,1,2)+DtoC(CtoD(SubStr(cSuch,3))) cSuch := SubStr(cSuch,1,2)+SubStr(cSuch,9,4)+SubStr(cSuch,6,2)+SubStr(cSuch,3,2) INDEX ON &("DtoS("+cVariable+")") TO C:\HDBE\btemp ELSEIF ValType(11->&cVariable)=="N" cSuch := StrTran(cSuch,",",".") cSuch := IIf(SubStr(cSuch,4,1)==".", SubStr(cSuch,1,2)+" "+SubStr(cSuch,3),cSuch) // damit ' 9.45' und nicht '9.45' INDEX ON &("Str("+cVariable+")") TO C:\HDBE\btemp ELSE IF Upper(cVariable)$"PLZ_ORT ANSP_ORT" .AND. Val(SubStr(cSuch,3))==0 //+30.10.2018 19:14 fr die Suche nach Orten die PLZ anh„ngen INDEX ON (SubStr(&("Upper("+cVariable+")"),7) + SubStr(&("Upper("+cVariable+")"),1,5)) TO C:\HDBE\btemp ELSE INDEX ON &("Upper("+cVariable+")") TO C:\HDBE\btemp ENDIF ENDIF // ordcreate("C:\HDBE\btemp",,"Upper("+cVariable+")") //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ CASE Asc(SubStr(cSuch,1,1)) > 64 //+26.11.2011 09:47 wenn der Name direkt eingegeben wurde: cSuch := "V "+cSuch SELECT 11 USE (cDatei) cIndex := IIf(Upper(cDatei)="V",("xvname"),("xname")) SET INDEX TO (cIndex) OTHERWISE //+23.11.2018 20:54 damit es kein Schlupfloch gibt SELECT 11 USE (cDatei) INDEX xauftrnr cSuch := cAuf ENDCASE GO TOP // cFont := IIf( nBSb < 700, "8.Arial", "10.Arial" ) oDlg := AKDialog():new( AppDesktop(), oDlg1 ) oDlg:tasklist := .T. oDlg:title := "Bestattungsfall suchen zu >" + cSuch +"<" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED // oDlg:create(,, {10,10}, {int(740*nV),int(450*nV)} ) oDlg:create(,, {10,10}, {int(770*nH),int(500*nV)} ) //13.07.2024 11:40 wg Baumann-Curve-Monitor // oDlg:drawingArea:setFontCompoundName( "8.Arial" ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea cKey := Upper(Substr(cSuch,1,1)) cSuch := Upper(Substr(cSuch,3,25)) SET SOFTSEEK ON FIND &cSuch SET SOFTSEEK OFF APPBROWSE ; PARENT oDlg:drawingArea ; POSITION TOP ; FONT &cFont ; SIZE 95,100 PERCENT DO CASE CASE cKey = "V" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 CASE cKey = "A" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Datum" WIDTH 6 APPFIELD ansp_name CAPTION "Name (Auftraggeber)" WIDTH 12 APPFIELD ansp_vname CAPTION "Vorname" WIDTH 10 APPFIELD ansp_str CAPTION "Straáe" WIDTH 12 APPFIELD ansp_ort CAPTION "Ort" WIDTH 12 CASE cKey = "S" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 CASE cKey = "F" APPFIELD auftrnr CAPTION "Auftrag" WIDTH 4 APPFIELD gestorben CAPTION "Datum" WIDTH 6 APPFIELD name CAPTION "Name (Verstorbener)" WIDTH 12 APPFIELD vorname CAPTION "Vorname" WIDTH 10 APPFIELD strasse CAPTION "Straáe" WIDTH 12 APPFIELD plz_ort CAPTION "Ort" WIDTH 12 APPFIELD &cVariable CAPTION &cVariable WIDTH 12 ENDCASE APPDISPLAY MODELESS oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeM_LbDblClick 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 oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() IF lFlucht = .F. // ESC-Taste: lFlucht = .T. cAuf := IIf(Upper(Alias(11))=="BEST",Str( 11->auftrnr,6,0 ),StrZero( 11->auftrnr,6,0 )) //29.08.2007 09:18 // cAuf := Str( 11->auftrnr,6,0 ) ENDIF USE SELECT 1 RETURN cAuf