pascalABCnet возврат в меню(графика) - Помощь студентам

Niv · 22.06.2015, 15:47

Нужно, что бы после того как фигура нарисовалась была возможность вернуться в начало программы и начать выполнять ее заново.

А если вам не трудно то и сделать. так что бы с клавиатуры задавать размеры фигур. Огромное спасибо.

Код:

uses
    GraphABC;
 
type
    Shape = auto class
        x, y: integer;
        color: GraphABC.Color;
       
        procedure Draw(); abstract;
    end;
 
    Rectangle = class(Shape)        
        x1, y1: integer;
       
        constructor Create(x, y, x1, y1: integer; color: GraphABC.Color);
        begin
            self.x := x;
            self.x1 := x1;
            self.y := y;
            self.y1 := y1;
            self.color := color;
        end;
       
        procedure Draw(); override;
        begin
            brush.Color := color;
            GraphABC.Rectangle(x, y, x1, y1);
           
            brush.Color := GraphABC.Color.Transparent;
        end;
    end;
   
    Circle = class(Shape)
        r: integer;
       
        constructor Create(x, y, r: integer; color: GraphABC.Color);
        begin
            self.x := x;
            self.y := y;
            self.r := r;
            self.color := color;
        end;
       
        procedure Draw(); override;
        begin
            brush.Color := color;
            GraphABC.Circle(x, y, r);
           
            brush.Color := GraphABC.Color.Transparent;
        end;
    end;
    
    Line = class(Shape)
        p1,p2,o1,o2: integer;
       
        constructor Create( p1,p2,o1,o2: integer; color: GraphABC.Color);
        begin
            self.p1 := p1;
            self.o1 := o1;
            self.p2 := p2;
            self.o2 := o2;
            self.color := color;
        end;
       
        procedure Draw(); override;
        begin
            brush.Color := color;
            GraphABC.Line( p1,p2,o1,o2);
           
            brush.Color := GraphABC.Color.Transparent;
        end;
    end;
      Triangle = class(Shape)
        x1, y1, x2, y2: integer;
 
        constructor Create(x, y, x1, y1, x2, y2: integer; color: GraphABC.Color);
        begin
            self.x := x;
            self.x1 := x1;
            self.x2 := x2;
            self.y := y;
            self.y1 := y1;
            self.y2 := y2;
            self.color := color;
        end;
       
        procedure Draw(); override;
        begin
            brush.Color := color;
           
            var points := new GraphABC.Point[3](new GraphABC.Point(x, y),
                                                new GraphABC.Point(x1, y1),
                                                new GraphABC.Point(x2, y2));
            GraphABC.Polygon(points);
            brush.Color := GraphABC.Color.Transparent;
        end;
    end;
function ChooseColor(color_name: string): GraphABC.Color;
begin
    case color_name of
        'красный': result := GraphABC.Color.Red;
        'оранжевый': result := GraphABC.Color.Orange;
        'желтый': result := GraphABC.Color.Yellow;
        'зеленый': result := GraphABC.Color.Green;
        'голубой': result := GraphABC.Color.LightCyan;
        'синий': result := GraphABC.Color.Blue;
        'фиолетовый': result := GraphABC.Color.Magenta;
 
    end;
end;
       
function ChooseFigure(figure_type: string; color: GraphABC.Color): Shape;
begin
    case figure_type of
        'прямоугольник': result := new Rectangle(500, 400, 300, 300, color);
        'квадрат': result := new Rectangle(400, 400, 300, 300, color);
        'круг': result := new Circle(350, 350, 100, color);
        'линия': result := new Line(300,100,400,100,color);
        'треугольник': result := new Triangle(100, 200, 150, 100, 200, 200, color);
    end;
end;
   
begin
    writeLn('Напишите один из семи цветов спектора:');
     writeLn('');
     writeLn('1-красный');
      writeLn('2-оранжевый');
       writeLn('3-желтый');
       writeLn('4-зеленый');
       writeLn('5-голубой');
       writeLn('6-синий');
       writeLn('7-фиолетовый');
        writeLn('');
    var color_name := ReadString();
    var color := ChooseColor(color_name);
    
    writeLn('Выберите одну их четырех фигур:');
     writeLn('');
    writeLn('1-треугольник');
    writeLn('2-круг');
    writeLn('3-квадрат');
    writeLn('4-прямоугольник');
    writeLn('5-линия');
    var figure_type := ReadString();
    var figure := ChooseFigure(figure_type, color);
   
    figure.Draw();
