uformmapedit.pas

单机泡泡堂 程序及源代码

  if ParamStr(1) <> '' then
    showmessage(ParamStr(0));
end;

procedure TFormMapEdit.InitImageList;
begin
  DXImageList.Items.MakeColorTable;
  DXDraw.ColorTable := DXImageList.Items.ColorTable;
  DXDraw.DefColorTable := DXImageList.Items.ColorTable;
  DXDraw.UpdatePalette;

  FillChar(MapTile, SizeOf(MapTile), 0);

end;

procedure TFormMapEdit.DXTimerTimer(Sender: TObject; LagCount: Integer);
var
  PerY              : Integer;
  ObjImage          : TPictureCollectionItem;
begin
  if not DXDraw.CanDraw then
    Exit;

  DXDraw.Surface.Fill(0);

  UpdateMapView;

  if mShowFps.Checked then
  begin
    with DXDraw.Surface.Canvas do
    begin
      Brush.Style := bsClear;
      Font.Color := clRed;
      Font.Size := 12;
      Textout(0, 0, 'FPS: ' + inttostr(DXTimer.FrameRate));
      Release;
    end;
  end;

  //画当前拖动的图标
  ObjImage := DXImageList.Items.Find('tile');
  if PsbBtn <> nil then
  begin

    case PageControl1.ActivePageIndex of
      0: ObjImage := DXImageList.Items.Find('tile');
      1: ObjImage := DXImageList.Items.Find('building');
      2: ObjImage := DXImageList.Items.Find('box');
    end;
    //调整显示的坐标位置
    if ObjImage.PatternHeight > Cnt_TileHeight then
      PerY := (ObjImage.PatternHeight - Cnt_TileHeight)
    else
      PerY := 0;

    ObjImage.Draw(DXDraw.surface, FCurx, FCury - PerY, PsbBtn.tag - 1);

  end;

  with DXDraw.Surface.Canvas do
  begin
    Brush.Style := bsClear;
    Pen.Color := ClRed;
    Pen.Width := 2;
    Rectangle(Rect(FOldX * Cnt_TileWidth, FOldY * Cnt_TileHeight, FOldX *
      Cnt_TileWidth + Cnt_TileWidth, FOldY * Cnt_TileHeight + Cnt_TileHeight));
    Release;
  end;

  DXImageList.Items.Find('cursor').Draw(DXDraw.Surface, FMx, Fmy, 0);
  DXDraw.Flip;
end;

procedure TFormMapEdit.DXDrawMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  FCursorX, FCursorY: Integer;
begin
  FCursorX := X div Cnt_TileWidth;
  FCursorY := Y div Cnt_TileHeight;
  FCurx := FCursorX * Cnt_TileWidth;
  FCury := FCursorY * Cnt_TileHeight;
  FMx := X;
  FMy := Y;
end;

procedure TFormMapEdit.mShowFpsClick(Sender: TObject);
begin
  mShowFps.Checked := not mShowFps.Checked;
end;

procedure TFormMapEdit.DXDrawMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  FCursorX, FCursorY: Integer;
begin
  FCursorX := X div Cnt_TileWidth;
  FCursorY := Y div Cnt_TileWidth;
  if (FCursorX > Cnt_TileWidthCount) or (FCursorY > Cnt_TileHeightCount) then
    Exit;

  if PsbBtn <> nil then
  begin
    case PageControl1.ActivePageIndex of
      0:
        begin
          MapTile[FCursorX, FCursorY].TileIndex := PsbBtn.Tag;
          MapTile[FCursorX, FCursorY].CanMove := FALSE; //不动
          MapTile[FCursorX, FCursorY].CanDestroy := FALSE; //不销毁
          MapTile[FCursorX, FCursorY].ObjIndex := 0; //物件为0
        end;
      1:
        begin
          MapTile[FCursorX, FCursorY].CanMove := FALSE;
          MapTile[FCursorX, FCursorY].CanDestroy := (PsbBtn.tag = 5); //不销毁
          MapTile[FCursorX, FCursorY].ObjIndex := PsbBtn.Tag;
        end;
      2:
        begin
          MapTile[FCursorX, FCursorY].CanMove := (PsbBtn.tag in [1]);
          MapTile[FCursorX, FCursorY].CanDestroy := (PsbBtn.tag in [1, 2, 3]);  //可销毁
          MapTile[FCursorX, FCursorY].ObjIndex := PsbBtn.Tag;
        end;
    end;
  end;

  FOldX := FCursorX;
  FOldY := FCursorY;
  ListBox1.Items.Clear;
  ListBox1.Items.Add(Format('地表索引 %d ', [MapTile[FCursorX,
    FCursorY].TileIndex]));
  ListBox1.Items.Add(Format('对象索引 %d ', [MapTile[FCursorX,
    FCursorY].ObjIndex]));
  ListBox1.Items.Add(Format('能被移动 %d ', [Ord(MapTile[FCursorX,
      FCursorY].CanMove)]));
  ListBox1.Items.Add(Format('能被摧毁 %d ', [Ord(MapTile[FCursorX,
      FCursorY].CanDestroy)]));

  if SetPlayerState then
  begin
    SetPlayerState := FALSE;
    PlayerList[PID].X := FOldX * Cnt_TileWidth;
    PlayerList[PID].Y := FOldY * Cnt_TileHeight;
  end;
