heightmap.dpr

此為國外大名鼎鼎的2D遊戲引擎HGE的Delphi版本 原官方是C++的,現在完全改為Delphi可使用,另外再增加許多單元與功能 新增的單元有HGEImages,HGECanvas,HGEDef

      Canvas.Draw(Images[Player.PicNum],Player.CellPic, PosX - 64, PosY - 104,Blend_Default);
  end
  else
  begin
   // the actual drawing of tiles
      Canvas.Draw4V(Images[Player.PicNum],
      Player.CellPic,
      PosX - 64, PosY - 64,
      PosX - 32, PosY - 64,
      PosX + 16, PosY,
      PosX - 16, PosY,
      False, False,
      ARGB(48,0, 0, 0),
      ARGB(48,0, 0, 0),
      ARGB(48,0, 0, 0),
      ARGB(48,0, 0, 0),
      Blend_Default);
     Canvas.Draw(Images[Player.PicNum], Player.CellPic, PosX - 16, PosY - 64, Blend_Default);
  end
end;

{
 Draw the ground objects stored in a Tlist
}

procedure DrawGroundObject(PosX, PosY, Index: Integer); // index is index of the ObjectList
begin
 //   posx := trunc(LEFTOFFSET+(x * TILEWIDTH));
 //  posy := trunc(TOPOFFSET+(y * TILEHEIGHT))-MapInfo.ph[x,y];
  if not ShowCheckers then
  begin
   // the actual drawing of tiles
      Canvas.Draw4V(Images[TGroundObject(ObjectList[Index]).PicNum],
      TGroundObject(ObjectList[Index]).CellPic,
      PosX - 70, PosY - 40,
      PosX - 6, PosY - 40,
      PosX + 64, PosY + 20,
      PosX, PosY + 20,
      False, False,
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      Blend_Default);

   // the actual drawing of tiles
      Canvas.Draw4V(Images[TGroundObject(ObjectList[Index]).PicNum],
      TGroundObject(ObjectList[Index]).CellPic,
      PosX, PosY - 96,
      PosX + 64, PosY - 96,
      PosX + 64, PosY + 20,
      PosX, PosY + 20,
      False, False,
      $FFFFFFFF,
      Blend_Default);
  end
  else
  begin
   // the actual drawing of tiles
   // shadow
      Canvas.Draw4v(Images[13],
      TGroundObject(ObjectList[Index]).CellPic,
      PosX - 100, PosY - 80,
      PosX - 36, PosY - 80,
      PosX + 64, PosY + 20,
      PosX, PosY + 20,
      False, False,
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      ARGB(96, 0, 0, 0),
      Blend_Default);

  // the actual drawing of tiles

      Canvas.Draw4V(Images[13],
      TGroundObject(ObjectList[Index]).CellPic,
      PosX, PosY - 96,
      PosX + 64, PosY - 96,
      PosX + 64, PosY + 20,
      PosX, PosY + 20,
      False, False,
      $FFFFFFFF,
      Blend_Default);
  end
end;

procedure MakeMountains;
var
  X, Y: Integer;
begin
  for X := 0 to MAPXSIZE do
    for Y := 0 to MAPYSIZE do
    begin
      if (MapInfo.Ph[X, Y] < 20) and (MapInfo.Layers[4].Plane[X, Y].Alpha > 1) then MapInfo.Layers[4].Plane[X, Y].Alpha := 30 - MapInfo.Ph[X, Y];
      if (MapInfo.Ph[X, Y] > 40) and (MapInfo.Layers[4].Plane[X, Y].Alpha > 1) then MapInfo.Layers[4].Plane[X, Y].Alpha := 100 - MapInfo.Ph[X, Y];
    //  if (MapInfo.ph[x,y]>50) and (mapinfo.layers[4].plane[x,y].alpha>1)then mapinfo.layers[4].plane[x,y].alpha := 0;//100-MapInfo.ph[x,y];

      if (MapInfo.Ph[X, Y] > 40) and (MapInfo.Layers[2].Plane[X, Y].Alpha > 1) then MapInfo.Layers[2].Plane[X, Y].Alpha := 70 - MapInfo.Ph[X, Y];

      if MapInfo.Layers[4].Plane[X, Y].Alpha < 2 then MapInfo.Layers[4].Plane[X, Y].Alpha := 1;
      if MapInfo.Layers[4].Plane[X, Y].Alpha > 255 then MapInfo.Layers[4].Plane[X, Y].Alpha := 255;

      if MapInfo.Layers[2].Plane[X, Y].Alpha < 2 then MapInfo.Layers[2].Plane[X, Y].Alpha := 1;
      if MapInfo.Layers[2].Plane[X, Y].Alpha > 255 then MapInfo.Layers[2].Plane[X, Y].Alpha := 255;
    end;
