ub1.pas

很经典的算法

  b  := 200.0;          // radius
  NB1 := updown2.position;       // polygone is closed
  IF NB1 < 2 then exit;
  anglepoly := 2*pi / NB1;       // angle increment
  a1 := pi / 2;                  // starting angle
  For i := 0 to NB1-1 do
  begin
    AA[i].x := cx + round(b*cos(a1));
    AA[i].y := cy - round(b*sin(a1)); // y inversed
    a1 := a1+anglepoly;
  end;
  AA[NB1] := AA[0];    // close polygon
end;

procedure Tform1.Sinusoide;  // aligned points and sine curve
var
  i : integer;
  a0, a, b : integer;
  r : integer;
begin
  NB1 := Updown2.position;
  a := (Image1.width - 24) div NB1;
  a0 := cx - a*(NB1 div 2);
  b := Image1.height*3 div 8;
  for i := 0 to NB1 do
  begin
    AA[i].x := a0+a*i;
    r := i mod 4;
    case r of
    0 : AA[i].y := cy;
    1 : AA[i].y := cy-b;
    2 : AA[i].y := cy;
    3 : AA[i].y := cy+b;
    end;
  end;
  IF nb1 mod 2 = 1 then nb1 := nb1 - 1;  // even nunber of points
end;

procedure Tform1.Dessin;   // draws Bezier curve and points
var
  i : integer;
  {-----}
  procedure unecroix(ax, ay : integer; acolor : tcolor);
  begin
    with image1.canvas do
    begin
      pen.color := acolor;
      moveto(ax-1, ay); lineto (ax+2, ay);
      moveto(ax, ay-1); lineto(ax, ay+2);
    end;
  end;
  {-----}
