/*//+das wird die neue PLZ() : 13.10.2008 14:21 */ #include "Gra.ch" #include "Xbp.ch" #include "Dmlb.ch" #include "Common.ch" #include "Appevent.ch" #include "AKDialog.ch" #include "Dll.ch" #include "Thread.ch" #define xbeU_RefreshPLZ xbeP_User + 7 #define xbeU_RefreshTIP xbeP_User + 8 //+ setzt die Eingaben von bisheriger Function PLZ() um: //+ oFocSle ist PRIVATE der Hauptmaske (bestp()) PROCEDURE PLC(cstr,cort,cplz) LOCAL aInfo := ThreadInfo( THREADINFO_FUNCINFO + THREADINFO_TID ) LOCAL lThreadIstAktiv := .F. IF !Empty( oBest:oPLZThrd ) AEval( aInfo, {|a,i| IIf( a[1] == oBest:oPLZThrd:threadid .AND. a[3] != NIL, ; lThreadIstAktiv := .T.,) } ) ENDIF IF !lThreadIstAktiv oBest:oPLZThrd := PLZThrd():new() oBest:oPLZThrd:start( ,cstr, cort, cplz, oFocSle ) oBest:oPLZThrd:setInterval(NIL) ELSE //+ dabei ist aPos und aSize egal, weil das Fenster ja schon existiert! : oBest:oPLZThrd:start( ,cstr, cort, cplz, oFocSle ) oBest:oPLZThrd:setInterval(NIL) ENDIF RETURN //++// CLASS PLZThrd FROM Thread EXPORTED: VAR producerID VAR terminated VAR nAold // die Area, von der ausgegangen wird VAR cStrSuch // gewandelte Strae fr DbSeek() 20.10.2008 21:31 VAR cStrasse // der Wert im Straenfeld ohne Hausnummer VAR cStrlang // Korrektur wegen Strae statt Str. VAR cHausnr // die Hausnummer im Straenfeld VAR cPLZ // der Wert im PLZ-Feld VAR cOrt // der Wert im Ort-Feld VAR cPLZ2 // die obere Grenze des PLZ-Bereiches eines Ortes VAR cPLZneu // die PLZ, die vielleicht die neue wird VAR lStrasse // die Strae wurde als Letztes verndert = danach suchen VAR lPLZ // die PLZ wurde als Letztes verndert = danach suchen VAR lOrt // der Ort wurde als Letztes verndert = danach suchen VAR lPlzOrt // PLZ und Ort zusammen oder in getrennten Feldern VAR lNeueStrasse // die Strae soll neu bei diesem Ort hinzugefgt werden VAR lNeuerOrt // der Ort soll neu hinzugefgt werden (bisher nicht in Datei) VAR lDieserOrt // Hilfsvariable VAR lAndererOrt // Hilfsvariable VAR lAction // .F. = nichts getan, Eingabefelder unverndert lassen INLINE METHOD init() ::thread:init() ::producerID := ThreadID() ::lAction := .T. ::terminated := .F. ::lNeueStrasse := .F. RETURN INLINE METHOD terminate() RETURN ::terminated := .T. EXPORTED: INLINE METHOD execute(a,b,c,d,e,f) LOCAL nAt ::PLZMain(a,b,c,d,e,f) IF ::lAction nAt := At("tr.",::cStrasse) IIf(::cStrlang != NIL .AND. nAt>0, ::cStrasse := Stuff(::cStrasse,nAt,3,::cStrlang),) IF ::lPlzOrt PostAppEvent( xbeU_RefreshPLZ, {::cStrasse+" "+::cHausNr,::cPLZ+" "+::cOrt},, aThrdFenster[2]) ELSE PostAppEvent( xbeU_RefreshPLZ, {::cStrasse+" "+::cHausNr,::cOrt,::cPLZ},, aThrdFenster[2]) ENDIF ELSE // damit wieder richtig gefokust wird PostAppEvent( xbeU_RefreshPLZ,,, aThrdFenster[2]) ENDIF RETURN self METHOD PLZMain METHOD PLZausORT METHOD ORTausPLZ METHOD PLZausHAUSNR METHOD Such METHOD NeueStrasse METHOD Eingabe METHOD PLZNeu METHOD atStart METHOD atEnd ENDCLASS //+ 2 Versionen in einer: PLZ und ORT als getrennte Felder (wie in ScrapX) oder //+ PLZ und ORT als ein Feld (wie z.B. beim Bestattungsprogramm) //+23.09.2008 21:03 holt die PLZ zu Strae+Ort, bzw. den Ort zur PLZ METHOD PLZThrd:PLZMain( cStrasse, cOrtX, cPLZX, oFocSle ) PRIVATE nFontR := cBFont IF "trae"$cStrasse ::cStrlang := "trae" cStrasse := Stuff(cStrasse,At("ae",cStrasse),3,".") //+26.08.2008 21:04 ELSEIF "trasse"$cStrasse ::cStrlang := "trae" cStrasse := Stuff(cStrasse,At("asse",cStrasse),4,".") //+23.09.2008 21:03 ENDIF //+ gibt an, ob PLZ und ORT in einem Feld sind (=.T.): ::lPlzOrt := IIf(Upper(AppName())$"SCRAPX.EXE",.F.,.T.) //+ getrennte Felder fr PLZ + Ort //+ der Satz der Variablen: die jetzigen Werte: (cStrasse,cHausnr,cPLZ,cOrt), alle ALLTrim()! ::cHausnr := Hausnummer(@cStrasse) //+ dabei wird cStrasse um die Nummer gekrzt und geALLtrimmt ::cStrasse := cStrasse ::cStrSuch := Wandel(cStrasse) //+20.10.2008 21:31 ::cPLZ := Trim(IIf(!Empty(cPLZX), Trim(cPLZX), IIf(Val(cOrtX)=0,"",StrX(Val(cOrtX),5,0)) )) //+23.09.2008 21:17 ::cPLZneu := ::cPLZ //+ wird vielleicht als neue PLZ gebraucht ::cOrt := ORTohnePLZ(cOrtX) //+23.09.2008 21:21 ist schon getrimmt! //+ welches Feld ist verndert worden?: (immer das, aus dem man hierher kommt: oFocSle) ::lStrasse := IIf( "STR"$Upper(oFocSle:cargo), .T., .F. ) ::lPlz := IIf( !::lPlzOrt, IIf( "PLZ"$Upper(oFocSle:cargo), .T., .F. ), ; IIf( "ORT"$Upper(oFocSle:cargo), ; IIf( Val(oFocSle:vorigerwert) != Val(::cPLZ) .AND. Val(::cPLZ)!=0 .AND. ; ORTohnePLZ(oFocSle:vorigerwert) = ::cOrt, ; .T., .F. ), .F. ) ) ::lOrt := IIf( !::lPlzOrt, IIf( "ORT"$Upper(oFocSle:cargo), .T., .F. ), ; IIf( "ORT"$Upper(oFocSle:cargo), ; IIf( ORTohnePLZ(oFocSle:vorigerwert) != ::cOrt .AND. ; Len(::cOrt)>0 .AND. !::lPlz, ; .T., IIf(!::lStrasse .AND. !::lPlz, .T., .F. ) ), .F. ) ) //+ wenn in einem intakten System der Ort gelscht wurde...: IF !::lStrasse .AND. !::lPLZ .AND. (!::lOrt .OR. Len(::cOrt)=0) .AND. Val(::cPLZ)>0 ::lPLZ := .T. ENDIF ::lAndererOrt := IIf(Len(::cOrt)>0 .AND. ::cOrt[1]=="+",.T.,.F.) ::lDieserOrt := IIf( (IsMemVar("cStadt") .AND. cStadt == ::cOrt) .OR. ; Upper(::cOrt)$"OBERHAUSEN", .T., .F. ) //+27.10.2008 17:58 IIf(Len(::cOrt)>0 .AND. ::cOrt[1]=="+", ::cOrt := SubStr(::cOrt,2),) DO CASE //+ Ausgangspunkt ist ein Straen-Feld: CASE ::lStrasse IF Len(::cPLZ)==0 .AND. Len(::cOrt)==0 //+ PLZ und Ort sind leer -> keine Aktion mglich: ::lAction := .F. RETURN self ELSEIF Len(::cPLZ)==0 //+ fehlende PLZ muss zu gegebenem Ort gesucht werden: ::PLZausORT() ELSEIF Len(::cOrt)==0 //+ fehlender Ort muss zu gegebener PLZ gesucht werden: ::ORTausPLZ() ELSE //+ PLZ und Ort sind vorhanden, was soll gesucht werden?? //+ Annahme: Weil Strae verndert wurde, wird nach neuer PLZ gesucht: ::PLZausORT() ENDIF //+ Ausgangspunkt ist ein PLZ-Feld, bzw. bei einem PLZ+Ort-Feld wurde gerade die PLZ verndert: CASE ::lPLZ IF Len(::cStrasse)==0 .AND. Len(::Ort)==0 //+ Strae und Ort sind leer -> es kann der Ort gesucht werden ::ORTausPLZ() ELSEIF Len(::cOrt)==0 //+ fehlender Ort muss zu gegebener PLZ gesucht werden, unter Bercksichtigung der Strae ::ORTausPLZ() ELSEIF Len(::cStrasse)==0 //+ fehlende Strae -> es kann der Ort gesucht werden ::ORTausPLZ() ELSE //+ Strae und Ort sind vorhanden, was soll gesucht werden??: //+ Annahme: Weil PLZ verndert wurde, wird nach neuem Ort gesucht: ::ORTausPLZ() ENDIF //+ Ausgangspunkt ist ein Ort-Feld, bzw. bei einem PLZ+Ort-Feld wurde gerade der Ort verndert: CASE ::lOrt IF Len(::cStrasse)==0 .AND. Len(::cPLZ)==0 //+ Strae und PLZ sind leer -> es kann versucht werden, die PLZ zu suchen ::PLZausORT() ELSEIF Len(::cPLZ)==0 //+ fehlende PLZ muss zu gegebenem Ort gesucht werden, unter Bercksichtigung der Strae: ::PLZausORT() ELSEIF Len(::cStrasse)==0 //+ fehlende Strae -> es kann PLZ und Ort abgeglichen/berprft werden //+ Annahme: Weil Ort verndert wurde, wird nach neuer Plz gesucht: ::PLZausORT() ELSE //+ Strae und PLZ sind vorhanden, was soll gesucht werden??: //+ Annahme: Weil Ort verndert wurde, wird nach neuer Plz gesucht: ::PLZausORT() ENDIF ENDCASE RETURN self METHOD PLZThrd:atStart() SetLexRule({ {"", "ue"}, ; // -> ue {"", "oe"}, ; // -> oe {"", "ae"}, ; // -> ae {"", "UE"}, ; // -> UE {"", "OE"}, ; // -> OE {"", "AE"}, ; // -> AE {"", "SS"}, ; // -> ss { "." , ""}, ; // Punkt -> "" { "-" , ""}, ; // Bindestrich -> "" {" " , "" } } ) // Leerzeichen -> "" SET LEXICAL ON DbUseArea( .T., "FOXCDX", "PlzOrt", "po" ) //+ selektiert auch gleich die neue Area! OrdListAdd( "PlzOrt" ) // .. OrdSetFocus( "o" ) // .. DbUseArea( .T., "FOXCDX", "PlzStr", "pr" ) OrdListAdd( "PlzStr" ) OrdSetFocus( "ps" ) RETURN self METHOD PLZThrd:atEnd() pr->(DbCloseArea()) po->(DbCloseArea()) SET LEXICAL OFF ThreadObject():QUIT() RETURN self METHOD PLZThrd:PLZausORT() //+ Ort ist gegeben und !="", Strae KANN gegeben u/o wichtig sein LOCAL nOldArea := SELECT() DbSelectArea("po") po->(DbSeek(PadR(::cOrt,Len(po->ort)),.F.,"o")) IF po->(Eof()) AlertBox( , "Zu diesem Ort ist keine PLZ vorhanden", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "ACHTUNG" ) //+15.11.2009 17:41 ::lAction := .F. SELECT &nOldArea RETURN self ENDIF ::cPLZ := Trim(po->plz) po->(DbSkip()) IF Upper(::cOrt) != Upper(Trim(po->ort)) //+ wenn in der nchsten Zeile ein anderer Ortsname steht po->(DbSkip(-1)) //+ berflssig? RETURN self //+ dann steht in ::cPLZ eine eindeutige PLZ ELSEIF Upper(::cOrt) == Upper(Trim(po->ort)) //+ Ort hat mehrere PLZ DO WHILE Upper(::cOrt) == Upper(Trim(po->ort)) .AND. !po->(Eof()) po->(DbSkip()) IF SubStr(::cPLZ,1,2) != SubStr(po->plz,1,2) .AND. ; !IIf(::cOrt$"Berlin-Hamburg-Mnchen-Frankfurt-Kln", ; Upper(::cOrt) == Upper(Trim(po->ort)),.F.) //+ wenn ein anderer PLZ-Bereich gefunden wird IF !::lAndererOrt .AND. (Upper(::cOrt) != Upper(Trim(po->ort)) .OR. ::lDieserOrt) //+lDieserOrt=>im Suchdialog ausgesuchter Ort mit mehreren PLZ po->(DbSkip(-1)) //+ zum eingegrenzten Ort zurckgehen ::cPLZ2 := Trim(po->plz) //+ obere PLZ-Grenze zu diesem Ort EXIT ELSE //+ 03.10.2008 12:05: Suchroutine aufrufen, um den richtigen Ort zu markieren ::lAndererOrt := .F. po->(DbSkip(-1)) //+ zurck zum ersten Ort mit dem gegebenen Namen IF ::Such( , "s_plz", 100, 109, SELECT(), RecNo(),{10*nH,30*nV},{425*nH,200*nV},, ; "Ort auswhlen! =abbrechen" ) //+03.10.2008 10:41 //+ wenn mit Esc abgebrochen: (also kein Ort ausgewhlt) ::lAction := .F. SELECT &nOldArea RETURN self ELSE //+ d.h., wenn ein Ort ausgewhlt: //+03.10.2008 12:05 ::cOrt := Trim(po->ort) IF po->plz_str == "1" // Ort hat nur eine PLZ ::cPLZ := Trim(po->plz) SELECT &nOldArea RETURN self ELSE // Ort hat mehrere PLZ, Straen-abhngig IF SubStr(::cPLZ,1,2) == SubStr(po->plz,1,2) //+ der ursprngliche Ort po->(DbSeek(::cPLZ,.F.,"p")) po->(DbSkip()) ::lDieserOrt := .T. //+im Suchdialog ausgesuchter Ort mit mehreren PLZ LOOP ELSE //+ anderer als der ursprngliche Ort ::cPLZ := Trim(po->plz) //+ neuer Startwert fr die Scope po->(DbSeek(::cPLZ,.F.,"p")) po->(DbSkip()) lDieserOrt := .T. //+im Suchdialog ausgesuchter Ort mit mehreren PLZ LOOP ENDIF ENDIF EXIT ENDIF ENDIF ENDIF ENDDO IIf(Empty(::cPLZ2), ::cPLZ2 := ::cPLZ, ) //+ fr alle Flle! IF Len(Trim(::cStrSuch)) > 0 ::PLZausHAUSNR() IF ::lNeueStrasse ::NeueStrasse("Strae passt nicht zum Ort!") ENDIF ENDIF ENDIF SELECT &nOldArea RETURN self METHOD PLZThrd:ORTausPLZ() //+ PLZ ist gegeben und !="", Strae KANN gegeben u/o wichtig sein LOCAL nOldArea := SELECT(), cIndexname IF Len(Trim(::cPLZ)) = 0 //+22.10.2008 13:24 PLZ ist leer... AlertBox( , "Geben Sie eine PLZ ein oder suchen Sie mit dem Ortsnamen!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "PLZ ist leer!" ) //+15.11.2009 17:41 ::lAction := .F. //+ wenn mit Esc abgebrochen: (also kein Ort ausgewhlt) RETURN self ENDIF DbSelectArea( "po" ) cIndexname := OrdSetFocus( "p" ) po->(DbSeek(::cPlz,.F.,"p")) IF po->(Eof()) AlertBox( , "berprfen Sie die Schreibweise!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "PLZ ist nicht verzeichnet!" ) //+15.11.2009 17:41 po->(DbSeek(::cPlz,.T.,"p")) IF ::Such( , "s_plz" , 100, 109, SELECT(), RecNo(),{10*nH,30*nV},{425*nH,200*nV},, ; "Ort auswhlen! =abbrechen" ) //+03.10.2008 10:41 ::lAction := .F. //+ wenn mit Esc abgebrochen: (also kein Ort ausgewhlt) SELECT &nOldArea OrdSetFocus( cIndexname ) // .. RETURN self ENDIF ENDIF IF po->plz_str == "1" //+ Ort ist NICHT in der PlzStr.dbf, hat also nur 1 PLZ ::cPLZ := Trim(po->plz) //+ ist doch berflssig, oder? ::cOrt := Trim(po->ort) //+ der erste Ort mit dieser PLZ po->(DbSkip()) IF ::cPLZ != Trim(po->plz) // PLZ ist eindeutig dem Ort zugewiesen ELSEIF Upper(::cOrt) != Upper(Trim(po->ort)) //PLZ nicht eindeutig, d.h. nchster Ort hat dieselbe PLZ po->(DbSkip(-1)) IF ::Such( , "s_plz" , 100, 109, SELECT(), RecNo(),{10*nH,30*nV},{425*nH,200*nV},, ; "Ort auswhlen! =abbrechen" ) //+03.10.2008 10:41 ::lAction := .F. //+ wenn mit Esc abgebrochen: (also kein Ort ausgewhlt) ELSE ::cPLZ := Trim(po->plz) ::cOrt := Trim(po->ort) // das ist der auserwhlte Ort ENDIF ENDIF ELSEIF po->plz_str == "2" //+ Ort mit mehreren PLZ, also eindeutige Zuordnung zu dieser PLZ: (Strae prfen!) ::cPLZ := Trim(po->plz) //+ ist doch berflssig, oder? ::cOrt := Trim(po->ort) //+ obere PLZ-Grenze suchen: DO WHILE Upper(::cOrt) == Upper(Trim(po->ort)) .AND. !po->(Bof()) po->(DbSkip(-1)) IF SubStr(::cPLZ,1,2) != SubStr(po->plz,1,2) .OR. Upper(::cOrt) != Upper(Trim(po->ort)) po->(DbSkip()) ::cPLZ := Trim(po->plz) EXIT ENDIF ENDDO //+ untere PLZ-Grenze suchen: DO WHILE Upper(::cOrt) == Upper(Trim(po->ort)) .AND. !po->(Eof()) po->(DbSkip()) IF SubStr(::cPLZ,1,2) != SubStr(po->plz,1,2) .OR. Upper(::cOrt) != Upper(Trim(po->ort)) po->(DbSkip(-1)) ::cPLZ2 := Trim(po->plz) EXIT ENDIF ENDDO IF Len(Trim(::cStrSuch)) > 0 ::PLZausHAUSNR() IF ::lNeueStrasse ::NeueStrasse("Strae passt nicht zur PLZ!") ENDIF ENDIF ENDIF OrdSetFocus( cIndexname ) // .. SELECT &nOldArea RETURN self METHOD PLZThrd:PLZausHAUSNR() LOCAL aI2 := {}, nI2 := 1, nTypN := 0, nTypG := 0, nTypU := 0 LOCAL nOldArea := SELECT(), cIndexname // ab hier ist der Ort eingegrenzt durch seinen kompletten PLZ-Bereich: //+ jetzt ist der Anfangs- und der Endwert der Scope gefunden worden ... //+ ... und die Suche kann in der PlzStr.dbf fortgesetzt werden: DbSelectArea("pr") cIndexname := OrdSetFocus( "ss" ) // das ist jetzt die Ordnung nach str_such+PLZ ! // d.h. alle gleichen Straen einer Stadt sind hintereinander // geordnet von ::cPLZ bis ::cPLZ2 DbSeek(PadR(::cStrSuch,46)+::cPLZ,.T.) //+ Softseek liefert normalerweise kein Eof(), deshalb: IF pr->plz > ::cPLZ2 .OR. ::cStrSuch != Trim(pr->str_such) //+ wenn PLZ auerhalb der Stadt und/oder Straennamen nicht gefunden: ::lNeueStrasse := .T. // damit neue Strae angelegt werden kann ELSEIF ::cPLZ <= pr->plz .AND. ::cPLZ2 >= pr->plz .AND. !pr->(Eof()) //+ Strae in der richtigen Stadt gefunden: IF pr->HNR_TYP == "N" //+ Strae hat nur eine einzige PLZ: ++nTypN AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ELSEIF pr->HNR_TYP == "G" .AND. (Val(::cHausnr)=0 .OR. Val(::cHausnr)%2=0 .AND. ; Val(pr->hnr_von)<=Val(::cHausnr) .AND. Val(pr->hnr_bis)>=Val(::cHausnr)) //+ Straenteil mit den geraden Hausnummern gefunden ++nTypG AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ELSEIF pr->HNR_TYP == "U" .AND. (Val(::cHausnr)=0 .OR. Val(::cHausnr)%2!=0 .AND. ; Val(pr->hnr_von)<=Val(::cHausnr) .AND. Val(pr->hnr_bis)>=Val(::cHausnr)) //+ Straenteil mit den ungeraden Hausnummern gefunden ++nTypU AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ENDIF pr->(DbSkip()) DO WHILE Upper(::cStrasse) = Trim(pr->str_such) .AND. ; ::cPLZ <= pr->plz .AND. ::cPLZ2 >= pr->plz .AND. !pr->(Eof()) //+ gibt es noch weitere Eintrge zu diesem Straennamen?: IF pr->HNR_TYP == "N" //+ weiterer Straeneintrag mit nur einer einzigen PLZ ++nTypN AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ELSEIF pr->HNR_TYP == "G" .AND. (Val(::cHausnr)=0 .OR. Val(::cHausnr)%2=0 .AND. ; Val(pr->hnr_von)<=Val(::cHausnr) .AND. Val(pr->hnr_bis)>=Val(::cHausnr)) //+ weiterer Straeneintrag mit geraden Hausnummern ++nTypG AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ELSEIF pr->HNR_TYP == "U" .AND. (Val(::cHausnr)=0 .OR. Val(::cHausnr)%2!=0 .AND. ; Val(pr->hnr_von)<=Val(::cHausnr) .AND. Val(pr->hnr_bis)>=Val(::cHausnr)) //+ weiterer Straeneintrag mit ungeraden Hausnummern ++nTypU AAdd( aI2, {pr->str_46,pr->plz,pr->HNR_TYP,pr->HNR_VON,pr->HNR_BIS} ) ENDIF pr->(DbSkip()) IF Upper(::cStrasse) != Trim(pr->str_such) .OR. ::cPLZ > pr->plz .OR. ::cPLZ2 < pr->plz //+ das ist jetzt schon die nchste Strae bzw. der nchste Ort EXIT ENDIF ENDDO //+ zurck zum letzten Eintrag der richtigen Strae (entbehrlich?) pr->(DbSkip(-1)) IF (AScan(aI2,"G")>0 .OR. AScan(aI2,"G")>0) .AND. Val(::cHausnr) = 0 //+ wenn es Eintrge mit geraden bzw. ungeraden Nrn gibt, aber keine Hausnr angegeben ist AlertBox( , "Hausnummer angeben!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Strae hat mehrere PLZ" ) //+15.11.2009 17:41 IF AScan(aI2,"N")=0 //+ wenn es keine Strae mit nur einer PLZ gibt ::lAction := .F. OrdSetFocus( cIndexname ) SELECT &nOldArea RETURN self ENDIF ENDIF IF (nTypN > 1 .OR. nTypG > 1 .OR. nTypU > 1) .OR. ; (nTypN = 1 .AND. (nTypG > 0 .OR. nTypU > 0)) //+ d.h. mehrere Straen //+ mehrere Straeneintrge mit demselben Namen in einer Stadt: IF ::Such( , "s_plz", 110, 119, SELECT(), aI2,{10*nH,30*nV},{425*nH,200*nV},, ; "Strae auswhlen! =abbrechen", @nI2 ) //+03.10.2008 10:41 //+ wenn mit Esc abgebrochen: (also kein Ort ausgewhlt) ::lAction := .F. ELSE //+ d.h., wenn eine Strae ausgewhlt: //+03.10.2008 12:05 //+ nI2 war mit @ bergeben worden und wurde in Such() mit der Rowpos gefllt ::cPLZ := aI2[nI2,2] ::cStrasse := Trim(aI2[nI2,1]) //+ auch: wegen der Schreibweise ENDIF ELSEIF nTypN = 1 ::cPLZ := aI2[1,2] // msste auch = pr->plz sein ! ::cStrasse := Trim(aI2[1,1]) //+ wegen der Schreibweise ELSEIF nTypG = 1 .OR. nTypU = 1 //+ pr->hnr_typ ist G oder U, d.h. diese PLZ gilt nur fr einen bestimmten Hausnr-Bereich //+ ...mal sehen, ob hiermit der richtige Straenteil zugewiesen wird...: FOR i := 1 TO Len(aI2) IF Int(Val(::cHausnr)/2)*2 != Val(::cHausnr) //+ ungerade Hausnr IF aI2[i,3] == "U" IF Val(aI2[i,4])<=Val(::cHausnr) .AND. Val(aI2[i,5])>=Val(::cHausnr) ::cPLZ := aI2[i,2] ::cStrasse := Trim(aI2[i,1]) //+ wegen der Schreibweise //+ Hausnummer ungerade UND PLZ fr ungerade HNrn in diesem HNr-Bereich EXIT ENDIF ENDIF ELSEIF Int(Val(::cHausnr)/2)*2 = Val(::cHausnr) //+ gerade Hausnr IF aI2[i,3] == "G" IF Val(aI2[i,4])<=Val(::cHausnr) .AND. Val(aI2[i,5])>=Val(::cHausnr) ::cPLZ := aI2[i,2] ::cStrasse := Trim(aI2[i,1]) //+ wegen der Schreibweise //+ Hausnummer gerade UND PLZ fr gerade HNrn in diesem HNr-Bereich EXIT ENDIF ENDIF ENDIF NEXT IF i > Len(aI2) AlertBox( , "Keinen passenden Straenteil zur Hausnummer gefunden!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Unmglich" ) //+15.11.2009 17:41 ENDIF ELSE AlertBox( , "berprfen Sie die Hausnummer!;" + ; "Fr diese Hausnummer ist kein Hausnr.Typ-Eintrag vorhanden!;" + ; "Ggf. mssen Sie diesen Straenteil neu eingeben!", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Unmglich!?" ) //+15.11.2009 17:41 ::lNeueStrasse := .T. ENDIF ELSE AlertBox( , "Strae existiert berhaupt nicht??", ; { "_OK" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "" ) //+15.11.2009 17:41 ::lAction := .F. ENDIF OrdSetFocus( cIndexname ) SELECT &nOldArea RETURN self // vor Aufruf von ::Such in die nA-Area wechseln! : //+ nS heit hier nRow und hat hier die Bedeutung Zeile des Browsers METHOD PLZThrd:Such( oParent, cProg, nAnf, nEnd, nA, nRec, aPos, ASize, aPP, cTitel, nRow ) //16.04.2006 12:56 LOCAL oDlg, nEvent, mp1, mp2, oBrowse, oHelp LOCAL nOldArea := Select(), oFocus := SetAppFocus(), oFoc LOCAL lFlucht := .F. // 3.2.2005 PRIVATE oCB, aStr := IIf( ValType(nRec)=="A", nRec, NIL ) DEFAULT oParent TO AppDeskTop() DEFAULT aPos TO {10*nH,30*nV} , ASize TO {int(330*nH),int(250*nV)} DEFAULT cTitel TO "Suchwort tippen/auswhlen ( = zurck) :" /*14.04.2008 20:01*/ aPos[1] += oParent:currentpos()[1] + 5 aPos[2] := oParent:currentpos()[2] + 30 /**/ oDlg := AKDialog():new( AppDesktop(), SetAppWindow() ) oDlg:tasklist := .T. oDlg:title := cTitel oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg // jetzt folgt die Erzeugung der Eingabefelder oBrowse := DialogFF():new( oCB,oDlg, , ,,, nBz, cProg, nAnf, nEnd, nA ) oBrowse:Fancy := "" oBrowse:VArea := nA oBrowse:BEArea := {} AAdd( oBrowse:BEArea, oCB ) oBrowse:BENr := Len( oBrowse:BEArea ) oBrowse:CREATE( oCB,oDlg, , ,aPP,, nBz, cProg, nAnf, nEnd, nA ) // bis hierhin geht die Erzeugung der Eingabefelder AEval( oBrowse:editControls, {|x| oDlg:addEditControl( x ) } ) // 28.02.2006 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 == xbeBRW_ItemSelected PostAppEvent( xbeP_Close,,,oDlg) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 .OR. mp1 == xbeK_TAB //02.09.2006 17:30 PostAppEvent( xbeP_Close,,,oDlg) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close,,,oDlg) CASE mp1 == xbeK_CTRL_DEL oFoc := SetAppFocus() IF AlertBox( , "Soll der Datensatz wirklich gelscht werden?;" + ; ";", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Datensatz lschen!" ) = 1 Satzsp( oCB ) (nA)->(DbDelete()) IF !(nA)->(Bof()) (nA)->(DbSkip(-1)) // 21.6.2005 zum Test ENDIF nRec := RecNo() oBrowse:BrowseFeld[1]:refreshAll() ENDIF SetAppFocus(oFoc) ENDCASE ENDIF IF nEvent == xbeU_RefreshTIP // xbeP_User + 8 ELSE oXbp:handleEvent( nEvent, mp1, mp2 ) ENDIF ENDDO IIf( nRow!=NIL, nRow := oBrowse:BrowseFeld[1]:rowpos,) oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() /// DO WHILE nEvent <> xbe_None nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO IF lFlucht = .T. IIf(ValType(nRec)=="N" .AND. nRec>0,(nA)->(DbGoto(nRec)),) ENDIF (nA)->(DbSkip(0)) SetAppFocus( oFocus ) RETURN lFlucht //+ zeigt den Eingabe-Dialog fr einen neuen Straeneintrag METHOD PLZThrd:NeueStrasse(cTitel) LOCAL nOldArea := SELECT(), cIndexname IF AlertBox( , "Ist das eine neue Strae?;" + ; ";", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; cTitel ) = 1 Zeitfenster("...einen Moment bitte...") DbSelectArea("pr") cIndexname := pr->(OrdSetFocus("ss")) //++ indiziert nach Strae + PLZ pr->(DbSetScope( SCOPE_TOP, ::cStrSuch[1] )) //+ scopen nach Strae pr->(DbSetScope( SCOPE_BOTTOM, ::cStrSuch[1]+"zzzzz" )) //+ (Anfangsbuchstabe) pr->(DbSeek( PadR(::cStrSuch,46)+::cPLZneu, .T. )) pr->(DbSkip(-1)) IF ::Eingabe( ,,,,, "s_plz", 120, 150,,,,"PLZ+Hausnr.Typ eingeben (N,G,U)" ) ::lAction := .F. ENDIF pr->(DbClearScope()) //+ Ent-Scopen pr->(OrdSetFocus(cIndexname)) //+OrdFocus wieder zurck ELSE ::lAction := .F. ENDIF SELECT &nOldArea RETURN self //+ 16.10.2008 08:58 hierherkopiert und etwas modifiziert aus DialogFF: //+ konzipiert als mglichst allgemeines Modul zur schnellen Erzeugung eines Dateneingabe-Fensters //+ nRec = RecNo in der bisherigen Datei, nA = Area einer ggf. neu zu ffnenden Datei //+ cDatei = Name der ggf. neu zu ffnenden Datei, cProg = 's_xxxx'-Datei mit AufbauProgramm //+ Aufruf fast ohne Parameter msste auch mglich sein -> nur mit cProg, nAnf, nEnd METHOD PLZThrd:Eingabe( oParent, oOwner, nRec, nA, cDatei, cProg, nAnf, nEnd, aPos, ASize, aPP, cTitel ) //06.04.2007 13:43 LOCAL oDlg, nEvent, mp1, mp2, lFlucht := .F., oHelp LOCAL nOldArea, oFocus := SetAppFocus(), oFoc PRIVATE oCB, oEdit, oFocSle // fr alle Flle (oFocSle wird fr Button gebraucht!) DEFAULT oParent TO AppDeskTop(), oOwner TO SetAppWindow(), nA TO SELECT() DEFAULT aPos TO {oParent:currentSize()[1]-315*nH,oParent:currentSize()[2]-350*nV}, ; ASize TO {250*nH,320*nV}, ; cTitel TO "Eingabe tippen ( = zurck) :" // Arbeitsbereich auswhlen, wenn noch nicht passiert und wenn ntig: IF nA > 0 .AND. nA != SELECT() nOldArea := Select() SELECT (nA) ENDIF // Datei ffnen, wenn noch nicht passiert und wenn ntig: IF !Empty(cDatei) DbUseArea( , , cDatei ) ENDIF // Satzzeiger positionieren, wenn noch nicht passiert und wenn ntig: IF !Empty(nRec) DbGoto(nRec) ENDIF oDlg := AKDialog():new( oParent, oOwner ) oDlg:tasklist := .T. oDlg:title := cTitel oDlg:maxButton := .F. oDlg:alwaysontop := .T. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg aThrdFenster[3] := oDlg //+23.10.2008 20:31 // jetzt folgt die Erzeugung der Eingabefelder oEdit := DialogFF():new( oCB,oDlg, , ,,, nBz, cProg, nAnf, nEnd, nA ) oEdit:Fancy := "" oEdit:VArea := nA oEdit:BEArea := {} AAdd( oEdit:BEArea, oCB ) // weil direkt mit DialogFF gearbeitet wird! oEdit:BENr := Len( oEdit:BEArea ) oEdit:CREATE( oCB,oDlg, , ,aPP,, nBz, cProg, nAnf, nEnd, nA ) AEval( oEdit:editControls, {|x| oDlg:addEditControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:setModalState( XBP_DISP_APPMODAL ) IF Len(oEdit:singleZeile) > 0 //+ wenn Eingabefelder erzeugt wurden oCtrl := XbpGetController():new( oDlg ) oCtrl:create() oCtrl:READ( 2, .F. ) // mit 1 steigt es aus mit Array-Fehler bei activate() 17.10.2008 21:50 ELSE oDlg:show() ENDIF IF Len(oEdit:BrowseFeld)>0 AEval( oEdit:BrowseFeld, {|a,i| a:refreshAll() } ) ENDIF DbSkip(0) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Close IF ValType(mp2) == "L" lFlucht := mp2 ENDIF ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_ESC // lFlucht := .T. //+ lFlucht wird ber mp2 gesetzt: PostAppEvent( xbeP_Close,,.T.,oDlg) CASE mp1 == xbeK_F10 PostAppEvent( xbeP_Close,,,oDlg) CASE mp1 == xbeK_CTRL_DEL oFoc := SetAppFocus() IF AlertBox( , "Soll der Datensatz wirklich gelscht werden?;" + ; ";", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Datensatz lschen!" ) = 1 Satzsp( oCB ) (nA)->(DbDelete()) IF !(nA)->(Bof()) (nA)->(DbSkip(-1)) ENDIF oEdit:BrowseFeld[1]:refreshAll() ENDIF SetAppFocus(oFoc) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() DO WHILE nEvent <> xbe_None nEvent := AppEvent( @mp1, @mp2, @oXbp, 10 ) //leert die Event-Loop !! wichtig!! ENDDO IF lFlucht = .T. // wenn gedrckt wurde // Satzzeiger zurck-positionieren, wenn noch nicht passiert und wenn ntig: IF !Empty(nRec) DbGoto(nRec) ENDIF ENDIF // Datei schlieen, wenn noch nicht passiert und wenn ntig: IF !Empty(cDatei) DbCloseArea() ENDIF // Arbeitsbereich zurckstellen, wenn noch nicht passiert und wenn ntig: IF nOldArea != NIL SELECT (nOldArea) ENDIF SetAppFocus( oFocus ) RETURN lFlucht //+ legt eine neue Strasse an, wenn ntig mit getrenntem Hausnummernbereich //+ oPEing:aI1 wird in einer v-Zeile der s_.tak gesetzt: //+ oEdit:aI1:={oBest:oPLZThrd:cStrasse,oBest:oPLZThrd:cHausnr,oBest:oPLZThrd:cPLZneu,oBest:oPLZThrd:cOrt," "," "," "} //+ (oPEing ist das oEdit der PLZThrd:Eingabe() + oBest:oPLZThrd ist das KlassenObjekt der PLZClass) METHOD PLZThrd:PLZNeu(oPEing) LOCAL i, cStr := "" LOCAL cStrasse := oPEing:aI1[1] LOCAL cPLZ := oPEing:aI1[3] LOCAL cHNR_TYP := oPEing:aI1[5] LOCAL cHNR_VON := oPEing:aI1[6] LOCAL cHNR_BIS := oPEing:aI1[7] IF !cHNR_TYP$"NUG" IF AlertBox( , "Hat die ganze Strae nur eine einzige PLZ?;" + ; ";", ; { "JA" , "_NEIN" } , ; XBPSTATIC_SYSICON_ICONWARNING , ; "Hausnummern-Typ leer oder falsch!" ) = 1 oEdit:XbpObjektSet(,"cHNR_TYP",cHNR_TYP := "N") ELSE MsgBox( "Geben Sie ein:" + CRLF + ; "Hausnr.Typ=G fr gerade Hausnummern" + CRLF + ; "Hausnr.von und Hausnr.bis = Bereich." + CRLF + ; + CRLF + ; "Klicken Sie auf NeuAnlegen" + CRLF + ; "und wiederholen Sie das fr " + CRLF + ; "Hausnr.Typ=U fr ungerade Hausnummern" + CRLF + ; + CRLF + ; "und ggf. nochmal dasselbe fr einen" + CRLF + ; "weiteren Hausnummernbereich, in G und U." + CRLF + ; + CRLF + ; " - Oder brechen Sie ab mit Esc!", ; "Hausnummernbereiche eingeben:" ) RETURN self ENDIF ENDIF IF Val(cHNR_VON) > 0 // wenn Hausnummernbereich angegeben IF Val(cHNR_BIS) < Val(cHNR_VON) MsgBox("von...bis aufsteigende Reihenfolge!","Hausnummernbereich berprfen!") RETURN self ENDIF IF cHNR_TYP == "N" MsgBox("N bedeutet: Hausnummer ist egal","Hausnummernbereich berprfen!") RETURN self ELSEIF cHNR_TYP == "G" .AND. Val(cHNR_VON)%2 > 0 // gerader Typ, ungerade Zahl MsgBox("G bedeutet: Hausnummer ist gerade Zahl","Hausnummernbereich berprfen!") RETURN self ELSEIF cHNR_TYP == "U" .AND. Val(cHNR_VON)%2 = 0 // gerader Typ, ungerade Zahl MsgBox("U bedeutet: Hausnummer ist ungerade Zahl","Hausnummernbereich berprfen!") RETURN self ELSEIF cHNR_TYP == "G" .AND. Val(cHNR_BIS)%2 > 0 // gerader Typ, ungerade Zahl MsgBox("G bedeutet: Hausnummer ist gerade Zahl","Hausnummernbereich berprfen!") RETURN self ELSEIF cHNR_TYP == "U" .AND. Val(cHNR_BIS)%2 = 0 // gerader Typ, ungerade Zahl MsgBox("U bedeutet: Hausnummer ist ungerade Zahl","Hausnummernbereich berprfen!") RETURN self ENDIF lTyp := .T. ENDIF pr->(DbAppend()) pr->plz := cPLZ // die LOCAL-Variable!! pr->str_22 := PadR(cStrasse,22) pr->str_46 := cStrasse cStr := Wandel(cStrasse) //+ wandelt Umlaute+Spezialzeichen um / wandelt alles um in Grobuchstaben pr->str_such := cStr pr->HNR_TYP := IIf( cHNR_TYP$"NGU", cHNR_TYP, "N" ) pr->HNR_VON := IIf( cHNR_TYP$"GU", cHNR_VON, "" ) pr->HNR_BIS := IIf( cHNR_TYP$"GU", cHNR_BIS, "" ) IF Len(oPEing:BrowseFeld)>0 AEval( oPEing:BrowseFeld, {|a,i| a:refreshAll() } ) ENDIF RETURN self PROCEDURE ZeitFenster(cText, aPos, ASize, nZeit ) oThread := Thread():new() oThread:start("zf1", cText, aPos, ASize, nZeit ) RETURN PROCEDURE ZF1( cText, aPos, ASize, nZeit ) DEFAULT cText TO "Bitte warten ..." DEFAULT nZeit TO 100 DEFAULT ASize TO {Len(cText)*10,100} DEFAULT aPos TO {AppDeskTop():currentsize()[1]/2-asize[1]/2,AppDeskTop():currentsize()[2]/2-asize[2]/2} oDlg := XbpDialog():new( AppDeskTop() ) oDlg:maxbutton := .F. oDlg:minbutton := .F. oDlg:sysmenu := .F. oDlg:titlebar := .F. oDlg:alwaysontop := .T. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) XbpStatic():New( oDlg:drawingArea,,{ 10, asize[2]/2-20},{ asize[1]-20, 20}):Create():SetCaption(cText) Sleep(nZeit) oDlg:destroy() ThreadObject():QUIT() RETURN //+20.10.2008 21:34 wandelt Straenbezeichnungen um, sodass mit DbSeek() str_such gefunden wird FUNCTION Wandel(cVar) LOCAL aWandel := {{"","AE"}, ; {"","AE"}, ; {"","OE"}, ; {"","OE"}, ; {"","UE"}, ; {"","UE"}, ; {"","SS"}, ; {" ",""}, ; {".",""}, ; {",",""}, ; {"-",""}, ; {"_",""}, ; {":",""}, ; {";",""} } LOCAL cVWandel := "" FOR i := 1 TO Len(cVar) cVWandel += IIf(Upper(cVar[i])$"ABCDEFGHIJKLMNOPQRSTUVWXYZ",Upper(cVar[i]), ; IIf(cVar[i]$"",aWandel[AScan(aWandel,cVar[i]),2],"")) NEXT RETURN cVWandel