drawbox.pas

A diagram edit component for delphi/c++ builder with full source included

    //X := Pen.Width div 2;
    //Y := X;
    //W := w - Pen.Width + 1;
    //H := h - Pen.Width + 1;

    if Pen.Width = 0 then begin
      Dec(W);
      Dec(H);
    end;

    if W < H then
      S := W
    else
      S := H;

    if FShape in [stSquare, stRoundSquare, stCircle] then begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;

    case FShape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
    end;
  end;

  if FSelected then begin
    DrawHandle(Canvas);
  end;
end;

function TRectangle.Handles(AHandle:integer):TRealPoint;
var
  p:TRealPoint;
begin
  case AHandle of
  1:p:=RealPoint(FPoints[0].x,FPoints[0].y);
  2:p:=RealPoint(FPoints[1].x,FPoints[0].y);
  3:p:=RealPoint(FPoints[1].x,FPoints[1].y);
  4:p:=RealPoint(FPoints[0].x,FPoints[1].y);
  end;

  result:=p;
end;

procedure TRectangle.HandleMove(dx,dy:Real);
begin
  if FHandle=0 then begin
    FPoints[0].x:=FPoints[0].x+dx;
    FPoints[0].y:=FPoints[0].y+dy;
    FPoints[1].x:=FPoints[1].x+dx;
    FPoints[1].y:=FPoints[1].y+dy;
  end
  else if FHandle=1 then begin
    FPoints[0].x:=FPoints[0].x+dx;
    FPoints[0].y:=FPoints[0].y+dy;
  end
  else if FHandle=2 then begin
    FPoints[1].x:=FPoints[1].x+dx;
    FPoints[0].y:=FPoints[0].y+dy;
  end
  else if FHandle=3 then begin
    FPoints[1].x:=FPoints[1].x+dx;
    FPoints[1].y:=FPoints[1].y+dy;
  end
  else if FHandle=4 then begin
    FPoints[0].x:=FPoints[0].x+dx;
    FPoints[1].y:=FPoints[1].y+dy;
  end;
end;

function TRectangle.GetCursor(p:TRealPoint;canvas:TCanvas):TCursor;
var
  b:TRealRect;
  p1:TRealPoint;
  i,AHandle:integer;
begin
  AHandle:=-1;

	if FSelected then begin
		for i:=1 to FHandleCount do begin
			p1 := Handles(i);
      p1:=View.DocToView(p1,canvas);
			if PtInRect(RealToInt(RealRect(p1.x-3,p1.y-3,p1.x+3,p1.y+3)),RealToInt(p)) then begin
				AHandle:=i;
        break;
      end;
		end;
	end;

  b:=Bounds;
  b:=View.DocToView(b,canvas);
  if (AHandle=-1) and PtInRect(RealToInt(b),RealToInt(p)) then begin
    AHandle:=0;
  end;

  result:=crArrow;
  case AHandle of
  0,-1:result:=crArrow;
  1,3:result:=crSizeNWSE;
  2,4:result:=crSizeNESW;
  end;
end;

function TRectangle.Bounds:TRealRect;
begin
  result.left:=Min(FPoints[0].x,FPoints[1].x);
  result.top:=Min(FPoints[0].y,FPoints[1].y);
  result.right:=Max(FPoints[0].x,FPoints[1].x);
  result.bottom:=Max(FPoints[0].y,FPoints[1].y);
end;

procedure TRectangle.Normalize;
begin
  if FPoints[0].x>FPoints[1].x then
    Swap(FPoints[0].x,FPoints[1].x);

  if FPoints[0].y>FPoints[1].y then
    Swap(FPoints[0].y,FPoints[1].y);
end;

procedure TRectangle.Alignment(AAlignment:TAlignment;pos:real);
var
  d:real;
begin
  case AAlignment of
  alLeft:
    begin
      d:=pos-FPoints[0].x;
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alHorzCenter:
    begin
      d:=pos-(FPoints[0].x+(FPoints[1].x-Fpoints[0].x)/2);
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alRight:
    begin
      d:=pos-FPoints[1].x;
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alTop:
    begin
      d:=pos-FPoints[0].y;
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  alVertCenter:
    begin
      d:=pos-(FPoints[0].y+(FPoints[1].y-Fpoints[0].y)/2);
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  alBottom:
    begin
      d:=pos-FPoints[1].y;
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  end;
end;

procedure TRectangle.ShowProperty;
var
  f:TRectanglePropertyForm;
