uformmapedit.pas

单机泡泡堂 程序及源代码

unit uFormMapEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls, Buttons, DXDraws, Menus, DXClass, ZLib,
  XPMenu, ShellApi;

type
  TTile = record
    TileIndex: Integer;                 //保存地表的信息
    ObjIndex: Integer; //保存地表之上的处于人物之下的建筑或者物品
    CanMove: Boolean;                   //可以移动的
    CanDestroy: Boolean;                //可以摧毁的
  end;

  TFormMapEdit = class(TDXForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    DXImageList: TDXImageList;
    btnFullTile: TButton;
    DXTimer: TDXTimer;
    MainMenu: TMainMenu;
    MFile: TMenuItem;
    MLoadMap: TMenuItem;
    MSaveMap: TMenuItem;
    N1: TMenuItem;
    MClose: TMenuItem;
    MConfig: TMenuItem;
    mShowFps: TMenuItem;
    MShowGrid: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    ScrollBox1: TScrollBox;
    DXDraw: TDXDraw;
    Panel1: TPanel;
    ListBox1: TListBox;
    Button1: TButton;
    btnSetPlayer1: TButton;
    btnSetPlayer2: TButton;
    Label1: TLabel;
    N2: TMenuItem;
    A1: TMenuItem;
    A2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mShowFpsClick(Sender: TObject);
    procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFullTileClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure MShowGridClick(Sender: TObject);
    procedure MCloseClick(Sender: TObject);
    procedure MLoadMapClick(Sender: TObject);
    procedure MSaveMapClick(Sender: TObject);
    procedure btnSetPlayer1Click(Sender: TObject);
    procedure btnSetPlayer2Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure A2Click(Sender: TObject);
  private
    FMx, Fmy, FCurx, FCury, FOldX, FOldY: Integer;
    PsbBtn: TSpeedButton;
    MapTile: array[0..14, 0..12] of TTile;
    PlayerList: array[0..1] of TPoint;
    PID: Integer;
    SetPlayerState: boolean;
    procedure CreateSpeedButton(SrcName: string; tabs: TTabSheet; w, h: Integer;
      SrcPic: TBitmap; TransparentColor: TColor; Transparent: Boolean);
    procedure InitTileBar;
    procedure InitImageList;
    procedure UpdateMapView;
    procedure sbBtnOnClick(Sender: TObject);
    procedure setPlayerPos(PlayerID: integer);
  public

  end;

const
  Cnt_TileWidth     = 40;               //Tile 宽
  Cnt_TileHeight    = 40;               //Tile 高
  Cnt_TileWidthCount = 14;              // 0..14 =15 ，屏幕列数 ，宽度=600
  Cnt_TileHeightCount = 12;             //0..12 =13 ，屏幕行数 ，高度=520
  Cnt_MaxPlayer     = 1;                //0..1=2
var
  FormMapEdit       : TFormMapEdit;

implementation

{$R *.DFM}
{ Compress a stream }

procedure CompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf    : Pointer;
  InpBytes, OutBytes: Integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  try
    GetMem(InpBuf, inpStream.Size);
    inpStream.Position := 0;
    InpBytes := inpStream.Read(InpBuf^, inpStream.Size);
    CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);
    outStream.Write(OutBuf^, OutBytes);
  finally
    if InpBuf <> nil then
      FreeMem(InpBuf);
    if OutBuf <> nil then
      FreeMem(OutBuf);
  end;
end;

{ Decompress a stream }

procedure DecompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf    : Pointer;
  OutBytes, sz      : Integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  sz := inpStream.Size - inpStream.Position;
  if sz > 0 then
  try
    GetMem(InpBuf, sz);
    inpStream.Read(InpBuf^, sz);
    DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);
    outStream.Write(OutBuf^, OutBytes);
  finally
    if InpBuf <> nil then
      FreeMem(InpBuf);
    if OutBuf <> nil then
      FreeMem(OutBuf);
  end;
  outStream.Position := 0;
end;

{ TFormMapEdit }

procedure TFormMapEdit.UpdateMapView;
var
  x, y, PerY        : Integer;
  TileImg, ObjImage, ObjImg1, ObjImg2: TPictureCollectionItem;
  ClientX, ClientY  : Integer;
label
  ShowGridLabel;
