**BRegieAS.prg - Regie-Zentrum // Suche von Anlieferern, nach beliebigem Feld #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Dmlb.ch" #include "Common.ch" //xbeP_User = 134217728 #define xbeU_RefreshHist xbeP_User + 1 #define xbeU_RefreshSuch xbeP_User + 2 #define xbeU_RefreshAnlief xbeP_User + 3 #define xbeU_RefreshScan xbeP_User + 4 #define xbeU_ShowHistDaten xbeP_User + 5 #define xbeU_ShowScan xbeP_User + 6 #define xbeU_RefreshPLZ xbeP_User + 7 #define xbeU_RefreshApp xbeP_User + 31 #define xbeU_ShowAnlief xbeP_User + 32 #define xbeU_RefreshRechng xbeP_User + 33 /* siehe: #define xbeP_User 134217728 */ //------------------------------------------ /* 24.06.2008 17:47 neue Thread-Klasse fr die Suchtabelle: */ CLASS SuchThrd FROM Thread EXPORTED: VAR producerID VAR terminated VAR nRec INLINE METHOD init() ::thread:init() ::producerID := ThreadID() ::terminated := .F. RETURN INLINE METHOD terminate() RETURN ::terminated := .T. EXPORTED: INLINE METHOD execute(a,b,c,d,e,f) AnliefSuche(a,b,c,d,e,f) RETURN self INLINE METHOD atStart() nRec := RecNo() RETURN self INLINE METHOD atEnd() nRec := RecNo() // Tone(1000) DbCloseAll() RETURN self ENDCLASS //------------------------------------------ /*25.06.2008 09:10 wird durch ::execute() im Such-Thread ausgefhrt und von oSignal aus Thread1 heraus gesteuert --> aPos und aSize werden unten ohnehin neu gesetzt! */ FUNCTION AnliefSuche( oDlg1, nRec, oSuchFeld ) LOCAL oDlg, nEvent, mp1, mp2, oXbp, oBrowse LOCAL oCtrl, oFocus := SetAppFocus(), aEditControls := {}, lFlucht LOCAL oHelp, oVideo //*11.07.2008 14:44 PRIVATE oCB, oASDA, oEdit, cVariable, cS := " ", nFontR := cBFont //*09.07.2008 15:10 ErrorBlock( {|e| FehlerBehandlung(e) } ) // e = Error-Objekt DO WHILE cS == " " Sleep(1) //+16.09.2012 22:51 /*29.06.2008 10:40 von :atstart() nach hierher verschoben: (Anlaufphase von oScrap abwarten!) */ DbSelectArea(11) DbUseArea( , "FOXCDX", "Anlief", , .T., .T. ) //+15.08.2012 15:09 letztes .T. == readOnly IF IsFieldVar(oSuchFeld:cargo) .AND. !oSuchFeld:isderivedfrom("XbpMle") //.AND. !oSuchFeld:cargo = "anummer" FErase( cDatver+"AnL_Temp.cdx" ) // damit der Index nicht nur berschrieben wird IF Upper(oSuchFeld:cargo) == "NAME" //+16.12.2009 20:29 //+16.09.2012 17:52 OrdCreate( "AnL_Temp", "x3", "NAME+VORNAME" ) // ->sortiert nach Vorname OrdListAdd( "ANLIEF" ) OrdSetFocus( "na" ) /* kontrollierender Index: na ist jetzt NAME+VORNAME*/ ELSE OrdCreate( "AnL_Temp", "x3", oSuchFeld:cargo ) OrdSetFocus( "x3" ) /* kontrollierender Index */ ENDIF cVariable := oSuchFeld:cargo ELSE OrdListAdd( "Anlief" ) OrdSetFocus( "an" ) /* kontrollierender Index */ cVariable := "anummer" ENDIF /**08.07.2008 10:12 msste berflssig sein, weil oDlg bereits im aufrufenden Thread ist **/ /*14.04.2008 19:25 nH, nV ver„ndert wegen Resize */ aPos := {oDlg1:currentpos()[1],oDlg1:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske ASize := {oDlg1:currentsize()[1],oDlg1:currentsize()[2] - ; IIf( oDlg1:isderivedfrom("XbpTabPage"), oDlg1:tabheight, 0 ) } //08.07.2008 18:19 /**/ /**/ oDlg := AKDialog():new( oDlg1, oDlg1:setparent() ) oDlg:tasklist := .T. oDlg:titlebar := .F. oDlg:sysmenu := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:lockUpdate(.T.) // damit der Bildaufbau unsichtbar bleibt 17.09.2012 09:32 oDlg:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) oCB := oDlg:drawingArea // fr alle F„lle oASDA := oDlg:drawingArea oASDA:cargo := oDlg aThrdFenster[3] := oDlg //+01.06.2009 09:26 3 statt 2 nBz := 23*nV //+31.07.2008 13:54 // jetzt folgt die Erzeugung der Eingabefelder oSuch := ASucheFF():new( oASDA,oASDA:cargo, {,}, {,},,, nBz, "s_such" , 0, 199, 11) /* jetzt ist oSuch:BEArea[1] == oASDA , also ist oSuch:BEArea[1]:cargo == oDlg !! */ oEdit := oSuch /* brauchen wir, weil oEdit in einigen Routinen steht... */ oSuch:CREATE( oASDA,oASDA:cargo, {,}, {,},,, nBz, "s_such" , 0, 199, 11) AEval( oSuch:editControls, {|x| oDlg:addEditControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder oCtrl := XbpGetController():new( oDlg ) oCtrl:create() oCtrl:READ( 1, .F. ) * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) oDlg:lockUpdate(.F.) // damit der Bildaufbau unsichtbar bleibt 17.09.2012 09:32 oDlg:invalidateRect() oSuch:nLastRec := LastRec() //*11.07.2008 10:20 DbGoto( nRec ) //+07.06.2009 11:12 hierher von oben nEvent := xbe_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF ThreadObject():terminated == .T. // mal sehen, ob das klappt... ThreadObject():atEnd() ThreadObject():QUIT() ENDIF IF nEvent == xbeU_RefreshSuch IF oSuch:nLastRec < LastRec() .OR. ; /*11.07.2008 10:21*/ (!Empty( mp2 ) .AND. !mp2:isderivedfrom("XbpMle") ; .AND. !mp2:isderivedfrom("XbpPushButton") .AND. Upper(mp2:cargo) != Upper(cVariable)) //+16.09.2012 22:51 cS := " " //+18.03.2009 10:04 berarbeitet wegen unerkl„rlichem Fehler beim DbUseArea(s_tak) in DialogFF:create DbGoto( nRec := mp1 ) oSuchFeld := IIf(mp2==NIL,oSuchfeld,mp2) IF Len(oSuch:BrowseFeld) > 0 .AND. mp2==NIL //+ nach dem Speichern aktualisieren //+16.09.2012 19:43 geREMt: // nRecH := RecNo() //+26.03.2009 10:05 // oSuch:BrowseFeld[1]:refreshAll() // DbGoto(nRecH) //+26.03.2009 10:05 aThrdFenster[3]:hide() //+17.09.2012 09:23 DbSkip(0) //+16.09.2012 19:43 um notify auszul”sung zum refreshAll() aThrdFenster[3]:show() //+17.09.2012 09:23 ELSE PostAppEvent( 1048632 ,,, aThrdFenster[3] ) //+01.06.2009 09:26 ENDIF //+// ELSE DbGoto( mp1 ) IF Len(oSuch:BrowseFeld) > 0 //+17.09.2012 09:42 geREMT: // nRecH := RecNo() //+26.03.2009 10:05 // oSuch:BrowseFeld[1]:refreshAll() // DbGoto(nRecH) //+26.03.2009 10:05 // aThrdFenster[3]:hide() //+17.09.2012 09:23 //+17.09.2012 09:45testhalber ->scheint zu klappen! DbSkip(0) //+16.09.2012 19:43 um notify auszul”sung zum refreshAll() // aThrdFenster[3]:show() //+17.09.2012 09:23 ELSE AlertBox( , "Klicken Sie auf OK!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Suchbereich neu aufbauen" ) //+15.11.2009 17:41 cS := " " nRec := mp1 oSuchFeld := IIf(mp2==NIL,oSuchfeld,mp2) PostAppEvent( 1048632 ,,, aThrdFenster[3] ) //+01.06.2009 09:26 ENDIF //+17.09.2012 09:47testhalber -> scheint zu klappen! wieder aktiviert am 24.09.2012 09:37 doppelte Zeilen in der Suchtabelle sind dadurch wieder weg! oDlg:invalidateRect() ENDIF ENDIF IF nEvent == xbeM_LbDblClick PostAppEvent( xbeU_RefreshAnlief, RecNo(),, aThrdFenster[2]) //+01.06.2009 09:27 ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .AND. oXbp:isDerivedFrom("XbpBrowse") PostAppEvent( xbeU_RefreshAnlief, RecNo(),, aThrdFenster[2]) //+01.06.2009 09:27 CASE mp1 == xbeK_ESC cS := "S" cS := " " // damit das Programm nicht abbricht CASE mp1 == xbeK_CTRL_F2 //+27.06.2009 18:46 ScreenDump Win_Clip_File(AppDeskTop(),cDatver+"CLIPS\S_"+Left(Time(),2)+SubStr(Time(),4,2)+Right(Time(),2) ) LOOP CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_AS.dbf"), "Bedienungshinweise", oASDA, 680*nH, 460*nV ) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient() // 20.5.2004, damit kein Painttip mehr durch :notify() oDlg:destroy() oSuch:destroy() DbCloseArea() DO WHILE nEvent <> xbe_None nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO ENDDO SetAppFocus( oFocus ) IF lFlucht == .F. // ESC-Taste: lFlucht = .T. ELSE ENDIF FErase( cDatver+"Anl_Temp"+".cdx" ) RETURN .T. CLASS ASucheFF FROM DialogFF EXPORTED: VAR VArea VAR cSuche //*09.07.2008 13:14 Suchfeld zur Eingabe im SuchTab VAR nLastRec //*11.07.2008 10:19 LastRec(), wenn mp1 > nLastRec, dann neu indizieren! VAR cAuskunftsDatei //+06.06.2011 16:49 zum Zwischenspeichern METHOD INIT METHOD CREATE METHOD notify METHOD AFSuch METHOD GoAbrech //+12.07.2010 10:02 siehe auch in BestP() ENDCLASS METHOD ASucheFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::Fancy := "" //* 12.07.2008 12:51 cSerieBM ::VArea := nA ::cSuche := "" ::aStructure := (nA)->(DbStruct()) AEval( ::aStructure, {|a| AAdd( ::aFelder, a[1] ) } ) ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) RETURN self METHOD ASucheFF: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 ASucheFF: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[1]:refreshAll() // NEXT // (::VArea)->(DbGoto( nRec )) (::VArea)->(DbResetNotifications()) ENDIF ENDIF ENDIF RETURN self //+26.03.2009 10:05 neues Suchen mit neuem refreshall() (nRecH!) METHOD ASucheFF:AFSuch( ) LOCAL cSuch := ::XbpObjekt(,"csuche"):getData(), nRecH DbSuspendNotifications() DbSeek(Trim(cSuch),.T.) nRecH := RecNo() IIf(Len(::BrowseFeld)>0,::BrowseFeld[1]:refreshAll(),) DbGoto(nRecH) DbResumeNotifications() RETURN self //+12.07.2010 09:45 ruft die Abrechnung auf METHOD ASucheFF:GoAbrech() IF cBK != 11->benutzer .AND. !Empty(11->benutzer) //+18.08.2012 22:31 23.09.2012 22:29 AlertBox( , "Dieser Anlieferer ist fr "+11->benutzer+" reserviert!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",GRA_CLR_CYAN) RETURN self ELSEIF "//alt//" $ 11->zusatz .AND. !11->benutzer $ "MD YYY" AlertBox( , "Diese Abrechnungen darf nur MD „ndern!;" + ; ";", ; { "OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$11->zusatz .OR. "//gesperrt//"$11->zusatz,GRA_CLR_RED,)) //+11.07.2010 21:32 RETURN self ELSEIF "//alt//" $ 11->zusatz .AND. 11->benutzer $ "MD YYY" .AND. ; AlertBox( , "Dieser Lieferant ist als ALT markiert!!;" + ; ";", ; { "JA", "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$11->zusatz .OR. "//gesperrt//"$11->zusatz,GRA_CLR_RED,)) = 2 //+11.07.2010 21:32 RETURN self ELSEIF "//gesperrt//" $ 11->zusatz .AND. ; AlertBox( , "Dieser Lieferant ist als gesperrt markiert!!;" + ; ";", ; { "JA", "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Abrechnung aufrufen?",IIf("//alt//"$11->zusatz .OR. "//gesperrt//"$11->zusatz,GRA_CLR_RED,)) = 2 //+11.07.2010 21:32 RETURN self ENDIF IF 11->name[1]<"A" .OR. 11->ausw_nr[1]<"0" .OR. DtoC(11->ausw_scn_v)=" " AlertBox(,"Legitimation: Name, Ausw-Nr oder Scandatum fehlt",,,"A C H T U N G !") ENDIF aThrdFenster[2]:hide() // PostAppEvent( 134217759,6,1->anummer, aThrdFenster[1])}) } PostAppEvent( xbeU_RefreshApp,6,11->anummer, aThrdFenster[1]) RETURN self