end.

Niv · 22.06.2015, 20:46

Пожалуйста помогите. Сделать только возврат в меню.

Serge_Bliznykov · 22.06.2015, 21:28

не знаю, какая у Вас версия Pascal ABC.NET, моя версия 2.2 сборка 776 (02.07.2014) такой case не разрешает:

Цитата:

Код:

function ChooseColor(color_name: string): GraphABC.Color;
begin
    case color_name of
        'красный': result := GraphABC.Color.Red;
....

выдаёт ошибку.

так что, и рад бы помочь, а не могу.

Niv · 22.06.2015, 21:33

Цитата:

Сообщение от Serge_Bliznykov

не знаю, какая у Вас версия Pascal ABC.NET, моя версия 2.2 сборка 776 (02.07.2014) такой case не разрешает:

выдаёт ошибку.

так что, и рад бы помочь, а не могу.

Подождите не уходите. сейчас проверю свою версию (версия 2.2, сборка 966 от 14.06.2015)
все работает. попробуйте тогда этот код (но он в принципе такой же за малым исключением)

Код:

uses
GraphABC;
 
type
Shape = auto class
x, y: integer;
color: GraphABC.Color;
 
procedure Draw(); abstract;
end;
 
Rectangle = class(Shape) 
x1, y1: integer;
 
constructor Create(x, y, x1, y1: integer; color: GraphABC.Color);
begin
self.x := x;
self.x1 := x1;
self.y := y;
self.y1 := y1;
self.color := color;
end;
 
procedure Draw(); override;
begin
brush.Color := color;
GraphABC.Rectangle(x, y, x1, y1);
 
brush.Color := GraphABC.Color.Transparent;
end;
end;
 
Circle = class(Shape)
r: integer;
 
constructor Create(x, y, r: integer; color: GraphABC.Color);
begin
self.x := x;
self.y := y;
self.r := r;
self.color := color;
end;
 
procedure Draw(); override;
begin
brush.Color := color;
GraphABC.Circle(x, y, r);
 
brush.Color := GraphABC.Color.Transparent;
end;
end;
 
Line = class(Shape)
p1,p2,o1,o2: integer;
 
constructor Create( p1,p2,o1,o2: integer; color: GraphABC.Color);
begin
self.p1 := p1;
self.o1 := o1;
self.p2 := p2;
self.o2 := o2;
self.color := color;
end;
 
procedure Draw(); override;
begin
brush.Color := color;
GraphABC.Line( p1,p2,o1,o2);
 
brush.Color := GraphABC.Color.Transparent;
end;
end;
Triangle = class(Shape)
x1, y1, x2, y2: integer;
 
constructor Create(x, y, x1, y1, x2, y2: integer; color: GraphABC.Color);
begin
self.x := x;
self.x1 := x1;
self.x2 := x2;
self.y := y;
self.y1 := y1;
self.y2 := y2;
self.color := color;
end;
 
procedure Draw(); override;
begin
brush.Color := color;
 
var points := new GraphABC.Point[3](new GraphABC.Point(x, y),
new GraphABC.Point(x1, y1),
new GraphABC.Point(x2, y2));
GraphABC.Polygon(points);
brush.Color := GraphABC.Color.Transparent;
end;
end;
function ChooseColor(color_name: string): GraphABC.Color;
begin
case color_name of
'красный': result := GraphABC.Color.Red;
'оранжевый': result := GraphABC.Color.Orange;
'желтый': result := GraphABC.Color.Yellow;
'зеленый': result := GraphABC.Color.Green;
'голубой': result := GraphABC.Color.LightCyan;
'синий': result := GraphABC.Color.Blue;
'фиолетовый': result := GraphABC.Color.Magenta;
 
end;
end;
 
function ChooseFigure(figure_type: string; color: GraphABC.Color): Shape;
begin
case figure_type of
'прямоугольник': result := new Rectangle(500, 400, 170, 170, color);
'квадрат': result := new Rectangle(200, 200, 400, 400, color);
'круг': result := new Circle(320, 250, 100, color);
'линия': result := new Line(300,100,400,100,color);
'треугольник': result := new Triangle(250, 350, 300, 250, 350, 350, color);
end;
end;
begin
writeLn('Программа содержит модуль graph и классы геометрических фигур');
writeLn('Для продолжения нажмите entr');
readln();
 
