unit1.pas

本程序是图形的设计

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);
         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);
         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);
         movestart_x:=ca;movestart_y:=cb;
         label1.Caption:='请输入旋转角度';
        end;
    end;
end;

procedure Tform1.oncir(x,y:integer);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb,nx1,ny1,nx2,ny2:integer;
    cos1,sin1,cos2,sin2,cos3,sin3,m,n:single;
begin
   x1:=movestart_x;y1:=movestart_y;
   x2:=x;y2:=y;
   cos1:=(x1-xc)/(sqrt(sqr(x1-xc)+sqr(y1-yc)));
   sin1:=(y1-yc)/(sqrt(sqr(x1-xc)+sqr(y1-yc)));
   cos2:=(x2-xc)/(sqrt(sqr(x2-xc)+sqr(y2-yc)));
   sin2:=(y2-yc)/(sqrt(sqr(x2-xc)+sqr(y2-yc)));
   cos3:=cos2*cos1+sin2*sin1;
   sin3:=sin2*cos1-cos2*sin1;
   cos1:=cos3;sin1:=sin3;
   m:=xc-xc*cos1+yc*sin1;
   n:=yc-yc*cos1-xc*sin1;
   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);
         nx1:=round(x1*cos1-y1*sin1+m);
         ny1:=round(x1*sin1+y1*cos1+n);
         nx2:=round(x2*cos1-y2*sin1+m);
         ny2:=round(x2*sin1+y2*cos1+n);
         paint_line(nx1,ny1,nx2,ny2,clblue);
        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);
          x1:=round(a*cos1-b*sin1+m);
          y1:=round(a*sin1+b*cos1+n);
          midbresenhamcircle(x1,y1,r,clblue);
        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);
         x1:=round(ca*cos1-cb*sin1+m);
         y1:=round(ca*sin1+cb*cos1+n);
         midbresenhamellipse(x1,y1,a,b,clblue);
        end;
    end;
end;

procedure Tform1.cirto(x,y:integer);
var i,A,B,C,r,x1,x2,y1,y2,ca,cb,nx1,ny1,nx2,ny2:integer;
    cos1,sin1,cos2,sin2,cos3,sin3,m,n:single;
