unit1.pas

delphi原码贝塞尔曲线.rar

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  { TCtrlPoint }
  TCtrlPoint = class
  private
    FX: Integer;
    FY: Integer;
    FxDir: Integer;
    FyDir: Integer;
  public
    property X: Integer read FX write FX;
    property Y: Integer read FY write FY;
    property xDir: Integer read FxDir write FxDir; // default 2;
    property yDir: Integer read FyDir write FyDir; // default 2;
    constructor Create(X, Y: Integer);
    procedure MoveX;
    procedure MoveY;
  end;

  TPoints = Array[0..3] of TPoint;

  { TBezier }
  TBezier = class
  private
    FPoints1, FPoints2: TPoints;
    FCtrlPoints: Array[0..3] of TCtrlPoint;
    FColor: Integer;
  public
    constructor Create(AColor: Integer);
    destructor Destroy; override;
    procedure Move;
    procedure SetPoints;
    procedure NewPos;
    procedure Draw(APoints1, APoints2: Array of TPoint);
    property Color: Integer read FColor write FColor;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FIsContinue: Boolean;
    FIsPause: Boolean;
    FLineCount: Integer;
    FBizer1, FBizer2: TBezier;
  public
    { Public declarations }
    procedure InitBizer(AColor: Integer);
    procedure WMSysKeyDown(var Msg: TMessage); message WM_SYSKEYDOWN;
  end;

var
  Form1: TForm1;
  ThreadID: DWORD;

implementation

{$R *.DFM}

{ TBezier }

constructor TBezier.Create(AColor: Integer);
var
  x1, y1, x2, y2, x3, y3, x4, y4: Integer;
begin
  FColor := AColor;
  x1 := Random(800);
  y1 := Random(600);
  x2 := Random(800);
  y2 := Random(600);
  x3 := Random(800);
  y3 := Random(600);
  x4 := Random(800);
  y4 := Random(600);
  
  FCtrlPoints[0] := TCtrlPoint.Create(x1, y1);
  FCtrlPoints[1] := TCtrlPoint.Create(x2, y2);
  FCtrlPoints[2] := TCtrlPoint.Create(x3, y3);
  FCtrlPoints[3] := TCtrlPoint.Create(x4, y4);

  FPoints1[1].x := FCtrlPoints[0].X;
  FPoints1[1].y := FCtrlPoints[0].Y;
  FPoints1[2].x := FCtrlPoints[1].X;
  FPoints1[2].y := FCtrlPoints[1].Y;

  FPoints2[1].x := FCtrlPoints[2].X;
  FPoints2[1].y := FCtrlPoints[2].Y;
  FPoints2[2].x := FCtrlPoints[3].X;
  FPoints2[2].y := FCtrlPoints[3].Y;
end;

destructor TBezier.Destroy;
var
  I: Integer;
begin
  for I := 0 to 3 do
    FCtrlPoints[I].Free;
end;

procedure TBezier.Draw(APoints1, APoints2: Array of TPoint);
begin
  with Form1.Canvas do
  begin
    Pen.Width := 1;
    Pen.Color := FColor;

    PolyBezier(APoints1);
    PolyBezier(APoints2);
  end;
end;

procedure TBezier.Move;
begin
  NewPos;
  SetPoints;
  Draw(FPoints1, FPoints2);
  Sleep(3);
end;

procedure TBezier.NewPos;
begin
  { New position }
  FCtrlPoints[0].MoveX;
  FCtrlPoints[0].MoveY;
  FCtrlPoints[1].MoveX;
  FCtrlPoints[1].MoveY;
  FCtrlPoints[2].MoveX;
  FCtrlPoints[2].MoveY;
  FCtrlPoints[3].MoveX;
  FCtrlPoints[3].MoveY;
end;

procedure TBezier.SetPoints;
var
  xShare1, xShare2, yShare1, yShare2: Integer;
begin
  xShare1 := (FCtrlPoints[0].x + FCtrlPoints[2].x) div 2;
  yShare1 := (FCtrlPoints[0].y + FCtrlPoints[2].y) div 2;
  yShare2 := (FCtrlPoints[1].y + FCtrlPoints[3].y) div 2;
  xShare2 := (FCtrlPoints[1].x + FCtrlPoints[3].x) div 2;

  FPoints1[0].x := xShare1;
  FPoints1[0].y := yShare1;
  FPoints1[3].x := xShare2;
  FPoints1[3].y := yShare2;

  FPoints2[0].x := xShare1;
  FPoints2[0].y := yShare1;
  FPoints2[3].x := xShare2;
  FPoints2[3].y := yShare2;

  FPoints1[1].x := FCtrlPoints[0].X;
  FPoints1[1].y := FCtrlPoints[0].Y;
  FPoints1[2].x := FCtrlPoints[1].X;
  FPoints1[2].y := FCtrlPoints[1].Y;

  FPoints2[1].x := FCtrlPoints[2].X;
  FPoints2[1].y := FCtrlPoints[2].Y;
  FPoints2[2].x := FCtrlPoints[3].X;
  FPoints2[2].y := FCtrlPoints[3].Y;
end;

{ TCtrlPoint }

constructor TCtrlPoint.Create(X, Y: Integer);
begin
  FX := X;
  FY := Y;
  FxDir := Random(10);
  FyDir := Random(10);
  if Random(2) = 1 then
    FxDir := -FxDir;
  if Random(3) = 1 then
    FyDir := -FyDir;
end;

procedure TCtrlPoint.MoveX;
begin
  FX := FX + xDir;
  if (FX + xDir < 0) or (FX + xDir > 800) then
    xDir := -xDir;
end;

procedure TCtrlPoint.MoveY;
begin
  FY := FY + yDir;
  if (FY + yDir < 0) or (FY + yDir > 600) then
    yDir := -yDir;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ABizer1, ABizer2: TBezier;
  I, J: Integer;
begin
  ABizer1 := TBezier.Create(clYellow);
  ABizer2 := TBezier.Create(clBtnFace);

  { 让 ABizer2 和 ABizer1 有相同的行为, 只是时间上的差异 }
  for I := 0 to 3 do
  begin
    ABizer2.FCtrlPoints[I].X := ABizer1.FCtrlPoints[I].X;
    ABizer2.FCtrlPoints[I].Y := ABizer1.FCtrlPoints[I].Y;
    ABizer2.FCtrlPoints[I].xDir := ABizer1.FCtrlPoints[I].xDir;
    ABizer2.FCtrlPoints[I].yDir := ABizer1.FCtrlPoints[I].yDir;
  end;
  J := 0;
  for I := 0 to 1000 do
  begin
    ABizer1.Move;
    Sleep(3);
    if J < 50 then
      Inc(J)
    else
      ABizer2.Move;
  end;
  ABizer1.Free;
  ABizer2.Free;
  FIsContinue := False;
end;

function BezierLines(P: Pointer): LongInt; stdcall;
var
  nLine, J: Integer;
begin
  nLine := 0; J := 0;
  with Form1 do
  begin
    InitBizer(clBlue);
    while FIsContinue do
    begin
      if FIsPause then
        Sleep(100)
      else begin
        Inc(J);
        if (J > 500) then begin InitBizer(Random($ffffff)); J := 0; end;
        FBizer1.Move;
        Sleep(3);
        if nLine < FLineCount then begin Inc(nLine); Continue; end
        else FBizer2.Move;
      end;
    end;
  end;
  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FIsContinue := True;
  FIsPause := False;
  FLineCount := 25;
  InitBizer(clBlue);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  FBizer1.Free;
  FBizer2.Free;
  FIsContinue := False;
end;

procedure TForm1.InitBizer(AColor: Integer);
var
  I: Integer;
begin
  if Assigned(FBizer1) then
  begin
    FBizer1.Color := AColor;
    Exit;
  end;

  FBizer1 := TBezier.Create(AColor);
  FBizer2 := TBezier.Create(clBlack);

  { 让 FBizer2 和 FBizer1 有相同的行为, 只是时间上的差异 }
  for I := 0 to 3 do
  begin
    FBizer2.FCtrlPoints[I].X := FBizer1.FCtrlPoints[I].X;
    FBizer2.FCtrlPoints[I].Y := FBizer1.FCtrlPoints[I].Y;
    FBizer2.FCtrlPoints[I].xDir := FBizer1.FCtrlPoints[I].xDir;
    FBizer2.FCtrlPoints[I].yDir := FBizer1.FCtrlPoints[I].yDir;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button1.Visible := False;
  Button2.Visible := False;
  BorderStyle := bsNone;
  Color := clBlack;
  Width := 800;
  Height := 600;
  Left := 0;
  Top := 0;

  CreateThread(nil, 0, @BezierLines, nil, 0, ThreadID);
end;

procedure TForm1.WMSysKeyDown(var Msg: TMessage);
begin
  Msg.Result := 0;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  str: String;
begin
  FIsPause := True;
  if ssShift in Shift then
  begin
    str := InputBox('Password:', 'Input password: ', '');
    if (str = 'ns') then
    begin
      FIsContinue := False;
      Form1.Close;
    end;
//    else
//      FLineCount := StrToInt(str);
  end;
  FIsPause := False;
end;

end.