begin
clearwindow;
writeLn('Напишите один из семи цветов спектора:');
writeLn('');
writeLn('1-красный');
writeLn('2-оранжевый');
writeLn('3-желтый');
writeLn('4-зеленый');
writeLn('5-голубой');
writeLn('6-синий');
writeLn('7-фиолетовый');
writeLn('');
var color_name := ReadString();
var color := ChooseColor(color_name);
clearwindow;
writeLn('Выберите одну их четырех фигур:');
writeLn('');
writeLn('1-треугольник');
writeLn('2-круг');
writeLn('3-квадрат');
writeLn('4-прямоугольник');
writeLn('5-линия');
var figure_type := ReadString();
var figure := ChooseFigure(figure_type, color);
clearwindow;
figure.Draw();
 
end;
end.

Serge_Bliznykov · 22.06.2015, 22:48

не знаю, понравится Вам или нет, попробуйте такой код:

Код:

uses
  GraphABC;

type
  Shape = auto class
    x, y: integer;
    color: GraphABC.Color;

    procedure Draw(); abstract;
  end;

  Rectangle = class(Shape)
    x1, y1: integer;

    constructor Create(x, y, x1, y1: integer; color: GraphABC.Color);
    begin
      self.x := x;
      self.x1 := x1;
      self.y := y;
      self.y1 := y1;
      self.color := color;
    end;

    procedure Draw(); override;
    begin
      brush.Color := color;
      GraphABC.Rectangle(x, y, x1, y1);

      brush.Color := GraphABC.Color.Transparent;
    end;
  end;

  Circle = class(Shape)
    r: integer;

    constructor Create(x, y, r: integer; color: GraphABC.Color);
    begin
      self.x := x;
      self.y := y;
      self.r := r;
      self.color := color;
    end;

    procedure Draw(); override;
    begin
      brush.Color := color;
      GraphABC.Circle(x, y, r);

      brush.Color := GraphABC.Color.Transparent;
    end;
  end;

  Line = class(Shape)
    p1, p2, o1, o2: integer;

    constructor Create(p1, p2, o1, o2: integer; color: GraphABC.Color);
    begin
      self.p1 := p1;
      self.o1 := o1;
      self.p2 := p2;
      self.o2 := o2;
      self.color := color;
    end;

    procedure Draw(); override;
    begin
      brush.Color := color;
      GraphABC.Line(p1, p2, o1, o2);

      brush.Color := GraphABC.Color.Transparent;
    end;
  end;

  Triangle = class(Shape)
    x1, y1, x2, y2: integer;

    constructor Create(x, y, x1, y1, x2, y2: integer; color: GraphABC.Color);
    begin
      self.x := x;
      self.x1 := x1;
      self.x2 := x2;
      self.y := y;
      self.y1 := y1;
      self.y2 := y2;
      self.color := color;
    end;

    procedure Draw(); override;
  var points: array of GraphABC.Point;
    begin
      brush.Color := color;
      SetLength(points, 4);
      points[0] := new GraphABC.Point(x, y);
      points[1] := new GraphABC.Point(x1, y1);
      points[2] := new GraphABC.Point(x2, y2);
      points[3] := points[0];
      GraphABC.Polygon(points);
      brush.Color := GraphABC.Color.Transparent;
    end;
  end;

function ChooseColor(color_name: integer): GraphABC.Color;
begin
  case color_name of
    1: result := GraphABC.Color.Red;
    2: result := GraphABC.Color.Orange;
    3: result := GraphABC.Color.Yellow;
    4: result := GraphABC.Color.Green;
    5: result := GraphABC.Color.LightCyan;
    6: result := GraphABC.Color.Blue;
    7: result := GraphABC.Color.Magenta;
  else
    result := GraphABC.Color.Black;
  end;
end;

