Ĺadny brzuch
Witam ;)
Znalazłem pewną stronkę (link), na której jest kod, który wyszukuje z podanych liter wyraz :). Przedstawię jeszcze ten kod tutaj:
// ====================================================================== // Return a list of Anagrams - Careful, long words generate HUGE lists // List of anagrams is returned in supplied String List // ====================================================================== procedure Anagrams(const InString : string; StringList : TStrings); var MsWordApp : OleVariant; WordsChecked,WordsFound : integer; // Internal Recursive routine procedure RecursePerm(const StrA,StrB : string; Len : integer; SL : TStrings); var i : integer; A,B : string; begin // Is built up word the length we require ? if (length(StrA) = Len) then begin inc(WordsChecked); // Check if not a duplicate and search dictionary for valid // word check. if (SL.IndexOf(StrA) = -1) and MsWordApp.CheckSpelling(StrA) then begin // OK, valid word - add to string list inc(WordsFound); SL.Add(StrA); Application.ProcessMessages; end; end; for i := 1 to length(StrB) do begin // Recursively build all possible permutations of word A := StrB; B := StrA + A[i]; delete(A,i,1); RecursePerm(B,A,Len,SL); end; end; begin try // Connect to MS-Word for dictionary check MsWordApp := CreateOleObject('Word.Application'); MsWordApp.Documents.Add; WordsChecked := 0; WordsFound := 0; StringList.Clear; Application.ProcessMessages; // Change string to lowercase in case MS-Word settings to // IGNORE capitalised words. RecursePerm('',LowerCase(InString),length(InString),StringList); MessageDlg('Anagram Search Check Complete' + #13#10 + IntToStr(WordsChecked) + ' words checked' + #13#10 + IntToStr(WordsFound) + ' anagrams found', mtInformation,[mbOk],0); MsWordApp.Quit; MsWordApp := VarNull; except MessageDlg('MS-Word not Available',mtError,[mbOk],0); end; end;
Trzeba tylko do uses dodać ComObj i kod wywołać Anagrams('litery',Memo1.Lines);. Wszystko byłoby dobrze, tylko, że wyszukuje mi słowa z tą samą ilością znaków (np. gdy podam lista, to wyszuka mi lista, stila, stali). Chciałbym, aby wyszukiwało mi wszystkie kombinacje, bez względu na ilość liter (np. aby mi znalazło list, lis itp.). Co muszę zmienić w kodzie?
Edit:
Już znalazłem. Odpowiada za to linijka RecursePerm('',LowerCase(InString),length(InString),StringList); i w miejsce length(InString) jest podana wartość, ile ma zajmować słówko. Temat do zamknięcia.
Użytkownik mateok edytował ten post 28 lipiec 2009, 15:25
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
Znalazłem pewną stronkę (link), na której jest kod, który wyszukuje z podanych liter wyraz :). Przedstawię jeszcze ten kod tutaj:
// ====================================================================== // Return a list of Anagrams - Careful, long words generate HUGE lists // List of anagrams is returned in supplied String List // ====================================================================== procedure Anagrams(const InString : string; StringList : TStrings); var MsWordApp : OleVariant; WordsChecked,WordsFound : integer; // Internal Recursive routine procedure RecursePerm(const StrA,StrB : string; Len : integer; SL : TStrings); var i : integer; A,B : string; begin // Is built up word the length we require ? if (length(StrA) = Len) then begin inc(WordsChecked); // Check if not a duplicate and search dictionary for valid // word check. if (SL.IndexOf(StrA) = -1) and MsWordApp.CheckSpelling(StrA) then begin // OK, valid word - add to string list inc(WordsFound); SL.Add(StrA); Application.ProcessMessages; end; end; for i := 1 to length(StrB) do begin // Recursively build all possible permutations of word A := StrB; B := StrA + A[i]; delete(A,i,1); RecursePerm(B,A,Len,SL); end; end; begin try // Connect to MS-Word for dictionary check MsWordApp := CreateOleObject('Word.Application'); MsWordApp.Documents.Add; WordsChecked := 0; WordsFound := 0; StringList.Clear; Application.ProcessMessages; // Change string to lowercase in case MS-Word settings to // IGNORE capitalised words. RecursePerm('',LowerCase(InString),length(InString),StringList); MessageDlg('Anagram Search Check Complete' + #13#10 + IntToStr(WordsChecked) + ' words checked' + #13#10 + IntToStr(WordsFound) + ' anagrams found', mtInformation,[mbOk],0); MsWordApp.Quit; MsWordApp := VarNull; except MessageDlg('MS-Word not Available',mtError,[mbOk],0); end; end;
Trzeba tylko do uses dodać ComObj i kod wywołać Anagrams('litery',Memo1.Lines);. Wszystko byłoby dobrze, tylko, że wyszukuje mi słowa z tą samą ilością znaków (np. gdy podam lista, to wyszuka mi lista, stila, stali). Chciałbym, aby wyszukiwało mi wszystkie kombinacje, bez względu na ilość liter (np. aby mi znalazło list, lis itp.). Co muszę zmienić w kodzie?
Edit:
Już znalazłem. Odpowiada za to linijka RecursePerm('',LowerCase(InString),length(InString),StringList); i w miejsce length(InString) jest podana wartość, ile ma zajmować słówko. Temat do zamknięcia.
Użytkownik mateok edytował ten post 28 lipiec 2009, 15:25