Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.06.2015, 09:07
Zmeo Zmeo вне форума
Прохожий
 
Регистрация: 15.06.2015
Сообщения: 4
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Рисование фигур с динамическим массивом

Друзья помогите кто может. Горю просто. Нужно нарисовать фигуры используя Динамический массив. Собственно вот задание. Незнаю даже с чего начать. Помоги с кодом.




Пользуясь средствами Borland Delphi, разработать Windows-приложение c графическим интерфейсом пользователя (окно Windows) для выполнения следующих операций с объектами:
• ввод данных об объектах предметной области;
• хранение данных в оперативной памяти;
• просмотр данных об объектах в экранной форме в виде списка (с помощью компонента TListBox, TMemo или TStringGrid) или дерева (TTreeView);
• редактирование выбранного объекта;
• удаление выбранного объекта;
• сортировка заданного набора объектов по общим атрибутам;
• поиск объекта по общим атрибутам.

Доступ к атрибутам объектов осуществлять только с помощью свойств классов. Операции реализовать только в виде методов классов.

Характеристики объектов:

Предметная область : Графические фигуры
Список типов объектов : Линия, треугольник, прямоугольник, окружность
Атрибуты : Общие - название, длина контура.
Индивид. - размеры, координаты
Ответить с цитированием
  #2  
Старый 15.06.2015, 09:12
Zmeo Zmeo вне форума
Прохожий
 
Регистрация: 15.06.2015
Сообщения: 4
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Есть какие то гугления и нароботки

Например нашёл процедуру создания треугольника.



Код:
procedure TForm1.Button1Click(Sender: TObject);
var a, b, c : integer;
  t1, t2, t3 : TPoint;
  ugol : double;
begin
  a := 200;
  b := 200;
  c := 350;
  if (a+b>c) and (b+c>a) and (a+c>b) then begin
    Memo1.Lines.Append('может быть такой!');
    t1.x := 0;
    t1.y := 0;
    t2.x := a;
    t2.y := 0;

    ugol := arccos( (sqr(b) - sqr(a) - sqr(c)) / (2*a*c) );
    t3.x := - trunc(c* cos(ugol));
    if t3.x < 0 then begin
      // сдвигаем весь треугольник по оси X
      t1.x := t1.x - t3.x;
      t2.x := t2.x - t3.x;
      t3.x := t3.x - t3.x; // кстати, тут должен ноль получится...
    end;
    t3.y := trunc(c* sin(ugol));
    Canvas.Polygon([t1, t2, t3]);

    Memo1.Lines.Append('X1, Y1 = '+IntToStr(t1.x)+' , '+IntToStr(t1.y));
    Memo1.Lines.Append('X2, Y2 = '+IntToStr(t2.x)+' , '+IntToStr(t2.y));
    Memo1.Lines.Append('X3, Y3 = '+IntToStr(t3.x)+' , '+IntToStr(t3.y));
  end
  else
    Memo1.Lines.Append('НЕ Может Быть!');

end;
Ответить с цитированием
  #3  
Старый 15.06.2015, 09:17
Zmeo Zmeo вне форума
Прохожий
 
Регистрация: 15.06.2015
Сообщения: 4
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Так же...

Примерный код создания прямоугольника и окружности.
Код:
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  x1, y1: integer;
  Down: BOOL;
implementation
 
{$R *.dfm}
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := True;
  x1 := x;
  y1 := y;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := False;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Down then
  begin
    if ssShift in Shift then
    begin
      Form1.Repaint;
      Canvas.Rectangle(x1,y1,x,y);
    end else
      begin
        Form1.Repaint;
        Canvas.Ellipse(x1,y1,x,y);
      end;
  end;
end;
 
end.
Ответить с цитированием
  #4  
Старый 15.06.2015, 11:40
icWasya icWasya вне форума
Местный
 
Регистрация: 09.11.2010
Сообщения: 499
Репутация: 10
По умолчанию

Ну для начала

Код:
type
 TFigura=class
private
   FName : String;
public
   procedure DrawTo(Canvas:TCanvas);//процедура рисования
                                           virtual;//сама процедура будет определена в наследниках
   procedure ToListItem(Item:TListItem);virtual;// процедура записи своих параметров в элемент TListView
   function ToString:String;virtual;
   function Verirification:Boolean;Virtual;//проверка правильности
   function Perimetr:Double;virtual; //периметр фигуры
   constructor Create(AName:String);//конструктор;
   property Name:String read FName;
end;

procedure TFigura.DrawTo(Canvas:TCanvas);
begin
end;
procedure TFigura.ToListItem(Item:TListItem);
begin
  Item.Caption:=Name;
  Item.SubItems.Clear;
  Item.SubItems.Add('Фигура');
  if Verirification then
    Item.SubItems.Add('может быть такой!')
  else
    Item.SubItems.Add('Не может быть');
  Item.SubItems.Add(Format('%F',[Perimetr]));
end;
function TFigura.ToString:String;
begin
  Result:=Name + '  Фигура  ';
  if Verirification then
    Result:=Result+'может быть такой!'
  else
    Result:=Result+'Не может быть';
  Result:=Result+Format('%F',[Perimetr]);
end;
function TFigura.Verirification:Boolean;
begin
  Result:=true;
end;
function TFigura.Perimetr:Double;
begin
  Result:=0;
end;
constructor TFigura.Create(AName:String);
begin
  inherited;
  FName:=AName;
end;

TFigurs = Array of TFigura;
и создать процедурки типа
Код:
procedure DrawAllTo(Canvas:TCanvas;A:TFigurs);
var i:Integer;
begin
  for I:=low(A) to high(A) do
    A[i].DrawTo(Canvas);