begin
  f:=TRectanglePropertyForm.create(nil);
  f.Obj:=Self;
  if f.ShowModal=mrOK then begin
  end;
  f.free;
end;

function TRectangle.HitTest(r:TRealRect;canvas:TCanvas):integer;
var
  r1:TRect;
  b:TRealRect;
  p:TRealPoint;
  i:integer;
begin
  FHandle:=-1;

	if FSelected then begin
		for i:=1 to FHandleCount do begin
			p:=Handles(i);
      p:=View.DocToView(p,canvas);
      if IntersectRect(r1,RealToInt(RealRect(p.x-3,p.y-3,p.x+3,p.y+3)),RealToInt(r)) then begin
				FHandle:=i;
        break;
      end;
		end;
	end;

  if (FHandle=-1) then begin
    b:=Bounds;
    b:=View.DocToView(b,canvas);
    if IntersectRect(r1,RealToInt(b),RealToInt(r)) then
      FHandle:=0;
  end;

	result:=FHandle;
end;

{TPolyLine}
constructor TPolyLine.Create(points:array of TRealPoint);
var
  i:integer;
begin
  inherited Create;

  SetLength(FPoints,2);

  for i:=Low(FPoints) to High(FPoints) do begin
    FPoints[i]:=points[i];
  end;

  FHandleCount:=2;
end;

destructor TPolyLine.Destroy;
begin
  inherited destroy;
end;

procedure TPolyLine.Draw(Canvas:TCanvas);
var
  i:integer;
  x,y:integer;
  points:array of TRealPoint;
begin
  SetLength(points,High(FPoints)+1);
  for i:=Low(FPoints) to High(FPoints) do begin
    points[i]:=View.DocToView(FPoints[i],Canvas);
  end;

  with canvas do begin
    pen:=FPen;
    brush:=FBrush;

    MoveTo(RealToInt(points[0].x),RealToint(points[0].y));
    for i:=1 to high(points) do begin
      LineTo(RealToInt(points[i].x),RealToint(points[i].y));
    end;

    if FSelected then begin
      DrawHandle(Canvas);
    end;
  end;
end;

function TPolyLine.Handles(AHandle:integer):TRealPoint;
var
  p:TRealPoint;
begin
  case AHandle of
  1:p:=RealPoint(FPoints[0].x,FPoints[0].y);
  2:p:=RealPoint(FPoints[1].x,FPoints[1].y);
  end;

  result:=p;
end;

procedure TPolyLine.HandleMove(dx,dy:Real);
begin
  if FHandle=0 then begin
    FPoints[0].x:=FPoints[0].x+dx;
    FPoints[0].y:=FPoints[0].y+dy;
    FPoints[1].x:=FPoints[1].x+dx;
    FPoints[1].y:=FPoints[1].y+dy;
  end
  else if FHandle=1 then begin
    FPoints[0].x:=FPoints[0].x+dx;
    FPoints[0].y:=FPoints[0].y+dy;
  end
  else if FHandle=2 then begin
    FPoints[1].x:=FPoints[1].x+dx;
    FPoints[1].y:=FPoints[1].y+dy;
  end;
end;

function TPolyLine.GetCursor(p:TRealPoint;canvas:TCanvas):TCursor;
var
  b:TRealRect;
  p1:TRealPoint;
  i,AHandle:integer;
begin
  AHandle:=-1;

	if FSelected then begin
		for i:=1 to FHandleCount do begin
			p1 := Handles(i);
      p1:=View.DocToView(p1,canvas);
			if PtInRect(RealToInt(RealRect(p1.x-3,p1.y-3,p1.x+3,p1.y+3)),RealToInt(p)) then begin
				AHandle:=i;
        break;
      end;
		end;
	end;

  b:=Bounds;
  b:=View.DocToView(b,canvas);
  if (AHandle=-1) and PtInRect(RealToInt(b),RealToInt(p)) then begin
    AHandle:=0;
  end;

  result:=crArrow;
  case AHandle of
  0:result:=crArrow;
  1,2:result:=crSizeAll;
  end;
end;

function TPolyLine.Bounds:TRealRect;
begin
  result.left:=Min(FPoints[0].x,FPoints[1].x);
  result.top:=Min(FPoints[0].y,FPoints[1].y);
  result.right:=Max(FPoints[0].x,FPoints[1].x);
  result.bottom:=Max(FPoints[0].y,FPoints[1].y);
end;

procedure TPolyLine.Normalize;
begin
end;

procedure TPolyLine.Alignment(AAlignment:TAlignment;pos:real);
var
  d:real;
begin
  case AAlignment of
  alLeft:
    begin
      d:=pos-FPoints[0].x;
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alHorzCenter:
    begin
      d:=pos-(FPoints[0].x+(FPoints[1].x-Fpoints[0].x)/2);
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alRight:
    begin
      d:=pos-FPoints[1].x;
      FPoints[0].x:=FPoints[0].x+d;
      FPoints[1].x:=FPoints[1].x+d;
    end;
  alTop:
    begin
      d:=pos-FPoints[0].y;
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  alVertCenter:
    begin
      d:=pos-(FPoints[0].y+(FPoints[1].y-Fpoints[0].y)/2);
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  alBottom:
    begin
      d:=pos-FPoints[1].y;
      FPoints[0].y:=FPoints[0].y+d;
      FPoints[1].y:=FPoints[1].y+d;
    end;
  end;
end;

procedure TPolyLine.ShowProperty;
  var
  f:TPolyLinePropertyForm;
begin
  f:=TPolyLinePropertyForm.create(nil);
  if f.ShowModal=mrOK then begin

  end;
  f.free;
end;

function TPolyLine.HitTest(r:TRealRect;canvas:TCanvas):integer;
var
  r1:TRect;
  b:TRealRect;
  p:TRealPoint;
  i:integer;
  points:array of TRealPoint;
begin
  FHandle:=-1;

	if FSelected then begin
		for i:=1 to FHandleCount do begin
			p:=Handles(i);
      p:=View.DocToView(p,canvas);
      if IntersectRect(r1,RealToInt(RealRect(p.x-3,p.y-3,p.x+3,p.y+3)),RealToInt(r)) then begin
				FHandle:=i;
        break;
      end;
		end;
	end;

  if (FHandle=-1) then begin
    SetLength(points,2);
    points[0]:=View.DocToView(FPoints[0],canvas);
    points[1]:=View.DocToView(FPoints[1],canvas);
    if RectOnLine(r,points) then
      FHandle:=0;
  end;

	result:=FHandle;
end;

{TView}
constructor TView.Create(AOwner:TComponent);
begin
  inherited Create(Aowner);

  Font.Name:='Arial';
  Font.Size:=8;

  FObjects:=TObjectList.Create(true);

  FPrinting:=false;
  FZoom:=100;
  Paper:=A4;
  FDrawingTool:=dtSelect;
  FPaperColor:=clWhite;
  FShowGrid:=true;
end;

destructor TView.Destroy;
begin
  FObjects.free;

  inherited destroy;
end;

procedure TView.RubberBand(p1,p2:TRealPoint);
var
  OldPen:TPen;
  OldBrush:TBrush;
begin
  with Canvas do begin
    Oldpen:=Pen;
    OldBrush:=Brush;
    Pen.Mode:=pmNotXor;
    Pen.Color:=clBlue;
    Brush.Style:=bsClear;
    Rectangle(RealToInt(RealRect(p1.x,p1.y,p2.x,p2.y)));
    Pen:=OldPen;
    Brush:=OldBrush;
  end;
end;

function TView.GetCursor(p:TRealPoint):TCursor;
var
  obj:TDrawObj;
begin
  if SelectedCount=1 then begin
    obj:=SelectedObj;
    result:=obj.GetCursor(p,canvas);
  end
  else
    result:=crArrow;
end;

function TView.SelectedCount:integer;
var
  i,n:integer;
  obj:TDrawObj;
begin
  n:=0;
  for i:=0 to FObjects.Count-1 do begin
    obj:=TDrawObj(FObjects[i]);

    if obj.Selected then inc(n);
  end;

  result:=n;
end;

function TView.SelectedObj:TDrawObj;
var
  i:integer;
  obj:TDrawObj;
begin
  for i:=0 to FObjects.Count-1 do begin
    obj:=TDrawObj(FObjects[i]);

    if obj.Selected then begin
      result:=obj;
      exit;
    end;
  end;

  result:=nil;
end;

procedure TView.DblClick;
begin
  ShowProperty;
end;

procedure TView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  obj:TDrawObj;
  points:Array of TRealPoint;
begin
  if csDesigning in ComponentState then  exit;

  FDownPoint:=RealPoint(x,y);
  FMovePoint:=RealPoint(x,y);

  if FDrawingTool=dtSelect then begin