drawbox.pas

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

  p1,p2:TPoint;
begin
  r:=obj.Bounds;
  r:=DocToView(r,canvas);
  p1:=RealToInt(RealPoint(r.Left,r.top));
  p2:=RealToInt(RealPoint(r.right,r.bottom));

  p1:=self.ClientToScreen(p1);
  p2:=self.ClientToScreen(p2);

  p1:=TScrollBox(parent).ScreenToClient(p1);
  p2:=TScrollBox(parent).ScreenToClient(p2);

  b:=Rect(p1.x,p1.y,p2.x,p2.y);
  if obj.FSelected then begin
    OffsetRect(b,-3,-3);
    InflateRect(b,6,6);
  end;

  Windows.InvalidateRect(TScrollBox(parent).Handle,@b,false);
end;

procedure TView.Draw(Canvas:TCanvas);
  procedure DrawGrid(Canvas:TCanvas);
  var
    p:TRealPoint;
    n:integer;
    d,x,y:real;
  begin
    with Canvas do begin
      p:=RealPoint(5,5);
      p:=DocToView(p,Canvas);
      d:=p.x;
      x:=d;
      y:=d;

      n:=0;
      while x<Width do begin
        if n mod 2=0 then begin
          Pen.Color:=$f9f9f9;
        end
        else begin
          Pen.Color:=$f0f0f0;
        end;

        if (FZoom>50) and ((n+1) mod 4 =0) then begin
          Font.Name:='Arial';
          Font.Size:=7;
          Font.Color:=clBlue;
          TextOut(RealToInt(x+1),0,IntToStr(RealToInt(n div 2+1)));
        end;

        MoveTo(RealToInt(x),0);
        LineTo(RealToInt(x),Height);

        x:=x+d;
        n:=n+1;
      end;

      n:=0;
      while y<Height do begin
        if n mod 2=0 then begin
          Pen.Color:=$f9f9f9;
        end
        else begin
          Pen.Color:=$f0f0f0;
        end;

        if (FZoom>50) and ((n+1) mod 4 =0) then begin
          Font.Name:='Arial';
          Font.Size:=7;
          Font.Color:=clBlue;
          TextOut(2,RealToInt(y),IntToStr(RealToInt(n div 2+1)));
        end;
        MoveTo(0,RealToInt(y));
        LineTo(Width,RealToInt(y));

        y:=y+d;
        n:=n+1;
      end;
    end;
  end;
var
  i:integer;
  bmp:TBitmap;
begin
  if not FPrinting then begin
    bmp:=TBitmap.Create;
    bmp.Width:=Canvas.ClipRect.Right-Canvas.ClipRect.left;
    bmp.Height:=Canvas.ClipRect.bottom-Canvas.ClipRect.top;

    SetViewportOrgEx(bmp.Canvas.Handle,-Canvas.ClipRect.left,-Canvas.ClipRect.top,nil);

    //bakground
    with bmp.canvas do begin
      brush.Color:=FPaperColor;
      brush.Style:=bsSolid;
      FillRect(Rect(0,0,Width,Height));
    end;

    //show grid
    if FShowGrid then
      DrawGrid(bmp.Canvas);

    //draw objects
    for i:=0 to FObjects.Count-1 do begin
      TDrawObj(FObjects[i]).Draw(bmp.Canvas);
    end;

    //show frame
    with bmp.canvas do begin
      Pen.Color:=clBlack;
      brush.Style:=bsClear;
      Rectangle(0,0,Width,height);
    end;

    windows.SetViewportOrgEx(bmp.Canvas.Handle,0,0,nil);
    Windows.BitBlt(Canvas.handle,Canvas.ClipRect.left,Canvas.ClipRect.top,bmp.Width,bmp.height,bmp.Canvas.handle,0,0,SRCCopy);

    bmp.free;
  end
  else begin
    for i:=0 to FObjects.Count-1 do begin
      TDrawObj(FObjects[i]).Draw(Canvas);
    end;
  end;
end;

procedure TView.SetPaper(Value:TPaper);
var
  size:TRealPoint;
begin
  FPaper:=value;

  if FPaper<>Custom then begin
    case Value of
      Letter:begin  Size.x:=216; Size.y:=279; end;
      A3: begin     Size.x:=297; Size.y:=420; end;
      A4: begin     Size.x:=210; Size.y:=297; end;
      A5: begin     Size.x:=148; Size.y:=210; end;
      B4: begin     Size.x:=250; Size.y:=354; end;
      B5: begin     Size.x:=182; Size.y:=257; end;
    end;
    FPaperWidth:=RealToint(size.x);
    FPaperHeight:=RealToint(size.y);

    size:=DocToView(size,canvas);

    Width:=RealToint(size.x);
    Height:=RealToint(size.y);
  end;