end;

procedure CalculateDarkness;
var
  i, j, k, m, cd: Integer;
begin
  for i := 0 to MAPXSIZE do
    for j := 0 to MAPYSIZE do
    begin
      MapInfo.Darkness[i, j] := 220;
    end;

  for i := 1 to MAPXSIZE - 1 do
    for j := 1 to MAPYSIZE - 1 do
    begin
      if MapInfo.Ph[i, j] > MapInfo.Ph[i - 1, j - 1] then
        MapInfo.Darkness[i - 1, j - 1] := Dan_Limit(
          MapInfo.Darkness[i - 1, j - 1] - (MapInfo.Ph[i, j] - MapInfo.Ph[i - 1, j - 1]) * 5,
          90, MapInfo.Darkness[i - 1, j - 1]);

      if MapInfo.Ph[i, j] > MapInfo.Ph[i - 1, j] then
        MapInfo.Darkness[i - 1, j] := Dan_Limit(
          MapInfo.Darkness[i - 1, j] - (MapInfo.Ph[i, j] - MapInfo.Ph[i - 1, j]) * 4,
          90, MapInfo.Darkness[i - 1, j]);

      if MapInfo.Ph[i, j] > MapInfo.Ph[i, j - 1] then
        MapInfo.Darkness[i, j - 1] := Dan_Limit(
          MapInfo.Darkness[i, j - 1] - (MapInfo.Ph[i, j] - MapInfo.Ph[i, j - 1]) * 4,
          90, MapInfo.Darkness[i, j - 1]);

      m := MapInfo.Ph[i, j];
      Inc(m, -TileHeight * 2);
      k := 2;
      while (m > TileHeight * 2) do
      begin
        cd := MapInfo.Darkness[i - k, j - k];
        if MapInfo.Ph[i, j] > MapInfo.Ph[i - k, j - k] then
          MapInfo.Darkness[i - k, j - k] := Dan_Limit(
            MapInfo.Darkness[i - k, j - k] - (MapInfo.Ph[i, j] - MapInfo.Ph[i - k, j - k]) * 5,
            Dan_Limit(90 + k * 7, 0, cd), cd);
        Inc(k);
        Inc(m, -TileHeight * 2);
      end;
    end;

  for i := 0 to MAPXSIZE do
    for j := 0 to MAPYSIZE do
    begin
      MapInfo.Darkness[i, j] := MapInfo.Darkness[i, j] + MapInfo.ExternalLight[i, j];
      if MapInfo.Darkness[i, j] > 255 then MapInfo.Darkness[i, j] := 255;
      if MapInfo.Darkness[i, j] < 1 then MapInfo.Darkness[i, j] := 1;
    end;
end;

procedure LoadMap;
var
  i, j, l: Integer;
  Stream: TFileStream;
  TempFileName, TmpStr: string[255];
begin
  if not fileexists(Lowercase(ExtractFilePath(paramstr(0))) + 'WorldMap.sav') then exit;
  TempFileName := Lowercase(ExtractFilePath(paramstr(0))) + 'WorldMap.sav';

  try
    Stream := TFileStream.Create(TempFileName, fmOpenRead);
    with Stream do
    begin
      Read(Player.Tx, SizeOf(Player.Tx));
      Read(Player.Ty, SizeOf(Player.Ty));

      for j := 0 to MAPXSIZE do // save the map
        for i := 0 to MAPXSIZE do
        begin
          for l := 1 to NUMLAYERS do
            Read(MapInfo.Layers[l].Plane[i, j], SizeOf(MapInfo.Layers[l].Plane[i, j]));
          Read(MapInfo.Ph[i, j], SizeOf(MapInfo.Ph[i, j]));
          Read(MapInfo.Darkness[i, j], SizeOf(MapInfo.Darkness[i, j]));
          Read(MapInfo.ExternalLight[i, j], SizeOf(MapInfo.ExternalLight[i, j]));
        end;

    end;
  finally
    if Stream <> nil then Stream.Free;
  end;
end;

procedure CreateGame;
var
  X, Y: Integer; a, b: Double;
