2009. május 10., vasárnap
How to create isometric maps
Problem/Question/Abstract:
I'm planning to make an isometric map based game. Now, to do this, I need to know if the user clicked on one (or more) squares, for example, a building or a creature. I cannot figure out how to do this.
Answer:
Create a new project. On the form, create a TImage and align it to client. Also assign the form's OnCreate event, and the Image's OnMouseUp and OnMouseDown events. Paste this code into Unit1 and run. A 10x10 grid will be drawn. Click in it to highlight a square.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
public
end;
var
Form1: TForm1;
implementation
uses
Math;
{$R *.DFM}
var
XC: Integer;
YC: Integer;
LastX: Single;
LastY: Single;
const
Scale = 20;
procedure Map(const WorldX: Single; const WorldY: Single; out DisplayX: Integer;
out DisplayY: Integer);
begin
DisplayX := Round(XC + Scale * (WorldX - WorldY) * 0.5 * Sqrt(3));
DisplayY := Round(YC + Scale * (WorldX + WorldY) * 0.5);
end;
procedure UnMap(const DisplayX: Integer; const DisplayY: Integer; out WorldX: Single;
out WorldY: Single);
var
Sum: Single;
Diff: Single;
begin
Diff := (DisplayX - XC) / (0.5 * Scale * Sqrt(3));
Sum := (DisplayY - YC) / (0.5 * Scale);
WorldY := (Sum - Diff) / 2;
WorldX := Sum - WorldY;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
X1: Integer;
Y1: Integer;
X2: Integer;
Y2: Integer;
begin
XC := ClientWidth div 2;
YC := ClientHeight div 2;
with Image1.Picture.Bitmap do
begin
Width := Image1.Width;
Height := Image1.Height;
end;
for I := -5 to 5 do
begin
Map(I, 5, X1, Y1);
Map(I, -5, X2, Y2);
with Image1.Picture.Bitmap.Canvas do
begin
MoveTo(X1, Y1);
LineTo(X2, Y2);
end;
Map(5, I, X1, Y1);
Map(-5, I, X2, Y2);
with Image1.Picture.Bitmap.Canvas do
begin
MoveTo(X1, Y1);
LineTo(X2, Y2);
end;
end;
end;
procedure ColorizeCell(const Color: TColor);
var
PolygonData: array[0..3] of TPoint;
begin
if ((Abs(LastX) < 5) and (Abs(LastY) < 5)) then
begin
Map(Floor(LastX), Floor(LastY), PolygonData[0].X, PolygonData[0].Y);
Map(Floor(LastX), Ceil(LastY), PolygonData[1].X, PolygonData[1].Y);
Map(Ceil(LastX), Ceil(LastY), PolygonData[2].X, PolygonData[2].Y);
Map(Ceil(LastX), Floor(LastY), PolygonData[3].X, PolygonData[3].Y);
with Form1.Image1.Picture.Bitmap.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := Color;
Polygon(PolygonData);
end;
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Unmap(X, Y, LastX, LastY);
ColorizeCell(clRed);
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorizeCell(clWhite);
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
ColorizeCell(clWhite);
Unmap(X, Y, LastX, LastY);
ColorizeCell(clYellow);
end;
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése