satirlarin ilk karakteri

[sr1111]

s.a
yardımcı olursanız sevinirim. memomdaki satrlar su sekilde

elma armut
erik seftali
armut erik
ceviz fındık
enginar seftali

ilk karakteri e ile baslayan satirlari silmek istiyorum
silindiginde asagidaki gibi kalacak

armut erik
ceviz fındık

[Ertugrul]

Kod: Tümünü seç

var
i:integer;
begin
i:=0;
while i<memo1.Lines.count do
begin
if (copy(memo1.lines[i],1,1)='e') then
  memo1.lines.Delete(i)
else
  inc(i);
end;

[Hakan Can]

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  for I := Memo1.Lines.Count - 1 downto 0 do
    if System.Pos('e', Memo1.Lines[I]) = 1 then Memo1.Lines.Delete(I);
end;

Alternatif bir çözüm.

[sr1111]

tesekkur ederim.
bu 2 procedureden en hızlı hangisi calisir.
bir de pos komutu ile system.pos komutu arasindaki fark nedir.

[Hakan Can]

Aslında ikisi de hızlı çalışmaz. Misal Memo1.Lines.Count 1.000.000 olduğunda falan 2-3 saat beklemen gerekebilir. Ben benzer bir ihtiyacı karşılamak için çözüm olarak TStringList kullanmıştım ki 1-2 saniyede falan hallediyor. System.Pos ile Pos aynı. Fakat bazı ek bileşenler Pos fonksiyonunu farklı tanımladığı ve kullandığı için daha garanti olsun diye bu şekilde yazmıştım.

Problemin hızlı çözümü şu şekilde olabilir:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  aList1, aList2: TStringList;
begin
  aList1 := TStringList.Create;
  aList2 := TStringList.Create;
  try
    Memo1.Lines.BeginUpdate;
    try
      aList1.AddStrings(Memo1.Lines);

      Memo1.Lines.Clear;

      for I := 0 to aList1.Count - 1 do
        if System.Pos('e', aList1[I]) <> 1 then aList2.Add(aList1[I]);

      Memo1.Lines.Text := aList2.Text;
    finally
      Memo1.Lines.EndUpdate;
    end;
  finally
    aList1.Free;
    aList2.Free;
  end;
end;

[sr1111]

tesekkurler bende az once sizin gibi yapmistim. fakat siznkinde su var
aList1) <> 1 bu satirlari eklemeye gerek var mi.

kullanmis oldugum,
begin
sl := TStringlist.Create;
sl.Text:=memo1.Lines.Text;
for I := sl.Count - 1 downto 0 do if Pos('e', sl) = 1 then
sl.Delete(I);

memo1.lines.text:= sl.text;
showmessage('bitti');
FreeAndNil(sl);

[Hakan Can]

Ben çok daha hızlı olsun diye iki tane TStringList kullanmıştım. Çünkü Delete fonksiyonu bir noktadan sonra bilhassa başlardaki satırlarda yavaşlamalara neden olabiliyor. Add fonksiyonu çok daha hızlı çalışıyor.

Farklı yöntem kullandığım için aList1) <> 1 demiştim.

[sr1111]

tesekkur ederim. cok makbule gecti. hiza cok ihtiyacim vardi buyuk dosylar ile calisitigimdan.
ozellikle hizli pos ve replace functionlarina. bunun icin onereceginiz ozel functionlar varmi.

ayni sekilde stringlist ile hizli stringreplace yapacak wholeword (, . ? ' ' cok delimiterli) ozellikli bir dongu yapilabilir mi stringlist de. buna cok ihtiyacim var.

[Battosai]

stringlist ile satır satır replace yaparsan oldukça hızlı işlem yapmış olursun fazla bişey aramaya gerek yok...Bu işler için RegEX kütüphaneleri var daha profosyonel kullanım için...

[Hakan Can]

Şu fonksiyonlar replace işlemlerinde çok hızlı:

Kod: Tümünü seç

function MyAnsiReplace(const aText, aFromText, aToText: string; aAnsiUpperCase, aFirstPosControl: Boolean; var ChangeCount: Integer): string;
var
  I, J: Integer;
  aFirstIndex: Integer;
  St: string;
  aSearchText: string;
  aSearchFromText: string;
  aLengthText: Integer;
  aLengthFromText: Integer;
  aFound: Boolean;