end;
procedure FigursToStrings(List:TStings;A:TFigurs);
var i:Integer;
begin
  List.Clear;
  for I:=low(A) to high(A) do
    List.Add(A[i].ToString);
end;

procedure FigursToListView(List:TListView;A:TFigurs);
begin
//напиши сам
end;

Кроме того, нужны будут процедуры добавления фигур в массив, удаления из него, поиск(По имени)
Ответить с цитированием
Этот пользователь сказал Спасибо icWasya за это полезное сообщение:
Zmeo (15.06.2015)
  #5  
Старый 15.06.2015, 12:09
icWasya icWasya вне форума
Местный
 
Регистрация: 09.11.2010
Сообщения: 499
Репутация: 10
По умолчанию

Например Окружность
Код:
type
 TCircle=class(TFigura)
private
   FO:TPoint;
   FR:Double;
public
   procedure DrawTo(Canvas:TCanvas);override;
   procedure ToListItem(Item:TListItem);override;
   function ToString:String;override;
   function Verirification:Boolean;override;
   function Perimetr:Double;override;
   constructor Create(AName:String);

   property Radius:Double read FR write FR;
   property center:TPoint read FO write FO;
end;

procedure TCircle.DrawTo(Canvas:TCanvas);
var R:integer;
begin
  R:=Round(FR);
  Canvas.Ellipce(FO.X-R,FO.Y-R,FO.X+R,FO.Y+R);
end;
procedure TCircle.ToListItem(Item:TListItem);
begin
  Item.Caption:=Name;
  Item.SubItems.Clear;
  Item.SubItems.Add('Круг');
  if Verirification then
    Item.SubItems.Add('может быть такой!')
  else
    Item.SubItems.Add('Не может быть');
  Item.SubItems.Add(Format('%F',[Perimetr]));
  Item.SubItems.Add(Format('%F',[Radius]));
  Item.SubItems.Add(Format('%d:%d',[FO.X,FO.Y]));
end;
function TCircle.ToString:String;
begin
  Result:=Name + '  Круг ';
  if Verirification then
    Result:=Result+'может быть такой!'
  else
    Result:=Result+'Не может быть';
  Result:=Result+Format('%F',[Perimetr]);

  Result:=Result+Format('%F',[Radius]));
  Result:=Result+Format('%d:%d',[FO.X,FO.Y]);
end;
function TCircle.Verirification:Boolean;
begin
  Result:=FR>0;
end;
function TCircle.Perimetr:Double;
begin
  Result:=Radius*2*Pi;
end;
constructor TCircle.Create(AName:String);
begin
  inherited(AName);
end;
Ответить с цитированием
Этот пользователь сказал Спасибо icWasya за это полезное сообщение:
Zmeo (15.06.2015)
  #6  
Старый 15.06.2015, 12:33
icWasya icWasya вне форума
Местный
 
Регистрация: 09.11.2010
Сообщения: 499
Репутация: 10
По умолчанию

Для редактирования
Завести на форме несколько панелек(Можно использовать TPageControl)
и процедур типа таких
Код:
 type TForm1=class(TForm)
  ....
  private
    CurrentCircle:TCircle;
....
 end;

Procedure TForm1.EditFigure(F:TFigure);
Begin
  if Figure Is TCircle then begin
    // спрятать все панели, кроме панели для окружности,
    // или, если TPageControl, переключиться на нужную страницу
    CurrentCircle:=Figure As TCircle;
    ShowCircle();
  end
End;

Procedure TForm1.ShowCircle();
Begin
   EditCircleRadius.Text:=Format('%f',[CurrentCircle.Radius]);
   EditCircleX.Text:=Format('%d',CurrentCircle.Center.X]);
   EditCircleY.Text:=Format('%d',CurrentCircle.Center.Y]);
end;

При выборе фигуры в списке Вызвать EditFigure.

Соответственно на панельке для работы с окружностями нужны Едиты EditCircleRadius,EditCircleX и EditCircleY, а так же кнопки ButtonCircleSave и ButtonCircleCancel.

Код:
Procedure TForm1.ButtonCircleSave (Sender :TObject);
var
  O:TPoint;
begin
   CurrentCircle.Radius:=StrToFloat(EditCircleRadius.Text);
   O.X:=StrToInt(EditCircleX.Text);
   O.Y:=StrToInt(EditCircleY.Text);
   CurrentCircle.Center:=O;
end;
Procedure TForm1.ButtonCircleCancel (Sender :TObject);
begin
  ShowCircle();
end;

Остальное сам
Ответить с цитированием
Этот пользователь сказал Спасибо icWasya за это полезное сообщение:
Zmeo (15.06.2015)
  #7  
Старый 15.06.2015, 19:24
Zmeo Zmeo вне форума
Прохожий
 
Регистрация: 15.06.2015
Сообщения: 4
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Благодарю

Спасибо тебе добрый человек. Выручил просто. Теперь буду разбираться что к чему. А то сам даже не знал с чего начать. Ценю за твой большой труд,что бы объяснить всё это мне.
Ответить с цитированием
  #8  
Старый 03.07.2015, 01:36
Аватар для Verevkin
Verevkin Verevkin вне форума
Прохожий
 
Регистрация: 22.06.2015
Сообщения: 43
Версия Delphi: 3...XE12
Репутация: -50
По умолчанию

что-то подобное я делал. не тебе ли?
__________________
Хей-хей-хей! Только не ходите в мой сарай, лады?..
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 22:08.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter