drwobj.~pas

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

          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;

    TDrawRectGraph=class(TDrawObject)
      private
        m_x1,m_y1,m_x2,m_y2:longint;
        m_oldx,m_oldy:longint;
        GroupList:array of TDotData;//存储棒图数据指针链
        fDotCount:integer;
        fGroupCount:integer;
        fMaxValue:double;
        fMinValue:double;
        fStep:integer;
        fxyColor:TColor;//坐标轴颜色
        fGridShow:boolean;
        procedure drawXY(drwCanvas:TCanvas);
        function getMemberData(index:integer):TDotData;//获取棒图数据成员
      public
        property xyColor:TColor read fxyColor write fxyColor default clWhite;
        property GridShow:boolean read fGridShow write fGridShow default true;
        property MaxValue:double read fMaxValue write fMaxValue;
        property MinValue:double read fMinValue write fMinValue;
        property DotCount:integer read fDotCount write fDotCount default 3;
        property GroupCount:integer read fGroupCount write fGroupCount default 3;
        property Step:integer read fStep write fStep default 10;
        property GroupMember[index:integer]:TDotData read getMemberData;
        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 ReRandomData;//刷新随机数据的填充
        //改变采集量的采集值
        function setRealData(gather_Code:integer;realValue:double):integer;
        //设置采集量的采集号
        procedure setGatherCode(
        gatherCodeArry:array of integer;gatherNameArry:array of String);
      end;

    TDrawLineGraph=class(TDrawObject)
      private
        m_x1,m_y1,m_x2,m_y2:longint;
        m_oldx,m_oldy:longint;
        fMaxValue:double;//最大值
        fMinValue:double;//最小值
        fStep:integer;  //刻度大小
        fxyColor:TColor;//坐标轴颜色
        fGridShow:boolean;//网格的可见性
        fLineCount:integer;//曲线的个数
        lineRealData:TLineArray;//存储对应曲线数据的数组
        realDotCount:array of integer;//存储当前实时数据的个数
        lineParam:array of TDotLine;//存储曲线参数的数组
        procedure drawXY(drwCanvas:TCanvas);
        procedure setLineCount(iCount:integer);//设置曲线的个数,重新分配空间
        function getLineParam(iIndex:integer):TDotLine;
        procedure setLineParam(iIndex:integer;newParam:TDotLine);
        procedure fillRandomParam;//随机填充曲线参数
        function getLineNum(iCode:integer):integer;//根据采集号获取对应曲线编号
      public
        property xyColor:TColor read fxyColor write fxyColor default clWhite;
        property GridShow:boolean read fGridShow write fGridShow default true;
        property MaxValue:double read fMaxValue write fMaxValue;
        property MinValue:double read fMinValue write fMinValue;
        property Step:integer read fStep write fStep default 10;
        property LineCount:integer read fLineCount write setLineCount default 1;
        property LineParams[iIndex:integer]:TDotLine read getLineParam write setLineParam;
        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 fillRandomData;
        //增加对应采集号的遥测数据点
        function addRealDot(iGatherCode:integer;newReal:TLineData):boolean;
        //删除对应采集号的指定点的数据
        function deleteDot(iGatherCode:integer;iIndex:integer):integer;
        //获得对应采集号的实时数据的个数
        function getCount(iGatherCode:integer):integer;
        //根据曲线名称获取数据的最大值、最小值对应的数据结构
        function getMaxData(curveLineName:string):TLineData;
        function getMinData(curveLineName:string):TLineData;
        function getAvgValue(curveLineName:string):double;//取得平均值
     end;

     {管理图元库的类}
     TLibManage=class
       private
         fLibName:string;
         fLibObjects:TStringList;
         function getObjCount:integer;
       public
         constructor Create;virtual;
         destructor Destroy;override;
         function GetShapeName(index:integer):string;
         procedure getShapeByName(sName:string;var drw_Group:TDrawGroup);
         procedure loadFromFile(fileName:string);
         procedure saveToFile(fileName:string);
         procedure getIconByName(shapeName:string;const bmp:TBitmap);
         property LibFileName:string read fLibName;
         property Count:integer read getObjCount;
       end;
implementation
var
  f:array[0..2] of array[0..2] of double;
{旋转变换}
procedure Rotate(theta:double);
var
  th:double;
begin
  th:=theta/180*Pi;
  f[0,0]:=Cos(th);f[0,1]:=Sin(th);f[0,2]:=0.0;
  f[0,0]:=-Sin(th);f[1,1]:=Cos(th);f[1,2]:=0.0;
  f[2,0]:=0.0;f[2,1]:=0.0;f[2,2]:=1.0;
