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

📄 unit1.pas

📁 code for d bezier curve
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  UpdatePointValues();
end;

{------------------------------------------------------------------------}
{  Event Handlers for UpDowns                                            }
{------------------------------------------------------------------------}

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin

   DoUpDown(txtPoint1X,Button);

end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint1Y,Button);

end;

procedure TForm1.UpDown3Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint1Z,Button);

end;

procedure TForm1.UpDown4Click(Sender: TObject; Button: TUDBtnType);
begin
  DoUpDown(txtPoint2X,Button);

end;

procedure TForm1.UpDown5Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint2Y,Button);

end;

procedure TForm1.UpDown6Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint2Z,Button);

end;

procedure TForm1.UpDown7Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint3X,Button);

end;

procedure TForm1.UpDown8Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint3Y,Button);

end;

procedure TForm1.UpDown9Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint3Z,Button);

end;

procedure TForm1.UpDown10Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint4X,Button);

end;

procedure TForm1.UpDown11Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint3Y,Button);

end;

procedure TForm1.UpDown12Click(Sender: TObject; Button: TUDBtnType);
begin

  DoUpDown(txtPoint4Z,Button);

end;

{------------------------------------------------------------------------}
{  Goto or create next Bezier curve                                      }
{------------------------------------------------------------------------}

procedure TForm1.Button3Click(Sender: TObject);
begin

  g_arrIndex := g_arrIndex + 1;

  if g_arrIndex > high(g_arrvStartPoint) then // set size of temp point arrays
  begin

    if MessageDlg('You are about to add a new curve, Is this correct?',mtConfirmation,[mbOK ,mbCancel],0) = mrOk then
    begin
      SetArrayLength;

      //set the start point to the end of the last curve
      g_arrvStartPoint[g_arrIndex] := g_arrvEndPoint[g_arrIndex-1];

      //set the control points to the last used
      g_arrvControlPoint1[g_arrIndex].X := g_arrvStartPoint[g_arrIndex].X+2;
      g_arrvControlPoint1[g_arrIndex].Y := g_arrvStartPoint[g_arrIndex].Y;
      g_arrvControlPoint1[g_arrIndex].Z := g_arrvStartPoint[g_arrIndex].Z;

      g_arrvControlPoint2[g_arrIndex] := g_arrvControlPoint2[g_arrIndex-1];

      //set the end point to any point.
      g_arrvEndPoint[g_arrIndex].x := g_arrvStartPoint[g_arrIndex].X+2;
      g_arrvEndPoint[g_arrIndex].y := g_arrvStartPoint[g_arrIndex].Y;
      g_arrvEndPoint[g_arrIndex].z := g_arrvStartPoint[g_arrIndex].Z;
      // This is the end point of the curve
    end
    else
    begin
      g_arrIndex := 0;
    end;
  end;

  UpdateTextValues;

end;

{------------------------------------------------------------------------}
{  Increment Control point array sizes                                   }
{------------------------------------------------------------------------}
procedure TForm1.SetArrayLength();
begin
  setLength(g_arrvStartPoint,g_arrIndex+1);
  setLength(g_arrvControlPoint1,g_arrIndex+1);
  setLength(g_arrvControlPoint2,g_arrIndex+1);
  setLength(g_arrvEndPoint,g_arrIndex+1);
  
end;

{------------------------------------------------------------------------}
{  Update the text values from  the control point arrays                 }
{------------------------------------------------------------------------}
procedure TForm1.UpdateTextValues();
begin
 txtPoint1X.Text := FloatToStr(g_arrvStartPoint[g_arrIndex].X);
 txtPoint1Y.Text := FloatToStr(g_arrvStartPoint[g_arrIndex].Y);
 txtPoint1Z.Text := FloatToStr(g_arrvStartPoint[g_arrIndex].Z);

 txtPoint2X.Text := FloatToStr(g_arrvControlPoint1[g_arrIndex].X);
 txtPoint2Y.Text := FloatToStr(g_arrvControlPoint1[g_arrIndex].Y);
 txtPoint2Z.Text := FloatToStr(g_arrvControlPoint1[g_arrIndex].Z);

 txtPoint3X.Text := FloatToStr(g_arrvControlPoint2[g_arrIndex].X);
 txtPoint3Y.Text := FloatToStr(g_arrvControlPoint2[g_arrIndex].Y);
 txtPoint3Z.Text := FloatToStr(g_arrvControlPoint2[g_arrIndex].Z);

 txtPoint4X.Text := FloatToStr(g_arrvEndPoint[g_arrIndex].X);
 txtPoint4Y.Text := FloatToStr(g_arrvEndPoint[g_arrIndex].Y);
 txtPoint4Z.Text := FloatToStr(g_arrvEndPoint[g_arrIndex].Z);
end;


{------------------------------------------------------------------------}
{  Update the control point array values from  the text boxes            }
{------------------------------------------------------------------------}
procedure TForm1.UpdatePointValues();
begin
 g_arrvStartPoint[g_arrIndex].X := StrToFloat(txtPoint1X.Text);
 g_arrvStartPoint[g_arrIndex].Y := StrToFloat(txtPoint1Y.Text);
 g_arrvStartPoint[g_arrIndex].Z := StrToFloat(txtPoint1Z.Text);

 g_arrvControlPoint1[g_arrIndex].X := StrToFloat(txtPoint2X.Text);
 g_arrvControlPoint1[g_arrIndex].Y := StrToFloat(txtPoint2Y.Text);
 g_arrvControlPoint1[g_arrIndex].Z := StrToFloat(txtPoint2Z.Text);

 g_arrvControlPoint2[g_arrIndex].X := StrToFloat(txtPoint3X.Text);
 g_arrvControlPoint2[g_arrIndex].Y := StrToFloat(txtPoint3Y.Text);
 g_arrvControlPoint2[g_arrIndex].Z := StrToFloat(txtPoint3Z.Text);

 g_arrvEndPoint[g_arrIndex].X := StrToFloat(txtPoint4X.Text);
 g_arrvEndPoint[g_arrIndex].Y := StrToFloat(txtPoint4Y.Text);
 g_arrvEndPoint[g_arrIndex].Z := StrToFloat(txtPoint4Z.Text);
