📄 unit1.pas
字号:
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 + -