Помощь - Поиск - Пользователи - Календарь
Полная версия: Псевдографика в Паскале
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Расим
Доброе время суток.
Люди помогите в понедельник сессия а задачу сделать не могуsad.gif
С помощью знаков «*» нарисовать 2 фигуры близнецов в соответствии . Необходимо написать собственные процедуры, функции для задания примитивов.
Подскажите хотя бы как создать эти процедуры???
Зарание Спасибо
Lapp
Цитата(Расим @ 10.01.2009 22:31) *
Подскажите хотя бы как создать эти процедуры
Если я правильно тебя понял, тебе нужно что-то наподобие вот этого:
uses
  CRT;

procedure DrawMan(x,y: integer);
const
  m=16;
  Man: array[1..m]of string=(
    '     *****     ',
    '**  *     *    ',
    ' *  *     *    ',
    ' *   *****     ',
    ' *     *       ',
    ' ************* ',
    '      * *    * ',
    '      * *    * ',
    '      * *    **',
    '      * *      ',
    '      ***      ',
    '     *   *     ',
    '    *     *    ',
    '   *       *   ',
    '  *         *  ',
    '**           **'
  );
var
  i: integer;
begin
  for i:=1 to m do begin
    GoToXY(x,y+i-1);
    Write(Man[i])
  end
end;

begin
  ClrScr;
  DrawMan(20,2);
  TextColor(LightGreen);
  DrawMan(60,6);
  TextColor(LightRed);
  DrawMan(40,8);
  GotoXY(1,Hi(WindMax));
  ReadLn
end.

Это простейшее, что можно придумать. Если же нужно, например, накладывать изображения друг на друга, то можно сделать так (я еще добавил некий фон, чтоб было понятно, о чем речь):
uses
  CRT;

procedure DrawMan(x,y: integer);
const
  m=16;
  n=15;
  Man: array[1..m]of string=(
    '     *****     ',
    '**  *     *    ',
    ' *  *     *    ',
    ' *   *****     ',
    ' *     *       ',
    ' ************* ',
    '      * *    * ',
    '      * *    * ',
    '      * *    **',
    '      * *      ',
    '      ***      ',
    '     *   *     ',
    '    *     *    ',
    '   *       *   ',
    '  *         *  ',
    '**           **'
  );
var
  i,j: integer;
begin
  for i:=1 to m do for j:=1 to n do if Man[i][j]<>' ' then begin
    GoToXY(x+j-1,y+i-1);
    Write(Man[i][j])
  end
end;

var
  i,MaxX,MaxY: integer;

begin
  ClrScr;
  MaxX:=Lo(WindMax);
  MaxY:=Hi(WindMax);
  {заполняем фон}
  TextColor(Blue);
  TextBackGround(Green);
  for i:=1 to 2000 do begin
    GoToXY(Random(MaxX)+1,MaxY-Random(Random(Random(MaxY))));
    Write('+')
  end;
  TextBackGround(Black);
  TextColor(Yellow);
  DrawMan(20,2);
  TextColor(LightBlue);
  DrawMan(60,6);
  TextColor(LightRed);
  DrawMan(40,8);
  GotoXY(1,Hi(WindMax));
  ReadLn
end.

Выглядит это пещерно-наскальное творчество примерно так: Нажмите для просмотра прикрепленного файла

Про псевдографику на Форуме совсем мало. Вот одна тема, в которой она фигурирует, глянь:
Расчет биоритмов
renesko1
Random(Random(Random(MaxY))));
Здорова, надо будет взять на заметку. smile.gif
Расим
не надо для каждой из линий написать процедуру
например голова procedure_golova и эта процедура вычерчивает голову значками * и.т.д
Lapp
Цитата(Расим @ 11.01.2009 20:06) *
не надо для каждой из линий написать процедуру
например голова procedure_golova и эта процедура вычерчивает голову значками * и.т.д
Ну, замечательно, пиши. Или осталось неясным что-то?

Только совмещать их - та еще задача.. Удобнее удет, если у каждого примитива будет "точка присоединения". У головы это низ, у руки - верх. И в процедуре пересчитывать эти координаты на левый ыкрхний угол прямоугольника, от которого рисуешь.
Расим
а можно пример такой процедуру например для головы? плз smile.gif
Lapp
Цитата(Расим @ 11.01.2009 20:55) *
а можно пример такой процедуру например для головы?

Вообще-то, самостоятельное написание процедуры для головы было бы очень полезной процедурой для твоей головы..

Вот, смотри.. Тут голова и тело. Точки соединения, про которые я говорил, я выделил знаками х. (Точки соединения - не совсем правильное название; лучше сказать - точки привязки.)

uses
  CRT;

procedure DrawHead(x,y: integer);
const
  m=5;
  n=7;
  Man: array[1..m]of string=(
    ' ***** ',
    '* . . *',
    '*  |  *',
    '*  -  *',
    ' **x** '
  );
var
  i,j: integer;
begin
  x:=x-3;
  y:=y-4;
  for i:=1 to m do for j:=1 to n do if Man[i][j]<>' ' then begin
    GoToXY(x+j-1,y+i-1);
    Write(Man[i][j])
  end
end;

procedure DrawBody(x,y: integer);
const
  m=10;
  n=9;
  Man: array[1..m]of string=(
    '****x****',
    '*       *',
    '*       *',
    '*       *',
    '*       *',
    '*       *',
    '*       *',
    '*       *',
    '*       *',
    '********* '
  );
var
  i,j: integer;
begin
  x:=x-n div 2;
  for i:=1 to m do for j:=1 to n do if Man[i][j]<>' ' then begin
    GoToXY(x+j-1,y+i-1);
    Write(Man[i][j])
  end
end;

var
  i,MaxX,MaxY: integer;

begin
  ClrScr;
  MaxX:=Lo(WindMax);
  MaxY:=Hi(WindMax);
  TextColor(Yellow);
  DrawHead(20,10);
  TextColor(LightBlue);
  DrawBody(20,12);
  ReadLn
end.

Конечно, это полнейшая фигня (я имею в виду такую организацию программы). Было бы правильнее сделать примитивы как переменные - записи, содержащие массивы строк, размеры и точки привязки, а для вывода сделать одну процедуру. Тогда примитивы можно было бы задавать в файле данных (кстати, намного удобнее редактировать). Еще правильнее было бы сделать все объектами smile.gif.
renesko1
Насчёт обьектов эт я согласен, что интерессно по-проблемам ООП очень мало человек обр., видимо кто доучился до таких высот, освоил, что в инете всё есть и так smile.gif
//Извеняюсь за флуд..
Lapp
Цитата(renesko1 @ 13.01.2009 19:53) *
по-проблемам ООП очень мало человек обр.

что есть "обр."?
Обращаются?.. образованы? обременены? обрадованы? blink.gif
Неужели так трудно/долго написать слово целиком?
renesko1
Каюсь, не дописал... "обращаются"... привык печатать сам с собой поэтому недопичатываю слова по привычке.
Больше не буду.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.