| compuin |
20-09-2024 21:15:23 |
Evitar overlapping o sobreposicion
Saludos,
Estoy utilizando TImage y Canvas y necesito colocar 2 valores que estan en un array occupied: array[0..359] of integer;. Lo estoy intentando asi, sin exito
Código:
procedure WriteAtDeg(Image: TImage; deg: integer; what: string; isplanet, hasglyph: boolean;
PlanetPos: double; Retro: boolean; GlyphColor: tColor);
var
x, y: extended;
l, lplus: integer;
level: byte;
space: tSize;
CenterX, CenterY: Integer;
procedure SetFont(c: tCanvas; FontSizeBase: integer);
begin
with c do
begin
if hasglyph then
begin
Font.Name := 'StarFont Sans'; //'HamburgSymbols';
Font.Size := FontSizeBase div 18;
end
else
begin
Font.Name := 'Arial';
Font.Size := FontSizeBase div 18;
end;
end;
end;
begin
// Calcular el centro del TImage dinámicamente
CenterX := Image.Width div 2;
CenterY := Image.Height div 2;
// El radio de colocación siempre es el mismo para evitar que suban o bajen
if isplanet then
l := round(RadiusDiff * 1.65)
else
l := round(RadiusDiff / 2);
lplus := round(RadiusDiff * 0.7);
// Convertir el ángulo a coordenadas cartesianas
SinCos(degtorad(deg), y, x);
deg := (deg + 360) mod 360;
// Establecer la fuente
SetFont(Image.Canvas, RadiusInner);
//if not ((GlyphColor = clBlack) and ((what = 'AC') or (what = 'MC'))) then
// Dibujar el texto en la posición calculada con una separación entre capas
with Image.Canvas do
begin
Pen.Color := GlyphColor;
Font.Color := GlyphColor;
space := TextExtent(what);
TextOut(round(-x * (RadiusOuter - l - lplus * occupied[deg])) + CenterX - space.cx div 2,
round(y * (RadiusOuter - l - lplus * occupied[deg]) + CenterY - space.cy div 2), what);
...
Mi intencion es evitar que 2 valores proximos tengan sobreposicion o overlapping.
Agradecido de antemano cualquier ayuda |
