drawbox.pas

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

    if ssShift in shift then
      FTest:=HitTest(FDownPoint,smShift)
    else if ssCtrl in shift then
      FTest:=HitTest(FDownPoint,smCtrl)
    else
      FTest:=HitTest(FDownPoint,smNone);

    if not FTest then begin //select nothing at all
      RubberBand(FDownPoint,FDownPoint);
    end;
  end
  else if FDrawingTool=dtRectangle then begin
    Cursor:=crCross;

    UnselectAll;
    SetLength(points,2);
    points[0]:=ViewToDoc(FDownPoint,canvas);
    points[1]:=ViewToDoc(FDownPoint,canvas);
    obj:=TRectangle.create(points);
    Add(obj);
    Select(obj);
    obj.Handle:=3;
    FTest:=true;
    FDrawingTool:=dtSelect;
  end
  else if FDrawingTool=dtPolyLine then begin
    Cursor:=crCross;

    UnselectAll;
    SetLength(points,2);
    points[0]:=ViewToDoc(FDownPoint,canvas);
    points[1]:=ViewToDoc(FDownPoint,canvas);
    obj:=TPolyLine.create(points);
    Add(obj);
    Select(obj);
    obj.Handle:=2;
    FTest:=true;
    FDrawingTool:=dtSelect;
  end;

end;

procedure TView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  r:TRealRect;
  obj:TDrawObj;
begin
  if csDesigning in ComponentState then  exit;

  FUpPoint:=RealPoint(x,y);

  if FDrawingTool=dtSelect then begin
    if FTest then begin
      if SelectedCount=1 then begin
        obj:=SelectedObj;
        obj.Normalize;
      end;
    end
    else begin
      RubberBand(FDownPoint,FMovePoint);

      r:=RealRect(FDownPoint.x,FDownPoint.y,FMovePoint.x,FMovePoint.y);
      if ssShift in shift then
        HitTest(r,smShift)
      else if ssCtrl in shift then
        HitTest(r,smCtrl)
      else
        HitTest(r,smNone);
    end;
  end;
end;

procedure TView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  obj:TDrawObj;
  i:integer;
  dx,dy:Real;
begin
  if csDesigning in ComponentState then  exit;

  if FDrawingTool=dtSelect then begin
    if not (ssLeft in shift) then begin
      cursor:=GetCursor(RealPoint(x,y));
    end
    else begin
      if FTest then begin
        dx:=ViewToDoc(x,canvas)-ViewToDoc(FDownPoint.x,canvas);
        dy:=ViewToDoc(y,canvas)-ViewToDoc(FDownPoint.y,canvas);

        Move(dx,dy);

        FDownPoint:=RealPoint(x,y);
      end
      else begin
        RubberBand(FDownPoint,FMovePoint);
        FMovePoint:=RealPoint(x+1,y+1);
        RubberBand(FDownPoint,FMovePoint);
      end;
    end;
  end
  else if FDrawingTool=dtRectangle then begin
  end
  else if FDrawingTool=dtPolyLine then begin
  end;
end;

procedure TView.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if key=vk_down then
    Move(0,1)
  else if key=vk_up then
    Move(0,-1)
  else if key=vk_left then
    Move(1,0)
  else if key=vk_right then
    Move(-1,0);

end;

function TView.DocToView(x:Real;canvas:TCanvas):Real;
var
  factor:Real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	x := x*factor;

  result:=x;
end;

function TView.ViewToDoc(x:Real;canvas:TCanvas):Real;
var
  factor:real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	x := x/factor;

  result:=x;
end;

function TView.DocToView(p:TRealPoint;canvas:TCanvas):TRealPoint;
var
  factor:Real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	p.x := p.x*factor;
	p.y := p.y*factor;

  result:=p;
end;

function TView.ViewToDoc(p:TRealPoint;canvas:TCanvas):TRealPoint;
var
  factor:real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	p.x := p.x/factor;
	p.y := p.y/factor;

  result:=p;
end;

function TView.DocToView(r:TRealRect;canvas:TCanvas):TRealRect;
var
  factor:Real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	r.left := r.left*factor;
	r.top := r.top*factor;
	r.right := r.right*factor;
	r.bottom := r.bottom*factor;

  result:=r;
end;

function TView.ViewToDoc(r:TRealRect;canvas:TCanvas):TRealRect;
var
  factor:real;
begin
  if FPrinting then
    factor:=GetDeviceCaps(printer.handle,LOGPIXELSX)/25.4*FZoom/100
  else
    factor:=Screen.PixelsPerInch/25.4*FZoom/100;

	r.left := r.left/factor;
	r.top := r.top/factor;
	r.right := r.right/factor;
	r.bottom := r.bottom/factor;

  result:=r;
end;

procedure TView.Add(obj:TDrawObj);
begin
  obj.View:=self;
  FObjects.Add(obj);
end;

procedure TView.Delete(obj:TDrawObj);
begin
  FObjects.Remove(obj);
end;

procedure TView.Delete(index:integer);
begin
  FObjects.Delete(index);
end;

procedure TView.Select(obj:TDrawObj);
begin
  obj.Selected:=true;
  InvalObj(obj);
end;

procedure TView.SelectAll;
var
  i:integer;
  obj:TDrawObj;
begin
  for i:=0 to FObjects.Count-1 do begin
    obj:=TDrawObj(FObjects[i]);
    if not obj.Selected then begin
      InvalObj(obj);
      obj.Selected:=true;
      InvalObj(obj);
    end;
  end;
end;