end;

procedure TView.SetPaperWidth(value:integer);
begin
  FPaperWidth:=Value;

  Width:=RealToInt(DocToView(FPaperWidth,canvas));

  FPaper:=Custom;
end;

procedure TView.SetPaperHeight(value:integer);
begin
  FPaperHeight:=Value;

  Height:=RealToInt(DocToView(FPaperHeight,canvas));

  FPaper:=Custom;
end;

procedure TView.SetPaperColor(value:TColor);
begin
  FPaperColor:=Value;

  Invalidate;
end;

procedure TView.SetShowGrid(value:boolean);
begin
  FShowGrid:=Value;

  Invalidate;
end;

procedure TView.SetZoom(value:integer);
begin
  if value<10 then
    FZoom:=10
  else
    FZoom:=value;

  SetPaper(FPaper);

  Invalidate;
end;

{TCustomDrawBox}
constructor TCustomDrawBox.Create(AOwner:TComponent);
var
  o:TDrawObj;
  points:array of TRealPoint;
begin
  inherited Create(AOwner);

  Color:=clAppWorkSpace;
  Align:=alClient;

  HorzScrollBar.Tracking:=true;
  HorzScrollBar.Margin:=8;

  VertScrollBar.Tracking:=true;
  VertScrollBar.Margin:=8;

  FView:=TView.create(self);
  FView.parent:=self;
  FView.Left:=8;
  FView.Top:=8;

  FRightEdge:=TShape.Create(self);
  FRightEdge.Parent:=self;
  FRightEdge.Brush.Color:=clBlack;

  FBottomEdge:=TShape.Create(self);
  FBottomEdge.Parent:=self;
  FBottomEdge.Brush.Color:=clBlack;

  SetEdgePosition;

  SetLength(points,2);
  points[0]:=RealPoint(10,10);
  points[1]:=realPoint(30,30);
  o:=TRectangle.Create(points);
  TRectangle(o).shape:=stRectangle;
  FView.Add(o);

  points[0]:=RealPoint(20,20);
  points[1]:=RealPoint(40,40);
  o:=TPolyLine.Create(points);
  FView.Add(o);
end;

destructor TCustomDrawBox.destroy;
begin
  FView.free;
  FRightEdge.free;
  FBottomEdge.free;

  inherited destroy;
end;

procedure TCustomDrawBox.SetEdgePosition;
begin
  FRightEdge.Left:=FView.Left+FView.Width;
  FRightEdge.Top:=FView.Top+3;
  FRightEdge.Width:=3;
  FRightEdge.height:=FView.Height-1;

  FBottomEdge.Left:=FView.Left+3;
  FBottomEdge.Top:=FView.Top+FView.Height;
  FBottomEdge.Width:=FView.Width;
  FBottomEdge.height:=3;
end;

procedure TCustomDrawBox.SetDrawingTool(value:TDrawingTool);
begin
  FView.DrawingTool:=value;
end;

function TCustomDrawBox.GetDrawingTool:TDrawingTool;
begin
  result:=FView.DrawingTool;
end;

procedure TCustomDrawBox.PaperProperty;
var
  f:TPaperPropertyForm;
begin
    f:=TPaperPropertyForm.create(nil);
    if f.ShowModal=mrOK then begin
    end;
    f.free;
end;

procedure TCustomDrawBox.SetPaper(value:TPaper);
begin
  FView.Paper:=value;

  SetEdgePosition;
end;

function TCustomDrawBox.GetPaper:TPaper;
begin
  result:=FView.Paper;
end;

procedure TCustomDrawBox.SetPaperWidth(value:integer);
begin
  FView.PaperWidth:=value;

  SetEdgePosition;
end;

function TCustomDrawBox.GetPaperWidth:integer;
begin
  result:=FView.PaperWidth;
end;

procedure TCustomDrawBox.SetPaperHeight(value:integer);
begin
  FView.PaperHeight:=value;

  SetEdgePosition;
end;

function TCustomDrawBox.GetPaperHeight:integer;
begin
  result:=FView.PaperHeight;
end;

procedure TCustomDrawBox.SetPaperColor(value:TColor);
begin
  FView.PaperColor:=value;
end;

function TCustomDrawBox.GetPaperColor:TColor;
begin
  result:=FView.PaperColor;
end;

procedure TCustomDrawBox.SetZoom(value:integer);
begin
  FView.Zoom:=value;

  SetEdgePosition;
end;

function TCustomDrawBox.GetZoom:Integer;
begin
  result:=FView.Zoom;
end;

