⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 isoengine.pas

📁 类似文明的游戏源代码。
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{$INCLUDE switches}

unit IsoEngine;

interface

uses
  Protocol,ClientTools,Term,ScreenTools,Tribes,

  Windows,SysUtils,Classes,Graphics;

procedure Init;
procedure Done;
procedure Reset;

type
TIsoMap = class
  constructor Create;
  procedure SetOutput(Output: TBitmap);
  procedure SetPaintBounds(Left, Top, Right, Bottom: integer);
  procedure Paint(x,y,Loc,nx,ny,CityLoc,CityOwner:integer);
  procedure PaintUnit(x,y:integer;const UnitInfo:TUnitInfo;Status:integer);
  procedure PaintCity(x,y:integer;const CityInfo:TCityInfo; accessory: boolean = true);

  procedure AttackBegin(const ShowMove: TShowMove);
  procedure AttackEffect(const ShowMove: TShowMove);
  procedure AttackEnd;

protected
  FOutput: TBitmap;
  FLeft, FTop, FRight, FBottom, AttLoc, DefLoc, DefHealth: integer;
  OutDC, DataDC, MaskDC: Cardinal;
  function Connection4(Loc,Mask,Value:integer):integer;
  function Connection8(Loc,Mask:integer):integer;
  function OceanConnection(Loc: integer): integer;
  procedure PaintShore(x,y,Loc:integer);
  procedure PaintTileExtraTerrain(x,y,Loc: integer);
  procedure PaintTileObjects(x,y,Loc,CityLoc,CityOwner:integer);
  procedure PaintGrid(x,y,nx,ny: integer);
  procedure FillRect(x,y,Width,Height,Color: integer);
  procedure Textout(x,y,Color: integer; const s: string);
  procedure BitBlt(Src: TBitmap; x,y,Width,Height,xSrc,ySrc,Rop: integer);
  procedure Sprite(HGr,xDst,yDst,Width,Height,xGr,yGr: integer);
  procedure TSprite(xDst,yDst,grix: integer);
  end;

var
NoMap: TIsoMap;

implementation

const
FBounds=true;
ShoreDither=fGrass;

var
BordersOK: integer;
LandPatch,OceanPatch, Borders: TBitmap;
TSpriteSize: array[0..16*9-1] of TRect;
DebugMap: ^TTileList;
FoW, ShowLoc, ShowCityNames, ShowObjects, ShowBorder, ShowMyBorder,
  ShowGrWall, ShowDebug: boolean;

procedure Init;
type
TLine=array[0..9*65,0..2] of Byte;
var
i,x,y,xSrc,ySrc:integer;
LandMore,OceanMore,DitherMask,Mask24: TBitmap;
MaskLine: array[0..31] of ^TLine;
Border: boolean;
begin
{now prepare dithered ground tiles}
LandPatch:=TBitmap.Create;
if TrueColor=1 then
  LandPatch.PixelFormat:=pf24bit;
LandPatch.Canvas.Brush.Color:=0;
LandPatch.Width:=66*9; LandPatch.Height:=16*9;
OceanPatch:=TBitmap.Create;
if TrueColor=1 then
  OceanPatch.PixelFormat:=pf24bit;
OceanPatch.Canvas.Brush.Color:=0;
OceanPatch.Width:=66*4; OceanPatch.Height:=16*4;
LandMore:=TBitmap.Create;
if TrueColor=1 then
  LandMore.PixelFormat:=pf24bit;
LandMore.Canvas.Brush.Color:=0;
LandMore.Width:=66*9; LandMore.Height:=16*9;
OceanMore:=TBitmap.Create;
if TrueColor=1 then
  OceanMore.PixelFormat:=pf24bit;
OceanMore.Canvas.Brush.Color:=0;
OceanMore.Width:=66*4; OceanMore.Height:=16*4;
DitherMask:=TBitmap.Create;
if TrueColor=1 then
  DitherMask.PixelFormat:=pf24bit;
DitherMask.Width:=66; DitherMask.Height:=32;
BitBlt(DitherMask.Canvas.Handle,0,0,64,32,GrExt[HGrTerrain].Mask.Canvas.Handle,
  456,496,SRCAND);

for x:=-1 to 6 do
  begin
  if x=-1 then begin xSrc:=ShoreDither*65+1; ySrc:=1 end
  else if x=6 then begin xSrc:=131; ySrc:=67 end
  else begin xSrc:=(x+2)*65+1; ySrc:=1 end;
  for y:=-1 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66+1,(y+2)*16,64,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY);
  for y:=-2 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66,(y+2)*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+32,ySrc+16,SRCPAINT);
  for y:=-2 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66+34,(y+2)*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+16,SRCPAINT);
  for y:=-2 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66,(y+2)*16,32,16,
      DitherMask.Canvas.Handle,32,16,SRCAND);
  for y:=-2 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66+34,(y+2)*16,32,16,
      DitherMask.Canvas.Handle,0,16,SRCAND);
  end;

