Консультация № 145292
28.09.2008, 14:17
0.00 руб.
0 9 1
помогите написать програму на pascal: перевод с римской системы в двоичную и наоборот

Обсуждение

Неизвестный
28.09.2008, 15:17
общий
это ответ

Здравствуйте, [b]Магдин Борис Николаевич[/b]!

В приложении находится пример, в котором реализованы две функции: rom2bin (рим.->дв.) и bin2rom (дв.->рим.).
При переводе из римской в двоичную систему проверки не делается, так что будьте аккуратнее при вводе.
Реализацию функций частично взял из этого примера: Roman to Arabian

Удачи!


Приложение:
program Q145292;

const
TransTable: array[1..13] of record
AN: word;
RN: string[2];
end = ((AN: 1000; RN:'M'), (AN: 900; RN: 'CM'), (AN: 500; RN: 'D'),
(AN: 400; RN: 'CD'), (AN: 100; RN: 'C'), (AN: 90; RN: 'XC'),
(AN: 50; RN: 'L'), (AN: 40; RN: 'XL'), (AN: 10; RN: 'X'),
(AN: 9; RN: 'IX'), (AN: 5; RN: 'V'), (AN: 4; RN: 'IV'),
(AN: 1; RN: 'I'));

function rom2bin(const roman: String): String;
var
arabian: Longint;
curNum: Byte;
curSymb: String[2];
curVal: Word;
tmpStr: String;
begin
arabian:= 0;
curNum:= 1;
tmpStr:= roman;

{ Преобразование римских в арабские }
repeat
curSymb:= TransTable[curNum].RN;
curVal:= TransTable[curNum].AN;

while (Copy(tmpStr, 1, Length(curSymb)) = curSymb) do
begin
Inc(arabian, curVal);
Delete(tmpStr, 1, Length(curSymb));
end;

Inc(curNum);
until (Length(tmpStr) = 0);

{ Преобразование десятичных в арабские }
repeat
tmpStr:= Char((arabian and $01) + $30) + tmpStr;
arabian:= arabian shr 1;
until (arabian = 0);
{ Результат }
rom2bin:= tmpStr;
end;

function bin2rom(const binary: String): String;
var
arabian: Longint;
curNum: Byte;
curSymb: String[2];
curVal: Word;
tmpStr: String;
begin
{ Преобразование в десятичное }
arabian:= 0;
for curNum:= 1 to Length(binary) do
{ Проверка }
if ((binary[curNum] < #$30) or (binary[curNum] > #$31)) then
begin
WriteLn('Error: Not a binary number!');
Exit;
end
else
begin
arabian:= arabian shl 1;
Inc(arabian, Ord(binary[curNum])-$30);
end;

{ Преобразование в римское число }
tmpStr:= '';
curNum:= 1;
repeat
curSymb:= TransTable[curNum].RN;
curVal:= TransTable[curNum].AN;

while (curVal <= arabian) do
begin
tmpStr:= tmpStr + curSymb;
Dec(arabian, curVal);
end;

Inc(curNum);
until (arabian <= 0);
{ Результат }
bin2rom:= tmpStr;
end;

var
number: String;
begin
{ Ввод римского числа }
Write('Input roman number: '); ReadLn(number);

{ Вывод переведенного числа }
WriteLn('Binary = ', rom2bin(number));

{ Ввод двоичного числа }
Write('Input binary number: '); ReadLn(number);

{ Вывод переведенного числа }
WriteLn('Roman = ', bin2rom(number));

{Ожидание нажатия пользователем любой кнопки}
WriteLn;
WriteLn('Press any key...');
ReadLn;
end.
Неизвестный
29.09.2008, 21:35
общий
помогите написать програму: перевод с п'ятеричной в четырнацытиричную систему счисления и наоборот
Неизвестный
29.09.2008, 22:49
общий
Копирую Вам ответ эксперта Gh0stik на вопрос №111789:
Код:
procedure SysX_to_SysY(sysX: string; osnX,osnY: integer; var sysY: string);
var dec,i,z1,z2,r:integer;
b,c:string;
begin

i:=0;
dec:=0; { число в десятичной системе }
sysY:='';
while sysX<>'' do { переводим число из системы Х в десятичную }
begin
c:=copy(sysX,length(sysX),1);
delete(sysX,length(sysX),1);
if i=0 then z2:=1 else z2:=round(exp(i*ln(osnX)));
if ord(c[1]) > 64 then z1:=ord(c[1])-55
else z1:=StrToInt(c);
dec:=dec+z1*z2; inc(i);
end;

while
dec > 0 do { переводим число из десятичной системы в ситему Y }
begin
r:=dec mod osnY;
dec:=dec div osnY;
if r < 10 then b:=IntToStr(r) else b:=chr(ord('A')-10+r);
sysY:=b+sysY;
end;
end;


В Вашем случае функцию применять так:
Код:
var 
number, result: String;
begin

{ Ввод пятиричного числа }
Write('Input number: '); ReadLn(number);
{ Перевод числа }
SysX_to_SysY(number, 5, 14, result);
{ Вывод ответа }
WriteLn('Result = ', result);
end.
Неизвестный
01.10.2008, 21:17
общий
помогите написать проверку при вводе римских цифер: невозможность вводить IIІI, VIIII и т.д.
Неизвестный
05.10.2008, 12:59
общий
помогите написать програму на Assembler: найти суму непарных елементов масиву
Неизвестный
06.10.2008, 18:39
общий
помогите написать програму: перевод с 13 в 14 систему счисления и наоборот
Неизвестный
15.11.2008, 19:31
общий
помогите написать програму на С:

В одномерном массиве, состоящем из n вещественных элементов, вычис-
лить:
1) номер максимального по модулю элемента массива;
2) сумму элементов массива, расположенных после первого положитель-
ного элемента.

