Texto Circular

[Marcb3]

Hola a todos,

¿Alguien sabe como escribir texto circular encimar de un Image que tengo en el Form? He estado buscando en todas partes pero no he encontrado como hacerlo!!

Gracias de antemano.

Marc.

[[duilioisola]]

Qué es texto ciruclar?

Te refieres a escribir siguiendo un círculo, como si fuera un CD?

[Marcb3]

Exactamente!

como hacen los programas de carátulas para CD, que siguen la forma del círculo. Yo lo haria con Photoshop, pero el texto debe ser dinámico.

Gracias.

[PeterPunk]

Pues hoy que he tenido algo del tiempo en el curro me piqué con esto y me salió este código:

Código Delphi [-]
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure TextoCircular(X, Y, Radio: integer; Texto: String;
                            Tamanho: Integer = 20;
                            NombreFuente: string = 'Arial');
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Align := alClient;
  Image1.Canvas.Brush.Color := Form1.Color;
  Image1.Canvas.FillRect(image1.Canvas.ClipRect);
end;
procedure TForm1.TextoCircular(X, Y, Radio: integer; Texto: String;
                        Tamanho: Integer = 20;
                        NombreFuente: string = 'Arial');
var
  lf: TLogFont;
  tf: TFont;
  i: integer;
  Puntos_Letras: array of TPoint;
  Angulo: integer;
begin
  SetLength(Puntos_Letras, Length(Texto));
  Angulo := round(360 / Length(Texto));
  for i := 0 to Length(Texto) - 1  do
    begin
      Puntos_Letras[i].X := round(Cos(Angulo * pi / 180 * i) * Radio);
      Puntos_Letras[i].Y := round(Sin(Angulo * pi / 180 * i) * Radio);
    end;
  with Image1.Canvas do
    begin
      Font.Name := NombreFuente;
      Font.Size := Tamanho;
      tf := TFont.Create;
      tf.Assign(Font);
      for i := 1 to Length(Texto) do
        begin
          GetObject(tf.Handle, Sizeof(lf), @lf);
          lf.lfEscapement := round(-1 * Angulo * (i - 1) * 10) + 2700;
          SetBkMode(Handle, Transparent);
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(X + Puntos_Letras[i - 1].X, Y + Puntos_Letras[i - 1].Y, Texto[i]);
        end;
      tf.Free;
    end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//  TextoCircular(form1.Width div 2, form1.Height div 2, 100, 'PeterPunk');
  TextoCircular(Image1.Width div 2, Image1.Height div 2, 125, 'PeterPunk', 16, 'Comic Sans MS');
end;
end.

Sólo necesitas poner un botón y una imagen* en el formulario para probarlo.

*al principio lo hice con el canvas del propio form, pero si pasabas otra ventana por encima se borraba, por lo que habría que jugar con el evento onpaint

Espero que te ayude.

Saludos.

[Marcb3]

PeterPunk,

Lo he probado y funciona muy bien. Ahora voy a probar a hacerlo editable, pero de eso me encargo yo.

Muchísimas gracias!