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 miReopenMap
: TMenuItem
;
30 miSaveMiniMap
: TMenuItem
;
31 miDeleteMap
: TMenuItem
;
36 miMenuEdit
: TMenuItem
;
43 miSelectAll
: TMenuItem
;
48 miMenuTools
: TMenuItem
;
49 miSnapToGrid
: TMenuItem
;
51 miSwitchGrid
: TMenuItem
;
52 miShowEdges
: TMenuItem
;
64 miMenuService
: TMenuItem
;
65 miCheckMap
: TMenuItem
;
66 miOptimmization
: TMenuItem
;
67 miMapPreview
: TMenuItem
;
70 miMenuSettings
: TMenuItem
;
71 miMapOptions
: TMenuItem
;
75 miMenuHelp
: TMenuItem
;
77 // Скрытый пункт меню для Ctrl+Tab:
81 // Панель инструментов:
82 MainToolBar
: TToolBar
;
84 pLoadProgress
: TPanel
;
85 RenderPanel
: TOpenGLControl
;
86 tbNewMap
: TToolButton
;
87 tbOpenMap
: TToolButton
;
88 tbSaveMap
: TToolButton
;
89 tbOpenWadMap
: TToolButton
;
91 tbShowMap
: TToolButton
;
95 tbGridOn
: TToolButton
;
98 tbTestMap
: TToolButton
;
99 // Всплывающее меню для кнопки слоев:
101 miLayerP1
: TMenuItem
;
102 miLayerP2
: TMenuItem
;
103 miLayerP3
: TMenuItem
;
104 miLayerP4
: TMenuItem
;
105 miLayerP5
: TMenuItem
;
106 miLayerP6
: TMenuItem
;
107 miLayerP7
: TMenuItem
;
108 miLayerP8
: TMenuItem
;
109 miLayerP9
: TMenuItem
;
114 sbHorizontal
: TScrollBar
;
115 sbVertical
: TScrollBar
;
119 // Панель применения свойств:
120 PanelPropApply
: TPanel
;
121 bApplyProperty
: TButton
;
122 MapTestTimer
: TTimer
;
123 // Редактор свойств объектов:
124 vleObjectProperty
: TValueListEditor
;
126 // Панель объектов - вкладки:
128 pcObjects
: TPageControl
;
131 lbTextureList
: TListBox
;
132 // Панель настройки текстур:
133 PanelTextures
: TPanel
;
135 lTextureWidth
: TLabel
;
137 lTextureHeight
: TLabel
;
138 cbPreview
: TCheckBox
;
139 bbAddTexture
: TBitBtn
;
140 bbRemoveTexture
: TBitBtn
;
141 bClearTexture
: TButton
;
142 // Панель типов панелей:
143 PanelPanelType
: TPanel
;
144 lbPanelType
: TListBox
;
145 // Вкладка "Предметы":
147 lbItemList
: TListBox
;
150 // Вкладка "Монстры":
151 tsMonsters
: TTabSheet
;
152 lbMonsterList
: TListBox
;
153 rbMonsterLeft
: TRadioButton
;
154 rbMonsterRight
: TRadioButton
;
155 // Вкладка "Области":
157 lbAreasList
: TListBox
;
158 rbAreaLeft
: TRadioButton
;
159 rbAreaRight
: TRadioButton
;
160 // Вкладка "Триггеры":
161 tsTriggers
: TTabSheet
;
162 lbTriggersList
: TListBox
;
163 clbActivationType
: TCheckListBox
;
164 clbKeys
: TCheckListBox
;
167 Splitter1
: TSplitter
;
168 Splitter2
: TSplitter
;
169 StatusBar
: TStatusBar
;
171 // Специальные объекты:
172 ImageList
: TImageList
;
173 ilToolbar
: TImageList
;
174 OpenDialog
: TOpenDialog
;
175 SaveDialog
: TSaveDialog
;
176 selectall1
: TMenuItem
;
177 ColorDialog
: TColorDialog
;
179 procedure aAboutExecute(Sender
: TObject
);
180 procedure aCheckMapExecute(Sender
: TObject
);
181 procedure aMoveToFore(Sender
: TObject
);
182 procedure aMoveToBack(Sender
: TObject
);
183 procedure aCopyObjectExecute(Sender
: TObject
);
184 procedure aCutObjectExecute(Sender
: TObject
);
185 procedure aEditorOptionsExecute(Sender
: TObject
);
186 procedure aExitExecute(Sender
: TObject
);
187 procedure aMapOptionsExecute(Sender
: TObject
);
188 procedure aNewMapExecute(Sender
: TObject
);
189 procedure aOpenMapExecute(Sender
: TObject
);
190 procedure aOptimizeExecute(Sender
: TObject
);
191 procedure aPasteObjectExecute(Sender
: TObject
);
192 procedure aSelectAllExecute(Sender
: TObject
);
193 procedure aSaveMapExecute(Sender
: TObject
);
194 procedure aSaveMapAsExecute(Sender
: TObject
);
195 procedure aUndoExecute(Sender
: TObject
);
196 procedure aDeleteMap(Sender
: TObject
);
197 procedure bApplyPropertyClick(Sender
: TObject
);
198 procedure bbAddTextureClick(Sender
: TObject
);
199 procedure bbRemoveTextureClick(Sender
: TObject
);
200 procedure FormActivate(Sender
: TObject
);
201 procedure FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
202 procedure FormCreate(Sender
: TObject
);
203 procedure FormDestroy(Sender
: TObject
);
204 procedure FormDropFiles(Sender
: TObject
; const FileNames
: array of String);
205 procedure FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
206 procedure FormResize(Sender
: TObject
);
207 procedure lbTextureListClick(Sender
: TObject
);
208 procedure lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
209 ARect
: TRect
; State
: TOwnerDrawState
);
210 procedure miReopenMapClick(Sender
: TObject
);
211 procedure RenderPanelMouseDown(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
212 procedure RenderPanelMouseMove(Sender
: TObject
; Shift
: TShiftState
; X
, Y
: Integer);
213 procedure RenderPanelMouseUp(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
214 procedure RenderPanelPaint(Sender
: TObject
);
215 procedure RenderPanelResize(Sender
: TObject
);
216 procedure Splitter1Moved(Sender
: TObject
);
217 procedure MapTestCheck(Sender
: TObject
);
218 procedure vleObjectPropertyEditButtonClick(Sender
: TObject
);
219 procedure vleObjectPropertyApply(Sender
: TObject
);
220 procedure vleObjectPropertyGetPickList(Sender
: TObject
; const KeyName
: String; Values
: TStrings
);
221 procedure vleObjectPropertyKeyDown(Sender
: TObject
; var Key
: Word;
223 procedure tbGridOnClick(Sender
: TObject
);
224 procedure miMapPreviewClick(Sender
: TObject
);
225 procedure miLayer1Click(Sender
: TObject
);
226 procedure miLayer2Click(Sender
: TObject
);
227 procedure miLayer3Click(Sender
: TObject
);
228 procedure miLayer4Click(Sender
: TObject
);
229 procedure miLayer5Click(Sender
: TObject
);
230 procedure miLayer6Click(Sender
: TObject
);
231 procedure miLayer7Click(Sender
: TObject
);
232 procedure miLayer8Click(Sender
: TObject
);
233 procedure miLayer9Click(Sender
: TObject
);
234 procedure tbShowClick(Sender
: TObject
);
235 procedure miSnapToGridClick(Sender
: TObject
);
236 procedure miMiniMapClick(Sender
: TObject
);
237 procedure miSwitchGridClick(Sender
: TObject
);
238 procedure miShowEdgesClick(Sender
: TObject
);
239 procedure minexttabClick(Sender
: TObject
);
240 procedure miSaveMiniMapClick(Sender
: TObject
);
241 procedure bClearTextureClick(Sender
: TObject
);
242 procedure miPackMapClick(Sender
: TObject
);
243 procedure aRecentFileExecute(Sender
: TObject
);
244 procedure miTestMapClick(Sender
: TObject
);
245 procedure sbVerticalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
246 var ScrollPos
: Integer);
247 procedure sbHorizontalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
248 var ScrollPos
: Integer);
249 procedure miOpenWadMapClick(Sender
: TObject
);
250 procedure selectall1Click(Sender
: TObject
);
251 procedure Splitter1CanResize(Sender
: TObject
; var NewSize
: Integer;
252 var Accept
: Boolean);
253 procedure Splitter2CanResize(Sender
: TObject
; var NewSize
: Integer;
254 var Accept
: Boolean);
255 procedure vleObjectPropertyEnter(Sender
: TObject
);
256 procedure vleObjectPropertyExit(Sender
: TObject
);
257 procedure FormKeyUp(Sender
: TObject
; var Key
: Word;
261 procedure OnIdle(Sender
: TObject
; var Done
: Boolean);
263 procedure RefreshRecentMenu();
264 procedure OpenMapFile(FileName
: String);
265 function RenderMousePos(): TPoint
;
266 procedure RecountSelectedObjects();
272 LAYER_FOREGROUND
= 2;
280 TEST_MAP_NAME
= '$$$_TEST_$$$';
281 LANGUAGE_FILE_NAME
= '_Editor.txt';
292 DotStepOne
, DotStepTwo
: Word;
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;
312 TestD2dExe
, TestD2DArgs
: String;
313 TestMapOnce
: Boolean;
315 LayerEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
316 (True, True, True, True, True, True, True, True, True);
317 ContourEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
318 (False, False, False, False, False, False, False, False, False);
319 PreviewMode
: Byte = 0;
325 procedure OpenMap(FileName
: String; mapN
: String);
326 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
327 procedure RemoveSelectFromObjects();
328 procedure ChangeShownProperty(Name
: String; NewValue
: String);
333 f_options
, e_graphics
, e_log
, GL
, Math
,
334 f_mapoptions
, g_basic
, f_about
, f_mapoptimization
,
335 f_mapcheck
, f_addresource_texture
, g_textures
,
336 f_activationtype
, f_keys
, wadreader
, fileutil
,
337 MAPREADER
, f_selectmap
, f_savemap
, WADEDITOR
, MAPDEF
,
338 g_map
, f_saveminimap
, f_addresource
, CONFIG
, f_packmap
,
339 f_addresource_sound
, f_choosetype
,
340 g_language
, f_selectlang
, ClipBrd
, g_resources
, g_options
;
343 UNDO_DELETE_PANEL
= 1;
344 UNDO_DELETE_ITEM
= 2;
345 UNDO_DELETE_AREA
= 3;
346 UNDO_DELETE_MONSTER
= 4;
347 UNDO_DELETE_TRIGGER
= 5;
351 UNDO_ADD_MONSTER
= 9;
352 UNDO_ADD_TRIGGER
= 10;
353 UNDO_MOVE_PANEL
= 11;
356 UNDO_MOVE_MONSTER
= 14;
357 UNDO_MOVE_TRIGGER
= 15;
358 UNDO_RESIZE_PANEL
= 16;
359 UNDO_RESIZE_TRIGGER
= 17;
361 MOUSEACTION_NONE
= 0;
362 MOUSEACTION_DRAWPANEL
= 1;
363 MOUSEACTION_DRAWTRIGGER
= 2;
364 MOUSEACTION_MOVEOBJ
= 3;
365 MOUSEACTION_RESIZE
= 4;
366 MOUSEACTION_MOVEMAP
= 5;
367 MOUSEACTION_DRAWPRESS
= 6;
368 MOUSEACTION_NOACTION
= 7;
371 RESIZETYPE_VERTICAL
= 1;
372 RESIZETYPE_HORIZONTAL
= 2;
381 SELECTFLAG_TELEPORT
= 1;
383 SELECTFLAG_TEXTURE
= 3;
385 SELECTFLAG_MONSTER
= 5;
386 SELECTFLAG_SPAWNPOINT
= 6;
387 SELECTFLAG_SHOTPANEL
= 7;
388 SELECTFLAG_SELECTED
= 8;
390 RECENT_FILES_MENU_START
= 12;
392 CLIPBOARD_SIG
= 'DF:ED';
398 UNDO_DELETE_PANEL
: (Panel
: ^TPanel
);
399 UNDO_DELETE_ITEM
: (Item
: TItem
);
400 UNDO_DELETE_AREA
: (Area
: TArea
);
401 UNDO_DELETE_MONSTER
: (Monster
: TMonster
);
402 UNDO_DELETE_TRIGGER
: (Trigger
: TTrigger
);
407 UNDO_ADD_TRIGGER
: (AddID
: DWORD
);
412 UNDO_MOVE_TRIGGER
: (MoveID
: DWORD
; dX
, dY
: Integer);
414 UNDO_RESIZE_TRIGGER
: (ResizeID
: DWORD
; dW
, dH
: Integer);
421 OBJECT_PANEL
: (Panel
: ^TPanel
);
422 OBJECT_ITEM
: (Item
: TItem
);
423 OBJECT_AREA
: (Area
: TArea
);
424 OBJECT_MONSTER
: (Monster
: TMonster
);
425 OBJECT_TRIGGER
: (Trigger
: TTrigger
);
428 TCopyRecArray
= Array of TCopyRec
;
432 gDataLoaded
: Boolean = False;
433 ShowMap
: Boolean = False;
434 DrawRect
: PRect
= nil;
435 SnapToGrid
: Boolean = True;
437 MousePos
: Types
.TPoint
;
438 LastMovePoint
: Types
.TPoint
;
442 MouseLDownPos
: Types
.TPoint
;
443 MouseRDownPos
: Types
.TPoint
;
444 MouseMDownPos
: Types
.TPoint
;
446 SelectFlag
: Byte = SELECTFLAG_NONE
;
447 MouseAction
: Byte = MOUSEACTION_NONE
;
448 ResizeType
: Byte = RESIZETYPE_NONE
;
449 ResizeDirection
: Byte = RESIZEDIR_NONE
;
451 DrawPressRect
: Boolean = False;
452 EditingProperties
: Boolean = False;
454 UndoBuffer
: Array of Array of TUndoRec
= nil;
456 MapTestProcess
: TProcessUTF8
;
461 //----------------------------------------
462 //Далее идут вспомогательные процедуры
463 //----------------------------------------
465 function NameToBool(Name
: String): Boolean;
467 if Name
= BoolNames
[True] then
473 function NameToDir(Name
: String): TDirection
;
475 if Name
= DirNames
[D_LEFT
] then
481 function NameToDirAdv(Name
: String): Byte;
483 if Name
= DirNamesAdv
[1] then
486 if Name
= DirNamesAdv
[2] then
489 if Name
= DirNamesAdv
[3] then
495 function ActivateToStr(ActivateType
: Byte): String;
499 if ByteBool(ACTIVATE_PLAYERCOLLIDE
and ActivateType
) then
500 Result
:= Result
+ '+PC';
501 if ByteBool(ACTIVATE_MONSTERCOLLIDE
and ActivateType
) then
502 Result
:= Result
+ '+MC';
503 if ByteBool(ACTIVATE_PLAYERPRESS
and ActivateType
) then
504 Result
:= Result
+ '+PP';
505 if ByteBool(ACTIVATE_MONSTERPRESS
and ActivateType
) then
506 Result
:= Result
+ '+MP';
507 if ByteBool(ACTIVATE_SHOT
and ActivateType
) then
508 Result
:= Result
+ '+SH';
509 if ByteBool(ACTIVATE_NOMONSTER
and ActivateType
) then
510 Result
:= Result
+ '+NM';
512 if (Result
<> '') and (Result
[1] = '+') then
513 Delete(Result
, 1, 1);
516 function StrToActivate(Str
: String): Byte;
520 if Pos('PC', Str
) > 0 then
521 Result
:= ACTIVATE_PLAYERCOLLIDE
;
522 if Pos('MC', Str
) > 0 then
523 Result
:= Result
or ACTIVATE_MONSTERCOLLIDE
;
524 if Pos('PP', Str
) > 0 then
525 Result
:= Result
or ACTIVATE_PLAYERPRESS
;
526 if Pos('MP', Str
) > 0 then
527 Result
:= Result
or ACTIVATE_MONSTERPRESS
;
528 if Pos('SH', Str
) > 0 then
529 Result
:= Result
or ACTIVATE_SHOT
;
530 if Pos('NM', Str
) > 0 then
531 Result
:= Result
or ACTIVATE_NOMONSTER
;
534 function KeyToStr(Key
: Byte): String;
538 if ByteBool(KEY_RED
and Key
) then
539 Result
:= Result
+ '+RK';
540 if ByteBool(KEY_GREEN
and Key
) then
541 Result
:= Result
+ '+GK';
542 if ByteBool(KEY_BLUE
and Key
) then
543 Result
:= Result
+ '+BK';
544 if ByteBool(KEY_REDTEAM
and Key
) then
545 Result
:= Result
+ '+RT';
546 if ByteBool(KEY_BLUETEAM
and Key
) then
547 Result
:= Result
+ '+BT';
549 if (Result
<> '') and (Result
[1] = '+') then
550 Delete(Result
, 1, 1);
553 function StrToKey(Str
: String): Byte;
557 if Pos('RK', Str
) > 0 then
559 if Pos('GK', Str
) > 0 then
560 Result
:= Result
or KEY_GREEN
;
561 if Pos('BK', Str
) > 0 then
562 Result
:= Result
or KEY_BLUE
;
563 if Pos('RT', Str
) > 0 then
564 Result
:= Result
or KEY_REDTEAM
;
565 if Pos('BT', Str
) > 0 then
566 Result
:= Result
or KEY_BLUETEAM
;
569 function EffectToStr(Effect
: Byte): String;
571 if Effect
in [EFFECT_TELEPORT
..EFFECT_FIRE
] then
572 Result
:= EffectNames
[Effect
]
574 Result
:= EffectNames
[EFFECT_NONE
];
577 function StrToEffect(Str
: String): Byte;
581 Result
:= EFFECT_NONE
;
582 for i
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
583 if EffectNames
[i
] = Str
then
590 function MonsterToStr(MonType
: Byte): String;
592 if MonType
in [MONSTER_DEMON
..MONSTER_MAN
] then
593 Result
:= MonsterNames
[MonType
]
595 Result
:= MonsterNames
[MONSTER_ZOMBY
];
598 function StrToMonster(Str
: String): Byte;
602 Result
:= MONSTER_ZOMBY
;
603 for i
:= MONSTER_DEMON
to MONSTER_MAN
do
604 if MonsterNames
[i
] = Str
then
611 function ItemToStr(ItemType
: Byte): String;
613 if ItemType
in [ITEM_MEDKIT_SMALL
..ITEM_MAX
] then
614 Result
:= ItemNames
[ItemType
]
616 Result
:= ItemNames
[ITEM_AMMO_BULLETS
];
619 function StrToItem(Str
: String): Byte;
623 Result
:= ITEM_AMMO_BULLETS
;
624 for i
:= ITEM_MEDKIT_SMALL
to ITEM_MAX
do
625 if ItemNames
[i
] = Str
then
632 function ShotToStr(ShotType
: Byte): String;
634 if ShotType
in [TRIGGER_SHOT_PISTOL
..TRIGGER_SHOT_MAX
] then
635 Result
:= ShotNames
[ShotType
]
637 Result
:= ShotNames
[TRIGGER_SHOT_PISTOL
];
640 function StrToShot(Str
: String): Byte;
644 Result
:= TRIGGER_SHOT_PISTOL
;
645 for i
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
646 if ShotNames
[i
] = Str
then
653 function SelectedObjectCount(): Word;
659 if SelectedObjects
= nil then
662 for a
:= 0 to High(SelectedObjects
) do
663 if SelectedObjects
[a
].Live
then
664 Result
:= Result
+ 1;
667 function GetFirstSelected(): Integer;
673 if SelectedObjects
= nil then
676 for a
:= 0 to High(SelectedObjects
) do
677 if SelectedObjects
[a
].Live
then
684 function Normalize16(x
: Integer): Integer;
686 Result
:= (x
div 16) * 16;
689 procedure MoveMap(X
, Y
: Integer);
691 rx
, ry
, ScaleSz
: Integer;
693 with MainForm
.RenderPanel
do
695 ScaleSz
:= 16 div Scale
;
696 // Размер видимой части карты:
697 rx
:= Min(Normalize16(Width
), Normalize16(gMapInfo
.Width
)) div 2;
698 ry
:= Min(Normalize16(Height
), Normalize16(gMapInfo
.Height
)) div 2;
699 // Место клика на мини-карте:
700 MapOffset
.X
:= X
- (Width
- Max(gMapInfo
.Width
div ScaleSz
, 1) - 1);
701 MapOffset
.Y
:= Y
- 1;
702 // Это же место на "большой" карте:
703 MapOffset
.X
:= MapOffset
.X
* ScaleSz
;
704 MapOffset
.Y
:= MapOffset
.Y
* ScaleSz
;
705 // Левый верхний угол новой видимой части карты:
706 MapOffset
.X
:= MapOffset
.X
- rx
;
707 MapOffset
.Y
:= MapOffset
.Y
- ry
;
709 MapOffset
.X
:= EnsureRange(MapOffset
.X
, MainForm
.sbHorizontal
.Min
, MainForm
.sbHorizontal
.Max
);
710 MapOffset
.Y
:= EnsureRange(MapOffset
.Y
, MainForm
.sbVertical
.Min
, MainForm
.sbVertical
.Max
);
712 // MapOffset.X := Normalize16(MapOffset.X);
713 // MapOffset.Y := Normalize16(MapOffset.Y);
716 MainForm
.sbHorizontal
.Position
:= MapOffset
.X
;
717 MainForm
.sbVertical
.Position
:= MapOffset
.Y
;
719 MapOffset
.X
:= -MapOffset
.X
;
720 MapOffset
.Y
:= -MapOffset
.Y
;
725 function IsTexturedPanel(PanelType
: Word): Boolean;
727 Result
:= WordBool(PanelType
and (PANEL_WALL
or PANEL_BACK
or PANEL_FORE
or
728 PANEL_STEP
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
or
729 PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
));
732 procedure FillProperty();
737 MainForm
.vleObjectProperty
.Strings
.Clear();
738 MainForm
.RecountSelectedObjects();
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
;
1407 case Data
.DamageKind
of
1408 3: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_3
];
1409 4: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_4
];
1410 5: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_5
];
1411 6: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_6
];
1412 7: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_7
];
1413 8: str
:= _lc
[I_PROP_TR_DAMAGE_KIND_8
];
1414 else str
:= _lc
[I_PROP_TR_DAMAGE_KIND_0
];
1416 with ItemProps
[InsertRow(_lc
[I_PROP_TR_DAMAGE_KIND
], str
, True)] do
1418 EditStyle
:= esPickList
;
1425 with ItemProps
[InsertRow(_lc
[I_PROP_TR_HEALTH
], IntToStr(Data
.HealValue
), True)] do
1427 EditStyle
:= esSimple
;
1430 with ItemProps
[InsertRow(_lc
[I_PROP_TR_INTERVAL
], IntToStr(Data
.HealInterval
), True)] do
1432 EditStyle
:= esSimple
;
1435 with ItemProps
[InsertRow(_lc
[I_PROP_TR_HEALTH_MAX
], BoolNames
[Data
.HealMax
], True)] do
1437 EditStyle
:= esPickList
;
1440 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SILENT
], BoolNames
[Data
.HealSilent
], True)] do
1442 EditStyle
:= esPickList
;
1449 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_TYPE
], ShotToStr(Data
.ShotType
), True)] do
1451 EditStyle
:= esEllipsis
;
1455 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_SOUND
], BoolNames
[Data
.ShotSound
], True)] do
1457 EditStyle
:= esPickList
;
1461 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_PANEL
], IntToStr(Data
.ShotPanelID
), True)] do
1463 EditStyle
:= esEllipsis
;
1467 case Data
.ShotTarget
of
1468 1: str
:= _lc
[I_PROP_TR_SHOT_TO_1
];
1469 2: str
:= _lc
[I_PROP_TR_SHOT_TO_2
];
1470 3: str
:= _lc
[I_PROP_TR_SHOT_TO_3
];
1471 4: str
:= _lc
[I_PROP_TR_SHOT_TO_4
];
1472 5: str
:= _lc
[I_PROP_TR_SHOT_TO_5
];
1473 6: str
:= _lc
[I_PROP_TR_SHOT_TO_6
];
1474 else str
:= _lc
[I_PROP_TR_SHOT_TO_0
];
1476 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_TO
], str
, True)] do
1478 EditStyle
:= esPickList
;
1482 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_SIGHT
], IntToStr(Data
.ShotIntSight
), True)] do
1484 EditStyle
:= esSimple
;
1488 case Data
.ShotAim
of
1489 1: str
:= _lc
[I_PROP_TR_SHOT_AIM_1
];
1490 2: str
:= _lc
[I_PROP_TR_SHOT_AIM_2
];
1491 3: str
:= _lc
[I_PROP_TR_SHOT_AIM_3
];
1492 else str
:= _lc
[I_PROP_TR_SHOT_AIM_0
];
1494 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_AIM
], str
, True)] do
1496 EditStyle
:= esPickList
;
1500 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SPAWN_TO
],
1501 Format('(%d:%d)', [Data
.ShotPos
.X
, Data
.ShotPos
.Y
]), True)] do
1503 EditStyle
:= esEllipsis
;
1507 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_ANGLE
], IntToStr(Data
.ShotAngle
), True)] do
1509 EditStyle
:= esSimple
;
1513 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_DELAY
], IntToStr(Data
.ShotWait
), True)] do
1515 EditStyle
:= esSimple
;
1519 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_ACC
], IntToStr(Data
.ShotAccuracy
), True)] do
1521 EditStyle
:= esSimple
;
1525 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_AMMO
], IntToStr(Data
.ShotAmmo
), True)] do
1527 EditStyle
:= esSimple
;
1531 with ItemProps
[InsertRow(_lc
[I_PROP_TR_SHOT_RELOAD
], IntToStr(Data
.ShotIntReload
), True)] do
1533 EditStyle
:= esSimple
;
1540 with ItemProps
[InsertRow(_lc
[I_PROP_TR_COUNT
], IntToStr(Data
.FXCount
), True)] do
1542 EditStyle
:= esSimple
;
1546 if Data
.FXType
= 0 then
1547 str
:= _lc
[I_PROP_TR_EFFECT_PARTICLE
]
1549 str
:= _lc
[I_PROP_TR_EFFECT_ANIMATION
];
1550 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_TYPE
], str
, True)] do
1552 EditStyle
:= esEllipsis
;
1557 if Data
.FXType
= 0 then
1558 case Data
.FXSubType
of
1559 TRIGGER_EFFECT_SLIQUID
:
1560 str
:= _lc
[I_PROP_TR_EFFECT_SLIQUID
];
1561 TRIGGER_EFFECT_LLIQUID
:
1562 str
:= _lc
[I_PROP_TR_EFFECT_LLIQUID
];
1563 TRIGGER_EFFECT_DLIQUID
:
1564 str
:= _lc
[I_PROP_TR_EFFECT_DLIQUID
];
1565 TRIGGER_EFFECT_BLOOD
:
1566 str
:= _lc
[I_PROP_TR_EFFECT_BLOOD
];
1567 TRIGGER_EFFECT_SPARK
:
1568 str
:= _lc
[I_PROP_TR_EFFECT_SPARK
];
1569 TRIGGER_EFFECT_BUBBLE
:
1570 str
:= _lc
[I_PROP_TR_EFFECT_BUBBLE
];
1572 if Data
.FXType
= 1 then
1574 if (Data
.FXSubType
= 0) or (Data
.FXSubType
> EFFECT_FIRE
) then
1575 Data
.FXSubType
:= EFFECT_TELEPORT
;
1576 str
:= EffectToStr(Data
.FXSubType
);
1578 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SUBTYPE
], str
, True)] do
1580 EditStyle
:= esEllipsis
;
1584 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_COLOR
], IntToStr(Data
.FXColorR
or (Data
.FXColorG
shl 8) or (Data
.FXColorB
shl 16)), True)] do
1586 EditStyle
:= esEllipsis
;
1590 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_CENTER
], BoolNames
[Data
.FXPos
= 0], True)] do
1592 EditStyle
:= esPickList
;
1596 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EX_DELAY
], IntToStr(Data
.FXWait
), True)] do
1598 EditStyle
:= esSimple
;
1602 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_VELX
], IntToStr(Data
.FXVelX
), True)] do
1604 EditStyle
:= esSimple
;
1608 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_VELY
], IntToStr(Data
.FXVelY
), True)] do
1610 EditStyle
:= esSimple
;
1614 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPL
], IntToStr(Data
.FXSpreadL
), True)] do
1616 EditStyle
:= esSimple
;
1620 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPR
], IntToStr(Data
.FXSpreadR
), True)] do
1622 EditStyle
:= esSimple
;
1626 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPU
], IntToStr(Data
.FXSpreadU
), True)] do
1628 EditStyle
:= esSimple
;
1632 with ItemProps
[InsertRow(_lc
[I_PROP_TR_EFFECT_SPD
], IntToStr(Data
.FXSpreadD
), True)] do
1634 EditStyle
:= esSimple
;
1638 end; //case TriggerType
1640 end; // OBJECT_TRIGGER:
1644 procedure ChangeShownProperty(Name
: String; NewValue
: String);
1648 if SelectedObjectCount() <> 1 then
1650 if not SelectedObjects
[GetFirstSelected()].Live
then
1653 // Есть ли такой ключ:
1654 if MainForm
.vleObjectProperty
.FindRow(Name
, row
) then
1656 MainForm
.vleObjectProperty
.Values
[Name
] := NewValue
;
1660 procedure SelectObject(fObjectType
: Byte; fID
: DWORD
; Multi
: Boolean);
1669 // Уже выделен - убираем:
1670 if SelectedObjects
<> nil then
1671 for a
:= 0 to High(SelectedObjects
) do
1672 with SelectedObjects
[a
] do
1673 if Live
and (ID
= fID
) and
1674 (ObjectType
= fObjectType
) then
1683 SetLength(SelectedObjects
, Length(SelectedObjects
)+1);
1685 with SelectedObjects
[High(SelectedObjects
)] do
1687 ObjectType
:= fObjectType
;
1694 SetLength(SelectedObjects
, 1);
1696 with SelectedObjects
[0] do
1698 ObjectType
:= fObjectType
;
1704 MainForm
.miCopy
.Enabled
:= True;
1705 MainForm
.miCut
.Enabled
:= True;
1707 if fObjectType
= OBJECT_PANEL
then
1709 MainForm
.miToFore
.Enabled
:= True;
1710 MainForm
.miToBack
.Enabled
:= True;
1714 procedure RemoveSelectFromObjects();
1716 SelectedObjects
:= nil;
1717 DrawPressRect
:= False;
1718 MouseLDown
:= False;
1719 MouseRDown
:= False;
1720 MouseAction
:= MOUSEACTION_NONE
;
1721 SelectFlag
:= SELECTFLAG_NONE
;
1722 ResizeType
:= RESIZETYPE_NONE
;
1723 ResizeDirection
:= RESIZEDIR_NONE
;
1725 MainForm
.vleObjectProperty
.Strings
.Clear();
1727 MainForm
.miCopy
.Enabled
:= False;
1728 MainForm
.miCut
.Enabled
:= False;
1729 MainForm
.miToFore
.Enabled
:= False;
1730 MainForm
.miToBack
.Enabled
:= False;
1733 procedure DeleteSelectedObjects();
1738 if SelectedObjects
= nil then
1744 for a
:= 0 to High(SelectedObjects
) do
1745 with SelectedObjects
[a
] do
1750 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1751 i
:= High(UndoBuffer
);
1755 SetLength(UndoBuffer
[i
], Length(UndoBuffer
[i
])+1);
1756 ii
:= High(UndoBuffer
[i
]);
1761 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_PANEL
;
1762 New(UndoBuffer
[i
, ii
].Panel
);
1763 UndoBuffer
[i
, ii
].Panel
^ := gPanels
[ID
];
1767 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_ITEM
;
1768 UndoBuffer
[i
, ii
].Item
:= gItems
[ID
];
1772 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_AREA
;
1773 UndoBuffer
[i
, ii
].Area
:= gAreas
[ID
];
1777 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_TRIGGER
;
1778 UndoBuffer
[i
, ii
].Trigger
:= gTriggers
[ID
];
1782 RemoveObject(ID
, ObjectType
);
1785 RemoveSelectFromObjects();
1787 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1788 MainForm
.RecountSelectedObjects();
1791 procedure Undo_Add(ObjectType
: Byte; ID
: DWORD
; Group
: Boolean = False);
1795 if (not Group
) or (Length(UndoBuffer
) = 0) then
1796 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1797 SetLength(UndoBuffer
[High(UndoBuffer
)], Length(UndoBuffer
[High(UndoBuffer
)])+1);
1798 i
:= High(UndoBuffer
);
1799 ii
:= High(UndoBuffer
[i
]);
1803 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_PANEL
;
1805 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_ITEM
;
1807 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_MONSTER
;
1809 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_AREA
;
1811 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_TRIGGER
;
1814 UndoBuffer
[i
, ii
].AddID
:= ID
;
1816 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1819 procedure FullClear();
1821 RemoveSelectFromObjects();
1823 LoadSky(gMapInfo
.SkyName
);
1825 slInvalidTextures
.Clear();
1826 MapCheckForm
.lbErrorList
.Clear();
1827 MapCheckForm
.mErrorDescription
.Clear();
1829 MainForm
.miUndo
.Enabled
:= False;
1830 MainForm
.sbHorizontal
.Position
:= 0;
1831 MainForm
.sbVertical
.Position
:= 0;
1832 MainForm
.FormResize(nil);
1833 MainForm
.Caption
:= FormCaption
;
1838 procedure ErrorMessageBox(str
: String);
1840 Application
.MessageBox(PChar(str
), PChar(_lc
[I_MSG_ERROR
]),
1841 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
1844 function CheckProperty(): Boolean;
1850 _id
:= GetFirstSelected();
1852 if SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
then
1853 with gPanels
[SelectedObjects
[_id
].ID
] do
1855 if TextureWidth
<> 0 then
1856 if StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]], 1) mod TextureWidth
<> 0 then
1858 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXWIDTH
],
1863 if TextureHeight
<> 0 then
1864 if StrToIntDef(Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]), 1) mod TextureHeight
<> 0 then
1866 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXHEIGHT
],
1871 if IsTexturedPanel(PanelType
) and (TextureName
<> '') then
1872 if not (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_ALPHA
]], -1) in [0..255]) then
1874 ErrorMessageBox(_lc
[I_MSG_WRONG_ALPHA
]);
1879 if SelectedObjects
[_id
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
1880 if (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]], 0) <= 0) or
1881 (StrToIntDef(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]], 0) <= 0) then
1883 ErrorMessageBox(_lc
[I_MSG_WRONG_SIZE
]);
1887 if (Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_X
]]) = '') or
1888 (Trim(MainForm
.vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]) = '') then
1890 ErrorMessageBox(_lc
[I_MSG_WRONG_XY
]);
1897 procedure SelectTexture(ID
: Integer);
1899 MainForm
.lbTextureList
.ItemIndex
:= ID
;
1900 MainForm
.lbTextureListClick(nil);
1903 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
1905 a
, FrameLen
: Integer;
1908 ResourceName
: String;
1909 FullResourceName
: String;
1910 SectionName
: String;
1912 Width
, Height
: Word;
1920 if aSection
= '..' then
1923 SectionName
:= aSection
;
1926 aWAD
:= _lc
[I_WAD_SPECIAL_MAP
];
1928 if aWAD
= _lc
[I_WAD_SPECIAL_MAP
] then
1930 g_ProcessResourceStr(OpenedMap
, @fn
, nil, nil);
1932 ResourceName
:= ':'+SectionName
+'\'+aTex
;
1935 if aWAD
= _lc
[I_WAD_SPECIAL_TEXS
] then
1936 begin // Спец. текстуры
1938 ResourceName
:= aTex
;
1941 begin // Внешний WAD
1942 FileName
:= WadsDir
+ DirectorySeparator
+ aWAD
;
1943 ResourceName
:= aWAD
+':'+SectionName
+'\'+aTex
;
1948 // Есть ли уже такая текстура:
1949 for a
:= 0 to MainForm
.lbTextureList
.Items
.Count
-1 do
1950 if ResourceName
= MainForm
.lbTextureList
.Items
[a
] then
1953 ErrorMessageBox(Format(_lc
[I_MSG_TEXTURE_ALREADY
],
1958 // Название ресурса <= 64 символов:
1959 if Length(ResourceName
) > 64 then
1962 ErrorMessageBox(Format(_lc
[I_MSG_RES_NAME_64
],
1970 if aWAD
= _lc
[I_WAD_SPECIAL_TEXS
] then
1972 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1979 FullResourceName
:= FileName
+':'+SectionName
+'\'+aTex
;
1981 if IsAnim(FullResourceName
) then
1982 begin // Аним. текстура
1983 GetFrame(FullResourceName
, Data
, FrameLen
, Width
, Height
);
1985 if not g_CreateTextureMemorySize(Data
, FrameLen
, ResourceName
, 0, 0, Width
, Height
, 1) then
1987 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1989 else // Обычная текстура
1991 if not g_CreateTextureWAD(ResourceName
, FullResourceName
) then
1993 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1995 if (not ok
) and (slInvalidTextures
.IndexOf(ResourceName
) = -1) then
1997 slInvalidTextures
.Add(ResourceName
);
2000 if (a
> -1) and (not silent
) then
2007 procedure UpdateCaption(sMap
, sFile
, sRes
: String);
2010 if (sFile
= '') and (sRes
= '') and (sMap
= '') then
2011 Caption
:= FormCaption
2014 Caption
:= Format('%s - %s:%s', [FormCaption
, sFile
, sRes
])
2016 if (sFile
<> '') and (sRes
<> '') then
2017 Caption
:= Format('%s - %s (%s:%s)', [FormCaption
, sMap
, sFile
, sRes
])
2019 Caption
:= Format('%s - %s', [FormCaption
, sMap
]);
2022 procedure OpenMap(FileName
: String; mapN
: String);
2027 SelectMapForm
.Caption
:= _lc
[I_CAP_OPEN
];
2028 SelectMapForm
.GetMaps(FileName
);
2030 if (FileName
= OpenedWAD
) and
2031 (OpenedMap
<> '') then
2033 MapName
:= OpenedMap
;
2034 while (Pos(':\', MapName
) > 0) do
2035 Delete(MapName
, 1, Pos(':\', MapName
) + 1);
2037 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(MapName
);
2038 SelectMapForm
.lbMapList
.ItemIndex
:= idx
;
2041 if SelectMapForm
.lbMapList
.Count
> 0 then
2042 SelectMapForm
.lbMapList
.ItemIndex
:= 0
2044 SelectMapForm
.lbMapList
.ItemIndex
:= -1;
2049 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(mapN
);
2053 if (SelectMapForm
.ShowModal() = mrOK
) and
2054 (SelectMapForm
.lbMapList
.ItemIndex
<> -1) then
2055 idx
:= SelectMapForm
.lbMapList
.ItemIndex
2060 MapName
:= SelectMapForm
.lbMapList
.Items
[idx
];
2066 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
2067 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
2068 pLoadProgress
.Show();
2070 OpenedMap
:= FileName
+':\'+MapName
;
2071 OpenedWAD
:= FileName
;
2073 idx
:= RecentFiles
.IndexOf(OpenedMap
);
2074 // Такая карта уже недавно открывалась:
2076 RecentFiles
.Delete(idx
);
2077 RecentFiles
.Insert(0, OpenedMap
);
2078 RefreshRecentMenu();
2082 pLoadProgress
.Hide();
2085 lbTextureList
.Sorted
:= True;
2086 lbTextureList
.Sorted
:= False;
2088 UpdateCaption(gMapInfo
.Name
, ExtractFileName(FileName
), MapName
);
2092 procedure MoveSelectedObjects(Wall
, alt
: Boolean; dx
, dy
: Integer);
2097 if SelectedObjects
= nil then
2104 for a
:= 0 to High(SelectedObjects
) do
2105 if SelectedObjects
[a
].Live
then
2107 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, dx
, 0) then
2110 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, 0, dy
) then
2113 if (not okX
) or (not okY
) then
2119 for a
:= 0 to High(SelectedObjects
) do
2120 if SelectedObjects
[a
].Live
then
2123 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, dx
, 0);
2126 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, 0, dy
);
2128 if alt
and (SelectedObjects
[a
].ObjectType
= OBJECT_TRIGGER
) then
2130 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_PRESS
,
2131 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
] then
2132 begin // Двигаем зону Расширителя
2134 gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
+dx
;
2136 gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
+dy
;
2139 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_TELEPORT
] then
2140 begin // Двигаем точку назначения Телепорта
2142 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
+dx
;
2144 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
+dy
;
2147 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNMONSTER
] then
2148 begin // Двигаем точку создания монстра
2150 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
+dx
;
2152 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
+dy
;
2155 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNITEM
] then
2156 begin // Двигаем точку создания предмета
2158 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
+dx
;
2160 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
+dy
;
2163 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SHOT
] then
2164 begin // Двигаем точку создания выстрела
2166 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
+dx
;
2168 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
+dy
;
2173 LastMovePoint
:= MousePos
;
2177 procedure ShowLayer(Layer
: Byte; show
: Boolean);
2179 LayerEnabled
[Layer
] := show
;
2184 MainForm
.miLayer1
.Checked
:= show
;
2185 MainForm
.miLayerP1
.Checked
:= show
;
2189 MainForm
.miLayer2
.Checked
:= show
;
2190 MainForm
.miLayerP2
.Checked
:= show
;
2194 MainForm
.miLayer3
.Checked
:= show
;
2195 MainForm
.miLayerP3
.Checked
:= show
;
2199 MainForm
.miLayer4
.Checked
:= show
;
2200 MainForm
.miLayerP4
.Checked
:= show
;
2204 MainForm
.miLayer5
.Checked
:= show
;
2205 MainForm
.miLayerP5
.Checked
:= show
;
2209 MainForm
.miLayer6
.Checked
:= show
;
2210 MainForm
.miLayerP6
.Checked
:= show
;
2214 MainForm
.miLayer7
.Checked
:= show
;
2215 MainForm
.miLayerP7
.Checked
:= show
;
2219 MainForm
.miLayer8
.Checked
:= show
;
2220 MainForm
.miLayerP8
.Checked
:= show
;
2224 MainForm
.miLayer9
.Checked
:= show
;
2225 MainForm
.miLayerP9
.Checked
:= show
;
2229 RemoveSelectFromObjects();
2232 procedure SwitchLayer(Layer
: Byte);
2234 ShowLayer(Layer
, not LayerEnabled
[Layer
]);
2237 procedure SwitchMap();
2239 ShowMap
:= not ShowMap
;
2240 MainForm
.tbShowMap
.Down
:= ShowMap
;
2243 procedure ShowEdges();
2245 if drEdge
[3] < 255 then
2248 drEdge
[3] := gAlphaEdge
;
2251 function SelectedTexture(): String;
2253 if MainForm
.lbTextureList
.ItemIndex
<> -1 then
2254 Result
:= MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]
2259 function IsSpecialTextureSel(): Boolean;
2261 Result
:= (MainForm
.lbTextureList
.ItemIndex
<> -1) and
2262 IsSpecialTexture(MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]);
2265 function CopyBufferToString(var CopyBuf
: TCopyRecArray
): String;
2270 procedure AddInt(x
: Integer);
2272 Res
:= Res
+ IntToStr(x
) + ' ';
2278 if Length(CopyBuf
) = 0 then
2281 Res
:= CLIPBOARD_SIG
+ ' ';
2283 for i
:= 0 to High(CopyBuf
) do
2285 if (CopyBuf
[i
].ObjectType
= OBJECT_PANEL
) and
2286 (CopyBuf
[i
].Panel
= nil) then
2290 AddInt(CopyBuf
[i
].ObjectType
);
2293 // Свойства объекта:
2294 case CopyBuf
[i
].ObjectType
of
2296 with CopyBuf
[i
].Panel
^ do
2303 Res
:= Res
+ '"' + TextureName
+ '" ';
2305 AddInt(IfThen(Blending
, 1, 0));
2309 with CopyBuf
[i
].Item
do
2314 AddInt(IfThen(OnlyDM
, 1, 0));
2315 AddInt(IfThen(Fall
, 1, 0));
2319 with CopyBuf
[i
].Monster
do
2321 AddInt(MonsterType
);
2324 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2328 with CopyBuf
[i
].Area
do
2333 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2337 with CopyBuf
[i
].Trigger
do
2339 AddInt(TriggerType
);
2344 AddInt(ActivateType
);
2346 AddInt(IfThen(Enabled
, 1, 0));
2347 AddInt(TexturePanel
);
2349 for j
:= 0 to 127 do
2350 AddInt(Data
.Default
[j
]);
2358 procedure StringToCopyBuffer(Str
: String; var CopyBuf
: TCopyRecArray
;
2363 function GetNext(): String;
2368 if Str
[1] = '"' then
2380 Result
:= Copy(Str
, 1, p
-1);
2396 Result
:= Copy(Str
, 1, p
-1);
2406 if GetNext() <> CLIPBOARD_SIG
then
2412 t
:= StrToIntDef(GetNext(), 0);
2414 if (t
< OBJECT_PANEL
) or (t
> OBJECT_TRIGGER
) or
2415 (GetNext() <> ';') then
2416 begin // Что-то не то => пропускаем:
2424 i
:= Length(CopyBuf
);
2425 SetLength(CopyBuf
, i
+ 1);
2427 CopyBuf
[i
].ObjectType
:= t
;
2428 CopyBuf
[i
].Panel
:= nil;
2430 // Свойства объекта:
2434 New(CopyBuf
[i
].Panel
);
2436 with CopyBuf
[i
].Panel
^ do
2438 PanelType
:= StrToIntDef(GetNext(), PANEL_WALL
);
2439 X
:= StrToIntDef(GetNext(), 0);
2440 Y
:= StrToIntDef(GetNext(), 0);
2441 pmin
.X
:= Min(X
, pmin
.X
);
2442 pmin
.Y
:= Min(Y
, pmin
.Y
);
2443 Width
:= StrToIntDef(GetNext(), 16);
2444 Height
:= StrToIntDef(GetNext(), 16);
2445 TextureName
:= GetNext();
2446 Alpha
:= StrToIntDef(GetNext(), 0);
2447 Blending
:= (GetNext() = '1');
2452 with CopyBuf
[i
].Item
do
2454 ItemType
:= StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL
);
2455 X
:= StrToIntDef(GetNext(), 0);
2456 Y
:= StrToIntDef(GetNext(), 0);
2457 pmin
.X
:= Min(X
, pmin
.X
);
2458 pmin
.Y
:= Min(Y
, pmin
.Y
);
2459 OnlyDM
:= (GetNext() = '1');
2460 Fall
:= (GetNext() = '1');
2464 with CopyBuf
[i
].Monster
do
2466 MonsterType
:= StrToIntDef(GetNext(), MONSTER_DEMON
);
2467 X
:= StrToIntDef(GetNext(), 0);
2468 Y
:= StrToIntDef(GetNext(), 0);
2469 pmin
.X
:= Min(X
, pmin
.X
);
2470 pmin
.Y
:= Min(Y
, pmin
.Y
);
2472 if GetNext() = '1' then
2475 Direction
:= D_RIGHT
;
2479 with CopyBuf
[i
].Area
do
2481 AreaType
:= StrToIntDef(GetNext(), AREA_PLAYERPOINT1
);
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 if GetNext() = '1' then
2489 Direction
:= D_RIGHT
;
2493 with CopyBuf
[i
].Trigger
do
2495 TriggerType
:= StrToIntDef(GetNext(), TRIGGER_EXIT
);
2496 X
:= StrToIntDef(GetNext(), 0);
2497 Y
:= StrToIntDef(GetNext(), 0);
2498 pmin
.X
:= Min(X
, pmin
.X
);
2499 pmin
.Y
:= Min(Y
, pmin
.Y
);
2500 Width
:= StrToIntDef(GetNext(), 16);
2501 Height
:= StrToIntDef(GetNext(), 16);
2502 ActivateType
:= StrToIntDef(GetNext(), 0);
2503 Key
:= StrToIntDef(GetNext(), 0);
2504 Enabled
:= (GetNext() = '1');
2505 TexturePanel
:= StrToIntDef(GetNext(), 0);
2507 for j
:= 0 to 127 do
2508 Data
.Default
[j
] := StrToIntDef(GetNext(), 0);
2513 pmin
.X
:= Min(Data
.TargetPoint
.X
, pmin
.X
);
2514 pmin
.Y
:= Min(Data
.TargetPoint
.Y
, pmin
.Y
);
2516 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
2518 pmin
.X
:= Min(Data
.tX
, pmin
.X
);
2519 pmin
.Y
:= Min(Data
.tY
, pmin
.Y
);
2521 TRIGGER_SPAWNMONSTER
:
2523 pmin
.X
:= Min(Data
.MonPos
.X
, pmin
.X
);
2524 pmin
.Y
:= Min(Data
.MonPos
.Y
, pmin
.Y
);
2528 pmin
.X
:= Min(Data
.ItemPos
.X
, pmin
.X
);
2529 pmin
.Y
:= Min(Data
.ItemPos
.Y
, pmin
.Y
);
2533 pmin
.X
:= Min(Data
.ShotPos
.X
, pmin
.X
);
2534 pmin
.Y
:= Min(Data
.ShotPos
.Y
, pmin
.Y
);
2542 //----------------------------------------
2543 //Закончились вспомогательные процедуры
2544 //----------------------------------------
2546 procedure TMainForm
.RefreshRecentMenu();
2551 // Лишние запомненные карты:
2552 while RecentFiles
.Count
> RecentCount
do
2553 RecentFiles
.Delete(RecentFiles
.Count
-1);
2555 // Лишние строки меню:
2556 while MainMenu
.Items
[0].Count
> RECENT_FILES_MENU_START
do
2557 MainMenu
.Items
[0].Delete(MainMenu
.Items
[0].Count
-1);
2559 // Отделение списка карт от строки "Выход":
2560 if RecentFiles
.Count
> 0 then
2562 MI
:= TMenuItem
.Create(MainMenu
.Items
[0]);
2564 MainMenu
.Items
[0].Add(MI
);
2567 // Добавление в меню списка запомненных карт:
2568 for i
:= 0 to RecentFiles
.Count
-1 do
2570 MI
:= TMenuItem
.Create(MainMenu
.Items
[0]);
2571 MI
.Caption
:= IntToStr(i
+1) + ' ' + RecentFiles
[i
];
2572 MI
.OnClick
:= aRecentFileExecute
;
2573 MainMenu
.Items
[0].Add(MI
);
2577 procedure TMainForm
.aRecentFileExecute(Sender
: TObject
);
2582 s
:= LowerCase((Sender
as TMenuItem
).Caption
);
2583 Delete(s
, Pos('&', s
), 1);
2584 s
:= Trim(Copy(s
, 1, 2));
2585 n
:= StrToIntDef(s
, 0) - 1;
2586 if (n
>= 0) and (n
<= RecentFiles
.Count
) then
2588 fn
:= g_ExtractWadName(RecentFiles
[n
]);
2589 if FileExists(fn
) then
2591 s
:= g_ExtractFilePathName(RecentFiles
[n
]);
2594 else if Application
.MessageBox(PChar(_lc
[I_MSG_DEL_RECENT_PROMT
]), PChar(_lc
[I_MSG_DEL_RECENT
]), MB_ICONQUESTION
or MB_YESNO
) = idYes
then
2596 RecentFiles
.Delete(n
);
2597 RefreshRecentMenu();
2602 procedure TMainForm
.aEditorOptionsExecute(Sender
: TObject
);
2604 OptionsForm
.ShowModal();
2607 procedure LoadStdFont(cfgres
, texture
: string; var FontID
: DWORD
);
2617 g_ReadResource(GameWad
, 'FONTS', cfgres
, cfgdata
, cfglen
);
2618 if cfgdata
<> nil then
2620 if not g_CreateTextureWAD('FONT_STD', GameWad
+ ':FONTS\' + texture
) then
2621 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING
);
2623 config
:= TConfig
.CreateMem(cfgdata
, cfglen
);
2624 cwdt
:= Min(Max(config
.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2625 chgt
:= Min(Max(config
.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2626 spc
:= Min(Max(config
.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2628 if g_GetTexture('FONT_STD', ID
) then
2629 e_TextureFontBuild(ID
, FontID
, cwdt
, chgt
, spc
- 2);
2636 e_WriteLog('Could not load FONT_STD', MSG_WARNING
)
2640 procedure TMainForm
.FormCreate(Sender
: TObject
);
2648 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION
, MSG_NOTIFY
);
2649 e_WriteLog('Build date: ' + EDITOR_BUILDDATE
+ ' ' + EDITOR_BUILDTIME
, MSG_NOTIFY
);
2650 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY
);
2651 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY
);
2653 slInvalidTextures
:= TStringList
.Create
;
2655 ShowLayer(LAYER_BACK
, True);
2656 ShowLayer(LAYER_WALLS
, True);
2657 ShowLayer(LAYER_FOREGROUND
, True);
2658 ShowLayer(LAYER_STEPS
, True);
2659 ShowLayer(LAYER_WATER
, True);
2660 ShowLayer(LAYER_ITEMS
, True);
2661 ShowLayer(LAYER_MONSTERS
, True);
2662 ShowLayer(LAYER_AREAS
, True);
2663 ShowLayer(LAYER_TRIGGERS
, True);
2667 FormCaption
:= MainForm
.Caption
;
2671 config
:= TConfig
.CreateFile(CfgFileName
);
2673 if config
.ReadInt('Editor', 'XPos', -1) = -1 then
2674 Position
:= poDesktopCenter
2676 Left
:= config
.ReadInt('Editor', 'XPos', Left
);
2677 Top
:= config
.ReadInt('Editor', 'YPos', Top
);
2678 Width
:= config
.ReadInt('Editor', 'Width', Width
);
2679 Height
:= config
.ReadInt('Editor', 'Height', Height
);
2681 if config
.ReadBool('Editor', 'Maximize', False) then
2682 WindowState
:= wsMaximized
;
2683 ShowMap
:= config
.ReadBool('Editor', 'Minimap', False);
2684 PanelProps
.Width
:= config
.ReadInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
2685 Splitter1
.Left
:= PanelProps
.Left
;
2686 PanelObjs
.Height
:= config
.ReadInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
2687 Splitter2
.Top
:= PanelObjs
.Top
;
2688 StatusBar
.Top
:= PanelObjs
.BoundsRect
.Bottom
;
2689 DotEnable
:= config
.ReadBool('Editor', 'DotEnable', True);
2690 DotColor
:= config
.ReadInt('Editor', 'DotColor', $FFFFFF);
2691 DotStepOne
:= config
.ReadInt('Editor', 'DotStepOne', 16);
2692 DotStepTwo
:= config
.ReadInt('Editor', 'DotStepTwo', 8);
2693 DotStep
:= config
.ReadInt('Editor', 'DotStep', DotStepOne
);
2694 DrawTexturePanel
:= config
.ReadBool('Editor', 'DrawTexturePanel', True);
2695 DrawPanelSize
:= config
.ReadBool('Editor', 'DrawPanelSize', True);
2696 BackColor
:= config
.ReadInt('Editor', 'BackColor', $7F6040);
2697 PreviewColor
:= config
.ReadInt('Editor', 'PreviewColor', $00FF00);
2698 UseCheckerboard
:= config
.ReadBool('Editor', 'UseCheckerboard', True);
2699 gColorEdge
:= config
.ReadInt('Editor', 'EdgeColor', COLOR_EDGE
);
2700 gAlphaEdge
:= config
.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE
);
2701 if gAlphaEdge
= 255 then
2702 gAlphaEdge
:= ALPHA_EDGE
;
2703 drEdge
[0] := GetRValue(gColorEdge
);
2704 drEdge
[1] := GetGValue(gColorEdge
);
2705 drEdge
[2] := GetBValue(gColorEdge
);
2706 if not config
.ReadBool('Editor', 'EdgeShow', True) then
2709 drEdge
[3] := gAlphaEdge
;
2710 gAlphaTriggerLine
:= config
.ReadInt('Editor', 'LineAlpha', ALPHA_LINE
);
2711 if gAlphaTriggerLine
= 255 then
2712 gAlphaTriggerLine
:= ALPHA_LINE
;
2713 gAlphaTriggerArea
:= config
.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA
);
2714 if gAlphaTriggerArea
= 255 then
2715 gAlphaTriggerArea
:= ALPHA_AREA
;
2716 gAlphaMonsterRect
:= config
.ReadInt('Editor', 'MonsterRectAlpha', 0);
2717 gAlphaAreaRect
:= config
.ReadInt('Editor', 'AreaRectAlpha', 0);
2718 if config
.ReadInt('Editor', 'Scale', 0) = 1 then
2722 if config
.ReadInt('Editor', 'DotSize', 0) = 1 then
2726 OpenDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastOpenDir', MapsDir
);
2727 SaveDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastSaveDir', MapsDir
);
2729 s
:= config
.ReadStr('Editor', 'Language', '');
2732 Compress
:= config
.ReadBool('Editor', 'Compress', True);
2733 Backup
:= config
.ReadBool('Editor', 'Backup', True);
2735 TestGameMode
:= config
.ReadStr('TestRun', 'GameMode', 'DM');
2736 TestLimTime
:= config
.ReadStr('TestRun', 'LimTime', '0');
2737 TestLimScore
:= config
.ReadStr('TestRun', 'LimScore', '0');
2738 TestOptionsTwoPlayers
:= config
.ReadBool('TestRun', 'TwoPlayers', False);
2739 TestOptionsTeamDamage
:= config
.ReadBool('TestRun', 'TeamDamage', False);
2740 TestOptionsAllowExit
:= config
.ReadBool('TestRun', 'AllowExit', True);
2741 TestOptionsWeaponStay
:= config
.ReadBool('TestRun', 'WeaponStay', False);
2742 TestOptionsMonstersDM
:= config
.ReadBool('TestRun', 'MonstersDM', False);
2743 TestMapOnce
:= config
.ReadBool('TestRun', 'MapOnce', False);
2744 {$IF DEFINED(DARWIN)}
2745 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeDrawin', GameExeFile
);
2746 {$ELSEIF DEFINED(WINDOWS)}
2747 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeWindows', GameExeFile
);
2749 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeUnix', GameExeFile
);
2751 TestD2DArgs
:= config
.ReadStr('TestRun', 'Args', '');
2753 RecentCount
:= config
.ReadInt('Editor', 'RecentCount', 5);
2754 if RecentCount
> 10 then
2756 if RecentCount
< 2 then
2759 RecentFiles
:= TStringList
.Create();
2760 for i
:= 0 to RecentCount
-1 do
2762 s
:= config
.ReadStr('RecentFiles', IntToStr(i
+1), '');
2766 RefreshRecentMenu();
2770 tbShowMap
.Down
:= ShowMap
;
2771 tbGridOn
.Down
:= DotEnable
;
2772 pcObjects
.ActivePageIndex
:= 0;
2773 Application
.Title
:= _lc
[I_EDITOR_TITLE
];
2775 Application
.OnIdle
:= OnIdle
;
2778 procedure PrintBlack(X
, Y
: Integer; Text: string; FontID
: DWORD
);
2780 // NOTE: all the font printing routines assume CP1251
2781 e_TextureFontPrintEx(X
, Y
, Text, FontID
, 0, 0, 0, 1.0);
2784 procedure TMainForm
.Draw();
2789 Width
, Height
: Word;
2792 aX
, aY
, aX2
, aY2
, XX
, ScaleSz
: Integer;
2801 e_Clear(GL_COLOR_BUFFER_BIT
,
2802 GetRValue(BackColor
)/255,
2803 GetGValue(BackColor
)/255,
2804 GetBValue(BackColor
)/255);
2808 ObjCount
:= SelectedObjectCount();
2810 // Обводим выделенные объекты красной рамкой:
2811 if ObjCount
> 0 then
2813 for a
:= 0 to High(SelectedObjects
) do
2814 if SelectedObjects
[a
].Live
then
2816 Rect
:= ObjectGetRect(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
);
2820 e_DrawQuad(X
+MapOffset
.X
, Y
+MapOffset
.Y
,
2821 X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+Height
-1,
2824 // Рисуем точки изменения размеров:
2825 if (ObjCount
= 1) and
2826 (SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) then
2828 e_DrawPoint(5, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2829 e_DrawPoint(5, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2830 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 255, 255);
2831 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 255, 255);
2833 e_DrawPoint(3, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2834 e_DrawPoint(3, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2835 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 0, 0);
2836 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 0, 0);
2843 if DotEnable
and (PreviewMode
= 0) then
2850 x
:= MapOffset
.X
mod DotStep
;
2851 y
:= MapOffset
.Y
mod DotStep
;
2853 while x
< RenderPanel
.Width
do
2855 while y
< RenderPanel
.Height
do
2857 e_DrawPoint(DotSize
, x
+ a
, y
+ a
,
2858 GetRValue(DotColor
),
2859 GetGValue(DotColor
),
2860 GetBValue(DotColor
));
2864 y
:= MapOffset
.Y
mod DotStep
;
2869 if (lbTextureList
.ItemIndex
<> -1) and (cbPreview
.Checked
) and
2870 (not IsSpecialTextureSel()) and (PreviewMode
= 0) then
2872 if not g_GetTexture(SelectedTexture(), ID
) then
2873 g_GetTexture('NOTEXTURE', ID
);
2874 g_GetTextureSizeByID(ID
, Width
, Height
);
2875 if UseCheckerboard
then
2877 if g_GetTexture('PREVIEW', PID
) then
2878 e_DrawFill(PID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, Width
div 16 + 1, Height
div 16 + 1, 0, True, False);
2880 e_DrawFillQuad(RenderPanel
.Width
-Width
-2, RenderPanel
.Height
-Height
-2,
2881 RenderPanel
.Width
-1, RenderPanel
.Height
-1,
2882 GetRValue(PreviewColor
), GetGValue(PreviewColor
), GetBValue(PreviewColor
), 0);
2883 e_Draw(ID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, 0, True, False);
2886 // Подсказка при выборе точки Телепорта:
2887 if SelectFlag
= SELECTFLAG_TELEPORT
then
2889 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
2890 if Data
.d2d_teleport
then
2891 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2892 MousePos
.X
+16, MousePos
.Y
-1,
2895 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+AreaSize
[AREA_DMPOINT
].Width
-1,
2896 MousePos
.Y
+AreaSize
[AREA_DMPOINT
].Height
-1, 255, 255, 255);
2898 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2899 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2900 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_TELEPORT
], gEditorFont
);
2903 // Подсказка при выборе точки появления:
2904 if SelectFlag
= SELECTFLAG_SPAWNPOINT
then
2906 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2907 MousePos
.X
+16, MousePos
.Y
-1,
2909 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2910 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2911 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_SPAWN
], gEditorFont
);
2914 // Подсказка при выборе панели двери:
2915 if SelectFlag
= SELECTFLAG_DOOR
then
2917 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2918 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2919 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_DOOR
], gEditorFont
);
2922 // Подсказка при выборе панели с текстурой:
2923 if SelectFlag
= SELECTFLAG_TEXTURE
then
2925 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 192, 192, 192, 127);
2926 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 255, 255, 255);
2927 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_TEXTURE
], gEditorFont
);
2930 // Подсказка при выборе панели индикации выстрела:
2931 if SelectFlag
= SELECTFLAG_SHOTPANEL
then
2933 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 192, 192, 192, 127);
2934 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 255, 255, 255);
2935 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_SHOT
], gEditorFont
);
2938 // Подсказка при выборе панели лифта:
2939 if SelectFlag
= SELECTFLAG_LIFT
then
2941 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2942 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2943 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_PANEL_LIFT
], gEditorFont
);
2946 // Подсказка при выборе монстра:
2947 if SelectFlag
= SELECTFLAG_MONSTER
then
2949 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 192, 192, 192, 127);
2950 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 255, 255, 255);
2951 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_MONSTER
], gEditorFont
);
2954 // Подсказка при выборе области воздействия:
2955 if DrawPressRect
then
2957 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 192, 192, 192, 127);
2958 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 255, 255, 255);
2959 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, _glc
[I_HINT_EXT_AREA
], gEditorFont
);
2962 // Рисуем текстуры, если чертим панель:
2963 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and (DrawTexturePanel
) and
2964 (lbTextureList
.ItemIndex
<> -1) and (DrawRect
<> nil) and
2965 (lbPanelType
.ItemIndex
in [0..8]) and not IsSpecialTextureSel() then
2967 if not g_GetTexture(SelectedTexture(), ID
) then
2968 g_GetTexture('NOTEXTURE', ID
);
2969 g_GetTextureSizeByID(ID
, Width
, Height
);
2971 if (Abs(Right
-Left
) >= Width
) and (Abs(Bottom
-Top
) >= Height
) then
2972 e_DrawFill(ID
, Min(Left
, Right
), Min(Top
, Bottom
), Abs(Right
-Left
) div Width
,
2973 Abs(Bottom
-Top
) div Height
, 64, True, False);
2976 // Прямоугольник выделения:
2977 if DrawRect
<> nil then
2979 e_DrawQuad(Left
, Top
, Right
-1, Bottom
-1, 255, 255, 255);
2981 // Чертим мышью панель/триггер или меняем мышью их размер:
2982 if (((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
2983 not(ssCtrl
in GetKeyShiftState())) or (MouseAction
= MOUSEACTION_RESIZE
)) and
2984 (DrawPanelSize
) then
2986 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 192, 192, 192, 127);
2987 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 255, 255, 255);
2989 if MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
] then
2990 begin // Чертим новый
2991 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(_glc
[I_HINT_WIDTH
],
2992 [Abs(MousePos
.X
-MouseLDownPos
.X
)]), gEditorFont
);
2993 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(_glc
[I_HINT_HEIGHT
],
2994 [Abs(MousePos
.Y
-MouseLDownPos
.Y
)]), gEditorFont
);
2996 else // Растягиваем существующий
2997 if SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
2999 if SelectedObjects
[GetFirstSelected
].ObjectType
= OBJECT_PANEL
then
3001 Width
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3002 Height
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3006 Width
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3007 Height
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3010 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(_glc
[I_HINT_WIDTH
], [Width
]),
3012 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(_glc
[I_HINT_HEIGHT
], [Height
]),
3017 // Ближайшая к курсору мыши точка на сетке:
3018 e_DrawPoint(3, MousePos
.X
, MousePos
.Y
, 0, 0, 255);
3023 // Сколько пикселов карты в 1 пикселе мини-карты:
3024 ScaleSz
:= 16 div Scale
;
3025 // Размеры мини-карты:
3026 aX
:= max(gMapInfo
.Width
div ScaleSz
, 1);
3027 aY
:= max(gMapInfo
.Height
div ScaleSz
, 1);
3028 // X-координата на RenderPanel нулевой x-координаты карты:
3029 XX
:= RenderPanel
.Width
- aX
- 1;
3031 e_DrawFillQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 0, 0, 0, 0);
3032 e_DrawQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 197, 197, 197);
3034 if gPanels
<> nil then
3037 for a
:= 0 to High(gPanels
) do
3039 if PanelType
<> 0 then
3041 // Левый верхний угол:
3042 aX
:= XX
+ (X
div ScaleSz
);
3043 aY
:= 1 + (Y
div ScaleSz
);
3045 aX2
:= max(Width
div ScaleSz
, 1);
3046 aY2
:= max(Height
div ScaleSz
, 1);
3047 // Правый нижний угол:
3048 aX2
:= aX
+ aX2
- 1;
3049 aY2
:= aY
+ aY2
- 1;
3052 PANEL_WALL
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 208, 208, 208, 0);
3053 PANEL_WATER
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 0, 192, 0);
3054 PANEL_ACID1
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 176, 0, 0);
3055 PANEL_ACID2
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 176, 0, 0, 0);
3056 PANEL_STEP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 128, 128, 128, 0);
3057 PANEL_LIFTUP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 72, 36, 0);
3058 PANEL_LIFTDOWN
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 124, 96, 0);
3059 PANEL_LIFTLEFT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 200, 80, 4, 0);
3060 PANEL_LIFTRIGHT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 252, 140, 56, 0);
3061 PANEL_OPENDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 100, 220, 92, 0);
3062 PANEL_CLOSEDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 212, 184, 64, 0);
3063 PANEL_BLOCKMON
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 192, 0, 192, 0);
3067 // Рисуем красным выделенные панели:
3068 if SelectedObjects
<> nil then
3069 for b
:= 0 to High(SelectedObjects
) do
3070 with SelectedObjects
[b
] do
3071 if Live
and (ObjectType
= OBJECT_PANEL
) then
3072 with gPanels
[SelectedObjects
[b
].ID
] do
3073 if PanelType
and not(PANEL_BACK
or PANEL_FORE
) <> 0 then
3075 // Левый верхний угол:
3076 aX
:= XX
+ (X
div ScaleSz
);
3077 aY
:= 1 + (Y
div ScaleSz
);
3079 aX2
:= max(Width
div ScaleSz
, 1);
3080 aY2
:= max(Height
div ScaleSz
, 1);
3081 // Правый нижний угол:
3082 aX2
:= aX
+ aX2
- 1;
3083 aY2
:= aY
+ aY2
- 1;
3085 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0, 0)
3089 if (gMapInfo
.Width
> RenderPanel
.Width
) or
3090 (gMapInfo
.Height
> RenderPanel
.Height
) then
3092 // Окно, показывающее текущее положение экрана на карте:
3094 x
:= max(min(RenderPanel
.Width
, gMapInfo
.Width
) div ScaleSz
, 1);
3095 y
:= max(min(RenderPanel
.Height
, gMapInfo
.Height
) div ScaleSz
, 1);
3096 // Левый верхний угол:
3097 aX
:= XX
+ ((-MapOffset
.X
) div ScaleSz
);
3098 aY
:= 1 + ((-MapOffset
.Y
) div ScaleSz
);
3099 // Правый нижний угол:
3103 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 127, 192, 127, 127, B_BLEND
);
3104 e_DrawQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0);
3109 RenderPanel
.SwapBuffers();
3112 procedure TMainForm
.FormResize(Sender
: TObject
);
3114 e_SetViewPort(0, 0, RenderPanel
.Width
, RenderPanel
.Height
);
3116 sbHorizontal
.Min
:= Min(gMapInfo
.Width
- RenderPanel
.Width
, -RenderPanel
.Width
div 2);
3117 sbHorizontal
.Max
:= Max(0, gMapInfo
.Width
- RenderPanel
.Width
div 2);
3118 sbVertical
.Min
:= Min(gMapInfo
.Height
- RenderPanel
.Height
, -RenderPanel
.Height
div 2);
3119 sbVertical
.Max
:= Max(0, gMapInfo
.Height
- RenderPanel
.Height
div 2);
3121 MapOffset
.X
:= -sbHorizontal
.Position
;
3122 MapOffset
.Y
:= -sbVertical
.Position
;
3125 procedure SelectNextObject(X
, Y
: Integer; ObjectType
: Byte; ID
: DWORD
);
3130 j_max
:= 0; // shut up compiler
3134 res
:= (gPanels
<> nil) and
3135 PanelInShownLayer(gPanels
[ID
].PanelType
) and
3136 g_CollidePoint(X
, Y
, gPanels
[ID
].X
, gPanels
[ID
].Y
,
3138 gPanels
[ID
].Height
);
3139 j_max
:= Length(gPanels
) - 1;
3144 res
:= (gItems
<> nil) and
3145 LayerEnabled
[LAYER_ITEMS
] and
3146 g_CollidePoint(X
, Y
, gItems
[ID
].X
, gItems
[ID
].Y
,
3147 ItemSize
[gItems
[ID
].ItemType
][0],
3148 ItemSize
[gItems
[ID
].ItemType
][1]);
3149 j_max
:= Length(gItems
) - 1;
3154 res
:= (gMonsters
<> nil) and
3155 LayerEnabled
[LAYER_MONSTERS
] and
3156 g_CollidePoint(X
, Y
, gMonsters
[ID
].X
, gMonsters
[ID
].Y
,
3157 MonsterSize
[gMonsters
[ID
].MonsterType
].Width
,
3158 MonsterSize
[gMonsters
[ID
].MonsterType
].Height
);
3159 j_max
:= Length(gMonsters
) - 1;
3164 res
:= (gAreas
<> nil) and
3165 LayerEnabled
[LAYER_AREAS
] and
3166 g_CollidePoint(X
, Y
, gAreas
[ID
].X
, gAreas
[ID
].Y
,
3167 AreaSize
[gAreas
[ID
].AreaType
].Width
,
3168 AreaSize
[gAreas
[ID
].AreaType
].Height
);
3169 j_max
:= Length(gAreas
) - 1;
3174 res
:= (gTriggers
<> nil) and
3175 LayerEnabled
[LAYER_TRIGGERS
] and
3176 g_CollidePoint(X
, Y
, gTriggers
[ID
].X
, gTriggers
[ID
].Y
,
3177 gTriggers
[ID
].Width
,
3178 gTriggers
[ID
].Height
);
3179 j_max
:= Length(gTriggers
) - 1;
3189 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3198 if j
= Integer(ID
) then
3203 res
:= PanelInShownLayer(gPanels
[j
].PanelType
) and
3204 g_CollidePoint(X
, Y
, gPanels
[j
].X
, gPanels
[j
].Y
,
3208 res
:= (gItems
[j
].ItemType
<> ITEM_NONE
) and
3209 g_CollidePoint(X
, Y
, gItems
[j
].X
, gItems
[j
].Y
,
3210 ItemSize
[gItems
[j
].ItemType
][0],
3211 ItemSize
[gItems
[j
].ItemType
][1]);
3213 res
:= (gMonsters
[j
].MonsterType
<> MONSTER_NONE
) and
3214 g_CollidePoint(X
, Y
, gMonsters
[j
].X
, gMonsters
[j
].Y
,
3215 MonsterSize
[gMonsters
[j
].MonsterType
].Width
,
3216 MonsterSize
[gMonsters
[j
].MonsterType
].Height
);
3218 res
:= (gAreas
[j
].AreaType
<> AREA_NONE
) and
3219 g_CollidePoint(X
, Y
, gAreas
[j
].X
, gAreas
[j
].Y
,
3220 AreaSize
[gAreas
[j
].AreaType
].Width
,
3221 AreaSize
[gAreas
[j
].AreaType
].Height
);
3223 res
:= (gTriggers
[j
].TriggerType
<> TRIGGER_NONE
) and
3224 g_CollidePoint(X
, Y
, gTriggers
[j
].X
, gTriggers
[j
].Y
,
3226 gTriggers
[j
].Height
);
3233 SetLength(SelectedObjects
, 1);
3235 SelectedObjects
[0].ObjectType
:= ObjectType
;
3236 SelectedObjects
[0].ID
:= j
;
3237 SelectedObjects
[0].Live
:= True;
3245 procedure TMainForm
.RenderPanelMouseDown(Sender
: TObject
;
3246 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3250 c1
, c2
, c3
, c4
: Boolean;
3256 MainForm
.ActiveControl
:= RenderPanel
;
3257 RenderPanel
.SetFocus();
3259 RenderPanelMouseMove(RenderPanel
, Shift
, X
, Y
);
3261 if Button
= mbLeft
then // Left Mouse Button
3263 // Двигаем карту с помощью мыши и мини-карты:
3265 g_CollidePoint(X
, Y
,
3266 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3268 max(gMapInfo
.Width
div (16 div Scale
), 1),
3269 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3272 MouseAction
:= MOUSEACTION_MOVEMAP
;
3274 else // Ставим предмет/монстра/область:
3275 if (pcObjects
.ActivePageIndex
in [1, 2, 3]) and
3276 (not (ssShift
in Shift
)) then
3278 case pcObjects
.ActivePageIndex
of
3280 if lbItemList
.ItemIndex
= -1 then
3281 ErrorMessageBox(_lc
[I_MSG_CHOOSE_ITEM
])
3284 item
.ItemType
:= lbItemList
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
3285 if item
.ItemType
>= ITEM_WEAPON_KASTET
then
3286 item
.ItemType
:= item
.ItemType
+ 2;
3287 item
.X
:= MousePos
.X
-MapOffset
.X
;
3288 item
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3290 if not (ssCtrl
in Shift
) then
3292 item
.X
:= item
.X
- (ItemSize
[item
.ItemType
][0] div 2);
3293 item
.Y
:= item
.Y
- ItemSize
[item
.ItemType
][1];
3296 item
.OnlyDM
:= cbOnlyDM
.Checked
;
3297 item
.Fall
:= cbFall
.Checked
;
3298 Undo_Add(OBJECT_ITEM
, AddItem(item
));
3301 if lbMonsterList
.ItemIndex
= -1 then
3302 ErrorMessageBox(_lc
[I_MSG_CHOOSE_MONSTER
])
3305 monster
.MonsterType
:= lbMonsterList
.ItemIndex
+ MONSTER_DEMON
;
3306 monster
.X
:= MousePos
.X
-MapOffset
.X
;
3307 monster
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3309 if not (ssCtrl
in Shift
) then
3311 monster
.X
:= monster
.X
- (MonsterSize
[monster
.MonsterType
].Width
div 2);
3312 monster
.Y
:= monster
.Y
- MonsterSize
[monster
.MonsterType
].Height
;
3315 if rbMonsterLeft
.Checked
then
3316 monster
.Direction
:= D_LEFT
3318 monster
.Direction
:= D_RIGHT
;
3319 Undo_Add(OBJECT_MONSTER
, AddMonster(monster
));
3322 if lbAreasList
.ItemIndex
= -1 then
3323 ErrorMessageBox(_lc
[I_MSG_CHOOSE_AREA
])
3325 if (lbAreasList
.ItemIndex
+ 1) <> AREA_DOMFLAG
then
3327 area
.AreaType
:= lbAreasList
.ItemIndex
+ AREA_PLAYERPOINT1
;
3328 area
.X
:= MousePos
.X
-MapOffset
.X
;
3329 area
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3331 if not (ssCtrl
in Shift
) then
3333 area
.X
:= area
.X
- (AreaSize
[area
.AreaType
].Width
div 2);
3334 area
.Y
:= area
.Y
- AreaSize
[area
.AreaType
].Height
;
3337 if rbAreaLeft
.Checked
then
3338 area
.Direction
:= D_LEFT
3340 area
.Direction
:= D_RIGHT
;
3341 Undo_Add(OBJECT_AREA
, AddArea(area
));
3347 i
:= GetFirstSelected();
3349 // Выбираем объект под текущим:
3350 if (SelectedObjects
<> nil) and
3351 (ssShift
in Shift
) and (i
>= 0) and
3352 (SelectedObjects
[i
].Live
) then
3354 if SelectedObjectCount() = 1 then
3355 SelectNextObject(X
-MapOffset
.X
, Y
-MapOffset
.Y
,
3356 SelectedObjects
[i
].ObjectType
,
3357 SelectedObjects
[i
].ID
);
3361 // Рисуем область триггера "Расширитель":
3362 if DrawPressRect
and (i
>= 0) and
3363 (SelectedObjects
[i
].ObjectType
= OBJECT_TRIGGER
) and
3364 (gTriggers
[SelectedObjects
[i
].ID
].TriggerType
in
3365 [TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
]) then
3366 MouseAction
:= MOUSEACTION_DRAWPRESS
3367 else // Рисуем панель:
3368 if pcObjects
.ActivePageIndex
= 0 then
3370 if (lbPanelType
.ItemIndex
>= 0) then
3371 MouseAction
:= MOUSEACTION_DRAWPANEL
3373 else // Рисуем триггер:
3374 if (lbTriggersList
.ItemIndex
>= 0) then
3376 MouseAction
:= MOUSEACTION_DRAWTRIGGER
;
3380 end; // if Button = mbLeft
3382 if Button
= mbRight
then // Right Mouse Button
3384 // Клик по мини-карте:
3386 g_CollidePoint(X
, Y
,
3387 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3389 max(gMapInfo
.Width
div (16 div Scale
), 1),
3390 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3392 MouseAction
:= MOUSEACTION_NOACTION
;
3394 else // Нужно что-то выбрать мышью:
3395 if SelectFlag
<> SELECTFLAG_NONE
then
3398 SELECTFLAG_TELEPORT
:
3399 // Точку назначения телепортации:
3400 with gTriggers
[SelectedObjects
[
3401 GetFirstSelected() ].ID
].Data
.TargetPoint
do
3403 X
:= MousePos
.X
-MapOffset
.X
;
3404 Y
:= MousePos
.Y
-MapOffset
.Y
;
3407 SELECTFLAG_SPAWNPOINT
:
3408 // Точку создания монстра:
3409 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3410 if TriggerType
= TRIGGER_SPAWNMONSTER
then
3412 Data
.MonPos
.X
:= MousePos
.X
-MapOffset
.X
;
3413 Data
.MonPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3415 else if TriggerType
= TRIGGER_SPAWNITEM
then
3416 begin // Точка создания предмета:
3417 Data
.ItemPos
.X
:= MousePos
.X
-MapOffset
.X
;
3418 Data
.ItemPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3420 else if TriggerType
= TRIGGER_SHOT
then
3421 begin // Точка создания выстрела:
3422 Data
.ShotPos
.X
:= MousePos
.X
-MapOffset
.X
;
3423 Data
.ShotPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3429 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3431 2, 2, OBJECT_PANEL
, True);
3432 if IDArray
<> nil then
3434 for i
:= 0 to High(IDArray
) do
3435 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3436 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
) then
3438 gTriggers
[SelectedObjects
[
3439 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3444 gTriggers
[SelectedObjects
[
3445 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3449 // Панель с текстурой:
3451 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3453 2, 2, OBJECT_PANEL
, True);
3454 if IDArray
<> nil then
3456 for i
:= 0 to High(IDArray
) do
3457 if ((gPanels
[IDArray
[i
]].PanelType
in
3458 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3459 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3461 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3462 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3463 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3465 gTriggers
[SelectedObjects
[
3466 GetFirstSelected() ].ID
].TexturePanel
:= IDArray
[i
];
3471 gTriggers
[SelectedObjects
[
3472 GetFirstSelected() ].ID
].TexturePanel
:= -1;
3478 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3480 2, 2, OBJECT_PANEL
, True);
3481 if IDArray
<> nil then
3483 for i
:= 0 to High(IDArray
) do
3484 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTUP
) or
3485 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTDOWN
) or
3486 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTLEFT
) or
3487 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTRIGHT
) then
3489 gTriggers
[SelectedObjects
[
3490 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3495 gTriggers
[SelectedObjects
[
3496 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3502 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3504 2, 2, OBJECT_MONSTER
, False);
3505 if IDArray
<> nil then
3506 gTriggers
[SelectedObjects
[
3507 GetFirstSelected() ].ID
].Data
.MonsterID
:= IDArray
[0]+1
3509 gTriggers
[SelectedObjects
[
3510 GetFirstSelected() ].ID
].Data
.MonsterID
:= 0;
3513 SELECTFLAG_SHOTPANEL
:
3514 // Панель индикации выстрела:
3516 if gTriggers
[SelectedObjects
[
3517 GetFirstSelected() ].ID
].TriggerType
= TRIGGER_SHOT
then
3519 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3521 2, 2, OBJECT_PANEL
, True);
3522 if IDArray
<> nil then
3524 for i
:= 0 to High(IDArray
) do
3525 if ((gPanels
[IDArray
[i
]].PanelType
in
3526 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3527 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3529 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3530 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3531 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3533 gTriggers
[SelectedObjects
[
3534 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= IDArray
[i
];
3539 gTriggers
[SelectedObjects
[
3540 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= -1;
3545 SelectFlag
:= SELECTFLAG_SELECTED
;
3547 else // if SelectFlag <> SELECTFLAG_NONE...
3549 // Что уже выбрано и не нажат Ctrl:
3550 if (SelectedObjects
<> nil) and
3551 (not (ssCtrl
in Shift
)) then
3552 for i
:= 0 to High(SelectedObjects
) do
3553 with SelectedObjects
[i
] do
3556 if (ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) and
3557 (SelectedObjectCount() = 1) then
3559 Rect
:= ObjectGetRect(ObjectType
, ID
);
3561 c1
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3562 Rect
.X
-2, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3563 c2
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3564 Rect
.X
+Rect
.Width
-3, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3565 c3
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3566 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
-2, 4, 4);
3567 c4
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3568 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
+Rect
.Height
-3, 4, 4);
3570 // Меняем размер панели или триггера:
3571 if c1
or c2
or c3
or c4
then
3573 MouseAction
:= MOUSEACTION_RESIZE
;
3574 LastMovePoint
:= MousePos
;
3578 ResizeType
:= RESIZETYPE_HORIZONTAL
;
3580 ResizeDirection
:= RESIZEDIR_LEFT
3582 ResizeDirection
:= RESIZEDIR_RIGHT
;
3583 RenderPanel
.Cursor
:= crSizeWE
;
3587 ResizeType
:= RESIZETYPE_VERTICAL
;
3589 ResizeDirection
:= RESIZEDIR_UP
3591 ResizeDirection
:= RESIZEDIR_DOWN
;
3592 RenderPanel
.Cursor
:= crSizeNS
;
3599 // Перемещаем панель или триггер:
3600 if ObjectCollide(ObjectType
, ID
,
3602 Y
-MapOffset
.Y
-1, 2, 2) then
3604 MouseAction
:= MOUSEACTION_MOVEOBJ
;
3605 LastMovePoint
:= MousePos
;
3611 end; // if Button = mbRight
3613 if Button
= mbMiddle
then // Middle Mouse Button
3615 SetCapture(RenderPanel
.Handle
);
3616 RenderPanel
.Cursor
:= crSize
;
3619 MouseMDown
:= Button
= mbMiddle
;
3621 MouseMDownPos
:= Mouse
.CursorPos
;
3623 MouseRDown
:= Button
= mbRight
;
3625 MouseRDownPos
:= MousePos
;
3627 MouseLDown
:= Button
= mbLeft
;
3629 MouseLDownPos
:= MousePos
;
3632 procedure TMainForm
.RenderPanelMouseUp(Sender
: TObject
;
3633 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3638 rSelectRect
: Boolean;
3639 wWidth
, wHeight
: Word;
3642 procedure SelectObjects(ObjectType
: Byte);
3647 IDArray
:= ObjectInRect(rRect
.X
, rRect
.Y
,
3648 rRect
.Width
, rRect
.Height
,
3649 ObjectType
, rSelectRect
);
3651 if IDArray
<> nil then
3652 for i
:= 0 to High(IDArray
) do
3653 SelectObject(ObjectType
, IDArray
[i
], (ssCtrl
in Shift
) or rSelectRect
);
3656 if Button
= mbLeft
then
3657 MouseLDown
:= False;
3658 if Button
= mbRight
then
3659 MouseRDown
:= False;
3660 if Button
= mbMiddle
then
3661 MouseMDown
:= False;
3664 ResizeType
:= RESIZETYPE_NONE
;
3667 if Button
= mbLeft
then // Left Mouse Button
3669 if MouseAction
<> MOUSEACTION_NONE
then
3670 begin // Было действие мышью
3671 // Мышь сдвинулась во время удержания клавиши,
3672 // либо активирован режим быстрого рисования:
3673 if ((MousePos
.X
<> MouseLDownPos
.X
) and
3674 (MousePos
.Y
<> MouseLDownPos
.Y
)) or
3675 ((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3676 (ssCtrl
in Shift
)) then
3679 MOUSEACTION_DRAWPANEL
:
3681 // Фон или передний план без текстуры - ошибка:
3682 if (lbPanelType
.ItemIndex
in [1, 2]) and
3683 (lbTextureList
.ItemIndex
= -1) then
3684 ErrorMessageBox(_lc
[I_MSG_CHOOSE_TEXTURE
])
3685 else // Назначаем параметры панели:
3687 case lbPanelType
.ItemIndex
of
3688 0: Panel
.PanelType
:= PANEL_WALL
;
3689 1: Panel
.PanelType
:= PANEL_BACK
;
3690 2: Panel
.PanelType
:= PANEL_FORE
;
3691 3: Panel
.PanelType
:= PANEL_OPENDOOR
;
3692 4: Panel
.PanelType
:= PANEL_CLOSEDOOR
;
3693 5: Panel
.PanelType
:= PANEL_STEP
;
3694 6: Panel
.PanelType
:= PANEL_WATER
;
3695 7: Panel
.PanelType
:= PANEL_ACID1
;
3696 8: Panel
.PanelType
:= PANEL_ACID2
;
3697 9: Panel
.PanelType
:= PANEL_LIFTUP
;
3698 10: Panel
.PanelType
:= PANEL_LIFTDOWN
;
3699 11: Panel
.PanelType
:= PANEL_LIFTLEFT
;
3700 12: Panel
.PanelType
:= PANEL_LIFTRIGHT
;
3701 13: Panel
.PanelType
:= PANEL_BLOCKMON
;
3704 Panel
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3705 Panel
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3706 if ssCtrl
in Shift
then
3710 if (lbTextureList
.ItemIndex
<> -1) and
3711 (not IsSpecialTextureSel()) then
3713 if not g_GetTexture(SelectedTexture(), TextureID
) then
3714 g_GetTexture('NOTEXTURE', TextureID
);
3715 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
3717 Panel
.Width
:= wWidth
;
3718 Panel
.Height
:= wHeight
;
3722 Panel
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3723 Panel
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3726 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3727 if (lbPanelType
.ItemIndex
in [9, 10, 11, 12, 13]) or
3728 (lbTextureList
.ItemIndex
= -1) then
3730 Panel
.TextureHeight
:= 1;
3731 Panel
.TextureWidth
:= 1;
3732 Panel
.TextureName
:= '';
3733 Panel
.TextureID
:= TEXTURE_SPECIAL_NONE
;
3735 else // Есть текстура:
3737 Panel
.TextureName
:= SelectedTexture();
3739 // Обычная текстура:
3740 if not IsSpecialTextureSel() then
3742 g_GetTextureSizeByName(Panel
.TextureName
,
3743 Panel
.TextureWidth
, Panel
.TextureHeight
);
3744 g_GetTexture(Panel
.TextureName
, Panel
.TextureID
);
3746 else // Спец.текстура:
3748 Panel
.TextureHeight
:= 1;
3749 Panel
.TextureWidth
:= 1;
3750 Panel
.TextureID
:= SpecialTextureID(SelectedTexture());
3755 Panel
.Blending
:= False;
3757 Undo_Add(OBJECT_PANEL
, AddPanel(Panel
));
3761 // Рисовали триггер:
3762 MOUSEACTION_DRAWTRIGGER
:
3764 trigger
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3765 trigger
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3766 if ssCtrl
in Shift
then
3770 trigger
.Width
:= wWidth
;
3771 trigger
.Height
:= wHeight
;
3775 trigger
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3776 trigger
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3779 trigger
.Enabled
:= True;
3780 trigger
.TriggerType
:= lbTriggersList
.ItemIndex
+1;
3781 trigger
.TexturePanel
:= -1;
3784 trigger
.ActivateType
:= 0;
3786 if clbActivationType
.Checked
[0] then
3787 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERCOLLIDE
;
3788 if clbActivationType
.Checked
[1] then
3789 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERCOLLIDE
;
3790 if clbActivationType
.Checked
[2] then
3791 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERPRESS
;
3792 if clbActivationType
.Checked
[3] then
3793 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERPRESS
;
3794 if clbActivationType
.Checked
[4] then
3795 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_SHOT
;
3796 if clbActivationType
.Checked
[5] then
3797 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_NOMONSTER
;
3799 // Необходимые для активации ключи:
3802 if clbKeys
.Checked
[0] then
3803 trigger
.Key
:= Trigger
.Key
or KEY_RED
;
3804 if clbKeys
.Checked
[1] then
3805 trigger
.Key
:= Trigger
.Key
or KEY_GREEN
;
3806 if clbKeys
.Checked
[2] then
3807 trigger
.Key
:= Trigger
.Key
or KEY_BLUE
;
3808 if clbKeys
.Checked
[3] then
3809 trigger
.Key
:= Trigger
.Key
or KEY_REDTEAM
;
3810 if clbKeys
.Checked
[4] then
3811 trigger
.Key
:= Trigger
.Key
or KEY_BLUETEAM
;
3813 // Параметры триггера:
3814 FillByte(trigger
.Data
.Default
[0], 128, 0);
3816 case trigger
.TriggerType
of
3817 // Переключаемая панель:
3818 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
3819 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
3820 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
3822 Trigger
.Data
.PanelID
:= -1;
3828 trigger
.Data
.TargetPoint
.X
:= trigger
.X
-64;
3829 trigger
.Data
.TargetPoint
.Y
:= trigger
.Y
-64;
3830 trigger
.Data
.d2d_teleport
:= True;
3831 trigger
.Data
.TlpDir
:= 0;
3834 // Изменение других триггеров:
3835 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
3838 trigger
.Data
.Count
:= 1;
3844 trigger
.Data
.Volume
:= 255;
3845 trigger
.Data
.Pan
:= 127;
3846 trigger
.Data
.PlayCount
:= 1;
3847 trigger
.Data
.Local
:= True;
3848 trigger
.Data
.SoundSwitch
:= False;
3854 trigger
.Data
.MusicAction
:= 1;
3857 // Создание монстра:
3858 TRIGGER_SPAWNMONSTER
:
3860 trigger
.Data
.MonType
:= MONSTER_ZOMBY
;
3861 trigger
.Data
.MonPos
.X
:= trigger
.X
-64;
3862 trigger
.Data
.MonPos
.Y
:= trigger
.Y
-64;
3863 trigger
.Data
.MonHealth
:= 0;
3864 trigger
.Data
.MonActive
:= False;
3865 trigger
.Data
.MonCount
:= 1;
3868 // Создание предмета:
3871 trigger
.Data
.ItemType
:= ITEM_AMMO_BULLETS
;
3872 trigger
.Data
.ItemPos
.X
:= trigger
.X
-64;
3873 trigger
.Data
.ItemPos
.Y
:= trigger
.Y
-64;
3874 trigger
.Data
.ItemOnlyDM
:= False;
3875 trigger
.Data
.ItemFalls
:= False;
3876 trigger
.Data
.ItemCount
:= 1;
3877 trigger
.Data
.ItemMax
:= 0;
3878 trigger
.Data
.ItemDelay
:= 0;
3884 trigger
.Data
.PushAngle
:= 90;
3885 trigger
.Data
.PushForce
:= 10;
3886 trigger
.Data
.ResetVel
:= True;
3891 trigger
.Data
.ScoreCount
:= 1;
3892 trigger
.Data
.ScoreCon
:= True;
3893 trigger
.Data
.ScoreMsg
:= True;
3898 trigger
.Data
.MessageKind
:= 0;
3899 trigger
.Data
.MessageSendTo
:= 0;
3900 trigger
.Data
.MessageText
:= '';
3901 trigger
.Data
.MessageTime
:= 144;
3906 trigger
.Data
.DamageValue
:= 5;
3907 trigger
.Data
.DamageInterval
:= 12;
3912 trigger
.Data
.HealValue
:= 5;
3913 trigger
.Data
.HealInterval
:= 36;
3918 trigger
.Data
.ShotType
:= TRIGGER_SHOT_BULLET
;
3919 trigger
.Data
.ShotSound
:= True;
3920 trigger
.Data
.ShotPanelID
:= -1;
3921 trigger
.Data
.ShotTarget
:= 0;
3922 trigger
.Data
.ShotIntSight
:= 0;
3923 trigger
.Data
.ShotAim
:= TRIGGER_SHOT_AIM_DEFAULT
;
3924 trigger
.Data
.ShotPos
.X
:= trigger
.X
-64;
3925 trigger
.Data
.ShotPos
.Y
:= trigger
.Y
-64;
3926 trigger
.Data
.ShotAngle
:= 0;
3927 trigger
.Data
.ShotWait
:= 18;
3928 trigger
.Data
.ShotAccuracy
:= 0;
3929 trigger
.Data
.ShotAmmo
:= 0;
3930 trigger
.Data
.ShotIntReload
:= 0;
3935 trigger
.Data
.FXCount
:= 1;
3936 trigger
.Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
3937 trigger
.Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
3938 trigger
.Data
.FXColorR
:= 0;
3939 trigger
.Data
.FXColorG
:= 0;
3940 trigger
.Data
.FXColorB
:= 255;
3941 trigger
.Data
.FXPos
:= TRIGGER_EFFECT_POS_CENTER
;
3942 trigger
.Data
.FXWait
:= 1;
3943 trigger
.Data
.FXVelX
:= 0;
3944 trigger
.Data
.FXVelY
:= -20;
3945 trigger
.Data
.FXSpreadL
:= 5;
3946 trigger
.Data
.FXSpreadR
:= 5;
3947 trigger
.Data
.FXSpreadU
:= 4;
3948 trigger
.Data
.FXSpreadD
:= 0;
3952 Undo_Add(OBJECT_TRIGGER
, AddTrigger(trigger
));
3955 // Рисовали область триггера "Расширитель":
3956 MOUSEACTION_DRAWPRESS
:
3957 with gTriggers
[SelectedObjects
[GetFirstSelected
].ID
] do
3959 Data
.tX
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3960 Data
.tY
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3961 Data
.tWidth
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3962 Data
.tHeight
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3964 DrawPressRect
:= False;
3968 MouseAction
:= MOUSEACTION_NONE
;
3970 end // if Button = mbLeft...
3971 else if Button
= mbRight
then // Right Mouse Button:
3973 if MouseAction
= MOUSEACTION_NOACTION
then
3975 MouseAction
:= MOUSEACTION_NONE
;
3979 // Объект передвинут или изменен в размере:
3980 if MouseAction
in [MOUSEACTION_MOVEOBJ
, MOUSEACTION_RESIZE
] then
3982 RenderPanel
.Cursor
:= crDefault
;
3983 MouseAction
:= MOUSEACTION_NONE
;
3988 // Еще не все выбрали:
3989 if SelectFlag
<> SELECTFLAG_NONE
then
3991 if SelectFlag
= SELECTFLAG_SELECTED
then
3992 SelectFlag
:= SELECTFLAG_NONE
;
3997 // Мышь сдвинулась во время удержания клавиши:
3998 if (MousePos
.X
<> MouseRDownPos
.X
) and
3999 (MousePos
.Y
<> MouseRDownPos
.Y
) then
4001 rSelectRect
:= True;
4003 rRect
.X
:= Min(MousePos
.X
, MouseRDownPos
.X
)-MapOffset
.X
;
4004 rRect
.Y
:= Min(MousePos
.Y
, MouseRDownPos
.Y
)-MapOffset
.Y
;
4005 rRect
.Width
:= Abs(MousePos
.X
-MouseRDownPos
.X
);
4006 rRect
.Height
:= Abs(MousePos
.Y
-MouseRDownPos
.Y
);
4008 else // Мышь не сдвинулась - нет прямоугольника:
4010 rSelectRect
:= False;
4012 rRect
.X
:= X
-MapOffset
.X
-1;
4013 rRect
.Y
:= Y
-MapOffset
.Y
-1;
4018 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4019 if not (ssCtrl
in Shift
) then
4020 RemoveSelectFromObjects();
4022 // Выделяем всё в выбранном прямоугольнике:
4023 if (ssCtrl
in Shift
) and (ssAlt
in Shift
) then
4025 SelectObjects(OBJECT_PANEL
);
4026 SelectObjects(OBJECT_ITEM
);
4027 SelectObjects(OBJECT_MONSTER
);
4028 SelectObjects(OBJECT_AREA
);
4029 SelectObjects(OBJECT_TRIGGER
);
4032 SelectObjects(pcObjects
.ActivePageIndex
+1);
4037 else // Middle Mouse Button
4039 RenderPanel
.Cursor
:= crDefault
;
4044 procedure TMainForm
.RenderPanelPaint(Sender
: TObject
);
4049 function TMainForm
.RenderMousePos(): Types
.TPoint
;
4051 Result
:= RenderPanel
.ScreenToClient(Mouse
.CursorPos
);
4054 procedure TMainForm
.RecountSelectedObjects();
4056 if SelectedObjectCount() = 0 then
4057 StatusBar
.Panels
[0].Text := ''
4059 StatusBar
.Panels
[0].Text := Format(_lc
[I_CAP_STAT_SELECTED
], [SelectedObjectCount()]);
4062 procedure TMainForm
.RenderPanelMouseMove(Sender
: TObject
;
4063 Shift
: TShiftState
; X
, Y
: Integer);
4066 dWidth
, dHeight
: Integer;
4069 wWidth
, wHeight
: Word;
4071 _id
:= GetFirstSelected();
4074 // Рисуем панель с текстурой, сетка - размеры текстуры:
4075 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and
4076 (lbPanelType
.ItemIndex
in [0..8]) and
4077 (lbTextureList
.ItemIndex
<> -1) and
4078 (not IsSpecialTextureSel()) then
4080 sX
:= StrToIntDef(lTextureWidth
.Caption
, DotStep
);
4081 sY
:= StrToIntDef(lTextureHeight
.Caption
, DotStep
);
4084 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4085 if (MouseAction
= MOUSEACTION_RESIZE
) and
4086 ( (SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
) and
4087 IsTexturedPanel(gPanels
[SelectedObjects
[_id
].ID
].PanelType
) and
4088 (gPanels
[SelectedObjects
[_id
].ID
].TextureName
<> '') and
4089 (not IsSpecialTexture(gPanels
[SelectedObjects
[_id
].ID
].TextureName
)) ) then
4091 sX
:= gPanels
[SelectedObjects
[_id
].ID
].TextureWidth
;
4092 sY
:= gPanels
[SelectedObjects
[_id
].ID
].TextureHeight
;
4095 // Выравнивание по сетке:
4101 else // Нет выравнивания по сетке:
4107 // Новая позиция мыши:
4109 begin // Зажата левая кнопка мыши
4110 MousePos
.X
:= (Round((X
-MouseLDownPos
.X
)/sX
)*sX
)+MouseLDownPos
.X
;
4111 MousePos
.Y
:= (Round((Y
-MouseLDownPos
.Y
)/sY
)*sY
)+MouseLDownPos
.Y
;
4115 begin // Зажата правая кнопка мыши
4116 MousePos
.X
:= (Round((X
-MouseRDownPos
.X
)/sX
)*sX
)+MouseRDownPos
.X
;
4117 MousePos
.Y
:= (Round((Y
-MouseRDownPos
.Y
)/sY
)*sY
)+MouseRDownPos
.Y
;
4120 begin // Кнопки мыши не зажаты
4121 MousePos
.X
:= Round((-MapOffset
.X
+ X
) / sX
) * sX
+ MapOffset
.X
;
4122 MousePos
.Y
:= Round((-MapOffset
.Y
+ Y
) / sY
) * sY
+ MapOffset
.Y
;
4125 // Зажата только правая кнопка мыши:
4126 if (not MouseLDown
) and (MouseRDown
) and (not MouseMDown
) then
4128 // Рисуем прямоугольник выделения:
4129 if MouseAction
= MOUSEACTION_NONE
then
4131 if DrawRect
= nil then
4133 DrawRect
.Top
:= MouseRDownPos
.y
;
4134 DrawRect
.Left
:= MouseRDownPos
.x
;
4135 DrawRect
.Bottom
:= MousePos
.y
;
4136 DrawRect
.Right
:= MousePos
.x
;
4139 // Двигаем выделенные объекты:
4140 if MouseAction
= MOUSEACTION_MOVEOBJ
then
4142 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
,
4143 MousePos
.X
-LastMovePoint
.X
,
4144 MousePos
.Y
-LastMovePoint
.Y
);
4147 // Меняем размер выделенного объекта:
4148 if MouseAction
= MOUSEACTION_RESIZE
then
4150 if (SelectedObjectCount
= 1) and
4151 (SelectedObjects
[GetFirstSelected
].Live
) then
4153 dWidth
:= MousePos
.X
-LastMovePoint
.X
;
4154 dHeight
:= MousePos
.Y
-LastMovePoint
.Y
;
4157 RESIZETYPE_VERTICAL
: dWidth
:= 0;
4158 RESIZETYPE_HORIZONTAL
: dHeight
:= 0;
4161 case ResizeDirection
of
4162 RESIZEDIR_UP
: dHeight
:= -dHeight
;
4163 RESIZEDIR_LEFT
: dWidth
:= -dWidth
;
4166 if ResizeObject(SelectedObjects
[GetFirstSelected
].ObjectType
,
4167 SelectedObjects
[GetFirstSelected
].ID
,
4168 dWidth
, dHeight
, ResizeDirection
) then
4169 LastMovePoint
:= MousePos
;
4174 // Зажата только левая кнопка мыши:
4175 if (not MouseRDown
) and (MouseLDown
) and (not MouseMDown
) then
4177 // Рисуем прямоугольник планирования панели:
4178 if MouseAction
in [MOUSEACTION_DRAWPANEL
,
4179 MOUSEACTION_DRAWTRIGGER
,
4180 MOUSEACTION_DRAWPRESS
] then
4182 if DrawRect
= nil then
4184 if ssCtrl
in Shift
then
4188 if (lbTextureList
.ItemIndex
<> -1) and (not IsSpecialTextureSel()) and
4189 (MouseAction
= MOUSEACTION_DRAWPANEL
) then
4191 if not g_GetTexture(SelectedTexture(), TextureID
) then
4192 g_GetTexture('NOTEXTURE', TextureID
);
4193 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
4195 DrawRect
.Top
:= MouseLDownPos
.y
;
4196 DrawRect
.Left
:= MouseLDownPos
.x
;
4197 DrawRect
.Bottom
:= DrawRect
.Top
+ wHeight
;
4198 DrawRect
.Right
:= DrawRect
.Left
+ wWidth
;
4202 DrawRect
.Top
:= MouseLDownPos
.y
;
4203 DrawRect
.Left
:= MouseLDownPos
.x
;
4204 DrawRect
.Bottom
:= MousePos
.y
;
4205 DrawRect
.Right
:= MousePos
.x
;
4208 else // Двигаем карту:
4209 if MouseAction
= MOUSEACTION_MOVEMAP
then
4215 // Only Middle Mouse Button is pressed
4216 if (not MouseLDown
) and (not MouseRDown
) and (MouseMDown
) then
4218 MapOffset
.X
:= -EnsureRange(-MapOffset
.X
+ MouseMDownPos
.X
- Mouse
.CursorPos
.X
,
4219 sbHorizontal
.Min
, sbHorizontal
.Max
);
4220 sbHorizontal
.Position
:= -MapOffset
.X
;
4221 MapOffset
.Y
:= -EnsureRange(-MapOffset
.Y
+ MouseMDownPos
.Y
- Mouse
.CursorPos
.Y
,
4222 sbVertical
.Min
, sbVertical
.Max
);
4223 sbVertical
.Position
:= -MapOffset
.Y
;
4224 MouseMDownPos
:= Mouse
.CursorPos
;
4227 // Клавиши мыши не зажаты:
4228 if (not MouseRDown
) and (not MouseLDown
) then
4231 // Строка состояния - координаты мыши:
4232 StatusBar
.Panels
[1].Text := Format('(%d:%d)',
4233 [MousePos
.X
-MapOffset
.X
, MousePos
.Y
-MapOffset
.Y
]);
4236 procedure TMainForm
.FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
4238 CanClose
:= Application
.MessageBox(PChar(_lc
[I_MSG_EXIT_PROMT
]),
4239 PChar(_lc
[I_MSG_EXIT
]),
4240 MB_ICONQUESTION
or MB_YESNO
or
4241 MB_DEFBUTTON1
) = idYes
;
4244 procedure TMainForm
.aExitExecute(Sender
: TObject
);
4249 procedure TMainForm
.FormDestroy(Sender
: TObject
);
4254 config
:= TConfig
.CreateFile(CfgFileName
);
4256 if WindowState
<> wsMaximized
then
4258 config
.WriteInt('Editor', 'XPos', Left
);
4259 config
.WriteInt('Editor', 'YPos', Top
);
4260 config
.WriteInt('Editor', 'Width', Width
);
4261 config
.WriteInt('Editor', 'Height', Height
);
4265 config
.WriteInt('Editor', 'XPos', RestoredLeft
);
4266 config
.WriteInt('Editor', 'YPos', RestoredTop
);
4267 config
.WriteInt('Editor', 'Width', RestoredWidth
);
4268 config
.WriteInt('Editor', 'Height', RestoredHeight
);
4270 config
.WriteBool('Editor', 'Maximize', WindowState
= wsMaximized
);
4271 config
.WriteBool('Editor', 'Minimap', ShowMap
);
4272 config
.WriteInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
4273 config
.WriteInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
4274 config
.WriteBool('Editor', 'DotEnable', DotEnable
);
4275 config
.WriteInt('Editor', 'DotStep', DotStep
);
4276 config
.WriteStr('Editor', 'LastOpenDir', OpenDialog
.InitialDir
);
4277 config
.WriteStr('Editor', 'LastSaveDir', SaveDialog
.InitialDir
);
4278 config
.WriteBool('Editor', 'EdgeShow', drEdge
[3] < 255);
4279 config
.WriteInt('Editor', 'EdgeColor', gColorEdge
);
4280 config
.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge
);
4281 config
.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine
);
4282 config
.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea
);
4283 config
.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect
);
4284 config
.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect
);
4286 for i
:= 0 to RecentCount
-1 do
4287 if i
< RecentFiles
.Count
then
4288 config
.WriteStr('RecentFiles', IntToStr(i
+1), RecentFiles
[i
])
4290 config
.WriteStr('RecentFiles', IntToStr(i
+1), '');
4293 config
.SaveFile(CfgFileName
);
4296 slInvalidTextures
.Free
;
4299 procedure TMainForm
.FormDropFiles(Sender
: TObject
;
4300 const FileNames
: array of String);
4302 if Length(FileNames
) <> 1 then
4305 OpenMapFile(FileNames
[0]);
4308 procedure TMainForm
.RenderPanelResize(Sender
: TObject
);
4310 if MainForm
.Visible
then
4314 procedure TMainForm
.Splitter1Moved(Sender
: TObject
);
4319 procedure TMainForm
.MapTestCheck(Sender
: TObject
);
4321 if MapTestProcess
<> nil then
4323 if MapTestProcess
.Running
= false then
4325 if MapTestProcess
.ExitCode
<> 0 then
4326 Application
.MessageBox(PChar(_lc
[I_MSG_EXEC_ERROR
]), 'FIXME', MB_OK
or MB_ICONERROR
);
4327 SysUtils
.DeleteFile(MapTestFile
);
4329 FreeAndNil(MapTestProcess
);
4330 tbTestMap
.Enabled
:= True;
4335 procedure TMainForm
.aMapOptionsExecute(Sender
: TObject
);
4339 MapOptionsForm
.ShowModal();
4341 ResName
:= OpenedMap
;
4342 while (Pos(':\', ResName
) > 0) do
4343 Delete(ResName
, 1, Pos(':\', ResName
) + 1);
4345 UpdateCaption(gMapInfo
.Name
, ExtractFileName(OpenedWAD
), ResName
);
4348 procedure TMainForm
.aAboutExecute(Sender
: TObject
);
4350 AboutForm
.ShowModal();
4353 procedure TMainForm
.FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
4359 if (not EditingProperties
) then
4361 if ssCtrl
in Shift
then
4364 '1': ContourEnabled
[LAYER_BACK
] := not ContourEnabled
[LAYER_BACK
];
4365 '2': ContourEnabled
[LAYER_WALLS
] := not ContourEnabled
[LAYER_WALLS
];
4366 '3': ContourEnabled
[LAYER_FOREGROUND
] := not ContourEnabled
[LAYER_FOREGROUND
];
4367 '4': ContourEnabled
[LAYER_STEPS
] := not ContourEnabled
[LAYER_STEPS
];
4368 '5': ContourEnabled
[LAYER_WATER
] := not ContourEnabled
[LAYER_WATER
];
4369 '6': ContourEnabled
[LAYER_ITEMS
] := not ContourEnabled
[LAYER_ITEMS
];
4370 '7': ContourEnabled
[LAYER_MONSTERS
] := not ContourEnabled
[LAYER_MONSTERS
];
4371 '8': ContourEnabled
[LAYER_AREAS
] := not ContourEnabled
[LAYER_AREAS
];
4372 '9': ContourEnabled
[LAYER_TRIGGERS
] := not ContourEnabled
[LAYER_TRIGGERS
];
4376 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4377 if ContourEnabled
[i
] then
4379 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4380 ContourEnabled
[i
] := not ok
4387 '1': SwitchLayer(LAYER_BACK
);
4388 '2': SwitchLayer(LAYER_WALLS
);
4389 '3': SwitchLayer(LAYER_FOREGROUND
);
4390 '4': SwitchLayer(LAYER_STEPS
);
4391 '5': SwitchLayer(LAYER_WATER
);
4392 '6': SwitchLayer(LAYER_ITEMS
);
4393 '7': SwitchLayer(LAYER_MONSTERS
);
4394 '8': SwitchLayer(LAYER_AREAS
);
4395 '9': SwitchLayer(LAYER_TRIGGERS
);
4396 '0': tbShowClick(tbShow
);
4400 if Key
= Ord('V') then
4401 begin // Поворот монстров и областей:
4402 if (SelectedObjects
<> nil) then
4404 for i
:= 0 to High(SelectedObjects
) do
4405 if (SelectedObjects
[i
].Live
) then
4407 if (SelectedObjects
[i
].ObjectType
= OBJECT_MONSTER
) then
4409 g_ChangeDir(gMonsters
[SelectedObjects
[i
].ID
].Direction
);
4412 if (SelectedObjects
[i
].ObjectType
= OBJECT_AREA
) then
4414 g_ChangeDir(gAreas
[SelectedObjects
[i
].ID
].Direction
);
4420 if pcObjects
.ActivePage
= tsMonsters
then
4422 if rbMonsterLeft
.Checked
then
4423 rbMonsterRight
.Checked
:= True
4425 rbMonsterLeft
.Checked
:= True;
4427 if pcObjects
.ActivePage
= tsAreas
then
4429 if rbAreaLeft
.Checked
then
4430 rbAreaRight
.Checked
:= True
4432 rbAreaLeft
.Checked
:= True;
4437 if not (ssCtrl
in Shift
) then
4439 // Быстрое превью карты:
4440 if Key
= Ord('E') then
4442 if PreviewMode
= 0 then
4446 // Вертикальный скролл карты:
4449 if Key
= Ord('W') then
4452 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4453 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4454 MapOffset
.Y
:= -Position
;
4457 if (MouseLDown
or MouseRDown
) then
4459 if DrawRect
<> nil then
4461 Inc(MouseLDownPos
.y
, dy
);
4462 Inc(MouseRDownPos
.y
, dy
);
4464 Inc(LastMovePoint
.Y
, dy
);
4465 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4469 if Key
= Ord('S') then
4472 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4473 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4474 MapOffset
.Y
:= -Position
;
4477 if (MouseLDown
or MouseRDown
) then
4479 if DrawRect
<> nil then
4481 Inc(MouseLDownPos
.y
, dy
);
4482 Inc(MouseRDownPos
.y
, dy
);
4484 Inc(LastMovePoint
.Y
, dy
);
4485 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4490 // Горизонтальный скролл карты:
4491 with sbHorizontal
do
4493 if Key
= Ord('A') then
4496 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4497 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4498 MapOffset
.X
:= -Position
;
4501 if (MouseLDown
or MouseRDown
) then
4503 if DrawRect
<> nil then
4505 Inc(MouseLDownPos
.x
, dx
);
4506 Inc(MouseRDownPos
.x
, dx
);
4508 Inc(LastMovePoint
.X
, dx
);
4509 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4513 if Key
= Ord('D') then
4516 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4517 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4518 MapOffset
.X
:= -Position
;
4521 if (MouseLDown
or MouseRDown
) then
4523 if DrawRect
<> nil then
4525 Inc(MouseLDownPos
.x
, dx
);
4526 Inc(MouseRDownPos
.x
, dx
);
4528 Inc(LastMovePoint
.X
, dx
);
4529 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4534 else // ssCtrl in Shift
4536 if ssShift
in Shift
then
4538 // Вставка по абсолютному смещению:
4539 if Key
= Ord('V') then
4540 aPasteObjectExecute(Sender
);
4542 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4546 // Удалить выделенные объекты:
4547 if (Key
= VK_DELETE
) and (SelectedObjects
<> nil) and
4548 RenderPanel
.Focused() then
4549 DeleteSelectedObjects();
4552 if (Key
= VK_ESCAPE
) and (SelectedObjects
<> nil) then
4553 RemoveSelectFromObjects();
4555 // Передвинуть объекты:
4556 if MainForm
.ActiveControl
= RenderPanel
then
4561 if Key
= VK_NUMPAD4
then
4562 dx
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4563 if Key
= VK_NUMPAD6
then
4564 dx
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4565 if Key
= VK_NUMPAD8
then
4566 dy
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4567 if Key
= VK_NUMPAD5
then
4568 dy
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4570 if (dx
<> 0) or (dy
<> 0) then
4572 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
, dx
, dy
);
4577 if ssCtrl
in Shift
then
4579 // Выбор панели с текстурой для триггера
4580 if Key
= Ord('T') then
4582 DrawPressRect
:= False;
4583 if SelectFlag
= SELECTFLAG_TEXTURE
then
4585 SelectFlag
:= SELECTFLAG_NONE
;
4588 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TEXTURE_PANEL
], i
);
4590 SelectFlag
:= SELECTFLAG_TEXTURE
;
4593 if Key
= Ord('D') then
4595 SelectFlag
:= SELECTFLAG_NONE
;
4596 if DrawPressRect
then
4598 DrawPressRect
:= False;
4603 // Выбор области воздействия, в зависимости от типа триггера
4604 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_EX_AREA
], i
);
4607 DrawPressRect
:= True;
4610 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_DOOR_PANEL
], i
);
4612 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TRAP_PANEL
], i
);
4615 SelectFlag
:= SELECTFLAG_DOOR
;
4618 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_LIFT_PANEL
], i
);
4621 SelectFlag
:= SELECTFLAG_LIFT
;
4624 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_TELEPORT_TO
], i
);
4627 SelectFlag
:= SELECTFLAG_TELEPORT
;
4630 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_SPAWN_TO
], i
);
4633 SelectFlag
:= SELECTFLAG_SPAWNPOINT
;
4637 // Выбор основного параметра, в зависимости от типа триггера
4638 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_NEXT_MAP
], i
);
4641 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
4642 SelectMapForm
.Caption
:= _lc
[I_CAP_SELECT
];
4643 SelectMapForm
.GetMaps(FileName
);
4645 if SelectMapForm
.ShowModal() = mrOK
then
4647 vleObjectProperty
.Cells
[1, i
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
4648 bApplyProperty
.Click();
4652 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_SOUND_NAME
], i
);
4654 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_MUSIC_NAME
], i
);
4657 AddSoundForm
.OKFunction
:= nil;
4658 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
4659 AddSoundForm
.SetResource
:= vleObjectProperty
.Cells
[1, i
];
4661 if (AddSoundForm
.ShowModal() = mrOk
) then
4663 vleObjectProperty
.Cells
[1, i
] := AddSoundForm
.ResourceName
;
4664 bApplyProperty
.Click();
4668 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_PUSH_ANGLE
], i
);
4670 vleObjectProperty
.FindRow(_lc
[I_PROP_TR_MESSAGE_TEXT
], i
);
4673 vleObjectProperty
.Row
:= i
;
4674 vleObjectProperty
.SetFocus();
4681 procedure TMainForm
.aOptimizeExecute(Sender
: TObject
);
4683 RemoveSelectFromObjects();
4684 MapOptimizationForm
.ShowModal();
4687 procedure TMainForm
.aCheckMapExecute(Sender
: TObject
);
4689 MapCheckForm
.ShowModal();
4692 procedure TMainForm
.bbAddTextureClick(Sender
: TObject
);
4694 AddTextureForm
.lbResourcesList
.MultiSelect
:= True;
4695 AddTextureForm
.ShowModal();
4698 procedure TMainForm
.lbTextureListClick(Sender
: TObject
);
4701 TextureWidth
, TextureHeight
: Word;
4706 if (lbTextureList
.ItemIndex
<> -1) and
4707 (not IsSpecialTextureSel()) then
4709 if g_GetTexture(SelectedTexture(), TextureID
) then
4711 g_GetTextureSizeByID(TextureID
, TextureWidth
, TextureHeight
);
4713 lTextureWidth
.Caption
:= IntToStr(TextureWidth
);
4714 lTextureHeight
.Caption
:= IntToStr(TextureHeight
);
4717 lTextureWidth
.Caption
:= _lc
[I_NOT_ACCESSIBLE
];
4718 lTextureHeight
.Caption
:= _lc
[I_NOT_ACCESSIBLE
];
4723 lTextureWidth
.Caption
:= '';
4724 lTextureHeight
.Caption
:= '';
4728 procedure TMainForm
.lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
4729 ARect
: TRect
; State
: TOwnerDrawState
);
4731 with Control
as TListBox
do
4733 if LCLType
.odSelected
in State
then
4735 Canvas
.Brush
.Color
:= clHighlight
;
4736 Canvas
.Font
.Color
:= clHighlightText
;
4738 if (Items
<> nil) and (Index
>= 0) then
4739 if slInvalidTextures
.IndexOf(Items
[Index
]) > -1 then
4741 Canvas
.Brush
.Color
:= clRed
;
4742 Canvas
.Font
.Color
:= clWhite
;
4744 Canvas
.FillRect(ARect
);
4745 Canvas
.TextRect(ARect
, ARect
.Left
, ARect
.Top
, Items
[Index
]);
4749 procedure TMainForm
.miReopenMapClick(Sender
: TObject
);
4751 FileName
, Resource
: String;
4753 if OpenedMap
= '' then
4756 if Application
.MessageBox(PChar(_lc
[I_MSG_REOPEN_MAP_PROMT
]),
4757 PChar(_lc
[I_MENU_FILE_REOPEN
]), MB_ICONQUESTION
or MB_YESNO
) <> idYes
then
4760 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, @Resource
);
4761 OpenMap(FileName
, Resource
);
4764 procedure TMainForm
.vleObjectPropertyGetPickList(Sender
: TObject
;
4765 const KeyName
: String; Values
: TStrings
);
4767 if vleObjectProperty
.ItemProps
[KeyName
].EditStyle
= esPickList
then
4769 if KeyName
= _lc
[I_PROP_DIRECTION
] then
4771 Values
.Add(DirNames
[D_LEFT
]);
4772 Values
.Add(DirNames
[D_RIGHT
]);
4774 else if KeyName
= _lc
[I_PROP_TR_TELEPORT_DIR
] then
4776 Values
.Add(DirNamesAdv
[0]);
4777 Values
.Add(DirNamesAdv
[1]);
4778 Values
.Add(DirNamesAdv
[2]);
4779 Values
.Add(DirNamesAdv
[3]);
4781 else if KeyName
= _lc
[I_PROP_TR_MUSIC_ACT
] then
4783 Values
.Add(_lc
[I_PROP_TR_MUSIC_ON
]);
4784 Values
.Add(_lc
[I_PROP_TR_MUSIC_OFF
]);
4786 else if KeyName
= _lc
[I_PROP_TR_MONSTER_BEHAVIOUR
] then
4788 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_0
]);
4789 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_1
]);
4790 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_2
]);
4791 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_3
]);
4792 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_4
]);
4793 Values
.Add(_lc
[I_PROP_TR_MONSTER_BEHAVIOUR_5
]);
4795 else if KeyName
= _lc
[I_PROP_TR_SCORE_ACT
] then
4797 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_0
]);
4798 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_1
]);
4799 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_2
]);
4800 Values
.Add(_lc
[I_PROP_TR_SCORE_ACT_3
]);
4802 else if KeyName
= _lc
[I_PROP_TR_SCORE_TEAM
] then
4804 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_0
]);
4805 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_1
]);
4806 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_2
]);
4807 Values
.Add(_lc
[I_PROP_TR_SCORE_TEAM_3
]);
4809 else if KeyName
= _lc
[I_PROP_TR_MESSAGE_KIND
] then
4811 Values
.Add(_lc
[I_PROP_TR_MESSAGE_KIND_0
]);
4812 Values
.Add(_lc
[I_PROP_TR_MESSAGE_KIND_1
]);
4814 else if KeyName
= _lc
[I_PROP_TR_MESSAGE_TO
] then
4816 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_0
]);
4817 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_1
]);
4818 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_2
]);
4819 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_3
]);
4820 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_4
]);
4821 Values
.Add(_lc
[I_PROP_TR_MESSAGE_TO_5
]);
4823 else if KeyName
= _lc
[I_PROP_TR_SHOT_TO
] then
4825 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_0
]);
4826 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_1
]);
4827 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_2
]);
4828 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_3
]);
4829 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_4
]);
4830 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_5
]);
4831 Values
.Add(_lc
[I_PROP_TR_SHOT_TO_6
]);
4833 else if KeyName
= _lc
[I_PROP_TR_SHOT_AIM
] then
4835 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_0
]);
4836 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_1
]);
4837 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_2
]);
4838 Values
.Add(_lc
[I_PROP_TR_SHOT_AIM_3
]);
4840 else if KeyName
= _lc
[I_PROP_TR_DAMAGE_KIND
] then
4842 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_0
]);
4843 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_3
]);
4844 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_4
]);
4845 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_5
]);
4846 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_6
]);
4847 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_7
]);
4848 Values
.Add(_lc
[I_PROP_TR_DAMAGE_KIND_8
]);
4850 else if (KeyName
= _lc
[I_PROP_PANEL_BLEND
]) or
4851 (KeyName
= _lc
[I_PROP_DM_ONLY
]) or
4852 (KeyName
= _lc
[I_PROP_ITEM_FALLS
]) or
4853 (KeyName
= _lc
[I_PROP_TR_ENABLED
]) or
4854 (KeyName
= _lc
[I_PROP_TR_D2D
]) or
4855 (KeyName
= _lc
[I_PROP_TR_SILENT
]) or
4856 (KeyName
= _lc
[I_PROP_TR_TELEPORT_SILENT
]) or
4857 (KeyName
= _lc
[I_PROP_TR_EX_RANDOM
]) or
4858 (KeyName
= _lc
[I_PROP_TR_TEXTURE_ONCE
]) or
4859 (KeyName
= _lc
[I_PROP_TR_TEXTURE_ANIM_ONCE
]) or
4860 (KeyName
= _lc
[I_PROP_TR_SOUND_LOCAL
]) or
4861 (KeyName
= _lc
[I_PROP_TR_SOUND_SWITCH
]) or
4862 (KeyName
= _lc
[I_PROP_TR_MONSTER_ACTIVE
]) or
4863 (KeyName
= _lc
[I_PROP_TR_PUSH_RESET
]) or
4864 (KeyName
= _lc
[I_PROP_TR_SCORE_CON
]) or
4865 (KeyName
= _lc
[I_PROP_TR_SCORE_MSG
]) or
4866 (KeyName
= _lc
[I_PROP_TR_HEALTH_MAX
]) or
4867 (KeyName
= _lc
[I_PROP_TR_SHOT_SOUND
]) or
4868 (KeyName
= _lc
[I_PROP_TR_EFFECT_CENTER
]) then
4870 Values
.Add(BoolNames
[True]);
4871 Values
.Add(BoolNames
[False]);
4876 procedure TMainForm
.bApplyPropertyClick(Sender
: TObject
);
4878 _id
, a
, r
, c
: Integer;
4888 if SelectedObjectCount() <> 1 then
4890 if not SelectedObjects
[GetFirstSelected()].Live
then
4894 if not CheckProperty() then
4900 _id
:= GetFirstSelected();
4902 r
:= vleObjectProperty
.Row
;
4903 c
:= vleObjectProperty
.Col
;
4905 case SelectedObjects
[_id
].ObjectType
of
4908 with gPanels
[SelectedObjects
[_id
].ID
] do
4910 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
4911 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
4912 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]]));
4913 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]));
4915 PanelType
:= GetPanelType(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_TYPE
]]);
4917 // Сброс ссылки на триггеры смены текстуры:
4918 if not WordBool(PanelType
and (PANEL_WALL
or PANEL_FORE
or PANEL_BACK
)) then
4919 if gTriggers
<> nil then
4920 for a
:= 0 to High(gTriggers
) do
4922 if (gTriggers
[a
].TriggerType
<> 0) and
4923 (gTriggers
[a
].TexturePanel
= Integer(SelectedObjects
[_id
].ID
)) then
4924 gTriggers
[a
].TexturePanel
:= -1;
4925 if (gTriggers
[a
].TriggerType
= TRIGGER_SHOT
) and
4926 (gTriggers
[a
].Data
.ShotPanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4927 gTriggers
[a
].Data
.ShotPanelID
:= -1;
4930 // Сброс ссылки на триггеры лифта:
4931 if not WordBool(PanelType
and (PANEL_LIFTUP
or PANEL_LIFTDOWN
or PANEL_LIFTLEFT
or PANEL_LIFTRIGHT
)) then
4932 if gTriggers
<> nil then
4933 for a
:= 0 to High(gTriggers
) do
4934 if (gTriggers
[a
].TriggerType
in [TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
]) and
4935 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4936 gTriggers
[a
].Data
.PanelID
:= -1;
4938 // Сброс ссылки на триггеры двери:
4939 if not WordBool(PanelType
and (PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
4940 if gTriggers
<> nil then
4941 for a
:= 0 to High(gTriggers
) do
4942 if (gTriggers
[a
].TriggerType
in [TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
4943 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
]) and
4944 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
4945 gTriggers
[a
].Data
.PanelID
:= -1;
4947 if IsTexturedPanel(PanelType
) then
4948 begin // Может быть текстура
4949 if TextureName
<> '' then
4950 begin // Была текстура
4951 Alpha
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_ALPHA
]]));
4952 Blending
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_BLEND
]]);
4961 TextureName
:= vleObjectProperty
.Values
[_lc
[I_PROP_PANEL_TEX
]];
4963 if TextureName
<> '' then
4964 begin // Есть текстура
4965 // Обычная текстура:
4966 if not IsSpecialTexture(TextureName
) then
4968 g_GetTextureSizeByName(TextureName
,
4969 TextureWidth
, TextureHeight
);
4971 // Проверка кратности размеров панели:
4973 if TextureWidth
<> 0 then
4974 if gPanels
[SelectedObjects
[_id
].ID
].Width
mod TextureWidth
<> 0 then
4976 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXWIDTH
],
4980 if Res
and (TextureHeight
<> 0) then
4981 if gPanels
[SelectedObjects
[_id
].ID
].Height
mod TextureHeight
<> 0 then
4983 ErrorMessageBox(Format(_lc
[I_MSG_WRONG_TEXHEIGHT
],
4990 if not g_GetTexture(TextureName
, TextureID
) then
4991 // Не удалось загрузить текстуру, рисуем NOTEXTURE
4992 if g_GetTexture('NOTEXTURE', NoTextureID
) then
4994 TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
4995 g_GetTextureSizeByID(NoTextureID
, NW
, NH
);
4997 TextureHeight
:= NH
;
5000 TextureID
:= TEXTURE_SPECIAL_NONE
;
5010 TextureID
:= TEXTURE_SPECIAL_NONE
;
5013 else // Спец.текстура
5017 TextureID
:= SpecialTextureID(TextureName
);
5020 else // Нет текстуры
5024 TextureID
:= TEXTURE_SPECIAL_NONE
;
5027 else // Не может быть текстуры
5034 TextureID
:= TEXTURE_SPECIAL_NONE
;
5041 with gItems
[SelectedObjects
[_id
].ID
] do
5043 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
5044 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
5045 OnlyDM
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_DM_ONLY
]]);
5046 Fall
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_ITEM_FALLS
]]);
5052 with gMonsters
[SelectedObjects
[_id
].ID
] do
5054 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
5055 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
5056 Direction
:= NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]);
5062 with gAreas
[SelectedObjects
[_id
].ID
] do
5064 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
5065 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
5066 Direction
:= NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]);
5072 with gTriggers
[SelectedObjects
[_id
].ID
] do
5074 X
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_X
]]));
5075 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_Y
]]));
5076 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_WIDTH
]]));
5077 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[_lc
[I_PROP_HEIGHT
]]));
5078 Enabled
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ENABLED
]]);
5079 ActivateType
:= StrToActivate(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ACTIVATION
]]);
5080 Key
:= StrToKey(vleObjectProperty
.Values
[_lc
[I_PROP_TR_KEYS
]]);
5085 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_NEXT_MAP
]]);
5086 FillByte(Data
.MapName
[0], 16, 0);
5088 Move(s
[1], Data
.MapName
[0], Min(Length(s
), 16));
5093 Data
.ActivateOnce
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TEXTURE_ONCE
]]);
5094 Data
.AnimOnce
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TEXTURE_ANIM_ONCE
]]);
5097 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5099 Data
.Wait
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 65535);
5100 Data
.Count
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_COUNT
]], 0), 65535);
5101 if Data
.Count
< 1 then
5103 if TriggerType
= TRIGGER_PRESS
then
5104 Data
.ExtRandom
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_RANDOM
]]);
5107 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
, TRIGGER_DOOR5
,
5108 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
, TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
,
5111 Data
.NoSound
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SILENT
]]);
5112 Data
.d2d_doors
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_D2D
]]);
5117 Data
.d2d_teleport
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_D2D
]]);
5118 Data
.silent_teleport
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TELEPORT_SILENT
]]);
5119 Data
.TlpDir
:= NameToDirAdv(vleObjectProperty
.Values
[_lc
[I_PROP_TR_TELEPORT_DIR
]]);
5124 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_NAME
]]);
5125 FillByte(Data
.SoundName
[0], 64, 0);
5127 Move(s
[1], Data
.SoundName
[0], Min(Length(s
), 64));
5129 Data
.Volume
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_VOLUME
]], 0), 255);
5130 Data
.Pan
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_PAN
]], 0), 255);
5131 Data
.PlayCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_COUNT
]], 0), 255);
5132 Data
.Local
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_LOCAL
]]);
5133 Data
.SoundSwitch
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SOUND_SWITCH
]]);
5136 TRIGGER_SPAWNMONSTER
:
5138 Data
.MonType
:= StrToMonster(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_TYPE
]]);
5139 Data
.MonDir
:= Byte(NameToDir(vleObjectProperty
.Values
[_lc
[I_PROP_DIRECTION
]]));
5140 Data
.MonHealth
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH
]], 0), 1000000);
5141 if Data
.MonHealth
< 0 then
5142 Data
.MonHealth
:= 0;
5143 Data
.MonActive
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_ACTIVE
]]);
5144 Data
.MonCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 64);
5145 if Data
.MonCount
< 1 then
5147 Data
.MonEffect
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_FX_TYPE
]]);
5148 Data
.MonMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_MAX
]], 0), 65535);
5149 Data
.MonDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_DELAY
]], 0), 65535);
5151 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_1
] then
5153 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_2
] then
5155 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_3
] then
5157 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_4
] then
5159 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MONSTER_BEHAVIOUR
]] = _lc
[I_PROP_TR_MONSTER_BEHAVIOUR_5
] then
5165 Data
.ItemType
:= StrToItem(vleObjectProperty
.Values
[_lc
[I_PROP_TR_ITEM_TYPE
]]);
5166 Data
.ItemOnlyDM
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_DM_ONLY
]]);
5167 Data
.ItemFalls
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_ITEM_FALLS
]]);
5168 Data
.ItemCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 64);
5169 if Data
.ItemCount
< 1 then
5170 Data
.ItemCount
:= 1;
5171 Data
.ItemEffect
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_FX_TYPE
]]);
5172 Data
.ItemMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_MAX
]], 0), 65535);
5173 Data
.ItemDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SPAWN_DELAY
]], 0), 65535);
5178 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MUSIC_NAME
]]);
5179 FillByte(Data
.MusicName
[0], 64, 0);
5181 Move(s
[1], Data
.MusicName
[0], Min(Length(s
), 64));
5183 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MUSIC_ACT
]] = _lc
[I_PROP_TR_MUSIC_ON
] then
5184 Data
.MusicAction
:= 1
5186 Data
.MusicAction
:= 0;
5191 Data
.PushAngle
:= Min(
5192 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_ANGLE
]], 0), 360);
5193 Data
.PushForce
:= Min(
5194 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_FORCE
]], 0), 255);
5195 Data
.ResetVel
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_PUSH_RESET
]]);
5200 Data
.ScoreAction
:= 0;
5201 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_1
] then
5202 Data
.ScoreAction
:= 1
5203 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_2
] then
5204 Data
.ScoreAction
:= 2
5205 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_ACT
]] = _lc
[I_PROP_TR_SCORE_ACT_3
] then
5206 Data
.ScoreAction
:= 3;
5207 Data
.ScoreCount
:= Min(Max(
5208 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 0), 255);
5209 Data
.ScoreTeam
:= 0;
5210 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_1
] then
5212 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_2
] then
5214 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_TEAM
]] = _lc
[I_PROP_TR_SCORE_TEAM_3
] then
5215 Data
.ScoreTeam
:= 3;
5216 Data
.ScoreCon
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_CON
]]);
5217 Data
.ScoreMsg
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SCORE_MSG
]]);
5222 Data
.MessageKind
:= 0;
5223 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_KIND
]] = _lc
[I_PROP_TR_MESSAGE_KIND_1
] then
5224 Data
.MessageKind
:= 1;
5226 Data
.MessageSendTo
:= 0;
5227 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_1
] then
5228 Data
.MessageSendTo
:= 1
5229 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_2
] then
5230 Data
.MessageSendTo
:= 2
5231 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_3
] then
5232 Data
.MessageSendTo
:= 3
5233 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_4
] then
5234 Data
.MessageSendTo
:= 4
5235 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TO
]] = _lc
[I_PROP_TR_MESSAGE_TO_5
] then
5236 Data
.MessageSendTo
:= 5;
5238 s
:= utf2win(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TEXT
]]);
5239 FillByte(Data
.MessageText
[0], 100, 0);
5241 Move(s
[1], Data
.MessageText
[0], Min(Length(s
), 100));
5243 Data
.MessageTime
:= Min(Max(
5244 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_MESSAGE_TIME
]], 0), 0), 65535);
5249 Data
.DamageValue
:= Min(Max(
5250 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_DAMAGE_VALUE
]], 0), 0), 65535);
5251 Data
.DamageInterval
:= Min(Max(
5252 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_INTERVAL
]], 0), 0), 65535);
5253 s
:= vleObjectProperty
.Values
[_lc
[I_PROP_TR_DAMAGE_KIND
]];
5254 if s
= _lc
[I_PROP_TR_DAMAGE_KIND_3
] then
5255 Data
.DamageKind
:= 3
5256 else if s
= _lc
[I_PROP_TR_DAMAGE_KIND_4
] then
5257 Data
.DamageKind
:= 4
5258 else if s
= _lc
[I_PROP_TR_DAMAGE_KIND_5
] then
5259 Data
.DamageKind
:= 5
5260 else if s
= _lc
[I_PROP_TR_DAMAGE_KIND_6
] then
5261 Data
.DamageKind
:= 6
5262 else if s
= _lc
[I_PROP_TR_DAMAGE_KIND_7
] then
5263 Data
.DamageKind
:= 7
5264 else if s
= _lc
[I_PROP_TR_DAMAGE_KIND_8
] then
5265 Data
.DamageKind
:= 8
5267 Data
.DamageKind
:= 0;
5272 Data
.HealValue
:= Min(Max(
5273 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH
]], 0), 0), 65535);
5274 Data
.HealInterval
:= Min(Max(
5275 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_INTERVAL
]], 0), 0), 65535);
5276 Data
.HealMax
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_HEALTH_MAX
]]);
5277 Data
.HealSilent
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SILENT
]]);
5282 Data
.ShotType
:= StrToShot(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TYPE
]]);
5283 Data
.ShotSound
:= NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_SOUND
]]);
5284 Data
.ShotTarget
:= 0;
5285 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_1
] then
5286 Data
.ShotTarget
:= 1
5287 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_2
] then
5288 Data
.ShotTarget
:= 2
5289 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_3
] then
5290 Data
.ShotTarget
:= 3
5291 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_4
] then
5292 Data
.ShotTarget
:= 4
5293 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_5
] then
5294 Data
.ShotTarget
:= 5
5295 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_TO
]] = _lc
[I_PROP_TR_SHOT_TO_6
] then
5296 Data
.ShotTarget
:= 6;
5297 Data
.ShotIntSight
:= Min(Max(
5298 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_SIGHT
]], 0), 0), 65535);
5300 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_1
] then
5302 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_2
] then
5304 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AIM
]] = _lc
[I_PROP_TR_SHOT_AIM_3
] then
5306 Data
.ShotAngle
:= Min(
5307 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_ANGLE
]], 0), 360);
5308 Data
.ShotWait
:= Min(Max(
5309 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 0), 65535);
5310 Data
.ShotAccuracy
:= Min(Max(
5311 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_ACC
]], 0), 0), 65535);
5312 Data
.ShotAmmo
:= Min(Max(
5313 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_AMMO
]], 0), 0), 65535);
5314 Data
.ShotIntReload
:= Min(Max(
5315 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_SHOT_RELOAD
]], 0), 0), 65535);
5320 Data
.FXCount
:= Min(Max(
5321 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_COUNT
]], 0), 0), 255);
5322 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_PARTICLE
] then
5324 Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
5325 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
5326 if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_SLIQUID
] then
5327 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
5328 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_LLIQUID
] then
5329 Data
.FXSubType
:= TRIGGER_EFFECT_LLIQUID
5330 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_DLIQUID
] then
5331 Data
.FXSubType
:= TRIGGER_EFFECT_DLIQUID
5332 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_BLOOD
] then
5333 Data
.FXSubType
:= TRIGGER_EFFECT_BLOOD
5334 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_SPARK
] then
5335 Data
.FXSubType
:= TRIGGER_EFFECT_SPARK
5336 else if vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]] = _lc
[I_PROP_TR_EFFECT_BUBBLE
] then
5337 Data
.FXSubType
:= TRIGGER_EFFECT_BUBBLE
;
5340 Data
.FXType
:= TRIGGER_EFFECT_ANIMATION
;
5341 Data
.FXSubType
:= StrToEffect(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SUBTYPE
]]);
5344 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_COLOR
]], 0), 0), $FFFFFF);
5345 Data
.FXColorR
:= a
and $FF;
5346 Data
.FXColorG
:= (a
shr 8) and $FF;
5347 Data
.FXColorB
:= (a
shr 16) and $FF;
5348 if NameToBool(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_CENTER
]]) then
5352 Data
.FXWait
:= Min(Max(
5353 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EX_DELAY
]], 0), 0), 65535);
5354 Data
.FXVelX
:= Min(Max(
5355 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_VELX
]], 0), -128), 127);
5356 Data
.FXVelY
:= Min(Max(
5357 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_VELY
]], 0), -128), 127);
5358 Data
.FXSpreadL
:= Min(Max(
5359 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPL
]], 0), 0), 255);
5360 Data
.FXSpreadR
:= Min(Max(
5361 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPR
]], 0), 0), 255);
5362 Data
.FXSpreadU
:= Min(Max(
5363 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPU
]], 0), 0), 255);
5364 Data
.FXSpreadD
:= Min(Max(
5365 StrToIntDef(vleObjectProperty
.Values
[_lc
[I_PROP_TR_EFFECT_SPD
]], 0), 0), 255);
5374 vleObjectProperty
.Row
:= r
;
5375 vleObjectProperty
.Col
:= c
;
5378 procedure TMainForm
.bbRemoveTextureClick(Sender
: TObject
);
5382 i
:= lbTextureList
.ItemIndex
;
5386 if Application
.MessageBox(PChar(Format(_lc
[I_MSG_DEL_TEXTURE_PROMT
],
5387 [SelectedTexture()])),
5388 PChar(_lc
[I_MSG_DEL_TEXTURE
]),
5389 MB_ICONQUESTION
or MB_YESNO
or
5390 MB_DEFBUTTON1
) <> idYes
then
5393 if gPanels
<> nil then
5394 for a
:= 0 to High(gPanels
) do
5395 if (gPanels
[a
].PanelType
<> 0) and
5396 (gPanels
[a
].TextureName
= SelectedTexture()) then
5398 ErrorMessageBox(_lc
[I_MSG_DEL_TEXTURE_CANT
]);
5402 g_DeleteTexture(SelectedTexture());
5403 i
:= slInvalidTextures
.IndexOf(lbTextureList
.Items
[i
]);
5405 slInvalidTextures
.Delete(i
);
5406 if lbTextureList
.ItemIndex
> -1 then
5407 lbTextureList
.Items
.Delete(lbTextureList
.ItemIndex
)
5410 procedure TMainForm
.aNewMapExecute(Sender
: TObject
);
5412 if Application
.MessageBox(PChar(_lc
[I_MSG_CLEAR_MAP_PROMT
]), PChar(_lc
[I_MSG_CLEAR_MAP
]), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON1
) = mrYes
then
5416 procedure TMainForm
.aUndoExecute(Sender
: TObject
);
5420 if UndoBuffer
= nil then
5422 if UndoBuffer
[High(UndoBuffer
)] = nil then
5425 for a
:= 0 to High(UndoBuffer
[High(UndoBuffer
)]) do
5426 with UndoBuffer
[High(UndoBuffer
)][a
] do
5434 UNDO_DELETE_ITEM
: AddItem(Item
);
5435 UNDO_DELETE_AREA
: AddArea(Area
);
5436 UNDO_DELETE_MONSTER
: AddMonster(Monster
);
5437 UNDO_DELETE_TRIGGER
: AddTrigger(Trigger
);
5438 UNDO_ADD_PANEL
: RemoveObject(AddID
, OBJECT_PANEL
);
5439 UNDO_ADD_ITEM
: RemoveObject(AddID
, OBJECT_ITEM
);
5440 UNDO_ADD_AREA
: RemoveObject(AddID
, OBJECT_AREA
);
5441 UNDO_ADD_MONSTER
: RemoveObject(AddID
, OBJECT_MONSTER
);
5442 UNDO_ADD_TRIGGER
: RemoveObject(AddID
, OBJECT_TRIGGER
);
5446 SetLength(UndoBuffer
, Length(UndoBuffer
)-1);
5448 RemoveSelectFromObjects();
5450 miUndo
.Enabled
:= UndoBuffer
<> nil;
5454 procedure TMainForm
.aCopyObjectExecute(Sender
: TObject
);
5457 CopyBuffer
: TCopyRecArray
;
5461 function CB_Compare(I1
, I2
: TCopyRec
): Integer;
5463 Result
:= Integer(I1
.ObjectType
) - Integer(I2
.ObjectType
);
5465 if Result
= 0 then // Одного типа
5466 Result
:= Integer(I1
.ID
) - Integer(I2
.ID
);
5469 procedure QuickSortCopyBuffer(L
, R
: Integer);
5477 P
:= CopyBuffer
[(L
+ R
) shr 1];
5480 while CB_Compare(CopyBuffer
[I
], P
) < 0 do
5482 while CB_Compare(CopyBuffer
[J
], P
) > 0 do
5488 CopyBuffer
[I
] := CopyBuffer
[J
];
5496 QuickSortCopyBuffer(L
, J
);
5503 if SelectedObjects
= nil then
5509 // Копируем объекты:
5510 for a
:= 0 to High(SelectedObjects
) do
5511 if SelectedObjects
[a
].Live
then
5512 with SelectedObjects
[a
] do
5514 SetLength(CopyBuffer
, Length(CopyBuffer
)+1);
5515 b
:= High(CopyBuffer
);
5516 CopyBuffer
[b
].ID
:= ID
;
5517 CopyBuffer
[b
].Panel
:= nil;
5522 CopyBuffer
[b
].ObjectType
:= OBJECT_PANEL
;
5523 New(CopyBuffer
[b
].Panel
);
5524 CopyBuffer
[b
].Panel
^ := gPanels
[ID
];
5529 CopyBuffer
[b
].ObjectType
:= OBJECT_ITEM
;
5530 CopyBuffer
[b
].Item
:= gItems
[ID
];
5535 CopyBuffer
[b
].ObjectType
:= OBJECT_MONSTER
;
5536 CopyBuffer
[b
].Monster
:= gMonsters
[ID
];
5541 CopyBuffer
[b
].ObjectType
:= OBJECT_AREA
;
5542 CopyBuffer
[b
].Area
:= gAreas
[ID
];
5547 CopyBuffer
[b
].ObjectType
:= OBJECT_TRIGGER
;
5548 CopyBuffer
[b
].Trigger
:= gTriggers
[ID
];
5553 // Сортировка по ID:
5554 if CopyBuffer
<> nil then
5556 QuickSortCopyBuffer(0, b
);
5559 // Пестановка ссылок триггеров:
5560 for a
:= 0 to Length(CopyBuffer
)-1 do
5561 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5563 case CopyBuffer
[a
].Trigger
.TriggerType
of
5564 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5565 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5566 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5567 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5571 for b
:= 0 to Length(CopyBuffer
)-1 do
5572 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5573 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.PanelID
) then
5575 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= b
;
5580 // Этих панелей нет среди копируемых:
5582 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= -1;
5585 TRIGGER_PRESS
, TRIGGER_ON
,
5586 TRIGGER_OFF
, TRIGGER_ONOFF
:
5587 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5591 for b
:= 0 to Length(CopyBuffer
)-1 do
5592 if (CopyBuffer
[b
].ObjectType
= OBJECT_MONSTER
) and
5593 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1) then
5595 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= b
+1;
5600 // Этих монстров нет среди копируемых:
5602 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= 0;
5606 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5610 for b
:= 0 to Length(CopyBuffer
)-1 do
5611 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5612 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
) then
5614 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= b
;
5619 // Этих панелей нет среди копируемых:
5621 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= -1;
5625 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5629 for b
:= 0 to Length(CopyBuffer
)-1 do
5630 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5631 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.TexturePanel
) then
5633 CopyBuffer
[a
].Trigger
.TexturePanel
:= b
;
5638 // Этих панелей нет среди копируемых:
5640 CopyBuffer
[a
].Trigger
.TexturePanel
:= -1;
5645 str
:= CopyBufferToString(CopyBuffer
);
5646 ClipBoard
.AsText
:= str
;
5648 for a
:= 0 to Length(CopyBuffer
)-1 do
5649 if (CopyBuffer
[a
].ObjectType
= OBJECT_PANEL
) and
5650 (CopyBuffer
[a
].Panel
<> nil) then
5651 Dispose(CopyBuffer
[a
].Panel
);
5656 procedure TMainForm
.aPasteObjectExecute(Sender
: TObject
);
5659 CopyBuffer
: TCopyRecArray
;
5661 swad
, ssec
, sres
: String;
5667 pmin
.X
:= High(pmin
.X
);
5668 pmin
.Y
:= High(pmin
.Y
);
5670 StringToCopyBuffer(ClipBoard
.AsText
, CopyBuffer
, pmin
);
5671 rel
:= not(ssShift
in GetKeyShiftState());
5673 if CopyBuffer
= nil then
5676 RemoveSelectFromObjects();
5678 h
:= High(CopyBuffer
);
5680 with CopyBuffer
[a
] do
5684 if Panel
<> nil then
5688 Panel
^.X
:= Panel
^.X
- pmin
.X
- MapOffset
.X
+ 32;
5689 Panel
^.Y
:= Panel
^.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5692 Panel
^.TextureID
:= TEXTURE_SPECIAL_NONE
;
5693 Panel
^.TextureWidth
:= 1;
5694 Panel
^.TextureHeight
:= 1;
5696 if (Panel
^.PanelType
= PANEL_LIFTUP
) or
5697 (Panel
^.PanelType
= PANEL_LIFTDOWN
) or
5698 (Panel
^.PanelType
= PANEL_LIFTLEFT
) or
5699 (Panel
^.PanelType
= PANEL_LIFTRIGHT
) or
5700 (Panel
^.PanelType
= PANEL_BLOCKMON
) or
5701 (Panel
^.TextureName
= '') then
5702 begin // Нет или не может быть текстуры:
5704 else // Есть текстура:
5706 // Обычная текстура:
5707 if not IsSpecialTexture(Panel
^.TextureName
) then
5709 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5713 g_ProcessResourceStr(Panel
^.TextureName
, swad
, ssec
, sres
);
5714 AddTexture(swad
, ssec
, sres
, True);
5715 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5719 g_GetTextureSizeByName(Panel
^.TextureName
,
5720 Panel
^.TextureWidth
, Panel
^.TextureHeight
)
5722 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5724 Panel
^.TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5725 g_GetTextureSizeByID(NoTextureID
, Panel
^.TextureWidth
, Panel
^.TextureHeight
);
5728 else // Спец.текстура:
5730 Panel
^.TextureID
:= SpecialTextureID(Panel
^.TextureName
);
5731 with MainForm
.lbTextureList
.Items
do
5732 if IndexOf(Panel
^.TextureName
) = -1 then
5733 Add(Panel
^.TextureName
);
5737 ID
:= AddPanel(Panel
^);
5739 Undo_Add(OBJECT_PANEL
, ID
, a
> 0);
5740 SelectObject(OBJECT_PANEL
, ID
, True);
5747 Item
.X
:= Item
.X
- pmin
.X
- MapOffset
.X
+ 32;
5748 Item
.Y
:= Item
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5751 ID
:= AddItem(Item
);
5752 Undo_Add(OBJECT_ITEM
, ID
, a
> 0);
5753 SelectObject(OBJECT_ITEM
, ID
, True);
5760 Monster
.X
:= Monster
.X
- pmin
.X
- MapOffset
.X
+ 32;
5761 Monster
.Y
:= Monster
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5764 ID
:= AddMonster(Monster
);
5765 Undo_Add(OBJECT_MONSTER
, ID
, a
> 0);
5766 SelectObject(OBJECT_MONSTER
, ID
, True);
5773 Area
.X
:= Area
.X
- pmin
.X
- MapOffset
.X
+ 32;
5774 Area
.Y
:= Area
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5777 ID
:= AddArea(Area
);
5778 Undo_Add(OBJECT_AREA
, ID
, a
> 0);
5779 SelectObject(OBJECT_AREA
, ID
, True);
5787 X
:= X
- pmin
.X
- MapOffset
.X
+ 32;
5788 Y
:= Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5793 Data
.TargetPoint
.X
:=
5794 Data
.TargetPoint
.X
- pmin
.X
- MapOffset
.X
+ 32;
5795 Data
.TargetPoint
.Y
:=
5796 Data
.TargetPoint
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5798 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5800 Data
.tX
:= Data
.tX
- pmin
.X
- MapOffset
.X
+ 32;
5801 Data
.tY
:= Data
.tY
- pmin
.Y
- MapOffset
.Y
+ 32;
5803 TRIGGER_SPAWNMONSTER
:
5806 Data
.MonPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5808 Data
.MonPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5813 Data
.ItemPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5815 Data
.ItemPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5820 Data
.ShotPos
.X
- pmin
.X
- MapOffset
.X
+ 32;
5822 Data
.ShotPos
.Y
- pmin
.Y
- MapOffset
.Y
+ 32;
5827 ID
:= AddTrigger(Trigger
);
5828 Undo_Add(OBJECT_TRIGGER
, ID
, a
> 0);
5829 SelectObject(OBJECT_TRIGGER
, ID
, True);
5834 // Переставляем ссылки триггеров:
5835 for a
:= 0 to High(CopyBuffer
) do
5836 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5838 case CopyBuffer
[a
].Trigger
.TriggerType
of
5839 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5840 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5841 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5842 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5843 gTriggers
[CopyBuffer
[a
].ID
].Data
.PanelID
:=
5844 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.PanelID
].ID
;
5846 TRIGGER_PRESS
, TRIGGER_ON
,
5847 TRIGGER_OFF
, TRIGGER_ONOFF
:
5848 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5849 gTriggers
[CopyBuffer
[a
].ID
].Data
.MonsterID
:=
5850 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1].ID
+1;
5853 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5854 gTriggers
[CopyBuffer
[a
].ID
].Data
.ShotPanelID
:=
5855 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
].ID
;
5858 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5859 gTriggers
[CopyBuffer
[a
].ID
].TexturePanel
:=
5860 CopyBuffer
[CopyBuffer
[a
].Trigger
.TexturePanel
].ID
;
5869 procedure TMainForm
.aCutObjectExecute(Sender
: TObject
);
5872 DeleteSelectedObjects();
5875 procedure TMainForm
.vleObjectPropertyEditButtonClick(Sender
: TObject
);
5877 Key
, FileName
: String;
5880 Key
:= vleObjectProperty
.Keys
[vleObjectProperty
.Row
];
5882 if Key
= _lc
[I_PROP_PANEL_TYPE
] then
5884 with ChooseTypeForm
, vleObjectProperty
do
5885 begin // Выбор типа панели:
5886 Caption
:= _lc
[I_PROP_PANEL_TYPE
];
5887 lbTypeSelect
.Items
.Clear();
5889 for b
:= 0 to High(PANELNAMES
) do
5891 lbTypeSelect
.Items
.Add(PANELNAMES
[b
]);
5892 if Values
[Key
] = PANELNAMES
[b
] then
5893 lbTypeSelect
.ItemIndex
:= b
;
5896 if ShowModal() = mrOK
then
5898 b
:= lbTypeSelect
.ItemIndex
;
5899 Values
[Key
] := PANELNAMES
[b
];
5900 vleObjectPropertyApply(Sender
);
5904 else if Key
= _lc
[I_PROP_TR_TELEPORT_TO
] then
5905 SelectFlag
:= SELECTFLAG_TELEPORT
5906 else if Key
= _lc
[I_PROP_TR_SPAWN_TO
] then
5907 SelectFlag
:= SELECTFLAG_SPAWNPOINT
5908 else if (Key
= _lc
[I_PROP_TR_DOOR_PANEL
]) or
5909 (Key
= _lc
[I_PROP_TR_TRAP_PANEL
]) then
5910 SelectFlag
:= SELECTFLAG_DOOR
5911 else if Key
= _lc
[I_PROP_TR_TEXTURE_PANEL
] then
5913 DrawPressRect
:= False;
5914 SelectFlag
:= SELECTFLAG_TEXTURE
;
5916 else if Key
= _lc
[I_PROP_TR_SHOT_PANEL
] then
5917 SelectFlag
:= SELECTFLAG_SHOTPANEL
5918 else if Key
= _lc
[I_PROP_TR_LIFT_PANEL
] then
5919 SelectFlag
:= SELECTFLAG_LIFT
5920 else if key
= _lc
[I_PROP_TR_EX_MONSTER
] then
5921 SelectFlag
:= SELECTFLAG_MONSTER
5922 else if Key
= _lc
[I_PROP_TR_EX_AREA
] then
5924 SelectFlag
:= SELECTFLAG_NONE
;
5925 DrawPressRect
:= True;
5927 else if Key
= _lc
[I_PROP_TR_NEXT_MAP
] then
5928 begin // Выбор следующей карты:
5929 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
5930 SelectMapForm
.Caption
:= _lc
[I_CAP_SELECT
];
5931 SelectMapForm
.GetMaps(FileName
);
5933 if SelectMapForm
.ShowModal() = mrOK
then
5935 vleObjectProperty
.Values
[Key
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
5936 vleObjectPropertyApply(Sender
);
5939 else if (Key
= _lc
[I_PROP_TR_SOUND_NAME
]) or
5940 (Key
= _lc
[I_PROP_TR_MUSIC_NAME
]) then
5941 begin // Выбор файла звука/музыки:
5942 AddSoundForm
.OKFunction
:= nil;
5943 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
5944 AddSoundForm
.SetResource
:= vleObjectProperty
.Values
[Key
];
5946 if (AddSoundForm
.ShowModal() = mrOk
) then
5948 vleObjectProperty
.Values
[Key
] := AddSoundForm
.ResourceName
;
5949 vleObjectPropertyApply(Sender
);
5952 else if Key
= _lc
[I_PROP_TR_ACTIVATION
] then
5953 with ActivationTypeForm
, vleObjectProperty
do
5954 begin // Выбор типов активации:
5955 cbPlayerCollide
.Checked
:= Pos('PC', Values
[Key
]) > 0;
5956 cbMonsterCollide
.Checked
:= Pos('MC', Values
[Key
]) > 0;
5957 cbPlayerPress
.Checked
:= Pos('PP', Values
[Key
]) > 0;
5958 cbMonsterPress
.Checked
:= Pos('MP', Values
[Key
]) > 0;
5959 cbShot
.Checked
:= Pos('SH', Values
[Key
]) > 0;
5960 cbNoMonster
.Checked
:= Pos('NM', Values
[Key
]) > 0;
5962 if ShowModal() = mrOK
then
5965 if cbPlayerCollide
.Checked
then
5966 b
:= ACTIVATE_PLAYERCOLLIDE
;
5967 if cbMonsterCollide
.Checked
then
5968 b
:= b
or ACTIVATE_MONSTERCOLLIDE
;
5969 if cbPlayerPress
.Checked
then
5970 b
:= b
or ACTIVATE_PLAYERPRESS
;
5971 if cbMonsterPress
.Checked
then
5972 b
:= b
or ACTIVATE_MONSTERPRESS
;
5973 if cbShot
.Checked
then
5974 b
:= b
or ACTIVATE_SHOT
;
5975 if cbNoMonster
.Checked
then
5976 b
:= b
or ACTIVATE_NOMONSTER
;
5978 Values
[Key
] := ActivateToStr(b
);
5979 vleObjectPropertyApply(Sender
);
5982 else if Key
= _lc
[I_PROP_TR_KEYS
] then
5983 with KeysForm
, vleObjectProperty
do
5984 begin // Выбор необходимых ключей:
5985 cbRedKey
.Checked
:= Pos('RK', Values
[Key
]) > 0;
5986 cbGreenKey
.Checked
:= Pos('GK', Values
[Key
]) > 0;
5987 cbBlueKey
.Checked
:= Pos('BK', Values
[Key
]) > 0;
5988 cbRedTeam
.Checked
:= Pos('RT', Values
[Key
]) > 0;
5989 cbBlueTeam
.Checked
:= Pos('BT', Values
[Key
]) > 0;
5991 if ShowModal() = mrOK
then
5994 if cbRedKey
.Checked
then
5996 if cbGreenKey
.Checked
then
5997 b
:= b
or KEY_GREEN
;
5998 if cbBlueKey
.Checked
then
6000 if cbRedTeam
.Checked
then
6001 b
:= b
or KEY_REDTEAM
;
6002 if cbBlueTeam
.Checked
then
6003 b
:= b
or KEY_BLUETEAM
;
6005 Values
[Key
] := KeyToStr(b
);
6006 vleObjectPropertyApply(Sender
);
6009 else if Key
= _lc
[I_PROP_TR_FX_TYPE
] then
6010 with ChooseTypeForm
, vleObjectProperty
do
6011 begin // Выбор типа эффекта:
6012 Caption
:= _lc
[I_CAP_FX_TYPE
];
6013 lbTypeSelect
.Items
.Clear();
6015 for b
:= EFFECT_NONE
to EFFECT_FIRE
do
6016 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6018 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]);
6020 if ShowModal() = mrOK
then
6022 b
:= lbTypeSelect
.ItemIndex
;
6023 Values
[Key
] := EffectToStr(b
);
6024 vleObjectPropertyApply(Sender
);
6027 else if Key
= _lc
[I_PROP_TR_MONSTER_TYPE
] then
6028 with ChooseTypeForm
, vleObjectProperty
do
6029 begin // Выбор типа монстра:
6030 Caption
:= _lc
[I_CAP_MONSTER_TYPE
];
6031 lbTypeSelect
.Items
.Clear();
6033 for b
:= MONSTER_DEMON
to MONSTER_MAN
do
6034 lbTypeSelect
.Items
.Add(MonsterToStr(b
));
6036 lbTypeSelect
.ItemIndex
:= StrToMonster(Values
[Key
]) - MONSTER_DEMON
;
6038 if ShowModal() = mrOK
then
6040 b
:= lbTypeSelect
.ItemIndex
+ MONSTER_DEMON
;
6041 Values
[Key
] := MonsterToStr(b
);
6042 vleObjectPropertyApply(Sender
);
6045 else if Key
= _lc
[I_PROP_TR_ITEM_TYPE
] then
6046 with ChooseTypeForm
, vleObjectProperty
do
6047 begin // Выбор типа предмета:
6048 Caption
:= _lc
[I_CAP_ITEM_TYPE
];
6049 lbTypeSelect
.Items
.Clear();
6051 for b
:= ITEM_MEDKIT_SMALL
to ITEM_KEY_BLUE
do
6052 lbTypeSelect
.Items
.Add(ItemToStr(b
));
6053 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_BOTTLE
));
6054 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_HELMET
));
6055 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_JETPACK
));
6056 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_INVIS
));
6057 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER
));
6058 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_AMMO_FUELCAN
));
6060 b
:= StrToItem(Values
[Key
]);
6061 if b
>= ITEM_BOTTLE
then
6063 lbTypeSelect
.ItemIndex
:= b
- ITEM_MEDKIT_SMALL
;
6065 if ShowModal() = mrOK
then
6067 b
:= lbTypeSelect
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
6068 if b
>= ITEM_WEAPON_KASTET
then
6070 Values
[Key
] := ItemToStr(b
);
6071 vleObjectPropertyApply(Sender
);
6074 else if Key
= _lc
[I_PROP_TR_SHOT_TYPE
] then
6075 with ChooseTypeForm
, vleObjectProperty
do
6076 begin // Выбор типа предмета:
6077 Caption
:= _lc
[I_PROP_TR_SHOT_TYPE
];
6078 lbTypeSelect
.Items
.Clear();
6080 for b
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
6081 lbTypeSelect
.Items
.Add(ShotToStr(b
));
6083 lbTypeSelect
.ItemIndex
:= StrToShot(Values
[Key
]);
6085 if ShowModal() = mrOK
then
6087 b
:= lbTypeSelect
.ItemIndex
;
6088 Values
[Key
] := ShotToStr(b
);
6089 vleObjectPropertyApply(Sender
);
6092 else if Key
= _lc
[I_PROP_TR_EFFECT_TYPE
] then
6093 with ChooseTypeForm
, vleObjectProperty
do
6094 begin // Выбор типа эффекта:
6095 Caption
:= _lc
[I_CAP_FX_TYPE
];
6096 lbTypeSelect
.Items
.Clear();
6098 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_PARTICLE
]);
6099 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_ANIMATION
]);
6100 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
6101 lbTypeSelect
.ItemIndex
:= 1
6103 lbTypeSelect
.ItemIndex
:= 0;
6105 if ShowModal() = mrOK
then
6107 b
:= lbTypeSelect
.ItemIndex
;
6109 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_PARTICLE
]
6111 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_ANIMATION
];
6112 vleObjectPropertyApply(Sender
);
6115 else if Key
= _lc
[I_PROP_TR_EFFECT_SUBTYPE
] then
6116 with ChooseTypeForm
, vleObjectProperty
do
6117 begin // Выбор подтипа эффекта:
6118 Caption
:= _lc
[I_CAP_FX_TYPE
];
6119 lbTypeSelect
.Items
.Clear();
6121 if Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
6123 for b
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
6124 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6126 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]) - 1;
6129 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_SLIQUID
]);
6130 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_LLIQUID
]);
6131 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_DLIQUID
]);
6132 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_BLOOD
]);
6133 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_SPARK
]);
6134 lbTypeSelect
.Items
.Add(_lc
[I_PROP_TR_EFFECT_BUBBLE
]);
6135 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SLIQUID
;
6136 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_LLIQUID
] then
6137 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_LLIQUID
;
6138 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_DLIQUID
] then
6139 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_DLIQUID
;
6140 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_BLOOD
] then
6141 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BLOOD
;
6142 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_SPARK
] then
6143 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SPARK
;
6144 if Values
[Key
] = _lc
[I_PROP_TR_EFFECT_BUBBLE
] then
6145 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BUBBLE
;
6148 if ShowModal() = mrOK
then
6150 b
:= lbTypeSelect
.ItemIndex
;
6152 if Values
[_lc
[I_PROP_TR_EFFECT_TYPE
]] = _lc
[I_PROP_TR_EFFECT_ANIMATION
] then
6153 Values
[Key
] := EffectToStr(b
+ 1)
6155 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_SLIQUID
];
6156 if b
= TRIGGER_EFFECT_LLIQUID
then
6157 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_LLIQUID
];
6158 if b
= TRIGGER_EFFECT_DLIQUID
then
6159 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_DLIQUID
];
6160 if b
= TRIGGER_EFFECT_BLOOD
then
6161 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_BLOOD
];
6162 if b
= TRIGGER_EFFECT_SPARK
then
6163 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_SPARK
];
6164 if b
= TRIGGER_EFFECT_BUBBLE
then
6165 Values
[Key
] := _lc
[I_PROP_TR_EFFECT_BUBBLE
];
6168 vleObjectPropertyApply(Sender
);
6171 else if Key
= _lc
[I_PROP_TR_EFFECT_COLOR
] then
6172 with vleObjectProperty
do
6173 begin // Выбор цвета эффекта:
6174 ColorDialog
.Color
:= StrToIntDef(Values
[Key
], 0);
6175 if ColorDialog
.Execute
then
6177 Values
[Key
] := IntToStr(ColorDialog
.Color
);
6178 vleObjectPropertyApply(Sender
);
6181 else if Key
= _lc
[I_PROP_PANEL_TEX
] then
6182 begin // Смена текстуры:
6183 vleObjectProperty
.Values
[Key
] := SelectedTexture();
6184 vleObjectPropertyApply(Sender
);
6188 procedure TMainForm
.vleObjectPropertyApply(Sender
: TObject
);
6190 // hack to prevent empty ID in list
6191 RenderPanel
.SetFocus();
6192 bApplyProperty
.Click();
6193 vleObjectProperty
.SetFocus();
6196 procedure TMainForm
.aSaveMapExecute(Sender
: TObject
);
6198 FileName
, Section
, Res
: String;
6200 if OpenedMap
= '' then
6202 aSaveMapAsExecute(nil);
6206 g_ProcessResourceStr(OpenedMap
, FileName
, Section
, Res
);
6208 SaveMap(FileName
+':\'+Res
);
6211 procedure TMainForm
.aOpenMapExecute(Sender
: TObject
);
6213 OpenDialog
.Filter
:= _lc
[I_FILE_FILTER_ALL
];
6215 if OpenDialog
.Execute() then
6217 OpenMapFile(OpenDialog
.FileName
);
6218 OpenDialog
.InitialDir
:= ExtractFileDir(OpenDialog
.FileName
);
6222 procedure TMainForm
.OpenMapFile(FileName
: String);
6224 if (Pos('.ini', LowerCase(ExtractFileName(FileName
))) > 0) then
6228 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
6229 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
6230 pLoadProgress
.Show();
6235 LoadMapOld(FileName
);
6237 MainForm
.Caption
:= Format('%s - %s', [FormCaption
, ExtractFileName(FileName
)]);
6239 pLoadProgress
.Hide();
6240 MainForm
.FormResize(Self
);
6242 else // Карты из WAD:
6244 OpenMap(FileName
, '');
6248 procedure TMainForm
.FormActivate(Sender
: TObject
);
6253 MainForm
.ActiveControl
:= RenderPanel
;
6256 if (gLanguage
= '') and not (fsModal
in SelectLanguageForm
.FormState
) then
6258 lang
:= SelectLanguageForm
.ShowModal();
6260 1: gLanguage
:= LANGUAGE_ENGLISH
;
6261 2: gLanguage
:= LANGUAGE_RUSSIAN
;
6262 else gLanguage
:= LANGUAGE_ENGLISH
;
6265 config
:= TConfig
.CreateFile(CfgFileName
);
6266 config
.WriteStr('Editor', 'Language', gLanguage
);
6267 config
.SaveFile(CfgFileName
);
6271 //e_WriteLog('Read language file', MSG_NOTIFY);
6272 //g_Language_Load(EditorDir+'\data\'+gLanguage+LANGUAGE_FILE_NAME);
6273 g_Language_Set(gLanguage
);
6276 procedure TMainForm
.aDeleteMap(Sender
: TObject
);
6282 OpenDialog
.Filter
:= _lc
[I_FILE_FILTER_WAD
];
6284 if not OpenDialog
.Execute() then
6287 FileName
:= OpenDialog
.FileName
;
6288 SelectMapForm
.Caption
:= _lc
[I_CAP_REMOVE
];
6289 SelectMapForm
.lbMapList
.Items
.Clear();
6290 SelectMapForm
.GetMaps(FileName
);
6292 if SelectMapForm
.ShowModal() <> mrOK
then
6295 MapName
:= SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6296 if Application
.MessageBox(PChar(Format(_lc
[I_MSG_DELETE_MAP_PROMT
], [MapName
, OpenDialog
.FileName
])), PChar(_lc
[I_MSG_DELETE_MAP
]), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON2
) <> mrYes
then
6299 g_DeleteResource(FileName
, '', MapName
, res
);
6302 Application
.MessageBox(PChar('Cant delete map res=' + IntToStr(res
)), PChar('Map not deleted!'), MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
6306 Application
.MessageBox(
6307 PChar(Format(_lc
[I_MSG_MAP_DELETED_PROMT
], [MapName
])),
6308 PChar(_lc
[I_MSG_MAP_DELETED
]),
6309 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
6312 // Удалили текущую карту - сохранять по старому ее нельзя:
6313 if OpenedMap
= (FileName
+ ':\' + MapName
) then
6317 MainForm
.Caption
:= FormCaption
6321 procedure TMainForm
.vleObjectPropertyKeyDown(Sender
: TObject
;
6322 var Key
: Word; Shift
: TShiftState
);
6324 if Key
= VK_RETURN
then
6325 vleObjectPropertyApply(Sender
);
6328 procedure MovePanel(var ID
: DWORD
; MoveType
: Byte);
6333 if (ID
= 0) and (MoveType
= 0) then
6335 if (ID
= DWORD(High(gPanels
))) and (MoveType
<> 0) then
6337 if (ID
> DWORD(High(gPanels
))) then
6342 if MoveType
= 0 then // to Back
6344 if gTriggers
<> nil then
6345 for a
:= 0 to High(gTriggers
) do
6346 with gTriggers
[a
] do
6348 if TriggerType
= TRIGGER_NONE
then
6351 if TexturePanel
= _id
then
6354 if (TexturePanel
>= 0) and (TexturePanel
< _id
) then
6358 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6359 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6360 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6361 if Data
.PanelID
= _id
then
6364 if (Data
.PanelID
>= 0) and (Data
.PanelID
< _id
) then
6368 if Data
.ShotPanelID
= _id
then
6369 Data
.ShotPanelID
:= 0
6371 if (Data
.ShotPanelID
>= 0) and (Data
.ShotPanelID
< _id
) then
6372 Inc(Data
.ShotPanelID
);
6376 tmp
:= gPanels
[_id
];
6378 for a
:= _id
downto 1 do
6379 gPanels
[a
] := gPanels
[a
-1];
6387 if gTriggers
<> nil then
6388 for a
:= 0 to High(gTriggers
) do
6389 with gTriggers
[a
] do
6391 if TriggerType
= TRIGGER_NONE
then
6394 if TexturePanel
= _id
then
6395 TexturePanel
:= High(gPanels
)
6397 if TexturePanel
> _id
then
6401 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6402 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6403 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6404 if Data
.PanelID
= _id
then
6405 Data
.PanelID
:= High(gPanels
)
6407 if Data
.PanelID
> _id
then
6411 if Data
.ShotPanelID
= _id
then
6412 Data
.ShotPanelID
:= High(gPanels
)
6414 if Data
.ShotPanelID
> _id
then
6415 Dec(Data
.ShotPanelID
);
6419 tmp
:= gPanels
[_id
];
6421 for a
:= _id
to High(gPanels
)-1 do
6422 gPanels
[a
] := gPanels
[a
+1];
6424 gPanels
[High(gPanels
)] := tmp
;
6426 ID
:= High(gPanels
);
6430 procedure TMainForm
.aMoveToBack(Sender
: TObject
);
6434 if SelectedObjects
= nil then
6437 for a
:= 0 to High(SelectedObjects
) do
6438 with SelectedObjects
[a
] do
6439 if Live
and (ObjectType
= OBJECT_PANEL
) then
6441 SelectedObjects
[0] := SelectedObjects
[a
];
6442 SetLength(SelectedObjects
, 1);
6449 procedure TMainForm
.aMoveToFore(Sender
: TObject
);
6453 if SelectedObjects
= nil then
6456 for a
:= 0 to High(SelectedObjects
) do
6457 with SelectedObjects
[a
] do
6458 if Live
and (ObjectType
= OBJECT_PANEL
) then
6460 SelectedObjects
[0] := SelectedObjects
[a
];
6461 SetLength(SelectedObjects
, 1);
6468 procedure TMainForm
.aSaveMapAsExecute(Sender
: TObject
);
6472 SaveDialog
.Filter
:= _lc
[I_FILE_FILTER_WAD
];
6474 if not SaveDialog
.Execute() then
6477 SaveMapForm
.GetMaps(SaveDialog
.FileName
, True);
6479 if SaveMapForm
.ShowModal() <> mrOK
then
6482 SaveDialog
.InitialDir
:= ExtractFileDir(SaveDialog
.FileName
);
6483 OpenedMap
:= SaveDialog
.FileName
+':\'+SaveMapForm
.eMapName
.Text;
6484 OpenedWAD
:= SaveDialog
.FileName
;
6486 idx
:= RecentFiles
.IndexOf(OpenedMap
);
6487 // Такая карта уже недавно открывалась:
6489 RecentFiles
.Delete(idx
);
6490 RecentFiles
.Insert(0, OpenedMap
);
6495 gMapInfo
.FileName
:= SaveDialog
.FileName
;
6496 gMapInfo
.MapName
:= SaveMapForm
.eMapName
.Text;
6497 UpdateCaption(gMapInfo
.Name
, ExtractFileName(gMapInfo
.FileName
), gMapInfo
.MapName
);
6500 procedure TMainForm
.aSelectAllExecute(Sender
: TObject
);
6504 RemoveSelectFromObjects();
6506 case pcObjects
.ActivePageIndex
+1 of
6508 if gPanels
<> nil then
6509 for a
:= 0 to High(gPanels
) do
6510 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6511 SelectObject(OBJECT_PANEL
, a
, True);
6513 if gItems
<> nil then
6514 for a
:= 0 to High(gItems
) do
6515 if gItems
[a
].ItemType
<> ITEM_NONE
then
6516 SelectObject(OBJECT_ITEM
, a
, True);
6518 if gMonsters
<> nil then
6519 for a
:= 0 to High(gMonsters
) do
6520 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6521 SelectObject(OBJECT_MONSTER
, a
, True);
6523 if gAreas
<> nil then
6524 for a
:= 0 to High(gAreas
) do
6525 if gAreas
[a
].AreaType
<> AREA_NONE
then
6526 SelectObject(OBJECT_AREA
, a
, True);
6528 if gTriggers
<> nil then
6529 for a
:= 0 to High(gTriggers
) do
6530 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6531 SelectObject(OBJECT_TRIGGER
, a
, True);
6534 RecountSelectedObjects();
6537 procedure TMainForm
.tbGridOnClick(Sender
: TObject
);
6539 DotEnable
:= not DotEnable
;
6540 (Sender
as TToolButton
).Down
:= DotEnable
;
6543 procedure TMainForm
.OnIdle(Sender
: TObject
; var Done
: Boolean);
6546 // FIXME: this is a shitty hack
6547 if not gDataLoaded
then
6549 e_WriteLog('Init OpenGL', MSG_NOTIFY
);
6551 e_WriteLog('Loading data', MSG_NOTIFY
);
6552 LoadStdFont('STDTXT', 'STDFONT', gEditorFont
);
6553 e_WriteLog('Loading more data', MSG_NOTIFY
);
6555 e_WriteLog('Loading even more data', MSG_NOTIFY
);
6556 gDataLoaded
:= True;
6557 MainForm
.FormResize(nil);
6560 if StartMap
<> '' then
6568 procedure TMainForm
.miMapPreviewClick(Sender
: TObject
);
6570 if PreviewMode
= 2 then
6573 if PreviewMode
= 0 then
6575 Splitter2
.Visible
:= False;
6576 Splitter1
.Visible
:= False;
6577 StatusBar
.Visible
:= False;
6578 PanelObjs
.Visible
:= False;
6579 PanelProps
.Visible
:= False;
6580 MainToolBar
.Visible
:= False;
6581 sbHorizontal
.Visible
:= False;
6582 sbVertical
.Visible
:= False;
6586 StatusBar
.Visible
:= True;
6587 PanelObjs
.Visible
:= True;
6588 PanelProps
.Visible
:= True;
6589 Splitter2
.Visible
:= True;
6590 Splitter1
.Visible
:= True;
6591 MainToolBar
.Visible
:= True;
6592 sbHorizontal
.Visible
:= True;
6593 sbVertical
.Visible
:= True;
6596 PreviewMode
:= PreviewMode
xor 1;
6597 (Sender
as TMenuItem
).Checked
:= PreviewMode
> 0;
6602 procedure TMainForm
.miLayer1Click(Sender
: TObject
);
6604 SwitchLayer(LAYER_BACK
);
6607 procedure TMainForm
.miLayer2Click(Sender
: TObject
);
6609 SwitchLayer(LAYER_WALLS
);
6612 procedure TMainForm
.miLayer3Click(Sender
: TObject
);
6614 SwitchLayer(LAYER_FOREGROUND
);
6617 procedure TMainForm
.miLayer4Click(Sender
: TObject
);
6619 SwitchLayer(LAYER_STEPS
);
6622 procedure TMainForm
.miLayer5Click(Sender
: TObject
);
6624 SwitchLayer(LAYER_WATER
);
6627 procedure TMainForm
.miLayer6Click(Sender
: TObject
);
6629 SwitchLayer(LAYER_ITEMS
);
6632 procedure TMainForm
.miLayer7Click(Sender
: TObject
);
6634 SwitchLayer(LAYER_MONSTERS
);
6637 procedure TMainForm
.miLayer8Click(Sender
: TObject
);
6639 SwitchLayer(LAYER_AREAS
);
6642 procedure TMainForm
.miLayer9Click(Sender
: TObject
);
6644 SwitchLayer(LAYER_TRIGGERS
);
6647 procedure TMainForm
.tbShowClick(Sender
: TObject
);
6653 for a
:= 0 to High(LayerEnabled
) do
6654 b
:= b
and LayerEnabled
[a
];
6658 ShowLayer(LAYER_BACK
, b
);
6659 ShowLayer(LAYER_WALLS
, b
);
6660 ShowLayer(LAYER_FOREGROUND
, b
);
6661 ShowLayer(LAYER_STEPS
, b
);
6662 ShowLayer(LAYER_WATER
, b
);
6663 ShowLayer(LAYER_ITEMS
, b
);
6664 ShowLayer(LAYER_MONSTERS
, b
);
6665 ShowLayer(LAYER_AREAS
, b
);
6666 ShowLayer(LAYER_TRIGGERS
, b
);
6669 procedure TMainForm
.miMiniMapClick(Sender
: TObject
);
6674 procedure TMainForm
.miSwitchGridClick(Sender
: TObject
);
6676 if DotStep
= DotStepOne
then
6677 DotStep
:= DotStepTwo
6679 DotStep
:= DotStepOne
;
6681 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6682 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6685 procedure TMainForm
.miShowEdgesClick(Sender
: TObject
);
6690 procedure TMainForm
.miSnapToGridClick(Sender
: TObject
);
6692 SnapToGrid
:= not SnapToGrid
;
6694 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6695 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6697 miSnapToGrid
.Checked
:= SnapToGrid
;
6700 procedure TMainForm
.minexttabClick(Sender
: TObject
);
6702 if pcObjects
.ActivePageIndex
< pcObjects
.PageCount
-1 then
6703 pcObjects
.ActivePageIndex
:= pcObjects
.ActivePageIndex
+1
6705 pcObjects
.ActivePageIndex
:= 0;
6708 procedure TMainForm
.miSaveMiniMapClick(Sender
: TObject
);
6710 SaveMiniMapForm
.ShowModal();
6713 procedure TMainForm
.bClearTextureClick(Sender
: TObject
);
6715 lbTextureList
.ItemIndex
:= -1;
6716 lTextureWidth
.Caption
:= '';
6717 lTextureHeight
.Caption
:= '';
6720 procedure TMainForm
.miPackMapClick(Sender
: TObject
);
6722 PackMapForm
.ShowModal();
6725 type SSArray
= array of String;
6727 function ParseString (Str
: AnsiString): SSArray
;
6728 function GetStr (var Str
: AnsiString): AnsiString;
6732 if Str
[1] = '"' then
6733 for b
:= 1 to Length(Str
) do
6734 if (b
= Length(Str
)) or (Str
[b
+ 1] = '"') then
6736 Result
:= Copy(Str
, 2, b
- 1);
6737 Delete(Str
, 1, b
+ 1);
6741 for a
:= 1 to Length(Str
) do
6742 if (a
= Length(Str
)) or (Str
[a
+ 1] = ' ') then
6744 Result
:= Copy(Str
, 1, a
);
6745 Delete(Str
, 1, a
+ 1);
6755 SetLength(Result
, Length(Result
)+1);
6756 Result
[High(Result
)] := GetStr(Str
);
6760 procedure TMainForm
.miTestMapClick(Sender
: TObject
);
6762 newWAD
, oldWAD
, tempMap
, ext
: String;
6769 // Ignore while map testing in progress
6770 if MapTestProcess
<> nil then
6773 // Сохраняем временную карту:
6776 newWAD
:= Format('%s/temp%.4d', [MapsDir
, time
]);
6778 until not FileExists(newWAD
);
6779 if OpenedMap
<> '' then
6781 oldWad
:= g_ExtractWadName(OpenedMap
);
6782 newWad
:= newWad
+ ExtractFileExt(oldWad
);
6783 if CopyFile(oldWad
, newWad
) = false then
6784 e_WriteLog('MapTest: unable to copy [' + oldWad
+ '] to [' + newWad
+ ']', MSG_WARNING
)
6788 newWad
:= newWad
+ '.wad'
6790 tempMap
:= newWAD
+ ':\' + TEST_MAP_NAME
;
6795 if TestOptionsTwoPlayers
then
6797 if TestOptionsTeamDamage
then
6799 if TestOptionsAllowExit
then
6801 if TestOptionsWeaponStay
then
6803 if TestOptionsMonstersDM
then
6807 proc
:= TProcessUTF8
.Create(nil);
6808 proc
.Executable
:= TestD2dExe
;
6810 // TODO: get real executable name from Info.plist
6811 if LowerCase(ExtractFileExt(TestD2dExe
)) = '.app' then
6812 proc
.Executable
:= TestD2dExe
+ DirectorySeparator
+ 'Contents' + DirectorySeparator
+ 'MacOS' + DirectorySeparator
+ 'Doom2DF';
6814 proc
.Parameters
.Add('-map');
6815 proc
.Parameters
.Add(tempMap
);
6816 proc
.Parameters
.Add('-gm');
6817 proc
.Parameters
.Add(TestGameMode
);
6818 proc
.Parameters
.Add('-limt');
6819 proc
.Parameters
.Add(TestLimTime
);
6820 proc
.Parameters
.Add('-lims');
6821 proc
.Parameters
.Add(TestLimScore
);
6822 proc
.Parameters
.Add('-opt');
6823 proc
.Parameters
.Add(IntToStr(opt
));
6824 proc
.Parameters
.Add('--debug');
6826 proc
.Parameters
.Add('--close');
6828 args
:= ParseString(TestD2DArgs
);
6829 for i
:= 0 to High(args
) do
6830 proc
.Parameters
.Add(args
[i
]);
6840 tbTestMap
.Enabled
:= False;
6841 MapTestFile
:= newWAD
;
6842 MapTestProcess
:= proc
;
6846 Application
.MessageBox(PChar(_lc
[I_MSG_EXEC_ERROR
]), 'FIXME', MB_OK
or MB_ICONERROR
);
6847 SysUtils
.DeleteFile(newWAD
);
6852 procedure TMainForm
.sbVerticalScroll(Sender
: TObject
;
6853 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
6855 MapOffset
.Y
:= -sbVertical
.Position
;
6858 procedure TMainForm
.sbHorizontalScroll(Sender
: TObject
;
6859 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
6861 MapOffset
.X
:= -sbHorizontal
.Position
;
6864 procedure TMainForm
.miOpenWadMapClick(Sender
: TObject
);
6866 if OpenedWAD
<> '' then
6868 OpenMap(OpenedWAD
, '');
6872 procedure TMainForm
.selectall1Click(Sender
: TObject
);
6876 RemoveSelectFromObjects();
6878 if gPanels
<> nil then
6879 for a
:= 0 to High(gPanels
) do
6880 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6881 SelectObject(OBJECT_PANEL
, a
, True);
6883 if gItems
<> nil then
6884 for a
:= 0 to High(gItems
) do
6885 if gItems
[a
].ItemType
<> ITEM_NONE
then
6886 SelectObject(OBJECT_ITEM
, a
, True);
6888 if gMonsters
<> nil then
6889 for a
:= 0 to High(gMonsters
) do
6890 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6891 SelectObject(OBJECT_MONSTER
, a
, True);
6893 if gAreas
<> nil then
6894 for a
:= 0 to High(gAreas
) do
6895 if gAreas
[a
].AreaType
<> AREA_NONE
then
6896 SelectObject(OBJECT_AREA
, a
, True);
6898 if gTriggers
<> nil then
6899 for a
:= 0 to High(gTriggers
) do
6900 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6901 SelectObject(OBJECT_TRIGGER
, a
, True);
6903 RecountSelectedObjects();
6906 procedure TMainForm
.Splitter1CanResize(Sender
: TObject
;
6907 var NewSize
: Integer; var Accept
: Boolean);
6909 Accept
:= (NewSize
> 140);
6912 procedure TMainForm
.Splitter2CanResize(Sender
: TObject
;
6913 var NewSize
: Integer; var Accept
: Boolean);
6915 Accept
:= (NewSize
> 110);
6918 procedure TMainForm
.vleObjectPropertyEnter(Sender
: TObject
);
6920 EditingProperties
:= True;
6923 procedure TMainForm
.vleObjectPropertyExit(Sender
: TObject
);
6925 EditingProperties
:= False;
6928 procedure TMainForm
.FormKeyUp(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
6930 // Объекты передвигались:
6931 if MainForm
.ActiveControl
= RenderPanel
then
6933 if (Key
= VK_NUMPAD4
) or
6934 (Key
= VK_NUMPAD6
) or
6935 (Key
= VK_NUMPAD8
) or
6936 (Key
= VK_NUMPAD5
) or
6937 (Key
= Ord('V')) then
6940 // Быстрое превью карты:
6941 if Key
= Ord('E') then
6943 if PreviewMode
= 2 then
6946 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);