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

📄 unit1.pas

📁 Delphi写的BEZIER曲线,希望大家能喜欢
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls,Unit2, Buttons,MMSystem;

type
  TAReal = array of Double;
  TApoint = array of Tpoint;
  TForm1 = class(TForm)
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    Edit2: TEdit;
    Edit3: TEdit;
    SpeedButton3: TSpeedButton;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);

  private

  public

  end;

var
  Form1: TForm1;
  No,BNo,Drag,Selected,Xnow,Ynow,Count,control:Longint;
  TD,TL:integer;
  PointList,BPointList:TAPoint;
  TJD:Double;
  PPointList:TAReal;
implementation

{$R *.dfm}

var
TimerID:integer;
RanList:array of integer;


procedure IfSelected;
var T:integer;
begin
  Selected:=-1;
  for T:=0 to No-1 do
  begin
    if (Xnow<PointList[T].X+5) and (Xnow>PointList[T].X-5) and (Ynow<PointList[T].Y+5) and (Ynow>PointList[T].Y-5) then Selected:=T;
  end;
end;

procedure BezierDG(PPPointList:TAReal);
var TPointList:TAReal;DX,DY:Double;T:integer;
begin
  If count=1 then
  begin
    BNo:=BNo+1;
    SetLength(BPointList,BNo);
    DX:=PPPointList[2]-PPPointList[0];
    DY:=PPPointList[3]-PPPointList[1];
    SetLength(TPointList,2);
    TPointList[0]:=DX*TJD+PPPointList[0];
    TPointList[1]:=DY*TJD+PPPointList[1];
    BPointList[BNo-1]:=Point(Round(TPointList[0]),Round(TPointList[1]));
  end else
  begin
    For T:=0 to count-1 do
    begin
      DX:=PPPointList[T*2+2]-PPPointList[T*2];
      DY:=PPPointList[T*2+3]-PPPointList[T*2+1];
      SetLength(TPointList,(T+1)*2);
      TPointList[T*2]:=PPPointList[T*2]+DX*TJD;
      TPointList[T*2+1]:=PPPointList[T*2+1]+DY*TJD;
    end;
    count:=count-1;
    BezierDG(TPointList);
  end;
end;


procedure BezierA;
var T:integer;
begin
  BNo:=1;
  SetLength(BPointList,1);
  SetLength(PPointList,No*2);
  For T:=0 to No-1 do
  begin
    PPointList[T*2]:=PointList[T].X;
    PPointList[T*2+1]:=PointList[T].Y;
  end;
  BPointList[0]:=Point(PointList[0].X,PointList[0].Y);
  TJD:=Form1.TrackBar1.Position/1000;
  while TJD<1 do
  begin
    Count:=No-1;
    BezierDG(PPointList);
    TJD:=TJD+Form1.TrackBar1.Position/1000;
  end;
  BNo:=BNo+1;
  SetLength(BPointList,BNo);
  BPointList[BNo-1]:=Point(PointList[No-1].X,PointList[No-1].Y);
  If Form1.RadioGroup1.ItemIndex=0 then Form1.Canvas.Pen.Color:=clYellow else Form1.Canvas.Pen.Color:=clBlue;
  For T:=0 to BNo-2 do
  begin
    Form1.Canvas.MoveTo(BPointList[T].X,BPointList[T].Y);
    Form1.Canvas.LineTo(BPointList[T+1].X,BPointList[T+1].Y);
  end;
end;

function JC(X:integer):integer;
var T:integer;
begin
  IF X=0 then T:=1 else T:=X;X:=X-1;
  while X>=1 do
  begin
    T:=T*X;
    X:=X-1;
  end;
  JC:=T;
end;

function CF(X:Real;Y:integer):Real;
var T:integer;TT:Double;
begin
  TT:=X;
  For T:=2 to Y do TT:=TT*X;
  CF:=TT;
  If (Y=0) then CF:=1;
end;

procedure BezierB;
var T:longint;TX,TY:EXtended;
begin
  BNo:=1;
  SetLength(BPointList,BNo);
  BPointList[0]:=Point(PointList[0].X,PointList[0].Y);
  TJD:=Form1.TrackBar1.Position/1000;
  while TJD<1 do
  begin
    TX:=0;TY:=0;
    For T:=0 to No-1 do
    begin
      TX:=TX+PointList[T].X*(JC(No-1)*CF(TJD,T)*CF(1-TJD,No-1-T)/(JC(T)*JC(No-1-T)));
      TY:=TY+PointList[T].Y*(JC(No-1)*CF(TJD,T)*CF(1-TJD,No-1-T)/(JC(T)*JC(No-1-T)));
    end;
    BNo:=BNo+1;
    SetLength(BPointList,BNo);
    BPointList[BNo-1]:=Point(Round(TX),Round(TY));
    TJD:=TJD+Form1.TrackBar1.Position/1000;
  end;
  BNo:=BNo+1;
  SetLength(BPointList,BNo);
  BPointList[BNo-1]:=Point(PointList[No-1].X,PointList[No-1].Y);
  If Form1.RadioGroup1.ItemIndex=0 then Form1.Canvas.Pen.Color:=clYellow else Form1.Canvas.Pen.Color:=clBlue;
  For T:=0 to BNo-2 do
  begin
    Form1.Canvas.MoveTo(BPointList[T].X,BPointList[T].Y);
    Form1.Canvas.LineTo(BPointList[T+1].X,BPointList[T+1].Y);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TD:=1;TL:=1;
  No:=0;
  Drag:=0;
  Selected:=-1;
  SetLength(PointList,0);