Нужно добавить:
Преобразовать массив таким образом, чтобы сначала располагались все
элементы, целая часть которых лежит внутри отрезка [а, b], а потом – все ос-
тальные.

Код:
#include <iostream.h>
#include <conio.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>

void input(float*mas,const int n)
{
for(int i=0;i<n;i++){
cin>>mas[i]; }
}

void print(float*mas,const int n)
{
for(int i=0;i<n;i++)
cout<<" "<<mas[i]<<" ";
}

float maxpm(float*mas,const int n)
{
int max, jmax; float maxn;
max=abs(mas[0]);
jmax=0;
for(int i=0;i<n;i++)
if ((abs(mas[i]))>max) {
max=abs(mas[i]);
jmax=i;}
maxn=jmax;
return maxn;
}

float suma(float*mas,const int n)
{
float suma=0; int per=0;

for(int i=0;i<n;i++)
{
if(per==1) suma+=mas[i];
if (mas[i]>0) per=1;}
return suma;
}


int main()
{
clrscr();
const int n=5;
float x,y;
float a[n],b[n];
cout<<"vvedite a: "; cin>>x;
cout<<"vvedite b: "; cin>>y;
cout<<"\n";
cout<<"vvedite elementu masivy: "<<"\n";
input(a,n);
cout<<"\n";
cout<<"\n";
print(a,n);
cout<<"\n";
cout<<endl<<"nomer max elementa po modulu = "<<maxpm(a,n)<<endl;
cout<<"suma = "<<suma(a,n)<<endl;
cout<<"\n";
getch();
return 0;
}


Неизвестный
04.12.2008, 18:39
общий
как переделать элементарную игру в ООП

unit UMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, jpeg;

type
TMainForm = class(TForm)
Car: TImage;
Block1: TImage;
Block2: TImage;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Bevel3: TBevel;
Timer1: TTimer;
Timer2: TTimer;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;
Bonus:integer;

implementation

{$R *.dfm}

procedure GameOver;
begin
MainForm.Timer1.Enabled:=false;
MainForm.Timer2.Enabled:=false;
ShowMessage('Аварія');
end;

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//Управление машиной кнопками мышки
If (Button=mbLeft) and (Car.left>0) then
Car.left:=Car.left-(Car.width div 2);

If (Button=mbRight) and (Car.Left<(450-Car.Width)) then
Car.Left:=Car.Left+(Car.Width div 2);
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
close;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
//Располагаем препятсвия
Block1.Left:=128;
Block1.Top:=288;
Block2.Left:=320;
Block2.Top:=50;
Bonus:=0;
Label1.Caption:='0';
//Показываем препятствия
Block1.Show;
Block2.Show;
Car.Show;
//Включаем все таймеры;
Timer1.Enabled:=true;
Timer2.Enabled:=true;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
//Отображаем очки игрока
Label1.Caption:=IntToStr(Bonus);

//Задаем движение препятствия1
Block1.Top:=Block1.Top+(block1.height div 2);

//Проверяем не произошла ли авария
if (Block1.Top+Block1.Height)>(Car.Top) then
if (Block1.Left+1<=Car.Left) and (Car.Left<=(Block1.Left+Block1.Width-1))
then GameOver;

if (Block1.Top+Block1.Height)>(Car.Top) then
if (Block1.Left+1<=(Car.Left+Car.Width)) and ((Car.Left+Car.Width)<=(Block1.Left+Block1.Width-1))
then GameOver;

//Дошло ли препятствие до нижней границы
If Block1.Top>=(MainForm.ClientHeight) then
begin
Bonus:=Bonus+10;
Block1.Hide;
Block1.Top:=1;