procedure TView.Unselect(obj:TDrawObj);
begin
  InvalObj(obj);
  obj.Selected:=false;
  InvalObj(obj);
end;

procedure TView.UnselectAll;
var
  i:integer;
  obj:TDrawObj;
begin
  for i:=0 to FObjects.Count-1 do begin
    obj:=TDrawObj(FObjects[i]);
    if obj.Selected then begin
      InvalObj(obj);
      obj.Selected:=false;
      InvalObj(obj);
    end;
  end;
end;

procedure TView.LoadFromFile(AFileName:String);
begin
end;

procedure TView.LoadFromStream(AStream:TStream);
begin
end;

procedure TView.SaveToFile(AFileName:String);
begin
end;

procedure TView.SaveToStream(AStream:TStream);
begin
end;

function TView.HitTest(p:TRealPoint;mode:TSelectMode):boolean;
var
  i:integer;
  obj:TDrawObj;
begin
  result:=false;

  obj:=nil;
  for i:=FObjects.Count-1 downto 0 do begin
    obj:=TDrawObj(FObjects[i]);
    if obj.HitTest(RealRect(p.x-1,p.y-1,p.x+1,p.y+1),canvas)>=0 then begin
      result:=true;
      break;
    end;
  end;

  if not result then begin
    if mode=smNone then
      UnselectAll
  end
  else begin
    if mode=smCtrl then begin
      if obj.Selected then
        Unselect(obj)
      else
        Select(obj);
    end
    else if mode=smShift then begin
      if not obj.Selected then
        Select(obj);
    end
    else begin
      if not obj.Selected then UnselectAll;
      Select(obj);
    end;
  end;
end;

procedure TView.Move(dx,dy:Real);
var
  i,n:integer;
  obj:TDrawObj;
begin
  n:=SelectedCount;

  if n>1 then begin
    for i:=0 to FObjects.Count-1 do begin
      obj:=TDrawObj(FObjects[i]);
      if obj.Selected then begin
        InvalObj(obj);
        obj.Move(dx,dy);
        InvalObj(obj);
      end;
    end;
  end
  else if n=1 then begin
    obj:=SelectedObj;
    InvalObj(obj);
    obj.HandleMove(dx,dy);
    InvalObj(obj);
  end;
end;

procedure TView.Alignment(AAlignment:TAlignment);
var
  first:boolean;
  i:integer;
  pos:real;
begin
  if SelectedCount<2 then exit;
  case AAlignment of
  alLeft:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.left;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.left);
        end;
      end;
    end;
  alHorzCenter:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.left+(TDrawObj(FObjects[i]).Bounds.right-TDrawObj(FObjects[i]).Bounds.left)/2;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.left+(TDrawObj(FObjects[i]).Bounds.right-TDrawObj(FObjects[i]).Bounds.left)/2);
        end;
      end;
    end;
  alRight:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.right;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.right);
        end;
      end;
    end;
  alTop:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.top;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.top);
        end;
      end;
    end;
  alVertCenter:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.top+(TDrawObj(FObjects[i]).Bounds.bottom-TDrawObj(FObjects[i]).Bounds.top)/2;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.top+(TDrawObj(FObjects[i]).Bounds.bottom-TDrawObj(FObjects[i]).Bounds.top)/2);
        end;
      end;
    end;
  alBottom:
    begin
      first:=true;
      for i:=0 to FObjects.Count-1 do begin
        if TDrawObj(FObjects[i]).Selected then begin
          if first then begin
            first:=false;
            pos:=TDrawObj(FObjects[i]).Bounds.bottom;
          end
          else
            pos:=Min(pos,TDrawObj(FObjects[i]).Bounds.bottom);
        end;
      end;
    end;
  end;

  for i:=0 to FObjects.Count-1 do begin
    if TDrawObj(FObjects[i]).Selected then begin
      InvalObj(TDrawObj(FObjects[i]));
      TDrawObj(FObjects[i]).Alignment(AAlignment,pos);
      InvalObj(TDrawObj(FObjects[i]));
    end;
  end;
end;

function TView.HitTest(r:TRealRect;mode:TSelectMode):boolean;
var
  i:integer;
  obj:TDrawObj;
begin
  result:=false;

  if mode=smNone then
    UnselectAll;

  NormalizeRect(r);
  for i:=FObjects.Count-1 downto 0 do begin
    obj:=TDrawObj(FObjects[i]);
    if obj.HitTest(r,canvas)>=0 then begin
      result:=true;

      if ((mode=smShift) or (mode=smNone)) and not obj.selected then
          Select(obj)
      else if (mode=smCtrl) then begin
        if not obj.selected then
          Select(obj)
        else
          Unselect(obj);
      end;
    end;
  end;
end;

procedure TView.ShowProperty;
var
  c:integer;
  f:TPaperPropertyForm;
begin
  c:=SelectedCount;

  if c=1 then begin
    TDrawObj(Selectedobj).ShowProperty;
  end
  else begin
    f:=TPaperPropertyForm.create(nil);
    if f.ShowModal=mrOK then begin
    end;
    f.free;
  end;
end;

procedure TView.Paint;
begin
  Draw(Canvas);
end;

procedure TView.Print;
var
  dlg:TPrintDialog;
begin
  dlg:=TPrintDialog.Create(nil);
  if dlg.Execute then begin
    FPrinting:=true;
    printer.BeginDoc;
    Draw(printer.canvas);
    printer.EndDoc;
    FPrinting:=false;
  end;
  dlg.Free;
end;

procedure TView.InvalObj(obj:TDrawObj);
var
  b:TRect;
  r:TRealRect;