begin
  with image1.canvas do
  begin
    pen.color := cllime;
    if drawing and ((figure = 1) OR (Checkbox1.checked = false)) then
    begin
      case startp mod 3 of
      0 : begin
            if startp < NB2 then
            begin
              moveto(BB[startp].x, BB[startp].y);
              lineto(BB[startp+1].x, BB[startp+1].y);
            end;
            if startp > 0 then
            begin
              moveto(BB[startp-1].x, BB[startp-1].y);
              lineto(BB[startp].x, BB[startp].y);
            end;
          end;
      1 : begin
            moveto(BB[startp-1].x, BB[startp-1].y);
            lineto(BB[startp].x, BB[startp].y);
          end;
      2 : begin
            moveto(BB[startp].x, BB[startp].y);
            lineto(BB[startp+1].x, BB[startp+1].y);
          end;
      end; // case
    end;
    // courbe de B閦ier
    pen.color := clblack;
    Windows.polybezier(image1.canvas.handle, BB, NB2+1);
    // points
    If checkbox2.Checked then
    begin
      For i := 0 to NB2 do
      begin
        case i mod 3 of
        0 : begin
             pen.color := clblack;
             ellipse(BB[i].x-2, BB[i].y-2, BB[i].x+2, BB[i].y+2);
            end;
        1 : unecroix(BB[i].x, BB[i].y, clblue);
        2 : unecroix(BB[i].x, BB[i].y, clred);
        end;
      end;
    end
    else pixels[0,0] := pixels[0,0];
    { force paintbox to repaint because an API function using the canvas
      handle of a timage component doesn't do that }
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : integer;
  a, ro, rox, roy : single;
  colox, coloy : integer;

begin
  // colour drawing
  IF speedbutton1.down then
  begin
    with image1.canvas do
    begin
      IF Button = MbRight then Panelcolo.color := pixels[x, y]
      else
      begin
        brush.color := Panelcolo.color;
        // symmetrical processing
        IF checkbox3.checked then
        begin
          IF figure = 0 then
          begin
            rox := x-cx;
            roy := y-cy;
            ro := sqrt(sqr(rox) + sqr(roy));
            a := arctangente(x-cx, y-cy);
            for i := 0 to Nb1 do
            begin
              colox := Cx + round(ro*cos(a));
              coloy := Cy - round(ro*sin(a));
              if Nb1 mod 2 = 0 then
              begin
                if i mod 2 = 0 then floodfill(colox, coloy, clblack, fsBorder);
              end
              else floodfill(colox, coloy, clblack, fsBorder);
              a := a + anglepoly;
            end;
          end
          else
          begin
            floodfill(x, y, clblack, fsBorder);
            floodfill(cx*2-x, y, clblack, fsborder);
          end;
        end
        else  floodfill(x,y, clblack, fsBorder);
        brush.color := clwhite;
      end;
    end;
    exit;
  end;

  For i := 0 to Nb2 do
  begin
    IF (x > BB[i].x-4) AND (x < BB[i].x+4) AND  // clic on a point ?
       (y > BB[i].y-4) AND (y < BB[i].y+4) then
    begin
      startp := i;
      startx := BB[startp].x;
      starty := BB[startp].y;
      startangle := arctangente(startx-cx, starty -cy);
      drawing := true;
      Image1.Canvas.draw(0,0, bmpfond);
      image1.canvas.pen.mode := pmnotxor;
      dessin;    // uses notxor drawing . Polybezier doesn't do that
      break;
    end;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i : integer;
  m : integer;
  rox, roy, ro : single;
  a0, a : single;
begin
  IF NOT drawing then exit;
  dessin;       //  notxor erase
  IF checkbox1.checked then
  begin
    Case figure of
    0: begin
        a0 := arctangente(x-cx, y-cy) - startangle;
        rox := x-cx;
        roy := y-cy;
        ro := sqrt(sqr(rox) + sqr(roy));  // same radius for all points
        m := startp mod 3;    // edge point or conrol point
        For i := 0 to NB2 do
        begin
          if i mod 3 = m  then
          begin
             a := angles[i] + a0 ;  // angle variation
             BB[i].x := Cx + round(ro*cos(a));
             BB[i].y := Cy - round(ro*sin(a));
          end;
        end;
        Case radiogroup1.itemindex of
        1 : if m = 0 then    // link points 0 et 1 ('right' point)
            for i := 0 to NB1 - 1 do BB[i*3+1] := BB[i*3];
        2 : if m = 0 then    // lier points 0 et 2 ('left' point)
            for i := 1 to NB1 do BB[i*3-1] := BB[i*3];
        3 : begin            // link control points
              if m = 1 then for i := 0 to NB1 - 1 do BB[i*3+2] := BB[i*3+1]
              else
              if m = 2 then for i := 0 to NB1 - 1 do BB[i*3+1] := BB[i*3+2];
            end;
        4 : begin   //  opposite control points
              if m = 1 then for i := 0 to NB1 - 1 do
              begin
                BB[i*3+2].x := Cx+Cx - BB[i*3+1].x;
                BB[i*3+2].y := Cy+cy - BB[i*3+1].y;
              end
              else
              if m = 2 then for i := 0 to NB1 - 1 do
              begin
                BB[i*3+1].x := Cx+Cx - BB[i*3+2].x;
                BB[i*3+1].y := Cy+cy - BB[i*3+2].y;
              end;
            end;
        5 : For i := 0 to NB2 do  // rotation
            begin
              if i mod 3 <> m  then
              begin
                a := angles[i] + a0 ;
                rox := BB[i].x - cx;
                roy := BB[i].y - cy;
                ro := sqrt(sqr(rox) + sqr(roy));
                BB[i].x := Cx + round(ro*cos(a));
                BB[i].y := Cy - round(ro*sin(a));
              end;
             end;
        end; // case  radiogroup1
       end;
    1: begin
        BB[startp].x := x;   // move the point and symmetrical / y axis
        BB[startp].y := y;
        // symmetrical point from vertical axix (cy)
        i := nb2 - startp;
        if startp = i then BB[i].x := cx else BB[i].x := cx*2-x;
        BB[i].y := y;
       end;
    end; //  case
  end   // if checkbox
  else
  begin   // no symmetry
    BB[startp].x := x;
    BB[startp].y := y;
  end;
  dessin;   // notxor
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin
  IF not drawing then exit;
  image1.canvas.pen.mode := pmcopy;
  drawing := false;
  affichage(false);
  IF figure = 0 then
  begin      // update angles
    For i := 0 to Nb2 do Angles[i] := arctangente(BB[i].x-cx, BB[i].y-cy);
    {
    // display angles and radius for information purpose
    With image1.canvas do
    begin
      textout(8,0,'Total number of points = '+inttostr(NB1+1));
      For i := 0 to 2 do
      begin
        a := (angles[i] - infoang[i])* 180 / pi ; // delta angle in degrees
        while a < 0   do  a := a + 360;           // range 0..360
        while a >= 360 do  a := a - 360;
        rox := BB[i].x-cx;
        roy := BB[i].y-cy;
        ro := sqrt(sqr(rox) + sqr(roy));  // rayon
        Case i of
        0 : s := 'Courbe';
        1 : s := 'Bz n