function ChooseFigure(figure_type: integer; color: GraphABC.Color): Shape;
begin
  case figure_type of
    4 {'прямоугольник'}: result := new Rectangle(500, 400, 170, 170, color);
    3 {'квадрат'}: result := new Rectangle(200, 200, 400, 400, color);
    2 {'круг'}: result := new Circle(320, 250, 100, color);
    5 {'линия'}: result := new Line(300, 100, 400, 100, color);
    1 {'треугольник'}: result := new Triangle(250, 350, 300, 250, 350, 350, color);
  else
    result := nil
  end;
end;

var
  color_name, figure_type, answer: integer;

begin

  writeLn('Программа содержит модуль graph и классы геометрических фигур');
  writeLn('Для продолжения нажмите Enter');
  readln();

  repeat
    repeat
      ClearWindow;
      SetFontName('Tahoma');
      SetFontSize(11);
      TextOut(1, 1, 'Напишите один из семи цветов спектора:');
      TextOut(1, 20, '1-красный');
      TextOut(1, 40, '2-оранжевый');
      TextOut(1, 60, '3-желтый');
      TextOut(1, 80, '4-зеленый');
      TextOut(1, 100, '5-голубой');
      TextOut(1, 120, '6-синий');
      TextOut(1, 140, '7-фиолетовый');
      if not TryStrToInt(ReadString(), color_name) then color_name := -1;
    until color_name in [1..7];
  var color := ChooseColor(color_name);
    repeat
      ClearWindow;
      TextOut(1, 1, 'Выберите одну их четырех фигур (введите номер):');
      TextOut(1, 30, '1-треугольник');
      TextOut(1, 50, '2-круг');
      TextOut(1, 70, '3-квадрат');
      TextOut(1, 90, '4-прямоугольник');
      TextOut(1, 110, '5-линия');
      if not TryStrToInt(ReadString(), figure_type) then figure_type := -1;
    until figure_type in [1..5];
  var figure := ChooseFigure(figure_type, color);
    clearwindow;
    if figure <> nil then begin
      figure.Draw();
    end;
    TextOut(1, 1, 'Повторить ещё раз? (1=Да)');
    Readln(answer);
    clearwindow;
  until answer <> 1;
  CloseWindow;
end.

p.s. а Pascal ABC.NET - это, конечно, мутантное уродство!

Niv · 22.06.2015, 23:11

Цитата:

Сообщение от Serge_Bliznykov

не знаю, понравится Вам или нет, попробуйте такой код:

p.s. а Pascal ABC.NET - это, конечно, мутантное уродство!

Да понравится. это получше чем было. на много по лучше.
извините конечно за на глость, но можете еще помочь с вводом размеров с клавиатуры, потому что я как ни пытался это сделать не как не выходит.

за основы попыток брал вот этот код (пытался такой же метод применить к моему коду)

Код:

uses GraphAbc;
var w:char;
    j:integer;
begin
  repeat
    ClearWindow;
    textout(1,10,'Выберите действие');
    textout(1,30,'1-нарисовать квадрат');
    textout(1,50,'2-нарисовать круг');
    textout(1,70,'другое выход');
    readln(w);
    case w of 
    '1':begin
        textout(1,90,'Сторона:');
        readln(j);
        ClearWindow;
        Rectangle(WindowWidth div 2-j div 2,WindowHeight div 2-j div 2,WindowWidth div 2+j div 2,WindowHeight div 2+ j div 2);
        textout(WindowWidth div 2-50,10,'Нажмите Enter');
        readln;
        end;
    '2':begin
        textout(1,90,'радиус:');
        readln(j);
        ClearWindow;
        Circle(WindowWidth div 2,WindowHeight div 2,j);
        textout(WindowWidth div 2-50,10,'Нажмите Enter');
        readln;
       end;
     else exit;
   end;  
  until not (w in ['1','2']);   
 end.

Но если вы не хотите помочь (сделать). то и не надо. Просто напишите мне, что бы я не ждал не надеялся.
Спасибо большое.

Serge_Bliznykov · 22.06.2015, 23:54

замени одну процедуру в том примере кода, что я тебе приводил выше:

Код:

