untshape.pas

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

{***************************************************************}
{		 UntShape					}
{              }
{                  }
{                                                               }
{            }
{								}
{  E-Mail: [e-mail]				}
{                          04-2004	 by	Hu Qing Jiang		}
{								}
{***************************************************************}unit UntShape;

interface

uses
 windows,SysUtils, Classes, Controls,Graphics;
const
  SizerWidth=6;
type
    TShapeElement=(seNone,seSLine,seMLine,seCylinder,seArrow,seRectangle,seDiamond,
                   seEchelon,seEllipse,seTriangle);   //图形类别
    TShapeDir=(sdLeft,sdRight,sdDown,sdUp);
    TSizerType=(sTypeNone,sTypeDrag,sTypeFree,sType0,sType1,sType2,sType3,sType4,sType5,sType6,sType7);
    TPenWidth=1..4;


    TShapeProperty=record       // shape property record
       FHeadPnt:TPoint;         //图形初始位置
       FEndPnt:TPoint;          //图形终点位置
       FWidth:integer;          //图形宽度
       FHeight:integer;         //图形高度
       FLineWidth:TPenWidth;    //线的宽度
       FLineColor:TColor;       //线的颜色
       FColor:TColor;           //填充颜色类别
       FDir:TShapeDir;          //
       FTransparent:Boolean;    //图像是否透明
       FText:String;            //文本显示
       FFontName:string;        //字体名称
       FFontSize:integer;       //字体尺寸
       FFontColor:TColor;       //字体颜色
    end;

    TBaseShape=class             //定义基类
      private
       FHeadPnt:TPoint;         //开始位置
       FEndPnt:TPoint;          //终止位置
       FSelected:Boolean;       //是否选中
       FBoundRect:TRect;        //区域
       FDir:TShapeDir;

      protected
         procedure SetBoundRect;virtual;    //画图形区域
         procedure DrawSizer(kind:TShapeElement;dc:HDC);virtual;  //画图形边界红色标识
         procedure DrawCaption(DC:HDC);virtual;
      public
       LineWidth:TPenWidth;
       LineColor:TColor;
       Color:TColor;
       Caption:string;
       Transparent:Boolean;
       FontSize:integer;
       FontName:string;
       FontColor:TColor;
       property Selected:Boolean read FSelected write FSelected;
       property BoundRect:TRect read FBoundRect;
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);virtual;
         function HitTest(Pnt:TPoint):Boolean;virtual;  //点击图像发生该事件
         function Move(const Xoffset,YOffset:integer):Boolean;virtual;//参数为偏移量 移动图形并重画
         function ReSizeTest(const Pnt:TPoint):TSizerType; virtual;
         procedure SetRect(LTPnt,RBPnt:TPoint);virtual;
     end;
//....................................................................
     TBaseLine=class(TBaseShape)
       Private
        Pntarr:Array of TPoint;
        CurrentIndex:integer;

       protected
         procedure DrawSizer(kind:TShapeElement;dc:HDC);override;
         procedure DrawArrow(dc:HDC);virtual;
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
         function HitTest(Pnt:TPoint):Boolean;override;
         function Move(const Xoffset,YOffset:integer):Boolean;override;
         function ReSizeTest(const Pnt:TPoint):TSizerType;override;
         procedure MoveCurrentPnt(const X,Y:integer);
       public
         Arrow:Boolean;
       public
         property Selected;

     end;
//....................................................................
     TRectangle=class(TBaseShape)
      private

      protected
        procedure SetBoundRect;override;
        procedure DrawSizer(kind:TShapeElement;dc:HDC);override;
     //   procedure DrawCaption(DC:HDC);override;
      public
         RoundVal:integer;
         property Selected;
         property BoundRect;

      public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
         function HitTest(Pnt:TPoint):Boolean;override;
         function Move(const Xoffset,YOffset:integer):Boolean;override;
         function ReSizeTest(const Pnt:TPoint):TSizerType;override;
         procedure SetRect(LTPnt,RBPnt:TPoint);override;
     end;
//.........................................
     TDiamond=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
       end;
//.......................................................
     TCylinder=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
       end;
//.......................................................
  TEllipse=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
       end;
//.......................................................
     TEchelon=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
       end;
//..........................
     TTriangle=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
     end;
//................................................................
TArrow=class(TRectangle)
       public
         constructor Create(ShpStrt:TShapeProperty);
         procedure Paint(ACanvas:HDC);override;
       public
       property Selected;
       property BoundRect;
     end;
