drwobj.pas

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

  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
  else
     result.X :=m_x2;
  if m_y1>m_y2 then
     result.Y :=m_y1
  else
     result.Y :=m_y2;
end;

function TDrawLine.getMinPoint: TPoint;
begin
  if m_x1<m_x2 then
     result.X :=m_x1
  else
     result.X :=m_x2;
  if m_y1<m_y2 then
     result.Y :=m_y1
  else
     result.Y :=m_y2;
end;

procedure TDrawLine.HotPoints(drwCanvas: TCanvas);
begin
  HotPoint(drwCanvas,round(m_x1*fZoomScale),round(m_y1*fZoomScale));
  HotPoint(drwCanvas,round(m_x2*fZoomScale),round(m_y2*fZoomScale));
end;

function TDrawLine.IsValid: boolean;
var
  t1,t2:TPoint;
begin
  t1:=Point(m_x1,m_y1);
  t2:=Point(m_x2,m_y2);
  result:=not IsEqual(t1,t2);
end;

procedure TDrawLine.Load(stream: TStream);
begin
  inherited;
  stream.Read(m_x1,sizeOf(longint));
  stream.Read(m_y1,sizeOf(longint));
  stream.Read(m_x2,sizeOf(longint));
  stream.Read(m_y2,sizeOf(longint));
  stream.Read(fArrowStyle,sizeOf(TArrowStyle));
end;

procedure TDrawLine.MoveAt(drwCanvas: TCanvas; flags, x, y: Integer);
var
  oldPenMode:TPenMode;
  oldpenWidth:integer;
  oldpenStyle:TPenStyle;
  oldPenColor:TColor;
begin
  oldPenMode:=drwCanvas.Pen.Mode;
  oldpenWidth:=drwCanvas.Pen.Width ;
  oldpenStyle:=drwCanvas.Pen.Style;
  oldPenColor:=drwCanvas.Pen.Color;
  drwCanvas.Pen.Style:=getPenStyle;
  drwCanvas.Pen.width:=1;
  drwCanvas.Pen.Color :=clBlack;
  drwCanvas.Pen.Mode:=pmNotXor;
   if mSelected then
  HotPoints(drwCanvas);
  {删除原图形线}
{  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.MoveTo(round(m_x1*fZoomScale),round(m_y1*fZoomScale));
  drwCanvas.LineTo(round(m_x2*fZoomScale),round(m_y2*fZoomScale));

  {修改新图形坐标}
  if flags=1 then
  begin
    m_x1:=x;
    m_y1:=y;
  end
  else if flags=2 then
  begin
    m_x2:=x;
    m_y2:=y;
  end
  else if flags=-1 then
  begin
    m_x1:=m_x1+x-m_oldx;
    m_y1:=m_y1+y-m_oldy;
    m_x2:=m_x2+x-m_oldx;
    m_y2:=m_y2+y-m_oldy;
    m_oldx:=x;
    m_oldy:=y;
  end;
  {绘制新图形}
  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);}

  {如果以前选择了，设置热点}
  if mSelected then
  HotPoints(drwCanvas);
  {恢复画笔的默认模式}
  drwCanvas.Pen.Mode :=oldPenMode;
  drwCanvas.Pen.Width :=oldpenWidth;
  drwCanvas.Pen.Style :=oldpenStyle;
  drwCanvas.Pen.Color :=oldPenColor;
end;

function TDrawLine.NewPoint(x, y: Integer):integer;
begin
  m_x1:=x;m_x2:=x;
  m_y1:=y;m_y2:=y;
  result:=2;
end;

procedure TDrawLine.Save(stream: TStream);
begin
  inherited save(stream);
  stream.Write(m_x1,sizeOf(longint));
  stream.Write(m_y1,sizeOf(longint));
  stream.Write(m_x2,sizeOf(longint));
  stream.Write(m_y2,sizeOf(longint));
  stream.Write(fArrowStyle,sizeOf(TArrowStyle));
end;

function TDrawLine.SelectAt(x, y: Integer): integer;
begin
  if AtPoint(x,y,m_x1,m_y1) then
     result:=1
  else if AtPoint(x,y,m_x2,m_y2) then
     result:=2
  else if AtLine(x,y,m_x1,m_y1,m_x2,m_y2) then
  begin
     m_oldx:=x;
     m_oldy:=y;
     result:=-1;
  end
  else
     result:=0;
end;

procedure TDrawLine.Selected(drwCanvas: TCanvas; select: boolean);
begin
  if not Assigned(self) then
  exit;
  if select then
  begin
    if not mSelected then
    begin
      HotPoints(drwCanvas);
      mSelected:=true;
    end;
  end
  else
  begin
    if mSelected then
    begin
      HotPoints(drwCanvas);
      mSelected:=false;
    end;
  end;
end;

procedure TDrawLine.setOrg;
begin
  inherited;
  fRect:=Rect(m_x1,m_y1,m_x2,m_y2);
end;

{ TDrawRect }

procedure TDrawRect.Action_X;
var
  midY:longint;
begin
  midy:=m_y1;
  m_y1:=m_y2-2*(m_y2-m_y1);m_y2:=midY;
end;

procedure TDrawRect.Action_Y;
begin
  taisho_y;
  m_x1:=affinex(m_x1,m_y1,1);m_x2:=affinex(m_x2,m_y2,1);
  m_y1:=affiney(m_x1,m_y1,1);m_y2:=affinex(m_x2,m_y2,1);
end;

procedure TDrawRect.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 TDrawRect.create;
begin
  inherited;
  FIsRoundRect:=false;
  FBrushColor:=clSilver;
  FBrushStyle:=bsClear;
  m_x1:=0;m_x2:=0;
  m_y1:=0;m_y2:=0;
  m_oldx:=0;m_oldy:=0;
end;

procedure TDrawRect.Draw(drwCanvas: TCanvas);
var
  oldPenColor,oldBrushColor:TColor;
  oldPenWidth:integer;
  oldBrushStyle:TBrushStyle;
  oldPenStyle:TPenStyle;
  oldPenMode:TPenMode;
  t:TRect;
  rgn:HRgn;
begin
  if Not Visible then
  exit;
  oldPenColor:=drwCanvas.Pen.Color;
  oldBrushColor:=drwCanvas.Brush.Color;
  oldBrushStyle:=drwCanvas.Brush.Style;