procedure TCustomDrawBox.SetShowGrid(value:boolean);
begin
  FView.ShowGrid:=value;
end;

function TCustomDrawBox.GetShowGrid:Boolean;
begin
  result:=FView.ShowGrid;
end;

procedure TCustomDrawBox.Add(obj:TDrawObj);
begin
  FView.Add(obj);
end;

procedure TCustomDrawBox.Delete(obj:TDrawObj);
begin
  FView.Delete(obj);
end;

procedure TCustomDrawBox.Delete(index:integer);
begin
  FView.Delete(index);
end;

procedure TCustomDrawBox.Select(obj:TDrawObj);
begin
  FView.Select(obj);
end;

procedure TCustomDrawBox.Unselect(obj:TDrawObj);
begin
  FView.Unselect(obj);
end;

procedure TCustomDrawBox.SelectAll;
begin
  FView.SelectAll;
end;

procedure TCustomDrawBox.UnselectAll;
begin
  FView.UnselectAll;
end;

procedure TCustomDrawBox.Print;
begin
  FView.Print;
end;

procedure TCustomDrawBox.Alignment(AAlignment:TAlignment);
begin
  FView.Alignment(AAlignment);
end;

procedure TCustomDrawBox.LoadFromFile(AFileName:String);
begin
  FView.LoadFromFile(AFileName);
end;

procedure TCustomDrawBox.LoadFromStream(AStream:TStream);
begin
  FView.LoadFromStream(AStream);
end;

procedure TCustomDrawBox.SaveToFile(AFileName:String);
begin
  FView.SaveToFile(AFileName);
end;

procedure TCustomDrawBox.SaveToStream(AStream:TStream);
begin
  FView.SaveToStream(AStream);
end;

//TDrawBar
constructor TDrawBar.create(AOwner:TComponent);
var
  i,x:integer;
  GlyphNames:array[1..18] of string;
begin
  inherited create(AOwner);

  AutoSize:=false;
  //Align:=alTop;
  Height:=28;

  GlyphNames[1]:='dtSelect';
  GlyphNames[2]:='dtRectangle';
  GlyphNames[3]:='dtPolyLine';

  GlyphNames[4]:='SEPERATOR';

  GlyphNames[5]:='ALLEFT';
  GlyphNames[6]:='ALHORZCENTER';
  GlyphNames[7]:='ALRIGHT';
  GlyphNames[8]:='ALWIDTH';
  GlyphNames[9]:='ALTOP';
  GlyphNames[10]:='ALVERTCENTER';
  GlyphNames[11]:='ALBOTTOM';
  GlyphNames[12]:='ALHEIGHT';

  GlyphNames[13]:='SEPERATOR';

  GlyphNames[14]:='FGCOLOR';
  GlyphNames[15]:='BKCOLOR';
  GlyphNames[16]:='TEXTCOLOR';
  GlyphNames[17]:='FONT';

  x:=0;
  for i:=1 to 17 do begin
    FButtons[i]:=TSpeedButton.Create(Self);
    with FButtons[i] do begin
      Left:=x;
      Top:=1;
      Parent := self;
      Tag := I;
      Flat:=true;

      if (i=4) or (i=13) then begin
        FButtons[i].Enabled:=false;
      end;

      if (i>=1) and (i<=3) then
        GroupIndex:=1;

      if (i<>4) and (i<>13) then
        OnClick:=FOnClick;

      Glyph.LoadFromResourceName(HInstance,GlyphNames[i]);
      x:=x+23;
    end;
  end;

  FButtons[1].Down:=true;
end;

destructor TDrawBar.destroy;
var
  i:integer;
begin
  for i:=1 to 17 do begin
    FButtons[i].free;
  end;

  inherited destroy;
end;

procedure TDrawBar.FOnClick(Sender:TObject);
begin
  if Assigned(FDrawBox) then begin
    case TToolButton(Sender).Tag of
    1:FDrawBox.DrawingTool:=dtSelect;
    2:FDrawBox.DrawingTool:=dtRectangle;
    3:FDrawBox.DrawingTool:=dtPolyLine;
    4:FDrawBox.DrawingTool:=dtZoom;

    5:FDrawBox.Alignment(alLeft);
    6:FDrawBox.Alignment(alHorzCenter);
    7:FDrawBox.Alignment(alRight);
    //8:FDrawBox.Alignment(alWidth);
    9:FDrawBox.Alignment(alTop);
    10:FDrawBox.Alignment(alVertCenter);
    11:FDrawBox.Alignment(alBottom);
    //12:FDrawBox.Alignment(alHeight);
    13:;
    14:;
    15:;
    16:;
    17:;
    18:;
    end;
  end;
end;

end.