implementation

  function MaxAB(const a,b:integer):integer;
  begin
     if a>=b then result:=a
     else result:=b;
  end;
   function MinAB(const a,b:integer):integer;
  begin
     if a<=b then result:=a
     else result:=b;
  end;
{ TBaseShape }

constructor TBaseShape.Create(ShpStrt:TShapeProperty);
begin
   inherited Create;
   //初始化图像的属性
       FHeadPnt:=ShpStrt.FHeadPnt;     //起始位置
       FEndPnt:=ShpStrt.FEndPnt;       //终止位置
       LineWidth:=ShpStrt.FLineWidth;    //边界线的宽度
       if LineWidth<1 then LineWidth:=1;
       if LineWidth>4 then LineWidth:=4;
       LineColor:=ShpStrt.FLineColor;     //边界线的颜色
       Color:=ShpStrt.FColor;             //图形填充颜色
       Caption:=ShpStrt.FText;            //文字标识
       Transparent:=ShpStrt.FTransparent;
       FDir:=ShpStrt.FDir;
       SetBoundRect;                      //画图形
       FSelected:=true;                   //对是否选中属性赋值
   FontName:=ShpStrt.FFontName;           //字体名称
   FontSize:=ShpStrt.FFOntSize;           //字体尺寸
   FontColor:=ShpStrt.FFontColor;         //字体颜色

end;

procedure TBaseShape.DrawCaption(DC:HDC);
begin
  // nothing;
end;

procedure TBaseShape.DrawSizer(kind: TShapeElement; dc: HDC);
begin
// do nothing;;;;;;;;
end;

function TBaseShape.HitTest(Pnt: TPoint): Boolean;
begin
 result:=false;
end;



function TBaseShape.Move(const Xoffset,YOffset:integer):Boolean;  //基类中的移动重画事件
begin
 result:=false;
 if (Xoffset=0)and(Yoffset=0)then exit;
 FHeadPnt.x:=FHeadPnt.x+xoffset;
 FHeadPnt.y:=FHeadPnt.y+yoffset;
 FEndPnt.x:=FEndPnt.x+xoffset;
 FEndPnt.y:=FEndPnt.y+yoffset;
  SetBoundRect;
 result:=true;

end;

procedure TBaseShape.Paint(ACanvas:HDC);
begin
    // in this class ,it do nothing.........
end;

function TBaseShape.ReSizeTest(const Pnt: TPoint): TSizerType;
begin
  result:=sTypeNone;
end;

procedure TBaseShape.SetBoundRect;
var
lt,br:TPoint;
begin

 br.x:=MaxAB(FHeadPnt.X,FEndPnt.X);
 br.y:=MaxAB(FHeadPnt.y,FEndPnt.y);
 lt.x:=MinAB(FHeadPnt.x,FEndPnt.x);
 lt.y:=MinAB(FHeadPnt.y,FEndPnt.y);

FBoundRect:=Rect(lt,br);
end;
procedure TBaseShape.SetRect(LTPnt, RBPnt: TPoint);
begin
  if (LTPnt.x=RBPnt.x)and(LTPnt.y=RBPnt.y) then exit;
  FHeadPnt:=LTPnt;
  FEndPnt:=RBPnt;
  SetBoundRect;
end;

{ TRectangle }

constructor TRectangle.Create(ShpStrt:TShapeProperty);
begin
  inherited Create(ShpStrt);
  RoundVal:=0;
end;