begin
  TileWidth := 64;
  TileHeight := 48;

  randomize; Randseed := timeGetTime;
  PlateauHeight := -10;

  for X := 0 to MAPXSIZE do
    for Y := 0 to MAPYSIZE do
    begin
      // Set up some heights to start with
      a := (sin(DegToRad(X * 30)) * 9);
      b := (cos(DegToRad(Y * 30)) * 9);
      MapInfo.Ph[X, Y] := Round(a * b); //round(a*b)+(random(3));//*trunc(a));//PlateauHeight;//round(a*b);

      if Random(10) = 0 then
        MapInfo.Layers[2].Plane[X, Y].Alpha := 220 - (Random(50))
      else
        MapInfo.Layers[2].Plane[X, Y].Alpha := 255;

      MapInfo.Layers[1].Plane[X, Y].Alpha := 255; //-mapinfo.layer[2].plane[x,y].alpha;

      MapInfo.Layers[3].Plane[X, Y].Alpha := 0;
      MapInfo.Layers[4].Plane[X, Y].Alpha := 255;
      MapInfo.Layers[5].Plane[X, Y].Alpha := 0;

      if (X mod 2 = 0) and (Y mod 2 = 0) then
      begin
        MapInfo.Layers[5].Plane[X, Y].PicNumber := 5;
        MapInfo.Layers[5].Plane[X, Y].Alpha := 255;
      end
      else
        if (X mod 2 = 1) and (Y mod 2 = 1) then
        begin
          MapInfo.Layers[5].Plane[X, Y].PicNumber := 5;
          MapInfo.Layers[5].Plane[X, Y].Alpha := 255;
        end
        else
        begin
          MapInfo.Layers[5].Plane[X, Y].PicNumber := 6;
          MapInfo.Layers[5].Plane[X, Y].Alpha := 255;
        end;

      MapInfo.Layers[1].Plane[X, Y].PicNumber := ROCKPIC;
      MapInfo.Layers[1].Plane[X, Y].CellNumber := Random(5); ;
      MapInfo.Layers[2].Plane[X, Y].PicNumber := GRASSPIC;
      MapInfo.Layers[2].Plane[X, Y].CellNumber := Random(5);
      MapInfo.Layers[4].Plane[X, Y].PicNumber := MUDPIC;
      MapInfo.Layers[4].Plane[X, Y].CellNumber := Random(5);

      MapInfo.ContainsObject[X, Y] := False;
    end;

  MapInfo.Cutoff := 5;
  MapInfo.CurrentLayer := 2;
  MapInfo.Layers[1].CurrentImage := ROCKPIC;
  MapInfo.Layers[2].CurrentImage := GRASSPIC;
  MapInfo.Layers[3].CurrentImage := WATERPIC;
  MapInfo.Layers[4].CurrentImage := MUDPIC;
  MapInfo.Layers[5].CurrentImage := GRASSPIC2;

  Blendmode := 0;

  MakeMountains; // high mountains have layer 2 removed to expose rock

  CalculateDarkness;

  LEFTOFFSET := -500; TOPOFFSET := -500;
//  SetCursorPos(self.Left + (SCRWIDTH div 2), self.top + (SCRheight div 2));

  with Player do
  begin
    Tx := 15;
    Ty := 23;
    Fx := TileWidth div 2;
    Fy := TileHeight div 2;
    PicNum := 9;
    CellPic := 0;
    MoveDir := 0;
  end;

  ObjectList := Tlist.Create;
  for X := 1 to 200 do
  begin
    ObjectInst := TGroundObject.Create;
    with ObjectInst do
    begin
      Tx := 1 + Random(90);
      Ty := 1 + Random(90);
      PicNum := PALMPIC;
      CellPic := Random(5);
      MapInfo.ContainsObject[Tx, Ty] := True;
    end;
    ObjectList.Add(ObjectInst);
  end;
  if fileexists(Lowercase(ExtractFilePath(paramstr(0))) + 'WorldMap.sav') then LoadMap;

  CentrePlayer;
end;

procedure FreeObjects;
begin
  while ObjectList.count > 0 do
  begin
    TGroundObject(ObjectList[0]).Free;
    ObjectList.Delete(0);
  end;
  ObjectList.Free;
end;