function ChooseFigure(figure_type: integer; color: GraphABC.Color): Shape;
var x1,y1,x2,y2,x3,y3, a, r : integer;
begin
  case figure_type of
    4 {'прямоугольник'}: begin
          textout(1,200,'Введите координаты  углов x1, y1, x2, y2:');
          Readln(x1,y1,x2,y2);
          result := new Rectangle(x1, y1, x2, y2, color);
       end;
    3 {'квадрат'}:  begin
          textout(1,200,'Введите координаты левого угла x1, y1 и длину стороны a :');
          Readln(x1,y1,a);
       result := new Rectangle(x1, y1, x1+a, y1+a, color);
      end; 
    2 {'круг'}:  begin
          textout(1,200,'Введите координаты центра x1, y1 и радиус r :');
          Readln(x1,y1,r);
          result := new Circle(x1, y1, r, color);
      end;    
    5 {'линия'}: begin
          textout(1,200,'Введите координаты двух точек линии начала: x1,y1 и конца x2,y2 :');
          Readln(x1,y1,x2,y2);
          result := new Line(x1,y1,x2,y2, color);
        end;  
    1 {'треугольник'}: begin
          textout(1,200,'Введите координаты вершин треугольника  x1,y1,x2,y2,x3,y3:');
          Readln(x1,y1,x2,y2,x3,y3);
          result := new Triangle(x1,y1,x2,y2,x3,y2, color);
       end;   
  else
    result := nil
  end;
end;

Niv · 23.06.2015, 09:04

Цитата:

Сообщение от Serge_Bliznykov

замени одну процедуру в том примере кода, что я тебе приводил выше:

Код:

function ChooseFigure(figure_type: integer; color: GraphABC.Color): Shape;
var x1,y1,x2,y2,x3,y3, a, r : integer;
begin 
  case figure_type of
    4 {'прямоугольник'}: begin
          textout(1,200,'Введите координаты  углов x1, y1, x2, y2:');
          Readln(x1,y1,x2,y2);
          result := new Rectangle(x1, y1, x2, y2, color);
       end;
    3 {'квадрат'}:  begin
          textout(1,200,'Введите координаты левого угла x1, y1 и длину стороны a :');
          Readln(x1,y1,a);
       result := new Rectangle(x1, y1, x1+a, y1+a, color);
      end; 
    2 {'круг'}:  begin
          textout(1,200,'Введите координаты центра x1, y1 и радиус r :');
          Readln(x1,y1,r);
          result := new Circle(x1, y1, r, color);
      end;    
    5 {'линия'}: begin
          textout(1,200,'Введите координаты двух точек линии начала: x1,y1 и конца x2,y2 :');
          Readln(x1,y1,x2,y2);
          result := new Line(x1,y1,x2,y2, color);
        end;  
    1 {'треугольник'}: begin
          textout(1,200,'Введите координаты вершин треугольника  x1,y1,x2,y2,x3,y3:');
          Readln(x1,y1,x2,y2,x3,y3);
          result := new Triangle(x1,y1,x2,y2,x3,y2, color);
       end;   
  else
    result := nil
  end;
end;

Спасибо, огромное...

Serge_Bliznykov · 23.06.2015, 09:29

Цитата:

Сообщение от Niv

Спасибо, огромное...

пожалуйста.

опечатку только исправь:

Цитата:

Код:

 1 {'треугольник'}: begin
          textout(1,200,'Введите координаты вершин треугольника  x1,y1,x2,y2,x3,y3:');
          Readln(x1,y1,x2,y2,x3,y3);
          result := new Triangle(x1,y1,x2,y2,x3,y2, color);

Опции темы	Поиск в этой теме
Версия для печати Отправить по электронной почте	Поиск в этой теме: Расширенный поиск

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Файлы в PascalABCNET	Вадим Вергун	Паскаль, Turbo Pascal, PascalABC.NET	10	13.11.2014 22:36
Мышь в PascalABCNET	Вадим Вергун	Паскаль, Turbo Pascal, PascalABC.NET	19	02.11.2014 21:32
Возврат меню сервис	revaldo666	Microsoft Office Access	2	11.12.2010 00:16
Меню и графика	levadniy-andrey	Паскаль, Turbo Pascal, PascalABC.NET	0	28.05.2010 08:34
Возврат в меню	Baltazar-s	Общие вопросы Delphi	4	16.03.2010 17:59

22.06.2015, 20:46	#2
Niv Пользователь Регистрация: 18.06.2015 Сообщений: 24	Пожалуйста помогите. Сделать только возврат в меню.