unit Unit1;
interface
uses Windows, Messages, Forms,Dialogs, StdCtrls, ExtCtrls, ShellAPI, Buttons, XPMan;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Edit3: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Image1: TImage;
Edit5: TEdit;
Button4: TButton;
Label6: TLabel;
BitBtn1: TBitBtn;
Label5: TLabel;
Edit4: TEdit;
Button5: TButton;
Button6: TButton;
XPManifest1: TXPManifest;
Button3: TButton;
Button7: TButton;
procedure Edit1Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure Edit4Change(Sender: TObject);
procedure Edit5Change(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
function IntToBin(Value: integer; Digits: integer): string;
var
i: integer;
begin
result := '';
for i := 0 to Digits - 1 do begin if Value and (1 shl i) > 0
then result := '1' + result else result := '0' + result;
end;
end;
function IntToRoman(num: Cardinal): String; {returns num in capital roman digits}
const
Nvals = 13;
vals: array [1..Nvals] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
roms: array [1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
b: 1..Nvals;
begin
result := '';
b := Nvals;
while num > 0 do
begin
while vals[b] > num do
dec(b);
dec (num, vals[b]);
result := result + roms[b]
end;
end;

function RomanToDec(const Value: string): integer;
var
i, lastValue, curValue: integer;
begin
Result := 0;
lastValue := 0;
for i := Length(Value) downto 1 do
begin
case UpCase(Value[i]) of
'C':
curValue := 100;
'D':
curValue := 500;
'I':
curValue := 1;
'L':
curValue := 50;
'M':
curValue := 1000;
'V':
curValue := 5;
'X':
curValue := 10;
else raise Exception.CreateFmt('Invalid character: %s', [Value[i]]);
end;
if curValue < lastValue then
Dec(Result, curValue)
else
Inc(Result, curValue);
lastValue := curValue;
end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
s:string;n:integer;
begin
s:=edit1.Text;
for n:=length(s) downto 1 do
begin
if not (s[n] in ['0'..'9']) then delete(s, n ,1);
end;
edit1.Text:=s;
end;
procedure TForm1.Edit2Change(Sender: TObject);
var
s:string;n:integer;
begin
s:=edit2.Text;
for n:=length(s) downto 1 do
begin
if not (s[n] in ['0'..'1']) then delete(s, n ,1);
end;
edit2.Text:=s;
end;

procedure TForm1.Edit3Change(Sender: TObject);
var
s:string;n:integer;
begin
s:=edit3.Text;
for n:=length(s) downto 1 do
begin
if not (s[n] in ['I','V','X','C','D','M','L']) then delete(s, n ,1);
end;
edit3.Text:=s;

end;



procedure TForm1.Button6Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if edit1.Text<>'' then
begin
edit3.ShowHint:=false;
if strtoint(edit1.Text)<=65535 then
begin
edit3.text:= IntToRoman(strtoint(edit1.Text));
edit2.Text:=IntToBin(StrToInt(Edit1.Text),16);
EDIT5.Text:=Format('%0x',[strtoint(edit1.text)]);
if strtoint(edit1.Text)>3999 then begin edit3.ShowHint:=true; end;
end else showmessage('Введено занадто велике значення');
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
i,result:integer;
bin:string;
begin
if edit2.Text<>'' then
begin
edit3.ShowHint:=false;
bin:=edit2.Text;
result:=0;
for i:=1 to length(bin) do
begin
if not (copy(edit2.Text,i,1)<>IntToStr(1)) then
result:=result+(1 shl(length(bin)-i));
end;
edit1.text:=IntToStr(result);
edit3.text:= IntToRoman(strtoint(edit1.Text));
EDIT5.Text:=Format('%0x',[strtoint(edit1.text)]);
if strtoint(edit1.Text)>3999 then begin edit3.ShowHint:=true; end;
end;
end;

procedure TForm1.Edit5Change(Sender: TObject);
var
s:string;n:integer;
begin
s:=edit5.Text;
for n:=length(s) downto 1 do
begin
if not (s[n] in ['0'..'9','A','B','C','D','E','F']) then delete(s, n ,1);
end;
edit5.Text:=s;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if edit5.Text<>'' then
begin
edit3.ShowHint:=false;
edit1.Text:=IntToStr(StrToInt('$'+edit5.text));
edit3.text:= IntToRoman(strtoint(edit1.Text));
edit2.Text:=IntToBin(StrToInt(Edit1.Text),16);
if strtoint(edit1.Text)>3999 then begin edit3.ShowHint:=true; end;
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form2.ShowModal;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if edit3.Text<>'' then
begin
edit3.ShowHint:=false;
edit1.Text:=inttostr(RomanToDec(edit3.Text));
if strtoint(edit1.Text)<=65535 then
begin
edit2.Text:=IntToBin(StrToInt(Edit1.Text),16);
EDIT5.Text:=Format('%0x',[strtoint(edit1.text)]);
if strtoint(edit1.Text)>3999 then begin edit3.ShowHint:=true; end;
end else
begin
edit2.Text:=''; edit4.Text:=''; edit5.Text:='';
end;

end;
end;


procedure TForm1.Edit4Change(Sender: TObject);
var
s:string;n:integer;
begin
s:=edit4.Text;
for n:=length(s) downto 1 do
begin
if not (s[n] in ['0'..'7']) then delete(s, n ,1);
end;
edit4.Text:=s;
end;


end.