• 0
Jeysi Z

Неправильно работает case

Вопросы

Здравствуйте, для проекта понадобилось рисовать разные 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.

5a420791531a2_.PNG.2891de7392208a0f80440ec2b4e86d9d.PNG5a42079735611_1.PNG.dae9a7828a0d89da2fc1cd7d6f7751c1.PNG

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

Изменено пользователем Jeysi Z

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

4 ответа на этот вопрос

  • 0

Чудес не бывает, либо в отладчике смотрите какое значение stage, либо в render выводите stage на экран.

И не видно кода, как происходит перерисовка после изменения stage, думаете изменение переменной автоматически перерисует сцену?

Изменено пользователем Alexander

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

Значение 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;

 

Изменено пользователем Jeysi Z

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0
2 часа назад, POV сказал:

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

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

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

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти

  • Похожий контент

    • От Jeysi Z
      Здравствуйте, хотел поинтересоваться, как писать что-то в процедуре render на context?
    • От Ilya.Z
      Добрый день, может туплю, или не туда копаю.. есть ли Firemonkey более менее стандартный способ рисовать на поверхности  3D фигур?
      в частности интересует сфера, есть две координаты, нужно провести чрез них линию, так что бы бы она легла на поверхность, или начертить фигуру так же лежащую на поверхности.
      или надо копать в глубь математики, и разбивать на множество отрезков, расчитывать каждую координату для каждой точки и т.д.
      ну а заливка фигур как понимаю только через материалы доступна в 3D, но можно залить ограниченную область на поверхности тогда ?
      нашел очень симпатичный пример на youtube от QuarkCube - Sketch3d, но там интерактивное рисование мышкой, и каждая линия это множество примитивов, все красиво но не совсем то )
      пытаюсь рисовать скажем планету, и показать на ней треки, области, точки:) 
    • От Jeysi Z
      Здравствуйте, начал делать проект о сечениях, нарисовал на 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, то не получается сменить стандартную камеру. Можно ли это исправить?
      Заранее спасибо.
    • От Jeysi Z
      Здравствуйте, для проекта понадобилось рисовать линии в 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;
      На изображении результат работы программы.

    • От Maximus
      Доброго всем времени суток. Хочу снова поднять вопрос про отрисовку линий на канве, обсуждавшейся здесь
      С горизонтальными и вертикальными линиями проблем нет, при смещении на половину от толщины линии всё прекрасно выглядит. Однако при отрисовке линий под различными углами такой финт не проходит: слева VCL, справа FMX

      Линия всё так же размазывается, в итоге визуально утолщается и становится не такой чёткой.
      Как всё же добиться такого же результата как на VCL? Интересует только Windows.
      const OFFSET_LINE = 0.5; ... Image.Bitmap.Canvas.BeginScene; Image.Bitmap.Canvas.Stroke.Kind := TBrushKind.Solid; Image.Bitmap.Canvas.Stroke.Thickness := 1.0; Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(500.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(10.0 - OFFSET_LINE, 500.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(500.0 - OFFSET_LINE, 500.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.EndScene;  
    • От jekans
      Подскажите пожалуйста глупому человеку , как можно загрузив изображение:
      buf: TBitmap; buf.LoadFromFile('.bmp'); Определить цвет нужного мне пикселя (X,Y), и нарисовать хотя бы линию этого цвета на форме используя обычный: 
      Canvas.DrawLine    
    • От brunnengi
      Здравствуйте.
      Как включить Wireframe режим (отображение сетки) для всех моделей, и для отдельно взятой модели?
  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу