bin mal wieder auf was Seltsames gestoßen, und zwar führt der unten stehende Code zu einem richtigen/erwünschten Verhalten während des Debug-Modes, aber während der Laufzeit wird dann nur das erste Zeichen richtig gefiltert, danach nicht mehr weiter. Habe jetzt schon alles Mögliche versucht (Code umgeschrieben, Funktion geändert) aber während der Laufzeit funktioniert das Ganze nicht mehr. Daher hilft mir der Debug-Mode auch nicht weiter. Hat jemand irgendeine Idee? Vielleicht stehe ich ja auch nur auf der Leitung?!? Im Eingabefeld der den String übergebenden Combobox werden die Tastendrücke mittels:
Code: Alles auswählen
function DB_Eingabe(var key:Char):Char;
begin
if (key in ['0'..'9','.',':',';','_','<','>','+','*','~','#']) then key:=#0;
Result:=key;
end;
gefiltert, sodass nicht irgendein Blödsinn dort landet. Die "aufrufende" Funktion, die dann das Grid filtern soll geht wie folgt:
Code: Alles auswählen
procedure TFrmShowArchiv.UpdateDBGrid(DBStr:String='');
var
u,lstr:Integer;
i:Integer=0;
strNN,strVN,strDBin,strVNTemp:String;
begin
with FrmMain.dbfArchiv do begin
if not ControlsDisabled then DisableControls;
//falls Vorname angegeben, auch diesen filtern
FilterOptions:=[foCaseInsensitive];
Filtered:=False;
strDBin:=Trim(DBStr);
i:=Pos(',',strDBin);
strVN:='';
strNN:='';
if (i=1) then begin //wenn Komma am Anfang steht...
CBoxPat.Text:=''; //...löschen, da nicht verwertbar
Exit;
end;
if (Length(strDBin)>0) then begin //wenn 1 Zeichen oder mehr
if (i>0) then begin //wenn Komma vorhanden
strDBin:=Entferne_Zeichen(strDBin,','); //alle Kommata bis auf eins entfernen
strNN:=Copy(strDBin,1,i-1); //trenne Nachnamen
strVNTemp:=Copy(strDBin,i+1,Length(strDBin)); //und Vornamen
if (strVNTemp<>'') then begin //wenn Vorname vorhanden
lstr:=Length(strVNTemp);
for u:=1 To lstr do begin
if strVNTemp[u] in ['a'..'z'] then strVN:=Copy(strVNTemp,1,u)
else Exit;
end;
end;
end;
if (i>0) then lstr:=Length(strNN)
else lstr:=Length(strDBin);
for u:=1 To lstr do
if strDBin[u] in ['a'..'z'] then strNN:=Copy(strDBin,1,u)
else Exit;
if (strVN<>'') then //wenn Vorname > 0 Zeichen
//Filter nach Nachname und Vorname
Filter:=Format('NNAME="%s" and VNAME="%s"',[strNN+'*',strVN+'*'])
else Filter:=Format('NNAME="%s"',[strNN+'*']);
Locate('NNAME',Format('"%s"',[strNN]),[loCaseInsensitive,loPartialKey]);
end;
//Suche mit Soundex (klappt so nicht)
//Filter:=Format('SOUNDX="%s"',[Soundex(strDBin)]);
if (Length(CBoxPat.Text)<1) then Filtered:=False
else Filtered:=True;
if ControlsDisabled then EnableControls;
end;
end;
Die Hilfsfunktion die die Kommata aussortiert (bis auf eins):
Code: Alles auswählen
function Entferne_Zeichen(s:string;c:Char): string;
var
i: integer;
strKTemp,strSave:String;
begin
strKTemp:=s;
i:=Pos(c,strKTemp);
//überzählige Sonderzeichen bis auf eins ausfiltern...
while (i>0) do begin
strSave:=strKTemp;
strKTemp:=Copy(strKTemp,1,i-1);
i:=Pos(c,strKTemp);
end;
Result:=strSave;
end;
Gerade gemerkt, dass der obige Code noch nicht optimal ist, falls nach den Kommata noch Text (Vorname) stehen sollte. Muss ich noch anpassen, hat aber keine Auswirkung auf das o. g. Problem
Auffällig ist, dass die ComboBox im Debug-Mode nicht die passenden Namen wie zur Laufzeit bereits anzeigt. Ih weiß nicht, ob dies was mit dem veränderten Verhalten zu tun hat. Die ComboBox wird folgendermaßen gefüllt:
Code: Alles auswählen
procedure TFrmShowArchiv.FillComboBox;
var
i:Integer;
strName,strNN,strVN:String;
begin
try
//ShowMessage('FrmShowArchiv.FillComboBox');
if (FrmMain.InitializeDBF(dbfPfad,dbfName)=False) then Exit;
with FrmMain.dbfArchiv do begin
DisableControls; //beschleunigte Ausführung
Active:=True;
Filtered:=False;
First;
//Combobox füllen
CBoxPat.Clear;
if (RecordCount>0) then begin
i:=RecordCount;
while not EOF do begin
strNN:=FieldByName('NNAME').AsString;
strVN:=FieldByName('VNAME').AsString;
strName:=strNN+', '+strVN;
CBoxPat.Items.Add(strName);
i:=i-1;
if (i=0) then Break else Next;
end;
end;
EnableControls;
CBoxPat.SetFocus;
end;
except
on E: EDatabaseError do begin
MessageDlg('Fehler','Datenbankfehler: '+E.Message,mtError,[mbOK],0);
end;
end; // Ende 'try...except'
end;
Habe momentan echt keinen Plan und wäre für jeden Hinweis dankbar. Vielen Dank schon mal für die Mühe.
Verein
Links