end;

procedure TFormMapEdit.sbBtnOnClick(Sender: TObject);
begin
  if Sender <> nil then
    PsbBtn := Sender as TSpeedButton;
end;

procedure TFormMapEdit.btnFullTileClick(Sender: TObject);
var
  x, y              : Integer;
begin
  if PsbBtn = nil then
    exit;
  for x := 0 to Cnt_TileWidthCount do
    for y := 0 to Cnt_TileHeightCount do
      if PsbBtn.Tag <= (DXImageList.Items.Find('tile').PatternCount - 1) then
        MapTile[x, y].TileIndex := PsbBtn.Tag;
end;

procedure TFormMapEdit.Button1Click(Sender: TObject);
begin
  PsbBtn := nil;
end;

procedure TFormMapEdit.MShowGridClick(Sender: TObject);
begin
  MShowGrid.Checked := not MShowGrid.Checked;
end;

procedure TFormMapEdit.MCloseClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TFormMapEdit.MLoadMapClick(Sender: TObject);
var
  MapFileName       : string;
  FileHandle        : Integer;
  ms1, ms2          : TMemoryStream;
begin
  if OpenDialog.Execute then
  begin
    MapFileName := OpenDialog.FileName;

    ms1 := TMemoryStream.Create;
    try
      ms2 := TMemoryStream.Create;
      try
        ms1.LoadFromFile(MapFileName);
        DecompressStream(ms1, ms2);
        ms2.SaveToFile(MapFileName + '.tmp');
      finally
        ms1.Free;
      end;
    finally
      ms2.Free;
    end;

    if FileExists(MapFileName + '.tmp') then
    begin
      FileHandle := FileOpen(MapFileName + '.tmp', fmOpenRead);
      FileSeek(FileHandle, 0, 0);
      FileRead(FileHandle, MapTile, SizeOf(MapTile));
      FileRead(FileHandle, PlayerList, SizeOf(PlayerList));
      FileClose(FileHandle);
      DeleteFile(MapFileName + '.tmp');
    end;

  end;
end;

procedure TFormMapEdit.MSaveMapClick(Sender: TObject);
var
  MapFileName       : string;
  FileHandle        : Integer;
  ms1, ms2          : TMemoryStream;
begin
  if SaveDialog.Execute then
  begin
    MapFileName := ExtractFileName(SaveDialog.FileName);
    MapFileName := ChangeFileExt(MapFileName, '.Map');
    if FileExists(MapFileName) then
      DeleteFile(MapFileName);
    FileHandle := FileCreate(MapFileName);
    FileWrite(FileHandle, MapTile, SizeOf(MapTile));
    FileWrite(FileHandle, PlayerList, SizeOf(PlayerList));
    FileClose(FileHandle);

    ms1 := TMemoryStream.Create;
    try
      ms2 := TMemoryStream.Create;
      try
        ms1.LoadFromFile(MapFileName);
        CompressStream(ms1, ms2);
        ShowMessage(Format('Stream Compression Rate: %d %%',
          [round(100 / ms1.Size * ms2.Size)]));
        ms2.SaveToFile(MapFileName);
      finally
        ms1.Free;
      end;
    finally
      ms2.Free;
    end;

  end;
end;

procedure TFormMapEdit.setPlayerPos(PlayerID: integer);
begin
  PsbBtn := nil;
  SetPlayerState := TRUE;
  PID := playerID;
end;

procedure TFormMapEdit.btnSetPlayer1Click(Sender: TObject);
begin
  setPlayerPos(0);
end;

procedure TFormMapEdit.btnSetPlayer2Click(Sender: TObject);
begin
  setPlayerPos(1);
end;

procedure TFormMapEdit.N2Click(Sender: TObject);
begin
  fillChar(MapTile, SizeOf(MapTile), 0);
  fillChar(PlayerList, SizeOf(PlayerList), 0);
end;

procedure TFormMapEdit.A2Click(Sender: TObject);
begin
  ShellAbout(handle, '泡泡地图编辑器', 'mailto:[e-mail]',
    Application.Icon.Handle);
end;

end.