Летящий параллелепипед

koroleva25 · #16 18.03.2012, 18:13

Вы уж не сердитесь на меня, я ведь ещё новичек. А вращение вокруг точки я все же сделала – как научили.
Подскажите, почему оси координат исчезают, когда начинаю вращать квадрат?
И как сделать, чтобы квадрат вращался не где-то в стороне, а именно вокруг центра координат

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Image1: TImage;
    Button1: TButton;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   x,y,xn,yn:array[1..4] of integer;
  cosa,sina:double;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
x,y: Real;
    x0, y0: Integer;
    m: Integer;
    i: Integer;
    n: Integer;
begin
x0 := Image1.Width div 2; // центр координатной плоскости по х оси
  y0 := Image1.Height div 2; // центр координатной плоскости по у оси
  m := 25;      // масштаб

  // координатная плоскость
  Image1.Canvas.MoveTo(0, y0);
  Image1.Canvas.LineTo(ClientWidth, y0);
  Image1.Canvas.MoveTo(x0, 0);
  Image1.Canvas.LineTo(x0, ClientHeight);

  x := -7; // стартовое значение функции
  n := Abs(Round(x)); // конечное значение функции
  // шкалирование осей
  for i := Round(x) to n do
    begin
      Image1.Canvas.MoveTo(x0+i*m, y0-5);
      Image1.Canvas.LineTo(x0+i*m, y0-(-5));
      Image1.Canvas.TextOut(x0+i*m, y0+10, IntToStr(i));
      Image1.Canvas.MoveTo(x0+5, y0-m*i);
      Image1.Canvas.LineTo(x0-5, y0-m*i);
      Image1.Canvas.TextOut(x0-15, y0+i*m, IntToStr(-i));
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
x[1]:=-50 ;
y[1]:=-50 ;

x[2]:=50 ;
y[2]:=-50 ;

x[3]:=50 ;
y[3]:=50 ;

x[4]:=-50 ;
y[4]:=50 ;

end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
i:integer;

begin
label1.Caption:=Inttostr(TrackBar1.Position);
Image1.Canvas.FillRect(rect(0,0,Width,height));

cosa:=cos(2*pi*trackBar1.Position/360);
sina:=sin(2*pi*trackBar1.Position/360);
for i:=1 to 4 do
begin
    Canvas.MoveTo(200+xn[i],200+yn[i]);
    Image1.Canvas.lineTo(200+xn[i],200+yn[i]);

    xn[i]:=round((x[i]+100)*cosa-(y[i]+100)*sina);
    yn[i]:=round((x[i]+100)*sina+(y[i]+100)*cosa);

end;
end;
end.

Pilot_Red · #17 18.03.2012, 19:08

сетка исчезает из-за этой строчки
Image1.Canvas.FillRect(rect(0,0,Width,height));
по второму вопросу попробуй разобраться сама...

koroleva25 · #18 20.03.2012, 00:54

Ничего не получается.

Смогла только вывести на одно поле. Если не трудно, исправьте, пожалуйста

angvelem · #19 20.03.2012, 02:47

Так пойдет?

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Image1: TImage;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DrawCoo;
    procedure DrawRect;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x0, y0       : Integer;
  cosa, sina   : Double;
  RectCooOrg,
  RectCooLast  : array[0..4] of TPoint;

const
  pi2 = 2 * pi;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  x0 := Image1.Width div 2;     // центр координатной плоскости по х оси
  y0 := Image1.Height div 2;    // центр координатной плоскости по у оси

  RectCooOrg[0].X := - 150;
  RectCooOrg[0].Y := - 75;
  RectCooOrg[1].X := 150;
  RectCooOrg[1].Y := - 75;
  RectCooOrg[2].X := 150;
  RectCooOrg[2].Y := 75;
  RectCooOrg[3].X := - 150;
  RectCooOrg[3].Y := 75;
  RectCooOrg[4].X := - 150;
  RectCooOrg[4].Y := - 75;

  RectCooLast[0].X := - 150;
  RectCooLast[0].Y := - 75;
  RectCooLast[1].X := 150;
  RectCooLast[1].Y := - 75;
  RectCooLast[2].X := 150;
  RectCooLast[2].Y := 75;
  RectCooLast[3].X := - 150;
  RectCooLast[3].Y := 75;
  RectCooLast[4].X := - 150;
  RectCooLast[4].Y := - 75;

  DrawCoo;

  cosa := cos(pi2 * trackBar1.Position / 360);
  sina := sin(pi2 * trackBar1.Position / 360);

  DrawRect;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  label1.Caption := Inttostr(TrackBar1.Position);
  Image1.Canvas.FillRect(Rect(0, 0, Width, Height));

  DrawCoo;

  cosa := cos(pi2 * trackBar1.Position / 360);
  sina := sin(pi2 * trackBar1.Position / 360);

  DrawRect;
