⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 code for d bezier curve
💻 PAS
📖 第 1 页 / 共 4 页
字号:

{------------------------------------------------------------------------}
{  Zoom scene in or out depending on zViewModifier                       }
{------------------------------------------------------------------------}
procedure TForm1.Timer2Timer(Sender: TObject);
begin
   zView := zView + zViewModifier;
end;

{------------------------------------------------------------------------}
{  Enable Zoom out                                                    }
{------------------------------------------------------------------------}
procedure TForm1.Button5MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  zViewModifier := 0.1;
  timer2.Enabled := true;
end;

{------------------------------------------------------------------------}
{  Enable Zoom in                                                        }
{------------------------------------------------------------------------}
procedure TForm1.Button6MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  zViewModifier := -0.1;
  timer2.Enabled := true;
end;

{------------------------------------------------------------------------}
{  Disable Zoom in                                                       }
{------------------------------------------------------------------------}
procedure TForm1.Button6MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  timer2.Enabled := false;
end;

{------------------------------------------------------------------------}
{  Disable Zoom out                                                      }
{------------------------------------------------------------------------}
procedure TForm1.Button5MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  timer2.Enabled := false;
end;

{------------------------------------------------------------------------}
{  Save Control point to file(*.txt)                                     }
{------------------------------------------------------------------------}
procedure TForm1.SaveControlPoints1Click(Sender: TObject);
var f : TextFile;
    I : integer;
begin
  SaveDialog1.Filter := 'Control Points File|*.TXT';
  if SaveDialog1.Execute then
  begin
    AssignFile(f,SaveDialog1.FileName);
    Rewrite(f);
    for I := 0 to high(g_arrvStartPoint) do
    begin
      WriteLn(f,FloatToStr(g_arrvStartPoint[I].X) + ' ' + FloatToStr(g_arrvStartPoint[I].Y) + ' ' + FloatToStr(g_arrvStartPoint[I].Z));
      WriteLn(f,FloatToStr(g_arrvControlPoint1[I].X) + ' ' + FloatToStr(g_arrvControlPoint1[I].Y) + ' ' + FloatToStr(g_arrvControlPoint1[I].Z));
      WriteLn(f,FloatToStr(g_arrvControlPoint2[I].X) + ' ' + FloatToStr(g_arrvControlPoint2[I].Y) + ' ' + FloatToStr(g_arrvControlPoint2[I].Z));
      WriteLn(f,FloatToStr(g_arrvEndPoint[I].X) + ' ' + FloatToStr(g_arrvEndPoint[I].Y) + ' ' + FloatToStr(g_arrvEndPoint[I].Z));
    end;

    CloseFile(f);

  end;
end;

{------------------------------------------------------------------------}
{  Open Control point file(*.txt) and load                               }
{------------------------------------------------------------------------}
procedure TForm1.OpenControlPointFile1Click(Sender: TObject);
var x,y,z : GLfloat;
    f : TextFile;
    I : integer;
    arrvStartPoint,arrvControlPoint1,arrvControlPoint2,arrvEndPoint : array of TCoord;
