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.

Comments

Popular Posts