begin
  ChangeCount := 0;

  if (aText = '') or (aFromText = '') then
  begin
    Result := aText;
    Exit;
  end;

  if aFirstPosControl and not aAnsiUpperCase then
    if System.Pos(aFromText, aText) < 1 then
    begin
      Result := aText;
      Exit;
    end;

  if aAnsiUpperCase then
  begin
    aSearchText := AnsiUpperCase(aText);
    aSearchFromText := AnsiUpperCase(aFromText);
    if aFirstPosControl then
      if System.Pos(aSearchFromText, aSearchText) < 1 then
      begin
        Result := aText;
        Exit;
      end;
  end
  else
  begin
    aSearchText := aText;
    aSearchFromText := aFromText;
  end;

  aLengthText := Length(aText);
  aLengthFromText := Length(aFromText);

  Result := '';

  I := 1;
  aFirstIndex := 1;
  repeat
    aFound := aSearchText[I] = aSearchFromText[1];
    if aFound then
    begin
      for J := 2 to aLengthFromText do
        if aSearchText[I + J - 1] <> aSearchFromText[J] then
        begin
          aFound := FALSE;
          Break;
        end;
      if aFound then
      begin
        if aFirstIndex < I then
        begin
          SetLength(St, I - aFirstIndex);
          Move(aText[aFirstIndex], St[1], I - aFirstIndex);
          Result := Result + St;
        end;
        Result := Result + aToText;
        Inc(I, aLengthFromText - 1);
        aFirstIndex := I + 1;
        Inc(ChangeCount);
      end;
    end;

    Inc(I);
  until I > aLengthText;

  if aFirstIndex < I then
  begin
    SetLength(St, I - aFirstIndex);
    Move(aText[aFirstIndex], St[1], I - aFirstIndex);
    Result := Result + St;
  end;
end;

function MyAnsiReplaceStr(const aText, aFromText, aToText: string): string;
var
  aChangeCount: Integer;
begin
  Result := MyAnsiReplace(aText, aFromText, aToText, FALSE, TRUE, aChangeCount);
end;

function MyAnsiReplaceText(const aText, aFromText, aToText: string): string;
var
  aChangeCount: Integer;
begin
  Result := MyAnsiReplace(aText, aFromText, aToText, TRUE, TRUE, aChangeCount);
end;

function MyAnsiReplaceStrByMultiFromTexts(const aText: string; const aFromTexts: array of string; const aToText: string): string;
var
  I, aChangeCount: Integer;
begin
  Result := aText;
  for I := 0 to Length(aFromTexts) - 1 do Result := MyAnsiReplace(Result, aFromTexts[I], aToText, FALSE, TRUE, aChangeCount);
end;

function MyAnsiReplaceTextByMultiFromTexts(const aText: string; const aFromTexts: array of string; const aToText: string): string;
var
  I, aChangeCount: Integer;
begin
  Result := aText;
  for I := 0 to Length(aFromTexts) - 1 do Result := MyAnsiReplace(Result, aFromTexts[I], aToText, TRUE, TRUE, aChangeCount);
end;

Örnek kullanımı:

Kod: Tümünü seç

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Lines.Text := MyAnsiReplaceStr(Memo1.Lines.Text, 'a', 'Ali Veli'); //tam uyanları değiştiriyor.
  Memo1.Lines.Text := MyAnsiReplaceText(Memo1.Lines.Text, 'a', 'Ali Veli'); //büyülterek kontrol edip değiştiriyor.
  Memo1.Lines.Text := MyAnsiReplaceStrByMultiFromTexts(Memo1.Lines.Text, ['a', 'b', 'c', 'd'], 'Test'); //a, b, c ve d olanları Test yapıyor (tam uyanlar).
  Memo1.Lines.Text := MyAnsiReplaceTextByMultiFromTexts(Memo1.Lines.Text, ['a', 'b', 'c', 'd'], 'Test'); //a, b, c ve d olanları Test yapıyor (büyülterek arıyor).
end;

[sr1111]

MyAnsiReplaceStr fnctionu calismiyor delphi2009 kullaniyorum belki bundan dlayi acayip karakterler cikariyor. ansiuppercase = uppercase yaptigim halde. digerleride zannedersem calismiyor.
k1,k4,k6 string olarak kullandimdi. k1 k4 k6 yi daha hizli olmasi icin baska ne kullanabilirim. strnglist, raw.. vs.

k1:=MyAnsiReplaceStr(k1,k4,k6); bu sekilde

regex kutuphaneleri vb. functionlar buyuk dosylarda ve ayni anda 10-20 kelimeyi veya kelime listesindekileri değiştirme gibi islemlerde cok yavas. wholeword icin rightstr leftstr functionlarini delimeter için nasil kullanabiliriz stringreplace de. veya hizli bir funcion icin