Ver la Versión Completa : Crear Grid sobre Canvas
compuin
02-11-2016, 11:59:51
Saludos
Quien pudiera orientarme en como crear un grid sobre un Canvas con la siguente caracteristica
- Grid 7 x7 y como base 7 cuadros. A medida vaya ascendiendo restarle un cuadro hasta que el el tope solo aparecza 1 cuadro.
Tratare de colocar un grafico que muestre lo que necesito.
Gracias
Neftali [Germán.Estévez]
02-11-2016, 13:13:46
Yo te diría que comenzaras por colocar un TPaintBox en un formulario, y sobre él empieces a pintar líneas...
Por ejemplo, coloca un botón con el siguiente código. Algo así debería pintar algo parecido a lo que necesitas.
var
I: Integer;
x, y:integer;
begin
PaintBox1.Canvas.Pen.Width := 2;
PaintBox1.Canvas.Pen.Color := clBlack;
PaintBox1.Canvas.Pen.Style := psSolid;
PaintBox1.Canvas.MoveTo(10, 10);
PaintBox1.Canvas.LineTo(10, 410); // Vertical
PaintBox1.Canvas.LineTo(410, 410); // horizontal
for i := 1 to 10 do begin
x := 10 + (40*I);
y := 10 + (40*I);
PaintBox1.Canvas.MoveTo(x, y);
PaintBox1.Canvas.LineTo(x, 410); // vertical
PaintBox1.Canvas.MoveTo(x, y);
PaintBox1.Canvas.LineTo(10, y);
end;
compuin
02-11-2016, 13:20:28
Muchisimas gracias, es justo lo que necesito.
Ahora bien, hay alguna posibilidad de eliminar las lineas finales en los extremos para que quede un cuadrado perfecto ?
ecfisa
02-11-2016, 13:21:18
Hola.
Otra opcíon,
procedure MakeSquares(aCanvas: TCanvas; const pInit: TPoint;
const ncuad, size: Integer);
var
x, y: Integer;
p : TPoint;
begin
p.Y := pInit.Y;
for y := 1 to ncuad do
begin
p.X := pInit.X;
for x := 1 to y do
begin
aCanvas.Rectangle( p.X - 1, p.Y - 1, p.X + size, p.Y + size);
Inc( p.X, size );
end;
Inc( p.Y, size);
end;
end;
Ejemplo llamada:
procedure TForm1.btnStartClick(Sender: TObject);
begin
MakeSquares(Canvas, Point( 70, 30 ), 7, 20);
end;
Saludos :)
compuin
02-11-2016, 13:34:57
Gracias escfisa
Como llamo a la MakeSquare ?
ecfisa
02-11-2016, 13:54:03
Hola
Como llamo a la MakeSquare ?
Tál como está en el mensaje anterior.
Por ejemplo, usando como lienzo un TPanel en lugar del Form
...
type
TPanel = class(ExtCtrls.TPanel);
TForm1 = class(TForm)
btnStart: TButton;
Panel1: TPanel;
procedure btnStartClick(Sender: TObject);
...
implementation
procedure MakeSquares(aCanvas: TCanvas; const pInit: TPoint;
const ncuad, size: Integer);
var
x, y: Integer;
p : TPoint;
begin
p.Y := pInit.Y;
for y := 1 to ncuad do
begin
p.X := pInit.X;
for x := 1 to y do
begin
aCanvas.Rectangle( p.X - 1, p.Y - 1, p.X + size, p.Y + size);
Inc( p.X, size );
end;
Inc( p.Y, size);
end;
end;
// Evento OnClick de un TButton
procedure TForm1.btnStartClick(Sender: TObject);
begin
MakeSquares(Panel1.Canvas, Point( 70, 30 ), 7, 20); // <-- AQUI LO ESTAS LLAMANDO
end;
...
Salida:
https://s14.postimg.org/424gsge29/compuin.png
Saludos :)
compuin
02-11-2016, 14:11:49
Gracias
Ya la pude llamar pero no me aparece dentro del Image sino en el formulario...como corrijo eso?
ecfisa
02-11-2016, 14:41:50
Gracias
Ya la pude llamar pero no me aparece dentro del Image sino en el formulario...como corrijo eso?
MakeSquares( Image1.Canvas, Point( 70, 30 ), 7, 20 );
Saludos :)
compuin
02-11-2016, 14:44:31
Asi lo hice
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure MakeSquares(Image1: TCanvas; const pInit: TPoint;
const ncuad, size: Integer);
var
x, y: Integer;
p : TPoint;
begin
p.Y := pInit.Y;
for y := 1 to ncuad do
begin
p.X := pInit.X;
for x := 1 to y do
begin
Image1.Rectangle( p.X - 1, p.Y - 1, p.X + size, p.Y + size);
Inc( p.X, size );
end;
Inc( p.Y, size);
end;
end;
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
MakeSquares(Canvas, Point( 70, 30 ), 7, 20); // <== AQUI LA ESTAS LLAMANDO
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MakeSquares(Canvas, Point( 70, 30 ), 7, 20); // <== AQUI LA ESTAS LLAMANDO
end;
end.
Y asi me aparece
compuin
02-11-2016, 14:46:09
Esta es la ventana con el Canvas
ecfisa
02-11-2016, 14:53:45
Hola.
No veo como te aparece, pero aquí te va un ejemplo en el que dibujo la figura en el TForm, en un TPanel y en un TImage:
https://s3.postimg.org/fw8l30us3/compuin.png
Te adjunto el código fuente del ejemplo para que lo revises con tranquilidad.
Saludos :)
compuin
02-11-2016, 14:59:17
Muchas gracias.
Lo revisare
compuin
02-11-2016, 15:27:27
Gracias
Muy bueno tu codigo
Si yo quisiera agregarle letras en cada celda, que funcion o procedimiento me podrias sugerir ?
ecfisa
02-11-2016, 16:07:14
Hola.
El método TextOut (http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Graphics_TCanvas_TextOut.html) de la clase TCanvas (http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Graphics_TCanvas.html).
Saludos :)
compuin
02-11-2016, 16:12:15
Lo coloque asi y me arroja error
image2.Canvas.TextOut('Hola');
ecfisa
02-11-2016, 16:25:18
Hola.
Así es... y es lógico que te lo dé.
Si revisas el enlace que te agregué en el mensaje anterior, verás que te faltan pasarle dos argumentos al método TextOut.
image2.Canvas.TextOut( 10, 50, 'Hola' );
Saludos :)
compuin
02-11-2016, 16:27:37
Con los argumentos se presenta asi
Que esta mal?
ecfisa
02-11-2016, 16:36:59
Hola.
La verdad es, que no sé que código usas ni como lo estas usando...
De este modo,
...
begin
MakeSquares(Image1.Canvas, Point( 10, 10 ), 7, 30 );
Image1.Canvas.TextOut(12,12, 'Hola');
end;
obtengo este resultado:
https://s14.postimg.org/bnv71dwi9/compuin2.png
Saludos :)
compuin
02-11-2016, 16:43:39
Lo hice asi
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TPanel = class(ExtCtrls.TPanel);
TForm1 = class(TForm)
btnStart: TButton;
Panel1: TPanel;
Image1: TImage;
procedure btnStartClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation {$R *.dfm}
procedure MakeSquares(aCanvas: TCanvas; const pInit: TPoint;
const ncuad, size: Integer);
var
x, y: Integer;
p : TPoint;
begin
p.Y := pInit.Y;
for y := 1 to ncuad do
begin
p.X := pInit.X;
for x := 1 to y do
begin
aCanvas.Rectangle( p.X - 1, p.Y - 1, p.X + size, p.Y + size);
Inc( p.X, size );
end;
Inc( p.Y, size);
end;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
MakeSquares(Canvas, Point( 70, 30 ), 7, 20);
MakeSquares(Panel1.Canvas, Point( 70, 30 ), 7, 20);
MakeSquares(Image1.Canvas, Point( 70, 30 ), 7, 20);
Image1.Canvas.TextOut(12,12, 'Hola');
end;
end.
Y me pone la imagen asi
compuin
02-11-2016, 17:14:31
Ya vi mi error
vBulletin v3.6.8, Derechos ©2000-2024, Jelsoft Enterprises Ltd.