home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 August / Chip_1999-08_cd.bin / tema / Ozogan / RUNTIME / APLIKACE.EXE / MORSE.KL3 < prev    next >
Text File  |  1999-06-19  |  8KB  |  204 lines
  1. Program morse;
  2.  
  3. {**************************************}
  4. { Program pro v²poΦet plochy a obvodu  }
  5. { Autor: Petr Ozogßn, 19.6.1999        }
  6. {**************************************}
  7.  
  8. Function TxtToMor(txt: char): String;
  9. begin
  10.    txt:= UpperCase(txt); Result := txt+'/';
  11.    if txt = 'A' then Result := '.-/';     if txt = 'B' then Result := '-.../';
  12.    if txt = 'C' then Result := '-.-./';   if txt = 'D' then Result := '-../';
  13.    if txt = 'E' then Result := './';      if txt = 'F' then Result := '..-./';
  14.    if txt = 'G' then Result := '--./';    if txt = 'H' then Result := '..../';
  15.    if txt = 'I' then Result := '../';     if txt = 'J' then Result := '.---/';
  16.    if txt = 'K' then Result := '-.-/';    if txt = 'L' then Result := '.-../';
  17.    if txt = 'M' then Result := '--/';     if txt = 'N' then Result := '-./';
  18.    if txt = 'O' then Result := '---/';    if txt = 'P' then Result := '.--./';
  19.    if txt = 'Q' then Result := '--.-/';   if txt = 'R' then Result := '.-./';
  20.    if txt = 'S' then Result := '.../';    if txt = 'T' then Result := '-/';
  21.    if txt = 'U' then Result := '..-/';    if txt = 'V' then Result := '...-/';
  22.    if txt = 'W' then Result := '.--/';    if txt = 'X' then Result := '-..-/';
  23.    if txt = 'Y' then Result := '-.--/';   if txt = 'Z' then Result := '--../';
  24.  
  25.    if txt = '1' then Result := '.----/';  if txt = '2' then Result := '..---/';
  26.    if txt = '3' then Result := '...--/';  if txt = '4' then Result := '....-/';
  27.    if txt = '5' then Result := '...../';  if txt = '6' then Result := '-..../';
  28.    if txt = '7' then Result := '--.../';  if txt = '8' then Result := '---../';
  29.    if txt = '9' then Result := '----./';  if txt = '0' then Result := '-----/';
  30.  
  31.    if txt = ' ' then Result := '/';       if txt = '"' then Result := '-...-/';
  32.    if txt = '.' then Result := '....../'; if txt = '?' then Result := '..--../';
  33.    if txt = ',' then Result := '.-.-.-/'; if txt = ':' then Result := '---.../';
  34.    if txt = '!' then Result := '--..--/'; if txt = '-' then Result := '-....-/';
  35.    {nßsledujφcφ znak je asi dopln∞n chybn∞, jinak by to ale nefungovalo}
  36.    if txt = '/' then Result := '------/';
  37. end;
  38.  
  39. Function MorToTxt(mor: String): char;
  40. begin
  41.    Result := '/'+Copy(MOR, 1, Length(MOR)-1)+'/';
  42.    if mor = '.-/'     then Result := 'A';  if mor = '-.../'   then Result := 'B';
  43.    if mor = '-.-./'   then Result := 'C';  if mor = '-../'    then Result := 'D';
  44.    if mor = './'      then Result := 'E';  if mor = '..-./'   then Result := 'F';
  45.    if mor = '--./'    then Result := 'G';  if mor = '..../'   then Result := 'H';
  46.    if mor = '../'     then Result := 'I';  if mor = '.---/'   then Result := 'J';
  47.    if mor = '-.-/'    then Result := 'K';  if mor = '.-../'   then Result := 'L';
  48.    if mor = '--/'     then Result := 'M';  if mor = '-./'     then Result := 'N';
  49.    if mor = '---/'    then Result := 'O';  if mor = '.--./'   then Result := 'P';
  50.    if mor = '--.-/'   then Result := 'Q';  if mor = '.-./'    then Result := 'R';
  51.    if mor = '.../'    then Result := 'S';  if mor = '-/'      then Result := 'T';
  52.    if mor = '..-/'    then Result := 'U';  if mor = '...-/'   then Result := 'V';
  53.    if mor = '.--/'    then Result := 'W';  if mor = '-..-/'   then Result := 'X';
  54.    if mor = '-.--/'   then Result := 'Y';  if mor = '--../'   then Result := 'Z';
  55.    if mor = '.----/'  then Result := '1';  if mor = '..---/'  then Result := '2';
  56.    if mor = '...--/'  then Result := '3';  if mor = '....-/'  then Result := '4';
  57.    if mor = '...../'  then Result := '5';  if mor = '-..../'  then Result := '6';
  58.    if mor = '--.../'  then Result := '7';  if mor = '---../'  then Result := '8';
  59.    if mor = '----./'  then Result := '9';  if mor = '-----/'  then Result := '0';
  60.  
  61.  
  62.    if mor = '/'       then Result := ' ';  if mor = '///'     then Result := '.';
  63.    if mor = '....../' then Result := '.';  if mor = '..--../' then Result := '?';
  64.    if mor = '.-.-.-/' then Result := ',';  if mor = '---.../' then Result := ':';
  65.    if mor = '--..--/' then Result := '!';  if mor = '-....-/' then Result := '-';
  66.    if mor = '-...-/'  then Result := '"';
  67.    {nßsledujφcφ znak je asi dopln∞n chybn∞, jinak by to ale nefungovalo}
  68.    if mor = '------/' then Result := '/';
  69. end;
  70.  
  71. procedure TForm.ButtonToMORClick(Sender: TObject);
  72. Var x, y: Integer; RadTxt, RadMor, Bak, Pismeno: String;
  73. begin
  74.    Bak := '';
  75.    RadMor := '';
  76.    MemoMOR.Clear;
  77.    for x:= 0 to MemoTXT.Lines.Count-1 do
  78.    begin
  79.       RadTxt:= CsWinToAsc(MemoTXT.Lines[x]);
  80.       for y:= 1 to Length(RadTxt) do
  81.       begin
  82.          Pismeno := Copy(RadTxt, y, 1);
  83.          if (Bak+Pismeno<>'  ') then RadMor:= RadMor + TxtToMor(Pismeno);
  84.          if Length(RadMor)>65 then
  85.          begin
  86.             MemoMOR.Lines.Add(RadMor); RadMor := '';
  87.          end;
  88.          Bak := Pismeno;
  89.       end;
  90.       RadMor:= RadMor + '/';
  91.    end;
  92.    MemoMOR.Lines.Add(RadMor);
  93.    MemoMOR.SelStart := 1;
  94. end;
  95.  
  96. procedure TForm.ButtonToTXTClick(Sender: TObject);
  97. Var poz, x, y: Integer; RadTxt, Pismeno, RadMor: String;
  98. begin
  99.    RadTxt := '';
  100.    MemoTXT.Clear;
  101.    for x:= 0 to MemoMOR.Lines.Count-1 do
  102.    begin
  103.       RadMor:= MemoMor.Lines[x];
  104.       if Pos('/', RadMor) = 0 then RadMor := RadMor + '/';
  105.       While Length(RadMor) > 0 do
  106.       begin
  107.          Poz := Pos('/', RadMor);
  108.          if Poz = 0 then RadMor := '';
  109.          Pismeno := Copy(RadMor, 1, Poz);
  110.          RadTxt:= RadTxt + MorToTxt(Pismeno);
  111.          if Length(RadTxt)>65 then
  112.          begin
  113.             MemoTXT.Lines.Add(RadTxt); RadTxt := '';
  114.          end;
  115.          RadMor := Copy(RadMor, Poz+1, Length(RadMor)-Poz);
  116.       end;
  117.    end;
  118.    MemoTXT.Lines.Add(RadTxt);
  119. end;
  120.  
  121. procedure TForm.ButtonLoadTXTClick(Sender: TObject);
  122. begin
  123.    OpenDialog.DefaultExt := 'TXT';
  124.    OpenDialog.Filter := 'Texty *.txt|*.txt';
  125.    If OpenDialog.Execute then MemoTXT.Lines.LoadFromFile(OpenDialog.FileName);
  126. end;
  127.  
  128. procedure TForm.ButtonLoadMORClick(Sender: TObject);
  129. begin
  130.    OpenDialog.DefaultExt := 'MOR';
  131.    OpenDialog.Filter := 'Morseovka *.mor|*.mor';
  132.    If OpenDialog.Execute then MemoMOR.Lines.LoadFromFile(OpenDialog.FileName);
  133. end;
  134.  
  135. procedure TForm.ButtonSaveTXTClick(Sender: TObject);
  136. begin
  137.    SaveDialog.DefaultExt := 'TXT';
  138.    SaveDialog.Filter := 'Texty *.txt|*.txt';
  139.    If SaveDialog.Execute then MemoTXT.Lines.SaveToFile(SaveDialog.FileName);
  140. end;
  141.  
  142. procedure TForm.ButtonSaveMORClick(Sender: TObject);
  143. begin
  144.    SaveDialog.DefaultExt := 'MOR';
  145.    SaveDialog.Filter := 'Morseovka *.mor|*.mor';
  146.    If SaveDialog.Execute then MemoMOR.Lines.SaveToFile(SaveDialog.FileName);
  147. end;
  148.  
  149. procedure TForm.ButtonClearTXTClick(Sender: TObject);
  150. begin
  151.    MemoTXT.Clear;
  152. end;
  153.  
  154. procedure TForm.ButtonClearMORClick(Sender: TObject);
  155. begin
  156.    MemoMOR.Clear;
  157. end;
  158.  
  159. procedure TForm.ButtonCloseClick(Sender: TObject);
  160. begin
  161.   Form.Close;
  162. end;
  163.  
  164. procedure TForm.FormResize(Sender: TObject);
  165. begin
  166.    ButtonClose.Left := Form.Width - 115;
  167.    Panel2.Height := (Form.ClientHeight-50)/2;
  168. end;
  169.  
  170. procedure TForm.ButtonPrintTXTClick(Sender: TObject);
  171. Var x: Integer; RadTxt : String;
  172. begin
  173.    if MessageDlg('Opravdu vytisknout text ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  174.    begin
  175.       ConsoleClear;
  176.       ConsoleHide;
  177.       for x:= 0 to MemoTXT.Lines.Count-1 do
  178.       begin
  179.          RadTxt:= MemoTXT.Lines[x];
  180.          Writeln(RadTxt);
  181.       end;
  182.       ConsolePrint;
  183.    end;
  184. end;
  185.  
  186. procedure TForm.ButtonPrintMORClick(Sender: TObject);
  187. Var x: Integer; RadMor : String;
  188. begin
  189.    if MessageDlg('Opravdu vytisknout morseovku ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  190.    begin
  191.       ConsoleClear;
  192.       ConsoleHide;
  193.       for x:= 0 to MemoMOR.Lines.Count-1 do
  194.       begin
  195.          RadMor:= MemoMOR.Lines[x];
  196.          Writeln(RadMor);
  197.       end;
  198.       ConsolePrint;
  199.    end;
  200. end;
  201.  
  202. end.
  203.  
  204.