memodaki zor string için yardim

[sr1111]

s.a
yardimci olursaniz sevinirim. bir türlü başaramadim
memoda şöyle kelimelerim var.

herzaman
dekorasyon/u,unu,a,da,uyla,unda,un,una,la
işçiliğim
çekilmeliyim
yüreğimizden
armağan/ı,lar,ın,ını,ları,ıdır,a,dır,larla
gelse
gitsem

benim istediğim sadece asagidaki kelimeleri sonunda / olan kelimeleri yanindaki ile birleştirip memoya yazmasi.
dekorasyon/
armağan/

memodaki sonuç şu olmali;
herzaman
dekorasyonu
dekorasyonunu
dekorasyona
dekorasyonda
dekorasyonuyla
dekorasyonunda
dekorasyonun
dekorasyonuna
dekorasyonla
işçiliğim
çekilmeliyim
yüreğimizden
armağanı
armağanlar
armağanın
armağanını
armağanları
armağanıdır
armağana
armağandır
armağanlarla
gelse
gitsem

[Lost Soul]

elemanlar memo1,memo2,button1

ekler.rar

Proje (D2010)

(9.07 KiB) 76 kere indirildi

Kod: Tümünü seç

unit fmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  CharSet = Set of char;
type
  Tmain = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Function ExtractWord(N: Integer; S: AnsiString; WordDelims: CharSet): AnsiString;
    Function WordCount(stText: AnsiString; Delimiters: CharSet = []): integer;
    Procedure KelimeTuret( Satir : AnsiString; var Sonuc : TStrings);
  public
    { Public declarations }
  end;

var
  main: Tmain;

implementation

{$R *.dfm}




Function TMain.ExtractWord(N: Integer; S: AnsiString; WordDelims: CharSet): AnsiString;
Var
  I, J: Word;
  Count: Integer;
  SLen: Integer;
Begin
  Count := 0;
  I := 1;
  Result := '';
  SLen := Length(S);
  While I <= SLen Do
  Begin
    { preskoc oddelovace }
    While (I <= SLen) And (S[i]In WordDelims) Do
      Inc(I);
    { neni-li na konci retezce, bude nalezen zacatek slova }
    If I <= SLen Then Inc(Count);
    J := I;
    { a zde je konec slova }
    While (J <= SLen) And Not(S[J]In WordDelims) Do
      Inc(J);
    { je-li toto n-te slovo, vloz ho na vystup }
    If Count = N Then
    Begin
      Result := Copy(S, I, J - I);
      exit
    End;
    I := J;
  End; { while }
End;

Function TMain.WordCount(stText: AnsiString; Delimiters: CharSet = []): integer;
const
  // Define word separator types that we will recognise
  LF = #10;
  TAB = #9;
  CR = #13;
  BLANK = #32;
var
  WordSeparatorSet: Set of char; // We will set on only the above characters
  index: Integer; // Used to scan along the string
  inWord: Boolean; // Indicates whether we are in the middle of a word
begin
  // Turn on the TAB, CR, LF and BLANK characters in our word separator set
  if Delimiters <> [] then
    WordSeparatorSet := Delimiters
  else
    WordSeparatorSet := [LF, TAB, CR, BLANK];

  // Start with 0 words
  Result := 0;

  // Scan the string character by character looking for word separators
  inWord := False;

  for index := 1 to Length(stText) do
  begin
    // Have we found a separator character?
    if stText[index]In WordSeparatorSet then
    begin
      // Separator found - have we moved from a word?
      if inWord then
        Inc(Result); // Yes - we have ended another word

      // Indicate that we are not in a word anymore
      inWord := False;
    end
    else
      // Separator not found - we are in a word
      inWord := True;
  end;

  // Finally, were we still in a word at the end of the string?
  // if so, we must add one to the word count since we did not meet a separator
  if inWord then
    Inc(Result);
end;

Procedure TMain.KelimeTuret(Satir: AnsiString; var Sonuc: TStrings);
var
  i:Integer;
  Kok : AnsiString;
  xSatir : AnsiString;
begin
  //dekorasyon/u,unu,a,da,uyla,unda,un,una,la
  if Pos('/',Satir)>0 then
  Begin
    xSatir := Satir;
    Kok := ExtractWord(1,xSatir,['/']);
    Delete(xSatir,1,Pos('/',xSatir));
    for i := 1 to WordCount(xSatir,[',']) do
      Sonuc.Add(Kok+ExtractWord(i,xSatir,[',']));
  End
  else
  Begin
    Sonuc.Add(Satir);
  End;

end;


procedure Tmain.Button1Click(Sender: TObject);
var
  s,s2: TStrings;
  i: Integer;
begin
  s:= TstringList.Create;
  s.Clear;
  s.Text := Memo1.Lines.Text;
  s2 := TstringList.Create;
  s2.Clear;
  for i := 0 to s.Count - 1 do
   KelimeTuret(s.Strings[i],s2);
  Memo2.Lines.Text := s2.Text;
  s.Free;
  s2.Free;

end;


end.

[sr1111]

Lost soul;
Nasıl tesekkur etsem, ne kadar etsem. Coook tesekkur ederim. Tam istedigim olmuş.

2 problemimden birisi cozuldu.

bir taneside şu;
4 listboxum var.

1. list icindeki kelimeler
elma
armut
portakal
ıspanak
pataest
domates

2.list icindeki kelimeler
lm
trk
frt
trm
prtkls
prstkl

3. listboxta sunu istiyorum
2.listbostaki harfleri 1.listboxtaki harflerde gecerse kelimeleri eklesin.
sesli harfleri görmemesi lazim. string sirasi uyanlar eklenmeli

elma
portakal

4.listboxta ise 3. gibi fakat harflerin yeri değişşede ve harflerin tamami içinde geçerse bulsun

[Lost Soul]

Bu sorunuzdaki cevaba benzder bir mantık yürütmeniz gerekecek.

[sr1111]

o cevaptan koddan benim istedigim şekli cikaramadim. çunku değiştirme yapiyor.
ben iıuxowü gibi tanimladigim sesli harfleri görmemesini istemistim.