How to create isometric maps

Mirror

How to create isometric maps (Views: 702)

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.

<< Back to main page