Форум программистов, компьютерный форум CyberForum.ru
Наши страницы

срочно требуется помощь... надо перевести из pascal в c++. каким образом ето сделать не понимаю... - C++

Войти
Регистрация
Восстановить пароль
Другие темы раздела
C++ Перевод чисел из римских в арабские и наоборот http://www.cyberforum.ru/cpp-beginners/thread37055.html
#include <iostream.h> #include <fstream.h> #include <stdlib.h> #include <windows.h> #include <conio.h> int AtoR(int);//прототипы функций int RtoA(char,char); void main()
C++ Нужна помощ с функциями в Borland C. Из-за праздников пропали пары по прогрмаированию, и одну из тем нам задали на самостоятельное изучение, тема про функции, и соответсвенно задали задание: Написать программу, содержащую функцию,... http://www.cyberforum.ru/cpp-beginners/thread37049.html
C++ максимальный элемент
В одномерном массиве, состоящем из n вещественных элементов, вычислить: 1) Номер максимального по модулю элемента массива; 2) Сумма модулей элементов массива, расположенных после первого...
C++ одномерный массив
Задача 1) В одномерном массиве, состоящем из nвещественных элементов, вычислить: 1. Сумму отрицательных элементов массива. 2. Произведение элементов массива, расположенных между максимальным и...
C++ Использование массива в функции http://www.cyberforum.ru/cpp-beginners/thread37041.html
Здравствуйте! Подскажите пожалуйсто каким образом я могу при описании функции ссылаться на массив данных.
C++ Проверить, есть ли в матрице хотя бы один столбец, содержащий элемент, равный нулю, и найти его номер 1)Проверить, есть ли в матрице хотя бы один столбец, содержащий элемент, равный нулю, и найти его номер. 2) Проверить, есть ли в матрице хотя бы одина строка, содержащая элемент, равный нулю, и... подробнее

Показать сообщение отдельно
san_andreys
Сообщений: n/a

срочно требуется помощь... надо перевести из pascal в c++. каким образом ето сделать не понимаю... - C++

28.05.2009, 19:49. Просмотров 474. Ответов 0
Метки (Все метки)

исходник паскаля

Program Kurs;
uses crt,graph;
type Dim=array[1..640] of byte;
DimPtr=^Dim;
var Wx,Wy,col,x1,i :integer;
DirPos,ImageFile,c :string;
driv,mode,x,y :integer;
seektiff :longint;
colmax,colmin :integer;
KoefSh :real;
a :array[1..480] of longint;
p :array[1..480] of DimPtr;
f :file;
Procedure HeadRead;
const TH :array[0..3] of byte=(73,73,42,0);
var NumberofTag,IFDlength :integer;
TagType,PoinTyp :integer;
comp,PoinAdr :longint;
Head,IFDInd,BegIFD :longint;
TiffHead :longint absolute TH;

begin
blockread(f,Head,4); {chtenie zagolovka faila}
if Head<>TiffHead then begin
writeln('eto ne TIFF, konec');
c:=readkey;
halt;
end;
seek(f,4);
blockread(f,BegIFD,4);{chtenie ukazatela na opisatelnuiu chast'}
seek(f,BegIFD);
blockread(f,NumberofTag,2);{chtenie kol-va tagov}
IFDInd:=BegIFD+2;
for i:=1 to NumberofTag do begin
blockread(f,TagType,2);
case TagType of
256: begin
inc(IFDInd,8);
seek(f,IFDInd);
blockread(f,Wx,4);{razmer po gorizontali}
end;
257: begin
inc(IFDInd,8);
seek(f,IFDInd);
blockread(f,Wy,4);{razmer po verticali}
end;
273: begin
inc(IFDInd,2);
seek(f,IFDInd);
blockread(f,PoinTyp,2);{tip zapisei}
inc(IFDInd,2); {v tablice}
seek(f,IFDInd);
blockread(f,comp,4);{kol-vo oblastei}
inc(IFDInd,4); {dannih}
seek(f,IFDInd);
if comp=1 then begin
blockread(f,seektiff,4); {ukazatel na nachalo dannih}
end
else begin
blockread(f,PoinAdr,4);{ukazatel na tablicu}
seek(f,PoinAdr);
blockread(f,seektiff,PoinTyp);
end;
end;
else begin
inc(IFDInd,8);
end;
end;
inc(IFDInd,4);
seek(f,IFDInd);
end;
end;
{----NACHALO ISPOLNYAEMOI CHASTI----}
begin
clrscr;
DirPos:='d:\tp7\images'; {ustanovka tekushchego kataloga}
clrscr;
writeln('vvedite imya faila iz etogo kataloga');
write('d:\tp7\images\');
readln(ImageFile);
if ImageFile='' then
begin
writeln('ne zadan file, konec');
c:=readkey;
halt;
end;
writeln('vvedite colmin');
read(colmin);
writeln('vvedite colmax');
read(colmax);
assign(f,ImageFile);
reset(f,1);
DirPos:='d:\tp7';
if (ImageFile='eagle.dat') then begin
Wx:=180;
Wy:=240;
seektiff:=0;
end
else Headread;
seek(f,seektiff);
for y:=1 to Wy do
begin
new(p[y]);
blockread(f,p[y]^,Wx); {chtenie faila}
end;
close(f);
driv:=9;
mode:=2;
InitGraph(driv,mode,''); {inizializaciya grafiki}
for y:=0 to 15 do
begin
setRGBpalette(y,y*4,y*4,y*4); {ustanovka palitry}
setPalette(y,y);
end;
for y:=1 to Wy do
begin
a[y]:=0;
for x:=1 to Wx do
begin
col:=p[y]^[x];
a[y]:=a[y]+col;
col:=col shr 4;
putpixel(x,y,col); {vyvod ishodnogo izobrajeniya}
end;
a[y]:=round(a[y]/Wx);
end;
SetColor(15);
OutTextXY(0,Wy+10,'najmite_lubuiu_klavishu');
c:=readkey;
SetColor(0);
OutTextXY(0,Wy+10,'najmite_lubuiu_klavishu');
if (Wx<(640/2)) then x1:=Wx
else x1:=640-Wx;
for y:=1 to Wy do
begin
if (a[y]<colmax) and (a[y]>colmin)
then begin
for x:=1 to x1 do
putpixel(x,y,0);
for x:=1 to Wx do
begin
col:=p[y]^[x];
col:=col shr 4;
putpixel(x+x1,y,col);
end;
end;
end;
for y:=1 to Wy do
dispose(p[y]); {osvobojdenie pamiyati}
SetColor(15);
OutTextXY(0,Wy+10,'najmite_lubuiu_klavishu_dlya_vihoda_iz_programmy');
c:=readkey;
end.



буду очень благодарен вам)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru