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
)
22 miMenuFile
: TMenuItem
;
26 miSaveMapAs
: TMenuItem
;
27 miOpenWadMap
: TMenuItem
;
29 miSaveMiniMap
: TMenuItem
;
30 miDeleteMap
: TMenuItem
;
35 miMenuEdit
: TMenuItem
;
42 miSelectAll
: TMenuItem
;
47 miMenuTools
: TMenuItem
;
48 miSnapToGrid
: TMenuItem
;
50 miSwitchGrid
: TMenuItem
;
51 miShowEdges
: TMenuItem
;
63 miMenuService
: TMenuItem
;
64 miCheckMap
: TMenuItem
;
65 miOptimmization
: TMenuItem
;
66 miMapPreview
: TMenuItem
;
69 miMenuSettings
: TMenuItem
;
70 miMapOptions
: TMenuItem
;
74 miMapTestSettings
: TMenuItem
;
76 miMenuHelp
: TMenuItem
;
78 // Скрытый пункт меню для Ctrl+Tab:
82 // Панель инструментов:
83 MainToolBar
: TToolBar
;
85 pLoadProgress
: TPanel
;
86 RenderPanel
: TOpenGLControl
;
87 tbNewMap
: TToolButton
;
88 tbOpenMap
: TToolButton
;
89 tbSaveMap
: TToolButton
;
90 tbOpenWadMap
: TToolButton
;
92 tbShowMap
: TToolButton
;
96 tbGridOn
: TToolButton
;
99 tbTestMap
: TToolButton
;
100 // Всплывающее меню для кнопки слоев:
102 miLayerP1
: TMenuItem
;
103 miLayerP2
: TMenuItem
;
104 miLayerP3
: TMenuItem
;
105 miLayerP4
: TMenuItem
;
106 miLayerP5
: TMenuItem
;
107 miLayerP6
: TMenuItem
;
108 miLayerP7
: TMenuItem
;
109 miLayerP8
: TMenuItem
;
110 miLayerP9
: TMenuItem
;
111 // Всплывающее меню для кнопки теста карты:
112 pmMapTest
: TPopupMenu
;
113 miMapTestPMSet
: TMenuItem
;
118 sbHorizontal
: TScrollBar
;
119 sbVertical
: TScrollBar
;
123 // Панель применения свойств:
124 PanelPropApply
: TPanel
;
125 bApplyProperty
: TButton
;
126 // Редактор свойств объектов:
127 vleObjectProperty
: TValueListEditor
;
129 // Панель объектов - вкладки:
131 pcObjects
: TPageControl
;
134 lbTextureList
: TListBox
;
135 // Панель настройки текстур:
136 PanelTextures
: TPanel
;
138 lTextureWidth
: TLabel
;
140 lTextureHeight
: TLabel
;
141 cbPreview
: TCheckBox
;
142 bbAddTexture
: TBitBtn
;
143 bbRemoveTexture
: TBitBtn
;
144 bClearTexture
: TButton
;
145 // Панель типов панелей:
146 PanelPanelType
: TPanel
;
147 lbPanelType
: TListBox
;
148 // Вкладка "Предметы":
150 lbItemList
: TListBox
;
153 // Вкладка "Монстры":
154 tsMonsters
: TTabSheet
;
155 lbMonsterList
: TListBox
;
156 rbMonsterLeft
: TRadioButton
;
157 rbMonsterRight
: TRadioButton
;
158 // Вкладка "Области":
160 lbAreasList
: TListBox
;
161 rbAreaLeft
: TRadioButton
;
162 rbAreaRight
: TRadioButton
;
163 // Вкладка "Триггеры":
164 tsTriggers
: TTabSheet
;
165 lbTriggersList
: TListBox
;
166 clbActivationType
: TCheckListBox
;
167 clbKeys
: TCheckListBox
;
170 Splitter1
: TSplitter
;
171 Splitter2
: TSplitter
;
172 StatusBar
: TStatusBar
;
174 // Специальные объекты:
175 ImageList
: TImageList
;
176 ilToolbar
: TImageList
;
177 OpenDialog
: TOpenDialog
;
178 SaveDialog
: TSaveDialog
;
179 selectall1
: TMenuItem
;
180 ColorDialog
: TColorDialog
;
182 procedure aAboutExecute(Sender
: TObject
);
183 procedure aCheckMapExecute(Sender
: TObject
);
184 procedure aMoveToFore(Sender
: TObject
);
185 procedure aMoveToBack(Sender
: TObject
);
186 procedure aCopyObjectExecute(Sender
: TObject
);
187 procedure aCutObjectExecute(Sender
: TObject
);
188 procedure aEditorOptionsExecute(Sender
: TObject
);
189 procedure aExitExecute(Sender
: TObject
);
190 procedure aMapOptionsExecute(Sender
: TObject
);
191 procedure aNewMapExecute(Sender
: TObject
);
192 procedure aOpenMapExecute(Sender
: TObject
);
193 procedure aOptimizeExecute(Sender
: TObject
);
194 procedure aPasteObjectExecute(Sender
: TObject
);
195 procedure aSelectAllExecute(Sender
: TObject
);
196 procedure aSaveMapExecute(Sender
: TObject
);
197 procedure aSaveMapAsExecute(Sender
: TObject
);
198 procedure aUndoExecute(Sender
: TObject
);
199 procedure aDeleteMap(Sender
: TObject
);
200 procedure bApplyPropertyClick(Sender
: TObject
);
201 procedure bbAddTextureClick(Sender
: TObject
);
202 procedure bbRemoveTextureClick(Sender
: TObject
);
203 procedure FormActivate(Sender
: TObject
);
204 procedure FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
205 procedure FormCreate(Sender
: TObject
);
206 procedure FormDestroy(Sender
: TObject
);
207 procedure FormDropFiles(Sender
: TObject
; const FileNames
: array of String);
208 procedure FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
209 procedure FormResize(Sender
: TObject
);
210 procedure lbTextureListClick(Sender
: TObject
);
211 procedure lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
212 ARect
: TRect
; State
: TOwnerDrawState
);
213 procedure RenderPanelMouseDown(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
214 procedure RenderPanelMouseMove(Sender
: TObject
; Shift
: TShiftState
; X
, Y
: Integer);
215 procedure RenderPanelMouseUp(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
216 procedure RenderPanelPaint(Sender
: TObject
);
217 procedure RenderPanelResize(Sender
: TObject
);
218 procedure Splitter1Moved(Sender
: TObject
);
219 procedure vleObjectPropertyEditButtonClick(Sender
: TObject
);
220 procedure vleObjectPropertyApply(Sender
: TObject
);
221 procedure vleObjectPropertyGetPickList(Sender
: TObject
; const KeyName
: String; Values
: TStrings
);
222 procedure vleObjectPropertyKeyDown(Sender
: TObject
; var Key
: Word;
224 procedure tbGridOnClick(Sender
: TObject
);
225 procedure miMapPreviewClick(Sender
: TObject
);
226 procedure miLayer1Click(Sender
: TObject
);
227 procedure miLayer2Click(Sender
: TObject
);
228 procedure miLayer3Click(Sender
: TObject
);
229 procedure miLayer4Click(Sender
: TObject
);
230 procedure miLayer5Click(Sender
: TObject
);
231 procedure miLayer6Click(Sender
: TObject
);
232 procedure miLayer7Click(Sender
: TObject
);
233 procedure miLayer8Click(Sender
: TObject
);
234 procedure miLayer9Click(Sender
: TObject
);
235 procedure tbShowClick(Sender
: TObject
);
236 procedure miSnapToGridClick(Sender
: TObject
);
237 procedure miMiniMapClick(Sender
: TObject
);
238 procedure miSwitchGridClick(Sender
: TObject
);
239 procedure miShowEdgesClick(Sender
: TObject
);
240 procedure minexttabClick(Sender
: TObject
);
241 procedure miSaveMiniMapClick(Sender
: TObject
);
242 procedure bClearTextureClick(Sender
: TObject
);
243 procedure miPackMapClick(Sender
: TObject
);
244 procedure aRecentFileExecute(Sender
: TObject
);
245 procedure miMapTestSettingsClick(Sender
: TObject
);
246 procedure miTestMapClick(Sender
: TObject
);
247 procedure sbVerticalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
248 var ScrollPos
: Integer);
249 procedure sbHorizontalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
250 var ScrollPos
: Integer);
251 procedure miOpenWadMapClick(Sender
: TObject
);
252 procedure selectall1Click(Sender
: TObject
);
253 procedure Splitter1CanResize(Sender
: TObject
; var NewSize
: Integer;
254 var Accept
: Boolean);
255 procedure Splitter2CanResize(Sender
: TObject
; var NewSize
: Integer;
256 var Accept
: Boolean);
257 procedure vleObjectPropertyEnter(Sender
: TObject
);
258 procedure vleObjectPropertyExit(Sender
: TObject
);
259 procedure FormKeyUp(Sender
: TObject
; var Key
: Word;
263 procedure OnIdle(Sender
: TObject
; var Done
: Boolean);
265 procedure RefreshRecentMenu();
266 procedure OpenMapFile(FileName
: String);
272 LAYER_FOREGROUND
= 2;
280 TEST_MAP_NAME
= '$$$_TEST_$$$';
281 LANGUAGE_FILE_NAME
= '_Editor.txt';
292 DotStepOne
, DotStepTwo
: Byte;
294 DrawTexturePanel
: Boolean;
295 DrawPanelSize
: Boolean;
297 PreviewColor
: TColor
;
298 UseCheckerboard
: Boolean;
300 RecentCount
: Integer;
301 RecentFiles
: TStringList
;
302 slInvalidTextures
: TStringList
;
304 TestGameMode
: String;
306 TestLimScore
: String;
307 TestOptionsTwoPlayers
: Boolean;
308 TestOptionsTeamDamage
: Boolean;
309 TestOptionsAllowExit
: Boolean;
310 TestOptionsWeaponStay
: Boolean;
311 TestOptionsMonstersDM
: Boolean;
313 TestMapOnce
: Boolean;
315 LayerEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
316 (True, True, True, True, True, True, True, True, True);
317 PreviewMode
: Byte = 0;
323 procedure OpenMap(FileName
: String; mapN
: String);
324 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
325 procedure RemoveSelectFromObjects();
326 procedure ChangeShownProperty(Name
: String; NewValue
: String);
331 f_options
, e_graphics
, e_log
, GL
, Math
,
332 f_mapoptions
, g_basic
, f_about
, f_mapoptimization
,
333 f_mapcheck
, f_addresource_texture
, g_textures
,
334 f_activationtype
, f_keys
,
335 MAPREADER
, f_selectmap
, f_savemap
, WADEDITOR
, WADSTRUCT
, MAPDEF
,
336 g_map
, f_saveminimap
, f_addresource
, CONFIG
, f_packmap
,
337 f_addresource_sound
, f_maptest
, f_choosetype
,
338 g_language
, f_selectlang
, ClipBrd
;
341 UNDO_DELETE_PANEL
= 1;
342 UNDO_DELETE_ITEM
= 2;
343 UNDO_DELETE_AREA
= 3;
344 UNDO_DELETE_MONSTER
= 4;
345 UNDO_DELETE_TRIGGER
= 5;
349 UNDO_ADD_MONSTER
= 9;
350 UNDO_ADD_TRIGGER
= 10;
351 UNDO_MOVE_PANEL
= 11;
354 UNDO_MOVE_MONSTER
= 14;
355 UNDO_MOVE_TRIGGER
= 15;
356 UNDO_RESIZE_PANEL
= 16;
357 UNDO_RESIZE_TRIGGER
= 17;
359 MOUSEACTION_NONE
= 0;
360 MOUSEACTION_DRAWPANEL
= 1;
361 MOUSEACTION_DRAWTRIGGER
= 2;
362 MOUSEACTION_MOVEOBJ
= 3;
363 MOUSEACTION_RESIZE
= 4;
364 MOUSEACTION_MOVEMAP
= 5;
365 MOUSEACTION_DRAWPRESS
= 6;
366 MOUSEACTION_NOACTION
= 7;
369 RESIZETYPE_VERTICAL
= 1;
370 RESIZETYPE_HORIZONTAL
= 2;
379 SELECTFLAG_TELEPORT
= 1;
381 SELECTFLAG_TEXTURE
= 3;
383 SELECTFLAG_MONSTER
= 5;
384 SELECTFLAG_SPAWNPOINT
= 6;
385 SELECTFLAG_SHOTPANEL
= 7;
386 SELECTFLAG_SELECTED
= 8;
388 RECENT_FILES_MENU_START
= 11;
390 CLIPBOARD_SIG
= 'DF:ED';
396 UNDO_DELETE_PANEL
: (Panel
: ^TPanel
);
397 UNDO_DELETE_ITEM
: (Item
: TItem
);
398 UNDO_DELETE_AREA
: (Area
: TArea
);
399 UNDO_DELETE_MONSTER
: (Monster
: TMonster
);
400 UNDO_DELETE_TRIGGER
: (Trigger
: TTrigger
);
405 UNDO_ADD_TRIGGER
: (AddID
: DWORD
);
410 UNDO_MOVE_TRIGGER
: (MoveID
: DWORD
; dX
, dY
: Integer);
412 UNDO_RESIZE_TRIGGER
: (ResizeID
: DWORD
; dW
, dH
: Integer);
419 OBJECT_PANEL
: (Panel
: ^TPanel
);
420 OBJECT_ITEM
: (Item
: TItem
);
421 OBJECT_AREA
: (Area
: TArea
);
422 OBJECT_MONSTER
: (Monster
: TMonster
);
423 OBJECT_TRIGGER
: (Trigger
: TTrigger
);
426 TCopyRecArray
= Array of TCopyRec
;
430 gDataLoaded
: Boolean = False;
431 ShowMap
: Boolean = False;
432 DrawRect
: PRect
= nil;
433 SnapToGrid
: Boolean = True;
435 MousePos
: Types
.TPoint
;
436 LastMovePoint
: Types
.TPoint
;
439 MouseLDownPos
: Types
.TPoint
;
440 MouseRDownPos
: Types
.TPoint
;
443 SelectFlag
: Byte = SELECTFLAG_NONE
;
444 MouseAction
: Byte = MOUSEACTION_NONE
;
445 ResizeType
: Byte = RESIZETYPE_NONE
;
446 ResizeDirection
: Byte = RESIZEDIR_NONE
;
448 DrawPressRect
: Boolean = False;
449 EditingProperties
: Boolean = False;
451 UndoBuffer
: Array of Array of TUndoRec
= nil;
456 //----------------------------------------
457 //Далее идут вспомогательные процедуры
458 //----------------------------------------
460 function NameToBool(Name
: String): Boolean;
462 if Name
= BoolNames
[True] then
468 function NameToDir(Name
: String): TDirection
;
470 if Name
= DirNames
[D_LEFT
] then
476 function NameToDirAdv(Name
: String): Byte;
478 if Name
= DirNamesAdv
[1] then
481 if Name
= DirNamesAdv
[2] then
484 if Name
= DirNamesAdv
[3] then
490 function ActivateToStr(ActivateType
: Byte): String;
494 if ByteBool(ACTIVATE_PLAYERCOLLIDE
and ActivateType
) then
495 Result
:= Result
+ '+PC';
496 if ByteBool(ACTIVATE_MONSTERCOLLIDE
and ActivateType
) then
497 Result
:= Result
+ '+MC';
498 if ByteBool(ACTIVATE_PLAYERPRESS
and ActivateType
) then
499 Result
:= Result
+ '+PP';
500 if ByteBool(ACTIVATE_MONSTERPRESS
and ActivateType
) then
501 Result
:= Result
+ '+MP';
502 if ByteBool(ACTIVATE_SHOT
and ActivateType
) then
503 Result
:= Result
+ '+SH';
504 if ByteBool(ACTIVATE_NOMONSTER
and ActivateType
) then
505 Result
:= Result
+ '+NM';
507 if (Result
<> '') and (Result
[1] = '+') then
508 Delete(Result
, 1, 1);
511 function StrToActivate(Str
: String): Byte;
515 if Pos('PC', Str
) > 0 then
516 Result
:= ACTIVATE_PLAYERCOLLIDE
;
517 if Pos('MC', Str
) > 0 then
518 Result
:= Result
or ACTIVATE_MONSTERCOLLIDE
;
519 if Pos('PP', Str
) > 0 then
520 Result
:= Result
or ACTIVATE_PLAYERPRESS
;
521 if Pos('MP', Str
) > 0 then
522 Result
:= Result
or ACTIVATE_MONSTERPRESS
;
523 if Pos('SH', Str
) > 0 then
524 Result
:= Result
or ACTIVATE_SHOT
;
525 if Pos('NM', Str
) > 0 then
526 Result
:= Result
or ACTIVATE_NOMONSTER
;
529 function KeyToStr(Key
: Byte): String;
533 if ByteBool(KEY_RED
and Key
) then
534 Result
:= Result
+ '+RK';
535 if ByteBool(KEY_GREEN
and Key
) then
536 Result
:= Result
+ '+GK';
537 if ByteBool(KEY_BLUE
and Key
) then
538 Result
:= Result
+ '+BK';
539 if ByteBool(KEY_REDTEAM
and Key
) then
540 Result
:= Result
+ '+RT';
541 if ByteBool(KEY_BLUETEAM
and Key
) then
542 Result
:= Result
+ '+BT';
544 if (Result
<> '') and (Result
[1] = '+') then
545 Delete(Result
, 1, 1);
548 function StrToKey(Str
: String): Byte;
552 if Pos('RK', Str
) > 0 then
554 if Pos('GK', Str
) > 0 then
555 Result
:= Result
or KEY_GREEN
;
556 if Pos('BK', Str
) > 0 then
557 Result
:= Result
or KEY_BLUE
;
558 if Pos('RT', Str
) > 0 then
559 Result
:= Result
or KEY_REDTEAM
;
560 if Pos('BT', Str
) > 0 then
561 Result
:= Result
or KEY_BLUETEAM
;
564 function EffectToStr(Effect
: Byte): String;
566 if Effect
in [EFFECT_TELEPORT
..EFFECT_FIRE
] then
567 Result
:= EffectNames
[Effect
]
569 Result
:= EffectNames
[EFFECT_NONE
];
572 function StrToEffect(Str
: String): Byte;
576 Result
:= EFFECT_NONE
;
577 for i
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
578 if EffectNames
[i
] = Str
then
585 function MonsterToStr(MonType
: Byte): String;
587 if MonType
in [MONSTER_DEMON
..MONSTER_MAN
] then
588 Result
:= MonsterNames
[MonType
]
590 Result
:= MonsterNames
[MONSTER_ZOMBY
];
593 function StrToMonster(Str
: String): Byte;
597 Result
:= MONSTER_ZOMBY
;
598 for i
:= MONSTER_DEMON
to MONSTER_MAN
do
599 if MonsterNames
[i
] = Str
then
606 function ItemToStr(ItemType
: Byte): String;
608 if ItemType
in [ITEM_MEDKIT_SMALL
..ITEM_MAX
] then
609 Result
:= ItemNames
[ItemType
]
611 Result
:= ItemNames
[ITEM_AMMO_BULLETS
];
614 function StrToItem(Str
: String): Byte;
618 Result
:= ITEM_AMMO_BULLETS
;
619 for i
:= ITEM_MEDKIT_SMALL
to ITEM_MAX
do
620 if ItemNames
[i
] = Str
then
627 function ShotToStr(ShotType
: Byte): String;
629 if ShotType
in [TRIGGER_SHOT_PISTOL
..TRIGGER_SHOT_MAX
] then
630 Result
:= ShotNames
[ShotType
]
632 Result
:= ShotNames
[TRIGGER_SHOT_PISTOL
];
635 function StrToShot(Str
: String): Byte;
639 Result
:= TRIGGER_SHOT_PISTOL
;
640 for i
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
641 if ShotNames
[i
] = Str
then
648 function SelectedObjectCount(): Word;
654 if SelectedObjects
= nil then
657 for a
:= 0 to High(SelectedObjects
) do
658 if SelectedObjects
[a
].Live
then
659 Result
:= Result
+ 1;
662 function GetFirstSelected(): Integer;
668 if SelectedObjects
= nil then
671 for a
:= 0 to High(SelectedObjects
) do
672 if SelectedObjects
[a
].Live
then
679 function Normalize16(x
: Integer): Integer;
681 Result
:= (x
div 16) * 16;
684 procedure MoveMap(X
, Y
: Integer);
686 rx
, ry
, ScaleSz
: Integer;
688 with MainForm
.RenderPanel
do
690 ScaleSz
:= 16 div Scale
;
691 // Размер видимой части карты:
692 rx
:= min(Normalize16(Width
), Normalize16(gMapInfo
.Width
)) div 2;
693 ry
:= min(Normalize16(Height
), Normalize16(gMapInfo
.Height
)) div 2;
694 // Место клика на мини-карте:
695 MapOffset
.X
:= X
- (Width
-max(gMapInfo
.Width
div ScaleSz
, 1)-1);
696 MapOffset
.Y
:= Y
- 1;
697 // Это же место на "большой" карте:
698 MapOffset
.X
:= MapOffset
.X
* ScaleSz
;
699 MapOffset
.Y
:= MapOffset
.Y
* ScaleSz
;
700 // Левый верхний угол новой видимой части карты:
701 MapOffset
.X
:= MapOffset
.X
- rx
;
702 MapOffset
.Y
:= MapOffset
.Y
- ry
;
704 if MapOffset
.X
< 0 then
706 if MapOffset
.Y
< 0 then
708 if MapOffset
.X
> MainForm
.sbHorizontal
.Max
then
709 MapOffset
.X
:= MainForm
.sbHorizontal
.Max
;
710 if MapOffset
.Y
> MainForm
.sbVertical
.Max
then
711 MapOffset
.Y
:= MainForm
.sbVertical
.Max
;
713 MapOffset
.X
:= Normalize16(MapOffset
.X
);
714 MapOffset
.Y
:= Normalize16(MapOffset
.Y
);
717 MainForm
.sbHorizontal
.Position
:= MapOffset
.X
;
718 MainForm
.sbVertical
.Position
:= MapOffset
.Y
;
720 MapOffset
.X
:= -MapOffset
.X
;
721 MapOffset
.Y
:= -MapOffset
.Y
;
726 function IsTexturedPanel(PanelType
: Word): Boolean;
728 Result
:= WordBool(PanelType
and (PANEL_WALL
or PANEL_BACK
or PANEL_FORE
or
729 PANEL_STEP
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
or
730 PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
));
733 procedure FillProperty();
738 MainForm
.vleObjectProperty
.Strings
.Clear();
740 // Отображаем свойства если выделен только один объект:
741 if SelectedObjectCount() <> 1 then
744 _id
:= GetFirstSelected();
745 if not SelectedObjects
[_id
].Live
then
748 with MainForm
.vleObjectProperty
do
749 with ItemProps
[InsertRow(_lc
[I_PROP_ID
], IntToStr(SelectedObjects
[_id
].ID
), True)] do
751 EditStyle
:= esSimple
;
755 case SelectedObjects
[0].ObjectType
of
758 with MainForm
.vleObjectProperty
,
759 gPanels
[SelectedObjects
[_id
].ID
] do
761 with ItemProps
[InsertRow(_lc
[I_PROP_X
], IntToStr(X
), True)] do
763 EditStyle
:= esSimple
;
767 with ItemProps
[InsertRow(_lc
[I_PROP_Y
], IntToStr(Y
), True)] do
769 EditStyle
:= esSimple
;
773 with ItemProps
[InsertRow(_lc
[I_PROP_WIDTH
], IntToStr(Width
), True)] do
775 EditStyle
:= esSimple
;
779 with ItemProps
[InsertRow(_lc
[I_PROP_HEIGHT
], IntToStr(Height
), True)] do
781 EditStyle
:= esSimple
;
785 with ItemProps
[InsertRow(_lc
[I_PROP_PANEL_TYPE
], GetPanelName(PanelType
), True)] do
787 EditStyle
:= esEllipsis
;
791 if IsTexturedPanel(PanelType
) then
792 begin // Может быть текстура
793 with ItemProps
[InsertRow(_lc
[I_PROP_PANEL_TEX
], TextureName
, True)] do
795 EditStyle
:= esEllipsis
;
799 if TextureName
<> '' then
800 begin // Есть текстура
801 with ItemProps
[InsertRow(_lc
[I_PROP_PANEL_ALPHA
], IntToStr(Alpha
), True)] do
803 EditStyle
:= esSimple
;
807 with ItemProps
[InsertRow(_lc
[I_PROP_PANEL_BLEND
], BoolNames
[Blending
], True)] do
809 EditStyle
:= esPickList
;
819 with MainForm
.vleObjectProperty
,
820 gItems
[SelectedObjects
[_id
].ID
] do
822 with ItemProps
[InsertRow(_lc
[I_PROP_X
], IntToStr(X
), True)] do
824 EditStyle
:= esSimple
;
828 with ItemProps
[InsertRow(_lc
[I_PROP_Y
], IntToStr(Y
), True)] do
830 EditStyle
:= esSimple
;
834 with ItemProps
[InsertRow(_lc
[I_PROP_DM_ONLY
], BoolNames
[OnlyDM
], True)] do
836 EditStyle
:= esPickList
;
840 with ItemProps
[InsertRow(_lc
[I_PROP_ITEM_FALLS
], BoolNames
[Fall
], True)] do
842 EditStyle
:= esPickList
;
850 with MainForm
.vleObjectProperty
,
851 gMonsters
[SelectedObjects
[_id
].ID
] do
853 with ItemProps
[InsertRow(_lc
[I_PROP_X
], IntToStr(X
), True)] do
855 EditStyle
:= esSimple
;
859 with ItemProps
[InsertRow(_lc
[I_PROP_Y
], IntToStr(Y
), True)] do
861 EditStyle
:= esSimple
;
865 with ItemProps
[InsertRow(_lc
[I_PROP_DIRECTION
], DirNames
[Direction
], True)] do
867 EditStyle
:= esPickList
;
875 with MainForm
.vleObjectProperty
,
876 gAreas
[SelectedObjects
[_id
].ID
] do
878 with ItemProps
[InsertRow(_lc
[I_PROP_X
], IntToStr(X
), True)] do
880 EditStyle
:= esSimple
;
884 with ItemProps
[InsertRow(_lc
[I_PROP_Y
], IntToStr(Y
), True)] do
886 EditStyle
:= esSimple
;
890 with ItemProps
[InsertRow(_lc
[I_PROP_DIRECTION
], DirNames
[Direction
], True)] do
892 EditStyle
:= esPickList
;
900 with MainForm
.vleObjectProperty
,
901 gTriggers
[SelectedObjects
[_id
].ID
] do
903 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TYPE
], GetTriggerName(TriggerType
), True)] do
905 EditStyle
:= esSimple
;
909 with ItemProps
[InsertRow(_lc
[I_PROP_X
], IntToStr(X
), True)] do
911 EditStyle
:= esSimple
;
915 with ItemProps
[InsertRow(_lc
[I_PROP_Y
], IntToStr(Y
), True)] do
917 EditStyle
:= esSimple
;
921 with ItemProps
[InsertRow(_lc
[I_PROP_WIDTH
], IntToStr(Width
), True)] do
923 EditStyle
:= esSimple
;
927 with ItemProps
[InsertRow(_lc
[I_PROP_HEIGHT
], IntToStr(Height
), True)] do
929 EditStyle
:= esSimple
;
933 with ItemProps
[InsertRow(_lc
[I_PROP_TR_ENABLED
], BoolNames
[Enabled
], True)] do
935 EditStyle
:= esPickList
;
939 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TEXTURE_PANEL
], IntToStr(TexturePanel
), True)] do
941 EditStyle
:= esEllipsis
;
945 with ItemProps
[InsertRow(_lc
[I_PROP_TR_ACTIVATION
], ActivateToStr(ActivateType
), True)] do
947 EditStyle
:= esEllipsis
;
951 with ItemProps
[InsertRow(_lc
[I_PROP_TR_KEYS
], KeyToStr(Key
), True)] do
953 EditStyle
:= esEllipsis
;
960 str
:= win2utf(Data
.MapName
);
961 with ItemProps
[InsertRow(_lc
[I_PROP_TR_NEXT_MAP
], str
, True)] do
963 EditStyle
:= esEllipsis
;
970 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TELEPORT_TO
], Format('(%d:%d)', [Data
.TargetPoint
.X
, Data
.TargetPoint
.Y
]), True)] do
972 EditStyle
:= esEllipsis
;
976 with ItemProps
[InsertRow(_lc
[I_PROP_TR_D2D
], BoolNames
[Data
.d2d_teleport
], True)] do
978 EditStyle
:= esPickList
;
982 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TELEPORT_SILENT
], BoolNames
[Data
.silent_teleport
], True)] do
984 EditStyle
:= esPickList
;
988 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TELEPORT_DIR
], DirNamesAdv
[Data
.TlpDir
], True)] do
990 EditStyle
:= esPickList
;
995 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
,
996 TRIGGER_DOOR
, TRIGGER_DOOR5
:
998 with ItemProps
[InsertRow(_lc
[I_PROP_TR_DOOR_PANEL
], IntToStr(Data
.PanelID
), True)] do
1000 EditStyle
:= esEllipsis
;
1004 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SILENT
], BoolNames
[Data
.NoSound
], True)] do
1006 EditStyle
:= esPickList
;
1010 with ItemProps
[InsertRow(_lc
[I_PROP_TR_D2D
], BoolNames
[Data
.d2d_doors
], True)] do
1012 EditStyle
:= esPickList
;
1017 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
:
1019 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TRAP_PANEL
], IntToStr(Data
.PanelID
), True)] do
1021 EditStyle
:= esEllipsis
;
1025 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SILENT
], BoolNames
[Data
.NoSound
], True)] do
1027 EditStyle
:= esPickList
;
1031 with ItemProps
[InsertRow(_lc
[I_PROP_TR_D2D
], BoolNames
[Data
.d2d_doors
], True)] do
1033 EditStyle
:= esPickList
;
1038 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
1041 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_AREA
],
1042 Format('(%d:%d %d:%d)', [Data
.tX
, Data
.tY
, Data
.tWidth
, Data
.tHeight
]), True)] do
1044 EditStyle
:= esEllipsis
;
1048 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_DELAY
], IntToStr(Data
.Wait
), True)] do
1050 EditStyle
:= esSimple
;
1054 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_COUNT
], IntToStr(Data
.Count
), True)] do
1056 EditStyle
:= esSimple
;
1060 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_MONSTER
], IntToStr(Data
.MonsterID
-1), True)] do
1062 EditStyle
:= esEllipsis
;
1066 if TriggerType
= TRIGGER_PRESS
then
1067 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_RANDOM
], BoolNames
[Data
.ExtRandom
], True)] do
1069 EditStyle
:= esPickList
;
1077 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
1079 with ItemProps
[InsertRow(_lc
[I_PROP_TR_LIFT_PANEL
], IntToStr(Data
.PanelID
), True)] do
1081 EditStyle
:= esEllipsis
;
1085 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SILENT
], BoolNames
[Data
.NoSound
], True)] do
1087 EditStyle
:= esPickList
;
1091 with ItemProps
[InsertRow(_lc
[I_PROP_TR_D2D
], BoolNames
[Data
.d2d_doors
], True)] do
1093 EditStyle
:= esPickList
;
1100 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TEXTURE_ONCE
], BoolNames
[Data
.ActivateOnce
], True)] do
1102 EditStyle
:= esPickList
;
1106 with ItemProps
[InsertRow(_lc
[I_PROP_TR_TEXTURE_ANIM_ONCE
], BoolNames
[Data
.AnimOnce
], True)] do
1108 EditStyle
:= esPickList
;
1115 str
:= win2utf(Data
.SoundName
);
1116 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_NAME
], str
, True)] do
1118 EditStyle
:= esEllipsis
;
1122 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_VOLUME
], IntToStr(Data
.Volume
), True)] do
1124 EditStyle
:= esSimple
;
1128 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_PAN
], IntToStr(Data
.Pan
), True)] do
1130 EditStyle
:= esSimple
;
1134 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_COUNT
], IntToStr(Data
.PlayCount
), True)] do
1136 EditStyle
:= esSimple
;
1140 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_LOCAL
], BoolNames
[Data
.Local
], True)] do
1142 EditStyle
:= esPickList
;
1146 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SOUND_SWITCH
], BoolNames
[Data
.SoundSwitch
], True)] do
1148 EditStyle
:= esPickList
;
1153 TRIGGER_SPAWNMONSTER
:
1155 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MONSTER_TYPE
], MonsterToStr(Data
.MonType
), True)] do
1157 EditStyle
:= esEllipsis
;
1161 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_TO
],
1162 Format('(%d:%d)', [Data
.MonPos
.X
, Data
.MonPos
.Y
]), True)] do
1164 EditStyle
:= esEllipsis
;
1168 with ItemProps
[InsertRow(_lc
[I_PROP_DIRECTION
], DirNames
[TDirection(Data
.MonDir
)], True)] do
1170 EditStyle
:= esPickList
;
1174 with ItemProps
[InsertRow(_lc
[I_PROP_TR_HEALTH
], IntToStr(Data
.MonHealth
), True)] do
1176 EditStyle
:= esSimple
;
1180 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MONSTER_ACTIVE
], BoolNames
[Data
.MonActive
], True)] do
1182 EditStyle
:= esPickList
;
1186 with ItemProps
[InsertRow(_lc
[I_PROP_TR_COUNT
], IntToStr(Data
.MonCount
), True)] do
1188 EditStyle
:= esSimple
;
1192 with ItemProps
[InsertRow(_lc
[I_PROP_TR_FX_TYPE
], EffectToStr(Data
.MonEffect
), True)] do
1194 EditStyle
:= esEllipsis
;
1198 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_MAX
], IntToStr(Data
.MonMax
), True)] do
1200 EditStyle
:= esSimple
;
1204 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_DELAY
], IntToStr(Data
.MonDelay
), True)] do
1206 EditStyle
:= esSimple
;
1210 case Data
.MonBehav
of
1211 1: str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_1
];
1212 2: str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_2
];
1213 3: str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_3
];
1214 4: str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_4
];
1215 5: str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_5
];
1216 else str
:= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_0
];
1218 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
], str
, True)] do
1220 EditStyle
:= esPickList
;
1227 with ItemProps
[InsertRow(_lc
[I_PROP_TR_ITEM_TYPE
], ItemToStr(Data
.ItemType
), True)] do
1229 EditStyle
:= esEllipsis
;
1233 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_TO
],
1234 Format('(%d:%d)', [Data
.ItemPos
.X
, Data
.ItemPos
.Y
]), True)] do
1236 EditStyle
:= esEllipsis
;
1240 with ItemProps
[InsertRow(_lc
[I_PROP_DM_ONLY
], BoolNames
[Data
.ItemOnlyDM
], True)] do
1242 EditStyle
:= esPickList
;
1246 with ItemProps
[InsertRow(_lc
[I_PROP_ITEM_FALLS
], BoolNames
[Data
.ItemFalls
], True)] do
1248 EditStyle
:= esPickList
;
1252 with ItemProps
[InsertRow(_lc
[I_PROP_TR_COUNT
], IntToStr(Data
.ItemCount
), True)] do
1254 EditStyle
:= esSimple
;
1258 with ItemProps
[InsertRow(_lc
[I_PROP_TR_FX_TYPE
], EffectToStr(Data
.ItemEffect
), True)] do
1260 EditStyle
:= esEllipsis
;
1264 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_MAX
], IntToStr(Data
.ItemMax
), True)] do
1266 EditStyle
:= esSimple
;
1270 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_DELAY
], IntToStr(Data
.ItemDelay
), True)] do
1272 EditStyle
:= esSimple
;
1279 str
:= win2utf(Data
.MusicName
);
1280 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MUSIC_NAME
], str
, True)] do
1282 EditStyle
:= esEllipsis
;
1286 if Data
.MusicAction
= 1 then
1287 str
:= _lc
[I_PROP_TR_MUSIC_ON
]
1289 str
:= _lc
[I_PROP_TR_MUSIC_OFF
];
1291 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MUSIC_ACT
], str
, True)] do
1293 EditStyle
:= esPickList
;
1300 with ItemProps
[InsertRow(_lc
[I_PROP_TR_PUSH_ANGLE
], IntToStr(Data
.PushAngle
), True)] do
1302 EditStyle
:= esSimple
;
1305 with ItemProps
[InsertRow(_lc
[I_PROP_TR_PUSH_FORCE
], IntToStr(Data
.PushForce
), True)] do
1307 EditStyle
:= esSimple
;
1310 with ItemProps
[InsertRow(_lc
[I_PROP_TR_PUSH_RESET
], BoolNames
[Data
.ResetVel
], True)] do
1312 EditStyle
:= esPickList
;
1319 case Data
.ScoreAction
of
1320 1: str
:= _lc
[I_PROP_TR_SCORE_ACT_1
];
1321 2: str
:= _lc
[I_PROP_TR_SCORE_ACT_2
];
1322 3: str
:= _lc
[I_PROP_TR_SCORE_ACT_3
];
1323 else str
:= _lc
[I_PROP_TR_SCORE_ACT_0
];
1325 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SCORE_ACT
], str
, True)] do
1327 EditStyle
:= esPickList
;
1330 with ItemProps
[InsertRow(_lc
[I_PROP_TR_COUNT
], IntToStr(Data
.ScoreCount
), True)] do
1332 EditStyle
:= esSimple
;
1335 case Data
.ScoreTeam
of
1336 1: str
:= _lc
[I_PROP_TR_SCORE_TEAM_1
];
1337 2: str
:= _lc
[I_PROP_TR_SCORE_TEAM_2
];
1338 3: str
:= _lc
[I_PROP_TR_SCORE_TEAM_3
];
1339 else str
:= _lc
[I_PROP_TR_SCORE_TEAM_0
];
1341 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SCORE_TEAM
], str
, True)] do
1343 EditStyle
:= esPickList
;
1346 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SCORE_CON
], BoolNames
[Data
.ScoreCon
], True)] do
1348 EditStyle
:= esPickList
;
1351 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SCORE_MSG
], BoolNames
[Data
.ScoreMsg
], True)] do
1353 EditStyle
:= esPickList
;
1360 case Data
.MessageKind
of
1361 1: str
:= _lc
[I_PROP_TR_MESSAGE_KIND_1
];
1362 else str
:= _lc
[I_PROP_TR_MESSAGE_KIND_0
];
1364 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MESSAGE_KIND
], str
, True)] do
1366 EditStyle
:= esPickList
;
1369 case Data
.MessageSendTo
of
1370 1: str
:= _lc
[I_PROP_TR_MESSAGE_TO_1
];
1371 2: str
:= _lc
[I_PROP_TR_MESSAGE_TO_2
];
1372 3: str
:= _lc
[I_PROP_TR_MESSAGE_TO_3
];
1373 4: str
:= _lc
[I_PROP_TR_MESSAGE_TO_4
];
1374 5: str
:= _lc
[I_PROP_TR_MESSAGE_TO_5
];
1375 else str
:= _lc
[I_PROP_TR_MESSAGE_TO_0
];
1377 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MESSAGE_TO
], str
, True)] do
1379 EditStyle
:= esPickList
;
1382 str
:= win2utf(Data
.MessageText
);
1383 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MESSAGE_TEXT
], str
, True)] do
1385 EditStyle
:= esSimple
;
1388 with ItemProps
[InsertRow(_lc
[I_PROP_TR_MESSAGE_TIME
], IntToStr(Data
.MessageTime
), True)] do
1390 EditStyle
:= esSimple
;
1397 with ItemProps
[InsertRow(_lc
[I_PROP_TR_DAMAGE_VALUE
], IntToStr(Data
.DamageValue
), True)] do
1399 EditStyle
:= esSimple
;
1402 with ItemProps
[InsertRow(_lc
[I_PROP_TR_INTERVAL
], IntToStr(Data
.DamageInterval
), True)] do
1404 EditStyle
:= esSimple
;
1411 with ItemProps
[InsertRow(_lc
[I_PROP_TR_HEALTH
], IntToStr(Data
.HealValue
), True)] do
1413 EditStyle
:= esSimple
;
1416 with ItemProps
[InsertRow(_lc
[I_PROP_TR_INTERVAL
], IntToStr(Data
.HealInterval
), True)] do
1418 EditStyle
:= esSimple
;
1421 with ItemProps
[InsertRow(_lc
[I_PROP_TR_HEALTH_MAX
], BoolNames
[Data
.HealMax
], True)] do
1423 EditStyle
:= esPickList
;
1426 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SILENT
], BoolNames
[Data
.HealSilent
], True)] do
1428 EditStyle
:= esPickList
;
1435 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_TYPE
], ShotToStr(Data
.ShotType
), True)] do
1437 EditStyle
:= esEllipsis
;
1441 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_SOUND
], BoolNames
[Data
.ShotSound
], True)] do
1443 EditStyle
:= esPickList
;
1447 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_PANEL
], IntToStr(Data
.ShotPanelID
), True)] do
1449 EditStyle
:= esEllipsis
;
1453 case Data
.ShotTarget
of
1454 1: str
:= _lc
[I_PROP_TR_SHOT_TO_1
];
1455 2: str
:= _lc
[I_PROP_TR_SHOT_TO_2
];
1456 3: str
:= _lc
[I_PROP_TR_SHOT_TO_3
];
1457 4: str
:= _lc
[I_PROP_TR_SHOT_TO_4
];
1458 5: str
:= _lc
[I_PROP_TR_SHOT_TO_5
];
1459 6: str
:= _lc
[I_PROP_TR_SHOT_TO_6
];
1460 else str
:= _lc
[I_PROP_TR_SHOT_TO_0
];
1462 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_TO
], str
, True)] do
1464 EditStyle
:= esPickList
;
1468 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_SIGHT
], IntToStr(Data
.ShotIntSight
), True)] do
1470 EditStyle
:= esSimple
;
1474 case Data
.ShotAim
of
1475 1: str
:= _lc
[I_PROP_TR_SHOT_AIM_1
];
1476 2: str
:= _lc
[I_PROP_TR_SHOT_AIM_2
];
1477 3: str
:= _lc
[I_PROP_TR_SHOT_AIM_3
];
1478 else str
:= _lc
[I_PROP_TR_SHOT_AIM_0
];
1480 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_AIM
], str
, True)-1] do
1482 EditStyle
:= esPickList
;
1486 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_TO
],
1487 Format('(%d:%d)', [Data
.ShotPos
.X
, Data
.ShotPos
.Y
]), True)] do
1489 EditStyle
:= esEllipsis
;
1493 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_ANGLE
], IntToStr(Data
.ShotAngle
), True)] do
1495 EditStyle
:= esSimple
;
1499 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_DELAY
], IntToStr(Data
.ShotWait
), True)] do
1501 EditStyle
:= esSimple
;
1505 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_ACC
], IntToStr(Data
.ShotAccuracy
), True)] do
1507 EditStyle
:= esSimple
;
1511 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_AMMO
], IntToStr(Data
.ShotAmmo
), True)] do
1513 EditStyle
:= esSimple
;
1517 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_RELOAD
], IntToStr(Data
.ShotIntReload
), True)] do
1519 EditStyle
:= esSimple
;
1526 with ItemProps
[InsertRow(_lc
[I_PROP_TR_COUNT
], IntToStr(Data
.FXCount
), True)] do
1528 EditStyle
:= esSimple
;
1532 if Data
.FXType
= 0 then
1533 str
:= _lc
[I_PROP_TR_EFFECT_PARTICLE
]
1535 str
:= _lc
[I_PROP_TR_EFFECT_ANIMATION
];
1536 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_TYPE
], str
, True)] do
1538 EditStyle
:= esEllipsis
;
1543 if Data
.FXType
= 0 then
1544 case Data
.FXSubType
of
1545 TRIGGER_EFFECT_SLIQUID
:
1546 str
:= _lc
[I_PROP_TR_EFFECT_SLIQUID
];
1547 TRIGGER_EFFECT_LLIQUID
:
1548 str
:= _lc
[I_PROP_TR_EFFECT_LLIQUID
];
1549 TRIGGER_EFFECT_DLIQUID
:
1550 str
:= _lc
[I_PROP_TR_EFFECT_DLIQUID
];
1551 TRIGGER_EFFECT_BLOOD
:
1552 str
:= _lc
[I_PROP_TR_EFFECT_BLOOD
];
1553 TRIGGER_EFFECT_SPARK
:
1554 str
:= _lc
[I_PROP_TR_EFFECT_SPARK
];
1555 TRIGGER_EFFECT_BUBBLE
:
1556 str
:= _lc
[I_PROP_TR_EFFECT_BUBBLE
];
1558 if Data
.FXType
= 1 then
1560 if (Data
.FXSubType
= 0) or (Data
.FXSubType
> EFFECT_FIRE
) then
1561 Data
.FXSubType
:= EFFECT_TELEPORT
;
1562 str
:= EffectToStr(Data
.FXSubType
);
1564 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SUBTYPE
], str
, True)] do
1566 EditStyle
:= esEllipsis
;
1570 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_COLOR
], IntToStr(Data
.FXColorR
or (Data
.FXColorG
shl 8) or (Data
.FXColorB
shl 16)), True)] do
1572 EditStyle
:= esEllipsis
;
1576 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_CENTER
], BoolNames
[Data
.FXPos
= 0], True)] do
1578 EditStyle
:= esPickList
;
1582 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_DELAY
], IntToStr(Data
.FXWait
), True)] do
1584 EditStyle
:= esSimple
;
1588 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_VELX
], IntToStr(Data
.FXVelX
), True)] do
1590 EditStyle
:= esSimple
;
1594 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_VELY
], IntToStr(Data
.FXVelY
), True)] do
1596 EditStyle
:= esSimple
;
1600 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPL
], IntToStr(Data
.FXSpreadL
), True)] do
1602 EditStyle
:= esSimple
;
1606 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPR
], IntToStr(Data
.FXSpreadR
), True)] do
1608 EditStyle
:= esSimple
;
1612 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPU
], IntToStr(Data
.FXSpreadU
), True)] do
1614 EditStyle
:= esSimple
;
1618 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPD
], IntToStr(Data
.FXSpreadD
), True)] do
1620 EditStyle
:= esSimple
;
1624 end; //case TriggerType
1626 end; // OBJECT_TRIGGER:
1630 procedure ChangeShownProperty(Name
: String; NewValue
: String);
1634 if SelectedObjectCount() <> 1 then
1636 if not SelectedObjects
[GetFirstSelected()].Live
then
1639 // Есть ли такой ключ:
1640 if MainForm
.vleObjectProperty
.FindRow(Name
, row
) then
1642 MainForm
.vleObjectProperty
.Values
[Name
] := NewValue
;
1646 procedure SelectObject(fObjectType
: Byte; fID
: DWORD
; Multi
: Boolean);
1655 // Уже выделен - убираем:
1656 if SelectedObjects
<> nil then
1657 for a
:= 0 to High(SelectedObjects
) do
1658 with SelectedObjects
[a
] do
1659 if Live
and (ID
= fID
) and
1660 (ObjectType
= fObjectType
) then
1669 SetLength(SelectedObjects
, Length(SelectedObjects
)+1);
1671 with SelectedObjects
[High(SelectedObjects
)] do
1673 ObjectType
:= fObjectType
;
1680 SetLength(SelectedObjects
, 1);
1682 with SelectedObjects
[0] do
1684 ObjectType
:= fObjectType
;
1690 MainForm
.miCopy
.Enabled
:= True;
1691 MainForm
.miCut
.Enabled
:= True;
1693 if fObjectType
= OBJECT_PANEL
then
1695 MainForm
.miToFore
.Enabled
:= True;
1696 MainForm
.miToBack
.Enabled
:= True;
1700 procedure RemoveSelectFromObjects();
1702 SelectedObjects
:= nil;
1703 DrawPressRect
:= False;
1704 MouseLDown
:= False;
1705 MouseRDown
:= False;
1706 MouseAction
:= MOUSEACTION_NONE
;
1707 SelectFlag
:= SELECTFLAG_NONE
;
1708 ResizeType
:= RESIZETYPE_NONE
;
1709 ResizeDirection
:= RESIZEDIR_NONE
;
1711 MainForm
.vleObjectProperty
.Strings
.Clear();
1713 MainForm
.miCopy
.Enabled
:= False;
1714 MainForm
.miCut
.Enabled
:= False;
1715 MainForm
.miToFore
.Enabled
:= False;
1716 MainForm
.miToBack
.Enabled
:= False;
1719 procedure DeleteSelectedObjects();
1724 if SelectedObjects
= nil then
1730 for a
:= 0 to High(SelectedObjects
) do
1731 with SelectedObjects
[a
] do
1736 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1737 i
:= High(UndoBuffer
);
1741 SetLength(UndoBuffer
[i
], Length(UndoBuffer
[i
])+1);
1742 ii
:= High(UndoBuffer
[i
]);
1747 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_PANEL
;
1748 New(UndoBuffer
[i
, ii
].Panel
);
1749 UndoBuffer
[i
, ii
].Panel
^ := gPanels
[ID
];
1753 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_ITEM
;
1754 UndoBuffer
[i
, ii
].Item
:= gItems
[ID
];
1758 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_AREA
;
1759 UndoBuffer
[i
, ii
].Area
:= gAreas
[ID
];
1763 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_TRIGGER
;
1764 UndoBuffer
[i
, ii
].Trigger
:= gTriggers
[ID
];
1768 RemoveObject(ID
, ObjectType
);
1771 RemoveSelectFromObjects();
1773 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1776 procedure Undo_Add(ObjectType
: Byte; ID
: DWORD
; Group
: Boolean = False);
1780 if (not Group
) or (Length(UndoBuffer
) = 0) then
1781 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1782 SetLength(UndoBuffer
[High(UndoBuffer
)], Length(UndoBuffer
[High(UndoBuffer
)])+1);
1783 i
:= High(UndoBuffer
);
1784 ii
:= High(UndoBuffer
[i
]);
1788 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_PANEL
;
1790 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_ITEM
;
1792 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_MONSTER
;
1794 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_AREA
;
1796 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_TRIGGER
;
1799 UndoBuffer
[i
, ii
].AddID
:= ID
;
1801 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1804 procedure FullClear();
1806 RemoveSelectFromObjects();
1808 LoadSky(gMapInfo
.SkyName
);
1810 slInvalidTextures
.Clear();
1811 MapCheckForm
.lbErrorList
.Clear();
1812 MapCheckForm
.mErrorDescription
.Clear();
1814 MainForm
.miUndo
.Enabled
:= False;
1815 MainForm
.sbHorizontal
.Position
:= 0;
1816 MainForm
.sbVertical
.Position
:= 0;
1817 MainForm
.FormResize(nil);
1818 MainForm
.Caption
:= FormCaption
;
1823 procedure ErrorMessageBox(str
: String);
1825 MessageBox(0, PChar(str
), PChar(_lc
[I_MSG_ERROR
]),
1826 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
1829 function CheckProperty(): Boolean;
1835 _id
:= GetFirstSelected();
1837 if SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
then
1838 with gPanels
[SelectedObjects
[_id
].ID
] do
1840 if TextureWidth
<> 0 then
1841 if StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]], 1) mod TextureWidth
<> 0 then
1843 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXWIDTH
],
1848 if TextureHeight
<> 0 then
1849 if StrToIntDef(Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]), 1) mod TextureHeight
<> 0 then
1851 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXHEIGHT
],
1856 if IsTexturedPanel(PanelType
) and (TextureName
<> '') then
1857 if not (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_ALPHA
]], -1) in [0..255]) then
1859 ErrorMessageBox(_lc
[I_MSG_WRONG_ALPHA
]);
1864 if SelectedObjects
[_id
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
1865 if (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]], 0) <= 0) or
1866 (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]], 0) <= 0) then
1868 ErrorMessageBox(_lc
[I_MSG_WRONG_SIZE
]);
1872 if (Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_X
]]) = '') or
1873 (Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]) = '') then
1875 ErrorMessageBox(_lc
[I_MSG_WRONG_XY
]);
1882 procedure SelectTexture(ID
: Integer);
1884 MainForm
.lbTextureList
.ItemIndex
:= ID
;
1885 MainForm
.lbTextureListClick(nil);
1888 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
1890 a
, FrameLen
: Integer;
1893 ResourceName
: String;
1894 FullResourceName
: String;
1895 SectionName
: String;
1897 Width
, Height
: Word;
1905 if aSection
= '..' then
1908 SectionName
:= aSection
;
1911 aWAD
:= _lc
[I_WAD_SPECIAL_MAP
];
1913 if aWAD
= _lc
[I_WAD_SPECIAL_MAP
] then
1915 g_ProcessResourceStr(OpenedMap
, @fn
, nil, nil);
1916 //FileName := EditorDir+'maps\'+ExtractFileName(fn);
1918 ResourceName
:= ':'+SectionName
+'\'+aTex
;
1921 if aWAD
= _lc
[I_WAD_SPECIAL_TEXS
] then
1922 begin // Спец. текстуры
1924 ResourceName
:= aTex
;
1927 begin // Внешний WAD
1928 FileName
:= EditorDir
+'wads/'+aWAD
;
1929 ResourceName
:= aWAD
+':'+SectionName
+'\'+aTex
;
1934 // Есть ли уже такая текстура:
1935 for a
:= 0 to MainForm
.lbTextureList
.Items
.Count
-1 do
1936 if ResourceName
= MainForm
.lbTextureList
.Items
[a
] then
1939 ErrorMessageBox(Format(_lc
[I_MSG_TEXTURE_ALREADY
],
1944 // Название ресурса <= 64 символов:
1945 if Length(ResourceName
) > 64 then
1948 ErrorMessageBox(Format(_lc
[I_MSG_RES_NAME_64
],
1956 if aWAD
= _lc
[I_WAD_SPECIAL_TEXS
] then
1958 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1965 FullResourceName
:= FileName
+':'+SectionName
+'\'+aTex
;
1967 if IsAnim(FullResourceName
) then
1968 begin // Аним. текстура
1969 GetFrame(FullResourceName
, Data
, FrameLen
, Width
, Height
);
1971 if not g_CreateTextureMemorySize(Data
, FrameLen
, ResourceName
, 0, 0, Width
, Height
, 1) then
1973 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1975 else // Обычная текстура
1977 if not g_CreateTextureWAD(ResourceName
, FullResourceName
) then
1979 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1981 if (not ok
) and (slInvalidTextures
.IndexOf(ResourceName
) = -1) then
1983 slInvalidTextures
.Add(ResourceName
);
1986 if (a
> -1) and (not silent
) then
1993 procedure UpdateCaption(sMap
, sFile
, sRes
: String);
1996 if (sFile
= '') and (sRes
= '') and (sMap
= '') then
1997 Caption
:= FormCaption
2000 Caption
:= Format('%s - %s:%s', [FormCaption
, sFile
, sRes
])
2002 if (sFile
<> '') and (sRes
<> '') then
2003 Caption
:= Format('%s - %s (%s:%s)', [FormCaption
, sMap
, sFile
, sRes
])
2005 Caption
:= Format('%s - %s', [FormCaption
, sMap
]);
2008 procedure OpenMap(FileName
: String; mapN
: String);
2013 SelectMapForm
.Caption
:= _lc
[I_CAP_OPEN
];
2014 SelectMapForm
.GetMaps(FileName
);
2016 if (FileName
= OpenedWAD
) and
2017 (OpenedMap
<> '') then
2019 MapName
:= OpenedMap
;
2020 while (Pos(':\', MapName
) > 0) do
2021 Delete(MapName
, 1, Pos(':\', MapName
) + 1);
2023 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(MapName
);
2024 SelectMapForm
.lbMapList
.ItemIndex
:= idx
;
2027 if SelectMapForm
.lbMapList
.Count
> 0 then
2028 SelectMapForm
.lbMapList
.ItemIndex
:= 0
2030 SelectMapForm
.lbMapList
.ItemIndex
:= -1;
2035 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(mapN
);
2039 if (SelectMapForm
.ShowModal() = mrOK
) and
2040 (SelectMapForm
.lbMapList
.ItemIndex
<> -1) then
2041 idx
:= SelectMapForm
.lbMapList
.ItemIndex
2046 MapName
:= SelectMapForm
.lbMapList
.Items
[idx
];
2052 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
2053 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
2054 pLoadProgress
.Show();
2056 OpenedMap
:= FileName
+':\'+MapName
;
2057 OpenedWAD
:= FileName
;
2059 idx
:= RecentFiles
.IndexOf(OpenedMap
);
2060 // Такая карта уже недавно открывалась:
2062 RecentFiles
.Delete(idx
);
2063 RecentFiles
.Insert(0, OpenedMap
);
2064 RefreshRecentMenu();
2068 pLoadProgress
.Hide();
2071 lbTextureList
.Sorted
:= True;
2072 lbTextureList
.Sorted
:= False;
2074 UpdateCaption(gMapInfo
.Name
, ExtractFileName(FileName
), MapName
);
2078 procedure MoveSelectedObjects(Wall
, alt
: Boolean; dx
, dy
: Integer);
2083 if SelectedObjects
= nil then
2090 for a
:= 0 to High(SelectedObjects
) do
2091 if SelectedObjects
[a
].Live
then
2093 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, dx
, 0) then
2096 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, 0, dy
) then
2099 if (not okX
) or (not okY
) then
2105 for a
:= 0 to High(SelectedObjects
) do
2106 if SelectedObjects
[a
].Live
then
2109 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, dx
, 0);
2112 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, 0, dy
);
2114 if alt
and (SelectedObjects
[a
].ObjectType
= OBJECT_TRIGGER
) then
2116 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_PRESS
,
2117 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
] then
2118 begin // Двигаем зону Расширителя
2120 gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
+dx
;
2122 gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
+dy
;
2125 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_TELEPORT
] then
2126 begin // Двигаем точку назначения Телепорта
2128 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
+dx
;
2130 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
+dy
;
2133 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNMONSTER
] then
2134 begin // Двигаем точку создания монстра
2136 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
+dx
;
2138 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
+dy
;
2141 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNITEM
] then
2142 begin // Двигаем точку создания предмета
2144 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
+dx
;
2146 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
+dy
;
2149 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SHOT
] then
2150 begin // Двигаем точку создания выстрела
2152 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
+dx
;
2154 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
+dy
;
2159 LastMovePoint
:= MousePos
;
2163 procedure ShowLayer(Layer
: Byte; show
: Boolean);
2165 LayerEnabled
[Layer
] := show
;
2170 MainForm
.miLayer1
.Checked
:= show
;
2171 MainForm
.miLayerP1
.Checked
:= show
;
2175 MainForm
.miLayer2
.Checked
:= show
;
2176 MainForm
.miLayerP2
.Checked
:= show
;
2180 MainForm
.miLayer3
.Checked
:= show
;
2181 MainForm
.miLayerP3
.Checked
:= show
;
2185 MainForm
.miLayer4
.Checked
:= show
;
2186 MainForm
.miLayerP4
.Checked
:= show
;
2190 MainForm
.miLayer5
.Checked
:= show
;
2191 MainForm
.miLayerP5
.Checked
:= show
;
2195 MainForm
.miLayer6
.Checked
:= show
;
2196 MainForm
.miLayerP6
.Checked
:= show
;
2200 MainForm
.miLayer7
.Checked
:= show
;
2201 MainForm
.miLayerP7
.Checked
:= show
;
2205 MainForm
.miLayer8
.Checked
:= show
;
2206 MainForm
.miLayerP8
.Checked
:= show
;
2210 MainForm
.miLayer9
.Checked
:= show
;
2211 MainForm
.miLayerP9
.Checked
:= show
;
2215 RemoveSelectFromObjects();
2218 procedure SwitchLayer(Layer
: Byte);
2220 ShowLayer(Layer
, not LayerEnabled
[Layer
]);
2223 procedure SwitchMap();
2225 ShowMap
:= not ShowMap
;
2226 MainForm
.tbShowMap
.Down
:= ShowMap
;
2229 procedure ShowEdges();
2231 if drEdge
[3] < 255 then
2234 drEdge
[3] := gAlphaEdge
;
2237 function SelectedTexture(): String;
2239 if MainForm
.lbTextureList
.ItemIndex
<> -1 then
2240 Result
:= MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]
2245 function IsSpecialTextureSel(): Boolean;
2247 Result
:= (MainForm
.lbTextureList
.ItemIndex
<> -1) and
2248 IsSpecialTexture(MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]);
2251 function CopyBufferToString(var CopyBuf
: TCopyRecArray
): String;
2256 procedure AddInt(x
: Integer);
2258 Res
:= Res
+ IntToStr(x
) + ' ';
2264 if Length(CopyBuf
) = 0 then
2267 Res
:= CLIPBOARD_SIG
+ ' ';
2269 for i
:= 0 to High(CopyBuf
) do
2271 if (CopyBuf
[i
].ObjectType
= OBJECT_PANEL
) and
2272 (CopyBuf
[i
].Panel
= nil) then
2276 AddInt(CopyBuf
[i
].ObjectType
);
2279 // Свойства объекта:
2280 case CopyBuf
[i
].ObjectType
of
2282 with CopyBuf
[i
].Panel
^ do
2289 Res
:= Res
+ '"' + TextureName
+ '" ';
2291 AddInt(IfThen(Blending
, 1, 0));
2295 with CopyBuf
[i
].Item
do
2300 AddInt(IfThen(OnlyDM
, 1, 0));
2301 AddInt(IfThen(Fall
, 1, 0));
2305 with CopyBuf
[i
].Monster
do
2307 AddInt(MonsterType
);
2310 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2314 with CopyBuf
[i
].Area
do
2319 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2323 with CopyBuf
[i
].Trigger
do
2325 AddInt(TriggerType
);
2330 AddInt(ActivateType
);
2332 AddInt(IfThen(Enabled
, 1, 0));
2333 AddInt(TexturePanel
);
2335 for j
:= 0 to 127 do
2336 AddInt(Data
.Default
[j
]);
2344 procedure StringToCopyBuffer(Str
: String; var CopyBuf
: TCopyRecArray
;
2349 function GetNext(): String;
2354 if Str
[1] = '"' then
2366 Result
:= Copy(Str
, 1, p
-1);
2382 Result
:= Copy(Str
, 1, p
-1);
2392 if GetNext() <> CLIPBOARD_SIG
then
2398 t
:= StrToIntDef(GetNext(), 0);
2400 if (t
< OBJECT_PANEL
) or (t
> OBJECT_TRIGGER
) or
2401 (GetNext() <> ';') then
2402 begin // Что-то не то => пропускаем:
2410 i
:= Length(CopyBuf
);
2411 SetLength(CopyBuf
, i
+ 1);
2413 CopyBuf
[i
].ObjectType
:= t
;
2414 CopyBuf
[i
].Panel
:= nil;
2416 // Свойства объекта:
2420 New(CopyBuf
[i
].Panel
);
2422 with CopyBuf
[i
].Panel
^ do
2424 PanelType
:= StrToIntDef(GetNext(), PANEL_WALL
);
2425 X
:= StrToIntDef(GetNext(), 0);
2426 Y
:= StrToIntDef(GetNext(), 0);
2427 pmin
.X
:= Min(X
, pmin
.X
);
2428 pmin
.Y
:= Min(Y
, pmin
.Y
);
2429 Width
:= StrToIntDef(GetNext(), 16);
2430 Height
:= StrToIntDef(GetNext(), 16);
2431 TextureName
:= GetNext();
2432 Alpha
:= StrToIntDef(GetNext(), 0);
2433 Blending
:= (GetNext() = '1');
2438 with CopyBuf
[i
].Item
do
2440 ItemType
:= StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL
);
2441 X
:= StrToIntDef(GetNext(), 0);
2442 Y
:= StrToIntDef(GetNext(), 0);
2443 pmin
.X
:= Min(X
, pmin
.X
);
2444 pmin
.Y
:= Min(Y
, pmin
.Y
);
2445 OnlyDM
:= (GetNext() = '1');
2446 Fall
:= (GetNext() = '1');
2450 with CopyBuf
[i
].Monster
do
2452 MonsterType
:= StrToIntDef(GetNext(), MONSTER_DEMON
);
2453 X
:= StrToIntDef(GetNext(), 0);
2454 Y
:= StrToIntDef(GetNext(), 0);
2455 pmin
.X
:= Min(X
, pmin
.X
);
2456 pmin
.Y
:= Min(Y
, pmin
.Y
);
2458 if GetNext() = '1' then
2461 Direction
:= D_RIGHT
;
2465 with CopyBuf
[i
].Area
do
2467 AreaType
:= StrToIntDef(GetNext(), AREA_PLAYERPOINT1
);
2468 X
:= StrToIntDef(GetNext(), 0);
2469 Y
:= StrToIntDef(GetNext(), 0);
2470 pmin
.X
:= Min(X
, pmin
.X
);
2471 pmin
.Y
:= Min(Y
, pmin
.Y
);
2472 if GetNext() = '1' then
2475 Direction
:= D_RIGHT
;
2479 with CopyBuf
[i
].Trigger
do
2481 TriggerType
:= StrToIntDef(GetNext(), TRIGGER_EXIT
);
2482 X
:= StrToIntDef(GetNext(), 0);
2483 Y
:= StrToIntDef(GetNext(), 0);
2484 pmin
.X
:= Min(X
, pmin
.X
);
2485 pmin
.Y
:= Min(Y
, pmin
.Y
);
2486 Width
:= StrToIntDef(GetNext(), 16);
2487 Height
:= StrToIntDef(GetNext(), 16);
2488 ActivateType
:= StrToIntDef(GetNext(), 0);
2489 Key
:= StrToIntDef(GetNext(), 0);
2490 Enabled
:= (GetNext() = '1');
2491 TexturePanel
:= StrToIntDef(GetNext(), 0);
2493 for j
:= 0 to 127 do
2494 Data
.Default
[j
] := StrToIntDef(GetNext(), 0);
2499 pmin
.X
:= Min(Data
.TargetPoint
.X
, pmin
.X
);
2500 pmin
.Y
:= Min(Data
.TargetPoint
.Y
, pmin
.Y
);
2502 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
2504 pmin
.X
:= Min(Data
.tX
, pmin
.X
);
2505 pmin
.Y
:= Min(Data
.tY
, pmin
.Y
);
2507 TRIGGER_SPAWNMONSTER
:
2509 pmin
.X
:= Min(Data
.MonPos
.X
, pmin
.X
);
2510 pmin
.Y
:= Min(Data
.MonPos
.Y
, pmin
.Y
);
2514 pmin
.X
:= Min(Data
.ItemPos
.X
, pmin
.X
);
2515 pmin
.Y
:= Min(Data
.ItemPos
.Y
, pmin
.Y
);
2519 pmin
.X
:= Min(Data
.ShotPos
.X
, pmin
.X
);
2520 pmin
.Y
:= Min(Data
.ShotPos
.Y
, pmin
.Y
);
2528 //----------------------------------------
2529 //Закончились вспомогательные процедуры
2530 //----------------------------------------
2532 procedure TMainForm
.RefreshRecentMenu();
2537 // Лишние запомненные карты:
2538 while RecentFiles
.Count
> RecentCount
do
2539 RecentFiles
.Delete(RecentFiles
.Count
-1);
2541 // Лишние строки меню:
2542 while MainMenu
.Items
[0].Count
> RECENT_FILES_MENU_START
do
2543 MainMenu
.Items
[0].Delete(MainMenu
.Items
[0].Count
-1);
2545 // Отделение списка карт от строки "Выход":
2546 if RecentFiles
.Count
> 0 then
2548 MI
:= TMenuItem
.Create(MainMenu
.Items
[0]);
2550 MainMenu
.Items
[0].Add(MI
);
2553 // Добавление в меню списка запомненных карт:
2554 for i
:= 0 to RecentFiles
.Count
-1 do
2556 MI
:= TMenuItem
.Create(MainMenu
.Items
[0]);
2557 MI
.Caption
:= IntToStr(i
+1) + ' ' + RecentFiles
[i
];
2558 MI
.OnClick
:= aRecentFileExecute
;
2559 MainMenu
.Items
[0].Add(MI
);
2563 procedure TMainForm
.aRecentFileExecute(Sender
: TObject
);
2569 s
:= LowerCase((Sender
as TMenuItem
).Caption
);
2570 Delete(s
, Pos('&', s
), 1);
2571 s
:= Trim(Copy(s
, 1, 2));
2572 n
:= StrToIntDef(s
, 0) - 1;
2574 if (n
< 0) or (n
>= RecentFiles
.Count
) then
2577 s
:= RecentFiles
[n
];
2578 pw
:= Pos('.wad:\', LowerCase(s
));
2582 begin // Map name included
2583 fn
:= Copy(s
, 1, pw
+ 3);
2584 Delete(s
, 1, pw
+ 5);
2585 if (FileExists(fn
)) then
2591 else // Only wad name
2592 if (FileExists(s
)) then
2598 if (not b
) and (MessageBox(0, PChar(_lc
[I_MSG_DEL_RECENT_PROMT
]),
2599 PChar(_lc
[I_MSG_DEL_RECENT
]), MB_ICONQUESTION
or MB_YESNO
) = idYes
) then
2601 RecentFiles
.Delete(n
);
2602 RefreshRecentMenu();
2606 procedure TMainForm
.aEditorOptionsExecute(Sender
: TObject
);
2608 OptionsForm
.ShowModal();
2611 procedure LoadStdFont(cfgres
, texture
: string; var FontID
: DWORD
);
2625 wad
:= TWADEditor_1
.Create
;
2626 if wad
.ReadFile(EditorDir
+'data/Game.wad') then
2627 wad
.GetResource('FONTS', cfgres
, cfgdata
, cfglen
);
2632 if not g_CreateTextureWAD('FONT_STD', EditorDir
+'data/Game.wad:FONTS\'+texture
) then
2633 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING
);
2635 config
:= TConfig
.CreateMem(cfgdata
, cfglen
);
2636 cwdt
:= Min(Max(config
.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2637 chgt
:= Min(Max(config
.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2638 spc
:= Min(Max(config
.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2640 if g_GetTexture('FONT_STD', ID
) then
2641 e_TextureFontBuild(ID
, FontID
, cwdt
, chgt
, spc
-2);
2646 e_WriteLog('Could not load FONT_STD', MSG_WARNING
);
2648 if cfglen
<> 0 then FreeMem(cfgdata
);
2651 procedure TMainForm
.FormCreate(Sender
: TObject
);
2659 EditorDir
:= ExtractFilePath(Application
.ExeName
);
2661 e_InitLog(EditorDir
+'Editor.log', WM_NEWFILE
);
2663 slInvalidTextures
:= TStringList
.Create
;
2665 ShowLayer(LAYER_BACK
, True);
2666 ShowLayer(LAYER_WALLS
, True);
2667 ShowLayer(LAYER_FOREGROUND
, True);
2668 ShowLayer(LAYER_STEPS
, True);
2669 ShowLayer(LAYER_WATER
, True);
2670 ShowLayer(LAYER_ITEMS
, True);
2671 ShowLayer(LAYER_MONSTERS
, True);
2672 ShowLayer(LAYER_AREAS
, True);
2673 ShowLayer(LAYER_TRIGGERS
, True);
2677 FormCaption
:= MainForm
.Caption
;
2681 config
:= TConfig
.CreateFile(EditorDir
+'Editor.cfg');
2683 if config
.ReadInt('Editor', 'XPos', -1) = -1 then
2684 Position
:= poDesktopCenter
2686 Left
:= config
.ReadInt('Editor', 'XPos', Left
);
2687 Top
:= config
.ReadInt('Editor', 'YPos', Top
);
2688 Width
:= config
.ReadInt('Editor', 'Width', Width
);
2689 Height
:= config
.ReadInt('Editor', 'Height', Height
);
2691 if config
.ReadBool('Editor', 'Maximize', False) then
2692 WindowState
:= wsMaximized
;
2693 ShowMap
:= config
.ReadBool('Editor', 'Minimap', False);
2694 PanelProps
.Width
:= config
.ReadInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
2695 Splitter1
.Left
:= PanelProps
.Left
;
2696 PanelObjs
.Height
:= config
.ReadInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
2697 Splitter2
.Top
:= PanelObjs
.Top
;
2698 StatusBar
.Top
:= PanelObjs
.BoundsRect
.Bottom
;
2699 DotEnable
:= config
.ReadBool('Editor', 'DotEnable', True);
2700 DotColor
:= config
.ReadInt('Editor', 'DotColor', $FFFFFF);
2701 DotStepOne
:= config
.ReadInt('Editor', 'DotStepOne', 16);
2702 DotStepTwo
:= config
.ReadInt('Editor', 'DotStepTwo', 8);
2703 DotStep
:= config
.ReadInt('Editor', 'DotStep', DotStepOne
);
2704 DrawTexturePanel
:= config
.ReadBool('Editor', 'DrawTexturePanel', True);
2705 DrawPanelSize
:= config
.ReadBool('Editor', 'DrawPanelSize', True);
2706 BackColor
:= config
.ReadInt('Editor', 'BackColor', $7F6040);
2707 PreviewColor
:= config
.ReadInt('Editor', 'PreviewColor', $00FF00);
2708 UseCheckerboard
:= config
.ReadBool('Editor', 'UseCheckerboard', True);
2709 gColorEdge
:= config
.ReadInt('Editor', 'EdgeColor', COLOR_EDGE
);
2710 gAlphaEdge
:= config
.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE
);
2711 if gAlphaEdge
= 255 then
2712 gAlphaEdge
:= ALPHA_EDGE
;
2713 drEdge
[0] := GetRValue(gColorEdge
);
2714 drEdge
[1] := GetGValue(gColorEdge
);
2715 drEdge
[2] := GetBValue(gColorEdge
);
2716 if not config
.ReadBool('Editor', 'EdgeShow', True) then
2719 drEdge
[3] := gAlphaEdge
;
2720 gAlphaTriggerLine
:= config
.ReadInt('Editor', 'LineAlpha', ALPHA_LINE
);
2721 if gAlphaTriggerLine
= 255 then
2722 gAlphaTriggerLine
:= ALPHA_LINE
;
2723 gAlphaTriggerArea
:= config
.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA
);
2724 if gAlphaTriggerArea
= 255 then
2725 gAlphaTriggerArea
:= ALPHA_AREA
;
2726 if config
.ReadInt('Editor', 'Scale', 0) = 1 then
2730 if config
.ReadInt('Editor', 'DotSize', 0) = 1 then
2734 OpenDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastOpenDir', EditorDir
);
2735 SaveDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastSaveDir', EditorDir
);
2737 s
:= config
.ReadStr('Editor', 'Language', '');
2740 RecentCount
:= config
.ReadInt('Editor', 'RecentCount', 5);
2741 if RecentCount
> 10 then
2743 if RecentCount
< 2 then
2746 RecentFiles
:= TStringList
.Create();
2747 for i
:= 0 to RecentCount
-1 do
2749 s
:= config
.ReadStr('RecentFiles', IntToStr(i
+1), '');
2753 RefreshRecentMenu();
2757 tbShowMap
.Down
:= ShowMap
;
2758 tbGridOn
.Down
:= DotEnable
;
2759 pcObjects
.ActivePageIndex
:= 0;
2760 Application
.Title
:= _lc
[I_EDITOR_TITLE
];
2762 Application
.OnIdle
:= OnIdle
;
2765 procedure PrintBlack(X
, Y
: Integer; Text: string; FontID
: DWORD
);
2767 // NOTE: all the font printing routines assume CP1251
2768 e_TextureFontPrintEx(X
, Y
, Text, FontID
, 0, 0, 0, 1.0);
2771 procedure TMainForm
.Draw();
2776 Width
, Height
: Word;
2779 aX
, aY
, aX2
, aY2
, XX
, ScaleSz
: Integer;
2788 e_Clear(GL_COLOR_BUFFER_BIT
,
2789 GetRValue(BackColor
)/255,
2790 GetGValue(BackColor
)/255,
2791 GetBValue(BackColor
)/255);
2795 ObjCount
:= SelectedObjectCount();
2797 // Обводим выделенные объекты красной рамкой:
2798 if ObjCount
> 0 then
2800 for a
:= 0 to High(SelectedObjects
) do
2801 if SelectedObjects
[a
].Live
then
2803 Rect
:= ObjectGetRect(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
);
2807 e_DrawQuad(X
+MapOffset
.X
, Y
+MapOffset
.Y
,
2808 X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+Height
-1,
2811 // Рисуем точки изменения размеров:
2812 if (ObjCount
= 1) and
2813 (SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) then
2815 e_DrawPoint(5, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2816 e_DrawPoint(5, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2817 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 255, 255);
2818 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 255, 255);
2820 e_DrawPoint(3, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2821 e_DrawPoint(3, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2822 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 0, 0);
2823 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 0, 0);
2830 if DotEnable
and (PreviewMode
= 0) then
2837 for x
:= 0 to (RenderPanel
.Width
div DotStep
) do
2838 for y
:= 0 to (RenderPanel
.Height
div DotStep
) do
2839 e_DrawPoint(DotSize
, x
*DotStep
+ a
, y
*DotStep
+ a
,
2840 GetRValue(DotColor
),
2841 GetGValue(DotColor
),
2842 GetBValue(DotColor
));
2846 if (lbTextureList
.ItemIndex
<> -1) and (cbPreview
.Checked
) and
2847 (not IsSpecialTextureSel()) and (PreviewMode
= 0) then
2849 if not g_GetTexture(SelectedTexture(), ID
) then
2850 g_GetTexture('NOTEXTURE', ID
);
2851 g_GetTextureSizeByID(ID
, Width
, Height
);
2852 if UseCheckerboard
then
2854 if g_GetTexture('PREVIEW', PID
) then
2855 e_DrawFill(PID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, Width
div 16 + 1, Height
div 16 + 1, 0, True, False);
2857 e_DrawFillQuad(RenderPanel
.Width
-Width
-2, RenderPanel
.Height
-Height
-2,
2858 RenderPanel
.Width
-1, RenderPanel
.Height
-1,
2859 GetRValue(PreviewColor
), GetGValue(PreviewColor
), GetBValue(PreviewColor
), 0);
2860 e_Draw(ID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, 0, True, False);
2863 // Подсказка при выборе точки Телепорта:
2864 if SelectFlag
= SELECTFLAG_TELEPORT
then
2866 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
2867 if Data
.d2d_teleport
then
2868 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2869 MousePos
.X
+16, MousePos
.Y
-1,
2872 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+AreaSize
[AREA_DMPOINT
].Width
-1,
2873 MousePos
.Y
+AreaSize
[AREA_DMPOINT
].Height
-1, 255, 255, 255);
2875 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2876 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2877 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_TELEPORT
], gEditorFont
);
2880 // Подсказка при выборе точки появления:
2881 if SelectFlag
= SELECTFLAG_SPAWNPOINT
then
2883 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2884 MousePos
.X
+16, MousePos
.Y
-1,
2886 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2887 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2888 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_SPAWN
], gEditorFont
);
2891 // Подсказка при выборе панели двери:
2892 if SelectFlag
= SELECTFLAG_DOOR
then
2894 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2895 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2896 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_DOOR
], gEditorFont
);
2899 // Подсказка при выборе панели с текстурой:
2900 if SelectFlag
= SELECTFLAG_TEXTURE
then
2902 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 192, 192, 192, 127);
2903 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 255, 255, 255);
2904 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_TEXTURE
], gEditorFont
);
2907 // Подсказка при выборе панели индикации выстрела:
2908 if SelectFlag
= SELECTFLAG_SHOTPANEL
then
2910 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 192, 192, 192, 127);
2911 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 255, 255, 255);
2912 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_SHOT
], gEditorFont
);
2915 // Подсказка при выборе панели лифта:
2916 if SelectFlag
= SELECTFLAG_LIFT
then
2918 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2919 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2920 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_LIFT
], gEditorFont
);
2923 // Подсказка при выборе монстра:
2924 if SelectFlag
= SELECTFLAG_MONSTER
then
2926 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 192, 192, 192, 127);
2927 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 255, 255, 255);
2928 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_MONSTER
], gEditorFont
);
2931 // Подсказка при выборе области воздействия:
2932 if DrawPressRect
then
2934 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 192, 192, 192, 127);
2935 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 255, 255, 255);
2936 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_EXT_AREA
], gEditorFont
);
2939 // Рисуем текстуры, если чертим панель:
2940 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and (DrawTexturePanel
) and
2941 (lbTextureList
.ItemIndex
<> -1) and (DrawRect
<> nil) and
2942 (lbPanelType
.ItemIndex
in [0..8]) and not IsSpecialTextureSel() then
2944 if not g_GetTexture(SelectedTexture(), ID
) then
2945 g_GetTexture('NOTEXTURE', ID
);
2946 g_GetTextureSizeByID(ID
, Width
, Height
);
2948 e_DrawFill(ID
, Min(Left
, Right
), Min(Top
, Bottom
), Abs(Right
-Left
) div Width
,
2949 Abs(Bottom
-Top
) div Height
, 0, True, False);
2952 // Прямоугольник выделения:
2953 if DrawRect
<> nil then
2955 e_DrawQuad(Left
, Top
, Right
-1, Bottom
-1, 255, 255, 255);
2957 // Чертим мышью панель/триггер или меняем мышью их размер:
2958 if (MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
, MOUSEACTION_RESIZE
]) and
2959 (DrawPanelSize
) then
2961 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 192, 192, 192, 127);
2962 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 255, 255, 255);
2964 if MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
] then
2965 begin // Чертим новый
2966 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(_glc
[I_HINT_WIDTH
],
2967 [Abs(MousePos
.X
-MouseLDownPos
.X
)]), gEditorFont
);
2968 PrintBlack(MousePos
.X
+2, MousePos
.Y
+14, Format(_glc
[I_HINT_HEIGHT
],
2969 [Abs(MousePos
.Y
-MouseLDownPos
.Y
)]), gEditorFont
);
2971 else // Растягиваем существующий
2972 if SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
2974 if SelectedObjects
[GetFirstSelected
].ObjectType
= OBJECT_PANEL
then
2976 Width
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
2977 Height
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
2981 Width
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
2982 Height
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
2985 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(_glc
[I_HINT_WIDTH
], [Width
]),
2987 PrintBlack(MousePos
.X
+2, MousePos
.Y
+14, Format(_glc
[I_HINT_HEIGHT
], [Height
]),
2992 // Ближайшая к курсору мыши точка на сетке:
2993 e_DrawPoint(3, MousePos
.X
, MousePos
.Y
, 0, 0, 255);
2998 // Сколько пикселов карты в 1 пикселе мини-карты:
2999 ScaleSz
:= 16 div Scale
;
3000 // Размеры мини-карты:
3001 aX
:= max(gMapInfo
.Width
div ScaleSz
, 1);
3002 aY
:= max(gMapInfo
.Height
div ScaleSz
, 1);
3003 // X-координата на RenderPanel нулевой x-координаты карты:
3004 XX
:= RenderPanel
.Width
- aX
- 1;
3006 e_DrawFillQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 0, 0, 0, 0);
3007 e_DrawQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 197, 197, 197);
3009 if gPanels
<> nil then
3012 for a
:= 0 to High(gPanels
) do
3014 if PanelType
<> 0 then
3016 // Левый верхний угол:
3017 aX
:= XX
+ (X
div ScaleSz
);
3018 aY
:= 1 + (Y
div ScaleSz
);
3020 aX2
:= max(Width
div ScaleSz
, 1);
3021 aY2
:= max(Height
div ScaleSz
, 1);
3022 // Правый нижний угол:
3023 aX2
:= aX
+ aX2
- 1;
3024 aY2
:= aY
+ aY2
- 1;
3027 PANEL_WALL
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 208, 208, 208, 0);
3028 PANEL_WATER
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 0, 192, 0);
3029 PANEL_ACID1
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 176, 0, 0);
3030 PANEL_ACID2
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 176, 0, 0, 0);
3031 PANEL_STEP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 128, 128, 128, 0);
3032 PANEL_LIFTUP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 72, 36, 0);
3033 PANEL_LIFTDOWN
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 124, 96, 0);
3034 PANEL_LIFTLEFT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 200, 80, 4, 0);
3035 PANEL_LIFTRIGHT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 252, 140, 56, 0);
3036 PANEL_OPENDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 100, 220, 92, 0);
3037 PANEL_CLOSEDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 212, 184, 64, 0);
3038 PANEL_BLOCKMON
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 192, 0, 192, 0);
3042 // Рисуем красным выделенные панели:
3043 if SelectedObjects
<> nil then
3044 for b
:= 0 to High(SelectedObjects
) do
3045 with SelectedObjects
[b
] do
3046 if Live
and (ObjectType
= OBJECT_PANEL
) then
3047 with gPanels
[SelectedObjects
[b
].ID
] do
3048 if PanelType
and not(PANEL_BACK
or PANEL_FORE
) <> 0 then
3050 // Левый верхний угол:
3051 aX
:= XX
+ (X
div ScaleSz
);
3052 aY
:= 1 + (Y
div ScaleSz
);
3054 aX2
:= max(Width
div ScaleSz
, 1);
3055 aY2
:= max(Height
div ScaleSz
, 1);
3056 // Правый нижний угол:
3057 aX2
:= aX
+ aX2
- 1;
3058 aY2
:= aY
+ aY2
- 1;
3060 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0, 0)
3064 if (gMapInfo
.Width
> RenderPanel
.Width
) or
3065 (gMapInfo
.Height
> RenderPanel
.Height
) then
3067 // Окно, показывающее текущее положение экрана на карте:
3069 x
:= max(min(RenderPanel
.Width
, gMapInfo
.Width
) div ScaleSz
, 1);
3070 y
:= max(min(RenderPanel
.Height
, gMapInfo
.Height
) div ScaleSz
, 1);
3071 // Левый верхний угол:
3072 aX
:= XX
+ ((-MapOffset
.X
) div ScaleSz
);
3073 aY
:= 1 + ((-MapOffset
.Y
) div ScaleSz
);
3074 // Правый нижний угол:
3078 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 127, 192, 127, 127, B_BLEND
);
3079 e_DrawQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0);
3084 RenderPanel
.SwapBuffers();
3087 procedure TMainForm
.FormResize(Sender
: TObject
);
3089 e_SetViewPort(0, 0, RenderPanel
.Width
, RenderPanel
.Height
);
3091 if gMapInfo
.Width
>= RenderPanel
.Width
then
3092 sbHorizontal
.Max
:= Normalize16(gMapInfo
.Width
-RenderPanel
.Width
+16)
3094 sbHorizontal
.Max
:= 0;
3096 if gMapInfo
.Height
>= RenderPanel
.Height
then
3097 sbVertical
.Max
:= Normalize16(gMapInfo
.Height
-RenderPanel
.Height
+16)
3099 sbVertical
.Max
:= 0;
3101 MapOffset
.X
:= -Normalize16(sbHorizontal
.Position
);
3102 MapOffset
.Y
:= -Normalize16(sbVertical
.Position
);
3105 procedure SelectNextObject(X
, Y
: Integer; ObjectType
: Byte; ID
: DWORD
);
3110 j_max
:= 0; // shut up compiler
3114 res
:= (gPanels
<> nil) and
3115 PanelInShownLayer(gPanels
[ID
].PanelType
) and
3116 g_CollidePoint(X
, Y
, gPanels
[ID
].X
, gPanels
[ID
].Y
,
3118 gPanels
[ID
].Height
);
3119 j_max
:= Length(gPanels
) - 1;
3124 res
:= (gItems
<> nil) and
3125 LayerEnabled
[LAYER_ITEMS
] and
3126 g_CollidePoint(X
, Y
, gItems
[ID
].X
, gItems
[ID
].Y
,
3127 ItemSize
[gItems
[ID
].ItemType
][0],
3128 ItemSize
[gItems
[ID
].ItemType
][1]);
3129 j_max
:= Length(gItems
) - 1;
3134 res
:= (gMonsters
<> nil) and
3135 LayerEnabled
[LAYER_MONSTERS
] and
3136 g_CollidePoint(X
, Y
, gMonsters
[ID
].X
, gMonsters
[ID
].Y
,
3137 MonsterSize
[gMonsters
[ID
].MonsterType
].Width
,
3138 MonsterSize
[gMonsters
[ID
].MonsterType
].Height
);
3139 j_max
:= Length(gMonsters
) - 1;
3144 res
:= (gAreas
<> nil) and
3145 LayerEnabled
[LAYER_AREAS
] and
3146 g_CollidePoint(X
, Y
, gAreas
[ID
].X
, gAreas
[ID
].Y
,
3147 AreaSize
[gAreas
[ID
].AreaType
].Width
,
3148 AreaSize
[gAreas
[ID
].AreaType
].Height
);
3149 j_max
:= Length(gAreas
) - 1;
3154 res
:= (gTriggers
<> nil) and
3155 LayerEnabled
[LAYER_TRIGGERS
] and
3156 g_CollidePoint(X
, Y
, gTriggers
[ID
].X
, gTriggers
[ID
].Y
,
3157 gTriggers
[ID
].Width
,
3158 gTriggers
[ID
].Height
);
3159 j_max
:= Length(gTriggers
) - 1;
3169 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3178 if j
= Integer(ID
) then
3183 res
:= PanelInShownLayer(gPanels
[j
].PanelType
) and
3184 g_CollidePoint(X
, Y
, gPanels
[j
].X
, gPanels
[j
].Y
,
3188 res
:= (gItems
[j
].ItemType
<> ITEM_NONE
) and
3189 g_CollidePoint(X
, Y
, gItems
[j
].X
, gItems
[j
].Y
,
3190 ItemSize
[gItems
[j
].ItemType
][0],
3191 ItemSize
[gItems
[j
].ItemType
][1]);
3193 res
:= (gMonsters
[j
].MonsterType
<> MONSTER_NONE
) and
3194 g_CollidePoint(X
, Y
, gMonsters
[j
].X
, gMonsters
[j
].Y
,
3195 MonsterSize
[gMonsters
[j
].MonsterType
].Width
,
3196 MonsterSize
[gMonsters
[j
].MonsterType
].Height
);
3198 res
:= (gAreas
[j
].AreaType
<> AREA_NONE
) and
3199 g_CollidePoint(X
, Y
, gAreas
[j
].X
, gAreas
[j
].Y
,
3200 AreaSize
[gAreas
[j
].AreaType
].Width
,
3201 AreaSize
[gAreas
[j
].AreaType
].Height
);
3203 res
:= (gTriggers
[j
].TriggerType
<> TRIGGER_NONE
) and
3204 g_CollidePoint(X
, Y
, gTriggers
[j
].X
, gTriggers
[j
].Y
,
3206 gTriggers
[j
].Height
);
3213 SetLength(SelectedObjects
, 1);
3215 SelectedObjects
[0].ObjectType
:= ObjectType
;
3216 SelectedObjects
[0].ID
:= j
;
3217 SelectedObjects
[0].Live
:= True;
3225 procedure TMainForm
.RenderPanelMouseDown(Sender
: TObject
;
3226 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3230 c1
, c2
, c3
, c4
: Boolean;
3236 MainForm
.ActiveControl
:= RenderPanel
;
3237 RenderPanel
.SetFocus();
3239 RenderPanelMouseMove(RenderPanel
, Shift
, X
, Y
);
3241 if Button
= mbLeft
then // Left Mouse Button
3243 // Двигаем карту с помощью мыши и мини-карты:
3245 g_CollidePoint(X
, Y
,
3246 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3248 max(gMapInfo
.Width
div (16 div Scale
), 1),
3249 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3252 MouseAction
:= MOUSEACTION_MOVEMAP
;
3254 else // Ставим предмет/монстра/область:
3255 if (pcObjects
.ActivePageIndex
in [1, 2, 3]) and
3256 (not (ssShift
in Shift
)) then
3258 case pcObjects
.ActivePageIndex
of
3260 if lbItemList
.ItemIndex
= -1 then
3261 ErrorMessageBox(_lc
[I_MSG_CHOOSE_ITEM
])
3264 item
.ItemType
:= lbItemList
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
3265 if item
.ItemType
>= ITEM_WEAPON_KASTET
then
3266 item
.ItemType
:= item
.ItemType
+ 2;
3267 item
.X
:= MousePos
.X
-MapOffset
.X
;
3268 item
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3270 if not (ssCtrl
in Shift
) then
3272 item
.X
:= item
.X
- (ItemSize
[item
.ItemType
][0] div 2);
3273 item
.Y
:= item
.Y
- ItemSize
[item
.ItemType
][1];
3276 item
.OnlyDM
:= cbOnlyDM
.Checked
;
3277 item
.Fall
:= cbFall
.Checked
;
3278 Undo_Add(OBJECT_ITEM
, AddItem(item
));
3281 if lbMonsterList
.ItemIndex
= -1 then
3282 ErrorMessageBox(_lc
[I_MSG_CHOOSE_MONSTER
])
3285 monster
.MonsterType
:= lbMonsterList
.ItemIndex
+ MONSTER_DEMON
;
3286 monster
.X
:= MousePos
.X
-MapOffset
.X
;
3287 monster
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3289 if not (ssCtrl
in Shift
) then
3291 monster
.X
:= monster
.X
- (MonsterSize
[monster
.MonsterType
].Width
div 2);
3292 monster
.Y
:= monster
.Y
- MonsterSize
[monster
.MonsterType
].Height
;
3295 if rbMonsterLeft
.Checked
then
3296 monster
.Direction
:= D_LEFT
3298 monster
.Direction
:= D_RIGHT
;
3299 Undo_Add(OBJECT_MONSTER
, AddMonster(monster
));
3302 if lbAreasList
.ItemIndex
= -1 then
3303 ErrorMessageBox(_lc
[I_MSG_CHOOSE_AREA
])
3305 if (lbAreasList
.ItemIndex
+ 1) <> AREA_DOMFLAG
then
3307 area
.AreaType
:= lbAreasList
.ItemIndex
+ AREA_PLAYERPOINT1
;
3308 area
.X
:= MousePos
.X
-MapOffset
.X
;
3309 area
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3311 if not (ssCtrl
in Shift
) then
3313 area
.X
:= area
.X
- (AreaSize
[area
.AreaType
].Width
div 2);
3314 area
.Y
:= area
.Y
- AreaSize
[area
.AreaType
].Height
;
3317 if rbAreaLeft
.Checked
then
3318 area
.Direction
:= D_LEFT
3320 area
.Direction
:= D_RIGHT
;
3321 Undo_Add(OBJECT_AREA
, AddArea(area
));
3327 i
:= GetFirstSelected();
3329 // Выбираем объект под текущим:
3330 if (SelectedObjects
<> nil) and
3331 (ssShift
in Shift
) and (i
>= 0) and
3332 (SelectedObjects
[i
].Live
) then
3334 if SelectedObjectCount() = 1 then
3335 SelectNextObject(X
-MapOffset
.X
, Y
-MapOffset
.Y
,
3336 SelectedObjects
[i
].ObjectType
,
3337 SelectedObjects
[i
].ID
);
3341 // Рисуем область триггера "Расширитель":
3342 if DrawPressRect
and (i
>= 0) and
3343 (SelectedObjects
[i
].ObjectType
= OBJECT_TRIGGER
) and
3344 (gTriggers
[SelectedObjects
[i
].ID
].TriggerType
in
3345 [TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
]) then
3346 MouseAction
:= MOUSEACTION_DRAWPRESS
3347 else // Рисуем панель:
3348 if pcObjects
.ActivePageIndex
= 0 then
3350 if (lbPanelType
.ItemIndex
>= 0) then
3351 MouseAction
:= MOUSEACTION_DRAWPANEL
3353 else // Рисуем триггер:
3354 if (lbTriggersList
.ItemIndex
>= 0) then
3356 MouseAction
:= MOUSEACTION_DRAWTRIGGER
;
3360 end; // if Button = mbLeft
3362 if Button
= mbRight
then // Right Mouse Button
3364 // Клик по мини-карте:
3366 g_CollidePoint(X
, Y
,
3367 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3369 max(gMapInfo
.Width
div (16 div Scale
), 1),
3370 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3372 MouseAction
:= MOUSEACTION_NOACTION
;
3374 else // Нужно что-то выбрать мышью:
3375 if SelectFlag
<> SELECTFLAG_NONE
then
3378 SELECTFLAG_TELEPORT
:
3379 // Точку назначения телепортации:
3380 with gTriggers
[SelectedObjects
[
3381 GetFirstSelected() ].ID
].Data
.TargetPoint
do
3383 X
:= MousePos
.X
-MapOffset
.X
;
3384 Y
:= MousePos
.Y
-MapOffset
.Y
;
3387 SELECTFLAG_SPAWNPOINT
:
3388 // Точку создания монстра:
3389 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3390 if TriggerType
= TRIGGER_SPAWNMONSTER
then
3392 Data
.MonPos
.X
:= MousePos
.X
-MapOffset
.X
;
3393 Data
.MonPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3395 else if TriggerType
= TRIGGER_SPAWNITEM
then
3396 begin // Точка создания предмета:
3397 Data
.ItemPos
.X
:= MousePos
.X
-MapOffset
.X
;
3398 Data
.ItemPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3400 else if TriggerType
= TRIGGER_SHOT
then
3401 begin // Точка создания выстрела:
3402 Data
.ShotPos
.X
:= MousePos
.X
-MapOffset
.X
;
3403 Data
.ShotPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3409 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3411 2, 2, OBJECT_PANEL
, True);
3412 if IDArray
<> nil then
3414 for i
:= 0 to High(IDArray
) do
3415 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3416 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
) then
3418 gTriggers
[SelectedObjects
[
3419 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3424 gTriggers
[SelectedObjects
[
3425 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3429 // Панель с текстурой:
3431 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3433 2, 2, OBJECT_PANEL
, True);
3434 if IDArray
<> nil then
3436 for i
:= 0 to High(IDArray
) do
3437 if ((gPanels
[IDArray
[i
]].PanelType
in
3438 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3439 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3441 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3442 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3443 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3445 gTriggers
[SelectedObjects
[
3446 GetFirstSelected() ].ID
].TexturePanel
:= IDArray
[i
];
3451 gTriggers
[SelectedObjects
[
3452 GetFirstSelected() ].ID
].TexturePanel
:= -1;
3458 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3460 2, 2, OBJECT_PANEL
, True);
3461 if IDArray
<> nil then
3463 for i
:= 0 to High(IDArray
) do
3464 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTUP
) or
3465 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTDOWN
) or
3466 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTLEFT
) or
3467 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTRIGHT
) then
3469 gTriggers
[SelectedObjects
[
3470 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3475 gTriggers
[SelectedObjects
[
3476 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3482 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3484 2, 2, OBJECT_MONSTER
, False);
3485 if IDArray
<> nil then
3486 gTriggers
[SelectedObjects
[
3487 GetFirstSelected() ].ID
].Data
.MonsterID
:= IDArray
[0]+1
3489 gTriggers
[SelectedObjects
[
3490 GetFirstSelected() ].ID
].Data
.MonsterID
:= 0;
3493 SELECTFLAG_SHOTPANEL
:
3494 // Панель индикации выстрела:
3496 if gTriggers
[SelectedObjects
[
3497 GetFirstSelected() ].ID
].TriggerType
= TRIGGER_SHOT
then
3499 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3501 2, 2, OBJECT_PANEL
, True);
3502 if IDArray
<> nil then
3504 for i
:= 0 to High(IDArray
) do
3505 if ((gPanels
[IDArray
[i
]].PanelType
in
3506 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3507 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3509 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3510 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3511 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3513 gTriggers
[SelectedObjects
[
3514 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= IDArray
[i
];
3519 gTriggers
[SelectedObjects
[
3520 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= -1;
3525 SelectFlag
:= SELECTFLAG_SELECTED
;
3527 else // if SelectFlag <> SELECTFLAG_NONE...
3529 // Что уже выбрано и не нажат Ctrl:
3530 if (SelectedObjects
<> nil) and
3531 (not (ssCtrl
in Shift
)) then
3532 for i
:= 0 to High(SelectedObjects
) do
3533 with SelectedObjects
[i
] do
3536 if (ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) and
3537 (SelectedObjectCount() = 1) then
3539 Rect
:= ObjectGetRect(ObjectType
, ID
);
3541 c1
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3542 Rect
.X
-2, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3543 c2
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3544 Rect
.X
+Rect
.Width
-3, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3545 c3
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3546 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
-2, 4, 4);
3547 c4
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3548 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
+Rect
.Height
-3, 4, 4);
3550 // Меняем размер панели или триггера:
3551 if c1
or c2
or c3
or c4
then
3553 MouseAction
:= MOUSEACTION_RESIZE
;
3554 LastMovePoint
:= MousePos
;
3558 ResizeType
:= RESIZETYPE_HORIZONTAL
;
3560 ResizeDirection
:= RESIZEDIR_LEFT
3562 ResizeDirection
:= RESIZEDIR_RIGHT
;
3563 RenderPanel
.Cursor
:= crSizeWE
;
3567 ResizeType
:= RESIZETYPE_VERTICAL
;
3569 ResizeDirection
:= RESIZEDIR_UP
3571 ResizeDirection
:= RESIZEDIR_DOWN
;
3572 RenderPanel
.Cursor
:= crSizeNS
;
3579 // Перемещаем панель или триггер:
3580 if ObjectCollide(ObjectType
, ID
,
3582 Y
-MapOffset
.Y
-1, 2, 2) then
3584 MouseAction
:= MOUSEACTION_MOVEOBJ
;
3585 LastMovePoint
:= MousePos
;
3591 end; // if Button = mbRight
3593 MouseRDown
:= Button
= mbRight
;
3595 MouseRDownPos
:= MousePos
;
3597 MouseLDown
:= Button
= mbLeft
;
3599 MouseLDownPos
:= MousePos
;
3602 procedure TMainForm
.RenderPanelMouseUp(Sender
: TObject
;
3603 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3610 rSelectRect
: Boolean;
3612 if Button
= mbLeft
then
3613 MouseLDown
:= False;
3614 if Button
= mbRight
then
3615 MouseRDown
:= False;
3618 ResizeType
:= RESIZETYPE_NONE
;
3620 if Button
= mbLeft
then // Left Mouse Button
3622 if MouseAction
<> MOUSEACTION_NONE
then
3623 begin // Было действие мышью
3624 // Мышь сдвинулась во время удержания клавиши:
3625 if (MousePos
.X
<> MouseLDownPos
.X
) and
3626 (MousePos
.Y
<> MouseLDownPos
.Y
) then
3629 MOUSEACTION_DRAWPANEL
:
3631 // Фон или передний план без текстуры - ошибка:
3632 if (lbPanelType
.ItemIndex
in [1, 2]) and
3633 (lbTextureList
.ItemIndex
= -1) then
3634 ErrorMessageBox(_lc
[I_MSG_CHOOSE_TEXTURE
])
3635 else // Назначаем параметры панели:
3637 case lbPanelType
.ItemIndex
of
3638 0: Panel
.PanelType
:= PANEL_WALL
;
3639 1: Panel
.PanelType
:= PANEL_BACK
;
3640 2: Panel
.PanelType
:= PANEL_FORE
;
3641 3: Panel
.PanelType
:= PANEL_OPENDOOR
;
3642 4: Panel
.PanelType
:= PANEL_CLOSEDOOR
;
3643 5: Panel
.PanelType
:= PANEL_STEP
;
3644 6: Panel
.PanelType
:= PANEL_WATER
;
3645 7: Panel
.PanelType
:= PANEL_ACID1
;
3646 8: Panel
.PanelType
:= PANEL_ACID2
;
3647 9: Panel
.PanelType
:= PANEL_LIFTUP
;
3648 10: Panel
.PanelType
:= PANEL_LIFTDOWN
;
3649 11: Panel
.PanelType
:= PANEL_LIFTLEFT
;
3650 12: Panel
.PanelType
:= PANEL_LIFTRIGHT
;
3651 13: Panel
.PanelType
:= PANEL_BLOCKMON
;
3654 Panel
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3655 Panel
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3656 Panel
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3657 Panel
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3659 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3660 if (lbPanelType
.ItemIndex
in [9, 10, 11, 12, 13]) or
3661 (lbTextureList
.ItemIndex
= -1) then
3663 Panel
.TextureHeight
:= 1;
3664 Panel
.TextureWidth
:= 1;
3665 Panel
.TextureName
:= '';
3666 Panel
.TextureID
:= TEXTURE_SPECIAL_NONE
;
3668 else // Есть текстура:
3670 Panel
.TextureName
:= SelectedTexture();
3672 // Обычная текстура:
3673 if not IsSpecialTextureSel() then
3675 g_GetTextureSizeByName(Panel
.TextureName
,
3676 Panel
.TextureWidth
, Panel
.TextureHeight
);
3677 g_GetTexture(Panel
.TextureName
, Panel
.TextureID
);
3679 else // Спец.текстура:
3681 Panel
.TextureHeight
:= 1;
3682 Panel
.TextureWidth
:= 1;
3683 Panel
.TextureID
:= SpecialTextureID(SelectedTexture());
3688 Panel
.Blending
:= False;
3690 Undo_Add(OBJECT_PANEL
, AddPanel(Panel
));
3694 // Рисовали триггер:
3695 MOUSEACTION_DRAWTRIGGER
:
3697 trigger
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3698 trigger
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3699 trigger
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3700 trigger
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3702 trigger
.Enabled
:= True;
3703 trigger
.TriggerType
:= lbTriggersList
.ItemIndex
+1;
3704 trigger
.TexturePanel
:= -1;
3707 trigger
.ActivateType
:= 0;
3709 if clbActivationType
.Checked
[0] then
3710 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERCOLLIDE
;
3711 if clbActivationType
.Checked
[1] then
3712 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERCOLLIDE
;
3713 if clbActivationType
.Checked
[2] then
3714 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERPRESS
;
3715 if clbActivationType
.Checked
[3] then
3716 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERPRESS
;
3717 if clbActivationType
.Checked
[4] then
3718 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_SHOT
;
3719 if clbActivationType
.Checked
[5] then
3720 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_NOMONSTER
;
3722 // Необходимые для активации ключи:
3725 if clbKeys
.Checked
[0] then
3726 trigger
.Key
:= Trigger
.Key
or KEY_RED
;
3727 if clbKeys
.Checked
[1] then
3728 trigger
.Key
:= Trigger
.Key
or KEY_GREEN
;
3729 if clbKeys
.Checked
[2] then
3730 trigger
.Key
:= Trigger
.Key
or KEY_BLUE
;
3731 if clbKeys
.Checked
[3] then
3732 trigger
.Key
:= Trigger
.Key
or KEY_REDTEAM
;
3733 if clbKeys
.Checked
[4] then
3734 trigger
.Key
:= Trigger
.Key
or KEY_BLUETEAM
;
3736 // Параметры триггера:
3737 FillByte(trigger
.Data
.Default
[0], 128, 0);
3739 case trigger
.TriggerType
of
3740 // Переключаемая панель:
3741 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
3742 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
3743 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
3745 Trigger
.Data
.PanelID
:= -1;
3751 trigger
.Data
.TargetPoint
.X
:= trigger
.X
-64;
3752 trigger
.Data
.TargetPoint
.Y
:= trigger
.Y
-64;
3753 trigger
.Data
.d2d_teleport
:= True;
3754 trigger
.Data
.TlpDir
:= 0;
3757 // Изменение других триггеров:
3758 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
3761 trigger
.Data
.Count
:= 1;
3767 trigger
.Data
.Volume
:= 255;
3768 trigger
.Data
.Pan
:= 127;
3769 trigger
.Data
.PlayCount
:= 1;
3770 trigger
.Data
.Local
:= True;
3771 trigger
.Data
.SoundSwitch
:= False;
3777 trigger
.Data
.MusicAction
:= 1;
3780 // Создание монстра:
3781 TRIGGER_SPAWNMONSTER
:
3783 trigger
.Data
.MonType
:= MONSTER_ZOMBY
;
3784 trigger
.Data
.MonPos
.X
:= trigger
.X
-64;
3785 trigger
.Data
.MonPos
.Y
:= trigger
.Y
-64;
3786 trigger
.Data
.MonHealth
:= 0;
3787 trigger
.Data
.MonActive
:= False;
3788 trigger
.Data
.MonCount
:= 1;
3791 // Создание предмета:
3794 trigger
.Data
.ItemType
:= ITEM_AMMO_BULLETS
;
3795 trigger
.Data
.ItemPos
.X
:= trigger
.X
-64;
3796 trigger
.Data
.ItemPos
.Y
:= trigger
.Y
-64;
3797 trigger
.Data
.ItemOnlyDM
:= False;
3798 trigger
.Data
.ItemFalls
:= False;
3799 trigger
.Data
.ItemCount
:= 1;
3800 trigger
.Data
.ItemMax
:= 0;
3801 trigger
.Data
.ItemDelay
:= 0;
3807 trigger
.Data
.PushAngle
:= 90;
3808 trigger
.Data
.PushForce
:= 10;
3809 trigger
.Data
.ResetVel
:= True;
3814 trigger
.Data
.ScoreCount
:= 1;
3815 trigger
.Data
.ScoreCon
:= True;
3816 trigger
.Data
.ScoreMsg
:= True;
3821 trigger
.Data
.MessageKind
:= 0;
3822 trigger
.Data
.MessageSendTo
:= 0;
3823 trigger
.Data
.MessageText
:= '';
3824 trigger
.Data
.MessageTime
:= 144;
3829 trigger
.Data
.DamageValue
:= 5;
3830 trigger
.Data
.DamageInterval
:= 12;
3835 trigger
.Data
.HealValue
:= 5;
3836 trigger
.Data
.HealInterval
:= 36;
3841 trigger
.Data
.ShotType
:= TRIGGER_SHOT_BULLET
;
3842 trigger
.Data
.ShotSound
:= True;
3843 trigger
.Data
.ShotPanelID
:= -1;
3844 trigger
.Data
.ShotTarget
:= 0;
3845 trigger
.Data
.ShotIntSight
:= 0;
3846 trigger
.Data
.ShotAim
:= TRIGGER_SHOT_AIM_DEFAULT
;
3847 trigger
.Data
.ShotPos
.X
:= trigger
.X
-64;
3848 trigger
.Data
.ShotPos
.Y
:= trigger
.Y
-64;
3849 trigger
.Data
.ShotAngle
:= 0;
3850 trigger
.Data
.ShotWait
:= 18;
3851 trigger
.Data
.ShotAccuracy
:= 0;
3852 trigger
.Data
.ShotAmmo
:= 0;
3853 trigger
.Data
.ShotIntReload
:= 0;
3858 trigger
.Data
.FXCount
:= 1;
3859 trigger
.Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
3860 trigger
.Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
3861 trigger
.Data
.FXColorR
:= 0;
3862 trigger
.Data
.FXColorG
:= 0;
3863 trigger
.Data
.FXColorB
:= 255;
3864 trigger
.Data
.FXPos
:= TRIGGER_EFFECT_POS_CENTER
;
3865 trigger
.Data
.FXWait
:= 1;
3866 trigger
.Data
.FXVelX
:= 0;
3867 trigger
.Data
.FXVelY
:= -20;
3868 trigger
.Data
.FXSpreadL
:= 5;
3869 trigger
.Data
.FXSpreadR
:= 5;
3870 trigger
.Data
.FXSpreadU
:= 4;
3871 trigger
.Data
.FXSpreadD
:= 0;
3875 Undo_Add(OBJECT_TRIGGER
, AddTrigger(trigger
));
3878 // Рисовали область триггера "Расширитель":
3879 MOUSEACTION_DRAWPRESS
:
3880 with gTriggers
[SelectedObjects
[GetFirstSelected
].ID
] do
3882 Data
.tX
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3883 Data
.tY
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3884 Data
.tWidth
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3885 Data
.tHeight
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3887 DrawPressRect
:= False;
3891 MouseAction
:= MOUSEACTION_NONE
;
3893 end // if Button = mbLeft...
3894 else // Right Mouse Button:
3896 if MouseAction
= MOUSEACTION_NOACTION
then
3898 MouseAction
:= MOUSEACTION_NONE
;
3902 // Объект передвинут или изменен в размере:
3903 if MouseAction
in [MOUSEACTION_MOVEOBJ
, MOUSEACTION_RESIZE
] then
3905 MouseAction
:= MOUSEACTION_NONE
;
3910 // Еще не все выбрали:
3911 if SelectFlag
<> SELECTFLAG_NONE
then
3913 if SelectFlag
= SELECTFLAG_SELECTED
then
3914 SelectFlag
:= SELECTFLAG_NONE
;
3919 // Мышь сдвинулась во время удержания клавиши:
3920 if (MousePos
.X
<> MouseRDownPos
.X
) and
3921 (MousePos
.Y
<> MouseRDownPos
.Y
) then
3923 rSelectRect
:= True;
3925 rRect
.X
:= Min(MousePos
.X
, MouseRDownPos
.X
)-MapOffset
.X
;
3926 rRect
.Y
:= Min(MousePos
.Y
, MouseRDownPos
.Y
)-MapOffset
.Y
;
3927 rRect
.Width
:= Abs(MousePos
.X
-MouseRDownPos
.X
);
3928 rRect
.Height
:= Abs(MousePos
.Y
-MouseRDownPos
.Y
);
3930 else // Мышь не сдвинулась - нет прямоугольника:
3932 rSelectRect
:= False;
3934 rRect
.X
:= X
-MapOffset
.X
-1;
3935 rRect
.Y
:= Y
-MapOffset
.Y
-1;
3940 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
3941 if not (ssCtrl
in Shift
) then
3942 RemoveSelectFromObjects();
3944 // Выделяем всё в выбранном прямоугольнике:
3945 IDArray
:= ObjectInRect(rRect
.X
, rRect
.Y
,
3946 rRect
.Width
, rRect
.Height
,
3947 pcObjects
.ActivePageIndex
+1, rSelectRect
);
3949 if IDArray
<> nil then
3950 for i
:= 0 to High(IDArray
) do
3951 SelectObject(pcObjects
.ActivePageIndex
+1, IDArray
[i
],
3952 (ssCtrl
in Shift
) or rSelectRect
);
3958 procedure TMainForm
.RenderPanelPaint(Sender
: TObject
);
3963 procedure TMainForm
.RenderPanelMouseMove(Sender
: TObject
;
3964 Shift
: TShiftState
; X
, Y
: Integer);
3967 dWidth
, dHeight
: Integer;
3970 _id
:= GetFirstSelected();
3972 // Рисуем панель с текстурой, сетка - размеры текстуры:
3973 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and
3974 (lbPanelType
.ItemIndex
in [0..8]) and
3975 (lbTextureList
.ItemIndex
<> -1) and
3976 (not IsSpecialTextureSel()) then
3978 sX
:= StrToIntDef(lTextureWidth
.Caption
, DotStep
);
3979 sY
:= StrToIntDef(lTextureHeight
.Caption
, DotStep
);
3982 // Меняем размер панели с текстурой, сетка - размеры текстуры:
3983 if (MouseAction
= MOUSEACTION_RESIZE
) and
3984 ( (SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
) and
3985 IsTexturedPanel(gPanels
[SelectedObjects
[_id
].ID
].PanelType
) and
3986 (gPanels
[SelectedObjects
[_id
].ID
].TextureName
<> '') and
3987 (not IsSpecialTexture(gPanels
[SelectedObjects
[_id
].ID
].TextureName
)) ) then
3989 sX
:= gPanels
[SelectedObjects
[_id
].ID
].TextureWidth
;
3990 sY
:= gPanels
[SelectedObjects
[_id
].ID
].TextureHeight
;
3993 // Выравнивание по сетке:
3999 else // Нет выравнивания по сетке:
4005 // Новая позиция мыши:
4007 begin // Зажата левая кнопка мыши
4008 MousePos
.X
:= (Round((X
-MouseLDownPos
.X
)/sX
)*sX
)+MouseLDownPos
.X
;
4009 MousePos
.Y
:= (Round((Y
-MouseLDownPos
.Y
)/sY
)*sY
)+MouseLDownPos
.Y
;
4013 begin // Зажата правая кнопка мыши
4014 MousePos
.X
:= (Round((X
-MouseRDownPos
.X
)/sX
)*sX
)+MouseRDownPos
.X
;
4015 MousePos
.Y
:= (Round((Y
-MouseRDownPos
.Y
)/sY
)*sY
)+MouseRDownPos
.Y
;
4018 begin // Кнопки мыши не зажаты
4019 MousePos
.X
:= (Round(X
/sX
)*sX
);
4020 MousePos
.Y
:= (Round(Y
/sY
)*sY
);
4023 // Изменение размера закончилось - ставим обычный курсор:
4024 if ResizeType
= RESIZETYPE_NONE
then
4025 RenderPanel
.Cursor
:= crDefault
;
4027 // Зажата только правая кнопка мыши:
4028 if (not MouseLDown
) and (MouseRDown
) then
4030 // Рисуем прямоугольник выделения:
4031 if MouseAction
= MOUSEACTION_NONE
then
4033 if DrawRect
= nil then
4035 DrawRect
.Top
:= MouseRDownPos
.y
;
4036 DrawRect
.Left
:= MouseRDownPos
.x
;
4037 DrawRect
.Bottom
:= MousePos
.y
;
4038 DrawRect
.Right
:= MousePos
.x
;
4041 // Двигаем выделенные объекты:
4042 if MouseAction
= MOUSEACTION_MOVEOBJ
then
4044 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
,
4045 MousePos
.X
-LastMovePoint
.X
+WASDOffset
.X
,
4046 MousePos
.Y
-LastMovePoint
.Y
+WASDOffset
.Y
);
4051 // Меняем размер выделенного объекта:
4052 if MouseAction
= MOUSEACTION_RESIZE
then
4054 if (SelectedObjectCount
= 1) and
4055 (SelectedObjects
[GetFirstSelected
].Live
) then
4057 dWidth
:= MousePos
.X
-LastMovePoint
.X
+WASDOffset
.X
;
4058 dHeight
:= MousePos
.Y
-LastMovePoint
.Y
+WASDOffset
.Y
;
4063 RESIZETYPE_VERTICAL
: dWidth
:= 0;
4064 RESIZETYPE_HORIZONTAL
: dHeight
:= 0;
4067 case ResizeDirection
of
4068 RESIZEDIR_UP
: dHeight
:= -dHeight
;
4069 RESIZEDIR_LEFT
: dWidth
:= -dWidth
;
4072 ResizeObject(SelectedObjects
[GetFirstSelected
].ObjectType
,
4073 SelectedObjects
[GetFirstSelected
].ID
,
4074 dWidth
, dHeight
, ResizeDirection
);
4076 LastMovePoint
:= MousePos
;
4081 // Зажата только левая кнопка мыши:
4082 if (not MouseRDown
) and (MouseLDown
) then
4084 // Рисуем прямоугольник планирования панели:
4085 if MouseAction
in [MOUSEACTION_DRAWPANEL
,
4086 MOUSEACTION_DRAWTRIGGER
,
4087 MOUSEACTION_DRAWPRESS
] then
4089 if DrawRect
= nil then
4091 DrawRect
.Top
:= MouseLDownPos
.y
;
4092 DrawRect
.Left
:= MouseLDownPos
.x
;
4093 DrawRect
.Bottom
:= MousePos
.y
;
4094 DrawRect
.Right
:= MousePos
.x
;
4096 else // Двигаем карту:
4097 if MouseAction
= MOUSEACTION_MOVEMAP
then
4103 // Клавиши мыши не зажаты:
4104 if (not MouseRDown
) and (not MouseLDown
) then
4107 // Строка состояния - координаты мыши:
4108 StatusBar
.Panels
[1].Text := Format('(%d:%d)',
4109 [MousePos
.X
-MapOffset
.X
, MousePos
.Y
-MapOffset
.Y
]);
4112 procedure TMainForm
.FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
4114 CanClose
:= MessageBox(0, PChar(_lc
[I_MSG_EXIT_PROMT
]),
4115 PChar(_lc
[I_MSG_EXIT
]),
4116 MB_ICONQUESTION
or MB_YESNO
or
4117 MB_DEFBUTTON1
) = idYes
;
4120 procedure TMainForm
.aExitExecute(Sender
: TObject
);
4125 procedure TMainForm
.FormDestroy(Sender
: TObject
);
4130 config
:= TConfig
.CreateFile(EditorDir
+'Editor.cfg');
4132 if WindowState
<> wsMaximized
then
4134 config
.WriteInt('Editor', 'XPos', Left
);
4135 config
.WriteInt('Editor', 'YPos', Top
);
4136 config
.WriteInt('Editor', 'Width', Width
);
4137 config
.WriteInt('Editor', 'Height', Height
);
4141 config
.WriteInt('Editor', 'XPos', RestoredLeft
);
4142 config
.WriteInt('Editor', 'YPos', RestoredTop
);
4143 config
.WriteInt('Editor', 'Width', RestoredWidth
);
4144 config
.WriteInt('Editor', 'Height', RestoredHeight
);
4146 config
.WriteBool('Editor', 'Maximize', WindowState
= wsMaximized
);
4147 config
.WriteBool('Editor', 'Minimap', ShowMap
);
4148 config
.WriteInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
4149 config
.WriteInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
4150 config
.WriteBool('Editor', 'DotEnable', DotEnable
);
4151 config
.WriteInt('Editor', 'DotStep', DotStep
);
4152 config
.WriteStr('Editor', 'LastOpenDir', OpenDialog
.InitialDir
);
4153 config
.WriteStr('Editor', 'LastSaveDir', SaveDialog
.InitialDir
);
4154 config
.WriteBool('Editor', 'EdgeShow', drEdge
[3] < 255);
4155 config
.WriteInt('Editor', 'EdgeColor', gColorEdge
);
4156 config
.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge
);
4157 config
.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine
);
4158 config
.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea
);
4160 for i
:= 0 to RecentCount
-1 do
4161 if i
< RecentFiles
.Count
then
4162 config
.WriteStr('RecentFiles', IntToStr(i
+1), RecentFiles
[i
])
4164 config
.WriteStr('RecentFiles', IntToStr(i
+1), '');
4167 config
.SaveFile(EditorDir
+'Editor.cfg');
4170 slInvalidTextures
.Free
;
4173 procedure TMainForm
.FormDropFiles(Sender
: TObject
;
4174 const FileNames
: array of String);
4176 if Length(FileNames
) <> 1 then
4179 OpenMapFile(FileNames
[0]);
4182 procedure TMainForm
.RenderPanelResize(Sender
: TObject
);
4184 if MainForm
.Visible
then
4188 procedure TMainForm
.Splitter1Moved(Sender
: TObject
);
4193 procedure TMainForm
.aMapOptionsExecute(Sender
: TObject
);
4197 MapOptionsForm
.ShowModal();
4199 ResName
:= OpenedMap
;
4200 while (Pos(':\', ResName
) > 0) do
4201 Delete(ResName
, 1, Pos(':\', ResName
) + 1);
4203 UpdateCaption(gMapInfo
.Name
, ExtractFileName(OpenedWAD
), ResName
);
4206 procedure TMainForm
.aAboutExecute(Sender
: TObject
);
4208 AboutForm
.ShowModal();
4211 procedure TMainForm
.FormKeyDown(Sender
: TObject
; var Key
: Word;
4212 Shift
: TShiftState
);
4217 if (not EditingProperties
) then
4219 if Key
= Ord('1') then
4220 SwitchLayer(LAYER_BACK
);
4221 if Key
= Ord('2') then
4222 SwitchLayer(LAYER_WALLS
);
4223 if Key
= Ord('3') then
4224 SwitchLayer(LAYER_FOREGROUND
);
4225 if Key
= Ord('4') then
4226 SwitchLayer(LAYER_STEPS
);
4227 if Key
= Ord('5') then
4228 SwitchLayer(LAYER_WATER
);
4229 if Key
= Ord('6') then
4230 SwitchLayer(LAYER_ITEMS
);
4231 if Key
= Ord('7') then
4232 SwitchLayer(LAYER_MONSTERS
);
4233 if Key
= Ord('8') then
4234 SwitchLayer(LAYER_AREAS
);
4235 if Key
= Ord('9') then
4236 SwitchLayer(LAYER_TRIGGERS
);
4237 if Key
= Ord('0') then
4238 tbShowClick(tbShow
);
4240 if Key
= Ord('V') then
4241 begin // Поворот монстров и областей:
4242 if (SelectedObjects
<> nil) then
4244 for i
:= 0 to High(SelectedObjects
) do
4245 if (SelectedObjects
[i
].Live
) then
4247 if (SelectedObjects
[i
].ObjectType
= OBJECT_MONSTER
) then
4249 g_ChangeDir(gMonsters
[SelectedObjects
[i
].ID
].Direction
);
4252 if (SelectedObjects
[i
].ObjectType
= OBJECT_AREA
) then
4254 g_ChangeDir(gAreas
[SelectedObjects
[i
].ID
].Direction
);
4260 if pcObjects
.ActivePage
= tsMonsters
then
4262 if rbMonsterLeft
.Checked
then
4263 rbMonsterRight
.Checked
:= True
4265 rbMonsterLeft
.Checked
:= True;
4267 if pcObjects
.ActivePage
= tsAreas
then
4269 if rbAreaLeft
.Checked
then
4270 rbAreaRight
.Checked
:= True
4272 rbAreaLeft
.Checked
:= True;
4277 if not (ssCtrl
in Shift
) then
4279 // Быстрое превью карты:
4280 if Key
= Ord('E') then
4282 if PreviewMode
= 0 then
4286 // Вертикальный скролл карты:
4289 if Key
= Ord('W') then
4291 if (MouseLDown
or MouseRDown
) and (Position
>= DotStep
) then
4293 Dec(WASDOffset
.Y
, DotStep
);
4294 RenderPanelMouseMove(Sender
, Shift
, LastMovePoint
.X
, LastMovePoint
.Y
);
4296 Position
:= IfThen(Position
> DotStep
, Position
-DotStep
, 0);
4297 MapOffset
.Y
:= -Round(Position
/16) * 16;
4300 if Key
= Ord('S') then
4302 if (MouseLDown
or MouseRDown
) and (Position
+DotStep
<= Max
) then
4304 Inc(WASDOffset
.Y
, DotStep
);
4305 RenderPanelMouseMove(Sender
, Shift
, LastMovePoint
.X
, LastMovePoint
.Y
);
4307 Position
:= IfThen(Position
+DotStep
< Max
, Position
+DotStep
, Max
);
4308 MapOffset
.Y
:= -Round(Position
/16) * 16;
4312 // Горизонтальный скролл карты:
4313 with sbHorizontal
do
4315 if Key
= Ord('A') then
4317 if (MouseLDown
or MouseRDown
) and (Position
>= DotStep
) then
4319 Dec(WASDOffset
.X
, DotStep
);
4320 RenderPanelMouseMove(Sender
, Shift
, LastMovePoint
.X
, LastMovePoint
.Y
);
4322 Position
:= IfThen(Position
> DotStep
, Position
-DotStep
, 0);
4323 MapOffset
.X
:= -Round(Position
/16) * 16;
4326 if Key
= Ord('D') then
4328 if (MouseLDown
or MouseRDown
) and (Position
+DotStep
<= Max
) then
4330 Inc(WASDOffset
.X
, DotStep
);
4331 RenderPanelMouseMove(Sender
, Shift
, LastMovePoint
.X
, LastMovePoint
.Y
);
4333 Position
:= IfThen(Position
+DotStep
< Max
, Position
+DotStep
, Max
);
4334 MapOffset
.X
:= -Round(Position
/16) * 16;
4338 else // ssCtrl in Shift
4340 if ssShift
in Shift
then
4342 // Вставка по абсолютному смещению:
4343 if Key
= Ord('V') then
4344 aPasteObjectExecute(Sender
);
4349 // Удалить выделенные объекты:
4350 if (Key
= VK_DELETE
) and (SelectedObjects
<> nil) and
4351 RenderPanel
.Focused() then
4352 DeleteSelectedObjects();
4355 if (Key
= VK_ESCAPE
) and (SelectedObjects
<> nil) then
4356 RemoveSelectFromObjects();
4358 // Передвинуть объекты:
4359 if MainForm
.ActiveControl
= RenderPanel
then
4364 if Key
= VK_NUMPAD4
then
4365 dx
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4366 if Key
= VK_NUMPAD6
then
4367 dx
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4368 if Key
= VK_NUMPAD8
then
4369 dy
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4370 if Key
= VK_NUMPAD5
then
4371 dy
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4373 if (dx
<> 0) or (dy
<> 0) then
4375 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
, dx
, dy
);
4380 if ssCtrl
in Shift
then
4382 // Выбор панели с текстурой для триггера
4383 if Key
= Ord('T') then
4385 DrawPressRect
:= False;
4386 if SelectFlag
= SELECTFLAG_TEXTURE
then
4388 SelectFlag
:= SELECTFLAG_NONE
;
4391 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TEXTURE_PANEL
], i
);
4393 SelectFlag
:= SELECTFLAG_TEXTURE
;
4396 if Key
= Ord('D') then
4398 SelectFlag
:= SELECTFLAG_NONE
;
4399 if DrawPressRect
then
4401 DrawPressRect
:= False;
4406 // Выбор области воздействия, в зависимости от типа триггера
4407 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_EX_AREA
], i
);
4410 DrawPressRect
:= True;
4413 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_DOOR_PANEL
], i
);
4415 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TRAP_PANEL
], i
);
4418 SelectFlag
:= SELECTFLAG_DOOR
;
4421 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_LIFT_PANEL
], i
);
4424 SelectFlag
:= SELECTFLAG_LIFT
;
4427 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TELEPORT_TO
], i
);
4430 SelectFlag
:= SELECTFLAG_TELEPORT
;
4433 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_SPAWN_TO
], i
);
4436 SelectFlag
:= SELECTFLAG_SPAWNPOINT
;
4440 // Выбор основного параметра, в зависимости от типа триггера
4441 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_NEXT_MAP
], i
);
4444 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
4445 SelectMapForm
.Caption
:= _lc
[I_CAP_SELECT
];
4446 SelectMapForm
.GetMaps(FileName
);
4448 if SelectMapForm
.ShowModal() = mrOK
then
4450 vleObjectProperty
.Cells
[1, i
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
4451 bApplyProperty
.Click();
4455 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_SOUND_NAME
], i
);
4457 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_MUSIC_NAME
], i
);
4460 AddSoundForm
.OKFunction
:= nil;
4461 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
4462 AddSoundForm
.SetResource
:= vleObjectProperty
.Cells
[1, i
];
4464 if (AddSoundForm
.ShowModal() = mrOk
) then
4466 vleObjectProperty
.Cells
[1, i
] := AddSoundForm
.ResourceName
;
4467 bApplyProperty
.Click();
4471 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_PUSH_ANGLE
], i
);
4473 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_MESSAGE_TEXT
], i
);
4476 vleObjectProperty
.Row
:= i
;
4477 vleObjectProperty
.SetFocus();
4484 procedure TMainForm
.aOptimizeExecute(Sender
: TObject
);
4486 RemoveSelectFromObjects();
4487 MapOptimizationForm
.ShowModal();
4490 procedure TMainForm
.aCheckMapExecute(Sender
: TObject
);
4492 MapCheckForm
.ShowModal();
4495 procedure TMainForm
.bbAddTextureClick(Sender
: TObject
);
4497 AddTextureForm
.lbResourcesList
.MultiSelect
:= True;
4498 AddTextureForm
.ShowModal();
4501 procedure TMainForm
.lbTextureListClick(Sender
: TObject
);
4504 TextureWidth
, TextureHeight
: Word;
4509 if (lbTextureList
.ItemIndex
<> -1) and
4510 (not IsSpecialTextureSel()) then
4512 if g_GetTexture(SelectedTexture(), TextureID
) then
4514 g_GetTextureSizeByID(TextureID
, TextureWidth
, TextureHeight
);
4516 lTextureWidth
.Caption
:= IntToStr(TextureWidth
);
4517 lTextureHeight
.Caption
:= IntToStr(TextureHeight
);
4520 lTextureWidth
.Caption
:= _lc
[I_NOT_ACCESSIBLE
];
4521 lTextureHeight
.Caption
:= _lc
[I_NOT_ACCESSIBLE
];
4526 lTextureWidth
.Caption
:= '';
4527 lTextureHeight
.Caption
:= '';
4531 procedure TMainForm
.lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
4532 ARect
: TRect
; State
: TOwnerDrawState
);
4534 with Control
as TListBox
do
4536 if LCLType
.odSelected
in State
then
4538 Canvas
.Brush
.Color
:= clHighlight
;
4539 Canvas
.Font
.Color
:= clHighlightText
;
4541 if (Items
<> nil) and (Index
>= 0) then
4542 if slInvalidTextures
.IndexOf(Items
[Index
]) > -1 then
4544 Canvas
.Brush
.Color
:= clRed
;
4545 Canvas
.Font
.Color
:= clWhite
;
4547 Canvas
.FillRect(ARect
);
4548 Canvas
.TextRect(ARect
, ARect
.Left
, ARect
.Top
, Items
[Index
]);
4552 procedure TMainForm
.vleObjectPropertyGetPickList(Sender
: TObject
;
4553 const KeyName
: String; Values
: TStrings
);
4555 if vleObjectProperty
.ItemProps
[KeyName
].EditStyle
= esPickList
then
4557 if KeyName
= _lc
[I_PROP_DIRECTION
] then
4559 Values
.Add(DirNames
[D_LEFT
]);
4560 Values
.Add(DirNames
[D_RIGHT
]);
4562 else if KeyName
= _lc
[I_PROP_TR_TELEPORT_DIR
] then
4564 Values
.Add(DirNamesAdv
[0]);
4565 Values
.Add(DirNamesAdv
[1]);
4566 Values
.Add(DirNamesAdv
[2]);
4567 Values
.Add(DirNamesAdv
[3]);
4569 else if KeyName
= _lc
[I_PROP_TR_MUSIC_ACT
] then
4571 Values
.Add(_lc
[I_PROP_TR_MUSIC_ON
]);
4572 Values
.Add(_lc
[I_PROP_TR_MUSIC_OFF
]);
4574 else if KeyName
= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR
] then
4576 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_0
]);
4577 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_1
]);
4578 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_2
]);
4579 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_3
]);
4580 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_4
]);
4581 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_5
]);
4583 else if KeyName
= _lc
[I_PROP_TR_SCORE_ACT
] then
4585 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_0
]);
4586 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_1
]);
4587 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_2
]);
4588 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_3
]);
4590 else if KeyName
= _lc
[I_PROP_TR_SCORE_TEAM
] then
4592 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_0
]);
4593 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_1
]);
4594 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_2
]);
4595 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_3
]);
4597 else if KeyName
= _lc
[I_PROP_TR_MESSAGE_KIND
] then
4599 Values
.Add(_lc
[I_PROP_TR_MESSAGE_KIND_0
]);
4600 Values
.Add(_lc
[I_PROP_TR_MESSAGE_KIND_1
]);
4602 else if KeyName
= _lc
[I_PROP_TR_MESSAGE_TO
] then
4604 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_0
]);
4605 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_1
]);
4606 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_2
]);
4607 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_3
]);
4608 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_4
]);
4609 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_5
]);
4611 else if KeyName
= _lc
[I_PROP_TR_SHOT_TO
] then
4613 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_0
]);
4614 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_1
]);
4615 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_2
]);
4616 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_3
]);
4617 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_4
]);
4618 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_5
]);
4619 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_6
]);
4621 else if KeyName
= _lc
[I_PROP_TR_SHOT_AIM
] then
4623 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_0
]);
4624 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_1
]);
4625 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_2
]);
4626 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_3
]);
4628 else if (KeyName
= _lc
[I_PROP_PANEL_BLEND
]) or
4629 (KeyName
= _lc
[I_PROP_DM_ONLY
]) or
4630 (KeyName
= _lc
[I_PROP_ITEM_FALLS
]) or
4631 (KeyName
= _lc
[I_PROP_TR_ENABLED
]) or
4632 (KeyName
= _lc
[I_PROP_TR_D2D
]) or
4633 (KeyName
= _lc
[I_PROP_TR_SILENT
]) or
4634 (KeyName
= _lc
[I_PROP_TR_TELEPORT_SILENT
]) or
4635 (KeyName
= _lc
[I_PROP_TR_EX_RANDOM
]) or
4636 (KeyName
= _lc
[I_PROP_TR_TEXTURE_ONCE
]) or
4637 (KeyName
= _lc
[I_PROP_TR_TEXTURE_ANIM_ONCE
]) or
4638 (KeyName
= _lc
[I_PROP_TR_SOUND_LOCAL
]) or
4639 (KeyName
= _lc
[I_PROP_TR_SOUND_SWITCH
]) or
4640 (KeyName
= _lc
[I_PROP_TR_MONSTER_ACTIVE
]) or
4641 (KeyName
= _lc
[I_PROP_TR_PUSH_RESET
]) or
4642 (KeyName
= _lc
[I_PROP_TR_SCORE_CON
]) or
4643 (KeyName
= _lc
[I_PROP_TR_SCORE_MSG
]) or
4644 (KeyName
= _lc
[I_PROP_TR_HEALTH_MAX
]) or
4645 (KeyName
= _lc
[I_PROP_TR_SHOT_SOUND
]) or
4646 (KeyName
= _lc
[I_PROP_TR_EFFECT_CENTER
]) then
4648 Values
.Add(BoolNames
[True]);
4649 Values
.Add(BoolNames
[False]);
4654 procedure TMainForm
.bApplyPropertyClick(Sender
: TObject
);
4656 _id
, a
, r
, c
: Integer;
4666 if SelectedObjectCount() <> 1 then
4668 if not SelectedObjects
[GetFirstSelected()].Live
then
4672 if not CheckProperty() then
4678 _id
:= GetFirstSelected();
4680 r
:= vleObjectProperty
.Row
;
4681 c
:= vleObjectProperty
.Col
;
4683 case SelectedObjects
[_id
].ObjectType
of
4686 with gPanels
[SelectedObjects
[_id
].ID
] do
4688 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4689 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4690 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]]));
4691 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]));
4693 PanelType
:= GetPanelType(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_TYPE
]]);
4695 // Сброс ссылки на триггеры смены текстуры:
4696 if not WordBool(PanelType
and (PANEL_WALL
or PANEL_FORE
or PANEL_BACK
)) then
4697 if gTriggers
<> nil then
4698 for a
:= 0 to High(gTriggers
) do
4700 if (gTriggers
[a
].TriggerType
<> 0) and
4701 (gTriggers
[a
].TexturePanel
= Integer(SelectedObjects
[_id
].ID
)) then
4702 gTriggers
[a
].TexturePanel
:= -1;
4703 if (gTriggers
[a
].TriggerType
= TRIGGER_SHOT
) and
4704 (gTriggers
[a
].Data
.ShotPanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4705 gTriggers
[a
].Data
.ShotPanelID
:= -1;
4708 // Сброс ссылки на триггеры лифта:
4709 if not WordBool(PanelType
and (PANEL_LIFTUP
or PANEL_LIFTDOWN
or PANEL_LIFTLEFT
or PANEL_LIFTRIGHT
)) then
4710 if gTriggers
<> nil then
4711 for a
:= 0 to High(gTriggers
) do
4712 if (gTriggers
[a
].TriggerType
in [TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
]) and
4713 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4714 gTriggers
[a
].Data
.PanelID
:= -1;
4716 // Сброс ссылки на триггеры двери:
4717 if not WordBool(PanelType
and (PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
4718 if gTriggers
<> nil then
4719 for a
:= 0 to High(gTriggers
) do
4720 if (gTriggers
[a
].TriggerType
in [TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
4721 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
]) and
4722 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4723 gTriggers
[a
].Data
.PanelID
:= -1;
4725 if IsTexturedPanel(PanelType
) then
4726 begin // Может быть текстура
4727 if TextureName
<> '' then
4728 begin // Была текстура
4729 Alpha
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_ALPHA
]]));
4730 Blending
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_BLEND
]]);
4739 TextureName
:= vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_TEX
]];
4741 if TextureName
<> '' then
4742 begin // Есть текстура
4743 // Обычная текстура:
4744 if not IsSpecialTexture(TextureName
) then
4746 g_GetTextureSizeByName(TextureName
,
4747 TextureWidth
, TextureHeight
);
4749 // Проверка кратности размеров панели:
4751 if TextureWidth
<> 0 then
4752 if gPanels
[SelectedObjects
[_id
].ID
].Width
mod TextureWidth
<> 0 then
4754 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXWIDTH
],
4758 if Res
and (TextureHeight
<> 0) then
4759 if gPanels
[SelectedObjects
[_id
].ID
].Height
mod TextureHeight
<> 0 then
4761 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXHEIGHT
],
4768 if not g_GetTexture(TextureName
, TextureID
) then
4769 // Не удалось загрузить текстуру, рисуем NOTEXTURE
4770 if g_GetTexture('NOTEXTURE', NoTextureID
) then
4772 TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
4773 g_GetTextureSizeByID(NoTextureID
, NW
, NH
);
4775 TextureHeight
:= NH
;
4778 TextureID
:= TEXTURE_SPECIAL_NONE
;
4788 TextureID
:= TEXTURE_SPECIAL_NONE
;
4791 else // Спец.текстура
4795 TextureID
:= SpecialTextureID(TextureName
);
4798 else // Нет текстуры
4802 TextureID
:= TEXTURE_SPECIAL_NONE
;
4805 else // Не может быть текстуры
4812 TextureID
:= TEXTURE_SPECIAL_NONE
;
4819 with gItems
[SelectedObjects
[_id
].ID
] do
4821 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4822 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4823 OnlyDM
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_DM_ONLY
]]);
4824 Fall
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_ITEM_FALLS
]]);
4830 with gMonsters
[SelectedObjects
[_id
].ID
] do
4832 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4833 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4834 Direction
:= NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]);
4840 with gAreas
[SelectedObjects
[_id
].ID
] do
4842 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4843 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4844 Direction
:= NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]);
4850 with gTriggers
[SelectedObjects
[_id
].ID
] do
4852 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4853 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4854 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]]));
4855 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]));
4856 Enabled
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ENABLED
]]);
4857 ActivateType
:= StrToActivate(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ACTIVATION
]]);
4858 Key
:= StrToKey(vleObjectProperty
.Values
[_lc
[I_PROP_TR_KEYS
]]);
4863 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_NEXT_MAP
]]);
4864 FillByte(Data
.MapName
[0], 16, 0);
4866 Move(s
[1], Data
.MapName
[0], Min(Length(s
), 16));
4871 Data
.ActivateOnce
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TEXTURE_ONCE
]]);
4872 Data
.AnimOnce
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TEXTURE_ANIM_ONCE
]]);
4875 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
4877 Data
.Wait
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 65535);
4878 Data
.Count
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_COUNT
]], 0), 65535);
4879 if Data
.Count
< 1 then
4881 if TriggerType
= TRIGGER_PRESS
then
4882 Data
.ExtRandom
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_RANDOM
]]);
4885 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
, TRIGGER_DOOR5
,
4886 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
, TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
,
4889 Data
.NoSound
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SILENT
]]);
4890 Data
.d2d_doors
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_D2D
]]);
4895 Data
.d2d_teleport
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_D2D
]]);
4896 Data
.silent_teleport
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TELEPORT_SILENT
]]);
4897 Data
.TlpDir
:= NameToDirAdv(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TELEPORT_DIR
]]);
4902 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_NAME
]]);
4903 FillByte(Data
.SoundName
[0], 64, 0);
4905 Move(s
[1], Data
.SoundName
[0], Min(Length(s
), 64));
4907 Data
.Volume
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_VOLUME
]], 0), 255);
4908 Data
.Pan
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_PAN
]], 0), 255);
4909 Data
.PlayCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_COUNT
]], 0), 255);
4910 Data
.Local
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_LOCAL
]]);
4911 Data
.SoundSwitch
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_SWITCH
]]);
4914 TRIGGER_SPAWNMONSTER
:
4916 Data
.MonType
:= StrToMonster(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_TYPE
]]);
4917 Data
.MonDir
:= Byte(NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]));
4918 Data
.MonHealth
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH
]], 0), 1000000);
4919 if Data
.MonHealth
< 0 then
4920 Data
.MonHealth
:= 0;
4921 Data
.MonActive
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_ACTIVE
]]);
4922 Data
.MonCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 64);
4923 if Data
.MonCount
< 1 then
4925 Data
.MonEffect
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_FX_TYPE
]]);
4926 Data
.MonMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_MAX
]], 0), 65535);
4927 Data
.MonDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_DELAY
]], 0), 65535);
4929 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_1
] then
4931 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_2
] then
4933 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_3
] then
4935 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_4
] then
4937 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_5
] then
4943 Data
.ItemType
:= StrToItem(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ITEM_TYPE
]]);
4944 Data
.ItemOnlyDM
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_DM_ONLY
]]);
4945 Data
.ItemFalls
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_ITEM_FALLS
]]);
4946 Data
.ItemCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 64);
4947 if Data
.ItemCount
< 1 then
4948 Data
.ItemCount
:= 1;
4949 Data
.ItemEffect
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_FX_TYPE
]]);
4950 Data
.ItemMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_MAX
]], 0), 65535);
4951 Data
.ItemDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_DELAY
]], 0), 65535);
4956 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MUSIC_NAME
]]);
4957 FillByte(Data
.MusicName
[0], 64, 0);
4959 Move(s
[1], Data
.MusicName
[0], Min(Length(s
), 64));
4961 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MUSIC_ACT
]] = _lc
[I_PROP_TR_MUSIC_ON
] then
4962 Data
.MusicAction
:= 1
4964 Data
.MusicAction
:= 2;
4969 Data
.PushAngle
:= Min(
4970 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_ANGLE
]], 0), 360);
4971 Data
.PushForce
:= Min(
4972 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_FORCE
]], 0), 255);
4973 Data
.ResetVel
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_RESET
]]);
4978 Data
.ScoreAction
:= 0;
4979 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_1
] then
4980 Data
.ScoreAction
:= 1
4981 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_2
] then
4982 Data
.ScoreAction
:= 2
4983 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_3
] then
4984 Data
.ScoreAction
:= 3;
4985 Data
.ScoreCount
:= Min(Max(
4986 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 0), 255);
4987 Data
.ScoreTeam
:= 0;
4988 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_1
] then
4990 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_2
] then
4992 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_3
] then
4993 Data
.ScoreTeam
:= 3;
4994 Data
.ScoreCon
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_CON
]]);
4995 Data
.ScoreMsg
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_MSG
]]);
5000 Data
.MessageKind
:= 0;
5001 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_KIND
]] = _lc
[I_PROP_TR_MESSAGE_KIND_1
] then
5002 Data
.MessageKind
:= 1;
5004 Data
.MessageSendTo
:= 0;
5005 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_1
] then
5006 Data
.MessageSendTo
:= 1
5007 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_2
] then
5008 Data
.MessageSendTo
:= 2
5009 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_3
] then
5010 Data
.MessageSendTo
:= 3
5011 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_4
] then
5012 Data
.MessageSendTo
:= 4
5013 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_5
] then
5014 Data
.MessageSendTo
:= 5;
5016 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TEXT
]]);
5017 FillByte(Data
.MessageText
[0], 100, 0);
5019 Move(s
[1], Data
.MessageText
[0], Min(Length(s
), 100));
5021 Data
.MessageTime
:= Min(Max(
5022 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TIME
]], 0), 0), 65535);
5027 Data
.DamageValue
:= Min(Max(
5028 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_DAMAGE_VALUE
]], 0), 0), 65535);
5029 Data
.DamageInterval
:= Min(Max(
5030 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_INTERVAL
]], 0), 0), 65535);
5035 Data
.HealValue
:= Min(Max(
5036 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH
]], 0), 0), 65535);
5037 Data
.HealInterval
:= Min(Max(
5038 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_INTERVAL
]], 0), 0), 65535);
5039 Data
.HealMax
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH_MAX
]]);
5040 Data
.HealSilent
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SILENT
]]);
5045 Data
.ShotType
:= StrToShot(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TYPE
]]);
5046 Data
.ShotSound
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_SOUND
]]);
5047 Data
.ShotTarget
:= 0;
5048 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_1
] then
5049 Data
.ShotTarget
:= 1
5050 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_2
] then
5051 Data
.ShotTarget
:= 2
5052 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_3
] then
5053 Data
.ShotTarget
:= 3
5054 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_4
] then
5055 Data
.ShotTarget
:= 4
5056 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_5
] then
5057 Data
.ShotTarget
:= 5
5058 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_6
] then
5059 Data
.ShotTarget
:= 6;
5060 Data
.ShotIntSight
:= Min(Max(
5061 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_SIGHT
]], 0), 0), 65535);
5063 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_1
] then
5065 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_2
] then
5067 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_3
] then
5069 Data
.ShotAngle
:= Min(
5070 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_ANGLE
]], 0), 360);
5071 Data
.ShotWait
:= Min(Max(
5072 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 0), 65535);
5073 Data
.ShotAccuracy
:= Min(Max(
5074 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_ACC
]], 0), 0), 65535);
5075 Data
.ShotAmmo
:= Min(Max(
5076 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AMMO
]], 0), 0), 65535);
5077 Data
.ShotIntReload
:= Min(Max(
5078 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_RELOAD
]], 0), 0), 65535);
5083 Data
.FXCount
:= Min(Max(
5084 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 0), 255);
5085 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_PARTICLE
] then
5087 Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
5088 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
5089 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_SLIQUID
] then
5090 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
5091 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_LLIQUID
] then
5092 Data
.FXSubType
:= TRIGGER_EFFECT_LLIQUID
5093 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_DLIQUID
] then
5094 Data
.FXSubType
:= TRIGGER_EFFECT_DLIQUID
5095 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_BLOOD
] then
5096 Data
.FXSubType
:= TRIGGER_EFFECT_BLOOD
5097 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_SPARK
] then
5098 Data
.FXSubType
:= TRIGGER_EFFECT_SPARK
5099 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_BUBBLE
] then
5100 Data
.FXSubType
:= TRIGGER_EFFECT_BUBBLE
;
5103 Data
.FXType
:= TRIGGER_EFFECT_ANIMATION
;
5104 Data
.FXSubType
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]]);
5107 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_COLOR
]], 0), 0), $FFFFFF);
5108 Data
.FXColorR
:= a
and $FF;
5109 Data
.FXColorG
:= (a
shr 8) and $FF;
5110 Data
.FXColorB
:= (a
shr 16) and $FF;
5111 if NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_CENTER
]]) then
5115 Data
.FXWait
:= Min(Max(
5116 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 0), 65535);
5117 Data
.FXVelX
:= Min(Max(
5118 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_VELX
]], 0), -128), 127);
5119 Data
.FXVelY
:= Min(Max(
5120 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_VELY
]], 0), -128), 127);
5121 Data
.FXSpreadL
:= Min(Max(
5122 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPL
]], 0), 0), 255);
5123 Data
.FXSpreadR
:= Min(Max(
5124 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPR
]], 0), 0), 255);
5125 Data
.FXSpreadU
:= Min(Max(
5126 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPU
]], 0), 0), 255);
5127 Data
.FXSpreadD
:= Min(Max(
5128 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPD
]], 0), 0), 255);
5137 vleObjectProperty
.Row
:= r
;
5138 vleObjectProperty
.Col
:= c
;
5141 procedure TMainForm
.bbRemoveTextureClick(Sender
: TObject
);
5145 i
:= lbTextureList
.ItemIndex
;
5149 if MessageBox(0, PChar(Format(_lc
[I_MSG_DEL_TEXTURE_PROMT
],
5150 [SelectedTexture()])),
5151 PChar(_lc
[I_MSG_DEL_TEXTURE
]),
5152 MB_ICONQUESTION
or MB_YESNO
or
5153 MB_DEFBUTTON1
) <> idYes
then
5156 if gPanels
<> nil then
5157 for a
:= 0 to High(gPanels
) do
5158 if (gPanels
[a
].PanelType
<> 0) and
5159 (gPanels
[a
].TextureName
= SelectedTexture()) then
5161 ErrorMessageBox(_lc
[I_MSG_DEL_TEXTURE_CANT
]);
5165 g_DeleteTexture(SelectedTexture());
5166 i
:= slInvalidTextures
.IndexOf(lbTextureList
.Items
[i
]);
5168 slInvalidTextures
.Delete(i
);
5169 if lbTextureList
.ItemIndex
> -1 then
5170 lbTextureList
.Items
.Delete(lbTextureList
.ItemIndex
)
5173 procedure TMainForm
.aNewMapExecute(Sender
: TObject
);
5175 if (MessageBox(0, PChar(_lc
[I_MSG_CLEAR_MAP_PROMT
]),
5176 PChar(_lc
[I_MSG_CLEAR_MAP
]),
5177 MB_ICONQUESTION
or MB_YESNO
or
5178 MB_DEFBUTTON1
) = mrYes
) then
5182 procedure TMainForm
.aUndoExecute(Sender
: TObject
);
5186 if UndoBuffer
= nil then
5188 if UndoBuffer
[High(UndoBuffer
)] = nil then
5191 for a
:= 0 to High(UndoBuffer
[High(UndoBuffer
)]) do
5192 with UndoBuffer
[High(UndoBuffer
)][a
] do
5200 UNDO_DELETE_ITEM
: AddItem(Item
);
5201 UNDO_DELETE_AREA
: AddArea(Area
);
5202 UNDO_DELETE_MONSTER
: AddMonster(Monster
);
5203 UNDO_DELETE_TRIGGER
: AddTrigger(Trigger
);
5204 UNDO_ADD_PANEL
: RemoveObject(AddID
, OBJECT_PANEL
);
5205 UNDO_ADD_ITEM
: RemoveObject(AddID
, OBJECT_ITEM
);
5206 UNDO_ADD_AREA
: RemoveObject(AddID
, OBJECT_AREA
);
5207 UNDO_ADD_MONSTER
: RemoveObject(AddID
, OBJECT_MONSTER
);
5208 UNDO_ADD_TRIGGER
: RemoveObject(AddID
, OBJECT_TRIGGER
);
5212 SetLength(UndoBuffer
, Length(UndoBuffer
)-1);
5214 RemoveSelectFromObjects();
5216 miUndo
.Enabled
:= UndoBuffer
<> nil;
5220 procedure TMainForm
.aCopyObjectExecute(Sender
: TObject
);
5223 CopyBuffer
: TCopyRecArray
;
5227 function CB_Compare(I1
, I2
: TCopyRec
): Integer;
5229 Result
:= Integer(I1
.ObjectType
) - Integer(I2
.ObjectType
);
5231 if Result
= 0 then // Одного типа
5232 Result
:= Integer(I1
.ID
) - Integer(I2
.ID
);
5235 procedure QuickSortCopyBuffer(L
, R
: Integer);
5243 P
:= CopyBuffer
[(L
+ R
) shr 1];
5246 while CB_Compare(CopyBuffer
[I
], P
) < 0 do
5248 while CB_Compare(CopyBuffer
[J
], P
) > 0 do
5254 CopyBuffer
[I
] := CopyBuffer
[J
];
5262 QuickSortCopyBuffer(L
, J
);
5269 if SelectedObjects
= nil then
5275 // Копируем объекты:
5276 for a
:= 0 to High(SelectedObjects
) do
5277 if SelectedObjects
[a
].Live
then
5278 with SelectedObjects
[a
] do
5280 SetLength(CopyBuffer
, Length(CopyBuffer
)+1);
5281 b
:= High(CopyBuffer
);
5282 CopyBuffer
[b
].ID
:= ID
;
5283 CopyBuffer
[b
].Panel
:= nil;
5288 CopyBuffer
[b
].ObjectType
:= OBJECT_PANEL
;
5289 New(CopyBuffer
[b
].Panel
);
5290 CopyBuffer
[b
].Panel
^ := gPanels
[ID
];
5295 CopyBuffer
[b
].ObjectType
:= OBJECT_ITEM
;
5296 CopyBuffer
[b
].Item
:= gItems
[ID
];
5301 CopyBuffer
[b
].ObjectType
:= OBJECT_MONSTER
;
5302 CopyBuffer
[b
].Monster
:= gMonsters
[ID
];
5307 CopyBuffer
[b
].ObjectType
:= OBJECT_AREA
;
5308 CopyBuffer
[b
].Area
:= gAreas
[ID
];
5313 CopyBuffer
[b
].ObjectType
:= OBJECT_TRIGGER
;
5314 CopyBuffer
[b
].Trigger
:= gTriggers
[ID
];
5319 // Сортировка по ID:
5320 if CopyBuffer
<> nil then
5322 QuickSortCopyBuffer(0, b
);
5325 // Пестановка ссылок триггеров:
5326 for a
:= 0 to Length(CopyBuffer
)-1 do
5327 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5329 case CopyBuffer
[a
].Trigger
.TriggerType
of
5330 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5331 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5332 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5333 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5337 for b
:= 0 to Length(CopyBuffer
)-1 do
5338 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5339 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.PanelID
) then
5341 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= b
;
5346 // Этих панелей нет среди копируемых:
5348 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= -1;
5351 TRIGGER_PRESS
, TRIGGER_ON
,
5352 TRIGGER_OFF
, TRIGGER_ONOFF
:
5353 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5357 for b
:= 0 to Length(CopyBuffer
)-1 do
5358 if (CopyBuffer
[b
].ObjectType
= OBJECT_MONSTER
) and
5359 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1) then
5361 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= b
+1;
5366 // Этих монстров нет среди копируемых:
5368 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= 0;
5372 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5376 for b
:= 0 to Length(CopyBuffer
)-1 do
5377 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5378 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
) then
5380 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= b
;
5385 // Этих панелей нет среди копируемых:
5387 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= -1;
5391 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5395 for b
:= 0 to Length(CopyBuffer
)-1 do
5396 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5397 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.TexturePanel
) then
5399 CopyBuffer
[a
].Trigger
.TexturePanel
:= b
;
5404 // Этих панелей нет среди копируемых:
5406 CopyBuffer
[a
].Trigger
.TexturePanel
:= -1;
5411 str
:= CopyBufferToString(CopyBuffer
);
5412 ClipBoard
.AsText
:= str
;
5414 for a
:= 0 to Length(CopyBuffer
)-1 do
5415 if (CopyBuffer
[a
].ObjectType
= OBJECT_PANEL
) and
5416 (CopyBuffer
[a
].Panel
<> nil) then
5417 Dispose(CopyBuffer
[a
].Panel
);
5422 procedure TMainForm
.aPasteObjectExecute(Sender
: TObject
);
5425 CopyBuffer
: TCopyRecArray
;
5427 swad
, ssec
, sres
: String;
5433 pmin
.X
:= High(pmin
.X
);
5434 pmin
.Y
:= High(pmin
.Y
);
5436 StringToCopyBuffer(ClipBoard
.AsText
, CopyBuffer
, pmin
);
5437 rel
:= not(ssShift
in GetKeyShiftState());
5439 if CopyBuffer
= nil then
5442 RemoveSelectFromObjects();
5444 h
:= High(CopyBuffer
);
5446 with CopyBuffer
[a
] do
5450 if Panel
<> nil then
5454 Panel
^.X
:= Panel
^.X
- pmin
.X
- MapOffset
.X
+ 32;
5455 Panel
^.Y
:= Panel
^.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5458 Panel
^.TextureID
:= TEXTURE_SPECIAL_NONE
;
5459 Panel
^.TextureWidth
:= 1;
5460 Panel
^.TextureHeight
:= 1;
5462 if (Panel
^.PanelType
= PANEL_LIFTUP
) or
5463 (Panel
^.PanelType
= PANEL_LIFTDOWN
) or
5464 (Panel
^.PanelType
= PANEL_LIFTLEFT
) or
5465 (Panel
^.PanelType
= PANEL_LIFTRIGHT
) or
5466 (Panel
^.PanelType
= PANEL_BLOCKMON
) or
5467 (Panel
^.TextureName
= '') then
5468 begin // Нет или не может быть текстуры:
5470 else // Есть текстура:
5472 // Обычная текстура:
5473 if not IsSpecialTexture(Panel
^.TextureName
) then
5475 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5479 g_ProcessResourceStr(Panel
^.TextureName
, swad
, ssec
, sres
);
5480 AddTexture(swad
, ssec
, sres
, True);
5481 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5485 g_GetTextureSizeByName(Panel
^.TextureName
,
5486 Panel
^.TextureWidth
, Panel
^.TextureHeight
)
5488 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5490 Panel
^.TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5491 g_GetTextureSizeByID(NoTextureID
, Panel
^.TextureWidth
, Panel
^.TextureHeight
);
5494 else // Спец.текстура:
5496 Panel
^.TextureID
:= SpecialTextureID(Panel
^.TextureName
);
5497 with MainForm
.lbTextureList
.Items
do
5498 if IndexOf(Panel
^.TextureName
) = -1 then
5499 Add(Panel
^.TextureName
);
5503 ID
:= AddPanel(Panel
^);
5505 Undo_Add(OBJECT_PANEL
, ID
, a
> 0);
5506 SelectObject(OBJECT_PANEL
, ID
, True);
5513 Item
.X
:= Item
.X
- pmin
.X
- MapOffset
.X
+ 32;
5514 Item
.Y
:= Item
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5517 ID
:= AddItem(Item
);
5518 Undo_Add(OBJECT_ITEM
, ID
, a
> 0);
5519 SelectObject(OBJECT_ITEM
, ID
, True);
5526 Monster
.X
:= Monster
.X
- pmin
.X
- MapOffset
.X
+ 32;
5527 Monster
.Y
:= Monster
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5530 ID
:= AddMonster(Monster
);
5531 Undo_Add(OBJECT_MONSTER
, ID
, a
> 0);
5532 SelectObject(OBJECT_MONSTER
, ID
, True);
5539 Area
.X
:= Area
.X
- pmin
.X
- MapOffset
.X
+ 32;
5540 Area
.Y
:= Area
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5543 ID
:= AddArea(Area
);
5544 Undo_Add(OBJECT_AREA
, ID
, a
> 0);
5545 SelectObject(OBJECT_AREA
, ID
, True);
5553 X
:= X
- pmin
.X
- MapOffset
.X
+ 32;
5554 Y
:= Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5559 Data
.TargetPoint
.X
:=
5560 Data
.TargetPoint
.X
- pmin
.X
- MapOffset
.X
+ 32;
5561 Data
.TargetPoint
.Y
:=
5562 Data
.TargetPoint
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5564 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5566 Data
.tX
:= Data
.tX
- pmin
.X
- MapOffset
.X
+ 32;
5567 Data
.tY
:= Data
.tY
- pmin
.Y
- MapOffset
.Y
+ 32;
5569 TRIGGER_SPAWNMONSTER
:
5572 Data
.MonPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5574 Data
.MonPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5579 Data
.ItemPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5581 Data
.ItemPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5586 Data
.ShotPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5588 Data
.ShotPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5593 ID
:= AddTrigger(Trigger
);
5594 Undo_Add(OBJECT_TRIGGER
, ID
, a
> 0);
5595 SelectObject(OBJECT_TRIGGER
, ID
, True);
5600 // Переставляем ссылки триггеров:
5601 for a
:= 0 to High(CopyBuffer
) do
5602 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5604 case CopyBuffer
[a
].Trigger
.TriggerType
of
5605 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5606 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5607 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5608 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5609 gTriggers
[CopyBuffer
[a
].ID
].Data
.PanelID
:=
5610 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.PanelID
].ID
;
5612 TRIGGER_PRESS
, TRIGGER_ON
,
5613 TRIGGER_OFF
, TRIGGER_ONOFF
:
5614 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5615 gTriggers
[CopyBuffer
[a
].ID
].Data
.MonsterID
:=
5616 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1].ID
+1;
5619 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5620 gTriggers
[CopyBuffer
[a
].ID
].Data
.ShotPanelID
:=
5621 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
].ID
;
5624 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5625 gTriggers
[CopyBuffer
[a
].ID
].TexturePanel
:=
5626 CopyBuffer
[CopyBuffer
[a
].Trigger
.TexturePanel
].ID
;
5635 procedure TMainForm
.aCutObjectExecute(Sender
: TObject
);
5638 DeleteSelectedObjects();
5641 procedure TMainForm
.vleObjectPropertyEditButtonClick(Sender
: TObject
);
5643 Key
, FileName
: String;
5646 Key
:= vleObjectProperty
.Keys
[vleObjectProperty
.Row
];
5648 if Key
= _lc
[I_PROP_PANEL_TYPE
] then
5650 with ChooseTypeForm
, vleObjectProperty
do
5651 begin // Выбор типа панели:
5652 Caption
:= _lc
[I_PROP_PANEL_TYPE
];
5653 lbTypeSelect
.Items
.Clear();
5655 for b
:= 0 to High(PANELNAMES
) do
5657 lbTypeSelect
.Items
.Add(PANELNAMES
[b
]);
5658 if Values
[Key
] = PANELNAMES
[b
] then
5659 lbTypeSelect
.ItemIndex
:= b
;
5662 if ShowModal() = mrOK
then
5664 b
:= lbTypeSelect
.ItemIndex
;
5665 Values
[Key
] := PANELNAMES
[b
];
5666 vleObjectPropertyApply(Sender
);
5670 else if Key
= _lc
[I_PROP_TR_TELEPORT_TO
] then
5671 SelectFlag
:= SELECTFLAG_TELEPORT
5672 else if Key
= _lc
[I_PROP_TR_SPAWN_TO
] then
5673 SelectFlag
:= SELECTFLAG_SPAWNPOINT
5674 else if (Key
= _lc
[I_PROP_TR_DOOR_PANEL
]) or
5675 (Key
= _lc
[I_PROP_TR_TRAP_PANEL
]) then
5676 SelectFlag
:= SELECTFLAG_DOOR
5677 else if Key
= _lc
[I_PROP_TR_TEXTURE_PANEL
] then
5679 DrawPressRect
:= False;
5680 SelectFlag
:= SELECTFLAG_TEXTURE
;
5682 else if Key
= _lc
[I_PROP_TR_SHOT_PANEL
] then
5683 SelectFlag
:= SELECTFLAG_SHOTPANEL
5684 else if Key
= _lc
[I_PROP_TR_LIFT_PANEL
] then
5685 SelectFlag
:= SELECTFLAG_LIFT
5686 else if key
= _lc
[I_PROP_TR_EX_MONSTER
] then
5687 SelectFlag
:= SELECTFLAG_MONSTER
5688 else if Key
= _lc
[I_PROP_TR_EX_AREA
] then
5690 SelectFlag
:= SELECTFLAG_NONE
;
5691 DrawPressRect
:= True;
5693 else if Key
= _lc
[I_PROP_TR_NEXT_MAP
] then
5694 begin // Выбор следующей карты:
5695 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
5696 SelectMapForm
.Caption
:= _lc
[I_CAP_SELECT
];
5697 SelectMapForm
.GetMaps(FileName
);
5699 if SelectMapForm
.ShowModal() = mrOK
then
5701 vleObjectProperty
.Values
[Key
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
5702 vleObjectPropertyApply(Sender
);
5705 else if (Key
= _lc
[I_PROP_TR_SOUND_NAME
]) or
5706 (Key
= _lc
[I_PROP_TR_MUSIC_NAME
]) then
5707 begin // Выбор файла звука/музыки:
5708 AddSoundForm
.OKFunction
:= nil;
5709 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
5710 AddSoundForm
.SetResource
:= vleObjectProperty
.Values
[Key
];
5712 if (AddSoundForm
.ShowModal() = mrOk
) then
5714 vleObjectProperty
.Values
[Key
] := AddSoundForm
.ResourceName
;
5715 vleObjectPropertyApply(Sender
);
5718 else if Key
= _lc
[I_PROP_TR_ACTIVATION
] then
5719 with ActivationTypeForm
, vleObjectProperty
do
5720 begin // Выбор типов активации:
5721 cbPlayerCollide
.Checked
:= Pos('PC', Values
[Key
]) > 0;
5722 cbMonsterCollide
.Checked
:= Pos('MC', Values
[Key
]) > 0;
5723 cbPlayerPress
.Checked
:= Pos('PP', Values
[Key
]) > 0;
5724 cbMonsterPress
.Checked
:= Pos('MP', Values
[Key
]) > 0;
5725 cbShot
.Checked
:= Pos('SH', Values
[Key
]) > 0;
5726 cbNoMonster
.Checked
:= Pos('NM', Values
[Key
]) > 0;
5728 if ShowModal() = mrOK
then
5731 if cbPlayerCollide
.Checked
then
5732 b
:= ACTIVATE_PLAYERCOLLIDE
;
5733 if cbMonsterCollide
.Checked
then
5734 b
:= b
or ACTIVATE_MONSTERCOLLIDE
;
5735 if cbPlayerPress
.Checked
then
5736 b
:= b
or ACTIVATE_PLAYERPRESS
;
5737 if cbMonsterPress
.Checked
then
5738 b
:= b
or ACTIVATE_MONSTERPRESS
;
5739 if cbShot
.Checked
then
5740 b
:= b
or ACTIVATE_SHOT
;
5741 if cbNoMonster
.Checked
then
5742 b
:= b
or ACTIVATE_NOMONSTER
;
5744 Values
[Key
] := ActivateToStr(b
);
5745 vleObjectPropertyApply(Sender
);
5748 else if Key
= _lc
[I_PROP_TR_KEYS
] then
5749 with KeysForm
, vleObjectProperty
do
5750 begin // Выбор необходимых ключей:
5751 cbRedKey
.Checked
:= Pos('RK', Values
[Key
]) > 0;
5752 cbGreenKey
.Checked
:= Pos('GK', Values
[Key
]) > 0;
5753 cbBlueKey
.Checked
:= Pos('BK', Values
[Key
]) > 0;
5754 cbRedTeam
.Checked
:= Pos('RT', Values
[Key
]) > 0;
5755 cbBlueTeam
.Checked
:= Pos('BT', Values
[Key
]) > 0;
5757 if ShowModal() = mrOK
then
5760 if cbRedKey
.Checked
then
5762 if cbGreenKey
.Checked
then
5763 b
:= b
or KEY_GREEN
;
5764 if cbBlueKey
.Checked
then
5766 if cbRedTeam
.Checked
then
5767 b
:= b
or KEY_REDTEAM
;
5768 if cbBlueTeam
.Checked
then
5769 b
:= b
or KEY_BLUETEAM
;
5771 Values
[Key
] := KeyToStr(b
);
5772 vleObjectPropertyApply(Sender
);
5775 else if Key
= _lc
[I_PROP_TR_FX_TYPE
] then
5776 with ChooseTypeForm
, vleObjectProperty
do
5777 begin // Выбор типа эффекта:
5778 Caption
:= _lc
[I_CAP_FX_TYPE
];
5779 lbTypeSelect
.Items
.Clear();
5781 for b
:= EFFECT_NONE
to EFFECT_FIRE
do
5782 lbTypeSelect
.Items
.Add(EffectToStr(b
));
5784 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]);
5786 if ShowModal() = mrOK
then
5788 b
:= lbTypeSelect
.ItemIndex
;
5789 Values
[Key
] := EffectToStr(b
);
5790 vleObjectPropertyApply(Sender
);
5793 else if Key
= _lc
[I_PROP_TR_MONSTER_TYPE
] then
5794 with ChooseTypeForm
, vleObjectProperty
do
5795 begin // Выбор типа монстра:
5796 Caption
:= _lc
[I_CAP_MONSTER_TYPE
];
5797 lbTypeSelect
.Items
.Clear();
5799 for b
:= MONSTER_DEMON
to MONSTER_MAN
do
5800 lbTypeSelect
.Items
.Add(MonsterToStr(b
));
5802 lbTypeSelect
.ItemIndex
:= StrToMonster(Values
[Key
]) - MONSTER_DEMON
;
5804 if ShowModal() = mrOK
then
5806 b
:= lbTypeSelect
.ItemIndex
+ MONSTER_DEMON
;
5807 Values
[Key
] := MonsterToStr(b
);
5808 vleObjectPropertyApply(Sender
);
5811 else if Key
= _lc
[I_PROP_TR_ITEM_TYPE
] then
5812 with ChooseTypeForm
, vleObjectProperty
do
5813 begin // Выбор типа предмета:
5814 Caption
:= _lc
[I_CAP_ITEM_TYPE
];
5815 lbTypeSelect
.Items
.Clear();
5817 for b
:= ITEM_MEDKIT_SMALL
to ITEM_KEY_BLUE
do
5818 lbTypeSelect
.Items
.Add(ItemToStr(b
));
5819 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_BOTTLE
));
5820 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_HELMET
));
5821 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_JETPACK
));
5822 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_INVIS
));
5823 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER
));
5824 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_AMMO_FUELCAN
));
5826 b
:= StrToItem(Values
[Key
]);
5827 if b
>= ITEM_BOTTLE
then
5829 lbTypeSelect
.ItemIndex
:= b
- ITEM_MEDKIT_SMALL
;
5831 if ShowModal() = mrOK
then
5833 b
:= lbTypeSelect
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
5834 if b
>= ITEM_WEAPON_KASTET
then
5836 Values
[Key
] := ItemToStr(b
);
5837 vleObjectPropertyApply(Sender
);
5840 else if Key
= _lc
[I_PROP_TR_SHOT_TYPE
] then
5841 with ChooseTypeForm
, vleObjectProperty
do
5842 begin // Выбор типа предмета:
5843 Caption
:= _lc
[I_PROP_TR_SHOT_TYPE
];
5844 lbTypeSelect
.Items
.Clear();
5846 for b
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
5847 lbTypeSelect
.Items
.Add(ShotToStr(b
));
5849 lbTypeSelect
.ItemIndex
:= StrToShot(Values
[Key
]);
5851 if ShowModal() = mrOK
then
5853 b
:= lbTypeSelect
.ItemIndex
;
5854 Values
[Key
] := ShotToStr(b
);
5855 vleObjectPropertyApply(Sender
);
5858 else if Key
= _lc
[I_PROP_TR_EFFECT_TYPE
] then
5859 with ChooseTypeForm
, vleObjectProperty
do
5860 begin // Выбор типа эффекта:
5861 Caption
:= _lc
[I_CAP_FX_TYPE
];
5862 lbTypeSelect
.Items
.Clear();
5864 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_PARTICLE
]);
5865 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_ANIMATION
]);
5866 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
5867 lbTypeSelect
.ItemIndex
:= 1
5869 lbTypeSelect
.ItemIndex
:= 0;
5871 if ShowModal() = mrOK
then
5873 b
:= lbTypeSelect
.ItemIndex
;
5875 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_PARTICLE
]
5877 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_ANIMATION
];
5878 vleObjectPropertyApply(Sender
);
5881 else if Key
= _lc
[I_PROP_TR_EFFECT_SUBTYPE
] then
5882 with ChooseTypeForm
, vleObjectProperty
do
5883 begin // Выбор подтипа эффекта:
5884 Caption
:= _lc
[I_CAP_FX_TYPE
];
5885 lbTypeSelect
.Items
.Clear();
5887 if Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
5889 for b
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
5890 lbTypeSelect
.Items
.Add(EffectToStr(b
));
5892 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]) - 1;
5895 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_SLIQUID
]);
5896 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_LLIQUID
]);
5897 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_DLIQUID
]);
5898 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_BLOOD
]);
5899 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_SPARK
]);
5900 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_BUBBLE
]);
5901 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SLIQUID
;
5902 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_LLIQUID
] then
5903 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_LLIQUID
;
5904 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_DLIQUID
] then
5905 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_DLIQUID
;
5906 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_BLOOD
] then
5907 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BLOOD
;
5908 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_SPARK
] then
5909 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SPARK
;
5910 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_BUBBLE
] then
5911 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BUBBLE
;
5914 if ShowModal() = mrOK
then
5916 b
:= lbTypeSelect
.ItemIndex
;
5918 if Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
5919 Values
[Key
] := EffectToStr(b
+ 1)
5921 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_SLIQUID
];
5922 if b
= TRIGGER_EFFECT_LLIQUID
then
5923 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_LLIQUID
];
5924 if b
= TRIGGER_EFFECT_DLIQUID
then
5925 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_DLIQUID
];
5926 if b
= TRIGGER_EFFECT_BLOOD
then
5927 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_BLOOD
];
5928 if b
= TRIGGER_EFFECT_SPARK
then
5929 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_SPARK
];
5930 if b
= TRIGGER_EFFECT_BUBBLE
then
5931 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_BUBBLE
];
5934 vleObjectPropertyApply(Sender
);
5937 else if Key
= _lc
[I_PROP_TR_EFFECT_COLOR
] then
5938 with vleObjectProperty
do
5939 begin // Выбор цвета эффекта:
5940 ColorDialog
.Color
:= StrToIntDef(Values
[Key
], 0);
5941 if ColorDialog
.Execute
then
5943 Values
[Key
] := IntToStr(ColorDialog
.Color
);
5944 vleObjectPropertyApply(Sender
);
5947 else if Key
= _lc
[I_PROP_PANEL_TEX
] then
5948 begin // Смена текстуры:
5949 vleObjectProperty
.Values
[Key
] := SelectedTexture();
5950 vleObjectPropertyApply(Sender
);
5954 procedure TMainForm
.vleObjectPropertyApply(Sender
: TObject
);
5956 // hack to prevent empty ID in list
5957 RenderPanel
.SetFocus();
5958 bApplyProperty
.Click();
5959 vleObjectProperty
.SetFocus();
5962 procedure TMainForm
.aSaveMapExecute(Sender
: TObject
);
5964 FileName
, Section
, Res
: String;
5966 if OpenedMap
= '' then
5968 aSaveMapAsExecute(nil);
5972 g_ProcessResourceStr(OpenedMap
, FileName
, Section
, Res
);
5974 SaveMap(FileName
+':\'+Res
);
5977 procedure TMainForm
.aOpenMapExecute(Sender
: TObject
);
5979 OpenDialog
.Filter
:= _lc
[I_FILE_FILTER_ALL
];
5981 if OpenDialog
.Execute() then
5983 OpenMapFile(OpenDialog
.FileName
);
5984 OpenDialog
.InitialDir
:= ExtractFileDir(OpenDialog
.FileName
);
5988 procedure TMainForm
.OpenMapFile(FileName
: String);
5990 if (Pos('.ini', LowerCase(ExtractFileName(FileName
))) > 0) then
5994 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
5995 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
5996 pLoadProgress
.Show();
6001 LoadMapOld(FileName
);
6003 MainForm
.Caption
:= Format('%s - %s', [FormCaption
, ExtractFileName(FileName
)]);
6005 pLoadProgress
.Hide();
6006 MainForm
.FormResize(Self
);
6008 else // Карты из WAD:
6010 OpenMap(FileName
, '');
6014 procedure TMainForm
.FormActivate(Sender
: TObject
);
6019 MainForm
.ActiveControl
:= RenderPanel
;
6022 if gLanguage
= '' then
6024 lang
:= SelectLanguageForm
.ShowModal();
6026 1: gLanguage
:= LANGUAGE_ENGLISH
;
6027 else gLanguage
:= LANGUAGE_RUSSIAN
;
6030 config
:= TConfig
.CreateFile(EditorDir
+'Editor.cfg');
6031 config
.WriteStr('Editor', 'Language', gLanguage
);
6032 config
.SaveFile(EditorDir
+'Editor.cfg');
6036 //e_WriteLog('Read language file', MSG_NOTIFY);
6037 //g_Language_Load(EditorDir+'\data\'+gLanguage+LANGUAGE_FILE_NAME);
6038 g_Language_Set(gLanguage
);
6041 procedure TMainForm
.aDeleteMap(Sender
: TObject
);
6049 OpenDialog
.Filter
:= _lc
[I_FILE_FILTER_WAD
];
6051 if not OpenDialog
.Execute() then
6054 WAD
:= TWADEditor_1
.Create();
6056 if not WAD
.ReadFile(OpenDialog
.FileName
) then
6064 MapList
:= WAD
.GetResourcesList('');
6066 SelectMapForm
.Caption
:= _lc
[I_CAP_REMOVE
];
6067 SelectMapForm
.lbMapList
.Items
.Clear();
6069 if MapList
<> nil then
6070 for a
:= 0 to High(MapList
) do
6071 SelectMapForm
.lbMapList
.Items
.Add(win2utf(MapList
[a
]));
6073 if (SelectMapForm
.ShowModal() = mrOK
) then
6075 str
:= SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6077 Move(str
[1], MapName
[0], Min(16, Length(str
)));
6079 if MessageBox(0, PChar(Format(_lc
[I_MSG_DELETE_MAP_PROMT
],
6080 [MapName
, OpenDialog
.FileName
])),
6081 PChar(_lc
[I_MSG_DELETE_MAP
]),
6082 MB_ICONQUESTION
or MB_YESNO
or
6083 MB_DEFBUTTON2
) <> mrYes
then
6086 WAD
.RemoveResource('', utf2win(MapName
));
6088 MessageBox(0, PChar(Format(_lc
[I_MSG_MAP_DELETED_PROMT
],
6090 PChar(_lc
[I_MSG_MAP_DELETED
]),
6091 MB_ICONINFORMATION
or MB_OK
or
6094 WAD
.SaveTo(OpenDialog
.FileName
);
6096 // Удалили текущую карту - сохранять по старому ее нельзя:
6097 if OpenedMap
= (OpenDialog
.FileName
+':\'+MapName
) then
6101 MainForm
.Caption
:= FormCaption
;
6108 procedure TMainForm
.vleObjectPropertyKeyDown(Sender
: TObject
;
6109 var Key
: Word; Shift
: TShiftState
);
6111 if Key
= VK_RETURN
then
6112 vleObjectPropertyApply(Sender
);
6115 procedure MovePanel(var ID
: DWORD
; MoveType
: Byte);
6120 if (ID
= 0) and (MoveType
= 0) then
6122 if (ID
= DWORD(High(gPanels
))) and (MoveType
<> 0) then
6124 if (ID
> DWORD(High(gPanels
))) then
6129 if MoveType
= 0 then // to Back
6131 if gTriggers
<> nil then
6132 for a
:= 0 to High(gTriggers
) do
6133 with gTriggers
[a
] do
6135 if TriggerType
= TRIGGER_NONE
then
6138 if TexturePanel
= _id
then
6141 if (TexturePanel
>= 0) and (TexturePanel
< _id
) then
6145 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6146 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6147 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6148 if Data
.PanelID
= _id
then
6151 if (Data
.PanelID
>= 0) and (Data
.PanelID
< _id
) then
6155 if Data
.ShotPanelID
= _id
then
6156 Data
.ShotPanelID
:= 0
6158 if (Data
.ShotPanelID
>= 0) and (Data
.ShotPanelID
< _id
) then
6159 Inc(Data
.ShotPanelID
);
6163 tmp
:= gPanels
[_id
];
6165 for a
:= _id
downto 1 do
6166 gPanels
[a
] := gPanels
[a
-1];
6174 if gTriggers
<> nil then
6175 for a
:= 0 to High(gTriggers
) do
6176 with gTriggers
[a
] do
6178 if TriggerType
= TRIGGER_NONE
then
6181 if TexturePanel
= _id
then
6182 TexturePanel
:= High(gPanels
)
6184 if TexturePanel
> _id
then
6188 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6189 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6190 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6191 if Data
.PanelID
= _id
then
6192 Data
.PanelID
:= High(gPanels
)
6194 if Data
.PanelID
> _id
then
6198 if Data
.ShotPanelID
= _id
then
6199 Data
.ShotPanelID
:= High(gPanels
)
6201 if Data
.ShotPanelID
> _id
then
6202 Dec(Data
.ShotPanelID
);
6206 tmp
:= gPanels
[_id
];
6208 for a
:= _id
to High(gPanels
)-1 do
6209 gPanels
[a
] := gPanels
[a
+1];
6211 gPanels
[High(gPanels
)] := tmp
;
6213 ID
:= High(gPanels
);
6217 procedure TMainForm
.aMoveToBack(Sender
: TObject
);
6221 if SelectedObjects
= nil then
6224 for a
:= 0 to High(SelectedObjects
) do
6225 with SelectedObjects
[a
] do
6226 if Live
and (ObjectType
= OBJECT_PANEL
) then
6228 SelectedObjects
[0] := SelectedObjects
[a
];
6229 SetLength(SelectedObjects
, 1);
6236 procedure TMainForm
.aMoveToFore(Sender
: TObject
);
6240 if SelectedObjects
= nil then
6243 for a
:= 0 to High(SelectedObjects
) do
6244 with SelectedObjects
[a
] do
6245 if Live
and (ObjectType
= OBJECT_PANEL
) then
6247 SelectedObjects
[0] := SelectedObjects
[a
];
6248 SetLength(SelectedObjects
, 1);
6255 procedure TMainForm
.aSaveMapAsExecute(Sender
: TObject
);
6259 SaveDialog
.Filter
:= _lc
[I_FILE_FILTER_WAD
];
6261 if not SaveDialog
.Execute() then
6264 SaveMapForm
.GetMaps(SaveDialog
.FileName
, True);
6266 if SaveMapForm
.ShowModal() <> mrOK
then
6269 SaveDialog
.InitialDir
:= ExtractFileDir(SaveDialog
.FileName
);
6270 OpenedMap
:= SaveDialog
.FileName
+':\'+SaveMapForm
.eMapName
.Text;
6271 OpenedWAD
:= SaveDialog
.FileName
;
6273 idx
:= RecentFiles
.IndexOf(OpenedMap
);
6274 // Такая карта уже недавно открывалась:
6276 RecentFiles
.Delete(idx
);
6277 RecentFiles
.Insert(0, OpenedMap
);
6282 gMapInfo
.FileName
:= SaveDialog
.FileName
;
6283 gMapInfo
.MapName
:= SaveMapForm
.eMapName
.Text;
6284 UpdateCaption(gMapInfo
.Name
, ExtractFileName(gMapInfo
.FileName
), gMapInfo
.MapName
);
6287 procedure TMainForm
.aSelectAllExecute(Sender
: TObject
);
6291 RemoveSelectFromObjects();
6293 case pcObjects
.ActivePageIndex
+1 of
6295 if gPanels
<> nil then
6296 for a
:= 0 to High(gPanels
) do
6297 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6298 SelectObject(OBJECT_PANEL
, a
, True);
6300 if gItems
<> nil then
6301 for a
:= 0 to High(gItems
) do
6302 if gItems
[a
].ItemType
<> ITEM_NONE
then
6303 SelectObject(OBJECT_ITEM
, a
, True);
6305 if gMonsters
<> nil then
6306 for a
:= 0 to High(gMonsters
) do
6307 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6308 SelectObject(OBJECT_MONSTER
, a
, True);
6310 if gAreas
<> nil then
6311 for a
:= 0 to High(gAreas
) do
6312 if gAreas
[a
].AreaType
<> AREA_NONE
then
6313 SelectObject(OBJECT_AREA
, a
, True);
6315 if gTriggers
<> nil then
6316 for a
:= 0 to High(gTriggers
) do
6317 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6318 SelectObject(OBJECT_TRIGGER
, a
, True);
6322 procedure TMainForm
.tbGridOnClick(Sender
: TObject
);
6324 DotEnable
:= not DotEnable
;
6325 (Sender
as TToolButton
).Down
:= DotEnable
;
6328 procedure TMainForm
.OnIdle(Sender
: TObject
; var Done
: Boolean);
6330 // FIXME: this is a shitty hack
6331 if not gDataLoaded
then
6333 e_WriteLog('Init OpenGL', MSG_NOTIFY
);
6335 e_WriteLog('Loading data', MSG_NOTIFY
);
6336 LoadStdFont('STDTXT', 'STDFONT', gEditorFont
);
6337 e_WriteLog('Loading more data', MSG_NOTIFY
);
6339 e_WriteLog('Loading even more data', MSG_NOTIFY
);
6340 gDataLoaded
:= True;
6341 MainForm
.FormResize(nil);
6346 procedure TMainForm
.miMapPreviewClick(Sender
: TObject
);
6348 if PreviewMode
= 2 then
6351 if PreviewMode
= 0 then
6353 Splitter2
.Visible
:= False;
6354 Splitter1
.Visible
:= False;
6355 StatusBar
.Visible
:= False;
6356 PanelObjs
.Visible
:= False;
6357 PanelProps
.Visible
:= False;
6358 MainToolBar
.Visible
:= False;
6359 sbHorizontal
.Visible
:= False;
6360 sbVertical
.Visible
:= False;
6364 StatusBar
.Visible
:= True;
6365 PanelObjs
.Visible
:= True;
6366 PanelProps
.Visible
:= True;
6367 Splitter2
.Visible
:= True;
6368 Splitter1
.Visible
:= True;
6369 MainToolBar
.Visible
:= True;
6370 sbHorizontal
.Visible
:= True;
6371 sbVertical
.Visible
:= True;
6374 PreviewMode
:= PreviewMode
xor 1;
6375 (Sender
as TMenuItem
).Checked
:= PreviewMode
> 0;
6380 procedure TMainForm
.miLayer1Click(Sender
: TObject
);
6382 SwitchLayer(LAYER_BACK
);
6385 procedure TMainForm
.miLayer2Click(Sender
: TObject
);
6387 SwitchLayer(LAYER_WALLS
);
6390 procedure TMainForm
.miLayer3Click(Sender
: TObject
);
6392 SwitchLayer(LAYER_FOREGROUND
);
6395 procedure TMainForm
.miLayer4Click(Sender
: TObject
);
6397 SwitchLayer(LAYER_STEPS
);
6400 procedure TMainForm
.miLayer5Click(Sender
: TObject
);
6402 SwitchLayer(LAYER_WATER
);
6405 procedure TMainForm
.miLayer6Click(Sender
: TObject
);
6407 SwitchLayer(LAYER_ITEMS
);
6410 procedure TMainForm
.miLayer7Click(Sender
: TObject
);
6412 SwitchLayer(LAYER_MONSTERS
);
6415 procedure TMainForm
.miLayer8Click(Sender
: TObject
);
6417 SwitchLayer(LAYER_AREAS
);
6420 procedure TMainForm
.miLayer9Click(Sender
: TObject
);
6422 SwitchLayer(LAYER_TRIGGERS
);
6425 procedure TMainForm
.tbShowClick(Sender
: TObject
);
6431 for a
:= 0 to High(LayerEnabled
) do
6432 b
:= b
and LayerEnabled
[a
];
6436 ShowLayer(LAYER_BACK
, b
);
6437 ShowLayer(LAYER_WALLS
, b
);
6438 ShowLayer(LAYER_FOREGROUND
, b
);
6439 ShowLayer(LAYER_STEPS
, b
);
6440 ShowLayer(LAYER_WATER
, b
);
6441 ShowLayer(LAYER_ITEMS
, b
);
6442 ShowLayer(LAYER_MONSTERS
, b
);
6443 ShowLayer(LAYER_AREAS
, b
);
6444 ShowLayer(LAYER_TRIGGERS
, b
);
6447 procedure TMainForm
.miMiniMapClick(Sender
: TObject
);
6452 procedure TMainForm
.miSwitchGridClick(Sender
: TObject
);
6454 if DotStep
= DotStepOne
then
6455 DotStep
:= DotStepTwo
6457 DotStep
:= DotStepOne
;
6459 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6460 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6463 procedure TMainForm
.miShowEdgesClick(Sender
: TObject
);
6468 procedure TMainForm
.miSnapToGridClick(Sender
: TObject
);
6470 SnapToGrid
:= not SnapToGrid
;
6472 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6473 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6475 miSnapToGrid
.Checked
:= SnapToGrid
;
6478 procedure TMainForm
.minexttabClick(Sender
: TObject
);
6480 if pcObjects
.ActivePageIndex
< pcObjects
.PageCount
-1 then
6481 pcObjects
.ActivePageIndex
:= pcObjects
.ActivePageIndex
+1
6483 pcObjects
.ActivePageIndex
:= 0;
6486 procedure TMainForm
.miSaveMiniMapClick(Sender
: TObject
);
6488 SaveMiniMapForm
.ShowModal();
6491 procedure TMainForm
.bClearTextureClick(Sender
: TObject
);
6493 lbTextureList
.ItemIndex
:= -1;
6494 lTextureWidth
.Caption
:= '';
6495 lTextureHeight
.Caption
:= '';
6498 procedure TMainForm
.miPackMapClick(Sender
: TObject
);
6500 PackMapForm
.ShowModal();
6503 procedure TMainForm
.miMapTestSettingsClick(Sender
: TObject
);
6505 MapTestForm
.ShowModal();
6508 procedure TMainForm
.miTestMapClick(Sender
: TObject
);
6510 cmd
, mapWAD
, mapToRun
, tempWAD
: String;
6517 if OpenedMap
<> '' then
6519 // Указываем текущую карту для теста:
6520 g_ProcessResourceStr(OpenedMap
, @mapWAD
, nil, @mapToRun
);
6521 mapToRun
:= mapWAD
+ ':\' + mapToRun
;
6522 mapToRun
:= ExtractRelativePath(ExtractFilePath(TestD2dExe
) + 'maps/', mapToRun
);
6524 // Сохраняем временную карту:
6527 mapWAD
:= ExtractFilePath(TestD2dExe
) + Format('maps/temp%.4d.wad', [time
]);
6529 until not FileExists(mapWAD
);
6530 tempWAD
:= mapWAD
+ ':\' + TEST_MAP_NAME
;
6533 tempWAD
:= ExtractRelativePath(ExtractFilePath(TestD2dExe
) + 'maps/', tempWAD
);
6534 // Если карта не была открыта, указываем временную в качестве текущей:
6535 if mapToRun
= '' then
6536 mapToRun
:= tempWAD
;
6540 if TestOptionsTwoPlayers
then
6542 if TestOptionsTeamDamage
then
6544 if TestOptionsAllowExit
then
6546 if TestOptionsWeaponStay
then
6548 if TestOptionsMonstersDM
then
6551 // Составляем командную строку:
6552 cmd
:= '-map "' + mapToRun
+ '"';
6553 cmd
:= cmd
+ ' -testmap "' + tempWAD
+ '"';
6554 cmd
:= cmd
+ ' -gm ' + TestGameMode
;
6555 cmd
:= cmd
+ ' -limt ' + TestLimTime
;
6556 cmd
:= cmd
+ ' -lims ' + TestLimScore
;
6557 cmd
:= cmd
+ ' -opt ' + IntToStr(opt
);
6560 cmd
:= cmd
+ ' --close';
6562 cmd
:= cmd
+ ' --debug';
6565 proc
:= TProcessUTF8
.Create(nil);
6566 proc
.Executable
:= TestD2dExe
;
6567 proc
.Parameters
.Add(cmd
);
6576 Application
.Minimize();
6579 if (not res
) or (proc
.ExitCode
< 0) then
6581 MessageBox(0, 'FIXME',
6582 PChar(_lc
[I_MSG_EXEC_ERROR
]),
6583 MB_OK
or MB_ICONERROR
);
6587 SysUtils
.DeleteFile(mapWAD
);
6588 Application
.Restore();
6591 procedure TMainForm
.sbVerticalScroll(Sender
: TObject
;
6592 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
6594 MapOffset
.Y
:= -Normalize16(sbVertical
.Position
);
6597 procedure TMainForm
.sbHorizontalScroll(Sender
: TObject
;
6598 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
6600 MapOffset
.X
:= -Normalize16(sbHorizontal
.Position
);
6603 procedure TMainForm
.miOpenWadMapClick(Sender
: TObject
);
6605 if OpenedWAD
<> '' then
6607 OpenMap(OpenedWAD
, '');
6611 procedure TMainForm
.selectall1Click(Sender
: TObject
);
6615 RemoveSelectFromObjects();
6617 if gPanels
<> nil then
6618 for a
:= 0 to High(gPanels
) do
6619 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6620 SelectObject(OBJECT_PANEL
, a
, True);
6622 if gItems
<> nil then
6623 for a
:= 0 to High(gItems
) do
6624 if gItems
[a
].ItemType
<> ITEM_NONE
then
6625 SelectObject(OBJECT_ITEM
, a
, True);
6627 if gMonsters
<> nil then
6628 for a
:= 0 to High(gMonsters
) do
6629 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6630 SelectObject(OBJECT_MONSTER
, a
, True);
6632 if gAreas
<> nil then
6633 for a
:= 0 to High(gAreas
) do
6634 if gAreas
[a
].AreaType
<> AREA_NONE
then
6635 SelectObject(OBJECT_AREA
, a
, True);
6637 if gTriggers
<> nil then
6638 for a
:= 0 to High(gTriggers
) do
6639 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6640 SelectObject(OBJECT_TRIGGER
, a
, True);
6643 procedure TMainForm
.Splitter1CanResize(Sender
: TObject
;
6644 var NewSize
: Integer; var Accept
: Boolean);
6646 Accept
:= (NewSize
> 140);
6649 procedure TMainForm
.Splitter2CanResize(Sender
: TObject
;
6650 var NewSize
: Integer; var Accept
: Boolean);
6652 Accept
:= (NewSize
> 110);
6655 procedure TMainForm
.vleObjectPropertyEnter(Sender
: TObject
);
6657 EditingProperties
:= True;
6660 procedure TMainForm
.vleObjectPropertyExit(Sender
: TObject
);
6662 EditingProperties
:= False;
6665 procedure TMainForm
.FormKeyUp(Sender
: TObject
; var Key
: Word;
6666 Shift
: TShiftState
);
6668 // Объекты передвигались:
6669 if MainForm
.ActiveControl
= RenderPanel
then
6671 if (Key
= VK_NUMPAD4
) or
6672 (Key
= VK_NUMPAD6
) or
6673 (Key
= VK_NUMPAD8
) or
6674 (Key
= VK_NUMPAD5
) or
6675 (Key
= Ord('V')) then
6678 // Быстрое превью карты:
6679 if Key
= Ord('E') then
6681 if PreviewMode
= 2 then