begin
   x1:=movestart_x;y1:=movestart_y;
   x2:=x;y2:=y;
   cos1:=(x1-xc)/(sqrt(sqr(x1-xc)+sqr(y1-yc)));
   sin1:=(y1-yc)/(sqrt(sqr(x1-xc)+sqr(y1-yc)));
   cos2:=(x2-xc)/(sqrt(sqr(x2-xc)+sqr(y2-yc)));
   sin2:=(y2-yc)/(sqrt(sqr(x2-xc)+sqr(y2-yc)));
   cos3:=cos2*cos1+sin2*sin1;
   sin3:=sin2*cos1-cos2*sin1;
   cos1:=cos3;sin1:=sin3;
   m:=xc-xc*cos1+yc*sin1;
   n:=yc-yc*cos1-xc*sin1;
   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);
         nx1:=round(x1*cos1-y1*sin1+m);
         ny1:=round(x1*sin1+y1*cos1+n);
         nx2:=round(x2*cos1-y2*sin1+m);
         ny2:=round(x2*sin1+y2*cos1+n);
         line_save(i,nx1,ny1,nx2,ny2,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
          midbresenhamcircle(a,b,r,clred);
          x1:=round(a*cos1-b*sin1+m);
          y1:=round(a*sin1+b*cos1+n);
          midbresenhamcircle(x1,y1,r,clblue);
          circle_save(i,x1,y1,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
         midbresenhamellipse(ca,cb,a,b,clred);
         x1:=round(ca*cos1-cb*sin1+m);
         y1:=round(ca*sin1+cb*cos1+n);
         ellipse_save(i,x1,y1,a,b,circle_array[i].color);
        end;
    end;
end;



procedure Tform1.paintagain();
var i,r,a,b,x1,x2,y1,y2,ca,cb:integer;
begin
  form1.Image1.Picture := nil;
  for i:=1 to linecount do
    begin
      x1:=line_array[i].x1;
      y1:=line_array[i].y1;
      x2:=line_array[i].x2;
      y2:=line_array[i].y2;
      if line_array[i].fag=true then
        begin
         paint_line(x1,y1,x2,y2,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 circle_array[i].fag=true then
        begin
         midbresenhamcircle(a,b,r,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 ellipse_array[i].fag=true then
        begin
         midbresenhamellipse(ca,cb,a,b,ellipse_array[i].color);
        end;
    end;
end;


procedure Tform1.line_save(i,x1,y1,x2,y2:integer;color:Tcolor);
begin
  line_array[i].A:=y2-y1;
  line_array[i].B:=x1-x2;
  line_array[i].C:=y1*x2-y2*x1;
  line_array[i].x1:=x1;
  line_array[i].y1:=y1;
  line_array[i].x2:=x2;
  line_array[i].y2:=y2;
  line_array[i].color:=color;
  line_array[i].fag:=true;
end;

procedure Tform1.circle_save(i,x1,y1,x2,y2:integer;color:Tcolor);
begin
  circle_array[i].a:=x1;
  circle_array[i].b:=y1;
  circle_array[i].r:=x2;
  circle_array[i].color:=color;
  circle_array[i].fag:=true;
end;

procedure Tform1.ellipse_save(i,x1,y1,x2,y2:integer;color:Tcolor);
begin
  ellipse_array[i].a:=x2;
  ellipse_array[i].b:=y2;
  ellipse_array[i].ca:=x1;
  ellipse_array[i].cb:=y1;
  ellipse_array[i].color:=color;
  ellipse_array[i].fag:=true;
end;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  memo1.Lines.Add(inttostr(checkcursor_x(x))+','+inttostr(checkcursor_y(y)));
  if (form2.ToolButton1.Down=true)and(label1.Caption='直线（d\b\g）:')then
    begin
    save_back();
    save_default();
    x1:=checkcursor_x(x);y1:=checkcursor_y(y);
    c_line:='g';
    label1.Caption:='请输入第二点的横坐标：';
    end
  else
  if (form2.ToolButton1.Down=true)and(label1.Caption='请输入第一点的横坐标：')then
    begin
    save_default();
    x1:=checkcursor_x(x);y1:=checkcursor_y(y);
    label1.Caption:='请输入第二点的横坐标：';
    end
  else
  if (form2.ToolButton1.Down=true)and(label1.Caption='请输入第二点的横坐标：')then
    begin
    load_default();
    form2.ToolButton4.Enabled:=true;
    x2:=checkcursor_x(x);y2:=checkcursor_y(y);
    paint_line(x1,y1,x2,y2,cl);
    linecount:=linecount+1;
    line_save(linecount,x1,y1,x2,y2,cl);
    label1.Caption:='直线（d\b\g）:';
    end
  else
  if (form2.ToolButton2.Down=true)and(label1.Caption='请输入圆心横坐标：')then
    begin
    save_back();
    save_default();
    form2.ToolButton4.Enabled:=true;
    x1:=checkcursor_x(x);
    y1:=checkcursor_y(y);
    label1.Caption:='请输入半径：';
    end
  else
  if (form2.ToolButton2.Down=true)and(label1.Caption='请输入半径：')then
    begin
    load_default();
    form2.ToolButton4.Enabled:=true;
    x2:=round(sqrt(sqr(checkcursor_x(x)-x1)+sqr(checkcursor_y(y)-y1)));
    midbresenhamcircle(x1,y1,x2,cl);
    circlecount:=circlecount+1;
    circle_save(circlecount,x1,y1,x2,y2,cl);
    form1.save_default();
    label1.Caption:='请输入圆心横坐标：'
    end
  else
  if (form2.ToolButton3.Down=true)and(label1.Caption='请输入椭圆中心横坐标：')then
    begin
    save_back();
    save_default();
    form2.ToolButton4.Enabled:=true;
    x1:=checkcursor_x(x);
    y1:=checkcursor_y(y);
    label1.Caption:='请输入长半轴：';
    end
  else
  if (form2.ToolButton3.Down=true)and(label1.Caption='请输入长半轴：')then
    begin
    load_default();
    form2.ToolButton4.Enabled:=true;
    x2:=abs(checkcursor_x(x)-x1);
    y2:=abs(checkcursor_y(y)-y1);
    midbresenhamellipse(x1,y1,x2,y2,cl);
    ellipsecount:=ellipsecount+1;
    ellipse_save(ellipsecount,x1,y1,x2,y2,cl);
    form1.save_default();
    label1.Caption:='请输入椭圆中心横坐标：'
    end
  else
  if(form2.ToolButton12.Down=true)and(label1.Caption='请选择删除的图形') then
    begin
    save_back();
    xc:=checkcursor_x(x);
    yc:=checkcursor_y(y);
    pickup(xc,yc,clred);
    end
  else
  if(form2.ToolButton13.Down=true)and(label1.Caption='请选择移动的图形') then
    begin
    save_back();
    save_default();
    xc:=checkcursor_x(x);
    yc:=checkcursor_y(y);
    movepickup(xc,yc,clred);
    end
  else
  if(form2.ToolButton14.Down=true)and(label1.Caption='请选择旋转的支点') then
  begin
    save_back();
    save_default();
    xc:=checkcursor_x(x);
    yc:=checkcursor_y(y);
    label1.Caption:='请选择旋转图形';
  end
  else
  if(form2.ToolButton14.Down=true)and(label1.Caption='请选择旋转图形') then
  begin
    save_back();
    save_default();
    x1:=checkcursor_x(x);
    y1:=checkcursor_y(y);
    cirpickup(x1,y1,clred);
  end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if key=#13 then
   begin
      if label1.Caption='请输入命令：' then
         begin
             com_sel:=com_select();
             case  com_sel of
               1:change_curson();
               2:draw_line();
               3:draw_circle();
               4:draw_ellipse();
             end;
         end
      else
         begin
            case com_sel of
               1:change_curson() ;
               2:draw_line();
               3:draw_circle();
               4:draw_ellipse();
         end;
     end

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
   c_line:='g';
   x0:=image1.Width div 2;
   y0:=image1.Height div 2;
   form2.ToolButton4.Enabled:=false;
   form2.ToolButton11.Enabled:=false;
   bmp:=tbitmap.Create;
   for i:=1 to 50  do
      bmp1[i]:=tbitmap.Create;
   rb:=0;
   st:=0;
   linecount:=0;
   circlecount:=0;
   ellipsecount:=0;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  image1.Hint:=inttostr(x)+','+inttostr(y);
  if (form2.ToolButton1.Down=true)and(label1.Caption='请输入第二点的横坐标：')then
  begin
     load_default();
     save_default();
     x2:=checkcursor_x(x);y2:=checkcursor_y(y);
     paint_line(x1,y1,x2,y2,cl);
  end
  else
  if (form2.ToolButton2.Down=true)and(label1.Caption='请输入半径：')then
    begin
    load_default();
    save_default();
    x2:=round(sqrt(sqr(checkcursor_x(x)-x1)+sqr(checkcursor_y(y)-y1)));
    midbresenhamcircle(x1,y1,x2,cl);
    end
  else
  if (form2.ToolButton3.Down=true)and(label1.Caption='请输入长半轴：')then
    begin
    load_default();
    save_default();
    x2:=abs(checkcursor_x(x)-x1);
    y2:=abs(checkcursor_y(y)-y1);
    midbresenhamellipse(x1,y1,x2,y2,cl);
    end
  else
  if(form2.ToolButton13.Down=true)and(label1.Caption='请选择移动到何处') then
    begin
      load_default();
      x2:=checkcursor_x(x);y2:=checkcursor_y(y);
      onmove(x2,y2);
    end
  else
  if(form2.ToolButton14.Down=true)and(label1.Caption='请输入旋转角度') then
    begin
      load_default();
      x1:=movestart_x;y1:=movestart_y;
      x2:=checkcursor_x(x);y2:=checkcursor_y(y);
      midbresenhamcircle(xc,yc,round(sqrt(sqr(x1-xc)+sqr(y1-yc))),clred);
      oncir(x2,y2);
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i:integer;
begin
  bmp.free;
  for i:=1 to 50  do
      bmp1[i].free;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if(form2.ToolButton12.Down=true)and(label1.Caption='请选择删除的图形') then
    begin
       depickup(xc,yc);
       paintagain();
    end;
    if(form2.ToolButton13.Down=true)and(label1.Caption='请选择移动到何处') then
    begin
       x2:=checkcursor_x(x);y2:=checkcursor_y(y);
       moveto(x2,y2);
       paintagain();
       label1.Caption:='请选择移动的图形';
       image1.Cursor:=crCross;
    end
    else
    if(form2.ToolButton14.Down=true)and(label1.Caption='请输入旋转角度') then
    begin
     x2:=checkcursor_x(x);y2:=checkcursor_y(y);
     cirto(x2,y2);
     paintagain();
     label1.Caption:='请选择旋转的支点';
    end;
end;

end.