Implementación de un Canvas para modificar Objetos en Delphi parte XI

En éste artículo me dedicaré a explicaros como he resuelto el problema de las etiquetas. Dado que las líneas expresan un concepto, deberíamos poder indicarlo de alguna manera mediante una etiqueta (label) indicando una pequeña descripción de ésta. El problema empieza por saber dónde tengo que poner ese texto (ubicación exacta en coordenadas) y el ángulo exacto de inclinación que existe sobre la recta. El cálculo es relativamente fácil, ya que solo tenemos que calcular el angulo formado por dos puntos del plano, y buscar el punto médio de un segmento. Mediante éstos 2 cálculos ya tenemos el 50% del trabajo hecho. El otro 50% lo tenemos que completar buscando alguna forma para dibujar éste texto en ése punto con la inclinación dada. Pero para ésto tampoco hay ningún problema. Si os acordáis de mi post : Mostrar el texto en la orientación que queramos en un canvas, aquí describo como funciona el tema de las fuentes para dibujarlas en la orientación que queramos.

• 1. Calcular el ángulo formado por dos puntos del plano:

Mediante éste pequeña función obtendremos el cálculo:

function TAbstractLine.CalcAngleTwoPoints(Source, Target: TPoint): double;
var
 angle: double;
begin
 angle := 180 * (1 + ArcTan2(Source.y - Target.y, Target.x - Source.x) / PI);
 if angle >= 360.0 then
     angle := angle - 360.0;
 result := angle;
end;

• 2. Calcular el punto medio de un segmento:

Con éste cálculo obtenemos el punto medio:

 Position := Point((target.x + source.x) div 2, (target.y + source.y) div 2);

Ahora, la función que nos permite dibujar el tema de las descripciones es el siguiente:

procedure TAbstractLine.DrawTextOrientation(Source, Target: TPoint);

  function iif(condition: boolean; resultTrue: integer; resultFalse: integer): integer;
  begin
      result := resultFalse;
      if Condition then
          result := resultTrue
  end;
var
  newFont, FontSelected: integer;
  ft: TFont;
  angle: double;
  iAngle: integer;
  Position: TPoint;
begin
  ft := TFont.Create;
  ft.Name := 'Arial';
  ft.Size := 12;
  ft.Style := ft.Style - [fsBold, fsItalic, fsUnderline, fsStrikeOut];
  angle := CalcAngleTwoPoints(Source, Target);
  iAngle := Round(angle);
  Position := Point((target.x + source.x) div 2, (target.y + source.y) div 2);
  if FDescription = '' then
      exit;
  SetBkMode(Fcanvas.handle, transparent);
  newFont := CreateFont(
      -ft.Size,
      0,
      iAngle * 10,
      0,
      iif(fsBold in ft.Style, FW_BOLD, FW_NORMAL),
      iif(fsItalic in ft.Style, 1, 0),
      iif(fsUnderline in ft.Style, 1, 0),
      iif(fsStrikeOut in ft.Style, 1, 0),
      ANSI_CHARSET,
      OUT_TT_PRECIS,
      CLIP_DEFAULT_PRECIS,
      PROOF_QUALITY,
      FF_DONTCARE,
      PChar(ft.Name));

  FontSelected := SelectObject(Fcanvas.handle, newFont);
  TextOut(Fcanvas.handle, position.x, position.y, PChar(FDescription), length(FDescription));
  SelectObject(Fcanvas.handle, FontSelected);
  DeleteObject(newFont);
  FreeAndNil(ft);
end;

El resultado final, lo podéis comprobar en la siguiente imagen:

Aquí os dejo la última versión de la aplicación ThundaxBoxManager v1.0.0 Build 71.exe para que le echéis un vistazo y comprobéis el estado de la aplicación, que poco a poco va dando sus frutos.