end;
{x轴对称变换}
procedure taisho_x;
begin
  f[0,0]:=1.0;f[0,1]:=0.0;f[0,2]:=0.0;
  f[1,0]:=0.0;f[1,1]:=-1.0;f[1,2]:=0.0;
  f[2,0]:=0.0;f[2,1]:=0.0;f[2,2]:=1.0;
end;
{y轴对称变换}
procedure taisho_y;
begin
  f[0,0]:=-1.0;f[0,1]:=0.0;f[0,2]:=0.0;
  f[1,0]:=0.0;f[1,1]:=1.0;f[1,2]:=0.0;
  f[2,0]:=0.0;f[2,1]:=0.0;f[2,2]:=1.0;
end;
{经过变换后的坐标计算}
function affinex(x,y,d:longint):longint;
var
  xx:double;
begin
  xx:=x*f[0,0]+y*f[1,0]+d*f[2,0];
  result:=Round(xx);
end;
function IsEqualPoint(const p1,p2:TPoint):boolean;
begin
  result := (P1.X=p2.X) and (p1.Y = p2.Y);
end;
function affiney(x,y,d:longint):longint;
var
  yy:double;
begin
  yy:=x*f[0,1]+y*f[1,1]+d*f[2,1];
  result:=Round(yy);
end;

function PointToCirclePoint(StartPoint:TPoint;EndPoint:TPoint;APoint:TPoint): TPoint;
//计算点(X,Y)与圆心的连线同圆的交点
var
  radius: Integer; //Y方向的半径
  dX, dY: Integer;
  asp: Single; //细长比
  centerX, centerY: Integer; //圆心坐标
  tempAngle: Single; //夹角
  circlePoint: TPoint; //交点
  pp:array[1..3] of TPoint;
begin
  //调整数值,确保circleright>=circleLeft,circlebottom>=circletop
  pp[1].X := Min(StartPoint.X, EndPoint.X);
  pp[1].Y := Min(StartPoint.Y, EndPoint.Y);
  pp[2].X := Max(StartPoint.X, EndPoint.X);
  pp[2].Y := Max(StartPoint.Y, EndPoint.Y);
  //计算细长比
  asp := ((pp[2].Y - pp[1].y) / (pp[2].X - pp[1].x));
  radius := (pp[2].Y - pp[1].Y) div 2; //方向半径
  centerX := (pp[2].X + pp[1].X) div 2; //  圆心
  centerY := (pp[2].Y + pp[1].Y) div 2;
  //计算与圆心连线同水平线的夹角
  dX := APoint.X - centerX;
  dY := APoint.Y - centerY;
  if (Abs(dX) > 0.000000000001) then //'终点与圆心的连线同X 轴的夹角不为90度
    tempAngle := Abs(ArcTan(dY / (dX * asp))) //角度的绝对值
  else
    tempAngle := PI / 2; //终点与圆心的连线同X 轴的夹角为90度
    //确定角度的正负，及大小
  if (dX >= 0) and (dY <= 0) then
    tempAngle := tempAngle
  else if (dX <= 0) and (dY <= 0) then
    tempAngle := PI - tempAngle
  else if (dX <= 0) and (dY >= 0) then
    tempAngle := -PI + tempAngle
  else
    tempAngle := -tempAngle;
  circlePoint.X := Round(centerX + radius * Cos(tempAngle) / asp);
  circlePoint.Y := Round(centerY - radius * Sin(tempAngle));
  Result := circlePoint;
end;

{ TDrawObject }

function TDrawObject.AtLine(x, y, x1, y1, x2, y2: Integer): Boolean;
var
  A,B,C,D:single;
begin
  A:=y1-y2;
  B:=x2-x1;
  C:=x1*y2-x2*y1;
  d:=(A*x+B*y+C)*(A*x+B*y+C)/(A*A+B*B);
  result:=(d<MAXOFFSET) AND (((X1-X)*(X2-X)<0) OR ((Y1-Y)*(Y2-Y)<0));
end;

function TDrawObject.AtPoint(x, y, x1, y1: Integer): boolean;
var
  d:Double;
begin
  d:=(x1-x)*(x1-x)+(y1-y)*(y1-y);
  d:=sqrt(d);
  result:=(d<MAXOFFSET);
end;

