Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 22-06-2024
compuin compuin is offline
Miembro
 
Registrado: oct 2010
Posts: 216
Poder: 14
compuin Va por buen camino
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.

Última edición por compuin fecha: 22-06-2024 a las 01:58:51.
Responder Con Cita
  #2  
Antiguo 22-06-2024
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.182
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
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
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Girar un Timage con respecto a otro Timage Tuvan Gráficos 1 05-11-2016 21:30:50
Al hacer scroll no se dibuja un rectángulo en una celda de un dbgrid isnagil Varios 0 14-02-2011 18:38:50
No me dibuja en un label en el tiempo correcto noob Varios 5 11-02-2009 23:15:38
como Hacer que un TImage siga a un Timage? j_flores3000 OOP 8 27-03-2008 18:47:50
como combinar 2 Timage en un tercer Timage JefeNet Gráficos 10 02-09-2004 16:51:35


La franja horaria es GMT +2. Ahora son las 21:28:18.


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
Copyright 1996-2007 Club Delphi