10702 : I would like more control over the appearance of Links.

Question

Answer

Drawing links so that they look good in all situtions is hard. That is partly why we left a door open for you with the user draw link event.

This is our code to draw links:

procedure TphGant_ComBasic.DrawLink(theStartPoint,theStopPoint:TPoint;
  theCanvas:TCanvas;theLinkStyle:TLinkStyle; theLinkColor:TColor;theLinkPenWidth: Integer;
  aDataEntity_Link:TphDataEntity_Link);
var
  aMiddlePoint, aNewStopPoint:TPoint;
  cLRArr, cUDArr ,cOri,ssFold,ssMinDist, OldPenWidth:Integer;
  aColor : TColor;
begin
  OldPenWidth := theCanvas.Pen.Width;
  try
    theCanvas.Pen.Color := theLinkColor;
    theCanvas.Pen.Width := theLinkPenWidth;
    theCanvas.MoveTo(theStartPoint.X,theStartPoint.Y);
    cLRArr := 3;
    cUDArr := 3;
    cOri:=1;
    ssMinDist:=7;
    if GA.IsPrinting then
    begin
      cLRArr := Round(3*GA.Scalex);
      cUDArr := Round(3*GA.Scaley);
      ssMinDist:=Round(ssMinDist*GA.Scalex);
    end;

    aNewStopPoint := theStopPoint;

    if Assigned(aDataEntity_Link) and (aDataEntity_Link.StartFinishOption=tlsfSS) then
    begin
      // tlsfSS is treated the same way for tlsDefault and tlsMSProject
      if theStartPoint.X>theStopPoint.X then
        ssFold:=theStopPoint.X-ssMinDist
      else
        ssFold:=theStartPoint.X-ssMinDist;

      theCanvas.LineTo(ssFold,theStartPoint.Y);
      theCanvas.LineTo(ssFold,aNewStopPoint.Y);
      theCanvas.LineTo(aNewStopPoint.X,aNewStopPoint.Y);

      theLinkStyle:=tlsDefault;
    end
    else
    begin

      case theLinkStyle of
        tlsDefault:
    begin
      if theStartPoint.X>theStopPoint.X then
              cOri:=-1;
            // Moves horizonatal endpoint one extra pixel to get get nicer looking arrows
            aNewStopPoint.X := theStopPoint.X-cOri;
            // This code draws the line cut in three parts - horizontal - vertical - horizontal
            aMiddlePoint.X:=theStartPoint.X+((aNewStopPoint.X-theStartPoint.X) div 2);
            aMiddlePoint.Y:=theStartPoint.Y+((aNewStopPoint.Y-theStartPoint.Y) div 2);
            theCanvas.LineTo(aMiddlePoint.X,theStartPoint.Y);
            theCanvas.LineTo(aMiddlePoint.X,aNewStopPoint.Y);
            theCanvas.LineTo(aNewStopPoint.X,aNewStopPoint.Y);
          end;
        tlsMSProject:
          begin
            if theStartPoint.Y<theStopPoint.Y then
              cOri:=-1;
            if theStartPoint.X < theStopPoint.X then
              aNewStopPoint.X := theStopPoint.X + cUDArr  // Moves endpoint horizontal get the arrow "inside" the box
            else
              aNewStopPoint.X := theStopPoint.X - cUDArr; // Moves endpoint horizontal get the arrow "inside" the box
            // Moves endpoint one extra pixel up/down to get nicer looking arrows
            aNewStopPoint.Y := theStopPoint.Y+cOri;
            // Draw horizontal line, then downwards to the recieving point
            theCanvas.LineTo(aNewStopPoint.X,theStartPoint.Y);
            theCanvas.LineTo(aNewStopPoint.X,aNewStopPoint.Y+cUDArr*cOri);
          end;
      end;
    end;
    // Don't draw the arrow if we are "out of bounds"
    if PointInRect( aNewStopPoint, theCanvas.ClipRect ) then
    begin
      case theLinkStyle of
        tlsDefault:
          begin
            // This code draws the arrow
            theCanvas.LineTo(aNewStopPoint.X-cLRArr*cOri,aNewStopPoint.Y-cLRArr);
            theCanvas.LineTo(aNewStopPoint.X-cLRArr*cOri,aNewStopPoint.Y+cLRArr);
            theCanvas.LineTo(aNewStopPoint.X,aNewStopPoint.Y);
          end;
        tlsMSProject:
          begin
            // This code draws the arrow downwards or upwards!
            aColor := theCanvas.Brush.Color;
            theCanvas.Brush.Color := theLinkColor;
            theCanvas.Polygon( [
              Point(aNewStopPoint.X,aNewStopPoint.Y),
              Point(aNewStopPoint.X-cUDArr,aNewStopPoint.Y+cUDArr*cOri),
              Point(aNewStopPoint.X+cUDArr,aNewStopPoint.Y+cUDArr*cOri)
              ] );
            theCanvas.Brush.Color := aColor;
          end;
      end;
    end;
  finally
    theCanvas.Pen.Width := OldPenWidth;
  end;
end;