KennyToNormal

From 40tude Dialog Wiki

Encodes and decodes Kenny language, Rot13, Hex, Mirror Text, Base64, Morse Code, Foenigen and the LF-Language. In short: The swiss knife for 40tude Dialog ;-)

This script is an enhanced version of Guerin's Kenny-Translator. Thomas Barghahn extended it with a mirroring function, Base64 conversion, Hex text, F <-> K (in German called "Foenigen") and the LF-Language (a German children's "secret language"). He also implemented CTRL + A for selecting the whole text.


See the Swiss Knife in action:

Kennymirrorhexrot13morsebase64.png


If you want to use it independently from Dialog, you can download the standalone Kenny-Translator.


Program Kenny_Mirror_Hex_Rot13_Morse_Base64_Translater;

{ Version 4 Date: 2004/10/15 - 20:37
  compile and run with Dialog version 2.0.14.1 (Beta 37)
  Check the source code or save your data before use.}


uses
   Forms, StdCtrls;

CONST
   LetterSeparator = ' ';
   WordSeparator = '  ';



VAR
   CoderForm : TForm;
   CoderMemo : TMemo;
   CoderBtQuit : TButton;
   Rot13Bt : TButton;
   FromKennyBt :TButton;
   FromMorseBt : TButton;
   IntoKenny : TButton;
   IntoMorse : TButton;
   MirrorBt : TButton;
   RoRrImBT : TButton; 
   IntoHexBt : TButton;
   FromHexBt : TButton;
   IntoBase64Bt : TButton;
   FromBase64Bt : TButton;
   ClearMemoBt : TButton;
   ChangeFKBt : TButton;
   IntoLFBt : TButton;
   FromLFBt : TButton;
   Free1Bt : TButton;
   Free2Bt : TButton;
   CodeMorse : TstringList;
   CodeLetter:  TstringList;
   Index : INTEGER;
   CodeLine : String;
   EqualPos : INTEGER;

   FUNCTION DecodeMorseWords(MorseWord : String) : String;

   VAR
      LetterSeparatorPos : INTEGER;
      MorseChar : string;

   BEGIN  {DecodeMorseWords}
      Result := '';
      LetterSeparatorPos := Pos(LetterSeparator, MorseWord);
      WHILE  LetterSeparatorPos > 0 DO
      BEGIN
         MorseChar := Copy(MorseWord,1, LetterSeparatorPos-1);
         delete(MorseWord,1, LetterSeparatorPos);
         IF CodeLetter.IndexOfName(MorseChar) = -1 THEN
            Result := Result + MorseChar
         ELSE
         BEGIN
            Result := Result +  CodeLetter.Values[MorseChar];
            IF CodeLetter.Values[MorseChar] = 'SOS' THEN
               Result := Result+' ';
         END;
         LetterSeparatorPos := Pos(LetterSeparator, MorseWord);
      END;
      IF MorseWord > '' THEN
         IF CodeLetter.IndexOfName(MorseWord) = -1 THEN
            Result := Result + MorseWord
         ELSE
            Result := Result +   CodeLetter.Values[MorseWord];
      Result := Result +' ';
   END;   {DecodeMorseWords}

   FUNCTION DecodeMorseLine(Line : String) : String;

   VAR
      WordBuffer : string;
      WordSeparatorPos : INTEGER;
      Index : INTEGER;
   BEGIN
      Result := '';
      FOR Index := Length(Line) DOWNTO 1 DO
      BEGIN
         IF (Line[index] < ' ') THEN
            Insert(' ', line, index+1);
      END;
      WordSeparatorPos := POS(WordSeparator, Line);
      WHILE WordSeparatorPos > 0 DO
      BEGIN
         WordBuffer := Copy(Line,1, WordSeparatorPos-1);
         delete(Line,1, WordSeparatorPos);
         Result := Result + DecodeMorseWords(WordBuffer);
         WordSeparatorPos := Pos(WordSeparator, Line);
      END;
      IF Line > '' THEN
         Result := Result +   DecodeMorseWords(Line);
   END; {DecodeMorseLine}

   PROCEDURE NormalizeLineFeed(VAR Source : string);

   VAR
      LineSeparatorPos : INTEGER;

   BEGIN
      {normalize line feed (#10, #13#10, #10#13,#13 to #13}
      LineSeparatorPos := POS(#10, Source);
      WHILE LineSeparatorPos > 0 DO
      BEGIN
         delete(Source, LineSeparatorPos, 1);
         insert(#13, Source, LineSeparatorPos);
         LineSeparatorPos := POS(#10, Source);
      END;
      LineSeparatorPos := POS(#13#13, Source);
      WHILE LineSeparatorPos > 0 DO
      BEGIN
         delete(Source, LineSeparatorPos, 1);
         LineSeparatorPos := POS(#13#13, Source);
      END;
   END;

   FUNCTION DecodeMorse(Source : string) :string;

   VAR
      Line : String;
      LineSeparatorPos : INTEGER;


   BEGIN
      Result := '';
      NormalizeLineFeed(Source);
      LineSeparatorPos := POS(#13, Source);
      WHILE LineSeparatorPos > 0 DO
      BEGIN
         Line := Copy(Source,1, LineSeparatorPos-1);
         Result := Result + DecodeMorseLine(Line);
         delete(Source, 1, LineSeparatorPos);
         Result := Result +#13#10;
         LineSeparatorPos := POS(#13, Source);
      END;
      IF Source > '' THEN
         Result := Result +  DecodeMorseLine(Source);
   END;

   PROCEDURE BitBtMorseToTextClick(Sender: TObject);

   VAR
      DecodeBuffer : string;
      LengthBuffer : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      DecodeBuffer := CoderMemo.SelText;
      LengthBuffer := Length(DecodeBuffer);
      IF LengthBuffer > 1 THEN
      BEGIN
      {replace space at the beginning or / and at the end of morsestring by my morse wordseparator}
         IF (DecodeBuffer[LengthBuffer] = ' ') AND (DecodeBuffer[LengthBuffer-1] <> '/') THEN
            DecodeBuffer := DecodeBuffer +'/ ';
         IF (DecodeBuffer[1] = ' ') AND (DecodeBuffer[2] <> '/') THEN
            DecodeBuffer := ' /'+ DecodeBuffer;
      END;
      CoderMemo.SelText := DecodeMorse(DecodeBuffer);
      CoderMemo.SetFocus;
   END;

   FUNCTION CodeTextWord( TextWord : String): STRING;

   BEGIN
      Result := '';
      WHILE TextWord > '' DO
         IF TextWord = 'SOS' THEN
         BEGIN
            Result := Result +  CodeMorse.Values['SOS'];
            TextWord := '';
         END
         ELSE
         IF CodeMorse.IndexOfName(TextWord[1]) = -1 THEN
         {Not a morse code}
         BEGIN
            IF TextWord[1] >= ' ' THEN
            {printable char}
               Result := Result + TextWord[1]+' '
            ELSE
               Result := Result + TextWord[1];
            delete(TextWord, 1, 1);
         END
         ELSE
         BEGIN
            Result := Result +  CodeMorse.Values[TextWord[1]]+' ';
            delete(TextWord, 1, 1)
         END
   END;

   FUNCTION CodeTextLine(TextLine : String) : String;

   VAR
      WordBuffer : STRING;
      WordSeparatorPos : INTEGER;

   BEGIN
      Result := '';
      WordSeparatorPos :=  POS(' ', TextLine) ;
      WHILE WordSeparatorPos > 0 DO
      BEGIN
         IF Pos(' / ', TextLine) = 1 THEN
         BEGIN
            Result := Result + CodeMorse.Values[' / '];
            delete(TextLine, 1, 3);
         END
         ELSE
         BEGIN
            WordBuffer := Copy(TextLine, 1, WordSeparatorPos-1);
            Result := Result + CodeTextWord(WordBuffer)+' ';
            Delete(TextLine, 1 ,WordSeparatorPos);
         END;
         WordSeparatorPos :=  POS(' ', TextLine) ;
      END;
      IF TextLine > '' THEN
         Result := Result+ CodeTextWord(TextLine);
   END;

   FUNCTION CodeToMorse(Source : string) :string;

   VAR
      LineSeparatorPos : INTEGER;
      Line : String;
   BEGIN
      Result := '';
      Source := UpperCase(Source);
      {normilize linefeed}
      NormalizeLineFeed(Source);
      LineSeparatorPos := pos(#13, Source);
      WHILE LineSeparatorPos > 0 DO
      BEGIN
         Line := Copy(Source, 1, LineSeparatorPos-1);
         result := result + CodeTextLine(Line)+ #13#10;
         delete(Source, 1,LineSeparatorPos);
         LineSeparatorPos := pos(#13, Source);
      END;
      IF Source > '' THEN
         result := result + CodeTextLine(Source)+ #13#10;
   END;

   PROCEDURE BitBtTextToMorseClick(Sender: TObject);

   VAR
      CodeBuffer : String;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      CodeBuffer := CoderMemo.SelText;
      CoderMemo.SelText := CodeToMorse(CodeBuffer);
      CoderMemo.SetFocus;      
   END;

   FUNCTION KennyToNormal (Source : string ): string;

   BEGIN
      CASE Source[1] OF
         'm':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 'a';
               'p': result := 'b';
               'f': result := 'c';
            END; {Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'd';
               'p': result := 'e';
               'f': result := 'f';
            END; {Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'g';
               'p': result := 'h';
               'f': result := 'i';
            END;  {Source[3]}
         END;{Source[2]}
         'p':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 'j';
               'p': result := 'k';
               'f': result := 'l';
            END;{Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'm';
               'p': result := 'n';
               'f': result := 'o';
            END; {Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'p';
               'p': result := 'q';
               'f': result := 'r';
            END; {Source[3]}
         END; {Source[2]}
         'f':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 's';
               'p': result := 't';
               'f': result := 'u';
            END;{Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'v';
               'p': result := 'w';
               'f': result := 'x';
            END; {Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'y';
               'p': result := 'z';
            END; {Source[3]}
         END; {Source[2]}
         'M':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 'A';
               'p': result := 'B';
               'f': result := 'C';
            END; {Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'D';
               'p': result := 'E';
               'f': result := 'F';
            END; {Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'G';
               'p': result := 'H';
               'f': result := 'I';
            END; {Source[3]}
         END; {Source[2]}
         'P':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 'J';
               'p': result := 'K';
               'f': result := 'L';
            END; {Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'M';
               'p': result := 'N';
               'f': result := 'O';
            END;{Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'P';
               'p': result := 'Q';
               'f': result := 'R';
            END; {Source[3]}
         END; {Source[2]}
         'F':
         CASE Source[2] OF
            'm':
            CASE Source[3] OF
               'm': result := 'S';
               'p': result := 'T';
               'f': result := 'U';
            END;{Source[3]}
            'p':
            CASE Source[3] OF
               'm': result := 'V';
               'p': result := 'W';
               'f': result := 'X';
            END; {Source[3]}
            'f':
            CASE Source[3] OF
               'm': result := 'Y';
               'p': result := 'Z';
            END; {Source[3]}
         END {Source[2]}
      END {Source[1]}
   END;

   PROCEDURE BitBtKennyToNormalClick(Sender: TObject);

   VAR
      Index : INTEGER;
      SelBuffer : String;
      TestBuffer : STRING;


   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      SelBuffer := CoderMemo.SelText;
      {IF Kenny was decoded from Morse, only uppercase letter
       are in the code when no triplet has the last two letter
       uppercase. It allows a multiple coding translation like
       rot13 + Kenny+Rot13+Morse and recerse.
       It is not possible to restore exactly the initial sentence
       but it is readable ;-) }

       {Start uppercase translation at the end of the string}
      Index := Length(SelBuffer)-2;
      WHILE Index > 0  DO
      BEGIN
         {copy triplet}
         TestBuffer := Copy(Selbuffer,Index,3);
         {is Triplet a kenny triplet}
         IF ((TestBuffer[1] = 'F')
            OR (TestBuffer[1] = 'M')
            OR (TestBuffer[1] = 'P')
            OR (TestBuffer[1] = 'f')
            OR (TestBuffer[1] = 'm')
            OR (TestBuffer[1] = 'p'))
         AND
            ((TestBuffer[2] = 'F')
            OR (TestBuffer[2] = 'M')
            OR (TestBuffer[2] = 'P')
            OR (TestBuffer[2] = 'f')
            OR (TestBuffer[2] = 'm')
            OR (TestBuffer[2] = 'p'))
         AND
            ((TestBuffer[3] = 'F')
            OR (TestBuffer[3] = 'M')
            OR (TestBuffer[3] = 'P')
            OR (TestBuffer[3] = 'f')
            OR (TestBuffer[3] = 'm')
            OR (TestBuffer[3] = 'p'))
         THEN
         {If last two figures translated into uppercase by morse, do it lower case}
         BEGIN
            IF (TestBuffer[2] = 'F')
            OR (TestBuffer[2] = 'M')
            OR (TestBuffer[2] = 'P') THEN
               TestBuffer[2] := Chr(Byte(Ord(TestBuffer[2])+32));
            IF (TestBuffer[3] = 'F')
            OR (TestBuffer[3] = 'M')
            OR (TestBuffer[3] = 'P') THEN
               TestBuffer[3] := Chr(Byte(Ord(TestBuffer[3])+32));
            TestBuffer := KennyToNormal(TestBuffer);
            Delete(Selbuffer, Index, 3);
            Insert(TestBuffer, Selbuffer, Index);
            Index := Index-3;
         END
         ELSE
            Index := index-1
      END;
      CoderMemo.Seltext := SelBuffer;
      CoderMemo.SetFocus;      
   END;


   FUNCTION To_Kennyspeak (source : string) : string;

   VAR
      Index :  integer;

   BEGIN
       Result :='';
       Index := 1;
       WHILE Index <= Length(Source) DO
       BEGIN
          IF (Source[Index] < 'A')
          OR ((Source[Index] >'Z') AND (Source[Index]<'a'))
          OR (Source[Index] >'z') THEN
             Result := Result+Source[Index]
          else
             CASE Source[Index] OF
             'a': result := result+'mmm';
             'b': result := result+'mmp';
             'c': result := result+'mmf';
             'd': result := result+'mpm';
             'e': result := result+'mpp';
             'f': result := result+'mpf';
             'g': result := result+'mfm';
             'h': result := result+'mfp';
             'i': result := result+'mff';
             'j': result := result+'pmm';
             'k': result := result+'pmp';
             'l': result := result+'pmf';
             'm': result := result+'ppm';
             'n': result := result+'ppp';
             'o': result := result+'ppf';
             'p': result := result+'pfm';
             'q': result := result+'pfp';
             'r': result := result+'pff';
             's': result := result+'fmm';
             't': result := result+'fmp';
             'u': result := result+'fmf';
             'v': result := result+'fpm';
             'w': result := result+'fpp';
             'x': result := result+'fpf';
             'y': result := result+'ffm';
             'z': result := result+'ffp';
             'A': result := result+'Mmm';
             'B': result := result+'Mmp';
             'C': result := result+'Mmf';
             'D': result := result+'Mpm';
             'E': result := result+'Mpp';
             'F': result := result+'Mpf';
             'G': result := result+'Mfm';
             'H': result := result+'Mfp';
             'I': result := result+'Mff';
             'J': result := result+'Pmm';
             'K': result := result+'Pmp';
             'L': result := result+'Pmf';
             'M': result := result+'Ppm';
             'N': result := result+'Ppp';
             'O': result := result+'Ppf';
             'P': result := result+'Pfm';
             'Q': result := result+'Pfp';
             'R': result := result+'Pff';
             'S': result := result+'Fmm';
             'T': result := result+'Fmp';
             'U': result := result+'Fmf';
             'V': result := result+'Fpm';
             'W': result := result+'Fpp';
             'X': result := result+'Fpf';
             'Y': result := result+'Ffm';
             'Z': result := result+'Ffp';
          END;
          Index := Index+1;
       END;
   END;

   PROCEDURE BitBtTextToKennyClick(Sender: TObject);

   VAR
      CodeBuffer : String;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      CodeBuffer := CoderMemo.SelText;
      CoderMemo.Seltext := To_Kennyspeak(CodeBuffer);
      CoderMemo.SetFocus;      
   END;

   PROCEDURE BtMirrorClick(Sender: TObject);

   VAR
      Buffer : String;
      MirrorBuffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      FOR Letter := Length(Buffer) DOWNTO 1 DO
      BEGIN
       IF (copy(Buffer, Letter, 1) = #10) AND (copy(Buffer, Letter + 1, 1) <> #13) THEN
        BEGIN
         WHILE copy(Buffer, Letter, 1) = #10 DO
          BEGIN
           MirrorBuffer := MirrorBuffer + #13#10;
           Letter := Letter - 2;
          END;
           Letter := Letter + 1;
        END
       ELSE 
         MirrorBuffer := MirrorBuffer + COPY(Buffer, Letter, 1);
      END;
      CoderMemo.SelText := MirrorBuffer;
      CoderMemo.SetFocus;      
   END;

   PROCEDURE BtRorrimClick(Sender: TObject);

   VAR
      Buffer : String;
      MirrorBuffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      FOR Letter := Length(Buffer) DOWNTO 1 DO
      BEGIN
       IF (copy(Buffer, Letter, 1) = #10) AND (copy(Buffer, Letter + 1, 1) <> #13) THEN
        BEGIN
         WHILE copy(Buffer, Letter, 1) = #10 DO
          BEGIN
           MirrorBuffer := MirrorBuffer + #13#10;
           Letter := Letter - 2;
          END;
           Letter := Letter + 1;
        END
       ELSE
         BEGIN
          IF (Letter mod 2) = 0 THEN
            MirrorBuffer := MirrorBuffer + UpperCase(COPY(Buffer, Letter, 1))
           ELSE
            MirrorBuffer := MirrorBuffer + LowerCase(COPY(Buffer, Letter, 1)); 
         END;    
      END;
      CoderMemo.SelText := MirrorBuffer;
      CoderMemo.SetFocus;      
   END;

   PROCEDURE BtToHexClick(Sender: TObject);

   VAR
      Buffer : String;
      HexBuffer : String;
      Letter : INTEGER;
      
   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      FOR Letter := 1 TO Length(Buffer) DO
       BEGIN 
         IF (((Letter / 16) - Int(Letter / 16)) <> 0) AND (Letter < Length(Buffer)) THEN
          HexBuffer := HexBuffer + IntToHex(ord(Buffer[Letter]),2) + ' '
         ELSE
          HexBuffer := HexBuffer + IntToHex(ord(Buffer[Letter]),2) + #13#10; 
       END;
      CoderMemo.SelText := HexBuffer;
      CoderMemo.SetFocus;      
   END;

   PROCEDURE BtFromHexClick(Sender: TObject);

   VAR
      Buffer : String;
      HexBuffer : String;
      Letter : INTEGER;
      Temp : String;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      HexBuffer := CoderMemo.SelText;
      FOR Letter := 1 TO Length(HexBuffer) DO
       BEGIN 
        TRY 
         Temp := '$' + HexBuffer[Letter] + HexBuffer[Letter + 1]; 
         Buffer := Buffer + chr(StrToInt(Temp));
         Letter := Letter + 2;
         IF HexBuffer[Letter] = chr($0D) THEN
          Letter := Letter + 1;
        EXCEPT
        END;         
       END;
      CoderMemo.SelText := Buffer;
      CoderMemo.SetFocus;      
   END;

   PROCEDURE BtRot13Click(Sender: TObject);

   VAR
      Buffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      FOR Letter := 1 TO Length(Buffer) DO
      BEGIN
         IF ((Buffer[letter] >= 'A' )AND (Buffer[letter]<='M'))
         OR ((Buffer[letter]>= 'a')  AND( Buffer[letter]<= 'm')) THEN
            Buffer[letter] := chr(ord(Buffer[letter])+13)
         ELSE IF ((Buffer[letter] >='N') AND (Buffer[letter] <='Z'))
         OR (( Buffer[letter]>='n')  AND (Buffer[letter] <='z')) THEN
            Buffer[letter] := chr(ord(Buffer[letter])-13);
      END;
      CoderMemo.SelText := Buffer;
      CoderMemo.SetFocus;      
   END;

   FUNCTION Power(Base, Exponent: Integer): Extended;
    
   VAR
    Temp_Result : Integer;
    i : Integer;
    
    BEGIN
     IF Exponent = 0 THEN
      Temp_Result := 1
     ELSE IF (Base = 0) AND (Exponent > 0) THEN
      Temp_Result := 0
     ELSE IF Exponent = 1 THEN
      Temp_Result := Base
     ELSE IF Exponent = 2 THEN
      Temp_Result := Base * Base
     ELSE
      BEGIN
       Temp_Result := Base;
       FOR i := 2 TO Exponent DO
         Temp_Result := Temp_Result * Base; 
      END;
     Result := Temp_Result;
   END;

   PROCEDURE Str (X : Extended; VAR S : String);
 
   VAR DotPos : Integer;
 
   BEGIN
    S := FloatToStr (X);
    DotPos := Pos ('.',S);
    IF DotPos > 0 THEN
     S := copy (S,1,DotPos - 1);
   END;

   FUNCTION CharToBin(InChar : Char; ByteGroup : Byte) : String;

   VAR
    IntValue : Byte;
    DecChar : Extended;
    TempStr : String;
    Temp : String;
    i : Integer;

   BEGIN
    TempStr := '';
    IntValue := ord(InChar);
    DecChar := IntValue;
    FOR i := (ByteGroup - 1) DOWNTO 0 DO
     BEGIN
      Str(Int(DecChar / Power(2,i)),Temp);
      TempStr := TempStr + Temp;
      DecChar := DecChar - (Int(DecChar / Power(2,i)) * Power(2,i));
     END;
    Result := TempStr;
   END;

   FUNCTION BinToBase (BinString : String) : String;

   VAR
    i : Integer;
    j : Integer;
    BinValue : String;
    TempStr : String;
    BinResult : Extended;
    IntResult : Integer;
 
   BEGIN
    i := 1;
    WHILE i < Length (BinString) DO
     BEGIN
      BinResult := 0;
      BinValue := copy(BinString, i, 6);
      FOR j := 0 TO 5 DO
       BEGIN
        BinResult := BinResult + StrToInt(BinValue[6-j]) * Power(2,j);
       END;
      i := i + 6;
      Str(Int(BinResult),TempStr);
      IntResult := StrToInt(TempStr);
       IF (IntResult >= 0) AND (IntResult <= 25) THEN
        BEGIN
         IntResult := IntResult + 65;
         Result := Result + chr(IntResult);
        END
       ELSE IF (IntResult >= 26) AND (IntResult <= 51) THEN
        BEGIN
         IntResult := IntResult + 71;
         Result := Result + chr(IntResult);
        END
       ELSE If (IntResult >= 52) AND (IntResult <= 61) THEN
        BEGIN
         IntResult := IntResult - 4;
         Result := Result + chr(IntResult);
        END
       ELSE If (IntResult = 62) THEN
        BEGIN
         IntResult := IntResult - 19;
         Result := Result + chr(IntResult);
        END
       ELSE If (IntResult = 63) THEN
        BEGIN
         IntResult := IntResult + 16;
         Result := Result + chr(IntResult);
        END;
     END;   {of while}
   END;

   FUNCTION DecToBin(Digit : Byte; ByteGroup : Byte) : String;

   VAR
    DecDigit : Extended;
    TempStr : String;
    Temp : String;
    i : Integer; 

   BEGIN
    TempStr := '';
    DecDigit := Digit;
    FOR i := (ByteGroup - 1) DOWNTO 0 DO
     BEGIN
      Str(Int(DecDigit / Power(2,i)),Temp);
      TempStr := TempStr + Temp;
      DecDigit := Int(DecDigit - (Int(DecDigit / Power(2,i)) * Power(2,i)));
     END;
    Result := TempStr;
   END;

   FUNCTION BinToAsc (BinString : String; ByteGroup : Byte) : String;

   VAR i : Integer;
       j : Integer;
       TempStr : String;
       Temp : String;
       BinResult : Extended;

   BEGIN
     i := 1;
     WHILE i < Length(BinString) DO
      BEGIN
       BinResult := 0;
       TempStr := copy (Binstring,i,ByteGroup);
        FOR j := ByteGroup DOWNTO 1 DO
         BEGIN 
          TRY
           BinResult := BinResult + StrToInt(TempStr[j]) * Power(2,(ByteGroup - j));
          EXCEPT                                       
          END; 
         END;
       i := i + ByteGroup;
       Str(Int(BinResult),Temp);
       Result := Result + chr(StrToInt(Temp));
      END;
   END;

   FUNCTION BaseToBin (BaseString : String) : String;
   
   VAR
    i : Integer;
    BaseResult : Integer;

   BEGIN
    i := 1;
    WHILE i <= Length (BaseString) DO
     Begin
       IF (BaseString[i] >= 'A') AND  (BaseString[i] <= 'Z') THEN
        BEGIN
         BaseResult := ord(BaseString[i]) - 65;
         Result := Result + DecToBin(BaseResult, 6);
        END
       ELSE IF (BaseString[i] >= 'a') AND  (BaseString[i] <= 'z') THEN
        BEGIN
         BaseResult := ord(BaseString[i]) - 71;
         Result := Result + DecToBin(BaseResult, 6);
        END
       ELSE IF (BaseString[i] >= '0') AND  (BaseString[i] <= '9') THEN
        BEGIN
         BaseResult := ord(BaseString[i]) + 4;
         Result := Result + DecToBin(BaseResult, 6);
        END
       ELSE IF BaseString[i] = '+' THEN
        BEGIN
         BaseResult := ord(BaseString[i]) + 19;
         Result := Result + DecToBin(BaseResult, 6);
        END
       ELSE IF BaseString[i] = '/' THEN
        BEGIN
         BaseResult := ord(BaseString[i]) - 16;
         Result := Result + DecToBin(BaseResult, 6);
        END
       ELSE IF BaseString[i] = '=' THEN
        BEGIN
         BaseResult := 0;
         Result := Result + DecToBin(BaseResult, 6);
        END;
       i := i + 1;
     END;   {of while}
   END;

   PROCEDURE IntoBaseBtClick(Sender: TObject);
   VAR
      Buffer : String;
      Letter : INTEGER;
      BinBuffer : String;
      LenBuffer : Integer;
      BaseBuffer : String;
      FillValue : Byte;
      i : Byte;
      Seperator : Integer;
      TempString : String;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      LenBuffer := Length(Buffer);
      BinBuffer := '';
      TempString := '';
      Seperator := 1;
      FillValue := 0;
      Letter := 1;
     WHILE Letter <= LenBuffer DO
       BEGIN
        BinBuffer := BinBuffer + CharToBin(Buffer[Letter],8);
        Letter := Letter + 1;
       END;
      WHILE ((LenBuffer / 3) - Int(LenBuffer / 3)) <> 0 DO
       BEGIN
        LenBuffer := LenBuffer + 1;
        FillValue := FillValue + 1;
        BinBuffer := BinBuffer + '00000000';
       END;
     BaseBuffer := BinToBase(BinBuffer);
     IF FillValue > 0 THEN
      BEGIN
       FOR i := 1 TO FillValue DO
        BEGIN
         BaseBuffer[Length(BaseBuffer) + (1 - i)] := '=';
        END;
      END;
     WHILE Seperator < Length(BaseBuffer) DO
      BEGIN
       TempString := TempString + copy (BaseBuffer,Seperator,64) + #13#10;
       Seperator := Seperator + 64;
      END;
     CoderMemo.Seltext := TempString;
     CoderMemo.SetFocus;
   END;

   PROCEDURE FromBaseBtClick(Sender: TObject);

   VAR
      BinBuffer : String;
      BaseBuffer : String;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      BaseBuffer := CoderMemo.SelText;
      BinBuffer := BaseToBin(BaseBuffer);
      CoderMemo.Seltext := BinToAsc(BinBuffer, 8);
      CoderMemo.SetFocus;      
   END;
   
   PROCEDURE ClearBtClick(Sender: TObject);
   
   BEGIN
     CoderMemo.Clear;
     CoderMemo.SetFocus;     
   END;  
   
   PROCEDURE CoderMemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

   BEGIN
    IF (Key=65) AND (Shift=[ssCtrl]) THEN
     BEGIN
     // MessageDlg('Es funktioniert!', mtInformation, [mbOK],0);
     CoderMemo.SelectAll;
     END;
   END;
   
   PROCEDURE ChangeFKBtClick(Sender: TObject);
   VAR
      Buffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      FOR Letter := 1 TO Length(Buffer) DO
      BEGIN
       CASE Buffer[Letter] OF
        'c' : BEGIN
               IF Buffer[Letter + 1] = 'k' THEN
               Buffer[Letter] := 'f';
              END; 
        'C' : BEGIN
               IF Buffer[Letter + 1] = 'K' THEN
               Buffer[Letter] := 'F';
              END; 
        'F' : BEGIN
               Buffer[Letter] := 'K';
              END;
        'f' : BEGIN
               Buffer[Letter] := 'k';
              END;
        'K' : BEGIN
               Buffer[Letter] := 'F';
              END;
        'k' : BEGIN
               Buffer[Letter] := 'f';
              END;
       END; {of Case}
      END; {FOR}
   CoderMemo.SelText := Buffer;
   CoderMemo.SetFocus;
   END;
   
   PROCEDURE InToLFBtClick(Sender: TObject);
   VAR
      Buffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText + ' ';
      Letter := 1;
      WHILE Letter <= Length(Buffer) DO
      BEGIN
       Case (Buffer[Letter]) of
    'a','A' : BEGIN
               IF Buffer[Letter + 1] = 'i' THEN
                BEGIN
                 insert ('laifai',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE IF Buffer[Letter + 1] = 'u' THEN
                BEGIN
                 insert ('laufau',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE
                BEGIN
                 insert ('lafa',Buffer,Letter + 1);
                 Letter := Letter + 4;
                END;
              END;
    'e','E' : BEGIN
               IF Buffer[Letter + 1] = 'i' THEN
                BEGIN
                 insert ('leifei',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE IF Buffer[Letter + 1] = 'u' THEN
                BEGIN
                 insert ('leufeu',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE IF Buffer[Letter + 1] = 'y' THEN
                BEGIN
                 insert ('leyfey',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE
                BEGIN
                 insert ('lefe',Buffer,Letter + 1);
                 Letter := Letter + 4;
                END;
              END;
    'i','I' : BEGIN
               IF Buffer[Letter + 1] = 'e' THEN
                BEGIN
                 insert ('liefie',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE
                BEGIN
                 insert ('lifi',Buffer,Letter + 1);
                 Letter := Letter + 4;
                END;
              END;
    'o','O' : BEGIN
               insert ('lofo',Buffer,Letter + 1);
               Letter := Letter + 4;
              END;
    'u','U' : BEGIN
               insert ('lufu',Buffer,Letter + 1);
               Letter := Letter + 4;
              END;
    'y','Y' : BEGIN
               insert ('lyfy',Buffer,Letter + 1);
               Letter := Letter + 4;
              END;
    'ä','Ä' : BEGIN
               IF Buffer[Letter + 1] = 'u' THEN
                BEGIN
                 insert ('läufäu',Buffer,Letter + 2);
                 Letter := Letter + 7;
                END
               ELSE
                BEGIN
                 insert ('läfä',Buffer,Letter + 1);
                 Letter := Letter + 4;
                END;
              END;
    'ö','Ö' : BEGIN
               insert ('löfö',Buffer,Letter + 1);
               Letter := Letter + 4;
              END;
    'ü','Ü' : BEGIN
               insert ('lüfü',Buffer,Letter + 1);
               Letter := Letter + 4;
              END;
       END; {of Case}
       Letter := Letter + 1;
      END; {of while}
   CoderMemo.SelText := TrimRight(Buffer);
   CoderMemo.SetFocus;
   END;


   PROCEDURE FromLFBtClick(Sender: TObject);
   VAR
      Buffer : String;
      Letter : INTEGER;

   BEGIN
      IF CoderMemo.SelLength = 0 THEN
         CoderMemo.SelectAll;
      Buffer := CoderMemo.SelText;
      Letter := 1;
      WHILE Letter <= Length(Buffer) DO
      BEGIN 
       IF  (uppercase(copy (Buffer, Letter, 8)) = 'AULAUFAU')
        or (uppercase(copy (Buffer, Letter, 8)) = 'AILAIFAI')
        or (uppercase(copy (Buffer, Letter, 8)) = 'EILEIFEI')
        or (uppercase(copy (Buffer, Letter, 8)) = 'EULEUFEU')
        or (uppercase(copy (Buffer, Letter, 8)) = 'EYLEYFEY')
        or (uppercase(copy (Buffer, Letter, 8)) = 'IELIEFIE')
        or (copy (Buffer, Letter, 8) = 'Äuläufäu')
        or (copy (Buffer, Letter, 8) = 'äuläufäu') THEN
        BEGIN
         delete (Buffer, Letter + 2, 6);
        END 
       ELSE IF (uppercase(copy (Buffer, Letter, 5)) = 'ALAFA')
        or (uppercase(copy (Buffer, Letter, 5)) = 'ELEFE')
        or (uppercase(copy (Buffer, Letter, 5)) = 'ILIFI')
        or (uppercase(copy (Buffer, Letter, 5)) = 'OLOFO')
        or (uppercase(copy (Buffer, Letter, 5)) = 'ULUFU')
        or (uppercase(copy (Buffer, Letter, 5)) = 'YLYFY')
        or (copy (Buffer, Letter, 5) = 'Äläfä')
        or (copy (Buffer, Letter, 5) = 'äläfä')
        or (copy (Buffer, Letter, 5) = 'Ölöfö')
        or (copy (Buffer, Letter, 5) = 'ölöfö')
        or (copy (Buffer, Letter, 5) = 'Ülüfü')
        or (copy (Buffer, Letter, 5) = 'ülüfü') THEN
        BEGIN
         delete (Buffer, Letter + 1, 4);
        END
        ELSE
        Letter := Letter + 1;
      END; {of while}
   CoderMemo.SelText := Buffer;
   CoderMemo.SetFocus;
   END;
   
   
   PROCEDURE BuildCoderContainers;

   BEGIN
      CoderForm.Width := 800;
      CoderForm.Height:= 380;
      CoderForm.position := poScreenCenter;
      CoderForm.Caption := 'Kenny-Mirror-Hex-Rot13-Morse-Base64-Fönigen-*L*F* Translator :-)';
      CoderMemo := tmemo.Create(CoderForm);
      CoderMemo.Parent := CoderForm;
      // have a large enought width to avoid wrap around lines
      // CoderMemo.Width := Application.Mainform.width;
      // {freeze if Application not called from the script window : waiting for next version}
      CoderMemo.Top := 10;
      CoderMemo.Left := 10;
      CoderMemo.Height := CoderForm.ClientHeight - 70;
      CoderMemo.Width := CoderForm.ClientWidth - 20;
      CoderMemo.ScrollBars := ssVertical;
      CoderMemo.Font.Name := 'Courier New';
      CoderMemo.OnKeyDown := @CoderMemoKeyDown;
      CoderBtQuit := TButton.Create(CoderForm);
      CoderBtQuit.Parent := CoderForm;
      CoderBtQuit.Top := CoderMemo.Top + CoderMemo.Height + CoderBtQuit.height + 6;
      CoderBtQuit.Left := (CoderForm.Width - CoderBtQuit.Width ) DIV 2;
      CoderBtQuit.Caption := '&Quit';
      CoderBtQuit.modalresult := mrOK;
      Rot13Bt := TButton.Create(CoderForm);
      Rot13Bt.Parent := CoderForm;
      Rot13Bt.Top := CoderMemo.Top + CoderMemo.Height + 3;
      Rot13Bt.Left := CoderBtQuit.Left;
      Rot13Bt.Caption := 'R&ot 13';
      Rot13Bt.OnClick := @BtRot13Click;
      ClearMemoBt := TButton.Create(CoderForm);
      ClearMemoBt.Parent := CoderForm;
      ClearMemoBt.Top := CoderBtQuit.Top;
      ClearMemoBt.Left := Rot13Bt.Left + 81;
      ClearMemoBt.Caption := '&Clear';
      ClearMemoBt.OnClick := @ClearBtClick;
      ChangeFKBt := TButton.Create(CoderForm);
      ChangeFKBt.Parent := CoderForm;
      ChangeFKBt.Top := Rot13Bt.Top;
      ChangeFKBt.Left := ClearMemoBt.Left;
      ChangeFKBt.Caption := 'Fönigen';
      ChangeFKBt.OnClick := @ChangeFKBtClick;
      MirrorBt := TButton.Create(CoderForm);
      MirrorBt.Parent := CoderForm;
      MirrorBt.Top := CoderMemo.Top + CoderMemo.Height + 3;
      MirrorBt.Left := CoderBtQuit.Left - 81;
      MirrorBt.Caption := 'Mi&rror';
      MirrorBt.OnClick := @BtMirrorClick;
      RoRrImBt := TButton.Create(CoderForm);
      RoRrImBt.Parent := CoderForm;
      RoRrImBt.Top := CoderBtQuit.Top;
      RoRrImBt.Left := CoderBtQuit.Left - 81;
      RoRrImBt.Caption := 'RoRr&Im';
      RoRrImBt.OnClick := @BtRorrimClick;
      IntoMorse := TButton.Create(CoderForm);
      IntoMorse.Parent := CoderForm;
      IntoMorse.Top := Rot13Bt.Top;
      IntoMorse.Left := CoderForm.ClientWidth * 3 DIV 4 - IntoMorse.Width + 4;
      IntoMorse.Caption := '&To Morse';
      IntoMorse.OnClick := @BitBtTextToMorseClick;
      FromMorseBt := TButton.Create(CoderForm);
      FromMorseBt.Parent := CoderForm;
      FromMorseBt.Top := CoderBtQuit.Top;
      FromMorseBt.Left := IntoMorse.Left;
      FromMorseBt.Caption := 'From &Morse';
      FromMorseBt.OnClick := @BitBtMorseToTextClick;
      IntoKenny := TButton.Create(CoderForm);
      IntoKenny.Parent := CoderForm;
      IntoKenny.Top := Rot13Bt.Top;
      IntoKenny.Left := CoderForm.ClientWidth DIV 4 - IntoKenny.Width - 2;
      IntoKenny.Caption := 'To &Kenny';
      IntoKenny.OnClick := @BitBtTextToKennyClick;
      FromKennyBt := TButton.Create(CoderForm);
      FromKennyBt.Parent := CoderForm;
      FromKennyBt.Top := CoderBtQuit.Top;
      FromKennyBt.Left := IntoKenny.Left;
      FromKennyBt.Caption := '&From Kenny';
      FromKennyBt.OnClick := @BitBtKennyToNormalClick;
      IntoHexBt := TButton.Create(CoderForm);
      IntoHexBt.Parent := CoderForm;
      IntoHexBt.Top := Rot13Bt.Top;
      IntoHexBt.Left := CoderForm.ClientWidth DIV 4 + 2;
      IntoHexBt.Caption := 'To &Hex';
      IntoHexBt.OnClick := @BtToHexClick;
      FromHexBt := TButton.Create(CoderForm);
      FromHexBt.Parent := CoderForm;
      FromHexBt.Top := CoderBtQuit.Top;
      FromHexBt.Left := IntoHexBt.Left;
      FromHexBt.Caption := 'From He&x';
      FromHexBt.OnClick := @BtFromHexClick;
      IntoBase64Bt := TButton.Create(CoderForm);
      IntoBase64Bt.Parent := CoderForm;
      IntoBase64Bt.Top := Rot13Bt.Top;
      IntoBase64Bt.Left := CoderForm.ClientWidth * 3 DIV 4 + 8;
      IntoBase64Bt.Caption := 'To &Base-64';
      IntoBase64Bt.OnClick := @IntoBaseBtClick;
      FromBase64Bt := TButton.Create(CoderForm);
      FromBase64Bt.Parent := CoderForm;
      FromBase64Bt.Top := CoderBtQuit.Top;
      FromBase64Bt.Left := IntoBase64Bt.Left;
      FromBase64Bt.Caption := 'Fr. B&ase-64';
      FromBase64Bt.OnClick := @FromBaseBtClick;
      Free1Bt := TButton.Create(CoderForm);
      Free1Bt.Parent := CoderForm;
      Free1Bt.Top := Rot13Bt.Top;
      Free1Bt.Left := CoderForm.ClientWidth * 3 DIV 4 + Free1Bt.Width + 12;
      Free1Bt.Caption := 'FREE';
   //   Free1Bt.OnClick := @??;
      Free1Bt.Enabled := False;
      Free2Bt := TButton.Create(CoderForm);
      Free2Bt.Parent := CoderForm;
      Free2Bt.Top := CoderBtQuit.Top;
      Free2Bt.Left := Free1Bt.Left;
      Free2Bt.Caption := 'FREE';
   //   Free2Bt.OnClick := @??;
      Free2Bt.Enabled := False;
      InToLFBt := TButton.Create(CoderForm);
      IntoLFBt.Parent := CoderForm;
      IntoLFBt.Top := Rot13Bt.Top;
      IntoLFBt.Left := CoderForm.ClientWidth DIV 6 - IntoLFBt.Width - 16;
      IntoLFBt.Caption := 'To *L*F*';
      IntoLFBt.OnClick := @InToLFBtClick;
      FromLFBt := TButton.Create(CoderForm);
      FromLFBt.Parent := CoderForm;
      FromLFBt.Top := CoderBtQuit.Top;
      FromLFBt.Left := IntoLFBt.Left;
      FromLFBt.Caption := 'From *L*F*';
      FromLFBt.OnClick := @FromLFBtClick;
   END;

BEGIN
   CodeMorse := TstringList.Create;
   CodeLetter := TstringList.Create;
   try
   CodeMorse := TstringList.Create;
   CodeLetter := TstringList.Create;
   CodeMorse.Add('A=.-');   CodeMorse.Add('B=-...');   CodeMorse.Add('C=-.-.');
   CodeMorse.Add('D=-..');   CodeMorse.Add('E=.');   CodeMorse.Add('F=..-.');
   CodeMorse.Add('G=--.');   CodeMorse.Add('H=....');   CodeMorse.Add('I=..');
   CodeMorse.Add('J=.---');   CodeMorse.Add('K=-.-');   CodeMorse.Add('L=.-..');
   CodeMorse.Add('M=--');   CodeMorse.Add('N=-.');   CodeMorse.Add('O=---');
   CodeMorse.Add('P=.--.');   CodeMorse.Add('Q=--.-');   CodeMorse.Add('R=.-.');
   CodeMorse.Add('S=...');   CodeMorse.Add('T=-');   CodeMorse.Add('U=..-');
   CodeMorse.Add('V=...-');   CodeMorse.Add('W=.--');   CodeMorse.Add('X=-..-');
   CodeMorse.Add('Y=-.--');   CodeMorse.Add('Z=--..');   CodeMorse.Add('0=-----');
(*
   CodeMorse.add('a=.-');   CodeMorse.add('b=-...');   CodeMorse.add('c=-.-.');
   CodeMorse.add('d=-..');   CodeMorse.add('e=.');   CodeMorse.add('f=..-.');
   CodeMorse.add('g=--.');   CodeMorse.add('h=....');   CodeMorse.add('i=..');
   CodeMorse.add('j=.---');   CodeMorse.add('k=-.-');   CodeMorse.add('l=-.-..');
   CodeMorse.add('m=--');   CodeMorse.add('n=-.');   CodeMorse.add('o=---');
   CodeMorse.add('p=.--.');   CodeMorse.add('q=--.-');   CodeMorse.add('r=.-.');
   CodeMorse.add('s=...');   CodeMorse.add('t=-');   CodeMorse.add('u=..-');
   CodeMorse.add('v=...-');   CodeMorse.add('w=.--');   CodeMorse.add('x=-..-');
   CodeMorse.add('y=-.--');   CodeMorse.add('z=--..');   CodeMorse.add('0=-----');
*)
   CodeMorse.Add('1=.----');   CodeMorse.Add('2=..---');   CodeMorse.Add('3=...--');
   CodeMorse.Add('4=....-');   CodeMorse.Add('5=.....');   CodeMorse.Add('6=-....');
   CodeMorse.Add('7=--...');   CodeMorse.Add('8=---..');   CodeMorse.Add('9=----.');
   CodeMorse.Add('.=.-.-.-');   CodeMorse.Add(',=--..--');   CodeMorse.Add('?=..--..');
   CodeMorse.Add('-=-....-');   CodeMorse.Add('/=-..-.');   CodeMorse.Add(' = / ');
   CodeMorse.Add('ERROR=........'); CodeMorse.Add('+=.-.-.');   CodeMorse.Add('@=...-.-');
   CodeMorse.Add('SOS=...---...');

{international morse set}
   {å ä à é ö ü " ! ß (S-zet) }
{$IFDEF Nordik}
   CodeMorse.Add('Å=.--.-');
{$ELSE}
   CodeMorse.Add('À=.--.-');
{$ENDIF}
   CodeMorse.Add('Ä=.-.-');
   CodeMorse.Add('É=..-..');   CodeMorse.Add('Ö=---.');   CodeMorse.Add('Ü=..--');
   CodeMorse.Add('"=.-..-.');   CodeMorse.Add('!=..--.');   CodeMorse.Add('ß=----');


   FOR Index := 0 TO CodeMorse.Count-1 DO
   BEGIN
      CodeLine := CodeMorse.Strings[Index];
      EqualPos := Pos('=', CodeLine);
      CodeLine := Copy(CodeLine, EqualPos+1, Length(CodeLine)-EqualPos)+'='+Copy(CodeLine,1,EqualPos-1);
      CodeLetter.Add(CodeLine);
   END;
   CodeLetter.Add('/= ');
   Ado('Copy');
   CoderForm := tform.Create(nil);
   try
   BuildCoderContainers;
   Codermemo.PasteFromCLipboard;
   CoderForm.ShowModal;
   finally
   CoderForm.Free;
   end;
   finally
   CodeMorse.Free;
   CodeLetter.Free;
   end;
END.


René Fischer