PDA

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