end;

procedure TForm1.DrawCoo;
var
  m, i : Integer;
begin
  m := 25;                      // масштаб

  Image1.Canvas.Pen.Color := clBlack;
  // координатная плоскость
  Image1.Canvas.MoveTo(0, y0);
  Image1.Canvas.LineTo(ClientWidth, y0);
  Image1.Canvas.MoveTo(x0, 0);
  Image1.Canvas.LineTo(x0, ClientHeight);

  // шкалирование осей
  for i := -7 to 7 do
  begin
    Image1.Canvas.MoveTo(x0 + i * m, y0 - 5);
    Image1.Canvas.LineTo(x0 + i * m, y0 - (-5));
    if I <> 0 then
      Image1.Canvas.TextOut(x0 + i * m - 5, y0 + 10, IntToStr(i));

    Image1.Canvas.MoveTo(x0 + 5, y0 - m * i);
    Image1.Canvas.LineTo(x0 - 5, y0 - m * i);
    if I <> 0 then
      Image1.Canvas.TextOut(x0 - 20, y0 + i * m - 5, IntToStr(-i));
  end;
end;

procedure TForm1.DrawRect;
var
  I : Integer;
begin
  Image1.Canvas.Pen.Color := clLime;

  for I := 0 to 3 do
  begin
    Image1.Canvas.MoveTo(RectCooLast[i].X + x0, RectCooLast[i].Y + y0);
    Image1.Canvas.LineTo(RectCooLast[I + 1].X + x0, RectCooLast[I + 1].Y + y0);
  end;

  for I := 0 to 4 do
  begin
    RectCooLast[i].X := Round(RectCooOrg[i].X * cosa - RectCooOrg[i].Y * sina);
    RectCooLast[i].Y := Round(RectCooOrg[i].Y * cosa + RectCooOrg[i].X * sina);
  end;
end;

end.

angvelem · #20 20.03.2012, 03:59

Так, наверное, будет лучше?

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Image1: TImage;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DrawCoo;
    procedure DrawRect;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x0, y0       : Integer;
  cosa, sina   : Double;
  RectCooOrg,
  RectCooLast  : array[0..4] of TPoint;

const
  pi2 = 2 * pi;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  x0 := Image1.Width div 2;     // центр координатной плоскости по х оси
  y0 := Image1.Height div 2;    // центр координатной плоскости по у оси

  RectCooOrg[0].X := - 150;
  RectCooOrg[0].Y := - 75;
  RectCooOrg[1].X := 150;
  RectCooOrg[1].Y := - 75;
  RectCooOrg[2].X := 150;
  RectCooOrg[2].Y := 75;
  RectCooOrg[3].X := - 150;
  RectCooOrg[3].Y := 75;
  RectCooOrg[4].X := - 150;
  RectCooOrg[4].Y := - 75;

  RectCooLast := RectCooOrg;

  DrawCoo;

  cosa := cos(pi2 * trackBar1.Position / 360);
  sina := sin(pi2 * trackBar1.Position / 360);

  DrawRect;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  label1.Caption := Inttostr(TrackBar1.Position);
  Image1.Canvas.FillRect(Rect(0, 0, Width, Height));

  DrawCoo;

  cosa := cos(pi2 * trackBar1.Position / 360);
  sina := sin(pi2 * trackBar1.Position / 360);

  DrawRect;
end;

procedure TForm1.DrawCoo;
var
  m, i : Integer;
begin
  m := 25;                      // масштаб

  Image1.Canvas.Pen.Color := clBlack;
  // координатная плоскость
  Image1.Canvas.MoveTo(0, y0);
  Image1.Canvas.LineTo(ClientWidth, y0);
  Image1.Canvas.MoveTo(x0, 0);
  Image1.Canvas.LineTo(x0, ClientHeight);

  // шкалирование осей
  for i := -7 to 7 do
  begin
    Image1.Canvas.MoveTo(x0 + i * m, y0 - 5);
    Image1.Canvas.LineTo(x0 + i * m, y0 - (-5));
    if I <> 0 then
      Image1.Canvas.TextOut(x0 + i * m - 5, y0 + 10, IntToStr(i));

    Image1.Canvas.MoveTo(x0 + 5, y0 - m * i);
    Image1.Canvas.LineTo(x0 - 5, y0 - m * i);
    if I <> 0 then
      Image1.Canvas.TextOut(x0 - 20, y0 + i * m - 5, IntToStr(-i));
  end;
