Home - Computer - Delphi Tricks & Tips

Delphi Tricks und Tips

Hier ein paar Dinge, über die ich beim Programmieren in Delphi 5 gestolpert bin, in einer unsortierten Sammlung. Man kann in dieser Seite aber Volltextsuche machen....


Suchen & Ersetzen in TMemo

Im Gegensatz zum TRichEdit gibt es bei TMemo keine Function FindText. Deshalb ist Suchen und Ersetzen nicht so einfach möglich. Hier meine Lösung: Du brauchst einen FindDialog1: TFindDialog; und einen ReplaceDialog1: TReplaceDialog;. Bei beiden habe ich folgende Einstellungen vorgenommen: Options [frDown,frHideWholeWord,frHideUpDown].

procedure TForm1.Search1Click(Sender: TObject);  {Dialog Suchen aufrufen} 
begin 
  if Memo1.Lines.Count>1 then begin 
    FindDialog1.Position:=Point(0,0); 
    FindDialog1.Execute; 
  end; 
end; 
 
procedure TForm1.Replace1Click(Sender: TObject); {Dialog Ersetzen aufrufen} 
begin 
  if Memo1.Lines.Count>1 then begin 
    ReplaceDialog1.Position:=Point(0,0); 
    ReplaceDialog1.Execute; 
    Memo1.SelStart:=0; 
  end; 
end; 
 
{diese Funktion ersetzt FindText, wie es bei RichText gibt, für ein TMemo} 
function TForm1.FindeText(s: string; spos, slength: integer; ucase: boolean): longint; 
var x: integer; 
    p, cz: longint; 
    z: string; 
begin 
  result:=-1;  {nix gefunden} 
  cz:=0;   {zeigt auf 1. Zeichen im Text} 
  for x:=0 to Memo1.Lines.Count-1 do begin 
    z:=Memo1.Lines[x]; 
    if ucase then begin 
      s:=UpperCase(s); 
      z:=UpperCase(z); 
    end; 
    p:=pos(s,z); 
    if (p>0) and (cz+p>=spos) then begin   {erst ab Startposition in spos suchen} 
      result:=cz+p-1; 
      break; 
    end; 
    cz:=cz+length(Memo1.Lines[x])+2;  {zeilenweise alle Zeichen zählen} 
  end; 
end; 
 
procedure TForm1.FindDialog1Find(Sender: TObject);  {Suchen in Memo1} 
var FoundAt: LongInt; 
    StartPos, ToEnd: Integer; 
    ucase: boolean; 
begin 
  with Memo1 do begin 
    { Suchbeginn nach der aktuellen Markierung (falls vorhanden), 
      andernfalls am Textanfang starten } 
    if SelLength<>0 then StartPos:=SelStart+SelLength else StartPos:=0; 
    { ToEnd ist die Länge von StartPos bis zum Ende des Textes im Memo} 
    ToEnd:=Length(Text)-StartPos; 
    ucase:=not (frMatchCase in FindDialog1.Options); 
    FoundAt:=FindeText(FindDialog1.FindText, StartPos, ToEnd, ucase); 
    if FoundAt<>-1 then begin 
      SetFocus; 
      SelStart:=FoundAt; 
      SelLength:=Length(FindDialog1.FindText); 
    end else ShowMessage(suchende); 
  end; 
end; 
 
procedure TForm1.ReplaceDialog1Find(Sender: TObject);  {Finden mit Replace im Memo1} 
var FoundAt: LongInt; 
    StartPos, ToEnd: Integer; 
    ucase: boolean; 
begin 
  with Memo1 do begin 
    { Suchbeginn nach der aktuellen Markierung (falls vorhanden), 
      andernfalls am Textanfang starten } 
    if SelLength<>0 then StartPos:=SelStart+SelLength else StartPos:=0; 
    { ToEnd ist die Länge von StartPos bis zum Ende des Textes im Memo} 
    ToEnd:=Length(Text)-StartPos; 
    ucase:=not (frMatchCase in ReplaceDialog1.Options); 
    FoundAt:=FindeText(ReplaceDialog1.FindText, StartPos, ToEnd, ucase); 
    if FoundAt<>-1 then begin 
      SetFocus; 
      SelStart:=FoundAt; 
      SelLength:=Length(ReplaceDialog1.FindText); 
    end else ShowMessage(suchende); 
  end; 
end; 
 
procedure TForm1.ReplaceDialog1Replace(Sender: TObject); {Ersetzen im Memo1} 
var FoundAt: LongInt; 
 
  procedure SingleReplace; 
  var StartPos, ToEnd: Integer; 
      ucase: boolean; 
  begin 
    with Memo1 do begin 
      StartPos:=SelStart; 
      { ToEnd ist die Länge von StartPos bis zum Ende des Textes im Memo} 
      ToEnd:=Length(Text)-StartPos; 
      ucase:=not (frMatchCase in ReplaceDialog1.Options); 
      FoundAt:=FindeText(ReplaceDialog1.FindText, StartPos, ToEnd, ucase); 
      if FoundAt<>-1 then begin 
        SetFocus; 
        SelStart:=FoundAt; 
        SelLength:=Length(ReplaceDialog1.FindText); 
        SelText:=ReplaceDialog1.ReplaceText; 
      end else ShowMessage(suchende); 
    end; 
  end; 
 
