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

Question

I would like more control over the appearance of Links. I have been attempting to use the OnUserDrawLinks with limited success. Are there any examples (Delphi preferred) of how to use OnUserDrawLinks?

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;

Leave a Reply