end;

{------------------------------------------------------------------------}
{  Highlight Control point 2                                             }
{------------------------------------------------------------------------}
procedure TForm1.GroupBox4Click(Sender: TObject);
begin
  g_ControlPoint1Color := 1.0;
  g_ControlPoint2Color := 0.0;
end;


{------------------------------------------------------------------------}
{  Highlight Control point 3                                             }
{------------------------------------------------------------------------}
procedure TForm1.GroupBox3Click(Sender: TObject);
begin
  g_ControlPoint1Color := 0.0;
  g_ControlPoint2Color := 1.0;
end;

{------------------------------------------------------------------------}
{  Move to the previous curve                                            }
{------------------------------------------------------------------------}
procedure TForm1.Button4Click(Sender: TObject);
begin
  if g_arrIndex > 0 then
  begin
    g_arrIndex := g_arrIndex - 1;
    UpdateTextValues;
  end
  else
  begin
    g_arrIndex := high(g_arrvStartPoint);
    UpdateTextValues;
  end;
end;


{------------------------------------------------------------------------}
{  Show/Hide start position                                              }
{------------------------------------------------------------------------}
procedure TForm1.ShowStart1Click(Sender: TObject);
begin
  ShowStart1.Checked := not ShowStart1.Checked
end;

{------------------------------------------------------------------------}
{  Enable/Disable the scene rotation                                     }
{------------------------------------------------------------------------}
procedure TForm1.Rotate1Click(Sender: TObject);
begin
  Rotate1.Checked := not Rotate1.Checked;
  chkRotate.Checked := Rotate1.Checked;
end;

{------------------------------------------------------------------------}
{  Show/Hide all curves                                                  }
{------------------------------------------------------------------------}
procedure TForm1.ShowAllCurves1Click(Sender: TObject);
begin
  ShowAllCurves1.Checked := not ShowAllCurves1.Checked;
  chkAllBeziers.Checked := ShowAllCurves1.Checked;
end;

{------------------------------------------------------------------------}
{  Save Array of Coords to file(*.pas)                                   }
{------------------------------------------------------------------------}
procedure TForm1.Save1Click(Sender: TObject);
var I : integer;
    t : GLfloat;
    vPoint : TCoord;
    f : TextFile;
begin

  SaveDialog1.Filter := 'Points Array File|*.PAS';
  if SaveDialog1.Execute then
  begin

    AssignFile(f,SaveDialog1.FileName);

    Rewrite(f);

    WriteLn(f,'unit Unit2;');
    WriteLn(f,'interface');

    WriteLn(f,'uses OpenGL;');

    WriteLn(f,'type');
    WriteLn(f,'TCoord = Record');
    WriteLn(f,'  X, Y, Z : glFLoat;');;
    WriteLn(f,'end;');
    WriteLn(f,'var');
    WriteLn(f,' vCurves : array of TCoord;');

    WriteLn(f,'implementation');

    WriteLn(f,'procedure addPoint(X,Y,Z : GLfloat);');
    WriteLn(f,'begin');
    WriteLn(f,'  setLength(vCurves,high(vCurves)+1);');
    WriteLn(f,'  vCurves[high(vCurves)].X := X;');
    WriteLn(f,'  vCurves[high(vCurves)].Y := Y;');
    WriteLn(f,'  vCurves[high(vCurves)].Z := Z;');
    WriteLn(f,'end;');

    WriteLn(f,'procedure initCurve();');
    WriteLn(f,'begin');

    for I := 0 to high(g_arrvStartPoint) do
    begin
      t := 0;
      while t <= (1 + (1.0 / MAX_STEPS)) do
      begin
        vPoint := PointOnCurve(g_arrvStartPoint[I], g_arrvControlPoint1[I], g_arrvControlPoint2[I], g_arrvEndPoint[I], t);
        WriteLn(f,' addPoint(' + FloatToStr(vPoint.X) + ',' + FloatToStr(vPoint.Y) + ',' + FloatToStr(vPoint.Z) + ');');
        t := t + 1.0 / MAX_STEPS;
      end;
    end;

    WriteLn(f,'end;');
    WriteLn(f,'end.');

    CloseFile(f);
  end;

end;

{------------------------------------------------------------------------}
{  Set Y rotation when mouseclick occurs on panel                        }
{------------------------------------------------------------------------}
procedure TForm1.Timer1Timer(Sender: TObject);
var mpos : TPoint;
begin
  GetCursorPos(mpos);
  if mpos.X > Panel1.Width div 2 then
  begin
    rotateY := rotateY + mpos.X/1000;
  end
  else
  begin
   rotateY := rotateY - (mpos.X+1000)/1000;
  end;
end;

{------------------------------------------------------------------------}
{  Enable Y rotation                                                     }
{------------------------------------------------------------------------}
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Timer1.Enabled := true;
end;

{------------------------------------------------------------------------}
{  Disable Y rotation                                                    }
{------------------------------------------------------------------------}
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Timer1.Enabled := false;
end;

⌨️ 快捷键说明

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