drwobj.~pas

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

  m_y1:=y;m_y2:=y;
  result:=4;
end;

procedure TDrawRect.Save(stream: TStream);
begin
  inherited Save(stream);
  stream.Write(FIsRoundRect,sizeOf(Boolean));
  stream.Write(FBrushColor,SizeOf(TColor));
  stream.Write(FBrushStyle,sizeOf(TBrushStyle));
  stream.Write(m_x1,sizeOf(longint));
  stream.Write(m_y1,sizeOf(longint));
  stream.Write(m_x2,sizeOf(longint));
  stream.Write(m_y2,sizeOf(longint));  
end;

function TDrawRect.SelectAt(x, y: Integer): integer;
  function IsOverRect:boolean;
  const
    diff=4;
  var
    tempHrgn,tempHrgn2:HRGN;
    mrect:TRect;
  begin
    mrect := Rect(m_x1,m_y1,m_x2,m_y2);
    tempHrgn2 := CreateRectRgn(mRect.Left - diff, mRect.Top - diff, mRect.Right+ diff,
        mRect.Bottom + diff);
    tempHrgn := CreateRectRgn(mRect.Left + diff, mRect.Top + diff,mRect.Right - diff,
        mRect.Bottom - diff);
    CombineRGN(tempHrgn2, tempHrgn2, tempHrgn, RGN_DIFF);
    DeleteObject(tempHrgn);
    result := PtInRegion(tempHrgn2,x,y);
    deleteObject(TempHrgn2);
  end;
begin
  if AtPoint(x,y,m_x1,m_y1) then
     result:=1
  else if atPoint(x,y,m_x1,m_y2) then
     result:=2
  else if atPoint(x,y,m_x2,m_y1) then
     result:=3
  else if AtPoint(x,y,m_x2,m_y2) then
     result:=4
  else if IsOverRect then
  begin
     m_oldx:=x;m_oldy:=y;
     result:=-1
  end
  else
     result:=0;
end;

procedure TDrawRect.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 TDrawRect.setOrg;
begin
  inherited;
  fRect:=Rect(m_x1,m_y1,m_x2,m_y2);
end;

{ TDrawEllipse }

procedure TDrawEllipse.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;

function TDrawEllipse.AtCurve(x, y: Integer): boolean;
var
  fx1,fx2,fy1,fy2:single;
  a,b,c:single;
  cx,cy:single;
begin
  a:=(m_x1-m_x2)*0.5;{椭圆x轴长度}
  b:=(m_y1-m_y2)*0.5;{椭圆y轴长度}
  cx:=(m_x1+m_x2)*0.5;{椭圆中心x坐标}
  cy:=(m_y1+m_y2)*0.5;{椭圆中心点y坐标}
  if abs(a)>abs(b) then
  begin
    c:=sqrt(a*a-b*b);
    fx1:=cx-c;
    fx2:=cx+c;
    fy1:=cy;fy2:=cy;
  end
  else
  begin
    c:=sqrt(b*b-a*a);
    fx1:=cx;fx2:=cx;
    fy1:=cy-c;
    fy2:=cy+c;
    a:=b;
  end;
  b:=sqrt((fx1-x)*(fx1-x)+(fy1-y)*(fy1-y));{指定点到第一焦点的距离}
  b:=b+sqrt((fx2-x)*(fx2-x)+(fy2-y)*(fy2-y));{指定点到第二焦点的距离}
  a:=abs(2*a-b);{指定定点到两焦点的距离}
  result:=a<MAXOFFSET;
end;

constructor TDrawEllipse.create;
begin
  inherited;
  FBrushStyle:=bsClear;
  FBrushColor:=clSilver;
  m_x1:=0;m_y1:=0;
  m_x2:=0;m_y2:=0;
  m_oldx:=0;m_oldy:=0;
end;

procedure TDrawEllipse.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;
  oldPenWidth:=drwCanvas.Pen.Width;
  oldPenMode:=drwCanvas.Pen.Mode;
  oldPenStyle:=drwCanvas.Pen.Style;
  {设置画布新的设置}
  drwCanvas.Pen.Color:=GetPenColor;
  drwCanvas.Brush.Color :=FBrushColor;
  drwCanvas.Brush.Style :=FBrushStyle;
  drwCanvas.Pen.Width :=GetPenWidth;
  drwCanvas.Pen.Mode:=pmCopy;
  drwCanvas.Pen.Style :=getpenStyle;

  t.TopLeft:=Point(m_x1,m_y1);
  t.BottomRight:=Point(m_x2,m_y2);
  {进行方向正常化}
  NormalRect(t);
  m_x1:=t.Left;m_y1:=t.Top;
  m_x2:=t.Right;m_y2:=t.Bottom;

  //渐变填充
  t:=Rect(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
  if Gradient then
  begin
    drwCanvas.Brush.Style :=bsSolid;
    rgn := CreateEllipticRgn(t.Left,t.Top,t.Right,t.Bottom);
    SelectClipRgn(drwCanvas.handle,rgn);
    FillWithGradient(drwCanvas,beginColor,EndColor,GradientStyle,t);
    SelectClipRgn(drwCanvas.Handle,0);
    DeleteObject(rgn);
    drwCanvas.Brush.Style :=bsClear;
    drwCanvas.Ellipse(t.Left,t.Top,t.Right,t.Bottom);
  end
  else
  drwCanvas.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));

  {恢复画布的设置}
  drwCanvas.Pen.Color :=oldPenColor;
  drwCanvas.Pen.Width :=oldPenWidth;
  drwCanvas.Pen.Mode :=oldPenMode;
  drwCanvas.Brush.Color :=oldBrushColor;
  drwCanvas.Brush.Style :=oldBrushStyle;
  drwCanvas.Pen.Style :=oldPenStyle;
  if FSelected then
  HotPoints(drwCanvas);