procedure DoMouseMove;
begin
  MapInfo.ShowCursorTime := timeGetTime + 1200;
 // where is the cursor?
  CellX := Trunc((MouseX - LEFTOFFSET) / TileWidth);
  CellY := Trunc((MouseY - TOPOFFSET) / TileHeight);

  if CellX < 1 then CellX := 1;
  if CellY < 1 then CellY := 1;
  if CellX > MAPXSIZE - 1 then CellX := MAPXSIZE - 1;
  if CellY > MAPYSIZE - 1 then CellY := MAPYSIZE - 1;

 // flatten the ground
 {
  if ssshift in Shift then
  begin
    for i := CellX - 1 to CellX + 1 do
      for j := CellY - 1 to CellY + 1 do
        MapInfo.Ph[i, j] := PlateauHeight;

    CalculateDarkness;
  end
  }
end;

procedure MoveGround(MoveDown: Boolean; Cx, Cy: Integer);
begin
  if MoveDown then
  begin

    if not HGE.Input_GetKeyState(HGEK_ALT ) then // if alt is not held then do normal move down
    begin
      MapInfo.Ph[Cx - 1, Cy - 1] := MapInfo.Ph[Cx - 1, Cy - 1] - 3;
      MapInfo.Ph[Cx, Cy - 1] := MapInfo.Ph[Cx, Cy - 1] - 5;
      MapInfo.Ph[Cx + 1, Cy - 1] := MapInfo.Ph[Cx + 1, Cy - 1] - 3;

      MapInfo.Ph[Cx - 1, Cy] := MapInfo.Ph[Cx - 1, Cy] - 5;
      MapInfo.Ph[Cx, Cy] := MapInfo.Ph[Cx, Cy] - 6;
      MapInfo.Ph[Cx + 1, Cy] := MapInfo.Ph[Cx + 1, Cy] - 5;

      MapInfo.Ph[Cx - 1, Cy + 1] := MapInfo.Ph[Cx - 1, Cy + 1] - 3;
      MapInfo.Ph[Cx, Cy + 1] := MapInfo.Ph[Cx, Cy + 1] - 5;
      MapInfo.Ph[Cx + 1, Cy + 1] := MapInfo.Ph[Cx + 1, Cy + 1] - 3;

    end
    else
    begin // if alt is  held then do move down one vertix only
      MapInfo.Ph[Cx, Cy] := MapInfo.Ph[Cx, Cy] - 6;
    end;
  end
  else
  begin
    if not HGE.Input_GetKeyState(HGEK_ALT) then // if alt is not held then do normal move down
    begin
      MapInfo.Ph[Cx - 1, Cy - 1] := MapInfo.Ph[Cx - 1, Cy - 1] + 3;
      MapInfo.Ph[Cx, Cy - 1] := MapInfo.Ph[Cx, Cy - 1] + 5;
      MapInfo.Ph[Cx + 1, Cy - 1] := MapInfo.Ph[Cx + 1, Cy - 1] + 3;

      MapInfo.Ph[Cx - 1, Cy] := MapInfo.Ph[Cx - 1, Cy] + 5;
      MapInfo.Ph[Cx, Cy] := MapInfo.Ph[Cx, Cy] + 6;
      MapInfo.Ph[Cx + 1, Cy] := MapInfo.Ph[Cx + 1, Cy] + 5;

      MapInfo.Ph[Cx - 1, Cy + 1] := MapInfo.Ph[Cx - 1, Cy + 1] + 3;
      MapInfo.Ph[Cx, Cy + 1] := MapInfo.Ph[Cx, Cy + 1] + 5;
      MapInfo.Ph[Cx + 1, Cy + 1] := MapInfo.Ph[Cx + 1, Cy + 1] + 3;
    end
    else
    begin // if alt is  held then do move down one vertix only
      MapInfo.Ph[Cx, Cy] := MapInfo.Ph[Cx, Cy] + 6;
    end;
  end;
  CalculateDarkness;
end;

// for example, fog of war, the sun or clouds
procedure LightGround(Lighten: Boolean; Cx, Cy: Integer);
begin
  if Lighten then
  begin
    MapInfo.ExternalLight[Cx - 1, Cy - 1] := MapInfo.ExternalLight[Cx - 1, Cy - 1] - 3;
    MapInfo.ExternalLight[Cx, Cy - 1] := MapInfo.ExternalLight[Cx, Cy - 1] - 5;
    MapInfo.ExternalLight[Cx + 1, Cy - 1] := MapInfo.ExternalLight[Cx + 1, Cy - 1] - 3;