begin
  if OpenDialog1.Execute then
  begin

    //save our current control points to temp vars incase we need to roll back 
    setLength(arrvStartPoint,high(g_arrvStartPoint)+1);
    setLength(arrvControlPoint1,high(g_arrvControlPoint1)+1);
    setLength(arrvControlPoint2,high(g_arrvControlPoint2)+1);
    setLength(arrvEndPoint,high(g_arrvEndPoint)+1);

    for I := 0 to high(g_arrvStartPoint) do
    begin
       arrvStartPoint[i] := g_arrvStartPoint[i];
       arrvControlPoint1[i] := g_arrvControlPoint1[i];
       arrvControlPoint2[i] := g_arrvControlPoint2[i];
       arrvEndPoint[i] := g_arrvEndPoint[i];
    end;

    //reset the control point arrays
    setLength(g_arrvStartPoint,0);
    setLength(g_arrvControlPoint1,0);
    setLength(g_arrvControlPoint2,0);
    setLength(g_arrvEndPoint,0);
    try
      try
        //load the control point file
        AssignFile(f,OpenDialog1.FileName);
        Reset(f);

        while not eof(f) do
        begin

          setLength(g_arrvStartPoint,high(g_arrvStartPoint)+2);
          setLength(g_arrvControlPoint1,high(g_arrvControlPoint1)+2);
          setLength(g_arrvControlPoint2,high(g_arrvControlPoint2)+2);
          setLength(g_arrvEndPoint,high(g_arrvEndPoint)+2);

          I := high(g_arrvStartPoint);

          Readln(f,x,y,z);
          g_arrvStartPoint[I].X := x;
          g_arrvStartPoint[I].Y := y;
          g_arrvStartPoint[I].Z := z;

          Readln(f,x,y,z);
          g_arrvControlPoint1[I].X := x;
          g_arrvControlPoint1[I].Y := y;
          g_arrvControlPoint1[I].Z := z;

          Readln(f,x,y,z);
          g_arrvControlPoint2[I].X := x;
          g_arrvControlPoint2[I].Y := y;
          g_arrvControlPoint2[I].Z := z;

          Readln(f,x,y,z);
          g_arrvEndPoint[I].X := x;
          g_arrvEndPoint[I].Y := y;
          g_arrvEndPoint[I].Z := z;
        end;
      except
        //if the control point file is malformed alert the user
        MessageDlg('This file is not a invalid control point file.',mtError,[mbOK],0);

        //rollback

        setLength(g_arrvStartPoint,high(arrvStartPoint)+1);
        setLength(g_arrvControlPoint1,high(arrvControlPoint1)+1);
        setLength(g_arrvControlPoint2,high(arrvControlPoint2)+1);
        setLength(g_arrvEndPoint,high(arrvEndPoint)+1);

        for I := 0 to high(arrvStartPoint) do
        begin
          g_arrvStartPoint[i] := arrvStartPoint[i];
          g_arrvControlPoint1[i] := arrvControlPoint1[i];
          g_arrvControlPoint2[i] := arrvControlPoint2[i];
          g_arrvEndPoint[i] := arrvEndPoint[i];
        end;

      end;
    finally
      //make sure the file gets closed
      CloseFile(f);
    end;

    g_arrIndex := 0;

    UpdateTextValues();

  end;
end;

{------------------------------------------------------------------------}
{  Set Temp value for validation                                         }
{------------------------------------------------------------------------}
procedure TForm1.SetTempValue(txtBox : TEdit);
begin
  g_tempVar := StrToFloat(txtBox.text);
end;

{------------------------------------------------------------------------}
{  Validate textBox value and rollback if neccecary                      }
{------------------------------------------------------------------------}
procedure TForm1.SetCoordValue(txtBox : TEdit);
var tempVar : glFloat;
begin
  try
    tempVar := StrToFloat(txtBox.Text);
  except
    txtBox.Text := FloatToStr(g_tempVar);
  end;
  UpdatePointValues();
end;

{------------------------------------------------------------------------}
{  TextBox event Handlers                                                }
{------------------------------------------------------------------------}
procedure TForm1.txtPoint1XEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint1XExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint1YEnter(Sender: TObject);
begin
   SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint1YExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint1ZEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint1ZExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2XEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2XExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2YEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2YExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2ZEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint2ZExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3XEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3XExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3YEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3YExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3ZEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint3ZExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4XEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4XExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4YEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4YExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4ZEnter(Sender: TObject);
begin
  SetTempValue(TEdit(Sender));
end;

procedure TForm1.txtPoint4ZExit(Sender: TObject);
begin
  SetCoordValue(TEdit(Sender));
end;


{------------------------------------------------------------------------}
{  Re-initialise Point Arrays and TextBoxes (New Curve)                  }
{------------------------------------------------------------------------}
procedure TForm1.New1Click(Sender: TObject);
begin
  g_arrIndex := 0;

  setLength(g_arrvStartPoint,g_arrIndex+1);
  setLength(g_arrvControlPoint1,g_arrIndex+1);
  setLength(g_arrvControlPoint2,g_arrIndex+1);
  setLength(g_arrvEndPoint,g_arrIndex+1);

  g_arrvStartPoint[g_arrIndex].x := -1.0; g_arrvStartPoint[g_arrIndex].y := 1.0; g_arrvStartPoint[g_arrIndex].z := 0.0;    // This is the starting point of the curve
  g_arrvControlPoint1[g_arrIndex].x := -0.5;  g_arrvControlPoint1[g_arrIndex].y := 1.0;  g_arrvControlPoint1[g_arrIndex].z := 0.0;				// This is the first control point of the curve
  g_arrvControlPoint2[g_arrIndex].x := 0.5;  g_arrvControlPoint2[g_arrIndex].y := 1.0;  g_arrvControlPoint2[g_arrIndex].z := 0.0;				// This is the second control point of the curve
  g_arrvEndPoint[g_arrIndex].x := 1.0;  g_arrvEndPoint[g_arrIndex].y := 1.0;  g_arrvEndPoint[g_arrIndex].z := 0.0;				// This is the end point of the curve

  UpdateTextValues();

end;

procedure TForm1.About1Click(Sender: TObject);
begin
   Form2.Show;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -