08.04.2020, 17:23 [+3 UTC]
в нашей команде: 4 353 чел. | участники онлайн: 11 (рекорд: 21)

:: РЕГИСТРАЦИЯ

задать вопрос

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.85 (07.04.2020)
JS-v.1.38 | CSS-v.3.37

Общие новости:
28.03.2020, 20:29

Форум:
08.04.2020, 15:18

Последний вопрос:
08.04.2020, 17:10
Всего: 151970

Последний ответ:
08.04.2020, 15:24
Всего: 259943

Последняя рассылка:
08.04.2020, 15:16

Писем в очереди:
0

Мы в соцсетях:

Наша кнопка:

RFpro.ru - здесь вам помогут!

Отзывы о нас:
21.08.2011, 12:01 »
Dipauler
Спасибо, Сергей. Действительно проблему создал я сам, пытаясь отмонтировать том, находясь в нём. Проблема решена! [вопрос № 183905, ответ № 268082]
16.07.2019, 16:01 »
dar777
Это самое лучшее решение! [вопрос № 195959, ответ № 278399]

РАЗДЕЛ • Pascal / Delphi / Lazarus

Создание программ на языках Pascal, Delphi и Lazarus.

[администратор рассылки: Зенченко Константин Николаевич (Старший модератор)]

Лучшие эксперты в этом разделе

Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 118
Лысков Игорь Витальевич
Статус: Старший модератор
Рейтинг: 0
Асмик Гаряка
Статус: Советник
Рейтинг: 0

Перейти к консультации №:
 

Консультация онлайн # 145292
Раздел: • Pascal / Delphi / Lazarus
Автор вопроса: Магдин Борис Николаевич
Отправлена: 28.09.2008, 14:17
Поступило ответов: 1

помогите написать програму на pascal: перевод с римской системы в двоичную и наоборот

Состояние: Консультация закрыта

Ответ # 230609 от Denisss


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

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

Удачи!

Приложение:


Консультировал: Denisss
Дата отправки: 28.09.2008, 15:17

Рейтинг ответа:

0

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

Мини-форум консультации № 145292
неизвестный

# 1

= общий = | 29.09.2008, 21:35

помогите написать програму: перевод с п'ятеричной в четырнацытиричную систему счисления и наоборот

Denisss

# 2

= общий = | 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. 

неизвестный

# 3

= общий = | 01.10.2008, 21:17

помогите написать проверку при вводе римских цифер: невозможность вводить IIІI, VIIII и т.д.

неизвестный

# 4

= общий = | 05.10.2008, 12:59

помогите написать програму на Assembler: найти суму непарных елементов масиву

неизвестный

# 5

= общий = | 06.10.2008, 18:39

помогите написать програму: перевод с 13 в 14 систему счисления и наоборот

неизвестный

# 6

= общий = | 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;
}


неизвестный

# 7

= общий = | 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.

неизвестный

# 8

= общий = | 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.

 

Возможность оставлять сообщения в мини-форумах консультаций доступна только после входа в систему.
Воспользуйтесь кнопкой входа вверху страницы, если Вы зарегистрированы или пройдите простую процедуру регистрации на Портале.

Яндекс Rambler's Top100

главная страница | поддержка | задать вопрос

Время генерирования страницы: 0.16253 сек.

© 2001-2020, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.85 от 07.04.2020
Версия JS: 1.38 | Версия CSS: 3.37