unit Unit1;
{$codepage utf8}
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    d1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    b: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label1: TLabel;
    Grecka: TLabel;
    Label3: TLabel;
    d: TLabel;
    GrNaRzymska: TRadioButton;
    Zakres1: TRadioButton;
    Zakres2: TRadioButton;
    RadioGroup1: TRadioGroup;
    RzNaArabska: TRadioButton;
    GrNaArabska: TRadioButton;
    RzNaGrecka: TRadioButton;
    NaRzymska: TRadioButton;
    NaGrecka: TRadioButton;
    procedure Edit5Change(Sender: TObject);
    procedure GreckaClick(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure RzNaArabskaChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure RzNaArabskaClick(Sender: TObject);
    procedure NaGreckaChange(Sender: TObject);
    procedure NaRzymskaChange(Sender: TObject);
    procedure NaRzymskaClick(Sender: TObject);
    procedure ZakresNChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  a: integer;
  mnoznik: integer;
  aa: integer;
  c: integer;
  i: integer;
  j: integer;
  T: string;
  lrzym: string;
  lgrec: string;
  wynik:integer = 0;
  add, min, sum: integer;
  pom:boolean;
  rzym:string;
  GreckieJedn : array[1..9] of string =  ('α', 'β', 'γ', 'δ', 'ε',
  'ϝ', 'ζ', 'η', 'θ');
  GreckieDzie : array[1..9] of string =  ('ι', 'κ', 'λ', 'μ', 'ν',
  'ξ', 'ο', 'π', 'ϟ');
  GreckieSet : array[1..9] of string =  ('ρ', 'σ', 'τ', 'υ', 'φ',
  'χ', 'ψ', 'ω', 'ϡ');





implementation

function GreckaWartosc(Gr : UnicodeString) : integer;
begin
  aa := 0;

  for j:=1 to 9 do
    begin
         if(GreckieJedn[j] = Gr) then aa := j;
    end;

  for j:=1 to 9 do
    begin
         if(GreckieDzie[j] = Gr) then aa := j * 10;
    end;

  for j:=1 to 9 do
    begin
         if(GreckieSet[j] = Gr) then aa := j * 100;
    end;

  Result := aa;
end;


function Wstaw(a : integer; one, five, ten : string) : string;
begin
  T:='';
  if a < 4 then
    for i:=1 to a do T:=T+one;
  if a = 4 then
    T:=one + five;
  if a = 5 then
    T := five;
  if (a > 5) and (a < 9) then
  begin
    T:=five;
    for i:=1 to a - 5 do  T:=T+one;
  end;
  if a = 9 then T:=one+ten;

Result := T;
end;

function StworzArabskaZGreckiej(Gre : UnicodeString) : integer;
begin
     sum := 0;
     mnoznik := 1;
     for i:=1 to Length(Gre) do
       begin
         add := 0;
         if(Gre[i] = '͵') then mnoznik := 1000;
         if(Gre[i] <> '͵') then add := GreckaWartosc(Gre[i]);

         if(add > 0) then
         begin
              sum := sum + (add * mnoznik);
              mnoznik := 1;
         end;

       end;
     Result := sum;
end;

function StworzArabskaZRzymskiej(Rzym : string) : integer;
begin
    sum := 0;
    pom := false;
    mnoznik := 0;
    for i:= 1 to Length(Rzym) do
      begin
        add := 0;
        min := 0;

        if pom = false then
          begin
            case Rzym[i] of
                'M': add := 1000;
                'D': add := 500;
                'C': add := 100;
                'L': add := 50;
                'X': add := 10;
                'V': add := 5;
                'I': add := 1;
                '|': mnoznik := mnoznik + 1;
            end;

            case Rzym[i + 1] of
                'M': min := 1000;
                'D': min := 500;
                'C': min := 100;
                'L': min := 50;
                'X': min := 10;
                'V': min := 5;
                'I': min := 1;
            end;

            if (add < min) and (add > 0) then
              begin
                add := min - add;
                pom := true;
              end;
            sum := sum + add;
            if(mnoznik = 2) then
              begin
                 sum := sum * 1000;
                 mnoznik := 3;
              end;
          end
        else
          pom := false;
      end;
    Result := sum;
end;

function StworzGrecka(a : integer) : string;
begin
     lgrec := '';

     if(a > 999999) then
       begin
         ShowMessage('Liczby greckie obejmują zakres od 1 do 999999. Wprowadź inną liczbę');
         Result := 'bląd';
         exit;
       end;

     if(a > 999) then
     begin
         aa := a div 1000;

         if(aa div 100) > 0 then
         begin
           lgrec := lgrec + '͵' + GreckieSet[aa div 100];
           aa := aa mod 100;
         end;


         if(aa div 10) > 0 then
         begin
           lgrec := lgrec + '͵' + GreckieDzie[aa div 10];
           aa := aa mod 10;
         end;

         if(aa > 0) then lgrec := lgrec + '͵' + GreckieJedn[aa];

         a := a mod 1000;
     end;

     if(a div 100) > 0 then
     begin
          lgrec := lgrec + GreckieSet[a div 100];
          a := a mod 100;
     end;


     if(a div 10) > 0 then
     begin
          lgrec := lgrec + GreckieDzie[a div 10];
          a := a mod 10;
     end;

     if(a > 0) then lgrec := lgrec + GreckieJedn[a];

     lgrec := lgrec + 'ʹ';

     Result := lgrec;
end;

function StworzRzymska(a : integer; Zakres1, Zakres2 : boolean) : string;
begin
    lrzym := '';

    if Zakres1 then
    begin
      if a >= 4000 then
      begin
        ShowMessage('Ta liczba wychodzi poza zaznaczony zakres');
        Result := 'bląd';
        exit;
      end;
    end;
    if Zakres2 then
    begin
      if (a < 4000) or (a > 300000) then
      begin
        ShowMessage('Ta liczba wychodzi poza zaznaczony zakres');
        Result := 'bląd';
        exit;
      end;
    end;

   if (a >= 4000) then
       begin
         lrzym := '|';

         aa := a div 1000;

         if (aa div 1000) > 0 then
         begin
           for i := 1 to aa div 1000 do
             lrzym := lrzym +'M';
           aa := aa mod 1000;
         end;

         if (aa div 100) > 0 then
         begin
           lrzym := lrzym + Wstaw(aa div 100,'C','D','M');
           aa := aa mod 100;
         end;

         if (aa div 10) > 0 then
         begin
           lrzym := lrzym + Wstaw(aa div 10,'X','L','C');
           aa := aa mod 10;
         end;

         if aa > 0 then
         lrzym := lrzym + Wstaw(aa,'I','V','X');

         lrzym := lrzym + '|';

         a := a mod 1000;
       end;
       if (a div 1000) > 0 then
       begin
         for i := 1 to a div 1000 do
           lrzym := lrzym +'M';
         a := a mod 1000;
       end;

       if (a div 100) > 0 then
         begin
           lrzym := lrzym + Wstaw(a div 100,'C','D','M');
           a := a mod 100;
         end;

       if (a div 10) > 0 then
         begin
           lrzym := lrzym + Wstaw(a div 10,'X','L','C');
           a := a mod 10;
         end;

       if a > 0 then
         lrzym := lrzym + Wstaw(a,'I','V','X');

       Result := lrzym;
end;

{$R *.lfm}

{ TForm1 }

procedure TForm1.Label1Click(Sender: TObject);
begin

end;

procedure TForm1.RzNaArabskaClick(Sender: TObject);
begin

end;

procedure TForm1.NaGreckaChange(Sender: TObject);
begin

end;

procedure TForm1.NaRzymskaChange(Sender: TObject);
begin

end;

procedure TForm1.NaRzymskaClick(Sender: TObject);
begin

end;

procedure TForm1.ZakresNChange(Sender: TObject);
begin

end;


procedure TForm1.Edit1Change(Sender: TObject);
begin

end;

procedure TForm1.Edit2Change(Sender: TObject);
begin

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     if(Length(Edit1.text) = 0) then exit;
     a:=strtoint(Edit1.text);

     if (NaRzymska.Checked) then
       Edit2.text:=StworzRzymska(a, Zakres1.Checked, Zakres2.Checked);

     if (NaGrecka.Checked) then
       Edit2.text:=StworzGrecka(a);

end;

procedure TForm1.RzNaArabskaChange(Sender: TObject);
begin

end;

procedure TForm1.GreckaClick(Sender: TObject);
begin

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin

end;

procedure TForm1.Edit5Change(Sender: TObject);
begin

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit1.text:=' ';
  Edit2.text:=' ';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if RzNaArabska.Checked then
     Edit4.text := inttostr(StworzArabskaZRzymskiej(Edit3.text));
  if RzNaGrecka.Checked then
     Edit4.text := StworzGrecka(StworzArabskaZRzymskiej(Edit3.text));

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Edit3.text:=' ';
  Edit4.text:=' ';
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
     if GrNaArabska.Checked then
     Edit6.text := inttostr(StworzArabskaZGreckiej(Edit5.text));
     if GrNaRzymska.Checked then
     Edit6.text := StworzRzymska(StworzArabskaZGreckiej(Edit5.text), Zakres1.Checked, Zakres2.Checked);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Edit5.text:=' ';
  Edit6.text:=' ';
end;



end.