Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > C/C++ программирование > Общие вопросы C/C++
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.05.2015, 15:24   #1
FomAW
Пользователь
 
Регистрация: 14.03.2013
Сообщений: 30
По умолчанию Переписать с Pascal на Cи

К сожалению плохо разбираюсь в Си. Помогите пожалуйста.
Код:
program Project1;
uses
  System.SysUtils;

var F:Text;
    Str,S:String;
    I,J,K:integer;
    MHEX,MOCT:array[1..100] of String;
    Centr,LEN:array[1..100] of Integer;
    B:integer;
    Score,ScoreS:Integer;
FUNCTION BIN2OCT(BIN: STRING): STRING;
  FUNCTION SetOct(St: STRING; VAR Error: BOOLEAN): CHAR;
  VAR
  Ch: CHAR;
  BEGIN
    IF St = '000' THEN Ch := '0'
    ELSE IF St = '001' THEN Ch := '1'
    ELSE IF St = '010' THEN Ch := '2'
    ELSE IF St = '011' THEN Ch := '3'
    ELSE IF St = '100' THEN Ch := '4'
    ELSE IF St = '101' THEN Ch := '5'
    ELSE IF St = '110' THEN Ch := '6'
    ELSE IF St = '111' THEN Ch := '7'
    ELSE Error := True;
    SetOct := Ch;
  END;

VAR OCT  : STRING;
    I    : INTEGER;
    Temp : STRING[3];
    Error: BOOLEAN;

BEGIN
  Error := False;
  IF BIN = '0' THEN OCT := '0'
  ELSE
  BEGIN
    Temp := '';
    OCT := '';
    IF Length(BIN) MOD 3 <>0 THEN
    REPEAT
      BIN := '0' + BIN;
    UNTIL Length(BIN) MOD 3 = 0;
    FOR I := 1 TO Length(BIN) DO
    BEGIN
      Temp := Temp + BIN[i];
      IF Length(Temp) = 3 THEN
      BEGIN
        OCT := OCT + SetOct(Temp, Error);
        Temp := '';
      END;
    END;
  END;
  IF Error THEN BIN2OCT := '0'
  ELSE BIN2OCT := OCT;
  Error:=False;
END;

FUNCTION BIN2HEX(BIN: STRING): STRING;
  FUNCTION SetHex(St: STRING; VAR Error: BOOLEAN): CHAR;
  VAR
  Ch: CHAR;
  BEGIN
    IF St = '0000' THEN Ch := '0'
    ELSE IF St = '0001' THEN Ch := '1'
    ELSE IF St = '0010' THEN Ch := '2'
    ELSE IF St = '0011' THEN Ch := '3'
    ELSE IF St = '0100' THEN Ch := '4'
    ELSE IF St = '0101' THEN Ch := '5'
    ELSE IF St = '0110' THEN Ch := '6'
    ELSE IF St = '0111' THEN Ch := '7'
    ELSE IF St = '1000' THEN Ch := '8'
    ELSE IF St = '1001' THEN Ch := '9'
    ELSE IF St = '1010' THEN Ch := 'A'
    ELSE IF St = '1011' THEN Ch := 'B'
    ELSE IF St = '1100' THEN Ch := 'C'
    ELSE IF St = '1101' THEN Ch := 'D'
    ELSE IF St = '1110' THEN Ch := 'E'
    ELSE IF St = '1111' THEN Ch := 'F'
    ELSE Error := True;
    SetHex := Ch;
  END;

VAR HEX  : STRING;
    I    : INTEGER;
    Temp : STRING[4];
    Error: BOOLEAN;

BEGIN
  Error := False;
  IF BIN = '0' THEN HEX := '0'
  ELSE
  BEGIN
    Temp := '';
    HEX := '';
    IF Length(BIN) MOD 4 <>0 THEN
    REPEAT
      BIN := '0' + BIN;
    UNTIL Length(BIN) MOD 4 = 0;
    FOR I := 1 TO Length(BIN) DO
    BEGIN
      Temp := Temp + BIN[i];
      IF Length(Temp) = 4 THEN
      BEGIN
        HEX := HEX + SetHex(Temp, Error);
        Temp := '';
      END;
    END;
  END;
  IF Error THEN BIN2HEX := '0'
  ELSE BIN2HEX := HEX;
  Error:=False;
END;

begin
  Assign(F,'Bin.txt');
  Reset(F);
  Readln(F,Str);
  S:='';
  J:=0;
  Score:=0;
  for I := 1 to length(Str) do
  begin
    Score:=Score+1;
    if Str[I]<>' ' then begin S:=S+Str[I]; ScoreS:=ScoreS+1; end;
    if ((Str[I]=' ') or (I=length(Str))) and (S<>'') then
    begin
      INC(J);
      MHEX[J]:=Bin2Hex(S);
      MOCT[J]:=Bin2Oct(S);
      Len[J]:=ScoreS;
      Centr[J]:=Score;
      ScoreS:=0;
      S:='';
    end;
  end;
  Append(F);
  Writeln(F);
  B:=1;
  Score:=0;
  for I := 1 to J do
  begin
    for K := B to Centr[I]-Len[I] div 2-1 do
      Write(F,' ');
    B:=Centr[I];
    Write(F,MHEX[I]);
  end;
  Writeln(F);
    B:=1;
  Score:=0;
  for I := 1 to J do
  begin
    for K := B to Centr[I]-Len[I] div 2-1 do
      Write(F,' ');
    B:=Centr[I];
    Write(F,MOCT[I]);
  end;
  Close(F);
end.
FomAW вне форума Ответить с цитированием
Старый 30.05.2015, 15:32   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Жесть...
А как задача звучит?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 03.05.2016, 17:56   #3
katyakom
Новичок
Джуниор
 
Регистрация: 03.05.2016
Сообщений: 2
По умолчанию

...

Последний раз редактировалось katyakom; 03.05.2016 в 17:59.
katyakom вне форума Ответить с цитированием
Старый 03.05.2016, 17:58   #4
katyakom
Новичок
Джуниор
 
Регистрация: 03.05.2016
Сообщений: 2
По умолчанию и вот эту если можно на Си (чистый си). она покороче будет)) ооочень нужно

//Дан массив A размера N.
//Сформировать новый массив B того же размера
//по следующему правилу:
//элемент BK равен среднему арифметическому
//элементов массива A с номерами от 1 до K.
program Array59;
var
a: array [1..10] of real;
b: array [1..10] of real;
N:integer;
i:integer; // счетчик в цикле
begin
// ввод размера массива
writeln('Введите N (N<=10)');
readln(N);
writeln('Значения массива А');
// ввод значений исходного массива
for i:=1 to n do begin write('a[',i,']=');readln(A[i]); end;
// решение
b[1]:=a[1]; // значение первых элементов массивов совпадают
for i:=2 to n do // проход от 2 до последнего элемента исходжного массива
begin
b[i]:=(b[i-1]*(i-1)+a[i])/i; // формирование массива
end;
// вывод результата
Writeln('Ответ');
Write('B[]: '); for i:=1 to n do Write(B[i],' ');
end.
katyakom вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите переписать из кода Pascal в C++ Builder irisha3581 C++ Builder 1 02.10.2013 06:49
Переписать код с pascal на cpp yoyoyo Помощь студентам 5 11.02.2013 02:19
Переписать программу с Pascal на С++. Kimi_kun Общие вопросы C/C++ 0 21.12.2011 18:03
Как переписать с Pascal на C(++)? nd0ut Помощь студентам 2 07.02.2011 19:52
Нужно переписать программу с pascal на С++ ALiKa ALiK Помощь студентам 2 02.05.2010 22:01