string kelime sırası

[sr1111]

merhaba....

soyle kucuk bir sorunum var ama basaramadim nasil yaparim.
bir satirdaki -l- harflerinin sirasini sayisina göre önüne yazdirmak istiyorum asagidaki gibi.
yardimci olabilirmisiniz

örnek
kalabalıklardan
leyleklerle


yapmak istedigim

kal1abal2ıkl3ardan
l1eyl2ekl3erl4e

[unicorn64]

yemekte kullanılacak malzemeler:
kontrol edilecek ve sonuçta oluşan stringleri tutmak üzere 2 string değişken, biri for döngüsünde sayaç diğeri istenen karakterin sayısını tutmak üzere 2 integer değişken, kontrolü yapmak üzere 1 adet for döngüsü, karşılaştırma için 1 adet if

yemeğin yapılışı:
* sayaç değişkenine 0 değeri atanır
* kontrol edilecek stringin uzunluğu boyunca döngü kurulur
* döngünün her adımında kontrol stringi karakter karakter ele alınır
- karakter "l" ise: sayaç değeri 1 arttırılır, sonuc stringine "l" ile birlikte sayacın değeri aktarılır
- karakter "l" değil ise: kontrol edilen karakter sonuç stringine doğrudan aktarılır

Kod: Tümünü seç

function StringKontrol(KontrolEdilecek:string):string;
var
  i,sayac:integer;
begin
  sayac:=0;
  for i:=1 to length(KontrolEdilecek) do
  begin
     if KontrolEdilecek[i]='l' then
     begin 
        sayac:=sayac+1;
        result:=result+'l'+inttostr(sayac);
     end
     else
       result:=result+KontrolEdilecek[i];
  end;
end;    

[sr1111]

tesekkur ederim cok isimi gördü fakat söyle bir sorun var.
-l- sayisi o satirda bitmeli enterli yerde alttaki satirlarda da devam ediyor.

leylek
kedilerle
derken

l1eyl2ek
kedil3erl4e oluyor



l1eyl2ek
kedil1erl2e seklinde olmali

[unicorn64]

stringleri nereden aldığınıza göre değişik uygulama gerekir bu durumda...
örneğin kontrol edilecek stringler memo içindeyse bir üst döngüyle memo.lines[satir] şeklinde memo satır satır taranır ve her satır için kontrol yapılır...
yada string değişkendeyse ve string içinde enter varsa bu durumda string önce enter karakterinden bölünerek yine her satır için kontrol yapılır vs...

işin bundan sonraki kısmını halledebilirsiniz diye düşünüyorum, biraz üzerinde düşünerek kolayca yapabilirsiniz ama farklı çözüm yolları için biraz ipucu vereyim

* uses a idGlobal eklenir ve bu unitte bulunan fetch komutundan yararlanılır
* pos ve copy komutlarıyla parçalama işlemi manuel yapılır
* yanlış hatırlamıyorsam strUtils unitinde bulunan extractStrings metodu kullanılabilir

[sr1111]

memo icinde yapacagim

memo.lines[satir] seklnde ugrasayim bakayim yapabilecekmiyim.

[sr1111]

yapamadim beceremedim. biraz daha yardimci olursaniz sevinirim.

[unicorn64]

en azından ne yaptığını nerde nasıl bi sorun yaşadığını yazsaydın...

Kod: Tümünü seç

memo.lines[s]

ile memonun s değişkeninde belirtilen satırındaki yazıya ulaşırsın, yapmak gereken bir döngü kurup memonun satırındaki değeri daha önce verdiğim metodda kullanmak...

[sr1111]

tesekkur ederim oldu. fakat baska bir sorun daha cikti.

memodaki asagidaki gibi satirlarda sadece l2i olan satirlardaki c leri f ile stringreplace yapmak istiyorum.
yaptigimda diger satirlardada c varsa f ye ceviriyor. nasil yapabilirim.

l1eyl2imleyci
l1eyl2ekcil3erden
......
.........
sadece 1.satirda c ile f değişmesi lazim.


for k := 0 to Memo1.Lines.Count - 1 do
if Pos('l2i', Memo1.Lines[K]) <> k then
memo1.lines[k]:=Stringreplace(memo1.lines[K], 'c' ,'f' ,[rfreplaceall]);

[unicorn64]

pos metodunun kullanımında sıkıntı var sanırım... verilen string içinde aranan stringi bulursa bulduğu yerin indexini bulamazsa 0 döndürür...

Returns an integer specifying the position of the first occurrence of one string within another.
Pos looks for the first complete occurence of Str in Source. If it finds one, it returns the character position in Source of the first character in Str as an integer value, otherwise it returns 0.
Pos is case sensitive.

yani k nın değeriyle karşılaştırmak yerine sıfırdan büyük mü diye kontrol etmeniz gerek...

[sr1111]

k nın degerini 0 ve 1 yaptgim halde sonuc alamadim.
bir el atarsaniz sevinirim

[unicorn64]

bir önceki mesajımı tekrar okursanız kontrolü

Kod: Tümünü seç

if Pos('l2i', Memo1.Lines[K]) >0 then 

şeklinde yapmanız gerek demiştim...

[sr1111]

2 sorunum daha olustu.
1- 5000-15000 kelime de cok yavas, hatta kilitleniyor daha hizli nasil yaparim.
2- 1 karakter degil de 5-6 karakter kullanmak istiyorum. asagida gibi yapmaya calistim yapamadim.


soyle br sey yaptim ama bir yerde hata yapiyorum. yapamadim.

function StringKontrol1(KontrolEdilecek:string):TSetOfChar;
var
i,sayac:integer;
WordSeparatorSet: TSetOfChar;
begin
sayac:=0;
WordSeparatorSet := ['l', 't', 'c', 'b'];
for i:=1 to length(KontrolEdilecek) do
begin
if KontrolEdilecek In WordSeparatorSet then
begin
sayac:=sayac+1;
result:=result+WordSeparatorSet+inttostr(sayac);
end
else
result:=result+KontrolEdilecek;
end;
end;

[unicorn64]

fonksiyondan geriye neden TSetOfChar döndünüz ki string daha uygun bence...
kilitlenme olmaz sadece işlem uzun süreceği için program tepkisiz gibi görünüyordur, döngünün içinde

Kod: Tümünü seç

Application.ProcessMessages;

eklerseniz kilitlenmiş gibi görünmez...
ayrıca aranan karakteri bulduğunuz kısımda result a WordSeparatorSet i değil KontrolEdilecek yi eklemeniz gerekir

Kod: Tümünü seç

function StringKontrol1(KontrolEdilecek:string):string;
var
   i,sayac:integer;
   WordSeparatorSet: TSetOfChar;
begin
   sayac:=0;
   WordSeparatorSet := ['l', 't', 'c', 'b'];
   for i:=1 to length(KontrolEdilecek) do
   begin
      if KontrolEdilecek[i] In WordSeparatorSet then
      begin
          sayac:=sayac+1;
          result:=result+KontrolEdilecek[i]+inttostr(sayac);
      end
      else
          result:=result+KontrolEdilecek[i];
      Application.ProcessMessages;
   end;
end;

bir de forumda kod yazarken code bloğuna alırsanız mesajınız daha okunaklı olur...