function TDrawObject.AtPoint(x, y:integer;p: TPoint): boolean;
begin
  result := self.AtPoint(x,y,p.X,p.Y);
end;

function TDrawObject.atRect(x, y, x1, y1, x2, y2: Integer): Boolean;
begin
  result:=((x-x1)*(x-x2)<0) and ((y-y1)*(y-y2)<0);
end;

constructor TDrawObject.create;
begin
  FSelected:=false;
  FPenWidth:=1;
  FPenColor:=clBlack;
  FPenStyle:=psSolid;
  FName:='';
  FInfo:='';
  FZoomScale:=1;
  fVisible:=true;
  fGradient:=false;
  fBeginColor:=clWhite;
  fEndColor:=clBlack;
  fGradientStyle:=jgdUp;
end;

function TDrawObject.GetPenColor: TColor;
begin
  if assigned(self) then
  result:=FPenColor;
end;

function TDrawObject.getPenStyle: TPenStyle;
begin
  if Assigned(self) then
  result:=FPenStyle;
end;

function TDrawObject.GetPenWidth: integer;
begin
  if Assigned(self) then
  result:=FPenWidth;
end;

procedure TDrawObject.HotPoint(drwCanvas: TCanvas; x, y: Integer);
var
  OldPenMode:TPenMode;
  oldBrushStyle:TBrushStyle;
  oldPenColor,oldBrushColor:Tcolor;
  oldPenWidth:Integer;
  oldPenStyle:TPenStyle;
begin
  oldBrushStyle:=drwCanvas.Brush.Style;
  oldBrushColor:=drwCanvas.Brush.Color;
  oldPenMode:=drwCanvas.Pen.Mode;
  oldPenColor:=drwCanvas.Pen.Color;
  oldPenWidth:=drwCanvas.Pen.Width;
  oldPenStyle:=drwCanvas.Pen.Style;

  drwCanvas.Pen.Mode :=pmNotXor;
  drwCanvas.Pen.Style :=psSolid;
  drwCanvas.Pen.Color :=clRed;
  drwCanvas.Brush.Color :=clRed;
  drwCanvas.Brush.Style :=bsSolid;
  drwCanvas.Pen.Width :=1;

  drwCanvas.Rectangle(x-2,y-2,x+2,y+2);


  drwCanvas.Brush.Style :=oldBrushStyle;
  drwCanvas.Brush.Color :=oldBrushColor;
  drwCanvas.Pen.Mode :=oldPenMode;
  drwCanvas.Pen.Color :=oldPenColor;
  drwCanvas.Pen.Width :=oldPenWidth;
  drwCanvas.Pen.Style :=oldPenStyle;
end;

function TDrawObject.isEqual(t1, t2:TPoint): boolean;
begin
  if (t1.X =t2.X) and (t1.Y =t2.Y) then
    result:=true
  else
    result:=false;
end;

procedure TDrawObject.Load(stream: TStream);
begin
  stream.Read(FPenColor,sizeOf(TColor));
  stream.Read(FPenWidth,sizeOf(Integer));
  stream.Read(FPenStyle,sizeOf(TPenStyle));
  stream.Read(FName,sizeOf(TDrwName));
  stream.Read(FInfo,sizeOf(TDrwName));
  stream.Read(fVisible,sizeOf(fVisible));

  //*********2004.4.9. add gradient fill ******************
  stream.Read(fGradient,sizeOf(fGradient));
  stream.Read(fGradientStyle,sizeOf(fGradientStyle));
  stream.Read(fBeginColor,sizeOf(fBeginColor));
  stream.Read(fEndColor,sizeOf(fEndColor)); 

end;

procedure TDrawObject.NormalRect(var t: TRect);
var
  tmp1,tmp2:TPoint;
begin
  tmp1:=t.TopLeft;
  tmp2:=t.BottomRight ;
  if t.Left >t.Right then
  begin
     if t.Top <t.Bottom then
     begin
       t.Left :=t.Right;
       t.Right :=tmp1.X;
     end
     else
     begin
       t.TopLeft :=tmp2;
       t.BottomRight :=tmp1;
     end;
  end
  else
  begin
    if t.Top >T.Bottom then
    begin
      t.Top :=t.Bottom;
      t.Bottom :=tmp1.Y;
    end
  end;
end;

procedure TDrawObject.Save(stream: TStream);
begin
  stream.Write(FStyle,sizeOf(TDrwStyle));
  stream.Write(FPenColor,sizeof(TColor));
  stream.Write(FPenWidth,sizeof(integer));