Jeysi Z

Здравствуйте. Для проекта понадобилось мышью перемещать TSphere по линии, нарисованной с помощью Drawline. Не подскажите, как можно реализовать такое движение строго вдоль линии. Хотя, был бы благодарен если бы помогли понять обычное движение 3d объектов. Заранее спасибо.

Здравствуйте, хотел поинтересоваться, как писать что-то в процедуре render на context?

2 часа назад, POV сказал:

begin-end проконтроллируй. Похоже у тебя весь код для "1"

Я посмотрел, вроде всё правильно.

Значение stage меняется нажатием на кнопки, одна уменьшает на 1, другая увеличивает, в процедуре нажатия я вызываю render.

Вот код

procedure TForm2.Button2Click(Sender: TObject);
begin
  stage:=stage+1;
  if stage>1 then
  begin
    Button3.Visible:=true;
    Label1.Margins.Left:=0;
  end;
  if stage=laststage then
  begin
    Button2.Visible:=false;
    Label1.Margins.Right:=65;
  end;
  Dummy1Render(sender,Dummy1.Context);
  Label1.Text:=IntToStr(stage);
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  stage:=stage-1;
  if stage=1 then
  begin
    Button3.Visible:=false;
    Label1.Margins.Left:=65;
  end;
  if stage<laststage then
  begin
    Button2.Visible:=true;
    Label1.Margins.Right:=0;
  end;
  Dummy1Render(sender,Dummy1.Context);
  Label1.Text:=IntToStr(stage);
end;

Здравствуйте, для проекта понадобилось рисовать разные 3d линии в зависимости от значения переменной, сначала решил проверить на совсем простом примере, но сразу возникли проблемы. В общем, в процедуре render организован case для переменной stage, в зависимости от её значения должны рисоваться разные линии, но этого не происходит, рисуется только первоначальная линия. 

Вот код процедуры :

procedure TForm2.Dummy1Render(Sender: TObject; Context: TContext3D);
var i:integer;
begin
       case stage of
             1:begin
              if Context.BeginScene then
                 try
                    Context.Clear(TAlphaColorRec.White);
                    Context.DrawLine(TPoint3D.Create(3,3,0),TPoint3D.Create(3,-3,0),1,TAlphaColorRec.Black);
                  finally
                  Context.EndScene;
                  end;
              end;
              2:begin
                  if Context.BeginScene then
                  try
                    Context.Clear(TAlphaColorRec.White);
                    Context.DrawLine(TPoint3D.Create(-3,3,0),TPoint3D.Create(-3,-3,0),1,TAlphaColorRec.Black);
                  finally
                  Context.EndScene;
                  end;
              end;
        end;
end;

 Вот скрины работы программы. Снизу отображается значение переменной stage.

Заранее спасибо.

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

Вот код рендера:

procedure TForm2.Dummy1Render(Sender: TObject; Context: TContext3D);

begin

if Context.BeginScene then
    try
      Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);

      Context.DrawLine(TPoint3D.Create(-3,3,3),TPoint3D.Create(3,3,3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,-3,3),TPoint3D.Create(3,3,3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,-3,3),TPoint3D.Create(-3,-3,3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(-3,3,3),TPoint3D.Create(-3,-3,3),1,TAlphaColorRec.Black);

      Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(-3,3,3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(3,-3,3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(-3,-3,3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(3,3,3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);

      Context.DrawLine(TPoint3D.Create(Sphere1.Position.X,Sphere1.Position.Y,Sphere1.Position.Z),
      TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z),1,TAlphaColorRec.Black);
      Context.DrawLine(TPoint3D.Create(Sphere3.Position.X,Sphere3.Position.Y,Sphere3.Position.Z),
      TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z),1,TAlphaColorRec.Black);
    finally
      Context.EndScene;
    end;

end;

Вот код вращения

procedure TForm2.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
    if ssleft in shift then
    begin
      Dummy2.RotationAngle.X:=Dummy2.RotationAngle.X-((Y-rot.Y)*0.3);
      Dummy2.RotationAngle.Y:=Dummy2.RotationAngle.Y-((X-rot.X)*0.3);
      Rot:=PointF(X,Y);
    end;
end;

Процедура масштабирования

procedure TForm2.Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
begin
  CameraZ.Position.Z:=CameraZ.Position.Z+WheelDelta/40;
end;

На изображениях показано как работает программа

И ещё один вопрос если позволите. Обнаружил, что если ставить отображение камеры и объектов на viewport3d как screen, то не получается сменить стандартную камеру. Можно ли это исправить?

Заранее спасибо.

Огромное спасибо, всё понял, теперь в центр Viewport3D ставлю Dummy и на нём делаю рендер.

Здравствуйте, для проекта понадобилось рисовать линии в 3d графике, но возникла такая проблема, можете подсказать, что не так?

Вот часть кода

procedure TForm2.Sphere1Render(Sender: TObject; Context: TContext3D);
var v1,v2:TPoint3D;
begin
  if Context.BeginScene then
  try
    v1:=TPoint3D.Create(Sphere1.Position.X,Sphere1.Position.Y,Sphere1.Position.Z);
    v2:=TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z);
    Context.drawline(v1,v2,1,TAlphaColorRec.Black);
  finally
    Context.EndScene;
  end;
end;

На изображении результат работы программы.