drwobj.~pas

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

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;
  fIsVisible := 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));
  stream.Write(FPenStyle,sizeOf(TPenStyle));
  stream.Write(FName,sizeOf(TDrwName));
  stream.Write(FInfo,sizeOf(TDrwName));
  stream.Write(fVisible,sizeOf(fVisible));

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

procedure TDrawObject.SetPenColor(value: TColor);
begin
  if assigned(self) then
  FPenColor:=value;
end;

procedure TDrawObject.setPenStyle(value: TPenStyle);
begin
  if FPenStyle<>value then
  FPenStyle:=value;
end;

procedure TDrawObject.SetPenWidth(value: integer);
begin
  if Assigned(self) then
  FPenWidth:=value;
end;

{ TDrawLine }

procedure TDrawLine.addXY(x, y, flags: integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);
begin
  if flags=-1 then
  begin
    m_x1:=round(m_x1*zoomScaleX+x);
    m_y1:=round(m_y1*zoomScaleY+y);
    m_x2:=round(m_x2*zoomScaleX+x);
    m_y2:=round(m_y2*zoomScaleY+y);
  end;
  if flags<>-1 then
  begin
    m_x1:=round(fRect.Left*zoomScaleX);
    m_y1:=round(fRect.Top*zoomScaleY);
    m_x2:=round(fRect.Right*zoomScaleX);
    m_y2:=round(fRect.Bottom*zoomScaleY);
  end;
end;

constructor TDrawLine.create;
begin
  inherited;
  m_x1:=0;m_x2:=0;
  m_y1:=0;m_y2:=0;
  m_oldx:=0;m_oldy:=0;
  fArrowStyle:=arNone;
end;

procedure TDrawLine.Draw(drwCanvas: TCanvas);
var
  oldPenMode:TPenMode;
  oldPenWidth:integer;
  oldPenStyle:TPenStyle;
  oldPenColor:TColor;
begin
  if not Visible then
  exit;
  oldPenMode:=drwCanvas.Pen.Mode;
  oldPenWidth:=drwCanvas.Pen.Width ;
  oldPenStyle:=drwCanvas.Pen.Style;
  oldPenColor:=drwCanvas.Pen.Color;
  drwCanvas.Pen.Mode:=pmCopy;
  drwCanvas.Pen.Width :=getPenWidth;
  drwCanvas.Pen.Style :=getPenStyle;
  drwCanvas.Pen.Color :=getPenColor;

  drwCanvas.MoveTo(round(m_x1*fZoomScale),round(m_y1*fZoomScale));{移动绘图点到第一点}
  drwCanvas.LineTo(round(m_x2*fZoomScale),round(m_y2*fZoomScale));{绘制直线}
  if fArrowStyle<>arNone then
  drawArrow(drwCanvas,Point(round(m_x1*fZoomScale),round(m_y1*fZoomScale)),Point(round(m_x2*fZoomScale),round(m_y2*fZoomScale)),fArrowStyle);
  drwCanvas.Pen.Mode :=oldPenMode;
  drwCanvas.Pen.Width :=oldPenWidth;
  drwCanvas.Pen.Style :=oldPenStyle;
  drwCanvas.Pen.Color :=oldPenColor;
  if FSelected then
  HotPoints(drwCanvas);
end;

procedure TDrawLine.drawArrow(drwCanvas: TCanvas; m_One, m_Two: TPoint;
  flags: TArrowStyle);
const
  Par=10.0;
var
  slopy,cosy,siny:single;
  polyPoint:array [0..2] of TPoint;
procedure draw_Arrow(drwCanvas:TCanvas;Const m_aPoints:array of TPoint;isFill:boolean);
var
  oldBrushColor:TColor;
begin
  oldBrushColor:=drwCanvas.Brush.Color;
  drwCanvas.Brush.Color :=GetPenColor;
  if isFill then
     drwCanvas.Polygon(m_aPoints)
  else
  begin
    drwCanvas.MoveTo(m_aPoints[1].X,m_aPoints[1].Y);
    drwCanvas.LineTo(m_aPoints[0].X,m_aPoints[0].Y);
    drwCanvas.LineTo(m_aPoints[2].X,m_aPoints[2].Y);
  end;
  drwCanvas.Brush.Color :=oldBrushColor;
end;
begin
  slopy:=ArcTan2((m_one.Y -m_Two.Y),(m_One.X-m_Two.X));
  cosy:=cos(slopy);
  siny:=sin(slopy);
  case flags of
    arLeft,arFillLeft:begin
      polyPoint[0]:=m_One;
      polyPoint[1].X :=m_One.X+round(-Par*cosy-Par/2.0*siny);
      polyPoint[1].Y :=m_One.Y +round(-Par*siny+Par/2.0*cosy);
      polyPoint[2].X :=m_One.X +round(-Par*cosy+Par/2.0*siny);
      polyPoint[2].Y :=m_One.Y +round(-Par*siny-Par/2.0*cosy);
      if flags=arLeft then
         draw_Arrow(drwCanvas,polyPoint,false)
      else
         draw_Arrow(drwCanvas,polyPoint,true);
      end;
    arRight,arFillRight:begin
      polyPoint[0]:=m_Two;
      polyPoint[1].X :=m_Two.X+round(Par*cosy-Par/2.0*siny);
      polyPoint[1].Y :=m_Two.Y +round(Par*siny+Par/2.0*cosy);
      polyPoint[2].X :=m_Two.X +round(Par*cosy+Par/2.0*siny);
      polyPoint[2].Y :=m_Two.Y +round(Par*siny-Par/2.0*cosy);
      if flags=arRight then
         draw_Arrow(drwCanvas,polyPoint,false)
      else
        draw_Arrow(drwCanvas,polyPoint,true);
      end;
    arBoth,arFillBoth:begin
      polyPoint[0]:=m_One;
      polyPoint[1].X :=m_One.X+round(-Par*cosy-Par/2.0*siny);
      polyPoint[1].Y :=m_One.Y +round(-Par*siny+Par/2.0*cosy);
      polyPoint[2].X :=m_One.X +round(-Par*cosy+Par/2.0*siny);
      polyPoint[2].Y :=m_One.Y +round(-Par*siny-Par/2.0*cosy);
      if flags=arBoth then
         draw_Arrow(drwCanvas,polyPoint,false)
      else
         draw_Arrow(drwCanvas,polyPoint,true);
      polyPoint[0]:=m_Two;
      polyPoint[1].X :=m_Two.X+round(Par*cosy-Par/2.0*siny);
      polyPoint[1].Y :=m_Two.Y +round(Par*siny+Par/2.0*cosy);
      polyPoint[2].X :=m_Two.X +round(Par*cosy+Par/2.0*siny);
      polyPoint[2].Y :=m_Two.Y +round(Par*siny-Par/2.0*cosy);
      if flags=arBoth then
         draw_Arrow(drwCanvas,polyPoint,false)
      else
         draw_Arrow(drwCanvas,polyPoint,true);
      end;
  end;
end;

function TDrawLine.getMaxPoint: TPoint;
begin
  if m_x1>m_x2 then
     result.X :=m_x1