?? 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;
//調(diào)整顯示的坐標位置
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:Chinasf@hotmail.com',
Application.Icon.Handle);
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -