Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   No dibuja glifo en TImage (https://www.clubdelphi.com/foros/showthread.php?t=96753)

compuin 22-06-2024 01:51:28

No dibuja glifo en TImage
 
Saludos

Estoy tratando de crear una imagen a partir de una cadena de caracteres. La imagen es la de un circulo con un punto central.

Este codigo solo me genera la mitad de la imagen, sera que me estoy saltando algo adicional? Agradezco cualquier sugerencia

Código Delphi [-]
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure DrawGlyph(const glyph: string; const x, y: Integer; const Canvas: TCanvas);
  public
  end;

var
  Form1: TForm1;

const
  glyphs: array[0..0] of string = (
    'U0BH3DGD2FDRFR2ERUEU2HULHL2GL'
  );

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.Bitmap.SetSize(1000, 800); // Tamaño del bitmap ajustado para un solo glifo
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
  DrawGlyph(glyphs[0], 5, 5, Image1.Picture.Bitmap.Canvas); // Dibuja solo el primer glifo
  Image1.Refresh; // Actualiza el TImage para mostrar los cambios
end;

procedure TForm1.DrawGlyph(const glyph: string; const x, y: Integer; const Canvas: TCanvas);
var
  i: Integer;
  val, cx, cy: Int64;
  cmd: Char;
  dx, dy: Int64;
begin
  cx := x + 2;
  cy := y + 2;
  Canvas.MoveTo(cx, cy);

  i := 1;
  while i <= Length(glyph) do
  begin
    cmd := glyph[i];
    Inc(i);
    val := 0;
    while (i <= Length(glyph)) and (glyph[i] in ['0'..'0']) do
    begin
      val := val * 10 + (Ord(glyph[i]) - Ord('0'));
      Inc(i);
    end;

    case cmd of
      'N': dy := -val;
      'S': dy := val;
      'E': dx := val;
      'W': dx := -val;
      'U': dx := -val;
      'D': dy := val;
      'B': Canvas.MoveTo(cx, cy);
      'F': begin
             Canvas.LineTo(cx, cy);
             Canvas.Pen.Width := 2; // Grosor de línea aumentado para mejor visibilidad
           end;
      else dx := 0; dy := 0;
    end;

    if cmd in ['N', 'S', 'E', 'W', 'U', 'D'] then
    begin
      cx := cx + dx;
      cy := cy + dy;
      Canvas.LineTo(cx, cy);
    end
    else if cmd in ['B'] then
      Canvas.MoveTo(cx, cy)
    else if cmd in ['F'] then
      Canvas.LineTo(cx, cy);
  end;
end;

end.

Casimiro Noteví 22-06-2024 10:56:09

Así un poco por encima, deberías inicializar dx y dy antes de evaluar su valor en el case:
Código Delphi [-]
dx := 0; 
dy := 0; 
case cmd of
Luego, ¿Esto es correcto? array[0..0] ¿?

Código Delphi [-]
const
  glyphs: array[0..0] of string = ('U0BH3DGD2FDRFR2ERUEU2HULHL2GL');
Código Delphi [-]
while (i <= Length(glyph)) and (glyph[i] in ['0'..'0']) do


La franja horaria es GMT +2. Ahora son las 14:24:33.

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