« İnternet listelerden ibaret || İki sayı arasındaki asal sayılar »

Delphi ile heceleme programı

Çok önceden delphi ile yaptığım bir heceleme algoritması. Uzun zaman sonra görünce buraya da yazmak istedim.
Programın algoritmasını yazarken nasıl hecelediğimizi keşfetmiştim o nedenle severim bu algoritmayı.
Ayrıca bu ve benzeri kodları yayınlarken kodları renklendirebileceğim bi wp plugini bilen var mı?

  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ALScrollingText;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     Memo2: TMemo;
  13.     Button1: TButton;
  14.     procedure Button1Click(Sender: TObject);
  15.   private
  16. function sesli(harf:string):boolean;
  17.   public
  18.     { Public declarations }
  19.   end;
  20.  
  21. var
  22.   Form1: TForm1;
  23.  
  24. implementation
  25. {$R *.dfm}
  26.  
  27. function tform1.sesli(harf:string):boolean;
  28. begin
  29.  
  30. result:=false;
  31.  
  32. if harf=‘a’then  result:=true;
  33. if harf=‘e’then  result:=true;
  34. if harf=‘ı’then  result:=true;
  35. if harf=‘i’then  result:=true;
  36. if harf=‘o’then  result:=true;
  37. if harf=‘ö’then  result:=true;
  38. if harf=‘u’then  result:=true;
  39. if harf=‘ü’then  result:=true;
  40.  
  41. if harf=‘A’then  result:=true;
  42. if harf=‘E’then  result:=true;
  43. if harf=‘I’then  result:=true;
  44. if harf=‘İ’then  result:=true;
  45. if harf=‘O’then  result:=true;
  46. if harf=‘Ö’then  result:=true;
  47. if harf=‘U’then  result:=true;
  48. if harf=‘Ü’then  result:=true;
  49. end;
  50.  
  51. procedure TForm1.Button1Click(Sender: TObject);
  52. var
  53.   i:integer;
  54. begin
  55.   Memo2.Text := EmptyStr;
  56. for i := 1  to length(Memo1.Text) do
  57. begin
  58.   if
  59.       not     sesli(copy(Memo1.Text,i,1))
  60.       and     sesli(copy(Memo1.Text,i+1,1))
  61.       and not (copy(Memo1.Text,i,1)=‘ ‘)
  62.       and not (copy(Memo1.Text,i-1,1)=‘ ‘)
  63.       and not (copy(Memo1.Text,i+1,1)=‘ ‘)
  64.   then
  65.     begin
  66.      Memo2.text := Memo2.text+‘-’;
  67.     end;
  68.   if      sesli(copy(memo1.Text,i,1))
  69.       and sesli(copy(memo1.Text,i-1,1))
  70.   then
  71.     begin
  72.     Memo2.text := Memo2.text+‘-’;
  73.     end;
  74.   Memo2.Text := Memo2.Text + copy(Memo1.Text,i,1);
  75. end;
  76.  
  77. if copy(Memo2.Text,1,1) = ‘-’ then
  78. begin
  79.   Memo2.Text := copy(Memo2.Text,2,length(Memo2.text)-1);
  80. end;
  81. end;
  82.  
  83. end.

Yorumlar

Yorum yaz