end;

procedure TForm1.FormPaint(Sender: TObject);
var T:integer;
begin
  if (No=1) and (speedbutton1.Down=true) then
  begin
    Canvas.Brush.Color:=clred;
    canvas.FillRect(rect(Xnow-2,Ynow-2,Xnow+2,Ynow+2));
    canvas.MoveTo(Xnow,Ynow);
  end;
  if No>1 then
  begin
    for T:=0 to No-1 do
    begin
      if TD=1 then
      begin
        Canvas.Brush.Color:=clred;
        Canvas.FillRect(Rect(PointList[T].X-2,PointList[T].Y-2,PointList[T].X+2,PointList[T].Y+2));
      end;
    end;
    for T:=0 to No-2 do
    begin
      if TL=1 then
      begin
        Canvas.Pen.Color:=clblack;
        Canvas.MoveTo(PointList[T].X,PointList[T].Y);
        Canvas.LineTo(PointList[T+1].X,PointList[T+1].Y);
      end;
    end;
  end;
  If (selected<>-1) and (TD=1) then
  begin
    Canvas.Brush.Color:=clYellow;
    Canvas.FillRect(Rect(PointList[Selected].X-4,PointList[Selected].Y-4,PointList[Selected].X+4,PointList[Selected].Y+4));
  end;
  if No>2 then
  begin
    If RadioGroup1.ItemIndex=1 then BezierA;
    If RadioGroup1.ItemIndex=0 then BezierB;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Xnow:=X;Ynow:=Y;
  edit2.Text:='当前X坐标:  '+inttostr(Xnow);
  edit3.Text:='当前Y坐标:  '+inttostr(Ynow);
  If (Drag=1) and (selected<>-1) then
  begin
    PointList[selected]:=Point(Xnow,Ynow);
    Invalidate;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Xnow:=X;Ynow:=Y;
  Drag:=1;
  If No>0 then IfSelected;
  If Selected<>-1 then Invalidate;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drag:=0;
  If Selected=-1 then
  begin
    No:=No+1;
    SetLength(PointList,No);
    PointList[No-1]:=Point(Xnow,Ynow);
    Invalidate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  setlength(PointList,0);
  No:=0;
  Selected:=-1;
  invalidate;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  showmessage('直接在空白处点击就可以了,已经创建的点可以拖动!两种算法的结果是一样的,所以看起来可能没有变化');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  AboutBox.Visible:=True;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  If SpeedButton1.Down=True then TD:=1 else TD:=0;
  invalidate;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  If SpeedButton2.Down=True then TL:=1 else TL:=0;
  invalidate;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  invalidate;
end;

procedure TimerProc(uTimerID, uMessage: UINT; dwUser, dw1, dw2:
    DWORD); stdcall;
var
T,TX,TY:integer;
begin
  if control=Form1.TrackBar3.Position then
  begin
    Setlength(RanList,No);
    for T:=0 to No-1 do
    begin
      RanList[T]:=Random(360);
    end;
    control:=0;
  end;
  for T:=0 to No-1 do
  begin
    TX:=PointList[T].X+Round(Cos(RanList[T]));
    TY:=PointList[T].Y+Round(Sin(RanList[T]));
    If (TX<3) or (TX>780) then RanList[T]:=180-RanList[T];
    If (TY<3) or (TY>450) then RanList[T]:=-RanList[T];
    PointList[T].X:=PointList[T].X+Round(Cos(RanList[T]));
    PointList[T].Y:=PointList[T].Y+Round(Sin(RanList[T]));
  end;
  control:=control+1;
  Form1.Invalidate;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if speedbutton3.Down=True then
  begin
    Button1.Enabled:=false;
    Button4.Enabled:=False;
    SpeedButton2.Down:=False;TL:=0;
    control:=trackbar3.Position;
    TimerID := timeSetEvent(TrackBar2.Position,1000, @TimerProc, 0, TIME_PERIODIC);
  end;
  if speedbutton3.Down=False then
  begin
    timeKillEvent(TimerID);
    Button1.Enabled:=True;
    Button4.Enabled:=True;
  end;
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
  timeKillEvent(TimerID);
  TimerID := timeSetEvent(TrackBar2.Position,1000, @TimerProc, 0, TIME_PERIODIC);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
  control:=TrackBar3.Position-1;
end;

initialization
  Randomize;

end.

⌨️ 快捷键说明

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