Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Texto Circular (https://www.clubdelphi.com/foros/showthread.php?t=53738)

Marcb3 28-02-2008 13:55:43

Texto Circular
 
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 28-02-2008 15:35:32

Qué es texto ciruclar?

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

Marcb3 28-02-2008 17:28:31

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 29-02-2008 13:55:46

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 29-02-2008 21:39:26

PeterPunk,

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

Muchísimas gracias!


La franja horaria es GMT +2. Ahora son las 18:34:59.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi