How to draw an arrow head

I've worked on a few developments that require graphical input form users like CAD, flow control and diagram applications. Here is a snippet of code that draws an arrow head to a line.

This is an example and in real code you might want to pass the arrow head length and width in as parameters.




procedure TMainForm.DrawArrowHead(const x1, y1, x2, y2: integer;
  Canvas: TCanvas);
var
  HeadLength : real;
  HeadWidth : real;
  xbase : Integer;
  xLineDelta : Integer;
  xLineUnitDelta : Double;
  xNormalDelta : Integer;
  xNormalUnitDelta : Double;
  ybase : Integer;
  yLineDelta : Integer;
  yLineUnitDelta : Double;
  yNormalDelta : Integer;
  yNormalUnitDelta : Double;
  OrigBrushColor : TColor;
begin
   OrigBrushColor := Canvas.Brush.Color;
   Canvas.Brush.Color := clBlack;
   xLineDelta := x2 - x1;
   yLineDelta := y2 - y1;
   xLineUnitDelta := xLineDelta / SQRT( SQR(xLineDelta) + SQR(yLineDelta));
   yLineUnitDelta := yLineDelta / SQRT( SQR(xLineDelta) + SQR(yLineDelta));
   // (xBase,yBase) is were the arrow line is perpendicular to base triangle.
   HeadLength := 12;
   HeadWidth := 2;
   xBase := x2 - ROUND(HeadLength * xLineUnitDelta);
   yBase := y2 - ROUND(HeadLength * yLineUnitDelta);

   xNormalDelta := yLineDelta;
   yNormalDelta := -xLineDelta;
   xNormalUnitDelta := xNormalDelta / SQRT( SQR(xNormalDelta) + SQR(yNormalDelta));
   yNormalUnitDelta := yNormalDelta / SQRT( SQR(xNormalDelta) + SQR(yNormalDelta));
   //Draw the arrow tip
   Canvas.Polygon([Point(x2,y2),
     Point(xBase + Round(HeadWidth*xNormalUnitDelta),
       yBase + ROUND(HeadWidth*yNormalUnitDelta)),
     Point(xBase - ROUND(HeadWidth*xNormalUnitDelta),
       yBase - ROUND(HeadWidth*yNormalUnitDelta)) ]);
   Canvas.Brush.Color := OrigBrushCOlor;
end;

How to draw a gradient background

My previous post I wrote about how to reduce flicker on a gradient background and did not mention how to create a gradient background. Here is how I create a gradient background.

Interface

procedure GradVertical(Canvas: TCanvas; Rect: TRect; FromColor, ToColor: TColor);

Implemention


procedure TForm1.GradVertical(Canvas: TCanvas; Rect: TRect; FromColor, ToColor: TColor);
var
    Y                     : Integer;
    dr, dg, db            : Extended;
    C1, C2                : TColor;
    r1, r2, g1, g2, b1, b2: Byte;
    R, G, B               : Byte;
    cnt                   : Integer;
begin
    C1 := FromColor;
    r1 := GetRValue(C1);
    g1 := GetGValue(C1);
    b1 := GetBValue(C1);

    C2 := ToColor;
    r2 := GetRValue(C2);
    g2 := GetGValue(C2);
    b2 := GetBValue(C2);

    dr := (r2 - r1) / Rect.Bottom - Rect.Top;
    dg := (g2 - g1) / Rect.Bottom - Rect.Top;
    db := (b2 - b1) / Rect.Bottom - Rect.Top;

    cnt   := 0;
    for Y := Rect.Top to Rect.Bottom - 1 do
    begin
        R := r1 + Ceil(dr * cnt);
        G := g1 + Ceil(dg * cnt);
        B := b1 + Ceil(db * cnt);

        Canvas.Pen.Color := RGB(R, G, B);
        Canvas.MoveTo(Rect.Left, Y);
        Canvas.LineTo(Rect.Right, Y);
        Inc(cnt);
    end;
end;


procedure TForm1.ButtonClick(Sender: TObject);
var
    Rect: TRect;
begin
    Rect := GetClientRect;
    GradVertical(Self.Canvas, Rect, clBlack, clRed);
end;