begin 
  { Suchbeginn nach der aktuellen Markierung (falls vorhanden), 
    andernfalls am Textanfang starten } 
  if frReplace in ReplaceDialog1.Options then SingleReplace 
  else if frReplaceAll in ReplaceDialog1.Options then repeat 
    SingleReplace; 
  until FoundAt=-1; 
end; 
top

exe Pfad ermitteln

zwei Möglichkeiten (Pfad ist mit \ abgeschlossen):

  1. exedir:=ExtractFilePath(Application.ExeName);
  2. exedir:=ExtractFilePath(ParamStr(0));
top

Dateinamen im TShellListView ermitteln

Seltsamerweise funktioniert dieses naheliegende Konstrukt nicht:

DateiName:=ShellListView1.Items[x].Caption;

Nach langen Versuchen habe ich Folgendes gefunden:

DateiName:=ShellListView1.Folder[x].DisplayName;

Hier ein Beispiel, wie man alle selektierten Dateien aus einem ShellListView ausliest:

procedure TForm1.DateiName; {Dateinamen der markierten Dateien auslesen}
var x: integer; 
begin 
  for x:=0 to ShellListView1.Items.Count-1 do 
  if ShellListView1.Items[x].Selected then {nur markierte Dateien}
  Memo1.Add(ShellListView1.Folders[x].DisplayName); {oder was auch immer man mit 
                                                     den Dateinamen machen will}
end;

top


Auswahl mehrerer Dateien per Drag&Drop übernehmen

Die Dateinamen werden in einer StringList gespeichert und können auch zu anderen Zwecken (ggf. mit Pfadnamen) benutzt werden (z.B. über alle Dateien eine Prüfsumme berechnen usw.). Im Beispiel wird die Markierung der ausgewählten Dateien in ein ShellListView übernommen.

procedure TForm1.WMDropFiles(var Msg: TMessage);  {Drag&Drop}
var           {WindowsMessage abfangen: ShellAPI}
  hDrop:  THandle;
  szName: array[0..255] of Char;
  k, x:   integer;
  FileList: TStringList;
begin
  inherited;
  FileList:=TStringList.Create;
  try
    hDrop:=Msg.wParam;
    k:=DragQueryFile(hDrop,$FFFFFFFF,nil,0); {Anzahl der übergeben Files in k}
    for x:=0 to k-1 do begin
      DragQueryFile(hDrop,x,szName,SizeOf(szName));   {liest die Dateinamen aus}
      FileList.Add(ExtractFileName(StrPas(szName)));  {Dateienliste füllen}
    end;
    DragFinish(hDrop);
    ShellListView1.Root:=ExtractFileDir(StrPas(szName)); {Pfad übernehmen - 
                                           nicht schön, weiß aber nix Besseres}

    for x:=0 to ShellListView1.Items.Count-1 do    {gedropte Dateien markieren}
     if FileList.IndexOf(ShellListView1.Folders[x].DisplayName)>=0
      then ShellListView1.Items[x].Selected:=true;  {Markierung übernehmen}
  finally
    Application.BringToFront;    {Anwendung wieder in den Vordergrund bringen}
    FileList.Free;
  end;
end;

Nicht vergessen: Drag & Drop im Formular vorher erlauben:

DragAcceptFiles(Handle,True);

top


Zahl in beliebiges Zahlensystem umwandeln und umgekehrt

function CharToByte(b: char): byte;  {Char in Zahlenwert}
begin
  b:=Upcase(b);
  case b of
    '0'..'9': result:=ord(b)-48;
    'A'..'Z': result:=ord(b)-55;
  else result:=255;  {gibt bei Fehler 255 (FF'h) zurück !}
  end;
end;

function ByteToChar(b: byte): char;  {Zahl in Hex, Leerzeichen wird zu 0}
begin
  case b of
    0..9:   result:=chr(b+48);
    10..35: result:=chr(b+55);
  else result:=' ';     {gibt bei Fehler Leerzeichen zurück !}
  end;
end;

function StrToZS(str: string; ZS: integer): extended;   {Umrechnen String in               ganze Zahl für Zahlensystem ZS bis zur maximalen Basis von 36}
var x, z: integer;
    p: extended;
begin
  if zs<2 then zs:=2;
  if zs>36 then StrToInt('X'); {Exception auslösen, wenn zu großes Zahlensystem,        Exception muß aber im Programm abgefangen werden, weil sonst Blödsinns-        fehlermeldungen, wie sonst bei Windows üblich, kommen!}
  p:=1;
  result:=0;
  for x:=length(str) downto 1 do begin
    z:=CharToByte(str[x]);
    if (z>(zs-1)) or (zs>36) then StrToInt('X');  {Exception auslösen}
    result:=result+z*p;
    p:=p*zs;   {Stellenwert errechnen, p-te Potenz von ZS}
  end;
end;

function IntToZSStr(wert: extended; ZS: integer): string;
var zw: extended;
    rest: variant;
begin
  if zs<2 then zs:=2;
  if zs>36 then StrToInt('X'); {Exception auslösen, wenn zu großes Zahlensystem}
  result:='';
  repeat
    zw:=Int(wert/zs);
    rest:=wert-zw*zs;
    wert:=zw;
    result:=ByteToChar(rest)+result;
  until wert=0;
end;

top

HomeBack