3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, SysUtils
, Variants
, Classes
, Graphics
,
9 Controls
, Forms
, Dialogs
, StdCtrls
, Buttons
,
10 ComCtrls
, ValEdit
, Types
, Menus
, ExtCtrls
,
11 CheckLst
, Grids
, OpenGLContext
, Utils
, UTF8Process
;
17 TMainForm
= class(TForm
)
21 StatusBar
: TStatusBar
;
22 OpenDialog
: TOpenDialog
;
23 SaveDialog
: TSaveDialog
;
24 ColorDialog
: TColorDialog
;
28 ImageList
: TImageList
;
31 miAppleAbout
: TMenuItem
;
32 miAppleLine0
: TMenuItem
;
33 miApplePref
: TMenuItem
;
34 miAppleLine1
: TMenuItem
;
36 miMenuFile
: TMenuItem
;
39 miMacRecentSubMenu
: TMenuItem
;
40 miMacRecentEnd
: TMenuItem
;
41 miMacRecentClear
: TMenuItem
;
42 Separator1
: TMenuItem
;
44 miSaveMapAs
: TMenuItem
;
45 miOpenWadMap
: TMenuItem
;
47 miReopenMap
: TMenuItem
;
48 miSaveMiniMap
: TMenuItem
;
49 miDeleteMap
: TMenuItem
;
51 miWinRecentStart
: TMenuItem
;
52 miWinRecent
: TMenuItem
;
56 miMenuEdit
: TMenuItem
;
63 miSelectAll
: TMenuItem
;
65 miSnapToGrid
: TMenuItem
;
66 miSwitchGrid
: TMenuItem
;
67 Separator2
: TMenuItem
;
71 miMapOptions
: TMenuItem
;
74 miMenuView
: TMenuItem
;
85 miViewLine1
: TMenuItem
;
87 miShowEdges
: TMenuItem
;
88 miViewLine2
: TMenuItem
;
89 miMapPreview
: TMenuItem
;
91 miMenuService
: TMenuItem
;
92 miCheckMap
: TMenuItem
;
93 miOptimmization
: TMenuItem
;
96 miMenuWindow
: TMenuItem
;
97 miMacMinimize
: TMenuItem
;
100 miMenuHelp
: TMenuItem
;
103 miMenuHidden
: TMenuItem
;
104 minexttab
: TMenuItem
;
105 selectall1
: TMenuItem
;
108 ilToolbar
: TImageList
;
109 MainToolBar
: TToolBar
;
110 tbNewMap
: TToolButton
;
111 tbOpenMap
: TToolButton
;
112 tbSaveMap
: TToolButton
;
113 tbOpenWadMap
: TToolButton
;
114 tbLine1
: TToolButton
;
115 tbShowMap
: TToolButton
;
116 tbLine2
: TToolButton
;
119 miLayerP1
: TMenuItem
;
120 miLayerP2
: TMenuItem
;
121 miLayerP3
: TMenuItem
;
122 miLayerP4
: TMenuItem
;
123 miLayerP5
: TMenuItem
;
124 miLayerP6
: TMenuItem
;
125 miLayerP7
: TMenuItem
;
126 miLayerP8
: TMenuItem
;
127 miLayerP9
: TMenuItem
;
128 tbLine3
: TToolButton
;
129 tbGridOn
: TToolButton
;
131 tbLine4
: TToolButton
;
132 tbTestMap
: TToolButton
;
135 pLoadProgress
: TPanel
;
137 pbLoad
: TProgressBar
;
141 RenderPanel
: TOpenGLControl
;
142 sbHorizontal
: TScrollBar
;
143 sbVertical
: TScrollBar
;
145 // Object propertiy editor:
147 PanelPropApply
: TPanel
;
148 bApplyProperty
: TButton
;
149 vleObjectProperty
: TValueListEditor
;
153 pcObjects
: TPageControl
;
156 PanelPanelType
: TPanel
;
157 lbPanelType
: TListBox
;
158 lbTextureList
: TListBox
;
159 PanelTextures
: TPanel
;
161 lTextureWidth
: TLabel
;
163 lTextureHeight
: TLabel
;
164 cbPreview
: TCheckBox
;
165 bbAddTexture
: TBitBtn
;
166 bbRemoveTexture
: TBitBtn
;
167 bClearTexture
: TButton
;
170 lbItemList
: TListBox
;
174 tsMonsters
: TTabSheet
;
175 lbMonsterList
: TListBox
;
176 rbMonsterLeft
: TRadioButton
;
177 rbMonsterRight
: TRadioButton
;
180 lbAreasList
: TListBox
;
181 rbAreaLeft
: TRadioButton
;
182 rbAreaRight
: TRadioButton
;
184 tsTriggers
: TTabSheet
;
185 lbTriggersList
: TListBox
;
186 clbActivationType
: TCheckListBox
;
187 clbKeys
: TCheckListBox
;
189 procedure aAboutExecute(Sender
: TObject
);
190 procedure aCheckMapExecute(Sender
: TObject
);
191 procedure aMoveToFore(Sender
: TObject
);
192 procedure aMoveToBack(Sender
: TObject
);
193 procedure aCopyObjectExecute(Sender
: TObject
);
194 procedure aCutObjectExecute(Sender
: TObject
);
195 procedure aEditorOptionsExecute(Sender
: TObject
);
196 procedure aExitExecute(Sender
: TObject
);
197 procedure aMapOptionsExecute(Sender
: TObject
);
198 procedure aNewMapExecute(Sender
: TObject
);
199 procedure aOpenMapExecute(Sender
: TObject
);
200 procedure aOptimizeExecute(Sender
: TObject
);
201 procedure aPasteObjectExecute(Sender
: TObject
);
202 procedure aSelectAllExecute(Sender
: TObject
);
203 procedure aSaveMapExecute(Sender
: TObject
);
204 procedure aSaveMapAsExecute(Sender
: TObject
);
205 procedure aUndoExecute(Sender
: TObject
);
206 procedure aDeleteMap(Sender
: TObject
);
207 procedure bApplyPropertyClick(Sender
: TObject
);
208 procedure bbAddTextureClick(Sender
: TObject
);
209 procedure bbRemoveTextureClick(Sender
: TObject
);
210 procedure FormActivate(Sender
: TObject
);
211 procedure FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
212 procedure FormCreate(Sender
: TObject
);
213 procedure FormDestroy(Sender
: TObject
);
214 procedure FormDropFiles(Sender
: TObject
; const FileNames
: array of String);
215 procedure FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
216 procedure FormResize(Sender
: TObject
);
217 procedure FormWindowStateChange(Sender
: TObject
);
218 procedure miRecentFileExecute(Sender
: TObject
);
219 procedure miMacRecentClearClick(Sender
: TObject
);
220 procedure miMacZoomClick(Sender
: TObject
);
221 procedure lbTextureListClick(Sender
: TObject
);
222 procedure lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
223 ARect
: TRect
; State
: TOwnerDrawState
);
224 procedure miMacMinimizeClick(Sender
: TObject
);
225 procedure miReopenMapClick(Sender
: TObject
);
226 procedure RenderPanelMouseDown(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
227 procedure RenderPanelMouseMove(Sender
: TObject
; Shift
: TShiftState
; X
, Y
: Integer);
228 procedure RenderPanelMouseUp(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
229 procedure RenderPanelPaint(Sender
: TObject
);
230 procedure RenderPanelResize(Sender
: TObject
);
231 procedure Splitter1Moved(Sender
: TObject
);
232 procedure MapTestCheck(Sender
: TObject
);
233 procedure vleObjectPropertyEditButtonClick(Sender
: TObject
);
234 procedure vleObjectPropertyApply(Sender
: TObject
);
235 procedure vleObjectPropertyGetPickList(Sender
: TObject
; const KeyName
: String; Values
: TStrings
);
236 procedure vleObjectPropertyKeyDown(Sender
: TObject
; var Key
: Word;
238 procedure tbGridOnClick(Sender
: TObject
);
239 procedure miMapPreviewClick(Sender
: TObject
);
240 procedure miLayer1Click(Sender
: TObject
);
241 procedure miLayer2Click(Sender
: TObject
);
242 procedure miLayer3Click(Sender
: TObject
);
243 procedure miLayer4Click(Sender
: TObject
);
244 procedure miLayer5Click(Sender
: TObject
);
245 procedure miLayer6Click(Sender
: TObject
);
246 procedure miLayer7Click(Sender
: TObject
);
247 procedure miLayer8Click(Sender
: TObject
);
248 procedure miLayer9Click(Sender
: TObject
);
249 procedure tbShowClick(Sender
: TObject
);
250 procedure miSnapToGridClick(Sender
: TObject
);
251 procedure miMiniMapClick(Sender
: TObject
);
252 procedure miSwitchGridClick(Sender
: TObject
);
253 procedure miShowEdgesClick(Sender
: TObject
);
254 procedure minexttabClick(Sender
: TObject
);
255 procedure miSaveMiniMapClick(Sender
: TObject
);
256 procedure bClearTextureClick(Sender
: TObject
);
257 procedure miPackMapClick(Sender
: TObject
);
258 procedure miTestMapClick(Sender
: TObject
);
259 procedure sbVerticalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
260 var ScrollPos
: Integer);
261 procedure sbHorizontalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
262 var ScrollPos
: Integer);
263 procedure miOpenWadMapClick(Sender
: TObject
);
264 procedure selectall1Click(Sender
: TObject
);
265 procedure Splitter1CanResize(Sender
: TObject
; var NewSize
: Integer;
266 var Accept
: Boolean);
267 procedure Splitter2CanResize(Sender
: TObject
; var NewSize
: Integer;
268 var Accept
: Boolean);
269 procedure vleObjectPropertyEnter(Sender
: TObject
);
270 procedure vleObjectPropertyExit(Sender
: TObject
);
271 procedure FormKeyUp(Sender
: TObject
; var Key
: Word;
274 LastDrawTime
: UInt64;
276 procedure OnIdle(Sender
: TObject
; var Done
: Boolean);
277 procedure RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
279 procedure RefreshRecentMenu();
280 procedure OpenMapFile(FileName
: String);
281 function RenderMousePos(): TPoint
;
282 procedure RecountSelectedObjects();
288 LAYER_FOREGROUND
= 2;
296 TEST_MAP_NAME
= '$$$_TEST_$$$';
297 LANGUAGE_FILE_NAME
= '_Editor.txt';
308 DotStepOne
, DotStepTwo
: Word;
310 DrawTexturePanel
: Boolean;
311 DrawPanelSize
: Boolean;
313 PreviewColor
: TColor
;
314 UseCheckerboard
: Boolean;
316 RecentCount
: Integer;
317 RecentFiles
: TStringList
;
318 slInvalidTextures
: TStringList
;
320 TestGameMode
: String;
322 TestLimScore
: String;
323 TestOptionsTwoPlayers
: Boolean;
324 TestOptionsTeamDamage
: Boolean;
325 TestOptionsAllowExit
: Boolean;
326 TestOptionsWeaponStay
: Boolean;
327 TestOptionsMonstersDM
: Boolean;
328 TestD2dExe
, TestD2DArgs
: String;
329 TestMapOnce
: Boolean;
331 LayerEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
332 (True, True, True, True, True, True, True, True, True);
333 ContourEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
334 (False, False, False, False, False, False, False, False, False);
335 PreviewMode
: Byte = 0;
341 procedure OpenMap(FileName
: String; mapN
: String);
342 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
343 procedure RemoveSelectFromObjects();
344 procedure ChangeShownProperty(Name
: String; NewValue
: String);
349 f_options
, e_graphics
, e_log
, GL
, Math
,
350 f_mapoptions
, g_basic
, f_about
, f_mapoptimization
,
351 f_mapcheck
, f_addresource_texture
, g_textures
,
352 f_activationtype
, f_keys
, wadreader
, fileutil
,
353 MAPREADER
, f_selectmap
, f_savemap
, WADEDITOR
, WADSTRUCT
, MAPDEF
,
354 g_map
, f_saveminimap
, f_addresource
, CONFIG
, f_packmap
,
355 f_addresource_sound
, f_choosetype
,
356 g_language
, ClipBrd
, g_options
;
359 UNDO_DELETE_PANEL
= 1;
360 UNDO_DELETE_ITEM
= 2;
361 UNDO_DELETE_AREA
= 3;
362 UNDO_DELETE_MONSTER
= 4;
363 UNDO_DELETE_TRIGGER
= 5;
367 UNDO_ADD_MONSTER
= 9;
368 UNDO_ADD_TRIGGER
= 10;
369 UNDO_MOVE_PANEL
= 11;
372 UNDO_MOVE_MONSTER
= 14;
373 UNDO_MOVE_TRIGGER
= 15;
374 UNDO_RESIZE_PANEL
= 16;
375 UNDO_RESIZE_TRIGGER
= 17;
377 MOUSEACTION_NONE
= 0;
378 MOUSEACTION_DRAWPANEL
= 1;
379 MOUSEACTION_DRAWTRIGGER
= 2;
380 MOUSEACTION_MOVEOBJ
= 3;
381 MOUSEACTION_RESIZE
= 4;
382 MOUSEACTION_MOVEMAP
= 5;
383 MOUSEACTION_DRAWPRESS
= 6;
384 MOUSEACTION_NOACTION
= 7;
387 RESIZETYPE_VERTICAL
= 1;
388 RESIZETYPE_HORIZONTAL
= 2;
397 SELECTFLAG_TELEPORT
= 1;
399 SELECTFLAG_TEXTURE
= 3;
401 SELECTFLAG_MONSTER
= 5;
402 SELECTFLAG_SPAWNPOINT
= 6;
403 SELECTFLAG_SHOTPANEL
= 7;
404 SELECTFLAG_SELECTED
= 8;
406 RECENT_FILES_MENU_START
= 12;
408 CLIPBOARD_SIG
= 'DF:ED';
412 case UndoType
: Byte of
413 UNDO_DELETE_PANEL
: (Panel
: ^TPanel
);
414 UNDO_DELETE_ITEM
: (Item
: TItem
);
415 UNDO_DELETE_AREA
: (Area
: TArea
);
416 UNDO_DELETE_MONSTER
: (Monster
: TMonster
);
417 UNDO_DELETE_TRIGGER
: (Trigger
: TTrigger
);
422 UNDO_ADD_TRIGGER
: (AddID
: DWORD
);
427 UNDO_MOVE_TRIGGER
: (MoveID
: DWORD
; dX
, dY
: Integer);
429 UNDO_RESIZE_TRIGGER
: (ResizeID
: DWORD
; dW
, dH
: Integer);
434 case ObjectType
: Byte of
435 OBJECT_PANEL
: (Panel
: ^TPanel
);
436 OBJECT_ITEM
: (Item
: TItem
);
437 OBJECT_AREA
: (Area
: TArea
);
438 OBJECT_MONSTER
: (Monster
: TMonster
);
439 OBJECT_TRIGGER
: (Trigger
: TTrigger
);
442 TCopyRecArray
= Array of TCopyRec
;
446 gDataLoaded
: Boolean = False;
447 ShowMap
: Boolean = False;
448 DrawRect
: PRect
= nil;
449 SnapToGrid
: Boolean = True;
451 MousePos
: Types
.TPoint
;
452 LastMovePoint
: Types
.TPoint
;
456 MouseLDownPos
: Types
.TPoint
;
457 MouseRDownPos
: Types
.TPoint
;
458 MouseMDownPos
: Types
.TPoint
;
460 SelectFlag
: Byte = SELECTFLAG_NONE
;
461 MouseAction
: Byte = MOUSEACTION_NONE
;
462 ResizeType
: Byte = RESIZETYPE_NONE
;
463 ResizeDirection
: Byte = RESIZEDIR_NONE
;
465 DrawPressRect
: Boolean = False;
466 EditingProperties
: Boolean = False;
468 UndoBuffer
: Array of Array of TUndoRec
= nil;
470 MapTestProcess
: TProcessUTF8
;
475 //----------------------------------------
476 //Далее идут вспомогательные процедуры
477 //----------------------------------------
479 function NameToBool(Name
: String): Boolean;
481 if Name
= BoolNames
[True] then
487 function NameToDir(Name
: String): TDirection
;
489 if Name
= DirNames
[D_LEFT
] then
495 function NameToDirAdv(Name
: String): Byte;
497 if Name
= DirNamesAdv
[1] then
500 if Name
= DirNamesAdv
[2] then
503 if Name
= DirNamesAdv
[3] then
509 function ActivateToStr(ActivateType
: Byte): String;
513 if ByteBool(ACTIVATE_PLAYERCOLLIDE
and ActivateType
) then
514 Result
:= Result
+ '+PC';
515 if ByteBool(ACTIVATE_MONSTERCOLLIDE
and ActivateType
) then
516 Result
:= Result
+ '+MC';
517 if ByteBool(ACTIVATE_PLAYERPRESS
and ActivateType
) then
518 Result
:= Result
+ '+PP';
519 if ByteBool(ACTIVATE_MONSTERPRESS
and ActivateType
) then
520 Result
:= Result
+ '+MP';
521 if ByteBool(ACTIVATE_SHOT
and ActivateType
) then
522 Result
:= Result
+ '+SH';
523 if ByteBool(ACTIVATE_NOMONSTER
and ActivateType
) then
524 Result
:= Result
+ '+NM';
526 if (Result
<> '') and (Result
[1] = '+') then
527 Delete(Result
, 1, 1);
530 function StrToActivate(Str
: String): Byte;
534 if Pos('PC', Str
) > 0 then
535 Result
:= ACTIVATE_PLAYERCOLLIDE
;
536 if Pos('MC', Str
) > 0 then
537 Result
:= Result
or ACTIVATE_MONSTERCOLLIDE
;
538 if Pos('PP', Str
) > 0 then
539 Result
:= Result
or ACTIVATE_PLAYERPRESS
;
540 if Pos('MP', Str
) > 0 then
541 Result
:= Result
or ACTIVATE_MONSTERPRESS
;
542 if Pos('SH', Str
) > 0 then
543 Result
:= Result
or ACTIVATE_SHOT
;
544 if Pos('NM', Str
) > 0 then
545 Result
:= Result
or ACTIVATE_NOMONSTER
;
548 function KeyToStr(Key
: Byte): String;
552 if ByteBool(KEY_RED
and Key
) then
553 Result
:= Result
+ '+RK';
554 if ByteBool(KEY_GREEN
and Key
) then
555 Result
:= Result
+ '+GK';
556 if ByteBool(KEY_BLUE
and Key
) then
557 Result
:= Result
+ '+BK';
558 if ByteBool(KEY_REDTEAM
and Key
) then
559 Result
:= Result
+ '+RT';
560 if ByteBool(KEY_BLUETEAM
and Key
) then
561 Result
:= Result
+ '+BT';
563 if (Result
<> '') and (Result
[1] = '+') then
564 Delete(Result
, 1, 1);
567 function StrToKey(Str
: String): Byte;
571 if Pos('RK', Str
) > 0 then
573 if Pos('GK', Str
) > 0 then
574 Result
:= Result
or KEY_GREEN
;
575 if Pos('BK', Str
) > 0 then
576 Result
:= Result
or KEY_BLUE
;
577 if Pos('RT', Str
) > 0 then
578 Result
:= Result
or KEY_REDTEAM
;
579 if Pos('BT', Str
) > 0 then
580 Result
:= Result
or KEY_BLUETEAM
;
583 function EffectToStr(Effect
: Byte): String;
585 if Effect
in [EFFECT_TELEPORT
..EFFECT_FIRE
] then
586 Result
:= EffectNames
[Effect
]
588 Result
:= EffectNames
[EFFECT_NONE
];
591 function StrToEffect(Str
: String): Byte;
595 Result
:= EFFECT_NONE
;
596 for i
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
597 if EffectNames
[i
] = Str
then
604 function MonsterToStr(MonType
: Byte): String;
606 if MonType
in [MONSTER_DEMON
..MONSTER_MAN
] then
607 Result
:= MonsterNames
[MonType
]
609 Result
:= MonsterNames
[MONSTER_ZOMBY
];
612 function StrToMonster(Str
: String): Byte;
616 Result
:= MONSTER_ZOMBY
;
617 for i
:= MONSTER_DEMON
to MONSTER_MAN
do
618 if MonsterNames
[i
] = Str
then
625 function ItemToStr(ItemType
: Byte): String;
627 if ItemType
in [ITEM_MEDKIT_SMALL
..ITEM_MAX
] then
628 Result
:= ItemNames
[ItemType
]
630 Result
:= ItemNames
[ITEM_AMMO_BULLETS
];
633 function StrToItem(Str
: String): Byte;
637 Result
:= ITEM_AMMO_BULLETS
;
638 for i
:= ITEM_MEDKIT_SMALL
to ITEM_MAX
do
639 if ItemNames
[i
] = Str
then
646 function ShotToStr(ShotType
: Byte): String;
648 if ShotType
in [TRIGGER_SHOT_PISTOL
..TRIGGER_SHOT_MAX
] then
649 Result
:= ShotNames
[ShotType
]
651 Result
:= ShotNames
[TRIGGER_SHOT_PISTOL
];
654 function StrToShot(Str
: String): Byte;
658 Result
:= TRIGGER_SHOT_PISTOL
;
659 for i
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
660 if ShotNames
[i
] = Str
then
667 function SelectedObjectCount(): Word;
673 if SelectedObjects
= nil then
676 for a
:= 0 to High(SelectedObjects
) do
677 if SelectedObjects
[a
].Live
then
678 Result
:= Result
+ 1;
681 function GetFirstSelected(): Integer;
687 if SelectedObjects
= nil then
690 for a
:= 0 to High(SelectedObjects
) do
691 if SelectedObjects
[a
].Live
then
698 function Normalize16(x
: Integer): Integer;
700 Result
:= (x
div 16) * 16;
703 procedure MoveMap(X
, Y
: Integer);
705 rx
, ry
, ScaleSz
: Integer;
707 with MainForm
.RenderPanel
do
709 ScaleSz
:= 16 div Scale
;
710 // Размер видимой части карты:
711 rx
:= Min(Normalize16(Width
), Normalize16(gMapInfo
.Width
)) div 2;
712 ry
:= Min(Normalize16(Height
), Normalize16(gMapInfo
.Height
)) div 2;
713 // Место клика на мини-карте:
714 MapOffset
.X
:= X
- (Width
- Max(gMapInfo
.Width
div ScaleSz
, 1) - 1);
715 MapOffset
.Y
:= Y
- 1;
716 // Это же место на "большой" карте:
717 MapOffset
.X
:= MapOffset
.X
* ScaleSz
;
718 MapOffset
.Y
:= MapOffset
.Y
* ScaleSz
;
719 // Левый верхний угол новой видимой части карты:
720 MapOffset
.X
:= MapOffset
.X
- rx
;
721 MapOffset
.Y
:= MapOffset
.Y
- ry
;
723 MapOffset
.X
:= EnsureRange(MapOffset
.X
, MainForm
.sbHorizontal
.Min
, MainForm
.sbHorizontal
.Max
);
724 MapOffset
.Y
:= EnsureRange(MapOffset
.Y
, MainForm
.sbVertical
.Min
, MainForm
.sbVertical
.Max
);
726 // MapOffset.X := Normalize16(MapOffset.X);
727 // MapOffset.Y := Normalize16(MapOffset.Y);
730 MainForm
.sbHorizontal
.Position
:= MapOffset
.X
;
731 MainForm
.sbVertical
.Position
:= MapOffset
.Y
;
733 MapOffset
.X
:= -MapOffset
.X
;
734 MapOffset
.Y
:= -MapOffset
.Y
;
739 function IsTexturedPanel(PanelType
: Word): Boolean;
741 Result
:= WordBool(PanelType
and (PANEL_WALL
or PANEL_BACK
or PANEL_FORE
or
742 PANEL_STEP
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
or
743 PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
));
746 procedure FillProperty();
751 MainForm
.vleObjectProperty
.Strings
.Clear();
752 MainForm
.RecountSelectedObjects();
754 // Отображаем свойства если выделен только один объект:
755 if SelectedObjectCount() <> 1 then
758 _id
:= GetFirstSelected();
759 if not SelectedObjects
[_id
].Live
then
762 with MainForm
.vleObjectProperty
do
763 with ItemProps
[InsertRow(MsgPropId
, IntToStr(SelectedObjects
[_id
].ID
), True)] do
765 EditStyle
:= esSimple
;
769 case SelectedObjects
[0].ObjectType
of
772 with MainForm
.vleObjectProperty
,
773 gPanels
[SelectedObjects
[_id
].ID
] do
775 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
777 EditStyle
:= esSimple
;
781 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
783 EditStyle
:= esSimple
;
787 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
789 EditStyle
:= esSimple
;
793 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
795 EditStyle
:= esSimple
;
799 with ItemProps
[InsertRow(MsgPropPanelType
, GetPanelName(PanelType
), True)] do
801 EditStyle
:= esEllipsis
;
805 if IsTexturedPanel(PanelType
) then
806 begin // Может быть текстура
807 with ItemProps
[InsertRow(MsgPropPanelTex
, TextureName
, True)] do
809 EditStyle
:= esEllipsis
;
813 if TextureName
<> '' then
814 begin // Есть текстура
815 with ItemProps
[InsertRow(MsgPropPanelAlpha
, IntToStr(Alpha
), True)] do
817 EditStyle
:= esSimple
;
821 with ItemProps
[InsertRow(MsgPropPanelBlend
, BoolNames
[Blending
], True)] do
823 EditStyle
:= esPickList
;
833 with MainForm
.vleObjectProperty
,
834 gItems
[SelectedObjects
[_id
].ID
] do
836 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
838 EditStyle
:= esSimple
;
842 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
844 EditStyle
:= esSimple
;
848 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[OnlyDM
], True)] do
850 EditStyle
:= esPickList
;
854 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Fall
], True)] do
856 EditStyle
:= esPickList
;
864 with MainForm
.vleObjectProperty
,
865 gMonsters
[SelectedObjects
[_id
].ID
] do
867 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
869 EditStyle
:= esSimple
;
873 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
875 EditStyle
:= esSimple
;
879 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
881 EditStyle
:= esPickList
;
889 with MainForm
.vleObjectProperty
,
890 gAreas
[SelectedObjects
[_id
].ID
] do
892 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
894 EditStyle
:= esSimple
;
898 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
900 EditStyle
:= esSimple
;
904 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
906 EditStyle
:= esPickList
;
914 with MainForm
.vleObjectProperty
,
915 gTriggers
[SelectedObjects
[_id
].ID
] do
917 with ItemProps
[InsertRow(MsgPropTrType
, GetTriggerName(TriggerType
), True)] do
919 EditStyle
:= esSimple
;
923 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
925 EditStyle
:= esSimple
;
929 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
931 EditStyle
:= esSimple
;
935 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
937 EditStyle
:= esSimple
;
941 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
943 EditStyle
:= esSimple
;
947 with ItemProps
[InsertRow(MsgPropTrEnabled
, BoolNames
[Enabled
], True)] do
949 EditStyle
:= esPickList
;
953 with ItemProps
[InsertRow(MsgPropTrTexturePanel
, IntToStr(TexturePanel
), True)] do
955 EditStyle
:= esEllipsis
;
959 with ItemProps
[InsertRow(MsgPropTrActivation
, ActivateToStr(ActivateType
), True)] do
961 EditStyle
:= esEllipsis
;
965 with ItemProps
[InsertRow(MsgPropTrKeys
, KeyToStr(Key
), True)] do
967 EditStyle
:= esEllipsis
;
974 str
:= win2utf(Data
.MapName
);
975 with ItemProps
[InsertRow(MsgPropTrNextMap
, str
, True)] do
977 EditStyle
:= esEllipsis
;
984 with ItemProps
[InsertRow(MsgPropTrTeleportTo
, Format('(%d:%d)', [Data
.TargetPoint
.X
, Data
.TargetPoint
.Y
]), True)] do
986 EditStyle
:= esEllipsis
;
990 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_teleport
], True)] do
992 EditStyle
:= esPickList
;
996 with ItemProps
[InsertRow(MsgPropTrTeleportSilent
, BoolNames
[Data
.silent_teleport
], True)] do
998 EditStyle
:= esPickList
;
1002 with ItemProps
[InsertRow(MsgPropTrTeleportDir
, DirNamesAdv
[Data
.TlpDir
], True)] do
1004 EditStyle
:= esPickList
;
1009 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
,
1010 TRIGGER_DOOR
, TRIGGER_DOOR5
:
1012 with ItemProps
[InsertRow(MsgPropTrDoorPanel
, IntToStr(Data
.PanelID
), True)] do
1014 EditStyle
:= esEllipsis
;
1018 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1020 EditStyle
:= esPickList
;
1024 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1026 EditStyle
:= esPickList
;
1031 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
:
1033 with ItemProps
[InsertRow(MsgPropTrTrapPanel
, IntToStr(Data
.PanelID
), True)] do
1035 EditStyle
:= esEllipsis
;
1039 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1041 EditStyle
:= esPickList
;
1045 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1047 EditStyle
:= esPickList
;
1052 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
1055 with ItemProps
[InsertRow(MsgPropTrExArea
,
1056 Format('(%d:%d %d:%d)', [Data
.tX
, Data
.tY
, Data
.tWidth
, Data
.tHeight
]), True)] do
1058 EditStyle
:= esEllipsis
;
1062 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.Wait
), True)] do
1064 EditStyle
:= esSimple
;
1068 with ItemProps
[InsertRow(MsgPropTrExCount
, IntToStr(Data
.Count
), True)] do
1070 EditStyle
:= esSimple
;
1074 with ItemProps
[InsertRow(MsgPropTrExMonster
, IntToStr(Data
.MonsterID
-1), True)] do
1076 EditStyle
:= esEllipsis
;
1080 if TriggerType
= TRIGGER_PRESS
then
1081 with ItemProps
[InsertRow(MsgPropTrExRandom
, BoolNames
[Data
.ExtRandom
], True)] do
1083 EditStyle
:= esPickList
;
1091 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
1093 with ItemProps
[InsertRow(MsgPropTrLiftPanel
, IntToStr(Data
.PanelID
), True)] do
1095 EditStyle
:= esEllipsis
;
1099 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1101 EditStyle
:= esPickList
;
1105 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1107 EditStyle
:= esPickList
;
1114 with ItemProps
[InsertRow(MsgPropTrTextureOnce
, BoolNames
[Data
.ActivateOnce
], True)] do
1116 EditStyle
:= esPickList
;
1120 with ItemProps
[InsertRow(MsgPropTrTextureAnimOnce
, BoolNames
[Data
.AnimOnce
], True)] do
1122 EditStyle
:= esPickList
;
1129 str
:= win2utf(Data
.SoundName
);
1130 with ItemProps
[InsertRow(MsgPropTrSoundName
, str
, True)] do
1132 EditStyle
:= esEllipsis
;
1136 with ItemProps
[InsertRow(MsgPropTrSoundVolume
, IntToStr(Data
.Volume
), True)] do
1138 EditStyle
:= esSimple
;
1142 with ItemProps
[InsertRow(MsgPropTrSoundPan
, IntToStr(Data
.Pan
), True)] do
1144 EditStyle
:= esSimple
;
1148 with ItemProps
[InsertRow(MsgPropTrSoundCount
, IntToStr(Data
.PlayCount
), True)] do
1150 EditStyle
:= esSimple
;
1154 with ItemProps
[InsertRow(MsgPropTrSoundLocal
, BoolNames
[Data
.Local
], True)] do
1156 EditStyle
:= esPickList
;
1160 with ItemProps
[InsertRow(MsgPropTrSoundSwitch
, BoolNames
[Data
.SoundSwitch
], True)] do
1162 EditStyle
:= esPickList
;
1167 TRIGGER_SPAWNMONSTER
:
1169 with ItemProps
[InsertRow(MsgPropTrMonsterType
, MonsterToStr(Data
.MonType
), True)] do
1171 EditStyle
:= esEllipsis
;
1175 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1176 Format('(%d:%d)', [Data
.MonPos
.X
, Data
.MonPos
.Y
]), True)] do
1178 EditStyle
:= esEllipsis
;
1182 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[TDirection(Data
.MonDir
)], True)] do
1184 EditStyle
:= esPickList
;
1188 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.MonHealth
), True)] do
1190 EditStyle
:= esSimple
;
1194 with ItemProps
[InsertRow(MsgPropTrMonsterActive
, BoolNames
[Data
.MonActive
], True)] do
1196 EditStyle
:= esPickList
;
1200 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.MonCount
), True)] do
1202 EditStyle
:= esSimple
;
1206 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.MonEffect
), True)] do
1208 EditStyle
:= esEllipsis
;
1212 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.MonMax
), True)] do
1214 EditStyle
:= esSimple
;
1218 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.MonDelay
), True)] do
1220 EditStyle
:= esSimple
;
1224 case Data
.MonBehav
of
1225 1: str
:= MsgPropTrMonsterBehaviour1
;
1226 2: str
:= MsgPropTrMonsterBehaviour2
;
1227 3: str
:= MsgPropTrMonsterBehaviour3
;
1228 4: str
:= MsgPropTrMonsterBehaviour4
;
1229 5: str
:= MsgPropTrMonsterBehaviour5
;
1230 else str
:= MsgPropTrMonsterBehaviour0
;
1232 with ItemProps
[InsertRow(MsgPropTrMonsterBehaviour
, str
, True)] do
1234 EditStyle
:= esPickList
;
1241 with ItemProps
[InsertRow(MsgPropTrItemType
, ItemToStr(Data
.ItemType
), True)] do
1243 EditStyle
:= esEllipsis
;
1247 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1248 Format('(%d:%d)', [Data
.ItemPos
.X
, Data
.ItemPos
.Y
]), True)] do
1250 EditStyle
:= esEllipsis
;
1254 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[Data
.ItemOnlyDM
], True)] do
1256 EditStyle
:= esPickList
;
1260 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Data
.ItemFalls
], True)] do
1262 EditStyle
:= esPickList
;
1266 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ItemCount
), True)] do
1268 EditStyle
:= esSimple
;
1272 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.ItemEffect
), True)] do
1274 EditStyle
:= esEllipsis
;
1278 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.ItemMax
), True)] do
1280 EditStyle
:= esSimple
;
1284 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.ItemDelay
), True)] do
1286 EditStyle
:= esSimple
;
1293 str
:= win2utf(Data
.MusicName
);
1294 with ItemProps
[InsertRow(MsgPropTrMusicName
, str
, True)] do
1296 EditStyle
:= esEllipsis
;
1300 if Data
.MusicAction
= 1 then
1301 str
:= MsgPropTrMusicOn
1303 str
:= MsgPropTrMusicOff
;
1305 with ItemProps
[InsertRow(MsgPropTrMusicAct
, str
, True)] do
1307 EditStyle
:= esPickList
;
1314 with ItemProps
[InsertRow(MsgPropTrPushAngle
, IntToStr(Data
.PushAngle
), True)] do
1316 EditStyle
:= esSimple
;
1319 with ItemProps
[InsertRow(MsgPropTrPushForce
, IntToStr(Data
.PushForce
), True)] do
1321 EditStyle
:= esSimple
;
1324 with ItemProps
[InsertRow(MsgPropTrPushReset
, BoolNames
[Data
.ResetVel
], True)] do
1326 EditStyle
:= esPickList
;
1333 case Data
.ScoreAction
of
1334 1: str
:= MsgPropTrScoreAct1
;
1335 2: str
:= MsgPropTrScoreAct2
;
1336 3: str
:= MsgPropTrScoreAct3
;
1337 else str
:= MsgPropTrScoreAct0
;
1339 with ItemProps
[InsertRow(MsgPropTrScoreAct
, str
, True)] do
1341 EditStyle
:= esPickList
;
1344 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ScoreCount
), True)] do
1346 EditStyle
:= esSimple
;
1349 case Data
.ScoreTeam
of
1350 1: str
:= MsgPropTrScoreTeam1
;
1351 2: str
:= MsgPropTrScoreTeam2
;
1352 3: str
:= MsgPropTrScoreTeam3
;
1353 else str
:= MsgPropTrScoreTeam0
;
1355 with ItemProps
[InsertRow(MsgPropTrScoreTeam
, str
, True)] do
1357 EditStyle
:= esPickList
;
1360 with ItemProps
[InsertRow(MsgPropTrScoreCon
, BoolNames
[Data
.ScoreCon
], True)] do
1362 EditStyle
:= esPickList
;
1365 with ItemProps
[InsertRow(MsgPropTrScoreMsg
, BoolNames
[Data
.ScoreMsg
], True)] do
1367 EditStyle
:= esPickList
;
1374 case Data
.MessageKind
of
1375 1: str
:= MsgPropTrMessageKind1
;
1376 else str
:= MsgPropTrMessageKind0
;
1378 with ItemProps
[InsertRow(MsgPropTrMessageKind
, str
, True)] do
1380 EditStyle
:= esPickList
;
1383 case Data
.MessageSendTo
of
1384 1: str
:= MsgPropTrMessageTo1
;
1385 2: str
:= MsgPropTrMessageTo2
;
1386 3: str
:= MsgPropTrMessageTo3
;
1387 4: str
:= MsgPropTrMessageTo4
;
1388 5: str
:= MsgPropTrMessageTo5
;
1389 else str
:= MsgPropTrMessageTo0
;
1391 with ItemProps
[InsertRow(MsgPropTrMessageTo
, str
, True)] do
1393 EditStyle
:= esPickList
;
1396 str
:= win2utf(Data
.MessageText
);
1397 with ItemProps
[InsertRow(MsgPropTrMessageText
, str
, True)] do
1399 EditStyle
:= esSimple
;
1402 with ItemProps
[InsertRow(MsgPropTrMessageTime
, IntToStr(Data
.MessageTime
), True)] do
1404 EditStyle
:= esSimple
;
1411 with ItemProps
[InsertRow(MsgPropTrDamageValue
, IntToStr(Data
.DamageValue
), True)] do
1413 EditStyle
:= esSimple
;
1416 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.DamageInterval
), True)] do
1418 EditStyle
:= esSimple
;
1421 case Data
.DamageKind
of
1422 3: str
:= MsgPropTrDamageKind3
;
1423 4: str
:= MsgPropTrDamageKind4
;
1424 5: str
:= MsgPropTrDamageKind5
;
1425 6: str
:= MsgPropTrDamageKind6
;
1426 7: str
:= MsgPropTrDamageKind7
;
1427 8: str
:= MsgPropTrDamageKind8
;
1428 else str
:= MsgPropTrDamageKind0
;
1430 with ItemProps
[InsertRow(MsgPropTrDamageKind
, str
, True)] do
1432 EditStyle
:= esPickList
;
1439 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.HealValue
), True)] do
1441 EditStyle
:= esSimple
;
1444 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.HealInterval
), True)] do
1446 EditStyle
:= esSimple
;
1449 with ItemProps
[InsertRow(MsgPropTrHealthMax
, BoolNames
[Data
.HealMax
], True)] do
1451 EditStyle
:= esPickList
;
1454 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.HealSilent
], True)] do
1456 EditStyle
:= esPickList
;
1463 with ItemProps
[InsertRow(MsgPropTrShotType
, ShotToStr(Data
.ShotType
), True)] do
1465 EditStyle
:= esEllipsis
;
1469 with ItemProps
[InsertRow(MsgPropTrShotSound
, BoolNames
[Data
.ShotSound
], True)] do
1471 EditStyle
:= esPickList
;
1475 with ItemProps
[InsertRow(MsgPropTrShotPanel
, IntToStr(Data
.ShotPanelID
), True)] do
1477 EditStyle
:= esEllipsis
;
1481 case Data
.ShotTarget
of
1482 1: str
:= MsgPropTrShotTo1
;
1483 2: str
:= MsgPropTrShotTo2
;
1484 3: str
:= MsgPropTrShotTo3
;
1485 4: str
:= MsgPropTrShotTo4
;
1486 5: str
:= MsgPropTrShotTo5
;
1487 6: str
:= MsgPropTrShotTo6
;
1488 else str
:= MsgPropTrShotTo0
;
1490 with ItemProps
[InsertRow(MsgPropTrShotTo
, str
, True)] do
1492 EditStyle
:= esPickList
;
1496 with ItemProps
[InsertRow(MsgPropTrShotSight
, IntToStr(Data
.ShotIntSight
), True)] do
1498 EditStyle
:= esSimple
;
1502 case Data
.ShotAim
of
1503 1: str
:= MsgPropTrShotAim1
;
1504 2: str
:= MsgPropTrShotAim2
;
1505 3: str
:= MsgPropTrShotAim3
;
1506 else str
:= MsgPropTrShotAim0
;
1508 with ItemProps
[InsertRow(MsgPropTrShotAim
, str
, True)] do
1510 EditStyle
:= esPickList
;
1514 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1515 Format('(%d:%d)', [Data
.ShotPos
.X
, Data
.ShotPos
.Y
]), True)] do
1517 EditStyle
:= esEllipsis
;
1521 with ItemProps
[InsertRow(MsgPropTrShotAngle
, IntToStr(Data
.ShotAngle
), True)] do
1523 EditStyle
:= esSimple
;
1527 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.ShotWait
), True)] do
1529 EditStyle
:= esSimple
;
1533 with ItemProps
[InsertRow(MsgPropTrShotAcc
, IntToStr(Data
.ShotAccuracy
), True)] do
1535 EditStyle
:= esSimple
;
1539 with ItemProps
[InsertRow(MsgPropTrShotAmmo
, IntToStr(Data
.ShotAmmo
), True)] do
1541 EditStyle
:= esSimple
;
1545 with ItemProps
[InsertRow(MsgPropTrShotReload
, IntToStr(Data
.ShotIntReload
), True)] do
1547 EditStyle
:= esSimple
;
1554 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.FXCount
), True)] do
1556 EditStyle
:= esSimple
;
1560 if Data
.FXType
= 0 then
1561 str
:= MsgPropTrEffectParticle
1563 str
:= MsgPropTrEffectAnimation
;
1564 with ItemProps
[InsertRow(MsgPropTrEffectType
, str
, True)] do
1566 EditStyle
:= esEllipsis
;
1571 if Data
.FXType
= 0 then
1572 case Data
.FXSubType
of
1573 TRIGGER_EFFECT_SLIQUID
:
1574 str
:= MsgPropTrEffectSliquid
;
1575 TRIGGER_EFFECT_LLIQUID
:
1576 str
:= MsgPropTrEffectLliquid
;
1577 TRIGGER_EFFECT_DLIQUID
:
1578 str
:= MsgPropTrEffectDliquid
;
1579 TRIGGER_EFFECT_BLOOD
:
1580 str
:= MsgPropTrEffectBlood
;
1581 TRIGGER_EFFECT_SPARK
:
1582 str
:= MsgPropTrEffectSpark
;
1583 TRIGGER_EFFECT_BUBBLE
:
1584 str
:= MsgPropTrEffectBubble
;
1586 if Data
.FXType
= 1 then
1588 if (Data
.FXSubType
= 0) or (Data
.FXSubType
> EFFECT_FIRE
) then
1589 Data
.FXSubType
:= EFFECT_TELEPORT
;
1590 str
:= EffectToStr(Data
.FXSubType
);
1592 with ItemProps
[InsertRow(MsgPropTrEffectSubtype
, str
, True)] do
1594 EditStyle
:= esEllipsis
;
1598 with ItemProps
[InsertRow(MsgPropTrEffectColor
, IntToStr(Data
.FXColorR
or (Data
.FXColorG
shl 8) or (Data
.FXColorB
shl 16)), True)] do
1600 EditStyle
:= esEllipsis
;
1604 with ItemProps
[InsertRow(MsgPropTrEffectCenter
, BoolNames
[Data
.FXPos
= 0], True)] do
1606 EditStyle
:= esPickList
;
1610 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.FXWait
), True)] do
1612 EditStyle
:= esSimple
;
1616 with ItemProps
[InsertRow(MsgPropTrEffectVelx
, IntToStr(Data
.FXVelX
), True)] do
1618 EditStyle
:= esSimple
;
1622 with ItemProps
[InsertRow(MsgPropTrEffectVely
, IntToStr(Data
.FXVelY
), True)] do
1624 EditStyle
:= esSimple
;
1628 with ItemProps
[InsertRow(MsgPropTrEffectSpl
, IntToStr(Data
.FXSpreadL
), True)] do
1630 EditStyle
:= esSimple
;
1634 with ItemProps
[InsertRow(MsgPropTrEffectSpr
, IntToStr(Data
.FXSpreadR
), True)] do
1636 EditStyle
:= esSimple
;
1640 with ItemProps
[InsertRow(MsgPropTrEffectSpu
, IntToStr(Data
.FXSpreadU
), True)] do
1642 EditStyle
:= esSimple
;
1646 with ItemProps
[InsertRow(MsgPropTrEffectSpd
, IntToStr(Data
.FXSpreadD
), True)] do
1648 EditStyle
:= esSimple
;
1652 end; //case TriggerType
1654 end; // OBJECT_TRIGGER:
1658 procedure ChangeShownProperty(Name
: String; NewValue
: String);
1662 if SelectedObjectCount() <> 1 then
1664 if not SelectedObjects
[GetFirstSelected()].Live
then
1667 // Есть ли такой ключ:
1668 if MainForm
.vleObjectProperty
.FindRow(Name
, row
) then
1670 MainForm
.vleObjectProperty
.Values
[Name
] := NewValue
;
1674 procedure SelectObject(fObjectType
: Byte; fID
: DWORD
; Multi
: Boolean);
1683 // Уже выделен - убираем:
1684 if SelectedObjects
<> nil then
1685 for a
:= 0 to High(SelectedObjects
) do
1686 with SelectedObjects
[a
] do
1687 if Live
and (ID
= fID
) and
1688 (ObjectType
= fObjectType
) then
1697 SetLength(SelectedObjects
, Length(SelectedObjects
)+1);
1699 with SelectedObjects
[High(SelectedObjects
)] do
1701 ObjectType
:= fObjectType
;
1708 SetLength(SelectedObjects
, 1);
1710 with SelectedObjects
[0] do
1712 ObjectType
:= fObjectType
;
1718 MainForm
.miCopy
.Enabled
:= True;
1719 MainForm
.miCut
.Enabled
:= True;
1721 if fObjectType
= OBJECT_PANEL
then
1723 MainForm
.miToFore
.Enabled
:= True;
1724 MainForm
.miToBack
.Enabled
:= True;
1728 procedure RemoveSelectFromObjects();
1730 SelectedObjects
:= nil;
1731 DrawPressRect
:= False;
1732 MouseLDown
:= False;
1733 MouseRDown
:= False;
1734 MouseAction
:= MOUSEACTION_NONE
;
1735 SelectFlag
:= SELECTFLAG_NONE
;
1736 ResizeType
:= RESIZETYPE_NONE
;
1737 ResizeDirection
:= RESIZEDIR_NONE
;
1739 MainForm
.vleObjectProperty
.Strings
.Clear();
1741 MainForm
.miCopy
.Enabled
:= False;
1742 MainForm
.miCut
.Enabled
:= False;
1743 MainForm
.miToFore
.Enabled
:= False;
1744 MainForm
.miToBack
.Enabled
:= False;
1747 procedure DeleteSelectedObjects();
1752 if SelectedObjects
= nil then
1758 for a
:= 0 to High(SelectedObjects
) do
1759 with SelectedObjects
[a
] do
1764 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1765 i
:= High(UndoBuffer
);
1769 SetLength(UndoBuffer
[i
], Length(UndoBuffer
[i
])+1);
1770 ii
:= High(UndoBuffer
[i
]);
1775 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_PANEL
;
1776 New(UndoBuffer
[i
, ii
].Panel
);
1777 UndoBuffer
[i
, ii
].Panel
^ := gPanels
[ID
];
1781 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_ITEM
;
1782 UndoBuffer
[i
, ii
].Item
:= gItems
[ID
];
1786 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_AREA
;
1787 UndoBuffer
[i
, ii
].Area
:= gAreas
[ID
];
1791 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_TRIGGER
;
1792 UndoBuffer
[i
, ii
].Trigger
:= gTriggers
[ID
];
1796 RemoveObject(ID
, ObjectType
);
1799 RemoveSelectFromObjects();
1801 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1802 MainForm
.RecountSelectedObjects();
1805 procedure Undo_Add(ObjectType
: Byte; ID
: DWORD
; Group
: Boolean = False);
1809 if (not Group
) or (Length(UndoBuffer
) = 0) then
1810 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1811 SetLength(UndoBuffer
[High(UndoBuffer
)], Length(UndoBuffer
[High(UndoBuffer
)])+1);
1812 i
:= High(UndoBuffer
);
1813 ii
:= High(UndoBuffer
[i
]);
1817 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_PANEL
;
1819 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_ITEM
;
1821 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_MONSTER
;
1823 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_AREA
;
1825 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_TRIGGER
;
1828 UndoBuffer
[i
, ii
].AddID
:= ID
;
1829 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1832 procedure DiscardUndoBuffer();
1836 for i
:= 0 to High(UndoBuffer
) do
1837 for k
:= 0 to High(UndoBuffer
[i
]) do
1838 with UndoBuffer
[i
][k
] do
1839 if UndoType
= UNDO_DELETE_PANEL
then
1845 procedure FullClear();
1847 RemoveSelectFromObjects();
1849 LoadSky(gMapInfo
.SkyName
);
1850 DiscardUndoBuffer();
1851 slInvalidTextures
.Clear();
1852 MapCheckForm
.lbErrorList
.Clear();
1853 MapCheckForm
.mErrorDescription
.Clear();
1855 MainForm
.miUndo
.Enabled
:= False;
1856 MainForm
.sbHorizontal
.Position
:= 0;
1857 MainForm
.sbVertical
.Position
:= 0;
1858 MainForm
.FormResize(nil);
1859 MainForm
.Caption
:= FormCaption
;
1864 procedure ErrorMessageBox(str
: String);
1866 Application
.MessageBox(PChar(str
), PChar(MsgMsgError
),
1867 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
1870 function CheckProperty(): Boolean;
1876 _id
:= GetFirstSelected();
1878 if SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
then
1879 with gPanels
[SelectedObjects
[_id
].ID
] do
1881 if TextureWidth
<> 0 then
1882 if StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 1) mod TextureWidth
<> 0 then
1884 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
1889 if TextureHeight
<> 0 then
1890 if StrToIntDef(Trim(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
]), 1) mod TextureHeight
<> 0 then
1892 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
1897 if IsTexturedPanel(PanelType
) and (TextureName
<> '') then
1898 if not (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropPanelAlpha
], -1) in [0..255]) then
1900 ErrorMessageBox(MsgMsgWrongAlpha
);
1905 if SelectedObjects
[_id
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
1906 if (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 0) <= 0) or
1907 (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
], 0) <= 0) then
1909 ErrorMessageBox(MsgMsgWrongSize
);
1913 if (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropX
]) = '') or
1914 (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropY
]) = '') then
1916 ErrorMessageBox(MsgMsgWrongXy
);
1923 procedure SelectTexture(ID
: Integer);
1925 MainForm
.lbTextureList
.ItemIndex
:= ID
;
1926 MainForm
.lbTextureListClick(nil);
1929 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
1931 a
, FrameLen
: Integer;
1934 ResourceName
: String;
1935 FullResourceName
: String;
1936 SectionName
: String;
1938 Width
, Height
: Word;
1946 if aSection
= '..' then
1949 SectionName
:= aSection
;
1952 aWAD
:= MsgWadSpecialMap
;
1954 if aWAD
= MsgWadSpecialMap
then
1956 g_ProcessResourceStr(OpenedMap
, @fn
, nil, nil);
1958 ResourceName
:= ':'+SectionName
+'\'+aTex
;
1961 if aWAD
= MsgWadSpecialTexs
then
1962 begin // Спец. текстуры
1964 ResourceName
:= aTex
;
1967 begin // Внешний WAD
1968 FileName
:= WadsDir
+ DirectorySeparator
+ aWAD
;
1969 ResourceName
:= aWAD
+':'+SectionName
+'\'+aTex
;
1974 // Есть ли уже такая текстура:
1975 for a
:= 0 to MainForm
.lbTextureList
.Items
.Count
-1 do
1976 if ResourceName
= MainForm
.lbTextureList
.Items
[a
] then
1979 ErrorMessageBox(Format(MsgMsgTextureAlready
,
1984 // Название ресурса <= 64 символов:
1985 if Length(ResourceName
) > 64 then
1988 ErrorMessageBox(Format(MsgMsgResName64
,
1996 if aWAD
= MsgWadSpecialTexs
then
1998 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2005 FullResourceName
:= FileName
+':'+SectionName
+'\'+aTex
;
2007 if IsAnim(FullResourceName
) then
2008 begin // Аним. текстура
2009 GetFrame(FullResourceName
, Data
, FrameLen
, Width
, Height
);
2011 if not g_CreateTextureMemorySize(Data
, FrameLen
, ResourceName
, 0, 0, Width
, Height
, 1) then
2013 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2015 else // Обычная текстура
2017 if not g_CreateTextureWAD(ResourceName
, FullResourceName
) then
2019 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2021 if (not ok
) and (slInvalidTextures
.IndexOf(ResourceName
) = -1) then
2023 slInvalidTextures
.Add(ResourceName
);
2026 if (a
> -1) and (not silent
) then
2033 procedure UpdateCaption(sMap
, sFile
, sRes
: String);
2036 if (sFile
= '') and (sRes
= '') and (sMap
= '') then
2037 Caption
:= FormCaption
2040 Caption
:= Format('%s - %s:%s', [FormCaption
, sFile
, sRes
])
2042 if (sFile
<> '') and (sRes
<> '') then
2043 Caption
:= Format('%s - %s (%s:%s)', [FormCaption
, sMap
, sFile
, sRes
])
2045 Caption
:= Format('%s - %s', [FormCaption
, sMap
]);
2048 procedure OpenMap(FileName
: String; mapN
: String);
2053 SelectMapForm
.Caption
:= MsgCapOpen
;
2054 SelectMapForm
.GetMaps(FileName
);
2056 if (FileName
= OpenedWAD
) and
2057 (OpenedMap
<> '') then
2059 MapName
:= OpenedMap
;
2060 while (Pos(':\', MapName
) > 0) do
2061 Delete(MapName
, 1, Pos(':\', MapName
) + 1);
2063 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(MapName
);
2064 SelectMapForm
.lbMapList
.ItemIndex
:= idx
;
2067 if SelectMapForm
.lbMapList
.Count
> 0 then
2068 SelectMapForm
.lbMapList
.ItemIndex
:= 0
2070 SelectMapForm
.lbMapList
.ItemIndex
:= -1;
2075 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(mapN
);
2079 if (SelectMapForm
.ShowModal() = mrOK
) and
2080 (SelectMapForm
.lbMapList
.ItemIndex
<> -1) then
2081 idx
:= SelectMapForm
.lbMapList
.ItemIndex
2086 MapName
:= SelectMapForm
.lbMapList
.Items
[idx
];
2092 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
2093 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
2094 pLoadProgress
.Show();
2096 OpenedMap
:= FileName
+':\'+MapName
;
2097 OpenedWAD
:= FileName
;
2099 idx
:= RecentFiles
.IndexOf(OpenedMap
);
2100 // Такая карта уже недавно открывалась:
2102 RecentFiles
.Delete(idx
);
2103 RecentFiles
.Insert(0, OpenedMap
);
2104 RefreshRecentMenu();
2108 pLoadProgress
.Hide();
2111 lbTextureList
.Sorted
:= True;
2112 lbTextureList
.Sorted
:= False;
2114 UpdateCaption(gMapInfo
.Name
, ExtractFileName(FileName
), MapName
);
2118 procedure MoveSelectedObjects(Wall
, alt
: Boolean; dx
, dy
: Integer);
2123 if SelectedObjects
= nil then
2130 for a
:= 0 to High(SelectedObjects
) do
2131 if SelectedObjects
[a
].Live
then
2133 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, dx
, 0) then
2136 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, 0, dy
) then
2139 if (not okX
) or (not okY
) then
2145 for a
:= 0 to High(SelectedObjects
) do
2146 if SelectedObjects
[a
].Live
then
2149 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, dx
, 0);
2152 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, 0, dy
);
2154 if alt
and (SelectedObjects
[a
].ObjectType
= OBJECT_TRIGGER
) then
2156 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_PRESS
,
2157 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
] then
2158 begin // Двигаем зону Расширителя
2160 gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
+dx
;
2162 gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
+dy
;
2165 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_TELEPORT
] then
2166 begin // Двигаем точку назначения Телепорта
2168 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
+dx
;
2170 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
+dy
;
2173 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNMONSTER
] then
2174 begin // Двигаем точку создания монстра
2176 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
+dx
;
2178 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
+dy
;
2181 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNITEM
] then
2182 begin // Двигаем точку создания предмета
2184 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
+dx
;
2186 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
+dy
;
2189 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SHOT
] then
2190 begin // Двигаем точку создания выстрела
2192 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
+dx
;
2194 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
+dy
;
2199 LastMovePoint
:= MousePos
;
2203 procedure ShowLayer(Layer
: Byte; show
: Boolean);
2205 LayerEnabled
[Layer
] := show
;
2210 MainForm
.miLayer1
.Checked
:= show
;
2211 MainForm
.miLayerP1
.Checked
:= show
;
2215 MainForm
.miLayer2
.Checked
:= show
;
2216 MainForm
.miLayerP2
.Checked
:= show
;
2220 MainForm
.miLayer3
.Checked
:= show
;
2221 MainForm
.miLayerP3
.Checked
:= show
;
2225 MainForm
.miLayer4
.Checked
:= show
;
2226 MainForm
.miLayerP4
.Checked
:= show
;
2230 MainForm
.miLayer5
.Checked
:= show
;
2231 MainForm
.miLayerP5
.Checked
:= show
;
2235 MainForm
.miLayer6
.Checked
:= show
;
2236 MainForm
.miLayerP6
.Checked
:= show
;
2240 MainForm
.miLayer7
.Checked
:= show
;
2241 MainForm
.miLayerP7
.Checked
:= show
;
2245 MainForm
.miLayer8
.Checked
:= show
;
2246 MainForm
.miLayerP8
.Checked
:= show
;
2250 MainForm
.miLayer9
.Checked
:= show
;
2251 MainForm
.miLayerP9
.Checked
:= show
;
2255 RemoveSelectFromObjects();
2258 procedure SwitchLayer(Layer
: Byte);
2260 ShowLayer(Layer
, not LayerEnabled
[Layer
]);
2263 procedure SwitchMap();
2265 ShowMap
:= not ShowMap
;
2266 MainForm
.tbShowMap
.Down
:= ShowMap
;
2267 MainForm
.miMiniMap
.Checked
:= ShowMap
;
2270 procedure ShowEdges();
2272 if drEdge
[3] < 255 then
2275 drEdge
[3] := gAlphaEdge
;
2276 MainForm
.miShowEdges
.Checked
:= drEdge
[3] <> 255;
2279 function SelectedTexture(): String;
2281 if MainForm
.lbTextureList
.ItemIndex
<> -1 then
2282 Result
:= MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]
2287 function IsSpecialTextureSel(): Boolean;
2289 Result
:= (MainForm
.lbTextureList
.ItemIndex
<> -1) and
2290 IsSpecialTexture(MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]);
2293 function CopyBufferToString(var CopyBuf
: TCopyRecArray
): String;
2298 procedure AddInt(x
: Integer);
2300 Res
:= Res
+ IntToStr(x
) + ' ';
2306 if Length(CopyBuf
) = 0 then
2309 Res
:= CLIPBOARD_SIG
+ ' ';
2311 for i
:= 0 to High(CopyBuf
) do
2313 if (CopyBuf
[i
].ObjectType
= OBJECT_PANEL
) and
2314 (CopyBuf
[i
].Panel
= nil) then
2318 AddInt(CopyBuf
[i
].ObjectType
);
2321 // Свойства объекта:
2322 case CopyBuf
[i
].ObjectType
of
2324 with CopyBuf
[i
].Panel
^ do
2331 Res
:= Res
+ '"' + TextureName
+ '" ';
2333 AddInt(IfThen(Blending
, 1, 0));
2337 with CopyBuf
[i
].Item
do
2342 AddInt(IfThen(OnlyDM
, 1, 0));
2343 AddInt(IfThen(Fall
, 1, 0));
2347 with CopyBuf
[i
].Monster
do
2349 AddInt(MonsterType
);
2352 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2356 with CopyBuf
[i
].Area
do
2361 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2365 with CopyBuf
[i
].Trigger
do
2367 AddInt(TriggerType
);
2372 AddInt(ActivateType
);
2374 AddInt(IfThen(Enabled
, 1, 0));
2375 AddInt(TexturePanel
);
2377 for j
:= 0 to 127 do
2378 AddInt(Data
.Default
[j
]);
2386 procedure StringToCopyBuffer(Str
: String; var CopyBuf
: TCopyRecArray
; var pmin
: TPoint
);
2389 minArea
, newArea
, newX
, newY
: LongInt;
2391 function GetNext(): String;
2396 if Str
[1] = '"' then
2408 Result
:= Copy(Str
, 1, p
-1);
2424 Result
:= Copy(Str
, 1, p
-1);
2432 minArea
:= High(minArea
);
2435 if GetNext() <> CLIPBOARD_SIG
then
2441 t
:= StrToIntDef(GetNext(), 0);
2443 if (t
< OBJECT_PANEL
) or (t
> OBJECT_TRIGGER
) or (GetNext() <> ';') then
2444 begin // Что-то не то => пропускаем:
2452 i
:= Length(CopyBuf
);
2453 SetLength(CopyBuf
, i
+ 1);
2455 CopyBuf
[i
].ObjectType
:= t
;
2456 CopyBuf
[i
].Panel
:= nil;
2458 // Свойства объекта:
2462 New(CopyBuf
[i
].Panel
);
2464 with CopyBuf
[i
].Panel
^ do
2466 PanelType
:= StrToIntDef(GetNext(), PANEL_WALL
);
2467 X
:= StrToIntDef(GetNext(), 0);
2468 Y
:= StrToIntDef(GetNext(), 0);
2469 Width
:= StrToIntDef(GetNext(), 16);
2470 Height
:= StrToIntDef(GetNext(), 16);
2471 TextureName
:= GetNext();
2472 Alpha
:= StrToIntDef(GetNext(), 0);
2473 Blending
:= (GetNext() = '1');
2474 newArea
:= X
* Y
- Width
* Height
;
2481 with CopyBuf
[i
].Item
do
2483 ItemType
:= StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL
);
2484 X
:= StrToIntDef(GetNext(), 0);
2485 Y
:= StrToIntDef(GetNext(), 0);
2486 OnlyDM
:= (GetNext() = '1');
2487 Fall
:= (GetNext() = '1');
2494 with CopyBuf
[i
].Monster
do
2496 MonsterType
:= StrToIntDef(GetNext(), MONSTER_DEMON
);
2497 X
:= StrToIntDef(GetNext(), 0);
2498 Y
:= StrToIntDef(GetNext(), 0);
2500 then Direction
:= D_LEFT
2501 else Direction
:= D_RIGHT
;
2508 with CopyBuf
[i
].Area
do
2510 AreaType
:= StrToIntDef(GetNext(), AREA_PLAYERPOINT1
);
2511 X
:= StrToIntDef(GetNext(), 0);
2512 Y
:= StrToIntDef(GetNext(), 0);
2514 then Direction
:= D_LEFT
2515 else Direction
:= D_RIGHT
;
2522 with CopyBuf
[i
].Trigger
do
2524 TriggerType
:= StrToIntDef(GetNext(), TRIGGER_EXIT
);
2525 X
:= StrToIntDef(GetNext(), 0);
2526 Y
:= StrToIntDef(GetNext(), 0);
2527 Width
:= StrToIntDef(GetNext(), 16);
2528 Height
:= StrToIntDef(GetNext(), 16);
2529 ActivateType
:= StrToIntDef(GetNext(), 0);
2530 Key
:= StrToIntDef(GetNext(), 0);
2531 Enabled
:= (GetNext() = '1');
2532 TexturePanel
:= StrToIntDef(GetNext(), 0);
2534 do Data
.Default
[j
] := StrToIntDef(GetNext(), 0);
2535 newArea
:= X
* Y
- Width
* Height
;
2541 if newArea
< minArea
then
2550 //----------------------------------------
2551 //Закончились вспомогательные процедуры
2552 //----------------------------------------
2554 procedure TMainForm
.miRecentFileExecute (Sender
: TObject
);
2559 n
:= (Sender
as TMenuItem
).Tag
;
2560 s
:= RecentFiles
[n
];
2561 fn
:= g_ExtractWadName(s
);
2562 if FileExists(fn
) then
2563 OpenMap(fn
, g_ExtractFilePathName(s
))
2565 Application
.MessageBox('File not available anymore', '', MB_OK
);
2566 // if Application.MessageBox(PChar(MsgMsgDelRecentPrompt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
2568 // RecentFiles.Delete(n);
2569 // RefreshRecentMenu();
2573 procedure TMainForm
.RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
2574 var i
: Integer; MI
: TMenuItem
; s
: AnsiString;
2576 Assert(menu
<> nil);
2578 Assert(start
<= menu
.Count
);
2580 // clear all the recent entries from menu
2582 while i
< menu
.Count
do
2584 MI
:= menu
.Items
[i
];
2585 if @MI
.OnClick
<> @TMainForm
.miRecentFileExecute
then
2590 Application
.ReleaseComponent(MI
);
2594 // fill with a new ones
2595 for i
:= 0 to RecentFiles
.Count
-1 do
2597 MI
:= TMenuItem
.Create(menu
);
2598 s
:= RecentFiles
[i
];
2599 MI
.Caption
:= Format(fmt
, [i
+1, g_ExtractWadNameNoPath(s
), g_ExtractFilePathName(s
)]);
2600 MI
.OnClick
:= miRecentFileExecute
;
2602 menu
.Insert(start
+ i
, MI
); // transfers ownership
2606 procedure TMainForm
.RefreshRecentMenu();
2609 while RecentFiles
.Count
> RecentCount
do
2610 RecentFiles
.Delete(RecentFiles
.Count
- 1);
2612 if miMacRecentSubMenu
.Visible
then
2614 // Reconstruct OSX-like recent list
2615 RefillRecentMenu(miMacRecentSubMenu
, 0, '%1:s - %2:s');
2616 miMacRecentEnd
.Enabled
:= RecentFiles
.Count
<> 0;
2617 miMacRecentEnd
.Visible
:= RecentFiles
.Count
<> 0;
2620 if miWinRecentStart
.Visible
then
2622 // Reconstruct Windows-like recent list
2623 start
:= miMenuFile
.IndexOf(miWinRecent
);
2624 if start
< 0 then start
:= miMenuFile
.Count
else start
+= 1;
2625 RefillRecentMenu(miMenuFile
, start
, '%0:d %1:s:%2:s');
2626 miWinRecent
.Enabled
:= False;
2627 miWinRecent
.Visible
:= RecentFiles
.Count
= 0;
2631 procedure TMainForm
.miMacRecentClearClick(Sender
: TObject
);
2633 RecentFiles
.Clear();
2634 RefreshRecentMenu();
2637 procedure TMainForm
.aEditorOptionsExecute(Sender
: TObject
);
2639 OptionsForm
.ShowModal();
2642 procedure LoadStdFont(cfgres
, texture
: string; var FontID
: DWORD
);
2656 wad
:= TWADEditor_1
.Create
;
2657 if wad
.ReadFile(GameWad
) then
2658 wad
.GetResource('FONTS', cfgres
, cfgdata
, cfglen
);
2663 if not g_CreateTextureWAD('FONT_STD', GameWad
+ ':FONTS\' + texture
) then
2664 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING
);
2666 config
:= TConfig
.CreateMem(cfgdata
, cfglen
);
2667 cwdt
:= Min(Max(config
.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2668 chgt
:= Min(Max(config
.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2669 spc
:= Min(Max(config
.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2671 if g_GetTexture('FONT_STD', ID
) then
2672 e_TextureFontBuild(ID
, FontID
, cwdt
, chgt
, spc
-2);
2677 e_WriteLog('Could not load FONT_STD', MSG_WARNING
);
2679 if cfglen
<> 0 then FreeMem(cfgdata
);
2682 procedure TMainForm
.FormCreate(Sender
: TObject
);
2692 miApple
.Enabled
:= True;
2693 miApple
.Visible
:= True;
2694 miMacRecentSubMenu
.Enabled
:= True;
2695 miMacRecentSubMenu
.Visible
:= True;
2696 miWinRecentStart
.Enabled
:= False;
2697 miWinRecentStart
.Visible
:= False;
2698 miWinRecent
.Enabled
:= False;
2699 miWinRecent
.Visible
:= False;
2700 miLine2
.Enabled
:= False;
2701 miLine2
.Visible
:= False;
2702 miExit
.Enabled
:= False;
2703 miExit
.Visible
:= False;
2704 miOptions
.Enabled
:= False;
2705 miOptions
.Visible
:= False;
2706 miMenuWindow
.Enabled
:= True;
2707 miMenuWindow
.Visible
:= True;
2708 miAbout
.Enabled
:= False;
2709 miAbout
.Visible
:= False;
2711 miApple
.Enabled
:= False;
2712 miApple
.Visible
:= False;
2713 miMacRecentSubMenu
.Enabled
:= False;
2714 miMacRecentSubMenu
.Visible
:= False;
2715 miWinRecentStart
.Enabled
:= True;
2716 miWinRecentStart
.Visible
:= True;
2717 miWinRecent
.Enabled
:= True;
2718 miWinRecent
.Visible
:= True;
2719 miLine2
.Enabled
:= True;
2720 miLine2
.Visible
:= True;
2721 miExit
.Enabled
:= True;
2722 miExit
.Visible
:= True;
2723 miOptions
.Enabled
:= True;
2724 miOptions
.Visible
:= True;
2725 miMenuWindow
.Enabled
:= False;
2726 miMenuWindow
.Visible
:= False;
2727 miAbout
.Enabled
:= True;
2728 miAbout
.Visible
:= True;
2731 miNewMap
.ShortCut
:= ShortCut(VK_N
, [ssModifier
]);
2732 miOpenMap
.ShortCut
:= ShortCut(VK_O
, [ssModifier
]);
2733 miSaveMap
.ShortCut
:= ShortCut(VK_S
, [ssModifier
]);
2735 miSaveMapAs
.ShortCut
:= ShortCut(VK_S
, [ssModifier
, ssShift
]);
2736 miReopenMap
.ShortCut
:= ShortCut(VK_F5
, [ssModifier
]);
2738 miUndo
.ShortCut
:= ShortCut(VK_Z
, [ssModifier
]);
2739 miCopy
.ShortCut
:= ShortCut(VK_C
, [ssModifier
]);
2740 miCut
.ShortCut
:= ShortCut(VK_X
, [ssModifier
]);
2741 miPaste
.ShortCut
:= ShortCut(VK_V
, [ssModifier
]);
2742 miSelectAll
.ShortCut
:= ShortCut(VK_A
, [ssModifier
]);
2743 miToFore
.ShortCut
:= ShortCut(VK_LCL_CLOSE_BRACKET
, [ssModifier
]);
2744 miToBack
.ShortCut
:= ShortCut(VK_LCL_OPEN_BRACKET
, [ssModifier
]);
2746 miMapOptions
.Shortcut
:= ShortCut(VK_P
, [ssModifier
, ssAlt
]);
2747 selectall1
.Shortcut
:= ShortCut(VK_A
, [ssModifier
, ssAlt
]);
2750 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION
, MSG_NOTIFY
);
2751 e_WriteLog('Build date: ' + EDITOR_BUILDDATE
+ ' ' + EDITOR_BUILDTIME
, MSG_NOTIFY
);
2752 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY
);
2753 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY
);
2755 slInvalidTextures
:= TStringList
.Create
;
2757 ShowLayer(LAYER_BACK
, True);
2758 ShowLayer(LAYER_WALLS
, True);
2759 ShowLayer(LAYER_FOREGROUND
, True);
2760 ShowLayer(LAYER_STEPS
, True);
2761 ShowLayer(LAYER_WATER
, True);
2762 ShowLayer(LAYER_ITEMS
, True);
2763 ShowLayer(LAYER_MONSTERS
, True);
2764 ShowLayer(LAYER_AREAS
, True);
2765 ShowLayer(LAYER_TRIGGERS
, True);
2769 FormCaption
:= MainForm
.Caption
;
2773 config
:= TConfig
.CreateFile(CfgFileName
);
2775 gWADEditorLogLevel
:= config
.ReadInt('WADEditor', 'LogLevel', DFWAD_LOG_DEFAULT
);
2777 if config
.ReadInt('Editor', 'XPos', -1) = -1 then
2778 Position
:= poDesktopCenter
2780 Left
:= config
.ReadInt('Editor', 'XPos', Left
);
2781 Top
:= config
.ReadInt('Editor', 'YPos', Top
);
2782 Width
:= config
.ReadInt('Editor', 'Width', Width
);
2783 Height
:= config
.ReadInt('Editor', 'Height', Height
);
2785 if config
.ReadBool('Editor', 'Maximize', False) then
2786 WindowState
:= wsMaximized
;
2787 ShowMap
:= config
.ReadBool('Editor', 'Minimap', False);
2788 PanelProps
.Width
:= config
.ReadInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
2789 Splitter1
.Left
:= PanelProps
.Left
;
2790 PanelObjs
.Height
:= config
.ReadInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
2791 Splitter2
.Top
:= PanelObjs
.Top
;
2792 StatusBar
.Top
:= PanelObjs
.BoundsRect
.Bottom
;
2793 DotEnable
:= config
.ReadBool('Editor', 'DotEnable', True);
2794 DotColor
:= config
.ReadInt('Editor', 'DotColor', $FFFFFF);
2795 DotStepOne
:= config
.ReadInt('Editor', 'DotStepOne', 16);
2796 DotStepTwo
:= config
.ReadInt('Editor', 'DotStepTwo', 8);
2797 DotStep
:= config
.ReadInt('Editor', 'DotStep', DotStepOne
);
2798 DrawTexturePanel
:= config
.ReadBool('Editor', 'DrawTexturePanel', True);
2799 DrawPanelSize
:= config
.ReadBool('Editor', 'DrawPanelSize', True);
2800 BackColor
:= config
.ReadInt('Editor', 'BackColor', $7F6040);
2801 PreviewColor
:= config
.ReadInt('Editor', 'PreviewColor', $00FF00);
2802 UseCheckerboard
:= config
.ReadBool('Editor', 'UseCheckerboard', True);
2803 gColorEdge
:= config
.ReadInt('Editor', 'EdgeColor', COLOR_EDGE
);
2804 gAlphaEdge
:= config
.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE
);
2805 if gAlphaEdge
= 255 then
2806 gAlphaEdge
:= ALPHA_EDGE
;
2807 drEdge
[0] := GetRValue(gColorEdge
);
2808 drEdge
[1] := GetGValue(gColorEdge
);
2809 drEdge
[2] := GetBValue(gColorEdge
);
2810 if not config
.ReadBool('Editor', 'EdgeShow', True) then
2813 drEdge
[3] := gAlphaEdge
;
2814 gAlphaTriggerLine
:= config
.ReadInt('Editor', 'LineAlpha', ALPHA_LINE
);
2815 if gAlphaTriggerLine
= 255 then
2816 gAlphaTriggerLine
:= ALPHA_LINE
;
2817 gAlphaTriggerArea
:= config
.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA
);
2818 if gAlphaTriggerArea
= 255 then
2819 gAlphaTriggerArea
:= ALPHA_AREA
;
2820 gAlphaMonsterRect
:= config
.ReadInt('Editor', 'MonsterRectAlpha', 0);
2821 gAlphaAreaRect
:= config
.ReadInt('Editor', 'AreaRectAlpha', 0);
2822 Scale
:= Max(config
.ReadInt('Editor', 'Scale', 1), 1);
2823 DotSize
:= Max(config
.ReadInt('Editor', 'DotSize', 1), 1);
2824 OpenDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastOpenDir', MapsDir
);
2825 SaveDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastSaveDir', MapsDir
);
2827 s
:= config
.ReadStr('Editor', 'Language', '');
2830 TestGameMode
:= config
.ReadStr('TestRun', 'GameMode', 'DM');
2831 TestLimTime
:= config
.ReadStr('TestRun', 'LimTime', '0');
2832 TestLimScore
:= config
.ReadStr('TestRun', 'LimScore', '0');
2833 TestOptionsTwoPlayers
:= config
.ReadBool('TestRun', 'TwoPlayers', False);
2834 TestOptionsTeamDamage
:= config
.ReadBool('TestRun', 'TeamDamage', False);
2835 TestOptionsAllowExit
:= config
.ReadBool('TestRun', 'AllowExit', True);
2836 TestOptionsWeaponStay
:= config
.ReadBool('TestRun', 'WeaponStay', False);
2837 TestOptionsMonstersDM
:= config
.ReadBool('TestRun', 'MonstersDM', False);
2838 TestMapOnce
:= config
.ReadBool('TestRun', 'MapOnce', False);
2839 {$IF DEFINED(DARWIN)}
2840 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeDrawin', GameExeFile
);
2841 {$ELSEIF DEFINED(WINDOWS)}
2842 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeWindows', GameExeFile
);
2844 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeUnix', GameExeFile
);
2846 TestD2DArgs
:= config
.ReadStr('TestRun', 'Args', '');
2848 RecentCount
:= config
.ReadInt('Editor', 'RecentCount', 5);
2849 if RecentCount
> 10 then
2851 if RecentCount
< 2 then
2854 RecentFiles
:= TStringList
.Create();
2855 for i
:= 0 to RecentCount
-1 do
2858 s
:= config
.ReadStr('RecentFilesWin', IntToStr(i
), '');
2860 s
:= config
.ReadStr('RecentFilesUnix', IntToStr(i
), '');
2865 RefreshRecentMenu();
2869 tbShowMap
.Down
:= ShowMap
;
2870 tbGridOn
.Down
:= DotEnable
;
2871 pcObjects
.ActivePageIndex
:= 0;
2872 Application
.Title
:= MsgEditorTitle
;
2874 Application
.OnIdle
:= OnIdle
;
2877 procedure PrintBlack(X
, Y
: Integer; Text: string; FontID
: DWORD
);
2879 // NOTE: all the font printing routines assume CP1251
2880 e_TextureFontPrintEx(X
, Y
, Text, FontID
, 0, 0, 0, 1.0);
2883 procedure InitGraphics
;
2885 // FIXME: this is a shitty hack
2886 if not gDataLoaded
then
2888 e_WriteLog('Init OpenGL', MSG_NOTIFY
);
2890 e_WriteLog('Loading data', MSG_NOTIFY
);
2891 LoadStdFont('STDTXT', 'STDFONT', gEditorFont
);
2892 e_WriteLog('Loading more data', MSG_NOTIFY
);
2894 e_WriteLog('Loading even more data', MSG_NOTIFY
);
2895 gDataLoaded
:= True;
2896 MainForm
.FormResize(nil);
2900 procedure TMainForm
.Draw();
2905 Width
, Height
: Word;
2908 aX
, aY
, aX2
, aY2
, XX
, ScaleSz
: Integer;
2910 LastDrawTime
:= GetTickCount64();
2920 e_Clear(GL_COLOR_BUFFER_BIT
,
2921 GetRValue(BackColor
)/255,
2922 GetGValue(BackColor
)/255,
2923 GetBValue(BackColor
)/255);
2927 ObjCount
:= SelectedObjectCount();
2929 // Обводим выделенные объекты красной рамкой:
2930 if ObjCount
> 0 then
2932 for a
:= 0 to High(SelectedObjects
) do
2933 if SelectedObjects
[a
].Live
then
2935 Rect
:= ObjectGetRect(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
);
2939 e_DrawQuad(X
+MapOffset
.X
, Y
+MapOffset
.Y
,
2940 X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+Height
-1,
2943 // Рисуем точки изменения размеров:
2944 if (ObjCount
= 1) and
2945 (SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) then
2947 e_DrawPoint(5, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2948 e_DrawPoint(5, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2949 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 255, 255);
2950 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 255, 255);
2952 e_DrawPoint(3, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2953 e_DrawPoint(3, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2954 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 0, 0);
2955 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 0, 0);
2962 if DotEnable
and (PreviewMode
= 0) then
2969 glDisable(GL_TEXTURE_2D
);
2970 glColor3ub(GetRValue(DotColor
), GetGValue(DotColor
), GetBValue(DotColor
));
2971 glPointSize(DotSize
);
2973 x
:= MapOffset
.X
mod DotStep
;
2974 while x
< RenderPanel
.Width
do
2976 y
:= MapOffset
.Y
mod DotStep
;
2977 while y
< RenderPanel
.Height
do
2979 glVertex2i(x
+ a
, y
+ a
);
2985 glColor4ub(e_Colors
.R
, e_Colors
.G
, e_Colors
.B
, 255);
2989 if (lbTextureList
.ItemIndex
<> -1) and (cbPreview
.Checked
) and
2990 (not IsSpecialTextureSel()) and (PreviewMode
= 0) then
2992 if not g_GetTexture(SelectedTexture(), ID
) then
2993 g_GetTexture('NOTEXTURE', ID
);
2994 g_GetTextureSizeByID(ID
, Width
, Height
);
2995 if UseCheckerboard
then
2997 if g_GetTexture('PREVIEW', PID
) then
2998 e_DrawFill(PID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, Width
div 16 + 1, Height
div 16 + 1, 0, True, False);
3000 e_DrawFillQuad(RenderPanel
.Width
-Width
-2, RenderPanel
.Height
-Height
-2,
3001 RenderPanel
.Width
-1, RenderPanel
.Height
-1,
3002 GetRValue(PreviewColor
), GetGValue(PreviewColor
), GetBValue(PreviewColor
), 0);
3003 e_Draw(ID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, 0, True, False);
3006 // Подсказка при выборе точки Телепорта:
3007 if SelectFlag
= SELECTFLAG_TELEPORT
then
3009 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3010 if Data
.d2d_teleport
then
3011 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
3012 MousePos
.X
+16, MousePos
.Y
-1,
3015 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+AreaSize
[AREA_DMPOINT
].Width
-1,
3016 MousePos
.Y
+AreaSize
[AREA_DMPOINT
].Height
-1, 255, 255, 255);
3018 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3019 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3020 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintTeleport
), gEditorFont
);
3023 // Подсказка при выборе точки появления:
3024 if SelectFlag
= SELECTFLAG_SPAWNPOINT
then
3026 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
3027 MousePos
.X
+16, MousePos
.Y
-1,
3029 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3030 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3031 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintSpawn
), gEditorFont
);
3034 // Подсказка при выборе панели двери:
3035 if SelectFlag
= SELECTFLAG_DOOR
then
3037 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3038 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3039 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelDoor
), gEditorFont
);
3042 // Подсказка при выборе панели с текстурой:
3043 if SelectFlag
= SELECTFLAG_TEXTURE
then
3045 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 192, 192, 192, 127);
3046 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 255, 255, 255);
3047 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelTexture
), gEditorFont
);
3050 // Подсказка при выборе панели индикации выстрела:
3051 if SelectFlag
= SELECTFLAG_SHOTPANEL
then
3053 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 192, 192, 192, 127);
3054 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 255, 255, 255);
3055 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelShot
), gEditorFont
);
3058 // Подсказка при выборе панели лифта:
3059 if SelectFlag
= SELECTFLAG_LIFT
then
3061 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3062 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3063 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelLift
), gEditorFont
);
3066 // Подсказка при выборе монстра:
3067 if SelectFlag
= SELECTFLAG_MONSTER
then
3069 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 192, 192, 192, 127);
3070 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 255, 255, 255);
3071 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintMonster
), gEditorFont
);
3074 // Подсказка при выборе области воздействия:
3075 if DrawPressRect
then
3077 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 192, 192, 192, 127);
3078 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 255, 255, 255);
3079 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintExtArea
), gEditorFont
);
3082 // Рисуем текстуры, если чертим панель:
3083 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and (DrawTexturePanel
) and
3084 (lbTextureList
.ItemIndex
<> -1) and (DrawRect
<> nil) and
3085 (lbPanelType
.ItemIndex
in [0..8]) and not IsSpecialTextureSel() then
3087 if not g_GetTexture(SelectedTexture(), ID
) then
3088 g_GetTexture('NOTEXTURE', ID
);
3089 g_GetTextureSizeByID(ID
, Width
, Height
);
3091 if (Abs(Right
-Left
) >= Width
) and (Abs(Bottom
-Top
) >= Height
) then
3092 e_DrawFill(ID
, Min(Left
, Right
), Min(Top
, Bottom
), Abs(Right
-Left
) div Width
,
3093 Abs(Bottom
-Top
) div Height
, 64, True, False);
3096 // Прямоугольник выделения:
3097 if DrawRect
<> nil then
3099 e_DrawQuad(Left
, Top
, Right
-1, Bottom
-1, 255, 255, 255);
3101 // Чертим мышью панель/триггер или меняем мышью их размер:
3102 if (((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3103 not(ssCtrl
in GetKeyShiftState())) or (MouseAction
= MOUSEACTION_RESIZE
)) and
3104 (DrawPanelSize
) then
3106 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 192, 192, 192, 127);
3107 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 255, 255, 255);
3109 if MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
] then
3110 begin // Чертим новый
3111 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
),
3112 [Abs(MousePos
.X
-MouseLDownPos
.X
)]), gEditorFont
);
3113 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
),
3114 [Abs(MousePos
.Y
-MouseLDownPos
.Y
)]), gEditorFont
);
3116 else // Растягиваем существующий
3117 if SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
3119 if SelectedObjects
[GetFirstSelected
].ObjectType
= OBJECT_PANEL
then
3121 Width
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3122 Height
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3126 Width
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3127 Height
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3130 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
), [Width
]),
3132 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
), [Height
]),
3137 // Ближайшая к курсору мыши точка на сетке:
3138 e_DrawPoint(3, MousePos
.X
, MousePos
.Y
, 0, 0, 255);
3143 // Сколько пикселов карты в 1 пикселе мини-карты:
3144 ScaleSz
:= 16 div Scale
;
3145 // Размеры мини-карты:
3146 aX
:= max(gMapInfo
.Width
div ScaleSz
, 1);
3147 aY
:= max(gMapInfo
.Height
div ScaleSz
, 1);
3148 // X-координата на RenderPanel нулевой x-координаты карты:
3149 XX
:= RenderPanel
.Width
- aX
- 1;
3151 e_DrawFillQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 0, 0, 0, 0);
3152 e_DrawQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 197, 197, 197);
3154 if gPanels
<> nil then
3157 for a
:= 0 to High(gPanels
) do
3159 if PanelType
<> 0 then
3161 // Левый верхний угол:
3162 aX
:= XX
+ (X
div ScaleSz
);
3163 aY
:= 1 + (Y
div ScaleSz
);
3165 aX2
:= max(Width
div ScaleSz
, 1);
3166 aY2
:= max(Height
div ScaleSz
, 1);
3167 // Правый нижний угол:
3168 aX2
:= aX
+ aX2
- 1;
3169 aY2
:= aY
+ aY2
- 1;
3172 PANEL_WALL
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 208, 208, 208, 0);
3173 PANEL_WATER
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 0, 192, 0);
3174 PANEL_ACID1
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 176, 0, 0);
3175 PANEL_ACID2
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 176, 0, 0, 0);
3176 PANEL_STEP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 128, 128, 128, 0);
3177 PANEL_LIFTUP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 72, 36, 0);
3178 PANEL_LIFTDOWN
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 124, 96, 0);
3179 PANEL_LIFTLEFT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 200, 80, 4, 0);
3180 PANEL_LIFTRIGHT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 252, 140, 56, 0);
3181 PANEL_OPENDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 100, 220, 92, 0);
3182 PANEL_CLOSEDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 212, 184, 64, 0);
3183 PANEL_BLOCKMON
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 192, 0, 192, 0);
3187 // Рисуем красным выделенные панели:
3188 if SelectedObjects
<> nil then
3189 for b
:= 0 to High(SelectedObjects
) do
3190 with SelectedObjects
[b
] do
3191 if Live
and (ObjectType
= OBJECT_PANEL
) then
3192 with gPanels
[SelectedObjects
[b
].ID
] do
3193 if PanelType
and not(PANEL_BACK
or PANEL_FORE
) <> 0 then
3195 // Левый верхний угол:
3196 aX
:= XX
+ (X
div ScaleSz
);
3197 aY
:= 1 + (Y
div ScaleSz
);
3199 aX2
:= max(Width
div ScaleSz
, 1);
3200 aY2
:= max(Height
div ScaleSz
, 1);
3201 // Правый нижний угол:
3202 aX2
:= aX
+ aX2
- 1;
3203 aY2
:= aY
+ aY2
- 1;
3205 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0, 0)
3209 if (gMapInfo
.Width
> RenderPanel
.Width
) or
3210 (gMapInfo
.Height
> RenderPanel
.Height
) then
3212 // Окно, показывающее текущее положение экрана на карте:
3214 x
:= max(min(RenderPanel
.Width
, gMapInfo
.Width
) div ScaleSz
, 1);
3215 y
:= max(min(RenderPanel
.Height
, gMapInfo
.Height
) div ScaleSz
, 1);
3216 // Левый верхний угол:
3217 aX
:= XX
+ ((-MapOffset
.X
) div ScaleSz
);
3218 aY
:= 1 + ((-MapOffset
.Y
) div ScaleSz
);
3219 // Правый нижний угол:
3223 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 127, 192, 127, 127, B_BLEND
);
3224 e_DrawQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0);
3229 RenderPanel
.SwapBuffers();
3232 procedure TMainForm
.FormResize(Sender
: TObject
);
3234 e_SetViewPort(0, 0, RenderPanel
.Width
, RenderPanel
.Height
);
3236 sbHorizontal
.Min
:= Min(gMapInfo
.Width
- RenderPanel
.Width
, -RenderPanel
.Width
div 2);
3237 sbHorizontal
.Max
:= Max(0, gMapInfo
.Width
- RenderPanel
.Width
div 2);
3238 sbVertical
.Min
:= Min(gMapInfo
.Height
- RenderPanel
.Height
, -RenderPanel
.Height
div 2);
3239 sbVertical
.Max
:= Max(0, gMapInfo
.Height
- RenderPanel
.Height
div 2);
3241 MapOffset
.X
:= -sbHorizontal
.Position
;
3242 MapOffset
.Y
:= -sbVertical
.Position
;
3245 procedure TMainForm
.FormWindowStateChange(Sender
: TObject
);
3251 // deactivate all menus when main window minimized
3252 e
:= self
.WindowState
<> wsMinimized
;
3253 miMenuFile
.Enabled
:= e
;
3254 miMenuEdit
.Enabled
:= e
;
3255 miMenuView
.Enabled
:= e
;
3256 miMenuService
.Enabled
:= e
;
3257 miMenuWindow
.Enabled
:= e
;
3258 miMenuHelp
.Enabled
:= e
;
3259 miMenuHidden
.Enabled
:= e
;
3263 procedure SelectNextObject(X
, Y
: Integer; ObjectType
: Byte; ID
: DWORD
);
3268 j_max
:= 0; // shut up compiler
3272 res
:= (gPanels
<> nil) and
3273 PanelInShownLayer(gPanels
[ID
].PanelType
) and
3274 g_CollidePoint(X
, Y
, gPanels
[ID
].X
, gPanels
[ID
].Y
,
3276 gPanels
[ID
].Height
);
3277 j_max
:= Length(gPanels
) - 1;
3282 res
:= (gItems
<> nil) and
3283 LayerEnabled
[LAYER_ITEMS
] and
3284 g_CollidePoint(X
, Y
, gItems
[ID
].X
, gItems
[ID
].Y
,
3285 ItemSize
[gItems
[ID
].ItemType
][0],
3286 ItemSize
[gItems
[ID
].ItemType
][1]);
3287 j_max
:= Length(gItems
) - 1;
3292 res
:= (gMonsters
<> nil) and
3293 LayerEnabled
[LAYER_MONSTERS
] and
3294 g_CollidePoint(X
, Y
, gMonsters
[ID
].X
, gMonsters
[ID
].Y
,
3295 MonsterSize
[gMonsters
[ID
].MonsterType
].Width
,
3296 MonsterSize
[gMonsters
[ID
].MonsterType
].Height
);
3297 j_max
:= Length(gMonsters
) - 1;
3302 res
:= (gAreas
<> nil) and
3303 LayerEnabled
[LAYER_AREAS
] and
3304 g_CollidePoint(X
, Y
, gAreas
[ID
].X
, gAreas
[ID
].Y
,
3305 AreaSize
[gAreas
[ID
].AreaType
].Width
,
3306 AreaSize
[gAreas
[ID
].AreaType
].Height
);
3307 j_max
:= Length(gAreas
) - 1;
3312 res
:= (gTriggers
<> nil) and
3313 LayerEnabled
[LAYER_TRIGGERS
] and
3314 g_CollidePoint(X
, Y
, gTriggers
[ID
].X
, gTriggers
[ID
].Y
,
3315 gTriggers
[ID
].Width
,
3316 gTriggers
[ID
].Height
);
3317 j_max
:= Length(gTriggers
) - 1;
3327 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3336 if j
= Integer(ID
) then
3341 res
:= PanelInShownLayer(gPanels
[j
].PanelType
) and
3342 g_CollidePoint(X
, Y
, gPanels
[j
].X
, gPanels
[j
].Y
,
3346 res
:= (gItems
[j
].ItemType
<> ITEM_NONE
) and
3347 g_CollidePoint(X
, Y
, gItems
[j
].X
, gItems
[j
].Y
,
3348 ItemSize
[gItems
[j
].ItemType
][0],
3349 ItemSize
[gItems
[j
].ItemType
][1]);
3351 res
:= (gMonsters
[j
].MonsterType
<> MONSTER_NONE
) and
3352 g_CollidePoint(X
, Y
, gMonsters
[j
].X
, gMonsters
[j
].Y
,
3353 MonsterSize
[gMonsters
[j
].MonsterType
].Width
,
3354 MonsterSize
[gMonsters
[j
].MonsterType
].Height
);
3356 res
:= (gAreas
[j
].AreaType
<> AREA_NONE
) and
3357 g_CollidePoint(X
, Y
, gAreas
[j
].X
, gAreas
[j
].Y
,
3358 AreaSize
[gAreas
[j
].AreaType
].Width
,
3359 AreaSize
[gAreas
[j
].AreaType
].Height
);
3361 res
:= (gTriggers
[j
].TriggerType
<> TRIGGER_NONE
) and
3362 g_CollidePoint(X
, Y
, gTriggers
[j
].X
, gTriggers
[j
].Y
,
3364 gTriggers
[j
].Height
);
3371 SetLength(SelectedObjects
, 1);
3373 SelectedObjects
[0].ObjectType
:= ObjectType
;
3374 SelectedObjects
[0].ID
:= j
;
3375 SelectedObjects
[0].Live
:= True;
3383 procedure TMainForm
.RenderPanelMouseDown(Sender
: TObject
;
3384 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3388 c1
, c2
, c3
, c4
: Boolean;
3394 MainForm
.ActiveControl
:= RenderPanel
;
3395 RenderPanel
.SetFocus();
3397 RenderPanelMouseMove(RenderPanel
, Shift
, X
, Y
);
3399 if Button
= mbLeft
then // Left Mouse Button
3401 // Двигаем карту с помощью мыши и мини-карты:
3403 g_CollidePoint(X
, Y
,
3404 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3406 max(gMapInfo
.Width
div (16 div Scale
), 1),
3407 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3410 MouseAction
:= MOUSEACTION_MOVEMAP
;
3412 else // Ставим предмет/монстра/область:
3413 if (pcObjects
.ActivePageIndex
in [1, 2, 3]) and
3414 (not (ssShift
in Shift
)) then
3416 case pcObjects
.ActivePageIndex
of
3418 if lbItemList
.ItemIndex
= -1 then
3419 ErrorMessageBox(MsgMsgChooseItem
)
3422 item
.ItemType
:= lbItemList
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
3423 if item
.ItemType
>= ITEM_WEAPON_IRONFIST
then
3424 item
.ItemType
:= item
.ItemType
+ 2;
3425 item
.X
:= MousePos
.X
-MapOffset
.X
;
3426 item
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3428 if not (ssCtrl
in Shift
) then
3430 item
.X
:= item
.X
- (ItemSize
[item
.ItemType
][0] div 2);
3431 item
.Y
:= item
.Y
- ItemSize
[item
.ItemType
][1];
3434 item
.OnlyDM
:= cbOnlyDM
.Checked
;
3435 item
.Fall
:= cbFall
.Checked
;
3436 Undo_Add(OBJECT_ITEM
, AddItem(item
));
3439 if lbMonsterList
.ItemIndex
= -1 then
3440 ErrorMessageBox(MsgMsgChooseMonster
)
3443 monster
.MonsterType
:= lbMonsterList
.ItemIndex
+ MONSTER_DEMON
;
3444 monster
.X
:= MousePos
.X
-MapOffset
.X
;
3445 monster
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3447 if not (ssCtrl
in Shift
) then
3449 monster
.X
:= monster
.X
- (MonsterSize
[monster
.MonsterType
].Width
div 2);
3450 monster
.Y
:= monster
.Y
- MonsterSize
[monster
.MonsterType
].Height
;
3453 if rbMonsterLeft
.Checked
then
3454 monster
.Direction
:= D_LEFT
3456 monster
.Direction
:= D_RIGHT
;
3457 Undo_Add(OBJECT_MONSTER
, AddMonster(monster
));
3460 if lbAreasList
.ItemIndex
= -1 then
3461 ErrorMessageBox(MsgMsgChooseArea
)
3463 if (lbAreasList
.ItemIndex
+ 1) <> AREA_DOMFLAG
then
3465 area
.AreaType
:= lbAreasList
.ItemIndex
+ AREA_PLAYERPOINT1
;
3466 area
.X
:= MousePos
.X
-MapOffset
.X
;
3467 area
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3469 if not (ssCtrl
in Shift
) then
3471 area
.X
:= area
.X
- (AreaSize
[area
.AreaType
].Width
div 2);
3472 area
.Y
:= area
.Y
- AreaSize
[area
.AreaType
].Height
;
3475 if rbAreaLeft
.Checked
then
3476 area
.Direction
:= D_LEFT
3478 area
.Direction
:= D_RIGHT
;
3479 Undo_Add(OBJECT_AREA
, AddArea(area
));
3485 i
:= GetFirstSelected();
3487 // Выбираем объект под текущим:
3488 if (SelectedObjects
<> nil) and
3489 (ssShift
in Shift
) and (i
>= 0) and
3490 (SelectedObjects
[i
].Live
) then
3492 if SelectedObjectCount() = 1 then
3493 SelectNextObject(X
-MapOffset
.X
, Y
-MapOffset
.Y
,
3494 SelectedObjects
[i
].ObjectType
,
3495 SelectedObjects
[i
].ID
);
3499 // Рисуем область триггера "Расширитель":
3500 if DrawPressRect
and (i
>= 0) and
3501 (SelectedObjects
[i
].ObjectType
= OBJECT_TRIGGER
) and
3502 (gTriggers
[SelectedObjects
[i
].ID
].TriggerType
in
3503 [TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
]) then
3504 MouseAction
:= MOUSEACTION_DRAWPRESS
3505 else // Рисуем панель:
3506 if pcObjects
.ActivePageIndex
= 0 then
3508 if (lbPanelType
.ItemIndex
>= 0) then
3509 MouseAction
:= MOUSEACTION_DRAWPANEL
3511 else // Рисуем триггер:
3512 if (lbTriggersList
.ItemIndex
>= 0) then
3514 MouseAction
:= MOUSEACTION_DRAWTRIGGER
;
3518 end; // if Button = mbLeft
3520 if Button
= mbRight
then // Right Mouse Button
3522 // Клик по мини-карте:
3524 g_CollidePoint(X
, Y
,
3525 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3527 max(gMapInfo
.Width
div (16 div Scale
), 1),
3528 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3530 MouseAction
:= MOUSEACTION_NOACTION
;
3532 else // Нужно что-то выбрать мышью:
3533 if SelectFlag
<> SELECTFLAG_NONE
then
3536 SELECTFLAG_TELEPORT
:
3537 // Точку назначения телепортации:
3538 with gTriggers
[SelectedObjects
[
3539 GetFirstSelected() ].ID
].Data
.TargetPoint
do
3541 X
:= MousePos
.X
-MapOffset
.X
;
3542 Y
:= MousePos
.Y
-MapOffset
.Y
;
3545 SELECTFLAG_SPAWNPOINT
:
3546 // Точку создания монстра:
3547 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3548 if TriggerType
= TRIGGER_SPAWNMONSTER
then
3550 Data
.MonPos
.X
:= MousePos
.X
-MapOffset
.X
;
3551 Data
.MonPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3553 else if TriggerType
= TRIGGER_SPAWNITEM
then
3554 begin // Точка создания предмета:
3555 Data
.ItemPos
.X
:= MousePos
.X
-MapOffset
.X
;
3556 Data
.ItemPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3558 else if TriggerType
= TRIGGER_SHOT
then
3559 begin // Точка создания выстрела:
3560 Data
.ShotPos
.X
:= MousePos
.X
-MapOffset
.X
;
3561 Data
.ShotPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3567 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3569 2, 2, OBJECT_PANEL
, True);
3570 if IDArray
<> nil then
3572 for i
:= 0 to High(IDArray
) do
3573 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3574 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
) then
3576 gTriggers
[SelectedObjects
[
3577 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3582 gTriggers
[SelectedObjects
[
3583 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3587 // Панель с текстурой:
3589 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3591 2, 2, OBJECT_PANEL
, True);
3592 if IDArray
<> nil then
3594 for i
:= 0 to High(IDArray
) do
3595 if ((gPanels
[IDArray
[i
]].PanelType
in
3596 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3597 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3599 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3600 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3601 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3603 gTriggers
[SelectedObjects
[
3604 GetFirstSelected() ].ID
].TexturePanel
:= IDArray
[i
];
3609 gTriggers
[SelectedObjects
[
3610 GetFirstSelected() ].ID
].TexturePanel
:= -1;
3616 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3618 2, 2, OBJECT_PANEL
, True);
3619 if IDArray
<> nil then
3621 for i
:= 0 to High(IDArray
) do
3622 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTUP
) or
3623 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTDOWN
) or
3624 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTLEFT
) or
3625 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTRIGHT
) then
3627 gTriggers
[SelectedObjects
[
3628 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3633 gTriggers
[SelectedObjects
[
3634 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3640 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3642 2, 2, OBJECT_MONSTER
, False);
3643 if IDArray
<> nil then
3644 gTriggers
[SelectedObjects
[
3645 GetFirstSelected() ].ID
].Data
.MonsterID
:= IDArray
[0]+1
3647 gTriggers
[SelectedObjects
[
3648 GetFirstSelected() ].ID
].Data
.MonsterID
:= 0;
3651 SELECTFLAG_SHOTPANEL
:
3652 // Панель индикации выстрела:
3654 if gTriggers
[SelectedObjects
[
3655 GetFirstSelected() ].ID
].TriggerType
= TRIGGER_SHOT
then
3657 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3659 2, 2, OBJECT_PANEL
, True);
3660 if IDArray
<> nil then
3662 for i
:= 0 to High(IDArray
) do
3663 if ((gPanels
[IDArray
[i
]].PanelType
in
3664 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3665 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3667 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3668 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3669 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3671 gTriggers
[SelectedObjects
[
3672 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= IDArray
[i
];
3677 gTriggers
[SelectedObjects
[
3678 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= -1;
3683 SelectFlag
:= SELECTFLAG_SELECTED
;
3685 else // if SelectFlag <> SELECTFLAG_NONE...
3687 // Что уже выбрано и не нажат Ctrl:
3688 if (SelectedObjects
<> nil) and
3689 (not (ssCtrl
in Shift
)) then
3690 for i
:= 0 to High(SelectedObjects
) do
3691 with SelectedObjects
[i
] do
3694 if (ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) and
3695 (SelectedObjectCount() = 1) then
3697 Rect
:= ObjectGetRect(ObjectType
, ID
);
3699 c1
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3700 Rect
.X
-2, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3701 c2
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3702 Rect
.X
+Rect
.Width
-3, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3703 c3
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3704 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
-2, 4, 4);
3705 c4
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3706 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
+Rect
.Height
-3, 4, 4);
3708 // Меняем размер панели или триггера:
3709 if c1
or c2
or c3
or c4
then
3711 MouseAction
:= MOUSEACTION_RESIZE
;
3712 LastMovePoint
:= MousePos
;
3716 ResizeType
:= RESIZETYPE_HORIZONTAL
;
3718 ResizeDirection
:= RESIZEDIR_LEFT
3720 ResizeDirection
:= RESIZEDIR_RIGHT
;
3721 RenderPanel
.Cursor
:= crSizeWE
;
3725 ResizeType
:= RESIZETYPE_VERTICAL
;
3727 ResizeDirection
:= RESIZEDIR_UP
3729 ResizeDirection
:= RESIZEDIR_DOWN
;
3730 RenderPanel
.Cursor
:= crSizeNS
;
3737 // Перемещаем панель или триггер:
3738 if ObjectCollide(ObjectType
, ID
,
3740 Y
-MapOffset
.Y
-1, 2, 2) then
3742 MouseAction
:= MOUSEACTION_MOVEOBJ
;
3743 LastMovePoint
:= MousePos
;
3749 end; // if Button = mbRight
3751 if Button
= mbMiddle
then // Middle Mouse Button
3753 SetCapture(RenderPanel
.Handle
);
3754 RenderPanel
.Cursor
:= crSize
;
3757 MouseMDown
:= Button
= mbMiddle
;
3759 MouseMDownPos
:= Mouse
.CursorPos
;
3761 MouseRDown
:= Button
= mbRight
;
3763 MouseRDownPos
:= MousePos
;
3765 MouseLDown
:= Button
= mbLeft
;
3767 MouseLDownPos
:= MousePos
;
3770 procedure TMainForm
.RenderPanelMouseUp(Sender
: TObject
;
3771 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3776 rSelectRect
: Boolean;
3777 wWidth
, wHeight
: Word;
3780 procedure SelectObjects(ObjectType
: Byte);
3785 IDArray
:= ObjectInRect(rRect
.X
, rRect
.Y
,
3786 rRect
.Width
, rRect
.Height
,
3787 ObjectType
, rSelectRect
);
3789 if IDArray
<> nil then
3790 for i
:= 0 to High(IDArray
) do
3791 SelectObject(ObjectType
, IDArray
[i
], (ssCtrl
in Shift
) or rSelectRect
);
3794 if Button
= mbLeft
then
3795 MouseLDown
:= False;
3796 if Button
= mbRight
then
3797 MouseRDown
:= False;
3798 if Button
= mbMiddle
then
3799 MouseMDown
:= False;
3801 if DrawRect
<> nil then
3807 ResizeType
:= RESIZETYPE_NONE
;
3810 if Button
= mbLeft
then // Left Mouse Button
3812 if MouseAction
<> MOUSEACTION_NONE
then
3813 begin // Было действие мышью
3814 // Мышь сдвинулась во время удержания клавиши,
3815 // либо активирован режим быстрого рисования:
3816 if ((MousePos
.X
<> MouseLDownPos
.X
) and
3817 (MousePos
.Y
<> MouseLDownPos
.Y
)) or
3818 ((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3819 (ssCtrl
in Shift
)) then
3822 MOUSEACTION_DRAWPANEL
:
3824 // Фон или передний план без текстуры - ошибка:
3825 if (lbPanelType
.ItemIndex
in [1, 2]) and
3826 (lbTextureList
.ItemIndex
= -1) then
3827 ErrorMessageBox(MsgMsgChooseTexture
)
3828 else // Назначаем параметры панели:
3830 case lbPanelType
.ItemIndex
of
3831 0: Panel
.PanelType
:= PANEL_WALL
;
3832 1: Panel
.PanelType
:= PANEL_BACK
;
3833 2: Panel
.PanelType
:= PANEL_FORE
;
3834 3: Panel
.PanelType
:= PANEL_OPENDOOR
;
3835 4: Panel
.PanelType
:= PANEL_CLOSEDOOR
;
3836 5: Panel
.PanelType
:= PANEL_STEP
;
3837 6: Panel
.PanelType
:= PANEL_WATER
;
3838 7: Panel
.PanelType
:= PANEL_ACID1
;
3839 8: Panel
.PanelType
:= PANEL_ACID2
;
3840 9: Panel
.PanelType
:= PANEL_LIFTUP
;
3841 10: Panel
.PanelType
:= PANEL_LIFTDOWN
;
3842 11: Panel
.PanelType
:= PANEL_LIFTLEFT
;
3843 12: Panel
.PanelType
:= PANEL_LIFTRIGHT
;
3844 13: Panel
.PanelType
:= PANEL_BLOCKMON
;
3847 Panel
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3848 Panel
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3849 if ssCtrl
in Shift
then
3853 if (lbTextureList
.ItemIndex
<> -1) and
3854 (not IsSpecialTextureSel()) then
3856 if not g_GetTexture(SelectedTexture(), TextureID
) then
3857 g_GetTexture('NOTEXTURE', TextureID
);
3858 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
3860 Panel
.Width
:= wWidth
;
3861 Panel
.Height
:= wHeight
;
3865 Panel
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3866 Panel
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3869 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3870 if (lbPanelType
.ItemIndex
in [9, 10, 11, 12, 13]) or
3871 (lbTextureList
.ItemIndex
= -1) then
3873 Panel
.TextureHeight
:= 1;
3874 Panel
.TextureWidth
:= 1;
3875 Panel
.TextureName
:= '';
3876 Panel
.TextureID
:= TEXTURE_SPECIAL_NONE
;
3878 else // Есть текстура:
3880 Panel
.TextureName
:= SelectedTexture();
3882 // Обычная текстура:
3883 if not IsSpecialTextureSel() then
3885 g_GetTextureSizeByName(Panel
.TextureName
,
3886 Panel
.TextureWidth
, Panel
.TextureHeight
);
3887 g_GetTexture(Panel
.TextureName
, Panel
.TextureID
);
3889 else // Спец.текстура:
3891 Panel
.TextureHeight
:= 1;
3892 Panel
.TextureWidth
:= 1;
3893 Panel
.TextureID
:= SpecialTextureID(SelectedTexture());
3898 Panel
.Blending
:= False;
3900 Undo_Add(OBJECT_PANEL
, AddPanel(Panel
));
3904 // Рисовали триггер:
3905 MOUSEACTION_DRAWTRIGGER
:
3907 trigger
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3908 trigger
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3909 if ssCtrl
in Shift
then
3913 trigger
.Width
:= wWidth
;
3914 trigger
.Height
:= wHeight
;
3918 trigger
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3919 trigger
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3922 trigger
.Enabled
:= True;
3923 trigger
.TriggerType
:= lbTriggersList
.ItemIndex
+1;
3924 trigger
.TexturePanel
:= -1;
3927 trigger
.ActivateType
:= 0;
3929 if clbActivationType
.Checked
[0] then
3930 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERCOLLIDE
;
3931 if clbActivationType
.Checked
[1] then
3932 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERCOLLIDE
;
3933 if clbActivationType
.Checked
[2] then
3934 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERPRESS
;
3935 if clbActivationType
.Checked
[3] then
3936 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERPRESS
;
3937 if clbActivationType
.Checked
[4] then
3938 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_SHOT
;
3939 if clbActivationType
.Checked
[5] then
3940 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_NOMONSTER
;
3942 // Необходимые для активации ключи:
3945 if clbKeys
.Checked
[0] then
3946 trigger
.Key
:= Trigger
.Key
or KEY_RED
;
3947 if clbKeys
.Checked
[1] then
3948 trigger
.Key
:= Trigger
.Key
or KEY_GREEN
;
3949 if clbKeys
.Checked
[2] then
3950 trigger
.Key
:= Trigger
.Key
or KEY_BLUE
;
3951 if clbKeys
.Checked
[3] then
3952 trigger
.Key
:= Trigger
.Key
or KEY_REDTEAM
;
3953 if clbKeys
.Checked
[4] then
3954 trigger
.Key
:= Trigger
.Key
or KEY_BLUETEAM
;
3956 // Параметры триггера:
3957 FillByte(trigger
.Data
.Default
[0], 128, 0);
3959 case trigger
.TriggerType
of
3960 // Переключаемая панель:
3961 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
3962 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
3963 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
3965 Trigger
.Data
.PanelID
:= -1;
3971 trigger
.Data
.TargetPoint
.X
:= trigger
.X
-64;
3972 trigger
.Data
.TargetPoint
.Y
:= trigger
.Y
-64;
3973 trigger
.Data
.d2d_teleport
:= True;
3974 trigger
.Data
.TlpDir
:= 0;
3977 // Изменение других триггеров:
3978 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
3981 trigger
.Data
.Count
:= 1;
3987 trigger
.Data
.Volume
:= 255;
3988 trigger
.Data
.Pan
:= 127;
3989 trigger
.Data
.PlayCount
:= 1;
3990 trigger
.Data
.Local
:= True;
3991 trigger
.Data
.SoundSwitch
:= False;
3997 trigger
.Data
.MusicAction
:= 1;
4000 // Создание монстра:
4001 TRIGGER_SPAWNMONSTER
:
4003 trigger
.Data
.MonType
:= MONSTER_ZOMBY
;
4004 trigger
.Data
.MonPos
.X
:= trigger
.X
-64;
4005 trigger
.Data
.MonPos
.Y
:= trigger
.Y
-64;
4006 trigger
.Data
.MonHealth
:= 0;
4007 trigger
.Data
.MonActive
:= False;
4008 trigger
.Data
.MonCount
:= 1;
4011 // Создание предмета:
4014 trigger
.Data
.ItemType
:= ITEM_AMMO_BULLETS
;
4015 trigger
.Data
.ItemPos
.X
:= trigger
.X
-64;
4016 trigger
.Data
.ItemPos
.Y
:= trigger
.Y
-64;
4017 trigger
.Data
.ItemOnlyDM
:= False;
4018 trigger
.Data
.ItemFalls
:= False;
4019 trigger
.Data
.ItemCount
:= 1;
4020 trigger
.Data
.ItemMax
:= 0;
4021 trigger
.Data
.ItemDelay
:= 0;
4027 trigger
.Data
.PushAngle
:= 90;
4028 trigger
.Data
.PushForce
:= 10;
4029 trigger
.Data
.ResetVel
:= True;
4034 trigger
.Data
.ScoreCount
:= 1;
4035 trigger
.Data
.ScoreCon
:= True;
4036 trigger
.Data
.ScoreMsg
:= True;
4041 trigger
.Data
.MessageKind
:= 0;
4042 trigger
.Data
.MessageSendTo
:= 0;
4043 trigger
.Data
.MessageText
:= '';
4044 trigger
.Data
.MessageTime
:= 144;
4049 trigger
.Data
.DamageValue
:= 5;
4050 trigger
.Data
.DamageInterval
:= 12;
4055 trigger
.Data
.HealValue
:= 5;
4056 trigger
.Data
.HealInterval
:= 36;
4061 trigger
.Data
.ShotType
:= TRIGGER_SHOT_BULLET
;
4062 trigger
.Data
.ShotSound
:= True;
4063 trigger
.Data
.ShotPanelID
:= -1;
4064 trigger
.Data
.ShotTarget
:= 0;
4065 trigger
.Data
.ShotIntSight
:= 0;
4066 trigger
.Data
.ShotAim
:= TRIGGER_SHOT_AIM_DEFAULT
;
4067 trigger
.Data
.ShotPos
.X
:= trigger
.X
-64;
4068 trigger
.Data
.ShotPos
.Y
:= trigger
.Y
-64;
4069 trigger
.Data
.ShotAngle
:= 0;
4070 trigger
.Data
.ShotWait
:= 18;
4071 trigger
.Data
.ShotAccuracy
:= 0;
4072 trigger
.Data
.ShotAmmo
:= 0;
4073 trigger
.Data
.ShotIntReload
:= 0;
4078 trigger
.Data
.FXCount
:= 1;
4079 trigger
.Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
4080 trigger
.Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
4081 trigger
.Data
.FXColorR
:= 0;
4082 trigger
.Data
.FXColorG
:= 0;
4083 trigger
.Data
.FXColorB
:= 255;
4084 trigger
.Data
.FXPos
:= TRIGGER_EFFECT_POS_CENTER
;
4085 trigger
.Data
.FXWait
:= 1;
4086 trigger
.Data
.FXVelX
:= 0;
4087 trigger
.Data
.FXVelY
:= -20;
4088 trigger
.Data
.FXSpreadL
:= 5;
4089 trigger
.Data
.FXSpreadR
:= 5;
4090 trigger
.Data
.FXSpreadU
:= 4;
4091 trigger
.Data
.FXSpreadD
:= 0;
4095 Undo_Add(OBJECT_TRIGGER
, AddTrigger(trigger
));
4098 // Рисовали область триггера "Расширитель":
4099 MOUSEACTION_DRAWPRESS
:
4100 with gTriggers
[SelectedObjects
[GetFirstSelected
].ID
] do
4102 Data
.tX
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
4103 Data
.tY
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
4104 Data
.tWidth
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
4105 Data
.tHeight
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
4107 DrawPressRect
:= False;
4111 MouseAction
:= MOUSEACTION_NONE
;
4113 end // if Button = mbLeft...
4114 else if Button
= mbRight
then // Right Mouse Button:
4116 if MouseAction
= MOUSEACTION_NOACTION
then
4118 MouseAction
:= MOUSEACTION_NONE
;
4122 // Объект передвинут или изменен в размере:
4123 if MouseAction
in [MOUSEACTION_MOVEOBJ
, MOUSEACTION_RESIZE
] then
4125 RenderPanel
.Cursor
:= crDefault
;
4126 MouseAction
:= MOUSEACTION_NONE
;
4131 // Еще не все выбрали:
4132 if SelectFlag
<> SELECTFLAG_NONE
then
4134 if SelectFlag
= SELECTFLAG_SELECTED
then
4135 SelectFlag
:= SELECTFLAG_NONE
;
4140 // Мышь сдвинулась во время удержания клавиши:
4141 if (MousePos
.X
<> MouseRDownPos
.X
) and
4142 (MousePos
.Y
<> MouseRDownPos
.Y
) then
4144 rSelectRect
:= True;
4146 rRect
.X
:= Min(MousePos
.X
, MouseRDownPos
.X
)-MapOffset
.X
;
4147 rRect
.Y
:= Min(MousePos
.Y
, MouseRDownPos
.Y
)-MapOffset
.Y
;
4148 rRect
.Width
:= Abs(MousePos
.X
-MouseRDownPos
.X
);
4149 rRect
.Height
:= Abs(MousePos
.Y
-MouseRDownPos
.Y
);
4151 else // Мышь не сдвинулась - нет прямоугольника:
4153 rSelectRect
:= False;
4155 rRect
.X
:= X
-MapOffset
.X
-1;
4156 rRect
.Y
:= Y
-MapOffset
.Y
-1;
4161 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4162 if not (ssCtrl
in Shift
) then
4163 RemoveSelectFromObjects();
4165 // Выделяем всё в выбранном прямоугольнике:
4166 if (ssCtrl
in Shift
) and (ssAlt
in Shift
) then
4168 SelectObjects(OBJECT_PANEL
);
4169 SelectObjects(OBJECT_ITEM
);
4170 SelectObjects(OBJECT_MONSTER
);
4171 SelectObjects(OBJECT_AREA
);
4172 SelectObjects(OBJECT_TRIGGER
);
4175 SelectObjects(pcObjects
.ActivePageIndex
+1);
4180 else // Middle Mouse Button
4182 RenderPanel
.Cursor
:= crDefault
;
4187 procedure TMainForm
.RenderPanelPaint(Sender
: TObject
);
4192 function TMainForm
.RenderMousePos(): Types
.TPoint
;
4194 Result
:= RenderPanel
.ScreenToClient(Mouse
.CursorPos
);
4197 procedure TMainForm
.RecountSelectedObjects();
4199 if SelectedObjectCount() = 0 then
4200 StatusBar
.Panels
[0].Text := ''
4202 StatusBar
.Panels
[0].Text := Format(MsgCapStatSelected
, [SelectedObjectCount()]);
4205 procedure TMainForm
.RenderPanelMouseMove(Sender
: TObject
;
4206 Shift
: TShiftState
; X
, Y
: Integer);
4209 dWidth
, dHeight
: Integer;
4212 wWidth
, wHeight
: Word;
4214 _id
:= GetFirstSelected();
4217 // Рисуем панель с текстурой, сетка - размеры текстуры:
4218 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and
4219 (lbPanelType
.ItemIndex
in [0..8]) and
4220 (lbTextureList
.ItemIndex
<> -1) and
4221 (not IsSpecialTextureSel()) then
4223 sX
:= StrToIntDef(lTextureWidth
.Caption
, DotStep
);
4224 sY
:= StrToIntDef(lTextureHeight
.Caption
, DotStep
);
4227 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4228 if (MouseAction
= MOUSEACTION_RESIZE
) and
4229 ( (SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
) and
4230 IsTexturedPanel(gPanels
[SelectedObjects
[_id
].ID
].PanelType
) and
4231 (gPanels
[SelectedObjects
[_id
].ID
].TextureName
<> '') and
4232 (not IsSpecialTexture(gPanels
[SelectedObjects
[_id
].ID
].TextureName
)) ) then
4234 sX
:= gPanels
[SelectedObjects
[_id
].ID
].TextureWidth
;
4235 sY
:= gPanels
[SelectedObjects
[_id
].ID
].TextureHeight
;
4238 // Выравнивание по сетке:
4244 else // Нет выравнивания по сетке:
4250 // Новая позиция мыши:
4252 begin // Зажата левая кнопка мыши
4253 MousePos
.X
:= (Round((X
-MouseLDownPos
.X
)/sX
)*sX
)+MouseLDownPos
.X
;
4254 MousePos
.Y
:= (Round((Y
-MouseLDownPos
.Y
)/sY
)*sY
)+MouseLDownPos
.Y
;
4258 begin // Зажата правая кнопка мыши
4259 MousePos
.X
:= (Round((X
-MouseRDownPos
.X
)/sX
)*sX
)+MouseRDownPos
.X
;
4260 MousePos
.Y
:= (Round((Y
-MouseRDownPos
.Y
)/sY
)*sY
)+MouseRDownPos
.Y
;
4263 begin // Кнопки мыши не зажаты
4264 MousePos
.X
:= Round((-MapOffset
.X
+ X
) / sX
) * sX
+ MapOffset
.X
;
4265 MousePos
.Y
:= Round((-MapOffset
.Y
+ Y
) / sY
) * sY
+ MapOffset
.Y
;
4268 // Зажата только правая кнопка мыши:
4269 if (not MouseLDown
) and (MouseRDown
) and (not MouseMDown
) then
4271 // Рисуем прямоугольник выделения:
4272 if MouseAction
= MOUSEACTION_NONE
then
4274 if DrawRect
= nil then
4276 DrawRect
.Top
:= MouseRDownPos
.y
;
4277 DrawRect
.Left
:= MouseRDownPos
.x
;
4278 DrawRect
.Bottom
:= MousePos
.y
;
4279 DrawRect
.Right
:= MousePos
.x
;
4282 // Двигаем выделенные объекты:
4283 if MouseAction
= MOUSEACTION_MOVEOBJ
then
4285 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
,
4286 MousePos
.X
-LastMovePoint
.X
,
4287 MousePos
.Y
-LastMovePoint
.Y
);
4290 // Меняем размер выделенного объекта:
4291 if MouseAction
= MOUSEACTION_RESIZE
then
4293 if (SelectedObjectCount
= 1) and
4294 (SelectedObjects
[GetFirstSelected
].Live
) then
4296 dWidth
:= MousePos
.X
-LastMovePoint
.X
;
4297 dHeight
:= MousePos
.Y
-LastMovePoint
.Y
;
4300 RESIZETYPE_VERTICAL
: dWidth
:= 0;
4301 RESIZETYPE_HORIZONTAL
: dHeight
:= 0;
4304 case ResizeDirection
of
4305 RESIZEDIR_UP
: dHeight
:= -dHeight
;
4306 RESIZEDIR_LEFT
: dWidth
:= -dWidth
;
4309 if ResizeObject(SelectedObjects
[GetFirstSelected
].ObjectType
,
4310 SelectedObjects
[GetFirstSelected
].ID
,
4311 dWidth
, dHeight
, ResizeDirection
) then
4312 LastMovePoint
:= MousePos
;
4317 // Зажата только левая кнопка мыши:
4318 if (not MouseRDown
) and (MouseLDown
) and (not MouseMDown
) then
4320 // Рисуем прямоугольник планирования панели:
4321 if MouseAction
in [MOUSEACTION_DRAWPANEL
,
4322 MOUSEACTION_DRAWTRIGGER
,
4323 MOUSEACTION_DRAWPRESS
] then
4325 if DrawRect
= nil then
4327 if ssCtrl
in Shift
then
4331 if (lbTextureList
.ItemIndex
<> -1) and (not IsSpecialTextureSel()) and
4332 (MouseAction
= MOUSEACTION_DRAWPANEL
) then
4334 if not g_GetTexture(SelectedTexture(), TextureID
) then
4335 g_GetTexture('NOTEXTURE', TextureID
);
4336 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
4338 DrawRect
.Top
:= MouseLDownPos
.y
;
4339 DrawRect
.Left
:= MouseLDownPos
.x
;
4340 DrawRect
.Bottom
:= DrawRect
.Top
+ wHeight
;
4341 DrawRect
.Right
:= DrawRect
.Left
+ wWidth
;
4345 DrawRect
.Top
:= MouseLDownPos
.y
;
4346 DrawRect
.Left
:= MouseLDownPos
.x
;
4347 DrawRect
.Bottom
:= MousePos
.y
;
4348 DrawRect
.Right
:= MousePos
.x
;
4351 else // Двигаем карту:
4352 if MouseAction
= MOUSEACTION_MOVEMAP
then
4358 // Only Middle Mouse Button is pressed
4359 if (not MouseLDown
) and (not MouseRDown
) and (MouseMDown
) then
4361 MapOffset
.X
:= -EnsureRange(-MapOffset
.X
+ MouseMDownPos
.X
- Mouse
.CursorPos
.X
,
4362 sbHorizontal
.Min
, sbHorizontal
.Max
);
4363 sbHorizontal
.Position
:= -MapOffset
.X
;
4364 MapOffset
.Y
:= -EnsureRange(-MapOffset
.Y
+ MouseMDownPos
.Y
- Mouse
.CursorPos
.Y
,
4365 sbVertical
.Min
, sbVertical
.Max
);
4366 sbVertical
.Position
:= -MapOffset
.Y
;
4367 MouseMDownPos
:= Mouse
.CursorPos
;
4370 // Клавиши мыши не зажаты:
4371 if (not MouseRDown
) and (not MouseLDown
) and (DrawRect
<> nil) then
4377 // Строка состояния - координаты мыши:
4378 StatusBar
.Panels
[1].Text := Format('(%d:%d)',
4379 [MousePos
.X
-MapOffset
.X
, MousePos
.Y
-MapOffset
.Y
]);
4381 RenderPanel
.Invalidate
;
4384 procedure TMainForm
.FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
4386 CanClose
:= Application
.MessageBox(PChar(MsgMsgExitPrompt
),
4388 MB_ICONQUESTION
or MB_YESNO
or
4389 MB_DEFBUTTON1
) = idYes
;
4392 procedure TMainForm
.aExitExecute(Sender
: TObject
);
4397 procedure TMainForm
.FormDestroy(Sender
: TObject
);
4403 config
:= TConfig
.CreateFile(CfgFileName
);
4405 config
.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel
);
4407 if WindowState
<> wsMaximized
then
4409 config
.WriteInt('Editor', 'XPos', Left
);
4410 config
.WriteInt('Editor', 'YPos', Top
);
4411 config
.WriteInt('Editor', 'Width', Width
);
4412 config
.WriteInt('Editor', 'Height', Height
);
4416 config
.WriteInt('Editor', 'XPos', RestoredLeft
);
4417 config
.WriteInt('Editor', 'YPos', RestoredTop
);
4418 config
.WriteInt('Editor', 'Width', RestoredWidth
);
4419 config
.WriteInt('Editor', 'Height', RestoredHeight
);
4421 config
.WriteBool('Editor', 'Maximize', WindowState
= wsMaximized
);
4422 config
.WriteBool('Editor', 'Minimap', ShowMap
);
4423 config
.WriteInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
4424 config
.WriteInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
4425 config
.WriteBool('Editor', 'DotEnable', DotEnable
);
4426 config
.WriteInt('Editor', 'DotStep', DotStep
);
4427 config
.WriteStr('Editor', 'LastOpenDir', OpenDialog
.InitialDir
);
4428 config
.WriteStr('Editor', 'LastSaveDir', SaveDialog
.InitialDir
);
4429 config
.WriteStr('Editor', 'Language', gLanguage
);
4430 config
.WriteBool('Editor', 'EdgeShow', drEdge
[3] < 255);
4431 config
.WriteInt('Editor', 'EdgeColor', gColorEdge
);
4432 config
.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge
);
4433 config
.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine
);
4434 config
.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea
);
4435 config
.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect
);
4436 config
.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect
);
4438 for i
:= 0 to RecentCount
- 1 do
4440 if i
< RecentFiles
.Count
then s
:= RecentFiles
[i
] else s
:= '';
4442 config
.WriteStr('RecentFilesWin', IntToStr(i
), s
);
4444 config
.WriteStr('RecentFilesUnix', IntToStr(i
), s
);
4449 config
.SaveFile(CfgFileName
);
4452 slInvalidTextures
.Free();
4453 DiscardUndoBuffer();
4456 procedure TMainForm
.FormDropFiles(Sender
: TObject
;
4457 const FileNames
: array of String);
4459 if Length(FileNames
) <> 1 then
4462 OpenMapFile(FileNames
[0]);
4465 procedure TMainForm
.RenderPanelResize(Sender
: TObject
);
4467 if MainForm
.Visible
then
4471 procedure TMainForm
.Splitter1Moved(Sender
: TObject
);
4476 procedure TMainForm
.MapTestCheck(Sender
: TObject
);
4478 if MapTestProcess
<> nil then
4480 if MapTestProcess
.Running
= false then
4482 if MapTestProcess
.ExitCode
<> 0 then
4483 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
4484 SysUtils
.DeleteFile(MapTestFile
);
4486 FreeAndNil(MapTestProcess
);
4487 tbTestMap
.Enabled
:= True;
4492 procedure TMainForm
.aMapOptionsExecute(Sender
: TObject
);
4496 MapOptionsForm
.ShowModal();
4498 ResName
:= OpenedMap
;
4499 while (Pos(':\', ResName
) > 0) do
4500 Delete(ResName
, 1, Pos(':\', ResName
) + 1);
4502 UpdateCaption(gMapInfo
.Name
, ExtractFileName(OpenedWAD
), ResName
);
4505 procedure TMainForm
.aAboutExecute(Sender
: TObject
);
4507 AboutForm
.ShowModal();
4510 procedure TMainForm
.FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
4516 if (not EditingProperties
) then
4518 if ssCtrl
in Shift
then
4521 '1': ContourEnabled
[LAYER_BACK
] := not ContourEnabled
[LAYER_BACK
];
4522 '2': ContourEnabled
[LAYER_WALLS
] := not ContourEnabled
[LAYER_WALLS
];
4523 '3': ContourEnabled
[LAYER_FOREGROUND
] := not ContourEnabled
[LAYER_FOREGROUND
];
4524 '4': ContourEnabled
[LAYER_STEPS
] := not ContourEnabled
[LAYER_STEPS
];
4525 '5': ContourEnabled
[LAYER_WATER
] := not ContourEnabled
[LAYER_WATER
];
4526 '6': ContourEnabled
[LAYER_ITEMS
] := not ContourEnabled
[LAYER_ITEMS
];
4527 '7': ContourEnabled
[LAYER_MONSTERS
] := not ContourEnabled
[LAYER_MONSTERS
];
4528 '8': ContourEnabled
[LAYER_AREAS
] := not ContourEnabled
[LAYER_AREAS
];
4529 '9': ContourEnabled
[LAYER_TRIGGERS
] := not ContourEnabled
[LAYER_TRIGGERS
];
4533 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4534 if ContourEnabled
[i
] then
4536 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4537 ContourEnabled
[i
] := not ok
4544 '1': SwitchLayer(LAYER_BACK
);
4545 '2': SwitchLayer(LAYER_WALLS
);
4546 '3': SwitchLayer(LAYER_FOREGROUND
);
4547 '4': SwitchLayer(LAYER_STEPS
);
4548 '5': SwitchLayer(LAYER_WATER
);
4549 '6': SwitchLayer(LAYER_ITEMS
);
4550 '7': SwitchLayer(LAYER_MONSTERS
);
4551 '8': SwitchLayer(LAYER_AREAS
);
4552 '9': SwitchLayer(LAYER_TRIGGERS
);
4553 '0': tbShowClick(tbShow
);
4557 if Key
= Ord('I') then
4558 begin // Поворот монстров и областей:
4559 if (SelectedObjects
<> nil) then
4561 for i
:= 0 to High(SelectedObjects
) do
4562 if (SelectedObjects
[i
].Live
) then
4564 if (SelectedObjects
[i
].ObjectType
= OBJECT_MONSTER
) then
4566 g_ChangeDir(gMonsters
[SelectedObjects
[i
].ID
].Direction
);
4569 if (SelectedObjects
[i
].ObjectType
= OBJECT_AREA
) then
4571 g_ChangeDir(gAreas
[SelectedObjects
[i
].ID
].Direction
);
4577 if pcObjects
.ActivePage
= tsMonsters
then
4579 if rbMonsterLeft
.Checked
then
4580 rbMonsterRight
.Checked
:= True
4582 rbMonsterLeft
.Checked
:= True;
4584 if pcObjects
.ActivePage
= tsAreas
then
4586 if rbAreaLeft
.Checked
then
4587 rbAreaRight
.Checked
:= True
4589 rbAreaLeft
.Checked
:= True;
4594 if not (ssCtrl
in Shift
) then
4596 // Быстрое превью карты:
4597 if Key
= Ord('E') then
4599 if PreviewMode
= 0 then
4603 // Вертикальный скролл карты:
4606 if Key
= Ord('W') then
4609 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4610 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4611 MapOffset
.Y
:= -Position
;
4614 if (MouseLDown
or MouseRDown
) then
4616 if DrawRect
<> nil then
4618 Inc(MouseLDownPos
.y
, dy
);
4619 Inc(MouseRDownPos
.y
, dy
);
4621 Inc(LastMovePoint
.Y
, dy
);
4622 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4626 if Key
= Ord('S') then
4629 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4630 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4631 MapOffset
.Y
:= -Position
;
4634 if (MouseLDown
or MouseRDown
) then
4636 if DrawRect
<> nil then
4638 Inc(MouseLDownPos
.y
, dy
);
4639 Inc(MouseRDownPos
.y
, dy
);
4641 Inc(LastMovePoint
.Y
, dy
);
4642 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4647 // Горизонтальный скролл карты:
4648 with sbHorizontal
do
4650 if Key
= Ord('A') then
4653 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4654 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4655 MapOffset
.X
:= -Position
;
4658 if (MouseLDown
or MouseRDown
) then
4660 if DrawRect
<> nil then
4662 Inc(MouseLDownPos
.x
, dx
);
4663 Inc(MouseRDownPos
.x
, dx
);
4665 Inc(LastMovePoint
.X
, dx
);
4666 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4670 if Key
= Ord('D') then
4673 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4674 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4675 MapOffset
.X
:= -Position
;
4678 if (MouseLDown
or MouseRDown
) then
4680 if DrawRect
<> nil then
4682 Inc(MouseLDownPos
.x
, dx
);
4683 Inc(MouseRDownPos
.x
, dx
);
4685 Inc(LastMovePoint
.X
, dx
);
4686 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4691 else // ssCtrl in Shift
4693 if ssShift
in Shift
then
4695 // Вставка по абсолютному смещению:
4696 if Key
= Ord('V') then
4697 aPasteObjectExecute(Sender
);
4699 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4703 // Удалить выделенные объекты:
4704 if (Key
= VK_DELETE
) and (SelectedObjects
<> nil) and RenderPanel
.Focused() then
4705 DeleteSelectedObjects();
4708 if (Key
= VK_ESCAPE
) and (SelectedObjects
<> nil) then
4709 RemoveSelectFromObjects();
4711 // Передвинуть объекты:
4712 if MainForm
.ActiveControl
= RenderPanel
then
4717 if Key
= VK_NUMPAD4
then
4718 dx
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4719 if Key
= VK_NUMPAD6
then
4720 dx
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4721 if Key
= VK_NUMPAD8
then
4722 dy
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4723 if Key
= VK_NUMPAD5
then
4724 dy
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4726 if (dx
<> 0) or (dy
<> 0) then
4728 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
, dx
, dy
);
4733 if ssCtrl
in Shift
then
4735 // Выбор панели с текстурой для триггера
4736 if Key
= Ord('T') then
4738 DrawPressRect
:= False;
4739 if SelectFlag
= SELECTFLAG_TEXTURE
then
4741 SelectFlag
:= SELECTFLAG_NONE
;
4744 vleObjectProperty
.FindRow(MsgPropTrTexturePanel
, i
);
4746 SelectFlag
:= SELECTFLAG_TEXTURE
;
4749 if Key
= Ord('D') then
4751 SelectFlag
:= SELECTFLAG_NONE
;
4752 if DrawPressRect
then
4754 DrawPressRect
:= False;
4759 // Выбор области воздействия, в зависимости от типа триггера
4760 vleObjectProperty
.FindRow(MsgPropTrExArea
, i
);
4763 DrawPressRect
:= True;
4766 vleObjectProperty
.FindRow(MsgPropTrDoorPanel
, i
);
4768 vleObjectProperty
.FindRow(MsgPropTrTrapPanel
, i
);
4771 SelectFlag
:= SELECTFLAG_DOOR
;
4774 vleObjectProperty
.FindRow(MsgPropTrLiftPanel
, i
);
4777 SelectFlag
:= SELECTFLAG_LIFT
;
4780 vleObjectProperty
.FindRow(MsgPropTrTeleportTo
, i
);
4783 SelectFlag
:= SELECTFLAG_TELEPORT
;
4786 vleObjectProperty
.FindRow(MsgPropTrSpawnTo
, i
);
4789 SelectFlag
:= SELECTFLAG_SPAWNPOINT
;
4793 // Выбор основного параметра, в зависимости от типа триггера
4794 vleObjectProperty
.FindRow(MsgPropTrNextMap
, i
);
4797 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
4798 SelectMapForm
.Caption
:= MsgCapSelect
;
4799 SelectMapForm
.GetMaps(FileName
);
4801 if SelectMapForm
.ShowModal() = mrOK
then
4803 vleObjectProperty
.Cells
[1, i
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
4804 bApplyProperty
.Click();
4808 vleObjectProperty
.FindRow(MsgPropTrSoundName
, i
);
4810 vleObjectProperty
.FindRow(MsgPropTrMusicName
, i
);
4813 AddSoundForm
.OKFunction
:= nil;
4814 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
4815 AddSoundForm
.SetResource
:= vleObjectProperty
.Cells
[1, i
];
4817 if (AddSoundForm
.ShowModal() = mrOk
) then
4819 vleObjectProperty
.Cells
[1, i
] := AddSoundForm
.ResourceName
;
4820 bApplyProperty
.Click();
4824 vleObjectProperty
.FindRow(MsgPropTrPushAngle
, i
);
4826 vleObjectProperty
.FindRow(MsgPropTrMessageText
, i
);
4829 vleObjectProperty
.Row
:= i
;
4830 vleObjectProperty
.SetFocus();
4837 procedure TMainForm
.aOptimizeExecute(Sender
: TObject
);
4839 RemoveSelectFromObjects();
4840 MapOptimizationForm
.ShowModal();
4843 procedure TMainForm
.aCheckMapExecute(Sender
: TObject
);
4845 MapCheckForm
.ShowModal();
4848 procedure TMainForm
.bbAddTextureClick(Sender
: TObject
);
4850 AddTextureForm
.lbResourcesList
.MultiSelect
:= True;
4851 AddTextureForm
.ShowModal();
4854 procedure TMainForm
.lbTextureListClick(Sender
: TObject
);
4857 TextureWidth
, TextureHeight
: Word;
4862 if (lbTextureList
.ItemIndex
<> -1) and
4863 (not IsSpecialTextureSel()) then
4865 if g_GetTexture(SelectedTexture(), TextureID
) then
4867 g_GetTextureSizeByID(TextureID
, TextureWidth
, TextureHeight
);
4869 lTextureWidth
.Caption
:= IntToStr(TextureWidth
);
4870 lTextureHeight
.Caption
:= IntToStr(TextureHeight
);
4873 lTextureWidth
.Caption
:= MsgNotAccessible
;
4874 lTextureHeight
.Caption
:= MsgNotAccessible
;
4879 lTextureWidth
.Caption
:= '';
4880 lTextureHeight
.Caption
:= '';
4884 procedure TMainForm
.lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
4885 ARect
: TRect
; State
: TOwnerDrawState
);
4887 with Control
as TListBox
do
4889 if LCLType
.odSelected
in State
then
4891 Canvas
.Brush
.Color
:= clHighlight
;
4892 Canvas
.Font
.Color
:= clHighlightText
;
4894 if (Items
<> nil) and (Index
>= 0) then
4895 if slInvalidTextures
.IndexOf(Items
[Index
]) > -1 then
4897 Canvas
.Brush
.Color
:= clRed
;
4898 Canvas
.Font
.Color
:= clWhite
;
4900 Canvas
.FillRect(ARect
);
4901 Canvas
.TextRect(ARect
, ARect
.Left
, ARect
.Top
, Items
[Index
]);
4905 procedure TMainForm
.miMacMinimizeClick(Sender
: TObject
);
4907 self
.WindowState
:= wsMinimized
;
4908 self
.FormWindowStateChange(Sender
);
4911 procedure TMainForm
.miMacZoomClick(Sender
: TObject
);
4913 if self
.WindowState
= wsMaximized
then
4914 self
.WindowState
:= wsNormal
4916 self
.WindowState
:= wsMaximized
;
4917 self
.FormWindowStateChange(Sender
);
4920 procedure TMainForm
.miReopenMapClick(Sender
: TObject
);
4922 FileName
, Resource
: String;
4924 if OpenedMap
= '' then
4927 if Application
.MessageBox(PChar(MsgMsgReopenMapPrompt
),
4928 PChar(MsgMenuFileReopen
), MB_ICONQUESTION
or MB_YESNO
) <> idYes
then
4931 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, @Resource
);
4932 OpenMap(FileName
, Resource
);
4935 procedure TMainForm
.vleObjectPropertyGetPickList(Sender
: TObject
;
4936 const KeyName
: String; Values
: TStrings
);
4938 if vleObjectProperty
.ItemProps
[KeyName
].EditStyle
= esPickList
then
4940 if KeyName
= MsgPropDirection
then
4942 Values
.Add(DirNames
[D_LEFT
]);
4943 Values
.Add(DirNames
[D_RIGHT
]);
4945 else if KeyName
= MsgPropTrTeleportDir
then
4947 Values
.Add(DirNamesAdv
[0]);
4948 Values
.Add(DirNamesAdv
[1]);
4949 Values
.Add(DirNamesAdv
[2]);
4950 Values
.Add(DirNamesAdv
[3]);
4952 else if KeyName
= MsgPropTrMusicAct
then
4954 Values
.Add(MsgPropTrMusicOn
);
4955 Values
.Add(MsgPropTrMusicOff
);
4957 else if KeyName
= MsgPropTrMonsterBehaviour
then
4959 Values
.Add(MsgPropTrMonsterBehaviour0
);
4960 Values
.Add(MsgPropTrMonsterBehaviour1
);
4961 Values
.Add(MsgPropTrMonsterBehaviour2
);
4962 Values
.Add(MsgPropTrMonsterBehaviour3
);
4963 Values
.Add(MsgPropTrMonsterBehaviour4
);
4964 Values
.Add(MsgPropTrMonsterBehaviour5
);
4966 else if KeyName
= MsgPropTrScoreAct
then
4968 Values
.Add(MsgPropTrScoreAct0
);
4969 Values
.Add(MsgPropTrScoreAct1
);
4970 Values
.Add(MsgPropTrScoreAct2
);
4971 Values
.Add(MsgPropTrScoreAct3
);
4973 else if KeyName
= MsgPropTrScoreTeam
then
4975 Values
.Add(MsgPropTrScoreTeam0
);
4976 Values
.Add(MsgPropTrScoreTeam1
);
4977 Values
.Add(MsgPropTrScoreTeam2
);
4978 Values
.Add(MsgPropTrScoreTeam3
);
4980 else if KeyName
= MsgPropTrMessageKind
then
4982 Values
.Add(MsgPropTrMessageKind0
);
4983 Values
.Add(MsgPropTrMessageKind1
);
4985 else if KeyName
= MsgPropTrMessageTo
then
4987 Values
.Add(MsgPropTrMessageTo0
);
4988 Values
.Add(MsgPropTrMessageTo1
);
4989 Values
.Add(MsgPropTrMessageTo2
);
4990 Values
.Add(MsgPropTrMessageTo3
);
4991 Values
.Add(MsgPropTrMessageTo4
);
4992 Values
.Add(MsgPropTrMessageTo5
);
4994 else if KeyName
= MsgPropTrShotTo
then
4996 Values
.Add(MsgPropTrShotTo0
);
4997 Values
.Add(MsgPropTrShotTo1
);
4998 Values
.Add(MsgPropTrShotTo2
);
4999 Values
.Add(MsgPropTrShotTo3
);
5000 Values
.Add(MsgPropTrShotTo4
);
5001 Values
.Add(MsgPropTrShotTo5
);
5002 Values
.Add(MsgPropTrShotTo6
);
5004 else if KeyName
= MsgPropTrShotAim
then
5006 Values
.Add(MsgPropTrShotAim0
);
5007 Values
.Add(MsgPropTrShotAim1
);
5008 Values
.Add(MsgPropTrShotAim2
);
5009 Values
.Add(MsgPropTrShotAim3
);
5011 else if KeyName
= MsgPropTrDamageKind
then
5013 Values
.Add(MsgPropTrDamageKind0
);
5014 Values
.Add(MsgPropTrDamageKind3
);
5015 Values
.Add(MsgPropTrDamageKind4
);
5016 Values
.Add(MsgPropTrDamageKind5
);
5017 Values
.Add(MsgPropTrDamageKind6
);
5018 Values
.Add(MsgPropTrDamageKind7
);
5019 Values
.Add(MsgPropTrDamageKind8
);
5021 else if (KeyName
= MsgPropPanelBlend
) or
5022 (KeyName
= MsgPropDmOnly
) or
5023 (KeyName
= MsgPropItemFalls
) or
5024 (KeyName
= MsgPropTrEnabled
) or
5025 (KeyName
= MsgPropTrD2d
) or
5026 (KeyName
= MsgPropTrSilent
) or
5027 (KeyName
= MsgPropTrTeleportSilent
) or
5028 (KeyName
= MsgPropTrExRandom
) or
5029 (KeyName
= MsgPropTrTextureOnce
) or
5030 (KeyName
= MsgPropTrTextureAnimOnce
) or
5031 (KeyName
= MsgPropTrSoundLocal
) or
5032 (KeyName
= MsgPropTrSoundSwitch
) or
5033 (KeyName
= MsgPropTrMonsterActive
) or
5034 (KeyName
= MsgPropTrPushReset
) or
5035 (KeyName
= MsgPropTrScoreCon
) or
5036 (KeyName
= MsgPropTrScoreMsg
) or
5037 (KeyName
= MsgPropTrHealthMax
) or
5038 (KeyName
= MsgPropTrShotSound
) or
5039 (KeyName
= MsgPropTrEffectCenter
) then
5041 Values
.Add(BoolNames
[True]);
5042 Values
.Add(BoolNames
[False]);
5047 procedure TMainForm
.bApplyPropertyClick(Sender
: TObject
);
5049 _id
, a
, r
, c
: Integer;
5059 if SelectedObjectCount() <> 1 then
5061 if not SelectedObjects
[GetFirstSelected()].Live
then
5065 if not CheckProperty() then
5071 _id
:= GetFirstSelected();
5073 r
:= vleObjectProperty
.Row
;
5074 c
:= vleObjectProperty
.Col
;
5076 case SelectedObjects
[_id
].ObjectType
of
5079 with gPanels
[SelectedObjects
[_id
].ID
] do
5081 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5082 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5083 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5084 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5086 PanelType
:= GetPanelType(vleObjectProperty
.Values
[MsgPropPanelType
]);
5088 // Сброс ссылки на триггеры смены текстуры:
5089 if not WordBool(PanelType
and (PANEL_WALL
or PANEL_FORE
or PANEL_BACK
)) then
5090 if gTriggers
<> nil then
5091 for a
:= 0 to High(gTriggers
) do
5093 if (gTriggers
[a
].TriggerType
<> 0) and
5094 (gTriggers
[a
].TexturePanel
= Integer(SelectedObjects
[_id
].ID
)) then
5095 gTriggers
[a
].TexturePanel
:= -1;
5096 if (gTriggers
[a
].TriggerType
= TRIGGER_SHOT
) and
5097 (gTriggers
[a
].Data
.ShotPanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5098 gTriggers
[a
].Data
.ShotPanelID
:= -1;
5101 // Сброс ссылки на триггеры лифта:
5102 if not WordBool(PanelType
and (PANEL_LIFTUP
or PANEL_LIFTDOWN
or PANEL_LIFTLEFT
or PANEL_LIFTRIGHT
)) then
5103 if gTriggers
<> nil then
5104 for a
:= 0 to High(gTriggers
) do
5105 if (gTriggers
[a
].TriggerType
in [TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
]) and
5106 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5107 gTriggers
[a
].Data
.PanelID
:= -1;
5109 // Сброс ссылки на триггеры двери:
5110 if not WordBool(PanelType
and (PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
5111 if gTriggers
<> nil then
5112 for a
:= 0 to High(gTriggers
) do
5113 if (gTriggers
[a
].TriggerType
in [TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5114 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
]) and
5115 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5116 gTriggers
[a
].Data
.PanelID
:= -1;
5118 if IsTexturedPanel(PanelType
) then
5119 begin // Может быть текстура
5120 if TextureName
<> '' then
5121 begin // Была текстура
5122 Alpha
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropPanelAlpha
]));
5123 Blending
:= NameToBool(vleObjectProperty
.Values
[MsgPropPanelBlend
]);
5132 TextureName
:= vleObjectProperty
.Values
[MsgPropPanelTex
];
5134 if TextureName
<> '' then
5135 begin // Есть текстура
5136 // Обычная текстура:
5137 if not IsSpecialTexture(TextureName
) then
5139 g_GetTextureSizeByName(TextureName
,
5140 TextureWidth
, TextureHeight
);
5142 // Проверка кратности размеров панели:
5144 if TextureWidth
<> 0 then
5145 if gPanels
[SelectedObjects
[_id
].ID
].Width
mod TextureWidth
<> 0 then
5147 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
5151 if Res
and (TextureHeight
<> 0) then
5152 if gPanels
[SelectedObjects
[_id
].ID
].Height
mod TextureHeight
<> 0 then
5154 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
5161 if not g_GetTexture(TextureName
, TextureID
) then
5162 // Не удалось загрузить текстуру, рисуем NOTEXTURE
5163 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5165 TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5166 g_GetTextureSizeByID(NoTextureID
, NW
, NH
);
5168 TextureHeight
:= NH
;
5171 TextureID
:= TEXTURE_SPECIAL_NONE
;
5181 TextureID
:= TEXTURE_SPECIAL_NONE
;
5184 else // Спец.текстура
5188 TextureID
:= SpecialTextureID(TextureName
);
5191 else // Нет текстуры
5195 TextureID
:= TEXTURE_SPECIAL_NONE
;
5198 else // Не может быть текстуры
5205 TextureID
:= TEXTURE_SPECIAL_NONE
;
5212 with gItems
[SelectedObjects
[_id
].ID
] do
5214 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5215 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5216 OnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5217 Fall
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5223 with gMonsters
[SelectedObjects
[_id
].ID
] do
5225 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5226 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5227 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5233 with gAreas
[SelectedObjects
[_id
].ID
] do
5235 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5236 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5237 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5243 with gTriggers
[SelectedObjects
[_id
].ID
] do
5245 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5246 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5247 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5248 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5249 Enabled
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrEnabled
]);
5250 ActivateType
:= StrToActivate(vleObjectProperty
.Values
[MsgPropTrActivation
]);
5251 Key
:= StrToKey(vleObjectProperty
.Values
[MsgPropTrKeys
]);
5256 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrNextMap
]);
5257 FillByte(Data
.MapName
[0], 16, 0);
5259 Move(s
[1], Data
.MapName
[0], Min(Length(s
), 16));
5264 Data
.ActivateOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureOnce
]);
5265 Data
.AnimOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureAnimOnce
]);
5268 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5270 Data
.Wait
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 65535);
5271 Data
.Count
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExCount
], 0), 65535);
5272 if Data
.Count
< 1 then
5274 if TriggerType
= TRIGGER_PRESS
then
5275 Data
.ExtRandom
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrExRandom
]);
5278 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
, TRIGGER_DOOR5
,
5279 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
, TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
,
5282 Data
.NoSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5283 Data
.d2d_doors
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5288 Data
.d2d_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5289 Data
.silent_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTeleportSilent
]);
5290 Data
.TlpDir
:= NameToDirAdv(vleObjectProperty
.Values
[MsgPropTrTeleportDir
]);
5295 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrSoundName
]);
5296 FillByte(Data
.SoundName
[0], 64, 0);
5298 Move(s
[1], Data
.SoundName
[0], Min(Length(s
), 64));
5300 Data
.Volume
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundVolume
], 0), 255);
5301 Data
.Pan
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundPan
], 0), 255);
5302 Data
.PlayCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundCount
], 0), 255);
5303 Data
.Local
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundLocal
]);
5304 Data
.SoundSwitch
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundSwitch
]);
5307 TRIGGER_SPAWNMONSTER
:
5309 Data
.MonType
:= StrToMonster(vleObjectProperty
.Values
[MsgPropTrMonsterType
]);
5310 Data
.MonDir
:= Byte(NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]));
5311 Data
.MonHealth
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 1000000);
5312 if Data
.MonHealth
< 0 then
5313 Data
.MonHealth
:= 0;
5314 Data
.MonActive
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrMonsterActive
]);
5315 Data
.MonCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5316 if Data
.MonCount
< 1 then
5318 Data
.MonEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5319 Data
.MonMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5320 Data
.MonDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5322 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour1
then
5324 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour2
then
5326 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour3
then
5328 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour4
then
5330 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour5
then
5336 Data
.ItemType
:= StrToItem(vleObjectProperty
.Values
[MsgPropTrItemType
]);
5337 Data
.ItemOnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5338 Data
.ItemFalls
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5339 Data
.ItemCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5340 if Data
.ItemCount
< 1 then
5341 Data
.ItemCount
:= 1;
5342 Data
.ItemEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5343 Data
.ItemMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5344 Data
.ItemDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5349 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMusicName
]);
5350 FillByte(Data
.MusicName
[0], 64, 0);
5352 Move(s
[1], Data
.MusicName
[0], Min(Length(s
), 64));
5354 if vleObjectProperty
.Values
[MsgPropTrMusicAct
] = MsgPropTrMusicOn
then
5355 Data
.MusicAction
:= 1
5357 Data
.MusicAction
:= 0;
5362 Data
.PushAngle
:= Min(
5363 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushAngle
], 0), 360);
5364 Data
.PushForce
:= Min(
5365 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushForce
], 0), 255);
5366 Data
.ResetVel
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrPushReset
]);
5371 Data
.ScoreAction
:= 0;
5372 if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct1
then
5373 Data
.ScoreAction
:= 1
5374 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct2
then
5375 Data
.ScoreAction
:= 2
5376 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct3
then
5377 Data
.ScoreAction
:= 3;
5378 Data
.ScoreCount
:= Min(Max(
5379 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5380 Data
.ScoreTeam
:= 0;
5381 if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam1
then
5383 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam2
then
5385 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam3
then
5386 Data
.ScoreTeam
:= 3;
5387 Data
.ScoreCon
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreCon
]);
5388 Data
.ScoreMsg
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreMsg
]);
5393 Data
.MessageKind
:= 0;
5394 if vleObjectProperty
.Values
[MsgPropTrMessageKind
] = MsgPropTrMessageKind1
then
5395 Data
.MessageKind
:= 1;
5397 Data
.MessageSendTo
:= 0;
5398 if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo1
then
5399 Data
.MessageSendTo
:= 1
5400 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo2
then
5401 Data
.MessageSendTo
:= 2
5402 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo3
then
5403 Data
.MessageSendTo
:= 3
5404 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo4
then
5405 Data
.MessageSendTo
:= 4
5406 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo5
then
5407 Data
.MessageSendTo
:= 5;
5409 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMessageText
]);
5410 FillByte(Data
.MessageText
[0], 100, 0);
5412 Move(s
[1], Data
.MessageText
[0], Min(Length(s
), 100));
5414 Data
.MessageTime
:= Min(Max(
5415 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrMessageTime
], 0), 0), 65535);
5420 Data
.DamageValue
:= Min(Max(
5421 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrDamageValue
], 0), 0), 65535);
5422 Data
.DamageInterval
:= Min(Max(
5423 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5424 s
:= vleObjectProperty
.Values
[MsgPropTrDamageKind
];
5425 if s
= MsgPropTrDamageKind3
then
5426 Data
.DamageKind
:= 3
5427 else if s
= MsgPropTrDamageKind4
then
5428 Data
.DamageKind
:= 4
5429 else if s
= MsgPropTrDamageKind5
then
5430 Data
.DamageKind
:= 5
5431 else if s
= MsgPropTrDamageKind6
then
5432 Data
.DamageKind
:= 6
5433 else if s
= MsgPropTrDamageKind7
then
5434 Data
.DamageKind
:= 7
5435 else if s
= MsgPropTrDamageKind8
then
5436 Data
.DamageKind
:= 8
5438 Data
.DamageKind
:= 0;
5443 Data
.HealValue
:= Min(Max(
5444 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 0), 65535);
5445 Data
.HealInterval
:= Min(Max(
5446 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5447 Data
.HealMax
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrHealthMax
]);
5448 Data
.HealSilent
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5453 Data
.ShotType
:= StrToShot(vleObjectProperty
.Values
[MsgPropTrShotType
]);
5454 Data
.ShotSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrShotSound
]);
5455 Data
.ShotTarget
:= 0;
5456 if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo1
then
5457 Data
.ShotTarget
:= 1
5458 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo2
then
5459 Data
.ShotTarget
:= 2
5460 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo3
then
5461 Data
.ShotTarget
:= 3
5462 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo4
then
5463 Data
.ShotTarget
:= 4
5464 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo5
then
5465 Data
.ShotTarget
:= 5
5466 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo6
then
5467 Data
.ShotTarget
:= 6;
5468 Data
.ShotIntSight
:= Min(Max(
5469 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotSight
], 0), 0), 65535);
5471 if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim1
then
5473 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim2
then
5475 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim3
then
5477 Data
.ShotAngle
:= Min(
5478 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAngle
], 0), 360);
5479 Data
.ShotWait
:= Min(Max(
5480 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5481 Data
.ShotAccuracy
:= Min(Max(
5482 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAcc
], 0), 0), 65535);
5483 Data
.ShotAmmo
:= Min(Max(
5484 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAmmo
], 0), 0), 65535);
5485 Data
.ShotIntReload
:= Min(Max(
5486 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotReload
], 0), 0), 65535);
5491 Data
.FXCount
:= Min(Max(
5492 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5493 if vleObjectProperty
.Values
[MsgPropTrEffectType
] = MsgPropTrEffectParticle
then
5495 Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
5496 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
5497 if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSliquid
then
5498 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
5499 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectLliquid
then
5500 Data
.FXSubType
:= TRIGGER_EFFECT_LLIQUID
5501 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectDliquid
then
5502 Data
.FXSubType
:= TRIGGER_EFFECT_DLIQUID
5503 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBlood
then
5504 Data
.FXSubType
:= TRIGGER_EFFECT_BLOOD
5505 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSpark
then
5506 Data
.FXSubType
:= TRIGGER_EFFECT_SPARK
5507 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBubble
then
5508 Data
.FXSubType
:= TRIGGER_EFFECT_BUBBLE
;
5511 Data
.FXType
:= TRIGGER_EFFECT_ANIMATION
;
5512 Data
.FXSubType
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrEffectSubtype
]);
5515 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectColor
], 0), 0), $FFFFFF);
5516 Data
.FXColorR
:= a
and $FF;
5517 Data
.FXColorG
:= (a
shr 8) and $FF;
5518 Data
.FXColorB
:= (a
shr 16) and $FF;
5519 if NameToBool(vleObjectProperty
.Values
[MsgPropTrEffectCenter
]) then
5523 Data
.FXWait
:= Min(Max(
5524 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5525 Data
.FXVelX
:= Min(Max(
5526 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVelx
], 0), -128), 127);
5527 Data
.FXVelY
:= Min(Max(
5528 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVely
], 0), -128), 127);
5529 Data
.FXSpreadL
:= Min(Max(
5530 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpl
], 0), 0), 255);
5531 Data
.FXSpreadR
:= Min(Max(
5532 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpr
], 0), 0), 255);
5533 Data
.FXSpreadU
:= Min(Max(
5534 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpu
], 0), 0), 255);
5535 Data
.FXSpreadD
:= Min(Max(
5536 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpd
], 0), 0), 255);
5545 vleObjectProperty
.Row
:= r
;
5546 vleObjectProperty
.Col
:= c
;
5549 procedure TMainForm
.bbRemoveTextureClick(Sender
: TObject
);
5553 i
:= lbTextureList
.ItemIndex
;
5557 if Application
.MessageBox(PChar(Format(MsgMsgDelTexturePrompt
,
5558 [SelectedTexture()])),
5559 PChar(MsgMsgDelTexture
),
5560 MB_ICONQUESTION
or MB_YESNO
or
5561 MB_DEFBUTTON1
) <> idYes
then
5564 if gPanels
<> nil then
5565 for a
:= 0 to High(gPanels
) do
5566 if (gPanels
[a
].PanelType
<> 0) and
5567 (gPanels
[a
].TextureName
= SelectedTexture()) then
5569 ErrorMessageBox(MsgMsgDelTextureCant
);
5573 g_DeleteTexture(SelectedTexture());
5574 i
:= slInvalidTextures
.IndexOf(lbTextureList
.Items
[i
]);
5576 slInvalidTextures
.Delete(i
);
5577 if lbTextureList
.ItemIndex
> -1 then
5578 lbTextureList
.Items
.Delete(lbTextureList
.ItemIndex
)
5581 procedure TMainForm
.aNewMapExecute(Sender
: TObject
);
5583 if Application
.MessageBox(PChar(MsgMsgClearMapPrompt
), PChar(MsgMsgClearMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON1
) = mrYes
then
5587 procedure TMainForm
.aUndoExecute(Sender
: TObject
);
5591 if UndoBuffer
= nil then
5593 if UndoBuffer
[High(UndoBuffer
)] = nil then
5596 for a
:= 0 to High(UndoBuffer
[High(UndoBuffer
)]) do
5597 with UndoBuffer
[High(UndoBuffer
)][a
] do
5605 UNDO_DELETE_ITEM
: AddItem(Item
);
5606 UNDO_DELETE_AREA
: AddArea(Area
);
5607 UNDO_DELETE_MONSTER
: AddMonster(Monster
);
5608 UNDO_DELETE_TRIGGER
: AddTrigger(Trigger
);
5609 UNDO_ADD_PANEL
: RemoveObject(AddID
, OBJECT_PANEL
);
5610 UNDO_ADD_ITEM
: RemoveObject(AddID
, OBJECT_ITEM
);
5611 UNDO_ADD_AREA
: RemoveObject(AddID
, OBJECT_AREA
);
5612 UNDO_ADD_MONSTER
: RemoveObject(AddID
, OBJECT_MONSTER
);
5613 UNDO_ADD_TRIGGER
: RemoveObject(AddID
, OBJECT_TRIGGER
);
5617 SetLength(UndoBuffer
, Length(UndoBuffer
)-1);
5618 RemoveSelectFromObjects();
5619 miUndo
.Enabled
:= UndoBuffer
<> nil;
5623 procedure TMainForm
.aCopyObjectExecute(Sender
: TObject
);
5626 CopyBuffer
: TCopyRecArray
;
5630 function CB_Compare(I1
, I2
: TCopyRec
): Integer;
5632 Result
:= Integer(I1
.ObjectType
) - Integer(I2
.ObjectType
);
5634 if Result
= 0 then // Одного типа
5635 Result
:= Integer(I1
.ID
) - Integer(I2
.ID
);
5638 procedure QuickSortCopyBuffer(L
, R
: Integer);
5646 P
:= CopyBuffer
[(L
+ R
) shr 1];
5649 while CB_Compare(CopyBuffer
[I
], P
) < 0 do
5651 while CB_Compare(CopyBuffer
[J
], P
) > 0 do
5657 CopyBuffer
[I
] := CopyBuffer
[J
];
5665 QuickSortCopyBuffer(L
, J
);
5672 if SelectedObjects
= nil then
5678 // Копируем объекты:
5679 for a
:= 0 to High(SelectedObjects
) do
5680 if SelectedObjects
[a
].Live
then
5681 with SelectedObjects
[a
] do
5683 SetLength(CopyBuffer
, Length(CopyBuffer
)+1);
5684 b
:= High(CopyBuffer
);
5685 CopyBuffer
[b
].ID
:= ID
;
5686 CopyBuffer
[b
].Panel
:= nil;
5691 CopyBuffer
[b
].ObjectType
:= OBJECT_PANEL
;
5692 New(CopyBuffer
[b
].Panel
);
5693 CopyBuffer
[b
].Panel
^ := gPanels
[ID
];
5698 CopyBuffer
[b
].ObjectType
:= OBJECT_ITEM
;
5699 CopyBuffer
[b
].Item
:= gItems
[ID
];
5704 CopyBuffer
[b
].ObjectType
:= OBJECT_MONSTER
;
5705 CopyBuffer
[b
].Monster
:= gMonsters
[ID
];
5710 CopyBuffer
[b
].ObjectType
:= OBJECT_AREA
;
5711 CopyBuffer
[b
].Area
:= gAreas
[ID
];
5716 CopyBuffer
[b
].ObjectType
:= OBJECT_TRIGGER
;
5717 CopyBuffer
[b
].Trigger
:= gTriggers
[ID
];
5722 // Сортировка по ID:
5723 if CopyBuffer
<> nil then
5725 QuickSortCopyBuffer(0, b
);
5728 // Постановка ссылок триггеров:
5729 for a
:= 0 to Length(CopyBuffer
)-1 do
5730 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5732 case CopyBuffer
[a
].Trigger
.TriggerType
of
5733 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5734 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5735 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5736 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5740 for b
:= 0 to Length(CopyBuffer
)-1 do
5741 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5742 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.PanelID
) then
5744 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= b
;
5749 // Этих панелей нет среди копируемых:
5751 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= -1;
5754 TRIGGER_PRESS
, TRIGGER_ON
,
5755 TRIGGER_OFF
, TRIGGER_ONOFF
:
5756 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5760 for b
:= 0 to Length(CopyBuffer
)-1 do
5761 if (CopyBuffer
[b
].ObjectType
= OBJECT_MONSTER
) and
5762 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1) then
5764 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= b
+1;
5769 // Этих монстров нет среди копируемых:
5771 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= 0;
5775 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5779 for b
:= 0 to Length(CopyBuffer
)-1 do
5780 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5781 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
) then
5783 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= b
;
5788 // Этих панелей нет среди копируемых:
5790 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= -1;
5794 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5798 for b
:= 0 to Length(CopyBuffer
)-1 do
5799 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5800 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.TexturePanel
) then
5802 CopyBuffer
[a
].Trigger
.TexturePanel
:= b
;
5807 // Этих панелей нет среди копируемых:
5809 CopyBuffer
[a
].Trigger
.TexturePanel
:= -1;
5814 str
:= CopyBufferToString(CopyBuffer
);
5815 ClipBoard
.AsText
:= str
;
5817 for a
:= 0 to Length(CopyBuffer
)-1 do
5818 if (CopyBuffer
[a
].ObjectType
= OBJECT_PANEL
) and
5819 (CopyBuffer
[a
].Panel
<> nil) then
5820 Dispose(CopyBuffer
[a
].Panel
);
5825 procedure TMainForm
.aPasteObjectExecute(Sender
: TObject
);
5828 CopyBuffer
: TCopyRecArray
;
5830 swad
, ssec
, sres
: String;
5833 xadj
, yadj
: LongInt;
5838 pmin
.X
:= High(pmin
.X
);
5839 pmin
.Y
:= High(pmin
.Y
);
5841 StringToCopyBuffer(ClipBoard
.AsText
, CopyBuffer
, pmin
);
5842 if CopyBuffer
= nil then
5845 rel
:= not(ssShift
in GetKeyShiftState());
5846 h
:= High(CopyBuffer
);
5847 RemoveSelectFromObjects();
5850 pmin
.X
, pmin
.Y
, -MapOffset
.X
-32, -MapOffset
.Y
-32, RenderPanel
.Width
, RenderPanel
.Height
) then
5857 xadj
:= Floor((-pmin
.X
- MapOffset
.X
+ 32) / DotStep
) * DotStep
;
5858 yadj
:= Floor((-pmin
.Y
- MapOffset
.Y
+ 32) / DotStep
) * DotStep
;
5862 with CopyBuffer
[a
] do
5866 if Panel
<> nil then
5874 Panel
^.TextureID
:= TEXTURE_SPECIAL_NONE
;
5875 Panel
^.TextureWidth
:= 1;
5876 Panel
^.TextureHeight
:= 1;
5878 if (Panel
^.PanelType
= PANEL_LIFTUP
) or
5879 (Panel
^.PanelType
= PANEL_LIFTDOWN
) or
5880 (Panel
^.PanelType
= PANEL_LIFTLEFT
) or
5881 (Panel
^.PanelType
= PANEL_LIFTRIGHT
) or
5882 (Panel
^.PanelType
= PANEL_BLOCKMON
) or
5883 (Panel
^.TextureName
= '') then
5884 begin // Нет или не может быть текстуры:
5886 else // Есть текстура:
5888 // Обычная текстура:
5889 if not IsSpecialTexture(Panel
^.TextureName
) then
5891 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5895 g_ProcessResourceStr(Panel
^.TextureName
, swad
, ssec
, sres
);
5896 AddTexture(swad
, ssec
, sres
, True);
5897 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5901 g_GetTextureSizeByName(Panel
^.TextureName
,
5902 Panel
^.TextureWidth
, Panel
^.TextureHeight
)
5904 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5906 Panel
^.TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5907 g_GetTextureSizeByID(NoTextureID
, Panel
^.TextureWidth
, Panel
^.TextureHeight
);
5910 else // Спец.текстура:
5912 Panel
^.TextureID
:= SpecialTextureID(Panel
^.TextureName
);
5913 with MainForm
.lbTextureList
.Items
do
5914 if IndexOf(Panel
^.TextureName
) = -1 then
5915 Add(Panel
^.TextureName
);
5919 ID
:= AddPanel(Panel
^);
5921 Undo_Add(OBJECT_PANEL
, ID
, a
> 0);
5922 SelectObject(OBJECT_PANEL
, ID
, True);
5933 ID
:= AddItem(Item
);
5934 Undo_Add(OBJECT_ITEM
, ID
, a
> 0);
5935 SelectObject(OBJECT_ITEM
, ID
, True);
5946 ID
:= AddMonster(Monster
);
5947 Undo_Add(OBJECT_MONSTER
, ID
, a
> 0);
5948 SelectObject(OBJECT_MONSTER
, ID
, True);
5959 ID
:= AddArea(Area
);
5960 Undo_Add(OBJECT_AREA
, ID
, a
> 0);
5961 SelectObject(OBJECT_AREA
, ID
, True);
5975 Data
.TargetPoint
.X
+= xadj
;
5976 Data
.TargetPoint
.Y
+= yadj
;
5978 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5983 TRIGGER_SPAWNMONSTER
:
5985 Data
.MonPos
.X
+= xadj
;
5986 Data
.MonPos
.Y
+= yadj
;
5990 Data
.ItemPos
.X
+= xadj
;
5991 Data
.ItemPos
.Y
+= yadj
;
5995 Data
.ShotPos
.X
+= xadj
;
5996 Data
.ShotPos
.Y
+= yadj
;
6001 ID
:= AddTrigger(Trigger
);
6002 Undo_Add(OBJECT_TRIGGER
, ID
, a
> 0);
6003 SelectObject(OBJECT_TRIGGER
, ID
, True);
6008 // Переставляем ссылки триггеров:
6009 for a
:= 0 to High(CopyBuffer
) do
6010 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
6012 case CopyBuffer
[a
].Trigger
.TriggerType
of
6013 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6014 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6015 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6016 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
6017 gTriggers
[CopyBuffer
[a
].ID
].Data
.PanelID
:=
6018 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.PanelID
].ID
;
6020 TRIGGER_PRESS
, TRIGGER_ON
,
6021 TRIGGER_OFF
, TRIGGER_ONOFF
:
6022 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
6023 gTriggers
[CopyBuffer
[a
].ID
].Data
.MonsterID
:=
6024 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1].ID
+1;
6027 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
6028 gTriggers
[CopyBuffer
[a
].ID
].Data
.ShotPanelID
:=
6029 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
].ID
;
6032 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
6033 gTriggers
[CopyBuffer
[a
].ID
].TexturePanel
:=
6034 CopyBuffer
[CopyBuffer
[a
].Trigger
.TexturePanel
].ID
;
6043 procedure TMainForm
.aCutObjectExecute(Sender
: TObject
);
6046 DeleteSelectedObjects();
6049 procedure TMainForm
.vleObjectPropertyEditButtonClick(Sender
: TObject
);
6051 Key
, FileName
: String;
6054 Key
:= vleObjectProperty
.Keys
[vleObjectProperty
.Row
];
6056 if Key
= MsgPropPanelType
then
6058 with ChooseTypeForm
, vleObjectProperty
do
6059 begin // Выбор типа панели:
6060 Caption
:= MsgPropPanelType
;
6061 lbTypeSelect
.Items
.Clear();
6063 for b
:= 0 to High(PANELNAMES
) do
6065 lbTypeSelect
.Items
.Add(PANELNAMES
[b
]);
6066 if Values
[Key
] = PANELNAMES
[b
] then
6067 lbTypeSelect
.ItemIndex
:= b
;
6070 if ShowModal() = mrOK
then
6072 b
:= lbTypeSelect
.ItemIndex
;
6073 Values
[Key
] := PANELNAMES
[b
];
6074 vleObjectPropertyApply(Sender
);
6078 else if Key
= MsgPropTrTeleportTo
then
6079 SelectFlag
:= SELECTFLAG_TELEPORT
6080 else if Key
= MsgPropTrSpawnTo
then
6081 SelectFlag
:= SELECTFLAG_SPAWNPOINT
6082 else if (Key
= MsgPropTrDoorPanel
) or
6083 (Key
= MsgPropTrTrapPanel
) then
6084 SelectFlag
:= SELECTFLAG_DOOR
6085 else if Key
= MsgPropTrTexturePanel
then
6087 DrawPressRect
:= False;
6088 SelectFlag
:= SELECTFLAG_TEXTURE
;
6090 else if Key
= MsgPropTrShotPanel
then
6091 SelectFlag
:= SELECTFLAG_SHOTPANEL
6092 else if Key
= MsgPropTrLiftPanel
then
6093 SelectFlag
:= SELECTFLAG_LIFT
6094 else if key
= MsgPropTrExMonster
then
6095 SelectFlag
:= SELECTFLAG_MONSTER
6096 else if Key
= MsgPropTrExArea
then
6098 SelectFlag
:= SELECTFLAG_NONE
;
6099 DrawPressRect
:= True;
6101 else if Key
= MsgPropTrNextMap
then
6102 begin // Выбор следующей карты:
6103 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
6104 SelectMapForm
.Caption
:= MsgCapSelect
;
6105 SelectMapForm
.GetMaps(FileName
);
6107 if SelectMapForm
.ShowModal() = mrOK
then
6109 vleObjectProperty
.Values
[Key
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6110 vleObjectPropertyApply(Sender
);
6113 else if (Key
= MsgPropTrSoundName
) or
6114 (Key
= MsgPropTrMusicName
) then
6115 begin // Выбор файла звука/музыки:
6116 AddSoundForm
.OKFunction
:= nil;
6117 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
6118 AddSoundForm
.SetResource
:= vleObjectProperty
.Values
[Key
];
6120 if (AddSoundForm
.ShowModal() = mrOk
) then
6122 vleObjectProperty
.Values
[Key
] := AddSoundForm
.ResourceName
;
6123 vleObjectPropertyApply(Sender
);
6126 else if Key
= MsgPropTrActivation
then
6127 with ActivationTypeForm
, vleObjectProperty
do
6128 begin // Выбор типов активации:
6129 cbPlayerCollide
.Checked
:= Pos('PC', Values
[Key
]) > 0;
6130 cbMonsterCollide
.Checked
:= Pos('MC', Values
[Key
]) > 0;
6131 cbPlayerPress
.Checked
:= Pos('PP', Values
[Key
]) > 0;
6132 cbMonsterPress
.Checked
:= Pos('MP', Values
[Key
]) > 0;
6133 cbShot
.Checked
:= Pos('SH', Values
[Key
]) > 0;
6134 cbNoMonster
.Checked
:= Pos('NM', Values
[Key
]) > 0;
6136 if ShowModal() = mrOK
then
6139 if cbPlayerCollide
.Checked
then
6140 b
:= ACTIVATE_PLAYERCOLLIDE
;
6141 if cbMonsterCollide
.Checked
then
6142 b
:= b
or ACTIVATE_MONSTERCOLLIDE
;
6143 if cbPlayerPress
.Checked
then
6144 b
:= b
or ACTIVATE_PLAYERPRESS
;
6145 if cbMonsterPress
.Checked
then
6146 b
:= b
or ACTIVATE_MONSTERPRESS
;
6147 if cbShot
.Checked
then
6148 b
:= b
or ACTIVATE_SHOT
;
6149 if cbNoMonster
.Checked
then
6150 b
:= b
or ACTIVATE_NOMONSTER
;
6152 Values
[Key
] := ActivateToStr(b
);
6153 vleObjectPropertyApply(Sender
);
6156 else if Key
= MsgPropTrKeys
then
6157 with KeysForm
, vleObjectProperty
do
6158 begin // Выбор необходимых ключей:
6159 cbRedKey
.Checked
:= Pos('RK', Values
[Key
]) > 0;
6160 cbGreenKey
.Checked
:= Pos('GK', Values
[Key
]) > 0;
6161 cbBlueKey
.Checked
:= Pos('BK', Values
[Key
]) > 0;
6162 cbRedTeam
.Checked
:= Pos('RT', Values
[Key
]) > 0;
6163 cbBlueTeam
.Checked
:= Pos('BT', Values
[Key
]) > 0;
6165 if ShowModal() = mrOK
then
6168 if cbRedKey
.Checked
then
6170 if cbGreenKey
.Checked
then
6171 b
:= b
or KEY_GREEN
;
6172 if cbBlueKey
.Checked
then
6174 if cbRedTeam
.Checked
then
6175 b
:= b
or KEY_REDTEAM
;
6176 if cbBlueTeam
.Checked
then
6177 b
:= b
or KEY_BLUETEAM
;
6179 Values
[Key
] := KeyToStr(b
);
6180 vleObjectPropertyApply(Sender
);
6183 else if Key
= MsgPropTrFxType
then
6184 with ChooseTypeForm
, vleObjectProperty
do
6185 begin // Выбор типа эффекта:
6186 Caption
:= MsgCapFxType
;
6187 lbTypeSelect
.Items
.Clear();
6189 for b
:= EFFECT_NONE
to EFFECT_FIRE
do
6190 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6192 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]);
6194 if ShowModal() = mrOK
then
6196 b
:= lbTypeSelect
.ItemIndex
;
6197 Values
[Key
] := EffectToStr(b
);
6198 vleObjectPropertyApply(Sender
);
6201 else if Key
= MsgPropTrMonsterType
then
6202 with ChooseTypeForm
, vleObjectProperty
do
6203 begin // Выбор типа монстра:
6204 Caption
:= MsgCapMonsterType
;
6205 lbTypeSelect
.Items
.Clear();
6207 for b
:= MONSTER_DEMON
to MONSTER_MAN
do
6208 lbTypeSelect
.Items
.Add(MonsterToStr(b
));
6210 lbTypeSelect
.ItemIndex
:= StrToMonster(Values
[Key
]) - MONSTER_DEMON
;
6212 if ShowModal() = mrOK
then
6214 b
:= lbTypeSelect
.ItemIndex
+ MONSTER_DEMON
;
6215 Values
[Key
] := MonsterToStr(b
);
6216 vleObjectPropertyApply(Sender
);
6219 else if Key
= MsgPropTrItemType
then
6220 with ChooseTypeForm
, vleObjectProperty
do
6221 begin // Выбор типа предмета:
6222 Caption
:= MsgCapItemType
;
6223 lbTypeSelect
.Items
.Clear();
6225 for b
:= ITEM_MEDKIT_SMALL
to ITEM_KEY_BLUE
do
6226 lbTypeSelect
.Items
.Add(ItemToStr(b
));
6227 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_BOTTLE
));
6228 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_HELMET
));
6229 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_JETPACK
));
6230 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_INVIS
));
6231 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER
));
6232 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_AMMO_FUELCAN
));
6234 b
:= StrToItem(Values
[Key
]);
6235 if b
>= ITEM_BOTTLE
then
6237 lbTypeSelect
.ItemIndex
:= b
- ITEM_MEDKIT_SMALL
;
6239 if ShowModal() = mrOK
then
6241 b
:= lbTypeSelect
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
6242 if b
>= ITEM_WEAPON_IRONFIST
then
6244 Values
[Key
] := ItemToStr(b
);
6245 vleObjectPropertyApply(Sender
);
6248 else if Key
= MsgPropTrShotType
then
6249 with ChooseTypeForm
, vleObjectProperty
do
6250 begin // Выбор типа предмета:
6251 Caption
:= MsgPropTrShotType
;
6252 lbTypeSelect
.Items
.Clear();
6254 for b
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
6255 lbTypeSelect
.Items
.Add(ShotToStr(b
));
6257 lbTypeSelect
.ItemIndex
:= StrToShot(Values
[Key
]);
6259 if ShowModal() = mrOK
then
6261 b
:= lbTypeSelect
.ItemIndex
;
6262 Values
[Key
] := ShotToStr(b
);
6263 vleObjectPropertyApply(Sender
);
6266 else if Key
= MsgPropTrEffectType
then
6267 with ChooseTypeForm
, vleObjectProperty
do
6268 begin // Выбор типа эффекта:
6269 Caption
:= MsgCapFxType
;
6270 lbTypeSelect
.Items
.Clear();
6272 lbTypeSelect
.Items
.Add(MsgPropTrEffectParticle
);
6273 lbTypeSelect
.Items
.Add(MsgPropTrEffectAnimation
);
6274 if Values
[Key
] = MsgPropTrEffectAnimation
then
6275 lbTypeSelect
.ItemIndex
:= 1
6277 lbTypeSelect
.ItemIndex
:= 0;
6279 if ShowModal() = mrOK
then
6281 b
:= lbTypeSelect
.ItemIndex
;
6283 Values
[Key
] := MsgPropTrEffectParticle
6285 Values
[Key
] := MsgPropTrEffectAnimation
;
6286 vleObjectPropertyApply(Sender
);
6289 else if Key
= MsgPropTrEffectSubtype
then
6290 with ChooseTypeForm
, vleObjectProperty
do
6291 begin // Выбор подтипа эффекта:
6292 Caption
:= MsgCapFxType
;
6293 lbTypeSelect
.Items
.Clear();
6295 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6297 for b
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
6298 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6300 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]) - 1;
6303 lbTypeSelect
.Items
.Add(MsgPropTrEffectSliquid
);
6304 lbTypeSelect
.Items
.Add(MsgPropTrEffectLliquid
);
6305 lbTypeSelect
.Items
.Add(MsgPropTrEffectDliquid
);
6306 lbTypeSelect
.Items
.Add(MsgPropTrEffectBlood
);
6307 lbTypeSelect
.Items
.Add(MsgPropTrEffectSpark
);
6308 lbTypeSelect
.Items
.Add(MsgPropTrEffectBubble
);
6309 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SLIQUID
;
6310 if Values
[Key
] = MsgPropTrEffectLliquid
then
6311 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_LLIQUID
;
6312 if Values
[Key
] = MsgPropTrEffectDliquid
then
6313 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_DLIQUID
;
6314 if Values
[Key
] = MsgPropTrEffectBlood
then
6315 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BLOOD
;
6316 if Values
[Key
] = MsgPropTrEffectSpark
then
6317 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SPARK
;
6318 if Values
[Key
] = MsgPropTrEffectBubble
then
6319 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BUBBLE
;
6322 if ShowModal() = mrOK
then
6324 b
:= lbTypeSelect
.ItemIndex
;
6326 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6327 Values
[Key
] := EffectToStr(b
+ 1)
6329 Values
[Key
] := MsgPropTrEffectSliquid
;
6330 if b
= TRIGGER_EFFECT_LLIQUID
then
6331 Values
[Key
] := MsgPropTrEffectLliquid
;
6332 if b
= TRIGGER_EFFECT_DLIQUID
then
6333 Values
[Key
] := MsgPropTrEffectDliquid
;
6334 if b
= TRIGGER_EFFECT_BLOOD
then
6335 Values
[Key
] := MsgPropTrEffectBlood
;
6336 if b
= TRIGGER_EFFECT_SPARK
then
6337 Values
[Key
] := MsgPropTrEffectSpark
;
6338 if b
= TRIGGER_EFFECT_BUBBLE
then
6339 Values
[Key
] := MsgPropTrEffectBubble
;
6342 vleObjectPropertyApply(Sender
);
6345 else if Key
= MsgPropTrEffectColor
then
6346 with vleObjectProperty
do
6347 begin // Выбор цвета эффекта:
6348 ColorDialog
.Color
:= StrToIntDef(Values
[Key
], 0);
6349 if ColorDialog
.Execute
then
6351 Values
[Key
] := IntToStr(ColorDialog
.Color
);
6352 vleObjectPropertyApply(Sender
);
6355 else if Key
= MsgPropPanelTex
then
6356 begin // Смена текстуры:
6357 vleObjectProperty
.Values
[Key
] := SelectedTexture();
6358 vleObjectPropertyApply(Sender
);
6362 procedure TMainForm
.vleObjectPropertyApply(Sender
: TObject
);
6364 // hack to prevent empty ID in list
6365 RenderPanel
.SetFocus();
6366 bApplyProperty
.Click();
6367 vleObjectProperty
.SetFocus();
6370 procedure TMainForm
.aSaveMapExecute(Sender
: TObject
);
6372 FileName
, Section
, Res
: String;
6374 if OpenedMap
= '' then
6376 aSaveMapAsExecute(nil);
6380 g_ProcessResourceStr(OpenedMap
, FileName
, Section
, Res
);
6382 SaveMap(FileName
+':\'+Res
, '');
6385 procedure TMainForm
.aOpenMapExecute(Sender
: TObject
);
6387 OpenDialog
.Filter
:= MsgFileFilterAll
;
6389 if OpenDialog
.Execute() then
6391 OpenMapFile(OpenDialog
.FileName
);
6392 OpenDialog
.InitialDir
:= ExtractFileDir(OpenDialog
.FileName
);
6396 procedure TMainForm
.OpenMapFile(FileName
: String);
6398 if (Pos('.ini', LowerCase(ExtractFileName(FileName
))) > 0) then
6402 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
6403 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
6404 pLoadProgress
.Show();
6409 LoadMapOld(FileName
);
6411 MainForm
.Caption
:= Format('%s - %s', [FormCaption
, ExtractFileName(FileName
)]);
6413 pLoadProgress
.Hide();
6414 MainForm
.FormResize(Self
);
6416 else // Карты из WAD:
6418 OpenMap(FileName
, '');
6422 procedure TMainForm
.FormActivate(Sender
: TObject
);
6424 MainForm
.ActiveControl
:= RenderPanel
;
6427 procedure TMainForm
.aDeleteMap(Sender
: TObject
);
6435 OpenDialog
.Filter
:= MsgFileFilterWad
;
6437 if not OpenDialog
.Execute() then
6440 WAD
:= TWADEditor_1
.Create();
6442 if not WAD
.ReadFile(OpenDialog
.FileName
) then
6450 MapList
:= WAD
.GetResourcesList('');
6452 SelectMapForm
.Caption
:= MsgCapRemove
;
6453 SelectMapForm
.lbMapList
.Items
.Clear();
6455 if MapList
<> nil then
6456 for a
:= 0 to High(MapList
) do
6457 SelectMapForm
.lbMapList
.Items
.Add(win2utf(MapList
[a
]));
6459 if (SelectMapForm
.ShowModal() = mrOK
) then
6461 str
:= SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6463 Move(str
[1], MapName
[0], Min(16, Length(str
)));
6465 if Application
.MessageBox(PChar(Format(MsgMsgDeleteMapPrompt
, [MapName
, OpenDialog
.FileName
])), PChar(MsgMsgDeleteMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON2
) <> mrYes
then
6468 WAD
.RemoveResource('', utf2win(MapName
));
6470 Application
.MessageBox(
6471 PChar(Format(MsgMsgMapDeletedPrompt
, [MapName
])),
6472 PChar(MsgMsgMapDeleted
),
6473 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
6476 WAD
.SaveTo(OpenDialog
.FileName
);
6478 // Удалили текущую карту - сохранять по старому ее нельзя:
6479 if OpenedMap
= (OpenDialog
.FileName
+':\'+MapName
) then
6483 MainForm
.Caption
:= FormCaption
;
6490 procedure TMainForm
.vleObjectPropertyKeyDown(Sender
: TObject
;
6491 var Key
: Word; Shift
: TShiftState
);
6493 if Key
= VK_RETURN
then
6494 vleObjectPropertyApply(Sender
);
6497 procedure MovePanel(var ID
: DWORD
; MoveType
: Byte);
6502 if (ID
= 0) and (MoveType
= 0) then
6504 if (ID
= DWORD(High(gPanels
))) and (MoveType
<> 0) then
6506 if (ID
> DWORD(High(gPanels
))) then
6511 if MoveType
= 0 then // to Back
6513 if gTriggers
<> nil then
6514 for a
:= 0 to High(gTriggers
) do
6515 with gTriggers
[a
] do
6517 if TriggerType
= TRIGGER_NONE
then
6520 if TexturePanel
= _id
then
6523 if (TexturePanel
>= 0) and (TexturePanel
< _id
) then
6527 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6528 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6529 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6530 if Data
.PanelID
= _id
then
6533 if (Data
.PanelID
>= 0) and (Data
.PanelID
< _id
) then
6537 if Data
.ShotPanelID
= _id
then
6538 Data
.ShotPanelID
:= 0
6540 if (Data
.ShotPanelID
>= 0) and (Data
.ShotPanelID
< _id
) then
6541 Inc(Data
.ShotPanelID
);
6545 tmp
:= gPanels
[_id
];
6547 for a
:= _id
downto 1 do
6548 gPanels
[a
] := gPanels
[a
-1];
6556 if gTriggers
<> nil then
6557 for a
:= 0 to High(gTriggers
) do
6558 with gTriggers
[a
] do
6560 if TriggerType
= TRIGGER_NONE
then
6563 if TexturePanel
= _id
then
6564 TexturePanel
:= High(gPanels
)
6566 if TexturePanel
> _id
then
6570 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6571 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6572 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6573 if Data
.PanelID
= _id
then
6574 Data
.PanelID
:= High(gPanels
)
6576 if Data
.PanelID
> _id
then
6580 if Data
.ShotPanelID
= _id
then
6581 Data
.ShotPanelID
:= High(gPanels
)
6583 if Data
.ShotPanelID
> _id
then
6584 Dec(Data
.ShotPanelID
);
6588 tmp
:= gPanels
[_id
];
6590 for a
:= _id
to High(gPanels
)-1 do
6591 gPanels
[a
] := gPanels
[a
+1];
6593 gPanels
[High(gPanels
)] := tmp
;
6595 ID
:= High(gPanels
);
6599 procedure TMainForm
.aMoveToBack(Sender
: TObject
);
6603 if SelectedObjects
= nil then
6606 for a
:= 0 to High(SelectedObjects
) do
6607 with SelectedObjects
[a
] do
6608 if Live
and (ObjectType
= OBJECT_PANEL
) then
6610 SelectedObjects
[0] := SelectedObjects
[a
];
6611 SetLength(SelectedObjects
, 1);
6618 procedure TMainForm
.aMoveToFore(Sender
: TObject
);
6622 if SelectedObjects
= nil then
6625 for a
:= 0 to High(SelectedObjects
) do
6626 with SelectedObjects
[a
] do
6627 if Live
and (ObjectType
= OBJECT_PANEL
) then
6629 SelectedObjects
[0] := SelectedObjects
[a
];
6630 SetLength(SelectedObjects
, 1);
6637 procedure TMainForm
.aSaveMapAsExecute(Sender
: TObject
);
6638 var i
, idx
: Integer; list
: TStringList
; fmt
: String;
6640 list
:= TStringList
.Create();
6642 // TODO: get loclized strings automatically from language files
6643 SaveDialog
.DefaultExt
:= '.dfz';
6644 SaveDialog
.FilterIndex
:= 1;
6645 SaveDialog
.Filter
:= '';
6646 gWADEditorFactory
.GetRegistredEditors(list
);
6647 for i
:= 0 to list
.Count
- 1 do
6649 if list
[i
] = 'DFZIP' then
6650 SaveDialog
.FilterIndex
:= i
+ 1;
6653 SaveDialog
.Filter
:= SaveDialog
.Filter
+ '|';
6655 if list
[i
] = 'DFWAD' then
6656 SaveDialog
.Filter
:= SaveDialog
.Filter
+ MsgFileFilterSaveDFWAD
6657 else if list
[i
] = 'DFZIP' then
6658 SaveDialog
.Filter
:= SaveDialog
.Filter
+ MsgFileFilterSaveDFZIP
6660 SaveDialog
.Filter
:= SaveDialog
.Filter
+ list
[i
] + '|*.*';
6663 if SaveDialog
.Execute() then
6665 i
:= SaveDialog
.FilterIndex
- 1;
6666 if (i
>= 0) and (i
< list
.Count
) then fmt
:= list
[i
] else fmt
:= '';
6668 SaveMapForm
.GetMaps(SaveDialog
.FileName
, True, fmt
);
6669 if SaveMapForm
.ShowModal() = mrOK
then
6671 SaveDialog
.InitialDir
:= ExtractFileDir(SaveDialog
.FileName
);
6672 OpenedMap
:= SaveDialog
.FileName
+':\'+SaveMapForm
.eMapName
.Text;
6673 OpenedWAD
:= SaveDialog
.FileName
;
6675 idx
:= RecentFiles
.IndexOf(OpenedMap
);
6676 // Такая карта уже недавно открывалась:
6678 RecentFiles
.Delete(idx
);
6679 RecentFiles
.Insert(0, OpenedMap
);
6682 SaveMap(OpenedMap
, fmt
);
6684 gMapInfo
.FileName
:= SaveDialog
.FileName
;
6685 gMapInfo
.MapName
:= SaveMapForm
.eMapName
.Text;
6686 UpdateCaption(gMapInfo
.Name
, ExtractFileName(gMapInfo
.FileName
), gMapInfo
.MapName
);
6693 procedure TMainForm
.aSelectAllExecute(Sender
: TObject
);
6697 RemoveSelectFromObjects();
6699 case pcObjects
.ActivePageIndex
+1 of
6701 if gPanels
<> nil then
6702 for a
:= 0 to High(gPanels
) do
6703 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6704 SelectObject(OBJECT_PANEL
, a
, True);
6706 if gItems
<> nil then
6707 for a
:= 0 to High(gItems
) do
6708 if gItems
[a
].ItemType
<> ITEM_NONE
then
6709 SelectObject(OBJECT_ITEM
, a
, True);
6711 if gMonsters
<> nil then
6712 for a
:= 0 to High(gMonsters
) do
6713 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6714 SelectObject(OBJECT_MONSTER
, a
, True);
6716 if gAreas
<> nil then
6717 for a
:= 0 to High(gAreas
) do
6718 if gAreas
[a
].AreaType
<> AREA_NONE
then
6719 SelectObject(OBJECT_AREA
, a
, True);
6721 if gTriggers
<> nil then
6722 for a
:= 0 to High(gTriggers
) do
6723 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6724 SelectObject(OBJECT_TRIGGER
, a
, True);
6727 RecountSelectedObjects();
6730 procedure TMainForm
.tbGridOnClick(Sender
: TObject
);
6732 DotEnable
:= not DotEnable
;
6733 (Sender
as TToolButton
).Down
:= DotEnable
;
6736 procedure TMainForm
.OnIdle(Sender
: TObject
; var Done
: Boolean);
6740 // TODO: move refresh to user actions (ask to repaint only when something changed)
6741 if GetTickCount64() - LastDrawTime
>= 1000 div MaxFPS
then
6746 if StartMap
<> '' then
6754 procedure TMainForm
.miMapPreviewClick(Sender
: TObject
);
6756 if PreviewMode
= 2 then
6759 if PreviewMode
= 0 then
6761 Splitter2
.Visible
:= False;
6762 Splitter1
.Visible
:= False;
6763 StatusBar
.Visible
:= False;
6764 PanelObjs
.Visible
:= False;
6765 PanelProps
.Visible
:= False;
6766 MainToolBar
.Visible
:= False;
6767 sbHorizontal
.Visible
:= False;
6768 sbVertical
.Visible
:= False;
6772 StatusBar
.Visible
:= True;
6773 PanelObjs
.Visible
:= True;
6774 PanelProps
.Visible
:= True;
6775 Splitter2
.Visible
:= True;
6776 Splitter1
.Visible
:= True;
6777 MainToolBar
.Visible
:= True;
6778 sbHorizontal
.Visible
:= True;
6779 sbVertical
.Visible
:= True;
6782 PreviewMode
:= PreviewMode
xor 1;
6783 (Sender
as TMenuItem
).Checked
:= PreviewMode
> 0;
6788 procedure TMainForm
.miLayer1Click(Sender
: TObject
);
6790 SwitchLayer(LAYER_BACK
);
6793 procedure TMainForm
.miLayer2Click(Sender
: TObject
);
6795 SwitchLayer(LAYER_WALLS
);
6798 procedure TMainForm
.miLayer3Click(Sender
: TObject
);
6800 SwitchLayer(LAYER_FOREGROUND
);
6803 procedure TMainForm
.miLayer4Click(Sender
: TObject
);
6805 SwitchLayer(LAYER_STEPS
);
6808 procedure TMainForm
.miLayer5Click(Sender
: TObject
);
6810 SwitchLayer(LAYER_WATER
);
6813 procedure TMainForm
.miLayer6Click(Sender
: TObject
);
6815 SwitchLayer(LAYER_ITEMS
);
6818 procedure TMainForm
.miLayer7Click(Sender
: TObject
);
6820 SwitchLayer(LAYER_MONSTERS
);
6823 procedure TMainForm
.miLayer8Click(Sender
: TObject
);
6825 SwitchLayer(LAYER_AREAS
);
6828 procedure TMainForm
.miLayer9Click(Sender
: TObject
);
6830 SwitchLayer(LAYER_TRIGGERS
);
6833 procedure TMainForm
.tbShowClick(Sender
: TObject
);
6839 for a
:= 0 to High(LayerEnabled
) do
6840 b
:= b
and LayerEnabled
[a
];
6844 ShowLayer(LAYER_BACK
, b
);
6845 ShowLayer(LAYER_WALLS
, b
);
6846 ShowLayer(LAYER_FOREGROUND
, b
);
6847 ShowLayer(LAYER_STEPS
, b
);
6848 ShowLayer(LAYER_WATER
, b
);
6849 ShowLayer(LAYER_ITEMS
, b
);
6850 ShowLayer(LAYER_MONSTERS
, b
);
6851 ShowLayer(LAYER_AREAS
, b
);
6852 ShowLayer(LAYER_TRIGGERS
, b
);
6855 procedure TMainForm
.miMiniMapClick(Sender
: TObject
);
6860 procedure TMainForm
.miSwitchGridClick(Sender
: TObject
);
6862 if DotStep
= DotStepOne
then
6863 DotStep
:= DotStepTwo
6865 DotStep
:= DotStepOne
;
6867 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6868 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6871 procedure TMainForm
.miShowEdgesClick(Sender
: TObject
);
6876 procedure TMainForm
.miSnapToGridClick(Sender
: TObject
);
6878 SnapToGrid
:= not SnapToGrid
;
6880 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6881 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6883 miSnapToGrid
.Checked
:= SnapToGrid
;
6886 procedure TMainForm
.minexttabClick(Sender
: TObject
);
6888 if pcObjects
.ActivePageIndex
< pcObjects
.PageCount
-1 then
6889 pcObjects
.ActivePageIndex
:= pcObjects
.ActivePageIndex
+1
6891 pcObjects
.ActivePageIndex
:= 0;
6894 procedure TMainForm
.miSaveMiniMapClick(Sender
: TObject
);
6896 SaveMiniMapForm
.ShowModal();
6899 procedure TMainForm
.bClearTextureClick(Sender
: TObject
);
6901 lbTextureList
.ItemIndex
:= -1;
6902 lTextureWidth
.Caption
:= '';
6903 lTextureHeight
.Caption
:= '';
6906 procedure TMainForm
.miPackMapClick(Sender
: TObject
);
6908 PackMapForm
.ShowModal();
6911 type SSArray
= array of String;
6913 function ParseString (Str
: AnsiString): SSArray
;
6914 function GetStr (var Str
: AnsiString): AnsiString;
6918 if Str
[1] = '"' then
6919 for b
:= 1 to Length(Str
) do
6920 if (b
= Length(Str
)) or (Str
[b
+ 1] = '"') then
6922 Result
:= Copy(Str
, 2, b
- 1);
6923 Delete(Str
, 1, b
+ 1);
6927 for a
:= 1 to Length(Str
) do
6928 if (a
= Length(Str
)) or (Str
[a
+ 1] = ' ') then
6930 Result
:= Copy(Str
, 1, a
);
6931 Delete(Str
, 1, a
+ 1);
6941 SetLength(Result
, Length(Result
)+1);
6942 Result
[High(Result
)] := GetStr(Str
);
6946 procedure TMainForm
.miTestMapClick(Sender
: TObject
);
6948 newWAD
, oldWAD
, tempMap
, ext
: String;
6955 // Ignore while map testing in progress
6956 if MapTestProcess
<> nil then
6959 // Сохраняем временную карту:
6962 newWAD
:= Format('%s/temp%.4d', [MapsDir
, time
]);
6964 until not FileExists(newWAD
);
6965 if OpenedMap
<> '' then
6967 oldWad
:= g_ExtractWadName(OpenedMap
);
6968 newWad
:= newWad
+ ExtractFileExt(oldWad
);
6969 if CopyFile(oldWad
, newWad
) = false then
6970 e_WriteLog('MapTest: unable to copy [' + oldWad
+ '] to [' + newWad
+ ']', MSG_WARNING
)
6974 newWad
:= newWad
+ '.wad'
6976 tempMap
:= newWAD
+ ':\' + TEST_MAP_NAME
;
6977 SaveMap(tempMap
, '');
6981 if TestOptionsTwoPlayers
then
6983 if TestOptionsTeamDamage
then
6985 if TestOptionsAllowExit
then
6987 if TestOptionsWeaponStay
then
6989 if TestOptionsMonstersDM
then
6993 proc
:= TProcessUTF8
.Create(nil);
6994 proc
.Executable
:= TestD2dExe
;
6996 // TODO: get real executable name from Info.plist
6997 if LowerCase(ExtractFileExt(TestD2dExe
)) = '.app' then
6998 proc
.Executable
:= TestD2dExe
+ DirectorySeparator
+ 'Contents' + DirectorySeparator
+ 'MacOS' + DirectorySeparator
+ 'Doom2DF';
7000 proc
.Parameters
.Add('-map');
7001 proc
.Parameters
.Add(tempMap
);
7002 proc
.Parameters
.Add('-gm');
7003 proc
.Parameters
.Add(TestGameMode
);
7004 proc
.Parameters
.Add('-limt');
7005 proc
.Parameters
.Add(TestLimTime
);
7006 proc
.Parameters
.Add('-lims');
7007 proc
.Parameters
.Add(TestLimScore
);
7008 proc
.Parameters
.Add('-opt');
7009 proc
.Parameters
.Add(IntToStr(opt
));
7010 proc
.Parameters
.Add('--debug');
7012 proc
.Parameters
.Add('--close');
7014 args
:= ParseString(TestD2DArgs
);
7015 for i
:= 0 to High(args
) do
7016 proc
.Parameters
.Add(args
[i
]);
7026 tbTestMap
.Enabled
:= False;
7027 MapTestFile
:= newWAD
;
7028 MapTestProcess
:= proc
;
7032 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
7033 SysUtils
.DeleteFile(newWAD
);
7038 procedure TMainForm
.sbVerticalScroll(Sender
: TObject
;
7039 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
7041 MapOffset
.Y
:= -sbVertical
.Position
;
7042 RenderPanel
.Invalidate
;
7045 procedure TMainForm
.sbHorizontalScroll(Sender
: TObject
;
7046 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
7048 MapOffset
.X
:= -sbHorizontal
.Position
;
7049 RenderPanel
.Invalidate
;
7052 procedure TMainForm
.miOpenWadMapClick(Sender
: TObject
);
7054 if OpenedWAD
<> '' then
7056 OpenMap(OpenedWAD
, '');
7060 procedure TMainForm
.selectall1Click(Sender
: TObject
);
7064 RemoveSelectFromObjects();
7066 if gPanels
<> nil then
7067 for a
:= 0 to High(gPanels
) do
7068 if gPanels
[a
].PanelType
<> PANEL_NONE
then
7069 SelectObject(OBJECT_PANEL
, a
, True);
7071 if gItems
<> nil then
7072 for a
:= 0 to High(gItems
) do
7073 if gItems
[a
].ItemType
<> ITEM_NONE
then
7074 SelectObject(OBJECT_ITEM
, a
, True);
7076 if gMonsters
<> nil then
7077 for a
:= 0 to High(gMonsters
) do
7078 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
7079 SelectObject(OBJECT_MONSTER
, a
, True);
7081 if gAreas
<> nil then
7082 for a
:= 0 to High(gAreas
) do
7083 if gAreas
[a
].AreaType
<> AREA_NONE
then
7084 SelectObject(OBJECT_AREA
, a
, True);
7086 if gTriggers
<> nil then
7087 for a
:= 0 to High(gTriggers
) do
7088 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
7089 SelectObject(OBJECT_TRIGGER
, a
, True);
7091 RecountSelectedObjects();
7094 procedure TMainForm
.Splitter1CanResize(Sender
: TObject
;
7095 var NewSize
: Integer; var Accept
: Boolean);
7097 Accept
:= (NewSize
> 140);
7100 procedure TMainForm
.Splitter2CanResize(Sender
: TObject
;
7101 var NewSize
: Integer; var Accept
: Boolean);
7103 Accept
:= (NewSize
> 110);
7106 procedure TMainForm
.vleObjectPropertyEnter(Sender
: TObject
);
7108 EditingProperties
:= True;
7111 procedure TMainForm
.vleObjectPropertyExit(Sender
: TObject
);
7113 EditingProperties
:= False;
7116 procedure TMainForm
.FormKeyUp(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
7118 // Объекты передвигались:
7119 if MainForm
.ActiveControl
= RenderPanel
then
7121 if (Key
= VK_NUMPAD4
) or
7122 (Key
= VK_NUMPAD6
) or
7123 (Key
= VK_NUMPAD8
) or
7124 (Key
= VK_NUMPAD5
) or
7125 (Key
= Ord('V')) then
7128 // Быстрое превью карты:
7129 if Key
= Ord('E') then
7131 if PreviewMode
= 2 then
7134 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);