end;

procedure TForm1.DrawRect;
var
  I : Integer;
begin
  Image1.Canvas.Pen.Color := clLime;

  for I := 0 to 4 do
  begin
    RectCooLast[i].X := Round(RectCooOrg[i].X * cosa - RectCooOrg[i].Y * sina + x0);
    RectCooLast[i].Y := Round(RectCooOrg[i].Y * cosa + RectCooOrg[i].X * sina + y0);
  end;

  Image1.Canvas.Polyline(RectCooLast);
end;

end.

koroleva25 · #21 20.03.2012, 11:31

Спасибо огромное! Выручили! Естественно у меня появились вопросы по коду:
1) Вот здесь:

Код:

 RectCooOrg[0].X := - 150;
  RectCooOrg[0].Y := - 75;
  RectCooOrg[1].X := 150;
  RectCooOrg[1].Y := - 75;
  RectCooOrg[2].X := 150;
  RectCooOrg[2].Y := 75;
  RectCooOrg[3].X := - 150;
  RectCooOrg[3].Y := 75;
  RectCooOrg[4].X := - 150;
  RectCooOrg[4].Y := - 75;

Это так и должно быть, что повторяются первые две и последние две строчки?
2) Изменяя эти координаты, я могу смело строить свой паралелограм? (Уже боюсь что-либо менять без подсказки)
3) Какое вообще предназначение у этих массивов: RectCooOrg и RectCooLast, почему координаты у них дублируются?
4) Предполагаю, что для того чтобы можно было крутить мою фигуру:
a) не на 10 , а на 360 градусов;
b) не через свой центр, а вокруг центра осей координат,
я должна вот здесь:

Код:

RectCooLast[i].X := Round(RectCooOrg[i].X * cosa - RectCooOrg[i].Y * sina + x0);
RectCooLast[i].Y := Round(RectCooOrg[i].Y * cosa + RectCooOrg[i].X * sina + y0);

кое-что добавить ? Как в предыдущем варианте?

angvelem · #22 20.03.2012, 21:21

1. Координаты прямоугольника относительно центра оси координат. Нужно 5 координат - 4 основные и 5-ая возвращающая в исходную точку.
2. Да.
3. xxOrg - координаты от которых производятся вычисления - не меняются (лучше указать как константа). xxLast - по-которым отрисовываем, меняются при передвижении ползунка TTrackBar-а. В первоначальный момент одинаковы.
4. Оба кода идентичны, за исключением, во-втором используется одна команда Polyline, позволяющая отрисовать фигуру за один проход. +x0, +y0 привязывают координаты к цетру осей координат.

koroleva25 · #23 20.03.2012, 22:48

Благодарю вас за исчерпывающий ответ!
Ситуация прояснилась!

koroleva25 · #24 23.03.2012, 15:14

Здравствуйте! Нужна ваша подсказка.
Будьте добры, посмотрите пожалуйста программу.
1)Правильно ли я написала процедуру масштабирования моей фигуры для соответствующей кнопки? (Т.е. не совсем по дилетантски?)
2)Никак не получается написать код для кнопки « Перенос». Подскажите, если не сложно
3)Возможно ли сделать так, чтобы угол вращения (Label1) менялся не от 0 до 10, а от 0 до 360 градусов ?

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
TrackBar1: TTrackBar;
Image1: TImage;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure DrawCoo;
procedure DrawRect;

public
{ Public declarations }
end;

var
Form1: TForm1;
x0, y0 : Integer;
cosa, sina : Double;
RectCooOrg, RectCooLast : array[0..4] of TPoint;

const
pi2 = 2 * pi;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
x0 := Image1.Width div 2; // центр координатной плоскости по х оси
y0 := Image1.Height div 2; // центр координатной плоскости по у оси
// Координаты
RectCooOrg[0].X := 50;
RectCooOrg[0].Y := 70;
RectCooOrg[1].X := 120;
RectCooOrg[1].Y := 70;
RectCooOrg[2].X := 130;
RectCooOrg[2].Y := 30;
RectCooOrg[3].X := 60;
RectCooOrg[3].Y := 30;
RectCooOrg[4].X := 50;
RectCooOrg[4].Y := 70;

RectCooLast := RectCooOrg;

DrawCoo; // Оси

cosa := cos(pi2 * trackBar1.Position / 360);
sina := sin(pi2 * trackBar1.Position / 360);

DrawRect;// Процедура построения параллелограмма

end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
label1.Caption := Inttostr(TrackBar1.Position);
Image1.Canvas.FillRect(Rect(0, 0, Width, Height));

DrawCoo;

cosa := cos(10*pi2 * trackBar1.Position / 100);
sina := sin(10*pi2 * trackBar1.Position / 100);

DrawRect;
end;

procedure TForm1.Button1Click(Sender: TObject); //процедура маштабирования
begin
Image1.Picture:=nil;
DrawCoo;

RectCooOrg[0].X := 50 * (StrToInt(edit1.text));
RectCooOrg[0].Y := 70 * (StrToInt(edit1.text));
RectCooOrg[1].X := 120 * (StrToInt(edit1.text));
RectCooOrg[1].Y := 70 * (StrToInt(edit1.text));
RectCooOrg[2].X := 130 * (StrToInt(edit1.text));
RectCooOrg[2].Y := 30 * (StrToInt(edit1.text));
RectCooOrg[3].X := 60 * (StrToInt(edit1.text));
RectCooOrg[3].Y := 30 * (StrToInt(edit1.text));
RectCooOrg[4].X := 50 * (StrToInt(edit1.text));
RectCooOrg[4].Y := 70 * (StrToInt(edit1.text));

DrawRect;
end;

procedure TForm1.Button2Click(Sender: TObject); //Процедура переноса фигуры
begin
Image1.Picture:=nil;
DrawCoo;

end;

procedure TForm1.DrawCoo; //Построение осей координат
var
m, i : Integer;
begin
m := 25; // масштаб
Image1.Canvas.Pen.Color := clBlack;
// координатная плоскость
Image1.Canvas.MoveTo(0, y0);
Image1.Canvas.LineTo(ClientWidth, y0);
Image1.Canvas.MoveTo(x0, 0);
Image1.Canvas.LineTo(x0, ClientHeight);
// шкалирование осей
for i := -7 to 7 do
begin
Image1.Canvas.MoveTo(x0 + i * m, y0 - 5);
Image1.Canvas.LineTo(x0 + i * m, y0 - (-5));
if I <> 0 then
Image1.Canvas.TextOut(x0 + i * m - 5, y0 + 10, IntToStr(i));

Image1.Canvas.MoveTo(x0 + 5, y0 - m * i);
Image1.Canvas.LineTo(x0 - 5, y0 - m * i);
if I <> 0 then
Image1.Canvas.TextOut(x0 - 20, y0 + i * m - 5, IntToStr(-i));
end;
end;

procedure TForm1.DrawRect; // Построение параллелограмма
var
I : Integer;
begin
Image1.Canvas.Pen.Color := clBlack;

for I := 0 to 4 do
begin
RectCooLast[i].X := Round(RectCooOrg[i].X * cosa - RectCooOrg[i].Y * sina + x0);
RectCooLast[i].Y := Round(RectCooOrg[i].Y * cosa + RectCooOrg[i].X * sina + y0);
end;

Image1.Canvas.Polyline(RectCooLast);
end;

end.

angvelem · #25 24.03.2012, 00:38

Попробуй

koroleva25 · #26 24.03.2012, 20:13

Да уж !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Ну что я могу сказать. Спасибо !!!!!!!!!!!!!!!!!!!!!!!!!!!
Мне стыдно. Чтобы мне научиться самостоятельно писать такие коды наверное всей жизни не хватит. Такое впечатление что код писал человек с 40-летним опытом.
Ну чтобы мне не совсем обидно было за свои "знания", все-таки покажу что я успела "состряпать" и уже собиралась показать преподавателю.
Если что, не судите строго.
Была рада послушать ваши советы.

Pilot_Red · #27 24.03.2012, 20:24

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

angvelem · #28 24.03.2012, 21:16

Честно говоря, я так и не понял надобность кнопок, поэтому в моём варианте они отсутствуют. Все изменения "подвешены" на OnChange и исполняются динамически при изменении параметров.

koroleva25 · #29 24.03.2012, 21:43

Да нет, название кнопки правильное и сетку растягивать не надо. (Нам на лекции показывали пример работы программы с помощью проектора).
Правда потом препод сказала, что интерфейс - дело творческое, поэтому можно было делать как душа пожелает.
Честно говоря, даже немного страшно показывать такую работу (которую сделал angvelem). Даже невооруженным взглядом видно, что её делал профессионал.

angvelem · #30 24.03.2012, 21:52

Ничего страшного, убери 3 кнопки TSpeedButton, последние 3 процедуры (связанные с кнопками), процедуру FormHide и unit2. Во всём остальном обычная студенческая программа.

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

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо Pilot_Red за это полезное сообщение:
koroleva25 (20.03.2012)

Этот пользователь сказал Спасибо angvelem за это полезное сообщение:
koroleva25 (20.03.2012)