drwobj.pas

delphi语言开发的矢量图形处理对象

unit DrwObj;

interface
uses
  windows,Messages, SysUtils, Variants, Classes,Graphics,Types,DrwBaseType,
  math,jpeg,StrUtils;
type
  TdrwTool=class of TDrawobject;
  TDrawObject=class
    private
      FPenColor:Tcolor;
      FStyle:TDrwStyle;
      FPenWidth:integer;
      FPenStyle:TPenStyle;
      fVisible:boolean;
      fGradient:boolean;
      fGradientStyle:TGradientStyle;
      fBeginColor:TColor;
      fEndColor:TColor;
      fTag:integer;
      fIsVisible:boolean;
    protected
      FInfo:TDrwName;
      FName:TDrwName;
      FZoomScale:single;
      FSelected:boolean;
      function  getPenStyle:TPenStyle;
      procedure setPenStyle(value:TPenStyle);
      procedure SetPenColor(value:TColor);
      function  GetPenColor:TColor;
      procedure SetPenWidth(value:integer);
      function  GetPenWidth:integer;
      procedure HotPoint(drwCanvas:TCanvas;x,y:longint);{设置热点}
      function  AtPoint(x,y,x1,y1:longint):boolean;overload;{判断两点之间的位置关系}
      function AtPoint(x,y:integer;p:TPoint):boolean;overload;
      function  AtLine(x,y,x1,y1,x2,y2:longint):Boolean;{判断点和直线的位置关系}
      function  atRect(x,y,x1,y1,x2,y2:longint):Boolean;
      function  isEqual(t1,t2:TPoint):boolean;
      procedure NormalRect(var t:TRect);{进行方向正常化}
      //procedure RectNormal(t1,t2:TPoint);
    public
      property PenColor:tcolor read FPenColor write SetPenColor;
      property mSelected:boolean read FSelected write FSelected;
      property Style:TDrwStyle read FStyle write FStyle;
      property Name:TDrwName read FName write FName;
      property Info:TDrwName read FInfo write FInfo;
      property PenWidth:integer read GetPenWidth write SetPenWidth;
      property PenStyle:TPenStyle read getPenStyle write SetPenStyle;
      property ZoomScale:single read FZoomScale write FZoomScale;
      property Visible:boolean read fVisible write fVisible;
      property IsVisible:boolean read fIsVisible write fIsVisible;
      
      //**************gradient fill atrr***********************
      property Gradient:boolean read fGradient write fGradient;
      property GradientStyle:TGradientStyle read fGradientStyle write fGradientStyle;
      property BeginColor:TColor read fBeginColor write fBeginColor;
      property EndColor:TColor read fEndColor write fEndColor;

      property Tag:integer read fTag write fTag default 0;
      constructor create;virtual;
      procedure Selected(drwCanvas:TCanvas;select:boolean);virtual;abstract;{绘制/取消选择标志}
      procedure Draw(drwCanvas:TCanvas);virtual;abstract;{绘制图元}
      procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);virtual;abstract;{以指定方式移动图元}
      function SelectAt(x,y:longint):integer;virtual;abstract;{判断是否选择图元}
      function NewPoint(x,y:longint):integer;virtual;abstract;{图形对象的第一点坐标，如果返回false则绘图结束}
      procedure HotPoints(drwCanvas:TCanvas);virtual;abstract;{绘制热点}
      procedure Save(stream:TStream);virtual;{保存文件}
      procedure Load(stream:TStream);virtual;{获取文件}
      function IsValid:boolean;virtual;abstract;//判断图形是否合法
      {仅供分组使用}
      function getMinPoint:TPoint;virtual;abstract;
      function getMaxPoint:TPoint;virtual;abstract;
      procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);virtual;abstract;{增加XY的分量}
      procedure setOrg;virtual;abstract;//设置分组的缩放点
    end;
    TDrawLine=class(TDrawObject)
      private
        m_x1,m_y1,m_x2,m_y2:longint;
        m_oldx,m_oldy:longint;
        fArrowStyle:TArrowStyle;
        fRect:TRect;
        procedure drawArrow(drwCanvas:TCanvas;m_One,m_Two:TPoint;flags:TArrowStyle);
      public
        constructor create;override;
        procedure Selected(drwCanvas:TCanvas;select:boolean);override;
        procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
        procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
        function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
        function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
        procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
        procedure Save(stream:TStream);override;{保存文件}
        procedure Load(stream:TStream);override;{获取文件}
        function IsValid:boolean;override;
        property ArrowStyle:TArrowStyle read fArrowStyle write fArrowStyle default arNone;
       {仅供分组使用}
        function getMinPoint:TPoint;override;
        function getMaxPoint:TPoint;override;
        procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;
        procedure setOrg;override;//设置分组的缩放点

     end;
     TDrawRect=class(TDrawObject)
        private
          FIsRoundRect:boolean;
        protected
          m_x1,m_x2,m_y1,m_y2:longint;
          m_oldx,m_oldy:longint;
          FBrushColor:TColor;
          FBrushStyle:TBrushStyle;
          fRect:TRect;
        public
          property BrushColor:TColor read FBrushColor write FBrushColor;
          property BrushStyle:TBrushStyle read FBrushStyle write FBrushStyle;
          property IsRoundRect:Boolean read FIsRoundRect write FIsRoundRect;
          constructor create;override;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;
          procedure Action_X; //垂直翻转
          procedure Action_Y; //水平翻转
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;
          procedure setOrg;override;//设置分组的缩放点
     end;
     TDrawSanJiao=class(TDrawRect)
        public
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
     end;
     TDrawEllipse=class(TDrawObject)
        private
          m_x1,m_x2,m_y1,m_y2:longint;
          m_oldx,m_oldy:longint;
          FBrushStyle:TBrushStyle;
          FBrushColor:TColor;
          fRect:TRect;
          function AtCurve(x,y:longint):boolean;
        public
          property BrushColor:TColor read FBrushColor write FBrushColor;
          property BrushStyle:TBrushStyle read FBrushStyle write FBrushStyle;
          constructor create;override;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;{增加XY的分量}
          procedure setOrg;override;//设置分组的缩放点

     end;
     TDrawCircle=class(TDrawObject)
        private
          m_x2,m_y2,m_x1,m_y1:longint;
          m_oldx,m_oldy:longint;
          FBrushStyle:TBrushStyle;
          FBrushColor:TColor;
          fRect:TRect;
        public
          property BrushColor:TColor read FBrushColor write FBrushColor;
          property BrushStyle:TBrushStyle read FBrushStyle write FBrushStyle;
          constructor create;override;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;//判断图形是否合法
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;{增加XY的分量}
          procedure setOrg;override;//设置分组的缩放点
     end;
     TDrawPline=class(TDrawObject)
        protected
          m_aPoints:TDrwPline;
          m_oldx,m_oldy:longint;
          Fm_number:longint;
          old_aPoints:TDrwPline;
        public
          property m_number:longint read Fm_number write Fm_number;
          constructor create;override;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          function AddPoint(x,y:longint):integer;virtual;{增加下一个点}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;
          procedure setOrg;override;//设置分组的缩放点

     end;
     TDrawPolygon=class(TDrawPline)
        private
          fm_bIsEdit:boolean;
          FBrushStyle:TBrushStyle;
          FBrushColor:TColor;
        public
          property isEdit:boolean read fm_bIsEdit write fm_bIsEdit;
          property BrushStyle:TBrushStyle read FBrushStyle write FBrushStyle;
          property BrushColor:TColor read FBrushColor write FBrushColor;
          constructor create;override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
     end;
     TDrawText=class(TDrawObject)
        private
          m_x1,m_x2,m_y1,m_y2:longint;
          m_oldx,m_oldy:longint;
          isFirst:boolean;
          Ffont:TFont;
          fBold:boolean;
          fItalic:boolean;
          fUnderLine:boolean;
          fRect:TRect;
          procedure setFont(value:TFont);
          procedure setBold(value:boolean);
          procedure setItaic(value:boolean);
          procedure setUnderLine(value:boolean);
        public
          constructor create;override;
          property isBold:boolean read fBold write setBold;
          property isItaic:boolean read fItalic write setItaic;
          property isUnderLine:boolean read fUnderLine write setUnderLine;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;
          destructor Destroy;override;
          property Font:TFont read Ffont write setFont;
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;
          procedure setOrg;override;//设置分组的缩放点

     end;

     TDrawImage=class(TDrawObject)
        private
          m_x1,m_x2,m_y1,m_y2:longint;
          m_oldx,m_oldy:longint;
          ramBitmap:TBitmap;
          isLoad:boolean;
          fRect:TRect;
        public
          constructor create;override;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function IsValid:boolean;override;
          procedure LoadBitmap(bitFile:string);
          destructor Destroy;override;
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;{增加XY的分量}
          procedure setOrg;override;//设置分组的缩放点

     end;

     TDrawGroup=class(TDrawObject)
        private
          m_x1,m_x2,m_y1,m_y2:longint;
          m_oldx,m_oldy:longint;
          fList:TList;{存储各图元对象}
          fGroup:TList;{存储组中包含的组对象}
          offList:TList;
          onList:TList;
          isFirst:Boolean;
          fRect:TRect;
          fBrushColor:TColor;
          procedure createObjects(drwRef: TDrwTool;tmpMode:TDrwStyle;f:TStream);
          function Get(index:integer):Pointer;
          function GetObjGroup(index:integer):Pointer;
          function GetCount:integer;
          procedure SetDeadXY(incX,incY:longint);//设置成绝对坐标或相对坐标
          function getGroupObj:integer;
          procedure setGroupBrushColor(value:TColor);
        public
          constructor create;override;
          procedure getRect;{获取矩形的两点坐标}
          procedure setAllDeadXY;
          procedure setAllVersus;
          procedure Selected(drwCanvas:TCanvas;select:boolean);override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
          function  SelectAt(x,y:longint):integer;override;{判断是否选择图元}
          procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          destructor Destroy;override;
          procedure addObject(value:Pointer);
          procedure DeleteObjects;
          property Objects[index:integer]:Pointer read Get;
          property ObjGroups[index:integer]:Pointer read GetObjGroup;
          property CountObjGroups:integer read getGroupObj;
          property count:integer read GetCount;
          property BrushColor:TColor read fBrushColor write setGroupBrushColor;
          procedure ResetPenColor;
          procedure ResetPenWidth;
          {仅供分组使用}
          function getMinPoint:TPoint;override;
          function getMaxPoint:TPoint;override;
          procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;{增加XY的分量}
          procedure setOrg;override;//设置分组的缩放点
          procedure retSetObjOrg;//设置每个图元的相对位置

          procedure setObjVisible(flag:Boolean);
          procedure UpOnOffList;
          procedure turnOn;
          procedure turnOff;
     end;
     TDrawFreeLine=class(TDrawPLine)
        private
          fBrushColor:TColor;
          fBrushStyle:TBrushStyle;
        public
          property BrushStyle:TBrushStyle read FBrushStyle write FBrushStyle;
          property BrushColor:TColor read FBrushColor write FBrushColor;
          constructor create;override;
          procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
          procedure Save(stream:TStream);override;{保存文件}
          procedure Load(stream:TStream);override;{获取文件}
          function  AddPoint(x, y: Integer): integer;override;
     end;
     TDrawArc=class(TDrawObject)
      private
        m_x1,m_y1,m_x2,m_y2:longint;
        m_oldx,m_oldy:longint;
        ArcStartPos:TPoint;
        ArcEndPos:TPoint;
        fRect:TRect;
        bFirst:boolean;
      public
        constructor create;override;
        procedure Selected(drwCanvas:TCanvas;select:boolean);override;
        procedure Draw(drwCanvas:TCanvas);override;{绘制图元}
        procedure MoveAt(drwCanvas:TCanvas;flags:integer;x,y:longint);override;{以指定方式移动图元}
        function SelectAt(x,y:longint):integer;override;{判断是否选择图元}
        function NewPoint(x,y:longint):integer;override;{图形对象的第一点坐标，如果返回false则绘图结束}
        procedure HotPoints(drwCanvas:TCanvas);override;{绘制热点}
        procedure Save(stream:TStream);override;{保存文件}
        procedure Load(stream:TStream);override;{获取文件}
        function IsValid:boolean;override;
       {仅供分组使用}
        function getMinPoint:TPoint;override;
        function getMaxPoint:TPoint;override;
        procedure addXY(x,y:longint;flags:integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);override;
        procedure setOrg;override;//设置分组的缩放点

     end;

     {管理图元库的类}
     TLibManage=class
       private
         fLibName:string;
         fLibObjects:TStringList;
         function getObjCount:integer;
       public
         constructor Create;virtual;
         destructor Destroy;override;
         procedure clear;
         procedure delete(objName:string);
         function GetShapeName(index:integer):string;
         procedure getShapeByName(sName:string;var drw_Group:TDrawGroup);
         function  saveShapeByName(sName:string;drw_Group:TDrawGroup):integer;
         procedure loadFromFile(fileName:string);
         procedure saveToFile(fileName:string);
         procedure save;
         procedure setObjName(index:integer;objName:string);
         procedure getIconByName(shapeName:string;const bmp:TBitmap);
         property LibFileName:string read fLibName write fLibName;
         property Count:integer read getObjCount;
       end;