begin
  // 600 X 520 的图像大小，块大小为40像素
  TileImg := DXImageList.Items.Find('tile');
  ObjImg1 := DXImageList.Items.Find('building');
  ObjImg2 := DXImageList.Items.Find('box');

  for x := 0 to Cnt_TileWidthCount do
  begin
    for y := 0 to Cnt_TileHeightCount do
    begin
      ClientX := X * Cnt_TileWidth;
      ClientY := Y * Cnt_TileHeight;

      if mapTile[x, y].TileIndex > 0 then
        TileImg.Draw(DXDraw.surface, ClientX, ClientY, mapTile[x, y].TileIndex -
          1);

      if mapTile[x, y].ObjIndex < 1 then
        goto ShowGridLabel;

      if mapTile[X, y].CanDestroy and (mapTile[x, y].ObjIndex <> 5) then  //能摧毁的则是箱子之类的建筑
        ObjImage := ObjImg2
      else
        ObjImage := objImg1;

      //调整显示的坐标位置
      if ObjImage.PatternHeight > Cnt_TileHeight then
        PerY := ObjImage.PatternHeight - Cnt_TileHeight
      else
        PerY := 0;

      ObjImage.Draw(DXDraw.Surface, ClientX, ClientY - PerY, MapTile[x,
        y].ObjIndex - 1);

      ShowGridLabel:
      if MShowGrid.Checked then         //显示网格
        with DXDraw.Surface.Canvas do
        begin
          Brush.Style := bsClear;
          Pen.Color := ClBlue;
          Pen.Width := 1;
          Rectangle(Rect(ClientX, ClientY, ClientX + cnt_TileWidth, ClientY +
            cnt_TileHeight));
          Release;
        end;
    end;

  end;

  for x := 0 to Cnt_MaxPlayer do
    with DXDraw.Surface.Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Color := clBlue;
      Pen.Width := 1;
      Rectangle(Rect(PlayerList[x].X, PlayerList[x].Y, PlayerList[x].X +
        Cnt_TileWidth, PlayerList[x].Y + cnt_TileHeight));
      TextOut(PlayerList[x].X, PlayerList[x].Y, '玩家(' + inttostr(X + 1) +
        ')');
      Release;
    end;
end;

procedure TFormMapEdit.CreateSpeedButton(SrcName: string; tabs: TTabSheet; w, h:
  Integer;
  SrcPic: TBitmap; TransparentColor: TColor; Transparent: Boolean);
var
  i, count          : Integer;
  bmp               : TBitmap;
  sbBtn             : TSpeedButton;
begin

  count := SrcPic.Width div w;
  for I := 0 to count - 1 do
  begin
    bmp := TBitmap.Create;
    bmp.width := w;
    bmp.Height := h;
    Bitblt(bmp.Canvas.handle, 0, 0, w, h, SrcPic.Canvas.Handle, I * w, 0,
      SrcCopy);
    bmp.TransparentColor := TransparentColor;
    bmp.Transparent := Transparent;

    sbBtn := TSpeedButton.Create(Self);
    sbBtn.Name := SrcName + '_' + Inttostr(I + 1);
    sbBtn.Parent := tabs;
    sbBtn.Caption := '';
    sbBtn.SetBounds(I * (w + 1), abs((tabs.ClientHeight div 2) - (h div 2)), w +
      1, h + 1);
    sbBtn.Glyph := bmp;
    sbBtn.GroupIndex := 1;
    sbBtn.OnClick := sbBtnOnClick;
    sbBtn.Tag := I + 1;
    sbBtn.Show;
    PsbBtn := sbBtn;
  end;

end;

procedure TFormMapEdit.InitTileBar;
begin
  CreateSpeedButton('tile',
    TabSheet1,
    40, 40,
    Image1.Picture.Bitmap,
    $0,
    FALSE);

  CreateSpeedButton('building',
    TabSheet2,
    40, 56,
    Image2.Picture.Bitmap,
    clFuchsia,
    TRUE);

  CreateSpeedButton('box',
    TabSheet3,
    40, 40,
    Image3.Picture.Bitmap,
    $0,
    FALSE);
  Image1.Picture.Bitmap.FreeImage;
  Image2.Picture.Bitmap.FreeImage;
  Image3.Picture.Bitmap.FreeImage;

end;

procedure TFormMapEdit.FormCreate(Sender: TObject);
begin
  InitTileBar;
  InitImageList;