procedure TRectangle.DrawSizer(kind: TShapeElement; dc: HDC);
var
brush:HBRUSH;
i:integer;
sizer:array[0..7] of TPoint;
rc:TRect;
begin
 if not Selected then exit;
 sizer[0]:=Point(FBoundRect.left,FBoundRect.Top);   //图形的左上坐标
 sizer[1]:=Point(FBoundRect.left+(FBoundRect.Right-FBoundRect.left)div 2-SizerWidth div 2,
                  FBoundRect.Top);    // 图形的上中间坐标
 sizer[2]:=Point(FBoundRect.right-SizerWidth,FBoundRect.Top);   //图形的右上坐标
 sizer[3]:=Point(FBoundRect.right-SizerWidth,FBoundRect.top+(FBoundRect.Bottom-FBoundRect.Top)div 2
                       -SizerWidth div 2);     //图形的右中坐标
 sizer[4]:=Point(FBoundRect.Right-SizerWidth,FBoundRect.Bottom-SizerWidth);//图形的右下坐标
 sizer[5]:=Point(FBoundRect.left+(FBoundRect.Right-BoundRect.left)div 2-SizerWidth div 2,
                  FBoundRect.Bottom-SizerWidth);  //图形的下中坐标
 sizer[6]:=Point(FBoundRect.left,FBoundRect.Bottom-SizerWidth);   //图形的左下坐标
 sizer[7]:=Point(FBoundRect.left,FBoundRect.Top+(FBoundRect.Bottom-FBoundRect.Top)div 2
                       -SizerWidth div 2);   //图形的左中坐标

   Brush:=CreateSolidBrush(clRed);    // 取得纯色画笔
   SelectObject(dc,Brush);      //选中对象作为特殊的设备上下文
 for i:=0 to 7 do
 begin
   rc:=Rect(Sizer[i].X ,Sizer[i].Y,Sizer[i].X+SizerWidth,Sizer[i].Y+SizerWidth);
   //FillRect(dc,rc,BRUSH);
   FillRect(dc,rc,Brush);
 end;
   deleteObject(Brush);          //删除
end;

function TRectangle.HitTest(Pnt: TPoint): Boolean;
begin
  inherited HitTest(Pnt);
  //;
  if PtInRect(FBoundRect,Pnt) then   //判断某一坐标是否在某一特殊区域
  begin
    FSelected:=true;
  end
  else
  begin
    FSelected:=false;
  end;
  result:=FSelected;
end;

function TRectangle.Move(const Xoffset, YOffset: integer): Boolean;
begin
   inherited Move(Xoffset, YOffset);
   result:=true;
end;

procedure TRectangle.Paint(ACanvas:HDC);
var
  pen:HPEN;
  SolidBrush:HBRUSH;
  rgn:HRGN;  //区域句柄
begin
     rgn:=0;
    pen:=CreatePen(0,LineWidth,LineColor);   //创建画笔
    SolidBrush:=CreateSolidBrush(Color);     //创建刷子
    SelectObject(aCanvas,SolidBrush);
    SelectObject(aCanvas,pen);
    if RoundVal<=0then RoundVal:=0;
    RoundRect(aCanvas,FHeadPnt.x,FHeadPnt.y,FEndPnt.X,FEndPnt.y,RoundVal,RoundVal);

    deleteObject(pen);
    deleteObject(SolidBrush);
    DeleteObject(rgn);
     DrawCaption(aCanvas);
    DrawSizer(seSLine,aCanvas);   //画图形边界的红色标识

end;

function TRectangle.ReSizeTest(const Pnt: TPoint): TSizerType;
var
  left,top,halfw,halfh,right,bottom:integer;
  rc:TRect;
begin
 inherited ResizeTest(pnt);
    // none outside shape;
    if not PtInRect(FBoundRect,pnt) then     //判坐标是否在某一区域
    begin
     Result:=sTypeNone;
     exit;
    end else
  Result:=sTypeDrag;

   left:=FBoundRect.left;
   top:=FBoundRect.top;
   halfw:=FBoundRect.left+(FBoundRect.Right-FBoundRect.Left)div 2-SizerWidth div 2;  //上中坐标
   halfh:=FBoundRect.top+(FBoundRect.Bottom-FBoundRect.Top)div 2-SizerWidth div 2;   //左中坐标
   right:=FBoundRect.right-SizerWidth;
   bottom:=FBoundRect.bottom-SizerWidth;
   //0
   rc:=Rect(left,top,left+SizerWidth,top+SizerWidth);  //取得区域
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType0;
     exit;
   end;
   //1
   rc:=Rect(halfw,top,halfw+SizerWidth,top+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType1;
     exit;
   end;
   //2
    rc:=Rect(right,top,right+SizerWidth,top+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType2;
     exit;
   end;
   //3
    rc:=Rect(right,halfh,right+SizerWidth,halfh+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType3;
     exit;
   end;
  //4
    rc:=Rect(right,bottom,right+SizerWidth,bottom+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType4;
     exit;
   end;
   //5
    rc:=Rect(halfw,bottom,halfw+SizerWidth,bottom+SizerWidth);
   if PtInRect(rc,Pnt) then
   begin
     Result:=sType5;
     exit;
   end;
  //6