end;

function TDrawEllipse.getMaxPoint: TPoint;
begin
  result:=Point(m_x2,m_y2);
end;

function TDrawEllipse.getMinPoint: TPoint;
begin
  result:=Point(m_x1,m_y1);
end;

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

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

procedure TDrawEllipse.Load(stream: TStream);
begin
  inherited;
  stream.Read(FBrushColor,sizeOf(TColor));
  stream.Read(FBrushStyle,sizeOf(TBrushStyle));
  stream.Read(m_x1,sizeOf(longint));
  stream.Read(m_y1,sizeOf(longint));
  stream.Read(m_x2,sizeOf(longint));
  stream.Read(m_y2,sizeOf(longint));
end;

procedure TDrawEllipse.MoveAt(drwCanvas: TCanvas; flags, x, y: Integer);
var
  oldPenColor:TColor;
  oldPenWidth:integer;
  oldBrushStyle:TBrushStyle;
  oldPenStyle:TPenStyle;
  oldPenMode:TPenMode;
begin
  if not Assigned(self) then exit;
  {如果原先设置的热点,则取消}
  if mSelected then
  HotPoints(drwCanvas);

  {保存画布的原先设置}
  oldPenColor:=drwCanvas.Pen.Color;
  oldBrushStyle:=drwCanvas.Brush.Style;
  oldPenWidth:=drwCanvas.Pen.Width;
  oldPenMode:=drwCanvas.Pen.Mode;
  oldPenStyle:=drwCanvas.Pen.Style;

  {设置新的画笔和画刷的属性}
  drwCanvas.Pen.Mode :=pmNotXor;
  drwCanvas.Pen.Width :=1;
  drwCanvas.Brush.Style :=bsClear;
  drwCanvas.Pen.Color :=clBlack;
  drwCanvas.Pen.Style :=getPenStyle;
  {首先删除椭圆}
  drwCanvas.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),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_x1:=x;
    m_y2:=y;
    end
  else if flags=3 then
    begin
    m_x2:=x;
    m_y1:=y;
    end
  else if flags=4 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.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
  {恢复画布的原先设置}
  drwCanvas.Pen.Color :=oldPenColor;
  drwCanvas.Pen.Width :=oldPenWidth;
  drwCanvas.Pen.Mode :=oldPenMode;
  drwCanvas.Brush.Style :=oldBrushStyle;
  drwCanvas.Pen.Style :=oldPenStyle;
  {如果原先设置的热点,则取消}
  if mSelected then
  HotPoints(drwCanvas);
end;

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

procedure TDrawEllipse.Save(stream: TStream);
begin
  inherited;
  stream.Write(FBrushColor,sizeOf(TColor));
  stream.Write(FBrushStyle,sizeOf(TBrushStyle));
  stream.Write(m_x1,sizeOf(longint));
  stream.Write(m_y1,sizeOf(longint));
  stream.Write(m_x2,sizeOf(longint));
  stream.Write(m_y2,sizeOf(longint));
end;

function TDrawEllipse.SelectAt(x, y: Integer): integer;
var
  rgn:HRGN;
begin
  result:=0;
  rgn:=CreateEllipticRgn(m_x1,m_y1,m_x2,m_y2);
  if atPoint(x,y,m_x1,m_y1) then
    result:=1
  else if atPoint(x,y,m_x1,m_y2) then
    result:=2
  else if atPoint(x,y,m_x2,m_y1) then
    result:=3
  else if atPoint(x,y,m_x2,m_y2) then
    result:=4
  else if atCurve(x,y) or PtInRegion(rgn,x,y) then
    begin
    m_oldx:=x;
    m_oldy:=y;
    result:=-1;
    end;
  DeleteObject(rgn);
end;

procedure TDrawEllipse.Selected(drwCanvas: TCanvas; select: boolean);
begin
  inherited;
  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 TDrawEllipse.setOrg;
begin
  fRect:=Rect(m_x1,m_y1,m_x2,m_y2);
end;

{ TDrawCircle }

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

procedure TDrawCircle.Draw(drwCanvas: TCanvas);
var
  oldPenColor,oldBrushColor:TColor;
  oldPenWidth:integer;
  oldBrushStyle:TBrushStyle;
  oldPenStyle:TPenStyle;
  oldPenMode:TPenMode;