//препятствие не должно вылазить за левую границу
repeat
Block1.Left:=Random(450-Car.Width);
until (Block1.Left>10);
Block1.Show;
end;
end;

procedure TMainForm.Timer2Timer(Sender: TObject);
begin
//Отображаем очки игрока
Label1.Caption:=IntToStr(Bonus);

//Задаем движение препятствия1
Block2.Top:=Block2.Top+(Block2.Height div 2);

//Проверяем не произошла ли авария
if (Block2.Top+Block2.Height)>(Car.Top) then
if (Block2.Left+1<=Car.Left) and (Car.Left<=(Block2.Left+Block2.Width-1))
then GameOver;

if (Block2.Top+Block2.Height)>(Car.Top) then
if (Block2.Left+1<=(Car.Left+Car.Width)) and ((Car.Left+Car.Width)<=(Block2.Left+Block2.Width-1))
then GameOver;

//Дошло ли препятствие до нижней границы
If Block2.Top>=(MainForm.ClientHeight) then
begin
Bonus:=Bonus+10;
Block2.Hide;
Block2.Top:=1;

//препятствие не должно вылазить за левую границу
repeat
Block2.Left:=Random(450-Car.Width);
until (Block2.Left>10);
Block2.Show;
end;
end;

end.
Неизвестный
15.12.2008, 19:15
общий
как правильно переделать игру в ООП (с использованием компонент)?

Код:
unit UMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, jpeg;

type
TMainForm = class(TForm)
Car: TImage;
Block1: TImage;
Block2: TImage;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Bevel3: TBevel;
Timer1: TTimer;
Timer2: TTimer;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;
Bonus:integer;

implementation

{$R *.dfm}

procedure GameOver;
begin
MainForm.Timer1.Enabled:=false;
MainForm.Timer2.Enabled:=false;
ShowMessage('Аварія');
end;

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//Управление машиной кнопками мышки
If (Button=mbLeft) and (Car.left>0) then
Car.left:=Car.left-(Car.width div 2);

If (Button=mbRight) and (Car.Left<(450-Car.Width)) then
Car.Left:=Car.Left+(Car.Width div 2);
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
close;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
//Располагаем препятсвия
Block1.Left:=128;
Block1.Top:=288;
Block2.Left:=320;
Block2.Top:=50;
Bonus:=0;
Label1.Caption:='0';
//Показываем препятствия
Block1.Show;
Block2.Show;
Car.Show;
//Включаем все таймеры;
Timer1.Enabled:=true;
Timer2.Enabled:=true;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
//Отображаем очки игрока
Label1.Caption:=IntToStr(Bonus);

//Задаем движение препятствия1
Block1.Top:=Block1.Top+(block1.height div 2);

//Проверяем не произошла ли авария
if (Block1.Top+Block1.Height)>(Car.Top) then
if (Block1.Left+1<=Car.Left) and (Car.Left<=(Block1.Left+Block1.Width-1))
then GameOver;

if (Block1.Top+Block1.Height)>(Car.Top) then
if (Block1.Left+1<=(Car.Left+Car.Width)) and ((Car.Left+Car.Width)<=(Block1.Left+Block1.Width-1))
then GameOver;

//Дошло ли препятствие до нижней границы
If Block1.Top>=(MainForm.ClientHeight) then
begin
Bonus:=Bonus+10;
Block1.Hide;
Block1.Top:=1;

//препятствие не должно вылазить за левую границу
repeat
Block1.Left:=Random(450-Car.Width);
until (Block1.Left>10);
Block1.Show;
end;
end;

procedure TMainForm.Timer2Timer(Sender: TObject);
begin
//Отображаем очки игрока
Label1.Caption:=IntToStr(Bonus);

//Задаем движение препятствия1
Block2.Top:=Block2.Top+(Block2.Height div 2);

//Проверяем не произошла ли авария
if (Block2.Top+Block2.Height)>(Car.Top) then
if (Block2.Left+1<=Car.Left) and (Car.Left<=(Block2.Left+Block2.Width-1))
then GameOver;

if (Block2.Top+Block2.Height)>(Car.Top) then
if (Block2.Left+1<=(Car.Left+Car.Width)) and ((Car.Left+Car.Width)<=(Block2.Left+Block2.Width-1))
then GameOver;

//Дошло ли препятствие до нижней границы
If Block2.Top>=(MainForm.ClientHeight) then
begin
Bonus:=Bonus+10;
Block2.Hide;
Block2.Top:=1;

//препятствие не должно вылазить за левую границу
repeat
Block2.Left:=Random(450-Car.Width);
until (Block2.Left>10);
Block2.Show;
end;
end;

end.
Форма ответа