untshape.pas

这是个可以划出不同几何图形的程序

    rc:=Rect(left,bottom,left+SizerWidth,bottom+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType6;
     exit;
   end;
   //7
    rc:=Rect(left,halfh,left+SizerWidth,halfh+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType7;
     exit;
   end;
end;

procedure TRectangle.SetBoundRect;
begin
  inherited SetBoundRect;

end;

procedure TRectangle.SetRect(LTPnt, RBPnt: TPoint);
begin
 inherited SetRect(LTPnt, RBPnt);
end;

{ TDiamond }

constructor TDiamond.Create(ShpStrt: TShapeProperty);
begin
 inherited Create(ShpStrt);
end;

procedure TDiamond.Paint(ACanvas: HDC);     //菱形
var
  pen:HPEN;
  SolidBrush:HBRUSH;
  rgn:HRGN;
  pnt:array[0..3]of TPoint;
  //p1,p2,p3,p4:TPoint;
begin
    pen:=CreatePen(0,LineWidth,LineColor);
    SolidBrush:=CreateSolidBrush(Color);
    SelectObject(aCanvas,SolidBrush);
    SelectObject(aCanvas,pen);
      pnt[0]:=Point(FHeadPnt.X,FHeadPnt.Y+(FEndPnt.y-FHeadPnt.Y)div 2);
      pnt[1]:=Point(FHeadPnt.x+(FEndPnt.x-FHeadPnt.x)div 2,FHeadPnt.y);
      pnt[2]:=Point(FEndPnt.x,FHeadPnt.Y+(FEndPnt.y-FHeadPnt.Y)div 2);
      pnt[3]:=Point(FHeadPnt.x+(FEndPnt.x-FHeadPnt.x)div 2,FEndPnt.y);
     rgn:=CreatePolygonRgn(pnt,4,ALTERNATE	);  //创建多边形
    FillRgn(aCanvas,rgn,SolidBrush);           //填充区域
    MoveToEx(aCanvas,pnt[0].X,pnt[0].y,nil);   //画边界
    LineTo(aCanvas,pnt[1].X,pnt[1].y);
    LineTo(aCanvas,pnt[2].X,pnt[2].y);
    LineTo(aCanvas,pnt[3].X,pnt[3].y);
    LineTo(aCanvas,pnt[0].X,pnt[0].y);
    deleteObject(pen);
    deleteObject(SolidBrush);
    DeleteObject(rgn);
    DrawSizer(seSLine,aCanvas);
 end;
{ TBaseLine }

constructor TBaseLine.Create(ShpStrt: TShapeProperty);
begin
  inherited Create(ShpStrt);
  SetLength(PntArr,2);      //对动态数组进行赋值
  PntArr[0]:=FHeadPnt;
  PntArr[1]:=FEndPnt;
  CurrentIndex:=-1;
end;

procedure TBaseLine.DrawArrow(dc:HDC);
var
p1,p2:TPoint;
rc:TRect;
Brush:HBRUSH;
//hw:integer;
begin
  p1:=PntArr[High(PntArr)-1];
  p2:=PntArr[High(PntArr)];
    Brush:=CreateSolidBrush(LineColor);
    SelectObject(dc,Brush);
        //hw:=SizerWidth div 2;
         rc:=Rect(p1.x-3,p1.Y-3,p1.X+3,p1.y+3);
        FillRect(dc,rc,Brush);
         rc:=Rect(p2.x-3,p2.Y-3,p2.X+3,p2.y+3);
        FillRect(dc,rc,Brush);
    DeleteOBject(Brush);

end;

procedure TBaseLine.DrawSizer(kind: TShapeElement; dc: HDC); //画线的边界
var
 rc:TRect;
 brush:HBRUSH;
 i,hw:integer;
begin
    Brush:=CreateSolidBrush(clRed);
    SelectObject(dc,Brush);
    hw:=SizerWidth div 2;
       for i:=Low(PntArr)to High(PntArr) do
       begin
         Rc:=Rect(Pntarr[i].X-hw,PntArr[i].Y-hw,Pntarr[i].X+hw,PntArr[i].Y+hw);
        FillRect(dc,rc,Brush);
       end;
    DeleteObject(brush);
end;

function TBaseLine.HitTest(Pnt: TPoint): Boolean;
var

i:integer;
xoff,yoff:integer;
lngth,distance:integer;
rc:TRect;
hw:integer;
begin
   result:=false;
   FSelected:=false;
   CurrentIndex:=-1;
   hw:=SizerWidth div 2;

   for i:=0 to High(Pntarr) do
   begin
     rc:=Rect(PntArr[i].x-hw,PntArr[i].y-hw,PntArr[i].x+hw,PntArr[i].y+hw);
     if PtinRect(rc,Pnt) then
     begin
       FSelected:=true;
       result:=true;
       CurrentIndex:=i;
       exit;
     end;
   end;
   for i:=0 to (High(Pntarr)-1) do
   begin
     xoff:=(pntArr[i].x-pntarr[i+1].x);
     yoff:=(pntArr[i].y-pntarr[i+1].y);
     lngth:=Round(sqrt(xoff*xoff+yoff*yoff));
     xoff:=(pntarr[i].x-pnt.x);
     yoff:=(pntarr[i].y-pnt.y);
     distance:=Round(sqrt(xoff*xoff+yoff*yoff));
     xoff:=(pntarr[i+1].x-pnt.x);
     yoff:=(pntarr[i+1].y-pnt.y);
     distance:=distance+Round(sqrt(xoff*xoff+yoff*yoff));
     if abs(distance-lngth)<=2 then
     begin
       FSelected:=true;
       result:=true;
       exit;
     end;
   end;
end;

function TBaseLine.Move(const Xoffset, YOffset: integer): Boolean;
var
i:integer;
begin
 for i:=Low(PntArr) to High(PntArr) do
 begin
   inc(PntArr[i].X,Xoffset);
   inc(PntArr[i].y,Yoffset);
 end;
 result:=true;
end;

procedure TBaseLine.MoveCurrentPnt(const X, Y: integer);
begin
 if (CurrentIndex<Low(PntArr)) or (CurrentIndex>High(PntArr))  then exit;
  PntArr[CurrentIndex]:=Point(x,y);
end;

procedure TBaseLine.Paint(ACanvas: HDC);
var
pen:HPEN;
i:integer;
begin
   pen:=CreatePen(0,LineWIdth,LineColor);
   SelectObject(aCanvas,pen);
      MoveToEx(aCanvas,PntArr[0].X,PntArr[0].y,nil);
      for i:=Low(PntArr)+1 to High(PntArr) do
       LineTo(aCanvas,PntArr[i].x,PntArr[i].y);
      LineTo(aCanvas,PntArr[0].x,PntArr[0].y);
   deleteObject(pen);

   DrawArrow(aCanvas);
   if FSelected then
   DrawSizer(seSLine,ACanvas);
end;

function TBaseLine.ReSizeTest(const Pnt: TPoint): TSizerType;
var
i:integer;
rc:TRect;
hw:integer;
begin
  result:=sTypeNone;

  hw:=SizerWidth div 2;
  if HitTest(Pnt) then Result:=sTypeDrag;
  for i:=Low(PntArr)to High(PntArr) do
  begin
    rc:=Rect(PntArr[i].x-hw,PntArr[i].Y-hw,PntArr[i].X+hw,PntArr[i].Y+hw);
    if PtInRect(rc,Pnt) then
     begin
       Result:=sTypeFree;
       CurrentIndex:=i;
       exit;

     end;
  end;
end;
{ TTriangle }

constructor TTriangle.Create(ShpStrt: TShapeProperty);
begin
   inherited Create(ShpStrt);
  // Color:=clBlue;
end;

procedure TTriangle.Paint(ACanvas: HDC);
var
pen:HPEN;
SolidBrush:HBRUSH;
rgn:HRGN;
pnt:array [0..2]of TPoint;
begin
    pen:=CreatePen(0,LineWidth,LineColor);
    SolidBrush:=CreateSolidBrush(Color);
    SelectObject(aCanvas,SolidBrush);
    SelectObject(aCanvas,pen);
    case FDir of
    sdLeft,sdRight:begin
      pnt[0]:=Point(FHeadPnt.X,FHeadPnt.Y+(FEndPnt.y-FHeadPnt.Y)div 2);
      pnt[1]:=Point(FEndPnt.x,FHeadPnt.y);
      pnt[2]:=FEndPnt;
           end;
    sdDown,sdUp:begin
      pnt[2]:=Point(FHeadPnt.x+(FEndPnt.x-FHeadPnt.X)div 2,FHeadPnt.y);
      pnt[1]:=Point(FHeadPnt.x,FEndPnt.y);
      pnt[0]:=FEndPnt;
           end;
    end;
     rgn:=CreatePolygonRgn(pnt,3,ALTERNATE	);   //创建三角形
    FillRgn(aCanvas,rgn,SolidBrush);
    MoveToEx(aCanvas,pnt[0].X,pnt[0].y,nil);     //画边界线
    LineTo(aCanvas,pnt[1].X,pnt[1].y);
    LineTo(aCanvas,pnt[2].X,pnt[2].y);
    LineTo(aCanvas,pnt[0].X,pnt[0].y);
    deleteObject(pen);
    deleteObject(SolidBrush);
    DeleteObject(rgn);
    DrawSizer(seSLine,aCanvas);
 end;

{ TArrow }

constructor TArrow.Create(ShpStrt: TShapeProperty);
begin
   inherited Create(ShpStrt);
  // Color:=clFuchsia;
end;

procedure TArrow.Paint(ACanvas: HDC);        //画箭头
var
pen:hpen;
brush:hbrush;
rgn:hrgn;
hx,hy:integer;
ah,i:integer;
p:array[0..6]of TPoint;
begin
 hx:=FHeadPnt.x+(FEndPnt.x-FHeadPnt.x)div 2;      //上中位置
 hy:=FHeadPnt.y+(FEndPnt.y-FHeadPnt.y)div 2;      //下中位置

 case Fdir of
  sdLeft,sdRight: begin
                       ah:=(FEndPnt.y-FHeadPnt.y)div 4;
                    p[0]:=Point(FHeadPnt.x,hy);
                    p[1]:=Point(hx,FHeadPnt.y);
                    p[2]:=Point(hx,FHeadPnt.Y+ah);
                    p[3]:=Point(FEndPnt.x,FHeadPnt.y+ah);
                    p[4]:=Point(FEndPnt.x,FEndPnt.y-ah);
                    p[5]:=Point(hx,FEndPnt.y-ah);
                    P[6]:=Point(hx,FEndPnt.y);
                  end;
  sdDown,sdUp: begin
                       ah:=(FEndPnt.x-FHeadPnt.x)div 4;
                    p[0]:=Point(hx,FHeadPnt.y);
                    p[1]:=Point(FendPnt.X ,hy);
                    p[2]:=Point(FEndPnt.x-ah,hy);
                    p[3]:=Point(FEndPnt.x-ah,FEndPnt.y);
                    p[4]:=Point(FHeadPnt.x+ah,FEndPnt.y);
                    p[5]:=Point(FHeadPnt.x+ah,hy);
                    P[6]:=Point(FHeadPnt.x,hy);
                  end;
 end;

 pen:=CreatePen(0,LineWidth,LineColor);
 Brush:=CreateSolidBrush(Color);
    SelectObject(aCanvas,Brush);
    SelectObject(aCanvas,pen);
  rgn:=CreatePolygonRgn(p,7,ALTERNATE);
  MoveToex(aCanvas,p[0].X,p[0].Y,nil);
 
  FillRgn(aCanvas,rgn,Brush);
   for i:=1 to 6 do
    LineTo(aCanvas,p[i].x,p[i].Y);
  LineTo(aCanvas,p[0].x,p[0].Y);  
    deleteObject(pen);
    deleteObject(Brush);
    DeleteObject(rgn);
    DrawSizer(seSLine,aCanvas);
end;

{ TEchelon }

constructor TEchelon.Create(ShpStrt: TShapeProperty);
begin
    inherited Create(ShpStrt);
//   Color:=clOlive;
end;

procedure TEchelon.Paint(ACanvas: HDC);
var
pen:HPEN;
brush:HBRUSH;
rgn:HRGN;
 pnt:Array[0..3]of TPoint;
ah,i:integer;
begin
  ah:=(FEndPnt.x-FHeadPnt.X)div 5;
   pen:=CreatePen(0,LineWidth,LineCOlor);
   Brush:=CreateSolidBrush(Color);
   SelectObject(aCanvas,pen);
   SelectObject(aCanvas,Brush);
     pnt[0]:=Point(FHeadPnt.X,FEndPnt.y);
     pnt[1]:=Point(FHeadPnt.X+ah,FHeadPnt.y);
     pnt[2]:=Point(FEndPnt.X-ah,FHeadPnt.y);
     pnt[3]:=FEndPnt;
    rgn:=CreatePolygonRgn(pnt,4,ALTERNATE);
    FillRgn(aCanvas,rgn,brush);
    MoveToEx(aCanvas,pnt[0].x,pnt[0].Y,nil);
    for i:=1 to 3 do
      LineTo(aCanvas,pnt[i].x,pnt[i].y);
    LineTo(aCanvas,pnt[0].x,pnt[0].y);
   deleteObject(pen);
   deleteObject(brush);
   deleteObject(rgn);
   DrawSizer(seSLine,aCanvas);
end;

{ TEllipse }

constructor TEllipse.Create(ShpStrt: TShapeProperty);
begin
    inherited Create(ShpStrt);
//   Color:=clRed;
end;

procedure TEllipse.Paint(ACanvas: HDC);
var
pen:HPEN;
brush:HBRUSH;
begin
  pen:=CreatePen(0,LineWidth,LineCOlor);
   Brush:=CreateSolidBrush(Color);
   SelectObject(aCanvas,pen);
   SelectObject(aCanvas,Brush);
     Ellipse(aCanvas,FBoundRect.Left,FBoundRect.top,FBoundRect.right,
            FBoundRect.Bottom);
   deleteObject(pen);
   deleteObject(brush);
   DrawSizer(seSLine,aCanvas);
end;

{ TCylinder }

constructor TCylinder.Create(ShpStrt: TShapeProperty);
begin
   inherited Create(ShpStrt);
//   Color:=clOlive;
end;

procedure TCylinder.Paint(ACanvas: HDC);
var
pen:HPEN;
brush:HBRUSH;
rgn:HRGN;
ah:integer;

begin
   pen:=CreatePen(0,LineWidth,LineCOlor);
   Brush:=CreateSolidBrush(Color);
   SelectObject(aCanvas,pen);
   SelectObject(aCanvas,Brush);
     ah:=(FEndPnt.Y-FHeadPnt.y)div 4;
     Ellipse(aCanvas,FHeadPnt.x,FHeadPnt.y,FEndPnt.x,FHeadPnt.y+ah*2);

     rgn:=CreateRectRgn(FHeadPnt.x,FHeadPnt.y+ah ,FEndPnt.X,FEndPnt.y);
     FillRgn(aCanvas,rgn,brush);

      MoveToEx(aCanvas,FHeadPnt.x,FHeadPnt.y+ah,nil);
        LineTo(aCanvas,FHeadPnt.x,FEndPnt.y);
        LineTo(aCanvas,FEndPnt.X,FEndPnt.y);
        LineTo(aCanvas,FEndPnt.x,FHeadPnt.Y+ah);
   deleteObject(pen);
   deleteObject(brush);
   deleteObject(rgn);
   DrawSizer(seSLine,aCanvas);
end;

end.