for y:=-1 to 6 do
  begin
  if y=-1 then begin xSrc:=ShoreDither*65+1; ySrc:=1 end
  else if y=6 then begin xSrc:=131; ySrc:=67 end
  else begin xSrc:=(y+2)*65+1; ySrc:=1 end;
  for x:=-2 to 6 do
    BitBlt(LandMore.Canvas.Handle,(x+2)*66+1,(y+2)*16,64,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY);
  BitBlt(LandMore.Canvas.Handle,1*66+1-33+32,(y+2)*16,32,16,
    GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+32,ySrc+16,SRCPAINT);
  for x:=0 to 7 do
    BitBlt(LandMore.Canvas.Handle,(x+2)*66+1-33,(y+2)*16,64,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+16,SRCPAINT);
  for x:=-2 to 6 do
    BitBlt(LandMore.Canvas.Handle,(x+2)*66+1,(y+2)*16,64,16,
      DitherMask.Canvas.Handle,0,0,SRCAND);
  end;

for x:=0 to 3 do for y:=0 to 3 do
  begin
  if (x=1) and (y=1) then xSrc:=1
  else xSrc:=(x mod 2)*65+1;
  ySrc:=1;
  if (x>=1)=(y>=2) then
    BitBlt(OceanPatch.Canvas.Handle,x*66+1,y*16,64,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY);
  if (x>=1) and ((y<2) or (x>=2)) then
    begin
    BitBlt(OceanPatch.Canvas.Handle,x*66,y*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+32,ySrc+16,SRCPAINT);
    BitBlt(OceanPatch.Canvas.Handle,x*66+34,y*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+16,SRCPAINT);
    end;
  BitBlt(OceanPatch.Canvas.Handle,x*66,y*16,32,16,
    DitherMask.Canvas.Handle,32,16,SRCAND);
  BitBlt(OceanPatch.Canvas.Handle,x*66+34,y*16,32,16,
    DitherMask.Canvas.Handle,0,16,SRCAND);
  end;

for y:=0 to 3 do for x:=0 to 3 do
  begin
  if (x=1) and (y=1) then xSrc:=1
  else xSrc:=(y mod 2)*65+1;
  ySrc:=1;
  if (x<1) or (y>=2) then
    BitBlt(OceanMore.Canvas.Handle,x*66+1,y*16,64,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY);
  if (x=1) and (y<2) or (x>=2) and (y>=1) then
    begin
    BitBlt(OceanMore.Canvas.Handle,x*66,y*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+32,ySrc+16,SRCPAINT);
    BitBlt(OceanMore.Canvas.Handle,x*66+1+33,y*16,32,16,
      GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+16,SRCPAINT);
    end;
  BitBlt(OceanMore.Canvas.Handle,x*66+1,y*16,64,16,
    DitherMask.Canvas.Handle,0,0,SRCAND);
  end;

BitBlt(DitherMask.Canvas.Handle,0,0,64,32,
  DitherMask.Canvas.Handle,0,0,DSTINVERT); {invert dither mask}
BitBlt(DitherMask.Canvas.Handle,0,0,64,32,
  GrExt[HGrTerrain].Mask.Canvas.Handle,1,1,SRCPAINT);

for x:=-1 to 6 do
  for y:=-2 to 6 do
    BitBlt(LandPatch.Canvas.Handle,(x+2)*66+1,(y+2)*16,64,16,
      DitherMask.Canvas.Handle,0,0,SRCAND);

for y:=-1 to 6 do
  for x:=-2 to 7 do
    BitBlt(LandMore.Canvas.Handle,(x+2)*66+1-33,(y+2)*16,64,16,
      DitherMask.Canvas.Handle,0,16,SRCAND);

BitBlt(LandPatch.Canvas.Handle,0,0,66*9,16*9,LandMore.Canvas.Handle,0,0,
  SRCPAINT);

for x:=0 to 3 do
  for y:=0 to 3 do
    BitBlt(OceanPatch.Canvas.Handle,x*66+1,y*16,64,16,
      DitherMask.Canvas.Handle,0,0,SRCAND);

for y:=0 to 3 do
  for x:=0 to 4 do
    BitBlt(OceanMore.Canvas.Handle,x*66+1-33,y*16,64,16,
      DitherMask.Canvas.Handle,0,16,SRCAND);

