unit1.pas

本程序是图形的设计

            edit1.Text:='';
            edit1.SetFocus;
          end
         else
          if label1.Caption='请输入第二点的横坐标：' then
          begin
            label1.Caption:='请输入第二点的纵坐标：';
            x2:=strtoint(edit1.Text);
            edit1.Text:='';
            edit1.SetFocus;
          end
          else
            if label1.Caption='请输入第二点的纵坐标：' then
            begin
              load_default();
              form2.ToolButton4.Enabled:=true;
              label1.Caption:='请输入命令：';
              y2:=strtoint(edit1.Text);
              edit1.Text:='';
              edit1.SetFocus;
              paint_line(x1,y1,x2,y2,cl);
              linecount:=linecount+1;
              line_save(linecount,x1,y1,x2,y2,cl);
              form2.ToolButton1.Down:=false;
            end
      end;
end;



procedure circlepoint(x,y,xo,yo:integer;color:TColor);
var xi,yi:integer;
begin
    xi:=x+x0+xo;
    yi:=0-(y-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=y+x0+xo;
    yi:=0-(x-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=-y+x0+xo;
    yi:=0-(x-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=-x+x0+xo;
    yi:=0-(y-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=-x+x0+xo;
    yi:=0-(-y-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=-y+x0+xo;
    yi:=0-(-x-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=y+x0+xo;
    yi:=0-(-x-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
    xi:=x+x0+xo;
    yi:=0-(-y-y0+yo);
    form1.Image1.Canvas.Pixels[xi,yi]:=color;
end;

procedure midbresenhamcircle(xo,yo,r:integer;color:Tcolor);
var xt,yt,d:integer;
begin
  xt:=0;yt:=r;d:=1-r;
  while xt<=yt do
  begin
    circlepoint(xt,yt,xo,yo,color);
    if d<0 then d:=d+2*xt+3
    else
      begin
         d:=2*(xt-yt)+5+d;
         yt:=yt-1;
      end;
   xt:=xt+1;
 end;
end;

procedure midbresenhamellipse(xo,yo,a,b:integer;color:Tcolor);
var x,y,xi,yi:integer;
    d1,d2:single;
begin
   x:=0;y:=b;
   d1:=b*b+a*a*(-b+0.25);
   xi:=x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   while b*b*(x+1)<a*a*(y-0.5) do
   begin
     if d1<=0 then
     begin
       d1:=d1+b*b*(2*x+3);
       x:=x+1
     end
     else
     begin
       d1:=d1+b*b*(2*x+3)+a*a*(-2*y+2);
       x:=x+1;
       y:=y-1;
     end;
   xi:=x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   end;
   d2:=b*b*(x+0.5)*(x+0.5)+a*a*(y-1)*(y-1)-a*a*b*b;
   while y>0 do
   begin
    if d2<=0 then
      begin
        d2:=d2+b*b*(2*x+2)+a*a*(-2*y+3);
        x:=x+1;y:=y-1
      end
    else
      begin
        d2:=d2+a*a*(-2*y+3);
        y:=y-1;
      end;
   xi:=x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=-x+x0+xo;
   yi:=0-(y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   xi:=x+x0+xo;
   yi:=0-(-y-y0+yo);
   form1.Image1.Canvas.Pixels[xi,yi]:=color;
   end;
end;


procedure draw_circle();
begin
  with form1 do
   begin
      if label1.Caption='请输入命令：' then
      begin
         save_default();
         label1.Caption:='请输入圆心横坐标：';
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入圆心横坐标：' then
      begin
         save_back();
         save_default();
         label1.Caption:='请输入圆心纵坐标：';
         x1:=strtoint(edit1.Text);
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入圆心纵坐标：' then
      begin
         save_default();
         label1.Caption:='请输入半径：';
         y1:=strtoint(edit1.Text);
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入半径：' then
      begin
        load_default();
        form2.ToolButton4.Enabled:=true;
        label1.Caption:='请输入命令：';
        x2:=strtoint(edit1.Text);
        midbresenhamcircle(x1,y1,x2,clblue);
        form2.ToolButton2.Down:=false;
        edit1.Text:='';
        edit1.SetFocus;
      end;
   end;
end;

procedure draw_ellipse();
begin
  with form1 do
   begin
      if label1.Caption='请输入命令：' then
      begin
         save_default();
         label1.Caption:='请输入椭圆中心横坐标：';
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入椭圆中心横坐标：' then
      begin
         save_back();
         x1:=strtoint(edit1.Text);
         label1.Caption:='请输入椭圆中心纵坐标：';
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入椭圆中心纵坐标：' then
      begin
         y1:=strtoint(edit1.Text);
         label1.Caption:='请输入长半轴：';
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      if label1.Caption='请输入长半轴：' then
      begin
         x2:=strtoint(edit1.Text);
         label1.Caption:='请输入短半轴：';
         edit1.Text:='';
         edit1.SetFocus;
      end
      else
      begin
        load_default();
        form2.ToolButton4.Enabled:=true;
        label1.Caption:='请输入命令：';
        y2:=strtoint(edit1.Text);
        midbresenhamellipse(x1,y1,x2,y2,clAqua);
        form2.ToolButton3.Down:=false;
        edit1.Text:='';
        edit1.SetFocus;
      end;
   end;
end;

function check_line(A,B,C,x1,y1,x2,y2,x,y:integer):boolean;
var judge:boolean;
begin
    judge:=((x1<=x)and(x<=x2))or((x2<=x)and(x<=x1));
    result:=(A*x+B*y+C>-150)and(A*x+B*y+C<150)and(judge);
end;

function check_circle(a,b,r,x,y:integer):boolean;
begin
    result:=(((x-a)*(x-a)+(y-b)*(y-b)-r*r>-150)and((x-a)*(x-a)+(y-b)*(y-b)-r*r<150));
end;

function check_ellipse(a,b,ca,cb,x,y:integer):boolean;
begin
    result:=((round(sqrt((x-ca)*(x-ca)*b*b+(y-cb)*(y-cb)*a*a)-a*b)>-150)and(round(sqrt((x-ca)*(x-ca)*b*b+(y-cb)*(y-cb)*a*a)-a*b)<150));
end;

{$R *.dfm}

procedure Tform1.pickup(x,y:integer;c1:Tcolor);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb:integer;
    Cl:Tcolor;
begin
  for i:=1 to linecount do
    begin
      A:=line_array[i].A;
      B:=line_array[i].B;
      C:=line_array[i].C;
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if (check_line(A,B,C,x1,y1,x2,y2,x,y))and(line_array[i].fag=true) then
        begin
         Cl:=image1.Canvas.Pixels[x,y];
         paint_line(x1,y1,x2,y2,not(Cl));
         paint_line(x1,y1,x2,y2,c1);
        end;
    end;
    for i:=1 to circlecount do
    begin
      a:=circle_array[i].a;
      b:=circle_array[i].b;
      r:=circle_array[i].r;
      if check_circle(a,b,r,x,y)and(circle_array[i].fag=true) then
        begin
         Cl:=image1.Canvas.Pixels[x,y];
         midbresenhamcircle(a,b,r,not(Cl));
         midbresenhamcircle(a,b,r,c1);
        end;
    end;
    for i:=1 to ellipsecount do
    begin
      a:=ellipse_array[i].a;
      b:=ellipse_array[i].b;
      ca:=ellipse_array[i].ca;
      cb:=ellipse_array[i].cb;
      if check_ellipse(a,b,ca,cb,x,y)and(ellipse_array[i].fag=true) then
        begin
         Cl:=image1.Canvas.Pixels[x,y];
         midbresenhamellipse(ca,cb,a,b,not(Cl));
         midbresenhamellipse(ca,cb,a,b,c1);
        end;
    end;
end;

procedure Tform1.depickup(x,y:integer);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb:integer;
begin
  for i:=1 to linecount do
    begin
      A:=line_array[i].A;
      B:=line_array[i].B;
      C:=line_array[i].C;
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if check_line(A,B,C,x1,y1,x2,y2,x,y) then
        begin
         line_array[i].fag:=false;
        end;
    end;
    for i:=1 to circlecount do
    begin
      a:=circle_array[i].a;
      b:=circle_array[i].b;
      r:=circle_array[i].r;
      if check_circle(a,b,r,x,y) then
        begin
         circle_array[i].fag:=false;
        end;
    end;
    for i:=1 to ellipsecount do
    begin
      a:=ellipse_array[i].a;
      b:=ellipse_array[i].b;
      ca:=ellipse_array[i].ca;
      cb:=ellipse_array[i].cb;
      if check_ellipse(a,b,ca,cb,x,y) then
        begin
         ellipse_array[i].fag:=false;
        end;
    end;
end;

procedure Tform1.movepickup(x,y:integer;c1:Tcolor);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb:integer;
begin
  for i:=1 to linecount do
    begin
      A:=line_array[i].A;
      B:=line_array[i].B;
      C:=line_array[i].C;
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if (check_line(A,B,C,x1,y1,x2,y2,x,y))and(line_array[i].fag=true) then
        begin
         paint_line(x1,y1,x2,y2,c1);
         image1.Cursor:=crDrag;
         movestart_x:=x;movestart_y:=y;
         label1.Caption:='请选择移动到何处';
        end;
    end;
    for i:=1 to circlecount do
    begin
      a:=circle_array[i].a;
      b:=circle_array[i].b;
      r:=circle_array[i].r;
      if check_circle(a,b,r,x,y)and(circle_array[i].fag=true) then
        begin
         midbresenhamcircle(a,b,r,c1);
         image1.Cursor:=crDrag;
         movestart_x:=a;movestart_y:=b;
         label1.Caption:='请选择移动到何处';
        end;
    end;
    for i:=1 to ellipsecount do
    begin
      a:=ellipse_array[i].a;
      b:=ellipse_array[i].b;
      ca:=ellipse_array[i].ca;
      cb:=ellipse_array[i].cb;
      if check_ellipse(a,b,ca,cb,x,y)and(ellipse_array[i].fag=true) then
        begin
         midbresenhamellipse(ca,cb,a,b,c1);
         image1.Cursor:=crDrag;
         movestart_x:=ca;movestart_y:=cb;
         label1.Caption:='请选择移动到何处';
        end;
    end;
end;

procedure Tform1.onmove(x,y:integer);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb:integer;
begin
  paint_line(movestart_x,movestart_y,x,y,clred);
    for i:=1 to linecount do
    begin
      A:=line_array[i].A;
      B:=line_array[i].B;
      C:=line_array[i].C;
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if (check_line(A,B,C,x1,y1,x2,y2,movestart_x,movestart_y))and(line_array[i].fag=true) then
        begin
         paint_line(x1,y1,x2,y2,clred);
         paint_line(x1+x-movestart_x,y1+y-movestart_y,x2+x-movestart_x,y2+y-movestart_y,clred);
        end;
    end;
    for i:=1 to circlecount do
    begin
      a:=circle_array[i].a;
      b:=circle_array[i].b;
      r:=circle_array[i].r;
      if (a=movestart_x)and(b=movestart_y)and(circle_array[i].fag=true) then
        begin
          midbresenhamcircle(a,b,r,clred);
          midbresenhamcircle(a+x-movestart_x,b+y-movestart_y,r,clred);
        end;
    end;
    for i:=1 to ellipsecount do
    begin
      a:=ellipse_array[i].a;
      b:=ellipse_array[i].b;
      ca:=ellipse_array[i].ca;
      cb:=ellipse_array[i].cb;
      if (ca=movestart_x)and(cb=movestart_y)and(ellipse_array[i].fag=true) then
        begin
         midbresenhamellipse(ca,cb,a,b,clred);
         midbresenhamellipse(ca+x-movestart_x,cb+y-movestart_y,a,b,clred);
        end;
    end;
end;

procedure Tform1.moveto(x,y:integer);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb:integer;
begin
  paint_line(movestart_x,movestart_y,x,y,clred);
    for i:=1 to linecount do
    begin
      A:=line_array[i].A;
      B:=line_array[i].B;
      C:=line_array[i].C;
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if (check_line(A,B,C,x1,y1,x2,y2,movestart_x,movestart_y))and(line_array[i].fag=true) then
        begin
          line_save(i,x1+x-movestart_x,y1+y-movestart_y,x2+x-movestart_x,y2+y-movestart_y,line_array[i].color);
        end;
    end;
    for i:=1 to circlecount do
    begin
      a:=circle_array[i].a;
      b:=circle_array[i].b;
      r:=circle_array[i].r;
      if (a=movestart_x)and(b=movestart_y)and(circle_array[i].fag=true) then
        begin
          circle_save(i,a+x-movestart_x,b+y-movestart_y,r,0,circle_array[i].color);
        end;
    end;
    for i:=1 to ellipsecount do
    begin
      a:=ellipse_array[i].a;
      b:=ellipse_array[i].b;
      ca:=ellipse_array[i].ca;
      cb:=ellipse_array[i].cb;
      if (ca=movestart_x)and(cb=movestart_y)and(ellipse_array[i].fag=true) then
        begin
         ellipse_save(i,ca+x-movestart_x,cb+y-movestart_y,a,b,circle_array[i].color);
        end;
    end;
end;

procedure Tform1.cirpickup(x,y:integer;c1:Tcolor);