Mejorando el diseño de una flecha (Parte II)

He detectado un pequeño error en la composición de la flecha. Cuándo el ángulo representado es igual a pi/2 o -pi/2 la flecha no se dibuja correctamente, solo aparece la punta sin el relleno, es decir, el polígono no se dibuja correctamente. La solución (como siempre) es bastante fácil y solo hay que tener en cuenta la distribución geométrica de los puntos de representación de la punta de flecha. El problema reside en la comparación utilizando reales. Éstos no se pueden comparar realmente, ya que siempre son diferentes internamente, por lo tanto cuando el programa intenta comparar los valores de pi/2 con el valor calculado de pi/2 dice que no son iguales:

La funcion consiste en mirar si el valor absoluto del angulo difiere de un ángulo de pi/2, y si realizamos la comparación con el debugger no dirá que los valores no son iguales, y visualmente lo son.

Para evitar ésto utilizaré una función que os mostré hace tiempo en uno de mis posts para la comparación de reales: Comparando reales con delphi.

Mediante éste último arreglo, el framework (aún estoy pensando en que nombre darle, pero al final caerá algo como TWAIN Technology without an Interesting Name) tiene bastante resuelto todo el tema del cálculo para el repintado de las diferentes estructuras.

El código final del dibujado de la flecha es el siguiente:

procedure TAbstractLine.DrawFashionArrow(Source, Target: TPoint);
  function CalcPoint(p: TPoint; angle: double; Distance: integer): TPoint;
  var
      X, Y, M: double;
  begin
      if Comparar(Abs(angle),(PI / 2),'<>') then
      begin
          if Comparar(Abs(angle),(PI / 2),'<') then
              Distance := -Distance;
          M := Tan(angle);
          X := p.X + Distance / sqrt(1 + sqr(M));
          Y := p.Y + M * (X - p.X);
          Result := Point(round(X), round(Y));
      end
      else
      begin
          if angle > 0 then
              Distance := -Distance;
          Result := Point(p.X, p.Y + Distance);
      end;
  end;

var
  angle: double;
  PArrow: array[1..4] of TPoint;
  restColor: TColor;
begin
  if (Distance(Source, Target) < 20.0) or (Distance(Source, Target) > 2000.0) then
      exit;
  angle := ArcTan2((Target.Y - Source.Y), (Target.X - Source.X));
  PArrow[1] := Target;
  PArrow[2] := CalcPoint(Target, angle + PI / 9, LenArrow);
  PArrow[3] := CalcPoint(Target, angle, 2 * LenArrow div 3);
  PArrow[4] := CalcPoint(Target, angle - PI / 9, LenArrow);
  FCanvas.Pen.Width := 1;
  if FInside then
      FCanvas.Pen.Color := FSelectedColor
  else
      FCanvas.Pen.Color := FLineColor;
  FCanvas.Brush.Style := bsSolid;
  restColor := FCanvas.Brush.Color;
  if Ffilled then
      FCanvas.Brush.Color := FFillColor;
  FCanvas.Polygon(PArrow);
  FCanvas.Brush.Color := restColor;
end;

La actualización de la función de comparación también la dejo ya que faltaba un operador de comparación:

uses types, Math;

function Comparar(Value1, Value2: double; MethodComp: string): boolean;

const
  RealMargin = 0.000001; //1e-6

implementation

function Comparar(Value1, Value2: double; MethodComp: string): boolean;
var
  ret: boolean;
begin
  ret := false;
  if MethodComp = '=' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          EqualsValue: ret := true;
      end;
  end
  else if MethodComp = '<>' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          LessThanValue: ret := true;
          GreaterThanValue: ret := true;
      end;
  end
  else if MethodComp = '>=' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          EqualsValue: ret := true;
          GreaterThanValue: ret := true;
      end;
  end
  else if MethodComp = '>' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          GreaterThanValue: ret := true;
      end;
  end
  else if MethodComp = '<=' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          LessThanValue: ret := true;
          EqualsValue: ret := true;
      end;
  end
  else if MethodComp = '<' then
  begin
      case CompareValue(Value1, Value2, RealMargin) of
          LessThanValue: ret := true;
      end;
  end;
  result := ret;
end;

Ahora, el dibujado de las flechas es perfecto:

Espero que os sirva de ayuda.