BitBlt(OceanPatch.Canvas.Handle,0,0,66*4,16*4,OceanMore.Canvas.Handle,0,0,
  SRCPAINT);

with DitherMask.Canvas do
  begin
  Brush.Color:=$FFFFFF;
  FillRect(Rect(0,0,66,16));
  end;
BitBlt(DitherMask.Canvas.Handle,1,0,64,16,
  GrExt[HGrTerrain].Mask.Canvas.Handle,1,1,SRCCOPY);

for x:=0 to 6 do
  BitBlt(LandPatch.Canvas.Handle,66*(x+2),16,66,16,DitherMask.Canvas.Handle,0,0,
    SRCAND);

BitBlt(DitherMask.Canvas.Handle,0,0,66,16,
  DitherMask.Canvas.Handle,0,0,DSTINVERT);

for y:=0 to 6 do
  BitBlt(LandPatch.Canvas.Handle,66,(y+2)*16,66,16,DitherMask.Canvas.Handle,0,0,
    SRCAND);

LandMore.Free; OceanMore.Free; DitherMask.Free;
//LandPatch.Savetofile('landpatch.bmp');

// reduce size of terrain icons
Mask24:=TBitmap.Create;
Mask24.Assign(GrExt[HGrTerrain].Mask);
Mask24.PixelFormat:=pf24bit;
for ySrc:=0 to 16-1 do
  begin
  for i:=0 to 31 do
    MaskLine[i]:=Mask24.ScanLine[1+ySrc*33+i];
  for xSrc:=0 to 9-1 do
    begin
    i:=ySrc*9+xSrc;
    TSpriteSize[i].Left:=0;
    repeat
      Border:=true;
      for y:=0 to 31 do
        if MaskLine[y]^[1+xSrc*65+TSpriteSize[i].Left,0]=0 then Border:=false;
      if Border then inc(TSpriteSize[i].Left)
    until not Border or (TSpriteSize[i].Left=63);
    TSpriteSize[i].Top:=0;
    repeat
      Border:=true;
      for x:=0 to 63 do
        if MaskLine[TSpriteSize[i].Top]^[1+xSrc*65+x,0]=0 then Border:=false;
      if Border then inc(TSpriteSize[i].Top)
    until not Border or (TSpriteSize[i].Top=31);
    TSpriteSize[i].Right:=64;
    repeat
      Border:=true;
      for y:=0 to 31 do
        if MaskLine[y]^[xSrc*65+TSpriteSize[i].Right,0]=0 then Border:=false;
      if Border then dec(TSpriteSize[i].Right)
    until not Border or (TSpriteSize[i].Right=TSpriteSize[i].Left);
    TSpriteSize[i].Bottom:=32;
    repeat
      Border:=true;
      for x:=0 to 63 do
        if MaskLine[TSpriteSize[i].Bottom-1]^[1+xSrc*65+x,0]=0 then Border:=false;
      if Border then dec(TSpriteSize[i].Bottom)
    until not Border or (TSpriteSize[i].Bottom=TSpriteSize[i].Top);
    end
  end;
Mask24.Free;

Borders:=TBitmap.Create;
Borders.PixelFormat:=pf24bit;
Borders.Width:=64; Borders.Height:=32*nPl;
BordersOK:=0;

NoMap:=TIsoMap.Create;
end;

procedure Done;
begin
NoMap.Free;
LandPatch.Free; OceanPatch.Free;
Borders.Free
end;

procedure Reset;
begin
BordersOK:=0;
end;

constructor TIsoMap.Create;
begin
inherited;
FLeft:=0;
FTop:=0;
FRight:=0;
FBottom:=0;
AttLoc:=-1;
DefLoc:=-1;
end;

procedure TIsoMap.SetOutput(Output: TBitmap);
begin
FOutput:=Output;
FLeft:=0;
FTop:=0;
FRight:=FOutput.Width;
FBottom:=FOutput.Height;
end;

procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer);
begin
FLeft:=Left; FTop:=Top; FRight:=Right; FBottom:=Bottom;
end;

procedure TIsoMap.FillRect(x,y,Width,Height,Color: integer);
begin
if FBounds then
  begin
  if x<FLeft then
    begin Width:=Width-(FLeft-x); x:=FLeft end;
  if y<FTop then
    begin Height:=Height-(FTop-y); y:=FTop end;
  if x+Width>=FRight then Width:=FRight-x;
  if y+Height>=FBottom then Height:=FBottom-y;
  if (Width<=0) or (Height<=0) then exit
  end;
with FOutput.Canvas do
  begin
  Brush.Color:=Color;
  FillRect(Rect(x,y,x+Width,y+Height));
  Brush.Style:=bsClear;
  end
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -