3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, SysUtils
, Variants
, Classes
, Graphics
,
9 Controls
, Forms
, Dialogs
, StdCtrls
, Buttons
,
10 ComCtrls
, ValEdit
, Types
, Menus
, ExtCtrls
,
11 CheckLst
, Grids
, OpenGLContext
, Utils
, UTF8Process
;
17 TMainForm
= class(TForm
)
21 StatusBar
: TStatusBar
;
22 OpenDialog
: TOpenDialog
;
23 SaveDialog
: TSaveDialog
;
24 ColorDialog
: TColorDialog
;
28 ImageList
: TImageList
;
31 miAppleAbout
: TMenuItem
;
32 miAppleLine0
: TMenuItem
;
33 miApplePref
: TMenuItem
;
34 miAppleLine1
: TMenuItem
;
36 miMenuFile
: TMenuItem
;
39 miMacRecentSubMenu
: TMenuItem
;
40 miMacRecentEnd
: TMenuItem
;
41 miMacRecentClear
: TMenuItem
;
42 Separator1
: TMenuItem
;
44 miSaveMapAs
: TMenuItem
;
45 miOpenWadMap
: TMenuItem
;
47 miReopenMap
: TMenuItem
;
48 miSaveMiniMap
: TMenuItem
;
49 miDeleteMap
: TMenuItem
;
51 miWinRecentStart
: TMenuItem
;
52 miWinRecent
: TMenuItem
;
56 miMenuEdit
: TMenuItem
;
63 miSelectAll
: TMenuItem
;
65 miSnapToGrid
: TMenuItem
;
66 miSwitchGrid
: TMenuItem
;
67 Separator2
: TMenuItem
;
71 miMapOptions
: TMenuItem
;
74 miMenuView
: TMenuItem
;
85 miViewLine1
: TMenuItem
;
87 miShowEdges
: TMenuItem
;
88 miViewLine2
: TMenuItem
;
89 miMapPreview
: TMenuItem
;
91 miMenuService
: TMenuItem
;
92 miCheckMap
: TMenuItem
;
93 miOptimmization
: TMenuItem
;
96 miMenuWindow
: TMenuItem
;
97 miMacMinimize
: TMenuItem
;
100 miMenuHelp
: TMenuItem
;
103 miMenuHidden
: TMenuItem
;
104 minexttab
: TMenuItem
;
105 selectall1
: TMenuItem
;
108 ilToolbar
: TImageList
;
109 MainToolBar
: TToolBar
;
110 tbNewMap
: TToolButton
;
111 tbOpenMap
: TToolButton
;
112 tbSaveMap
: TToolButton
;
113 tbOpenWadMap
: TToolButton
;
114 tbLine1
: TToolButton
;
115 tbShowMap
: TToolButton
;
116 tbLine2
: TToolButton
;
119 miLayerP1
: TMenuItem
;
120 miLayerP2
: TMenuItem
;
121 miLayerP3
: TMenuItem
;
122 miLayerP4
: TMenuItem
;
123 miLayerP5
: TMenuItem
;
124 miLayerP6
: TMenuItem
;
125 miLayerP7
: TMenuItem
;
126 miLayerP8
: TMenuItem
;
127 miLayerP9
: TMenuItem
;
128 tbLine3
: TToolButton
;
129 tbGridOn
: TToolButton
;
131 tbLine4
: TToolButton
;
132 tbTestMap
: TToolButton
;
135 pLoadProgress
: TPanel
;
137 pbLoad
: TProgressBar
;
141 RenderPanel
: TOpenGLControl
;
142 sbHorizontal
: TScrollBar
;
143 sbVertical
: TScrollBar
;
145 // Object propertiy editor:
147 PanelPropApply
: TPanel
;
148 bApplyProperty
: TButton
;
149 vleObjectProperty
: TValueListEditor
;
153 pcObjects
: TPageControl
;
156 PanelPanelType
: TPanel
;
157 lbPanelType
: TListBox
;
158 lbTextureList
: TListBox
;
159 PanelTextures
: TPanel
;
161 lTextureWidth
: TLabel
;
163 lTextureHeight
: TLabel
;
164 cbPreview
: TCheckBox
;
165 bbAddTexture
: TBitBtn
;
166 bbRemoveTexture
: TBitBtn
;
167 bClearTexture
: TButton
;
170 lbItemList
: TListBox
;
174 tsMonsters
: TTabSheet
;
175 lbMonsterList
: TListBox
;
176 rbMonsterLeft
: TRadioButton
;
177 rbMonsterRight
: TRadioButton
;
180 lbAreasList
: TListBox
;
181 rbAreaLeft
: TRadioButton
;
182 rbAreaRight
: TRadioButton
;
184 tsTriggers
: TTabSheet
;
185 lbTriggersList
: TListBox
;
186 clbActivationType
: TCheckListBox
;
187 clbKeys
: TCheckListBox
;
189 procedure aAboutExecute(Sender
: TObject
);
190 procedure aCheckMapExecute(Sender
: TObject
);
191 procedure aMoveToFore(Sender
: TObject
);
192 procedure aMoveToBack(Sender
: TObject
);
193 procedure aCopyObjectExecute(Sender
: TObject
);
194 procedure aCutObjectExecute(Sender
: TObject
);
195 procedure aEditorOptionsExecute(Sender
: TObject
);
196 procedure aExitExecute(Sender
: TObject
);
197 procedure aMapOptionsExecute(Sender
: TObject
);
198 procedure aNewMapExecute(Sender
: TObject
);
199 procedure aOpenMapExecute(Sender
: TObject
);
200 procedure aOptimizeExecute(Sender
: TObject
);
201 procedure aPasteObjectExecute(Sender
: TObject
);
202 procedure aSelectAllExecute(Sender
: TObject
);
203 procedure aSaveMapExecute(Sender
: TObject
);
204 procedure aSaveMapAsExecute(Sender
: TObject
);
205 procedure aUndoExecute(Sender
: TObject
);
206 procedure aDeleteMap(Sender
: TObject
);
207 procedure bApplyPropertyClick(Sender
: TObject
);
208 procedure bbAddTextureClick(Sender
: TObject
);
209 procedure bbRemoveTextureClick(Sender
: TObject
);
210 procedure FormActivate(Sender
: TObject
);
211 procedure FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
212 procedure FormCreate(Sender
: TObject
);
213 procedure FormDestroy(Sender
: TObject
);
214 procedure FormDropFiles(Sender
: TObject
; const FileNames
: array of String);
215 procedure FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
216 procedure FormResize(Sender
: TObject
);
217 procedure FormWindowStateChange(Sender
: TObject
);
218 procedure miMacRecentClearClick(Sender
: TObject
);
219 procedure miMacZoomClick(Sender
: TObject
);
220 procedure lbTextureListClick(Sender
: TObject
);
221 procedure lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
222 ARect
: TRect
; State
: TOwnerDrawState
);
223 procedure miMacMinimizeClick(Sender
: TObject
);
224 procedure miReopenMapClick(Sender
: TObject
);
225 procedure RenderPanelMouseDown(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
226 procedure RenderPanelMouseMove(Sender
: TObject
; Shift
: TShiftState
; X
, Y
: Integer);
227 procedure RenderPanelMouseUp(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
228 procedure RenderPanelPaint(Sender
: TObject
);
229 procedure RenderPanelResize(Sender
: TObject
);
230 procedure Splitter1Moved(Sender
: TObject
);
231 procedure MapTestCheck(Sender
: TObject
);
232 procedure vleObjectPropertyEditButtonClick(Sender
: TObject
);
233 procedure vleObjectPropertyApply(Sender
: TObject
);
234 procedure vleObjectPropertyGetPickList(Sender
: TObject
; const KeyName
: String; Values
: TStrings
);
235 procedure vleObjectPropertyKeyDown(Sender
: TObject
; var Key
: Word;
237 procedure tbGridOnClick(Sender
: TObject
);
238 procedure miMapPreviewClick(Sender
: TObject
);
239 procedure miLayer1Click(Sender
: TObject
);
240 procedure miLayer2Click(Sender
: TObject
);
241 procedure miLayer3Click(Sender
: TObject
);
242 procedure miLayer4Click(Sender
: TObject
);
243 procedure miLayer5Click(Sender
: TObject
);
244 procedure miLayer6Click(Sender
: TObject
);
245 procedure miLayer7Click(Sender
: TObject
);
246 procedure miLayer8Click(Sender
: TObject
);
247 procedure miLayer9Click(Sender
: TObject
);
248 procedure tbShowClick(Sender
: TObject
);
249 procedure miSnapToGridClick(Sender
: TObject
);
250 procedure miMiniMapClick(Sender
: TObject
);
251 procedure miSwitchGridClick(Sender
: TObject
);
252 procedure miShowEdgesClick(Sender
: TObject
);
253 procedure minexttabClick(Sender
: TObject
);
254 procedure miSaveMiniMapClick(Sender
: TObject
);
255 procedure bClearTextureClick(Sender
: TObject
);
256 procedure miPackMapClick(Sender
: TObject
);
257 procedure miTestMapClick(Sender
: TObject
);
258 procedure sbVerticalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
259 var ScrollPos
: Integer);
260 procedure sbHorizontalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
261 var ScrollPos
: Integer);
262 procedure miOpenWadMapClick(Sender
: TObject
);
263 procedure selectall1Click(Sender
: TObject
);
264 procedure Splitter1CanResize(Sender
: TObject
; var NewSize
: Integer;
265 var Accept
: Boolean);
266 procedure Splitter2CanResize(Sender
: TObject
; var NewSize
: Integer;
267 var Accept
: Boolean);
268 procedure vleObjectPropertyEnter(Sender
: TObject
);
269 procedure vleObjectPropertyExit(Sender
: TObject
);
270 procedure FormKeyUp(Sender
: TObject
; var Key
: Word;
274 procedure OnIdle(Sender
: TObject
; var Done
: Boolean);
275 procedure RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
277 procedure RefreshRecentMenu();
278 procedure OpenMapFile(FileName
: String);
279 function RenderMousePos(): TPoint
;
280 procedure RecountSelectedObjects();
286 LAYER_FOREGROUND
= 2;
294 TEST_MAP_NAME
= '$$$_TEST_$$$';
295 LANGUAGE_FILE_NAME
= '_Editor.txt';
306 DotStepOne
, DotStepTwo
: Word;
308 DrawTexturePanel
: Boolean;
309 DrawPanelSize
: Boolean;
311 PreviewColor
: TColor
;
312 UseCheckerboard
: Boolean;
314 RecentCount
: Integer;
315 RecentFiles
: TStringList
;
316 slInvalidTextures
: TStringList
;
318 TestGameMode
: String;
320 TestLimScore
: String;
321 TestOptionsTwoPlayers
: Boolean;
322 TestOptionsTeamDamage
: Boolean;
323 TestOptionsAllowExit
: Boolean;
324 TestOptionsWeaponStay
: Boolean;
325 TestOptionsMonstersDM
: Boolean;
326 TestD2dExe
, TestD2DArgs
: String;
327 TestMapOnce
: Boolean;
329 LayerEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
330 (True, True, True, True, True, True, True, True, True);
331 ContourEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
332 (False, False, False, False, False, False, False, False, False);
333 PreviewMode
: Byte = 0;
339 procedure OpenMap(FileName
: String; mapN
: String);
340 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
341 procedure RemoveSelectFromObjects();
342 procedure ChangeShownProperty(Name
: String; NewValue
: String);
347 f_options
, e_graphics
, e_log
, GL
, Math
,
348 f_mapoptions
, g_basic
, f_about
, f_mapoptimization
,
349 f_mapcheck
, f_addresource_texture
, g_textures
,
350 f_activationtype
, f_keys
, wadreader
, fileutil
,
351 MAPREADER
, f_selectmap
, f_savemap
, WADEDITOR
, MAPDEF
,
352 g_map
, f_saveminimap
, f_addresource
, CONFIG
, f_packmap
,
353 f_addresource_sound
, f_choosetype
,
354 g_language
, ClipBrd
, g_resources
, g_options
;
357 UNDO_DELETE_PANEL
= 1;
358 UNDO_DELETE_ITEM
= 2;
359 UNDO_DELETE_AREA
= 3;
360 UNDO_DELETE_MONSTER
= 4;
361 UNDO_DELETE_TRIGGER
= 5;
365 UNDO_ADD_MONSTER
= 9;
366 UNDO_ADD_TRIGGER
= 10;
367 UNDO_MOVE_PANEL
= 11;
370 UNDO_MOVE_MONSTER
= 14;
371 UNDO_MOVE_TRIGGER
= 15;
372 UNDO_RESIZE_PANEL
= 16;
373 UNDO_RESIZE_TRIGGER
= 17;
375 MOUSEACTION_NONE
= 0;
376 MOUSEACTION_DRAWPANEL
= 1;
377 MOUSEACTION_DRAWTRIGGER
= 2;
378 MOUSEACTION_MOVEOBJ
= 3;
379 MOUSEACTION_RESIZE
= 4;
380 MOUSEACTION_MOVEMAP
= 5;
381 MOUSEACTION_DRAWPRESS
= 6;
382 MOUSEACTION_NOACTION
= 7;
385 RESIZETYPE_VERTICAL
= 1;
386 RESIZETYPE_HORIZONTAL
= 2;
395 SELECTFLAG_TELEPORT
= 1;
397 SELECTFLAG_TEXTURE
= 3;
399 SELECTFLAG_MONSTER
= 5;
400 SELECTFLAG_SPAWNPOINT
= 6;
401 SELECTFLAG_SHOTPANEL
= 7;
402 SELECTFLAG_SELECTED
= 8;
404 RECENT_FILES_MENU_START
= 12;
406 CLIPBOARD_SIG
= 'DF:ED';
410 case UndoType
: Byte of
411 UNDO_DELETE_PANEL
: (Panel
: ^TPanel
);
412 UNDO_DELETE_ITEM
: (Item
: TItem
);
413 UNDO_DELETE_AREA
: (Area
: TArea
);
414 UNDO_DELETE_MONSTER
: (Monster
: TMonster
);
415 UNDO_DELETE_TRIGGER
: (Trigger
: TTrigger
);
420 UNDO_ADD_TRIGGER
: (AddID
: DWORD
);
425 UNDO_MOVE_TRIGGER
: (MoveID
: DWORD
; dX
, dY
: Integer);
427 UNDO_RESIZE_TRIGGER
: (ResizeID
: DWORD
; dW
, dH
: Integer);
432 case ObjectType
: Byte of
433 OBJECT_PANEL
: (Panel
: ^TPanel
);
434 OBJECT_ITEM
: (Item
: TItem
);
435 OBJECT_AREA
: (Area
: TArea
);
436 OBJECT_MONSTER
: (Monster
: TMonster
);
437 OBJECT_TRIGGER
: (Trigger
: TTrigger
);
440 TCopyRecArray
= Array of TCopyRec
;
444 gDataLoaded
: Boolean = False;
445 ShowMap
: Boolean = False;
446 DrawRect
: PRect
= nil;
447 SnapToGrid
: Boolean = True;
449 MousePos
: Types
.TPoint
;
450 LastMovePoint
: Types
.TPoint
;
454 MouseLDownPos
: Types
.TPoint
;
455 MouseRDownPos
: Types
.TPoint
;
456 MouseMDownPos
: Types
.TPoint
;
458 SelectFlag
: Byte = SELECTFLAG_NONE
;
459 MouseAction
: Byte = MOUSEACTION_NONE
;
460 ResizeType
: Byte = RESIZETYPE_NONE
;
461 ResizeDirection
: Byte = RESIZEDIR_NONE
;
463 DrawPressRect
: Boolean = False;
464 EditingProperties
: Boolean = False;
466 UndoBuffer
: Array of Array of TUndoRec
= nil;
468 MapTestProcess
: TProcessUTF8
;
473 //----------------------------------------
474 //Далее идут вспомогательные процедуры
475 //----------------------------------------
477 function NameToBool(Name
: String): Boolean;
479 if Name
= BoolNames
[True] then
485 function NameToDir(Name
: String): TDirection
;
487 if Name
= DirNames
[D_LEFT
] then
493 function NameToDirAdv(Name
: String): Byte;
495 if Name
= DirNamesAdv
[1] then
498 if Name
= DirNamesAdv
[2] then
501 if Name
= DirNamesAdv
[3] then
507 function ActivateToStr(ActivateType
: Byte): String;
511 if ByteBool(ACTIVATE_PLAYERCOLLIDE
and ActivateType
) then
512 Result
:= Result
+ '+PC';
513 if ByteBool(ACTIVATE_MONSTERCOLLIDE
and ActivateType
) then
514 Result
:= Result
+ '+MC';
515 if ByteBool(ACTIVATE_PLAYERPRESS
and ActivateType
) then
516 Result
:= Result
+ '+PP';
517 if ByteBool(ACTIVATE_MONSTERPRESS
and ActivateType
) then
518 Result
:= Result
+ '+MP';
519 if ByteBool(ACTIVATE_SHOT
and ActivateType
) then
520 Result
:= Result
+ '+SH';
521 if ByteBool(ACTIVATE_NOMONSTER
and ActivateType
) then
522 Result
:= Result
+ '+NM';
524 if (Result
<> '') and (Result
[1] = '+') then
525 Delete(Result
, 1, 1);
528 function StrToActivate(Str
: String): Byte;
532 if Pos('PC', Str
) > 0 then
533 Result
:= ACTIVATE_PLAYERCOLLIDE
;
534 if Pos('MC', Str
) > 0 then
535 Result
:= Result
or ACTIVATE_MONSTERCOLLIDE
;
536 if Pos('PP', Str
) > 0 then
537 Result
:= Result
or ACTIVATE_PLAYERPRESS
;
538 if Pos('MP', Str
) > 0 then
539 Result
:= Result
or ACTIVATE_MONSTERPRESS
;
540 if Pos('SH', Str
) > 0 then
541 Result
:= Result
or ACTIVATE_SHOT
;
542 if Pos('NM', Str
) > 0 then
543 Result
:= Result
or ACTIVATE_NOMONSTER
;
546 function KeyToStr(Key
: Byte): String;
550 if ByteBool(KEY_RED
and Key
) then
551 Result
:= Result
+ '+RK';
552 if ByteBool(KEY_GREEN
and Key
) then
553 Result
:= Result
+ '+GK';
554 if ByteBool(KEY_BLUE
and Key
) then
555 Result
:= Result
+ '+BK';
556 if ByteBool(KEY_REDTEAM
and Key
) then
557 Result
:= Result
+ '+RT';
558 if ByteBool(KEY_BLUETEAM
and Key
) then
559 Result
:= Result
+ '+BT';
561 if (Result
<> '') and (Result
[1] = '+') then
562 Delete(Result
, 1, 1);
565 function StrToKey(Str
: String): Byte;
569 if Pos('RK', Str
) > 0 then
571 if Pos('GK', Str
) > 0 then
572 Result
:= Result
or KEY_GREEN
;
573 if Pos('BK', Str
) > 0 then
574 Result
:= Result
or KEY_BLUE
;
575 if Pos('RT', Str
) > 0 then
576 Result
:= Result
or KEY_REDTEAM
;
577 if Pos('BT', Str
) > 0 then
578 Result
:= Result
or KEY_BLUETEAM
;
581 function EffectToStr(Effect
: Byte): String;
583 if Effect
in [EFFECT_TELEPORT
..EFFECT_FIRE
] then
584 Result
:= EffectNames
[Effect
]
586 Result
:= EffectNames
[EFFECT_NONE
];
589 function StrToEffect(Str
: String): Byte;
593 Result
:= EFFECT_NONE
;
594 for i
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
595 if EffectNames
[i
] = Str
then
602 function MonsterToStr(MonType
: Byte): String;
604 if MonType
in [MONSTER_DEMON
..MONSTER_MAN
] then
605 Result
:= MonsterNames
[MonType
]
607 Result
:= MonsterNames
[MONSTER_ZOMBY
];
610 function StrToMonster(Str
: String): Byte;
614 Result
:= MONSTER_ZOMBY
;
615 for i
:= MONSTER_DEMON
to MONSTER_MAN
do
616 if MonsterNames
[i
] = Str
then
623 function ItemToStr(ItemType
: Byte): String;
625 if ItemType
in [ITEM_MEDKIT_SMALL
..ITEM_MAX
] then
626 Result
:= ItemNames
[ItemType
]
628 Result
:= ItemNames
[ITEM_AMMO_BULLETS
];
631 function StrToItem(Str
: String): Byte;
635 Result
:= ITEM_AMMO_BULLETS
;
636 for i
:= ITEM_MEDKIT_SMALL
to ITEM_MAX
do
637 if ItemNames
[i
] = Str
then
644 function ShotToStr(ShotType
: Byte): String;
646 if ShotType
in [TRIGGER_SHOT_PISTOL
..TRIGGER_SHOT_MAX
] then
647 Result
:= ShotNames
[ShotType
]
649 Result
:= ShotNames
[TRIGGER_SHOT_PISTOL
];
652 function StrToShot(Str
: String): Byte;
656 Result
:= TRIGGER_SHOT_PISTOL
;
657 for i
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
658 if ShotNames
[i
] = Str
then
665 function SelectedObjectCount(): Word;
671 if SelectedObjects
= nil then
674 for a
:= 0 to High(SelectedObjects
) do
675 if SelectedObjects
[a
].Live
then
676 Result
:= Result
+ 1;
679 function GetFirstSelected(): Integer;
685 if SelectedObjects
= nil then
688 for a
:= 0 to High(SelectedObjects
) do
689 if SelectedObjects
[a
].Live
then
696 function Normalize16(x
: Integer): Integer;
698 Result
:= (x
div 16) * 16;
701 procedure MoveMap(X
, Y
: Integer);
703 rx
, ry
, ScaleSz
: Integer;
705 with MainForm
.RenderPanel
do
707 ScaleSz
:= 16 div Scale
;
708 // Размер видимой части карты:
709 rx
:= Min(Normalize16(Width
), Normalize16(gMapInfo
.Width
)) div 2;
710 ry
:= Min(Normalize16(Height
), Normalize16(gMapInfo
.Height
)) div 2;
711 // Место клика на мини-карте:
712 MapOffset
.X
:= X
- (Width
- Max(gMapInfo
.Width
div ScaleSz
, 1) - 1);
713 MapOffset
.Y
:= Y
- 1;
714 // Это же место на "большой" карте:
715 MapOffset
.X
:= MapOffset
.X
* ScaleSz
;
716 MapOffset
.Y
:= MapOffset
.Y
* ScaleSz
;
717 // Левый верхний угол новой видимой части карты:
718 MapOffset
.X
:= MapOffset
.X
- rx
;
719 MapOffset
.Y
:= MapOffset
.Y
- ry
;
721 MapOffset
.X
:= EnsureRange(MapOffset
.X
, MainForm
.sbHorizontal
.Min
, MainForm
.sbHorizontal
.Max
);
722 MapOffset
.Y
:= EnsureRange(MapOffset
.Y
, MainForm
.sbVertical
.Min
, MainForm
.sbVertical
.Max
);
724 // MapOffset.X := Normalize16(MapOffset.X);
725 // MapOffset.Y := Normalize16(MapOffset.Y);
728 MainForm
.sbHorizontal
.Position
:= MapOffset
.X
;
729 MainForm
.sbVertical
.Position
:= MapOffset
.Y
;
731 MapOffset
.X
:= -MapOffset
.X
;
732 MapOffset
.Y
:= -MapOffset
.Y
;
737 function IsTexturedPanel(PanelType
: Word): Boolean;
739 Result
:= WordBool(PanelType
and (PANEL_WALL
or PANEL_BACK
or PANEL_FORE
or
740 PANEL_STEP
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
or
741 PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
));
744 procedure FillProperty();
749 MainForm
.vleObjectProperty
.Strings
.Clear();
750 MainForm
.RecountSelectedObjects();
752 // Отображаем свойства если выделен только один объект:
753 if SelectedObjectCount() <> 1 then
756 _id
:= GetFirstSelected();
757 if not SelectedObjects
[_id
].Live
then
760 with MainForm
.vleObjectProperty
do
761 with ItemProps
[InsertRow(MsgPropId
, IntToStr(SelectedObjects
[_id
].ID
), True)] do
763 EditStyle
:= esSimple
;
767 case SelectedObjects
[0].ObjectType
of
770 with MainForm
.vleObjectProperty
,
771 gPanels
[SelectedObjects
[_id
].ID
] do
773 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
775 EditStyle
:= esSimple
;
779 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
781 EditStyle
:= esSimple
;
785 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
787 EditStyle
:= esSimple
;
791 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
793 EditStyle
:= esSimple
;
797 with ItemProps
[InsertRow(MsgPropPanelType
, GetPanelName(PanelType
), True)] do
799 EditStyle
:= esEllipsis
;
803 if IsTexturedPanel(PanelType
) then
804 begin // Может быть текстура
805 with ItemProps
[InsertRow(MsgPropPanelTex
, TextureName
, True)] do
807 EditStyle
:= esEllipsis
;
811 if TextureName
<> '' then
812 begin // Есть текстура
813 with ItemProps
[InsertRow(MsgPropPanelAlpha
, IntToStr(Alpha
), True)] do
815 EditStyle
:= esSimple
;
819 with ItemProps
[InsertRow(MsgPropPanelBlend
, BoolNames
[Blending
], True)] do
821 EditStyle
:= esPickList
;
831 with MainForm
.vleObjectProperty
,
832 gItems
[SelectedObjects
[_id
].ID
] do
834 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
836 EditStyle
:= esSimple
;
840 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
842 EditStyle
:= esSimple
;
846 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[OnlyDM
], True)] do
848 EditStyle
:= esPickList
;
852 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Fall
], True)] do
854 EditStyle
:= esPickList
;
862 with MainForm
.vleObjectProperty
,
863 gMonsters
[SelectedObjects
[_id
].ID
] do
865 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
867 EditStyle
:= esSimple
;
871 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
873 EditStyle
:= esSimple
;
877 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
879 EditStyle
:= esPickList
;
887 with MainForm
.vleObjectProperty
,
888 gAreas
[SelectedObjects
[_id
].ID
] do
890 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
892 EditStyle
:= esSimple
;
896 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
898 EditStyle
:= esSimple
;
902 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
904 EditStyle
:= esPickList
;
912 with MainForm
.vleObjectProperty
,
913 gTriggers
[SelectedObjects
[_id
].ID
] do
915 with ItemProps
[InsertRow(MsgPropTrType
, GetTriggerName(TriggerType
), True)] do
917 EditStyle
:= esSimple
;
921 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
923 EditStyle
:= esSimple
;
927 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
929 EditStyle
:= esSimple
;
933 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
935 EditStyle
:= esSimple
;
939 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
941 EditStyle
:= esSimple
;
945 with ItemProps
[InsertRow(MsgPropTrEnabled
, BoolNames
[Enabled
], True)] do
947 EditStyle
:= esPickList
;
951 with ItemProps
[InsertRow(MsgPropTrTexturePanel
, IntToStr(TexturePanel
), True)] do
953 EditStyle
:= esEllipsis
;
957 with ItemProps
[InsertRow(MsgPropTrActivation
, ActivateToStr(ActivateType
), True)] do
959 EditStyle
:= esEllipsis
;
963 with ItemProps
[InsertRow(MsgPropTrKeys
, KeyToStr(Key
), True)] do
965 EditStyle
:= esEllipsis
;
972 str
:= win2utf(Data
.MapName
);
973 with ItemProps
[InsertRow(MsgPropTrNextMap
, str
, True)] do
975 EditStyle
:= esEllipsis
;
982 with ItemProps
[InsertRow(MsgPropTrTeleportTo
, Format('(%d:%d)', [Data
.TargetPoint
.X
, Data
.TargetPoint
.Y
]), True)] do
984 EditStyle
:= esEllipsis
;
988 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_teleport
], True)] do
990 EditStyle
:= esPickList
;
994 with ItemProps
[InsertRow(MsgPropTrTeleportSilent
, BoolNames
[Data
.silent_teleport
], True)] do
996 EditStyle
:= esPickList
;
1000 with ItemProps
[InsertRow(MsgPropTrTeleportDir
, DirNamesAdv
[Data
.TlpDir
], True)] do
1002 EditStyle
:= esPickList
;
1007 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
,
1008 TRIGGER_DOOR
, TRIGGER_DOOR5
:
1010 with ItemProps
[InsertRow(MsgPropTrDoorPanel
, IntToStr(Data
.PanelID
), True)] do
1012 EditStyle
:= esEllipsis
;
1016 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1018 EditStyle
:= esPickList
;
1022 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1024 EditStyle
:= esPickList
;
1029 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
:
1031 with ItemProps
[InsertRow(MsgPropTrTrapPanel
, IntToStr(Data
.PanelID
), True)] do
1033 EditStyle
:= esEllipsis
;
1037 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1039 EditStyle
:= esPickList
;
1043 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1045 EditStyle
:= esPickList
;
1050 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
1053 with ItemProps
[InsertRow(MsgPropTrExArea
,
1054 Format('(%d:%d %d:%d)', [Data
.tX
, Data
.tY
, Data
.tWidth
, Data
.tHeight
]), True)] do
1056 EditStyle
:= esEllipsis
;
1060 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.Wait
), True)] do
1062 EditStyle
:= esSimple
;
1066 with ItemProps
[InsertRow(MsgPropTrExCount
, IntToStr(Data
.Count
), True)] do
1068 EditStyle
:= esSimple
;
1072 with ItemProps
[InsertRow(MsgPropTrExMonster
, IntToStr(Data
.MonsterID
-1), True)] do
1074 EditStyle
:= esEllipsis
;
1078 if TriggerType
= TRIGGER_PRESS
then
1079 with ItemProps
[InsertRow(MsgPropTrExRandom
, BoolNames
[Data
.ExtRandom
], True)] do
1081 EditStyle
:= esPickList
;
1089 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
1091 with ItemProps
[InsertRow(MsgPropTrLiftPanel
, IntToStr(Data
.PanelID
), True)] do
1093 EditStyle
:= esEllipsis
;
1097 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1099 EditStyle
:= esPickList
;
1103 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1105 EditStyle
:= esPickList
;
1112 with ItemProps
[InsertRow(MsgPropTrTextureOnce
, BoolNames
[Data
.ActivateOnce
], True)] do
1114 EditStyle
:= esPickList
;
1118 with ItemProps
[InsertRow(MsgPropTrTextureAnimOnce
, BoolNames
[Data
.AnimOnce
], True)] do
1120 EditStyle
:= esPickList
;
1127 str
:= win2utf(Data
.SoundName
);
1128 with ItemProps
[InsertRow(MsgPropTrSoundName
, str
, True)] do
1130 EditStyle
:= esEllipsis
;
1134 with ItemProps
[InsertRow(MsgPropTrSoundVolume
, IntToStr(Data
.Volume
), True)] do
1136 EditStyle
:= esSimple
;
1140 with ItemProps
[InsertRow(MsgPropTrSoundPan
, IntToStr(Data
.Pan
), True)] do
1142 EditStyle
:= esSimple
;
1146 with ItemProps
[InsertRow(MsgPropTrSoundCount
, IntToStr(Data
.PlayCount
), True)] do
1148 EditStyle
:= esSimple
;
1152 with ItemProps
[InsertRow(MsgPropTrSoundLocal
, BoolNames
[Data
.Local
], True)] do
1154 EditStyle
:= esPickList
;
1158 with ItemProps
[InsertRow(MsgPropTrSoundSwitch
, BoolNames
[Data
.SoundSwitch
], True)] do
1160 EditStyle
:= esPickList
;
1165 TRIGGER_SPAWNMONSTER
:
1167 with ItemProps
[InsertRow(MsgPropTrMonsterType
, MonsterToStr(Data
.MonType
), True)] do
1169 EditStyle
:= esEllipsis
;
1173 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1174 Format('(%d:%d)', [Data
.MonPos
.X
, Data
.MonPos
.Y
]), True)] do
1176 EditStyle
:= esEllipsis
;
1180 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[TDirection(Data
.MonDir
)], True)] do
1182 EditStyle
:= esPickList
;
1186 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.MonHealth
), True)] do
1188 EditStyle
:= esSimple
;
1192 with ItemProps
[InsertRow(MsgPropTrMonsterActive
, BoolNames
[Data
.MonActive
], True)] do
1194 EditStyle
:= esPickList
;
1198 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.MonCount
), True)] do
1200 EditStyle
:= esSimple
;
1204 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.MonEffect
), True)] do
1206 EditStyle
:= esEllipsis
;
1210 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.MonMax
), True)] do
1212 EditStyle
:= esSimple
;
1216 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.MonDelay
), True)] do
1218 EditStyle
:= esSimple
;
1222 case Data
.MonBehav
of
1223 1: str
:= MsgPropTrMonsterBehaviour1
;
1224 2: str
:= MsgPropTrMonsterBehaviour2
;
1225 3: str
:= MsgPropTrMonsterBehaviour3
;
1226 4: str
:= MsgPropTrMonsterBehaviour4
;
1227 5: str
:= MsgPropTrMonsterBehaviour5
;
1228 else str
:= MsgPropTrMonsterBehaviour0
;
1230 with ItemProps
[InsertRow(MsgPropTrMonsterBehaviour
, str
, True)] do
1232 EditStyle
:= esPickList
;
1239 with ItemProps
[InsertRow(MsgPropTrItemType
, ItemToStr(Data
.ItemType
), True)] do
1241 EditStyle
:= esEllipsis
;
1245 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1246 Format('(%d:%d)', [Data
.ItemPos
.X
, Data
.ItemPos
.Y
]), True)] do
1248 EditStyle
:= esEllipsis
;
1252 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[Data
.ItemOnlyDM
], True)] do
1254 EditStyle
:= esPickList
;
1258 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Data
.ItemFalls
], True)] do
1260 EditStyle
:= esPickList
;
1264 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ItemCount
), True)] do
1266 EditStyle
:= esSimple
;
1270 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.ItemEffect
), True)] do
1272 EditStyle
:= esEllipsis
;
1276 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.ItemMax
), True)] do
1278 EditStyle
:= esSimple
;
1282 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.ItemDelay
), True)] do
1284 EditStyle
:= esSimple
;
1291 str
:= win2utf(Data
.MusicName
);
1292 with ItemProps
[InsertRow(MsgPropTrMusicName
, str
, True)] do
1294 EditStyle
:= esEllipsis
;
1298 if Data
.MusicAction
= 1 then
1299 str
:= MsgPropTrMusicOn
1301 str
:= MsgPropTrMusicOff
;
1303 with ItemProps
[InsertRow(MsgPropTrMusicAct
, str
, True)] do
1305 EditStyle
:= esPickList
;
1312 with ItemProps
[InsertRow(MsgPropTrPushAngle
, IntToStr(Data
.PushAngle
), True)] do
1314 EditStyle
:= esSimple
;
1317 with ItemProps
[InsertRow(MsgPropTrPushForce
, IntToStr(Data
.PushForce
), True)] do
1319 EditStyle
:= esSimple
;
1322 with ItemProps
[InsertRow(MsgPropTrPushReset
, BoolNames
[Data
.ResetVel
], True)] do
1324 EditStyle
:= esPickList
;
1331 case Data
.ScoreAction
of
1332 1: str
:= MsgPropTrScoreAct1
;
1333 2: str
:= MsgPropTrScoreAct2
;
1334 3: str
:= MsgPropTrScoreAct3
;
1335 else str
:= MsgPropTrScoreAct0
;
1337 with ItemProps
[InsertRow(MsgPropTrScoreAct
, str
, True)] do
1339 EditStyle
:= esPickList
;
1342 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ScoreCount
), True)] do
1344 EditStyle
:= esSimple
;
1347 case Data
.ScoreTeam
of
1348 1: str
:= MsgPropTrScoreTeam1
;
1349 2: str
:= MsgPropTrScoreTeam2
;
1350 3: str
:= MsgPropTrScoreTeam3
;
1351 else str
:= MsgPropTrScoreTeam0
;
1353 with ItemProps
[InsertRow(MsgPropTrScoreTeam
, str
, True)] do
1355 EditStyle
:= esPickList
;
1358 with ItemProps
[InsertRow(MsgPropTrScoreCon
, BoolNames
[Data
.ScoreCon
], True)] do
1360 EditStyle
:= esPickList
;
1363 with ItemProps
[InsertRow(MsgPropTrScoreMsg
, BoolNames
[Data
.ScoreMsg
], True)] do
1365 EditStyle
:= esPickList
;
1372 case Data
.MessageKind
of
1373 1: str
:= MsgPropTrMessageKind1
;
1374 else str
:= MsgPropTrMessageKind0
;
1376 with ItemProps
[InsertRow(MsgPropTrMessageKind
, str
, True)] do
1378 EditStyle
:= esPickList
;
1381 case Data
.MessageSendTo
of
1382 1: str
:= MsgPropTrMessageTo1
;
1383 2: str
:= MsgPropTrMessageTo2
;
1384 3: str
:= MsgPropTrMessageTo3
;
1385 4: str
:= MsgPropTrMessageTo4
;
1386 5: str
:= MsgPropTrMessageTo5
;
1387 else str
:= MsgPropTrMessageTo0
;
1389 with ItemProps
[InsertRow(MsgPropTrMessageTo
, str
, True)] do
1391 EditStyle
:= esPickList
;
1394 str
:= win2utf(Data
.MessageText
);
1395 with ItemProps
[InsertRow(MsgPropTrMessageText
, str
, True)] do
1397 EditStyle
:= esSimple
;
1400 with ItemProps
[InsertRow(MsgPropTrMessageTime
, IntToStr(Data
.MessageTime
), True)] do
1402 EditStyle
:= esSimple
;
1409 with ItemProps
[InsertRow(MsgPropTrDamageValue
, IntToStr(Data
.DamageValue
), True)] do
1411 EditStyle
:= esSimple
;
1414 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.DamageInterval
), True)] do
1416 EditStyle
:= esSimple
;
1419 case Data
.DamageKind
of
1420 3: str
:= MsgPropTrDamageKind3
;
1421 4: str
:= MsgPropTrDamageKind4
;
1422 5: str
:= MsgPropTrDamageKind5
;
1423 6: str
:= MsgPropTrDamageKind6
;
1424 7: str
:= MsgPropTrDamageKind7
;
1425 8: str
:= MsgPropTrDamageKind8
;
1426 else str
:= MsgPropTrDamageKind0
;
1428 with ItemProps
[InsertRow(MsgPropTrDamageKind
, str
, True)] do
1430 EditStyle
:= esPickList
;
1437 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.HealValue
), True)] do
1439 EditStyle
:= esSimple
;
1442 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.HealInterval
), True)] do
1444 EditStyle
:= esSimple
;
1447 with ItemProps
[InsertRow(MsgPropTrHealthMax
, BoolNames
[Data
.HealMax
], True)] do
1449 EditStyle
:= esPickList
;
1452 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.HealSilent
], True)] do
1454 EditStyle
:= esPickList
;
1461 with ItemProps
[InsertRow(MsgPropTrShotType
, ShotToStr(Data
.ShotType
), True)] do
1463 EditStyle
:= esEllipsis
;
1467 with ItemProps
[InsertRow(MsgPropTrShotSound
, BoolNames
[Data
.ShotSound
], True)] do
1469 EditStyle
:= esPickList
;
1473 with ItemProps
[InsertRow(MsgPropTrShotPanel
, IntToStr(Data
.ShotPanelID
), True)] do
1475 EditStyle
:= esEllipsis
;
1479 case Data
.ShotTarget
of
1480 1: str
:= MsgPropTrShotTo1
;
1481 2: str
:= MsgPropTrShotTo2
;
1482 3: str
:= MsgPropTrShotTo3
;
1483 4: str
:= MsgPropTrShotTo4
;
1484 5: str
:= MsgPropTrShotTo5
;
1485 6: str
:= MsgPropTrShotTo6
;
1486 else str
:= MsgPropTrShotTo0
;
1488 with ItemProps
[InsertRow(MsgPropTrShotTo
, str
, True)] do
1490 EditStyle
:= esPickList
;
1494 with ItemProps
[InsertRow(MsgPropTrShotSight
, IntToStr(Data
.ShotIntSight
), True)] do
1496 EditStyle
:= esSimple
;
1500 case Data
.ShotAim
of
1501 1: str
:= MsgPropTrShotAim1
;
1502 2: str
:= MsgPropTrShotAim2
;
1503 3: str
:= MsgPropTrShotAim3
;
1504 else str
:= MsgPropTrShotAim0
;
1506 with ItemProps
[InsertRow(MsgPropTrShotAim
, str
, True)] do
1508 EditStyle
:= esPickList
;
1512 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1513 Format('(%d:%d)', [Data
.ShotPos
.X
, Data
.ShotPos
.Y
]), True)] do
1515 EditStyle
:= esEllipsis
;
1519 with ItemProps
[InsertRow(MsgPropTrShotAngle
, IntToStr(Data
.ShotAngle
), True)] do
1521 EditStyle
:= esSimple
;
1525 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.ShotWait
), True)] do
1527 EditStyle
:= esSimple
;
1531 with ItemProps
[InsertRow(MsgPropTrShotAcc
, IntToStr(Data
.ShotAccuracy
), True)] do
1533 EditStyle
:= esSimple
;
1537 with ItemProps
[InsertRow(MsgPropTrShotAmmo
, IntToStr(Data
.ShotAmmo
), True)] do
1539 EditStyle
:= esSimple
;
1543 with ItemProps
[InsertRow(MsgPropTrShotReload
, IntToStr(Data
.ShotIntReload
), True)] do
1545 EditStyle
:= esSimple
;
1552 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.FXCount
), True)] do
1554 EditStyle
:= esSimple
;
1558 if Data
.FXType
= 0 then
1559 str
:= MsgPropTrEffectParticle
1561 str
:= MsgPropTrEffectAnimation
;
1562 with ItemProps
[InsertRow(MsgPropTrEffectType
, str
, True)] do
1564 EditStyle
:= esEllipsis
;
1569 if Data
.FXType
= 0 then
1570 case Data
.FXSubType
of
1571 TRIGGER_EFFECT_SLIQUID
:
1572 str
:= MsgPropTrEffectSliquid
;
1573 TRIGGER_EFFECT_LLIQUID
:
1574 str
:= MsgPropTrEffectLliquid
;
1575 TRIGGER_EFFECT_DLIQUID
:
1576 str
:= MsgPropTrEffectDliquid
;
1577 TRIGGER_EFFECT_BLOOD
:
1578 str
:= MsgPropTrEffectBlood
;
1579 TRIGGER_EFFECT_SPARK
:
1580 str
:= MsgPropTrEffectSpark
;
1581 TRIGGER_EFFECT_BUBBLE
:
1582 str
:= MsgPropTrEffectBubble
;
1584 if Data
.FXType
= 1 then
1586 if (Data
.FXSubType
= 0) or (Data
.FXSubType
> EFFECT_FIRE
) then
1587 Data
.FXSubType
:= EFFECT_TELEPORT
;
1588 str
:= EffectToStr(Data
.FXSubType
);
1590 with ItemProps
[InsertRow(MsgPropTrEffectSubtype
, str
, True)] do
1592 EditStyle
:= esEllipsis
;
1596 with ItemProps
[InsertRow(MsgPropTrEffectColor
, IntToStr(Data
.FXColorR
or (Data
.FXColorG
shl 8) or (Data
.FXColorB
shl 16)), True)] do
1598 EditStyle
:= esEllipsis
;
1602 with ItemProps
[InsertRow(MsgPropTrEffectCenter
, BoolNames
[Data
.FXPos
= 0], True)] do
1604 EditStyle
:= esPickList
;
1608 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.FXWait
), True)] do
1610 EditStyle
:= esSimple
;
1614 with ItemProps
[InsertRow(MsgPropTrEffectVelx
, IntToStr(Data
.FXVelX
), True)] do
1616 EditStyle
:= esSimple
;
1620 with ItemProps
[InsertRow(MsgPropTrEffectVely
, IntToStr(Data
.FXVelY
), True)] do
1622 EditStyle
:= esSimple
;
1626 with ItemProps
[InsertRow(MsgPropTrEffectSpl
, IntToStr(Data
.FXSpreadL
), True)] do
1628 EditStyle
:= esSimple
;
1632 with ItemProps
[InsertRow(MsgPropTrEffectSpr
, IntToStr(Data
.FXSpreadR
), True)] do
1634 EditStyle
:= esSimple
;
1638 with ItemProps
[InsertRow(MsgPropTrEffectSpu
, IntToStr(Data
.FXSpreadU
), True)] do
1640 EditStyle
:= esSimple
;
1644 with ItemProps
[InsertRow(MsgPropTrEffectSpd
, IntToStr(Data
.FXSpreadD
), True)] do
1646 EditStyle
:= esSimple
;
1650 end; //case TriggerType
1652 end; // OBJECT_TRIGGER:
1656 procedure ChangeShownProperty(Name
: String; NewValue
: String);
1660 if SelectedObjectCount() <> 1 then
1662 if not SelectedObjects
[GetFirstSelected()].Live
then
1665 // Есть ли такой ключ:
1666 if MainForm
.vleObjectProperty
.FindRow(Name
, row
) then
1668 MainForm
.vleObjectProperty
.Values
[Name
] := NewValue
;
1672 procedure SelectObject(fObjectType
: Byte; fID
: DWORD
; Multi
: Boolean);
1681 // Уже выделен - убираем:
1682 if SelectedObjects
<> nil then
1683 for a
:= 0 to High(SelectedObjects
) do
1684 with SelectedObjects
[a
] do
1685 if Live
and (ID
= fID
) and
1686 (ObjectType
= fObjectType
) then
1695 SetLength(SelectedObjects
, Length(SelectedObjects
)+1);
1697 with SelectedObjects
[High(SelectedObjects
)] do
1699 ObjectType
:= fObjectType
;
1706 SetLength(SelectedObjects
, 1);
1708 with SelectedObjects
[0] do
1710 ObjectType
:= fObjectType
;
1716 MainForm
.miCopy
.Enabled
:= True;
1717 MainForm
.miCut
.Enabled
:= True;
1719 if fObjectType
= OBJECT_PANEL
then
1721 MainForm
.miToFore
.Enabled
:= True;
1722 MainForm
.miToBack
.Enabled
:= True;
1726 procedure RemoveSelectFromObjects();
1728 SelectedObjects
:= nil;
1729 DrawPressRect
:= False;
1730 MouseLDown
:= False;
1731 MouseRDown
:= False;
1732 MouseAction
:= MOUSEACTION_NONE
;
1733 SelectFlag
:= SELECTFLAG_NONE
;
1734 ResizeType
:= RESIZETYPE_NONE
;
1735 ResizeDirection
:= RESIZEDIR_NONE
;
1737 MainForm
.vleObjectProperty
.Strings
.Clear();
1739 MainForm
.miCopy
.Enabled
:= False;
1740 MainForm
.miCut
.Enabled
:= False;
1741 MainForm
.miToFore
.Enabled
:= False;
1742 MainForm
.miToBack
.Enabled
:= False;
1745 procedure DeleteSelectedObjects();
1750 if SelectedObjects
= nil then
1756 for a
:= 0 to High(SelectedObjects
) do
1757 with SelectedObjects
[a
] do
1762 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1763 i
:= High(UndoBuffer
);
1767 SetLength(UndoBuffer
[i
], Length(UndoBuffer
[i
])+1);
1768 ii
:= High(UndoBuffer
[i
]);
1773 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_PANEL
;
1774 New(UndoBuffer
[i
, ii
].Panel
);
1775 UndoBuffer
[i
, ii
].Panel
^ := gPanels
[ID
];
1779 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_ITEM
;
1780 UndoBuffer
[i
, ii
].Item
:= gItems
[ID
];
1784 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_AREA
;
1785 UndoBuffer
[i
, ii
].Area
:= gAreas
[ID
];
1789 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_TRIGGER
;
1790 UndoBuffer
[i
, ii
].Trigger
:= gTriggers
[ID
];
1794 RemoveObject(ID
, ObjectType
);
1797 RemoveSelectFromObjects();
1799 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1800 MainForm
.RecountSelectedObjects();
1803 procedure Undo_Add(ObjectType
: Byte; ID
: DWORD
; Group
: Boolean = False);
1807 if (not Group
) or (Length(UndoBuffer
) = 0) then
1808 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1809 SetLength(UndoBuffer
[High(UndoBuffer
)], Length(UndoBuffer
[High(UndoBuffer
)])+1);
1810 i
:= High(UndoBuffer
);
1811 ii
:= High(UndoBuffer
[i
]);
1815 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_PANEL
;
1817 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_ITEM
;
1819 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_MONSTER
;
1821 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_AREA
;
1823 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_TRIGGER
;
1826 UndoBuffer
[i
, ii
].AddID
:= ID
;
1828 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1831 procedure FullClear();
1833 RemoveSelectFromObjects();
1835 LoadSky(gMapInfo
.SkyName
);
1837 slInvalidTextures
.Clear();
1838 MapCheckForm
.lbErrorList
.Clear();
1839 MapCheckForm
.mErrorDescription
.Clear();
1841 MainForm
.miUndo
.Enabled
:= False;
1842 MainForm
.sbHorizontal
.Position
:= 0;
1843 MainForm
.sbVertical
.Position
:= 0;
1844 MainForm
.FormResize(nil);
1845 MainForm
.Caption
:= FormCaption
;
1850 procedure ErrorMessageBox(str
: String);
1852 Application
.MessageBox(PChar(str
), PChar(MsgMsgError
),
1853 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
1856 function CheckProperty(): Boolean;
1862 _id
:= GetFirstSelected();
1864 if SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
then
1865 with gPanels
[SelectedObjects
[_id
].ID
] do
1867 if TextureWidth
<> 0 then
1868 if StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 1) mod TextureWidth
<> 0 then
1870 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
1875 if TextureHeight
<> 0 then
1876 if StrToIntDef(Trim(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
]), 1) mod TextureHeight
<> 0 then
1878 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
1883 if IsTexturedPanel(PanelType
) and (TextureName
<> '') then
1884 if not (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropPanelAlpha
], -1) in [0..255]) then
1886 ErrorMessageBox(MsgMsgWrongAlpha
);
1891 if SelectedObjects
[_id
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
1892 if (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 0) <= 0) or
1893 (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
], 0) <= 0) then
1895 ErrorMessageBox(MsgMsgWrongSize
);
1899 if (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropX
]) = '') or
1900 (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropY
]) = '') then
1902 ErrorMessageBox(MsgMsgWrongXy
);
1909 procedure SelectTexture(ID
: Integer);
1911 MainForm
.lbTextureList
.ItemIndex
:= ID
;
1912 MainForm
.lbTextureListClick(nil);
1915 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
1917 a
, FrameLen
: Integer;
1920 ResourceName
: String;
1921 FullResourceName
: String;
1922 SectionName
: String;
1924 Width
, Height
: Word;
1932 if aSection
= '..' then
1935 SectionName
:= aSection
;
1938 aWAD
:= MsgWadSpecialMap
;
1940 if aWAD
= MsgWadSpecialMap
then
1942 g_ProcessResourceStr(OpenedMap
, @fn
, nil, nil);
1944 ResourceName
:= ':'+SectionName
+'\'+aTex
;
1947 if aWAD
= MsgWadSpecialTexs
then
1948 begin // Спец. текстуры
1950 ResourceName
:= aTex
;
1953 begin // Внешний WAD
1954 FileName
:= WadsDir
+ DirectorySeparator
+ aWAD
;
1955 ResourceName
:= aWAD
+':'+SectionName
+'\'+aTex
;
1960 // Есть ли уже такая текстура:
1961 for a
:= 0 to MainForm
.lbTextureList
.Items
.Count
-1 do
1962 if ResourceName
= MainForm
.lbTextureList
.Items
[a
] then
1965 ErrorMessageBox(Format(MsgMsgTextureAlready
,
1970 // Название ресурса <= 64 символов:
1971 if Length(ResourceName
) > 64 then
1974 ErrorMessageBox(Format(MsgMsgResName64
,
1982 if aWAD
= MsgWadSpecialTexs
then
1984 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1991 FullResourceName
:= FileName
+':'+SectionName
+'\'+aTex
;
1993 if IsAnim(FullResourceName
) then
1994 begin // Аним. текстура
1995 GetFrame(FullResourceName
, Data
, FrameLen
, Width
, Height
);
1997 if not g_CreateTextureMemorySize(Data
, FrameLen
, ResourceName
, 0, 0, Width
, Height
, 1) then
1999 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2001 else // Обычная текстура
2003 if not g_CreateTextureWAD(ResourceName
, FullResourceName
) then
2005 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2007 if (not ok
) and (slInvalidTextures
.IndexOf(ResourceName
) = -1) then
2009 slInvalidTextures
.Add(ResourceName
);
2012 if (a
> -1) and (not silent
) then
2019 procedure UpdateCaption(sMap
, sFile
, sRes
: String);
2022 if (sFile
= '') and (sRes
= '') and (sMap
= '') then
2023 Caption
:= FormCaption
2026 Caption
:= Format('%s - %s:%s', [FormCaption
, sFile
, sRes
])
2028 if (sFile
<> '') and (sRes
<> '') then
2029 Caption
:= Format('%s - %s (%s:%s)', [FormCaption
, sMap
, sFile
, sRes
])
2031 Caption
:= Format('%s - %s', [FormCaption
, sMap
]);
2034 procedure OpenMap(FileName
: String; mapN
: String);
2039 SelectMapForm
.Caption
:= MsgCapOpen
;
2040 SelectMapForm
.GetMaps(FileName
);
2042 if (FileName
= OpenedWAD
) and
2043 (OpenedMap
<> '') then
2045 MapName
:= OpenedMap
;
2046 while (Pos(':\', MapName
) > 0) do
2047 Delete(MapName
, 1, Pos(':\', MapName
) + 1);
2049 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(MapName
);
2050 SelectMapForm
.lbMapList
.ItemIndex
:= idx
;
2053 if SelectMapForm
.lbMapList
.Count
> 0 then
2054 SelectMapForm
.lbMapList
.ItemIndex
:= 0
2056 SelectMapForm
.lbMapList
.ItemIndex
:= -1;
2061 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(mapN
);
2065 if (SelectMapForm
.ShowModal() = mrOK
) and
2066 (SelectMapForm
.lbMapList
.ItemIndex
<> -1) then
2067 idx
:= SelectMapForm
.lbMapList
.ItemIndex
2072 MapName
:= SelectMapForm
.lbMapList
.Items
[idx
];
2078 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
2079 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
2080 pLoadProgress
.Show();
2082 OpenedMap
:= FileName
+':\'+MapName
;
2083 OpenedWAD
:= FileName
;
2085 idx
:= RecentFiles
.IndexOf(OpenedMap
);
2086 // Такая карта уже недавно открывалась:
2088 RecentFiles
.Delete(idx
);
2089 RecentFiles
.Insert(0, OpenedMap
);
2090 RefreshRecentMenu();
2094 pLoadProgress
.Hide();
2097 lbTextureList
.Sorted
:= True;
2098 lbTextureList
.Sorted
:= False;
2100 UpdateCaption(gMapInfo
.Name
, ExtractFileName(FileName
), MapName
);
2104 procedure MoveSelectedObjects(Wall
, alt
: Boolean; dx
, dy
: Integer);
2109 if SelectedObjects
= nil then
2116 for a
:= 0 to High(SelectedObjects
) do
2117 if SelectedObjects
[a
].Live
then
2119 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, dx
, 0) then
2122 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, 0, dy
) then
2125 if (not okX
) or (not okY
) then
2131 for a
:= 0 to High(SelectedObjects
) do
2132 if SelectedObjects
[a
].Live
then
2135 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, dx
, 0);
2138 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, 0, dy
);
2140 if alt
and (SelectedObjects
[a
].ObjectType
= OBJECT_TRIGGER
) then
2142 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_PRESS
,
2143 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
] then
2144 begin // Двигаем зону Расширителя
2146 gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
+dx
;
2148 gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
+dy
;
2151 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_TELEPORT
] then
2152 begin // Двигаем точку назначения Телепорта
2154 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
+dx
;
2156 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
+dy
;
2159 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNMONSTER
] then
2160 begin // Двигаем точку создания монстра
2162 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
+dx
;
2164 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
+dy
;
2167 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNITEM
] then
2168 begin // Двигаем точку создания предмета
2170 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
+dx
;
2172 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
+dy
;
2175 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SHOT
] then
2176 begin // Двигаем точку создания выстрела
2178 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
+dx
;
2180 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
+dy
;
2185 LastMovePoint
:= MousePos
;
2189 procedure ShowLayer(Layer
: Byte; show
: Boolean);
2191 LayerEnabled
[Layer
] := show
;
2196 MainForm
.miLayer1
.Checked
:= show
;
2197 MainForm
.miLayerP1
.Checked
:= show
;
2201 MainForm
.miLayer2
.Checked
:= show
;
2202 MainForm
.miLayerP2
.Checked
:= show
;
2206 MainForm
.miLayer3
.Checked
:= show
;
2207 MainForm
.miLayerP3
.Checked
:= show
;
2211 MainForm
.miLayer4
.Checked
:= show
;
2212 MainForm
.miLayerP4
.Checked
:= show
;
2216 MainForm
.miLayer5
.Checked
:= show
;
2217 MainForm
.miLayerP5
.Checked
:= show
;
2221 MainForm
.miLayer6
.Checked
:= show
;
2222 MainForm
.miLayerP6
.Checked
:= show
;
2226 MainForm
.miLayer7
.Checked
:= show
;
2227 MainForm
.miLayerP7
.Checked
:= show
;
2231 MainForm
.miLayer8
.Checked
:= show
;
2232 MainForm
.miLayerP8
.Checked
:= show
;
2236 MainForm
.miLayer9
.Checked
:= show
;
2237 MainForm
.miLayerP9
.Checked
:= show
;
2241 RemoveSelectFromObjects();
2244 procedure SwitchLayer(Layer
: Byte);
2246 ShowLayer(Layer
, not LayerEnabled
[Layer
]);
2249 procedure SwitchMap();
2251 ShowMap
:= not ShowMap
;
2252 MainForm
.tbShowMap
.Down
:= ShowMap
;
2253 MainForm
.miMiniMap
.Checked
:= ShowMap
;
2256 procedure ShowEdges();
2258 if drEdge
[3] < 255 then
2261 drEdge
[3] := gAlphaEdge
;
2262 MainForm
.miShowEdges
.Checked
:= drEdge
[3] <> 255;
2265 function SelectedTexture(): String;
2267 if MainForm
.lbTextureList
.ItemIndex
<> -1 then
2268 Result
:= MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]
2273 function IsSpecialTextureSel(): Boolean;
2275 Result
:= (MainForm
.lbTextureList
.ItemIndex
<> -1) and
2276 IsSpecialTexture(MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]);
2279 function CopyBufferToString(var CopyBuf
: TCopyRecArray
): String;
2284 procedure AddInt(x
: Integer);
2286 Res
:= Res
+ IntToStr(x
) + ' ';
2292 if Length(CopyBuf
) = 0 then
2295 Res
:= CLIPBOARD_SIG
+ ' ';
2297 for i
:= 0 to High(CopyBuf
) do
2299 if (CopyBuf
[i
].ObjectType
= OBJECT_PANEL
) and
2300 (CopyBuf
[i
].Panel
= nil) then
2304 AddInt(CopyBuf
[i
].ObjectType
);
2307 // Свойства объекта:
2308 case CopyBuf
[i
].ObjectType
of
2310 with CopyBuf
[i
].Panel
^ do
2317 Res
:= Res
+ '"' + TextureName
+ '" ';
2319 AddInt(IfThen(Blending
, 1, 0));
2323 with CopyBuf
[i
].Item
do
2328 AddInt(IfThen(OnlyDM
, 1, 0));
2329 AddInt(IfThen(Fall
, 1, 0));
2333 with CopyBuf
[i
].Monster
do
2335 AddInt(MonsterType
);
2338 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2342 with CopyBuf
[i
].Area
do
2347 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2351 with CopyBuf
[i
].Trigger
do
2353 AddInt(TriggerType
);
2358 AddInt(ActivateType
);
2360 AddInt(IfThen(Enabled
, 1, 0));
2361 AddInt(TexturePanel
);
2363 for j
:= 0 to 127 do
2364 AddInt(Data
.Default
[j
]);
2372 procedure StringToCopyBuffer(Str
: String; var CopyBuf
: TCopyRecArray
;
2377 function GetNext(): String;
2382 if Str
[1] = '"' then
2394 Result
:= Copy(Str
, 1, p
-1);
2410 Result
:= Copy(Str
, 1, p
-1);
2420 if GetNext() <> CLIPBOARD_SIG
then
2426 t
:= StrToIntDef(GetNext(), 0);
2428 if (t
< OBJECT_PANEL
) or (t
> OBJECT_TRIGGER
) or
2429 (GetNext() <> ';') then
2430 begin // Что-то не то => пропускаем:
2438 i
:= Length(CopyBuf
);
2439 SetLength(CopyBuf
, i
+ 1);
2441 CopyBuf
[i
].ObjectType
:= t
;
2442 CopyBuf
[i
].Panel
:= nil;
2444 // Свойства объекта:
2448 New(CopyBuf
[i
].Panel
);
2450 with CopyBuf
[i
].Panel
^ do
2452 PanelType
:= StrToIntDef(GetNext(), PANEL_WALL
);
2453 X
:= StrToIntDef(GetNext(), 0);
2454 Y
:= StrToIntDef(GetNext(), 0);
2455 pmin
.X
:= Min(X
, pmin
.X
);
2456 pmin
.Y
:= Min(Y
, pmin
.Y
);
2457 Width
:= StrToIntDef(GetNext(), 16);
2458 Height
:= StrToIntDef(GetNext(), 16);
2459 TextureName
:= GetNext();
2460 Alpha
:= StrToIntDef(GetNext(), 0);
2461 Blending
:= (GetNext() = '1');
2466 with CopyBuf
[i
].Item
do
2468 ItemType
:= StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL
);
2469 X
:= StrToIntDef(GetNext(), 0);
2470 Y
:= StrToIntDef(GetNext(), 0);
2471 pmin
.X
:= Min(X
, pmin
.X
);
2472 pmin
.Y
:= Min(Y
, pmin
.Y
);
2473 OnlyDM
:= (GetNext() = '1');
2474 Fall
:= (GetNext() = '1');
2478 with CopyBuf
[i
].Monster
do
2480 MonsterType
:= StrToIntDef(GetNext(), MONSTER_DEMON
);
2481 X
:= StrToIntDef(GetNext(), 0);
2482 Y
:= StrToIntDef(GetNext(), 0);
2483 pmin
.X
:= Min(X
, pmin
.X
);
2484 pmin
.Y
:= Min(Y
, pmin
.Y
);
2486 if GetNext() = '1' then
2489 Direction
:= D_RIGHT
;
2493 with CopyBuf
[i
].Area
do
2495 AreaType
:= StrToIntDef(GetNext(), AREA_PLAYERPOINT1
);
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 if GetNext() = '1' then
2503 Direction
:= D_RIGHT
;
2507 with CopyBuf
[i
].Trigger
do
2509 TriggerType
:= StrToIntDef(GetNext(), TRIGGER_EXIT
);
2510 X
:= StrToIntDef(GetNext(), 0);
2511 Y
:= StrToIntDef(GetNext(), 0);
2512 pmin
.X
:= Min(X
, pmin
.X
);
2513 pmin
.Y
:= Min(Y
, pmin
.Y
);
2514 Width
:= StrToIntDef(GetNext(), 16);
2515 Height
:= StrToIntDef(GetNext(), 16);
2516 ActivateType
:= StrToIntDef(GetNext(), 0);
2517 Key
:= StrToIntDef(GetNext(), 0);
2518 Enabled
:= (GetNext() = '1');
2519 TexturePanel
:= StrToIntDef(GetNext(), 0);
2521 for j
:= 0 to 127 do
2522 Data
.Default
[j
] := StrToIntDef(GetNext(), 0);
2527 pmin
.X
:= Min(Data
.TargetPoint
.X
, pmin
.X
);
2528 pmin
.Y
:= Min(Data
.TargetPoint
.Y
, pmin
.Y
);
2530 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
2532 pmin
.X
:= Min(Data
.tX
, pmin
.X
);
2533 pmin
.Y
:= Min(Data
.tY
, pmin
.Y
);
2535 TRIGGER_SPAWNMONSTER
:
2537 pmin
.X
:= Min(Data
.MonPos
.X
, pmin
.X
);
2538 pmin
.Y
:= Min(Data
.MonPos
.Y
, pmin
.Y
);
2542 pmin
.X
:= Min(Data
.ItemPos
.X
, pmin
.X
);
2543 pmin
.Y
:= Min(Data
.ItemPos
.Y
, pmin
.Y
);
2547 pmin
.X
:= Min(Data
.ShotPos
.X
, pmin
.X
);
2548 pmin
.Y
:= Min(Data
.ShotPos
.Y
, pmin
.Y
);
2556 //----------------------------------------
2557 //Закончились вспомогательные процедуры
2558 //----------------------------------------
2561 TRecentHandler
= class
2566 constructor Create (form
: TMainForm
; path
: String);
2567 procedure Execute (Sender
: TObject
);
2570 constructor TRecentHandler
.Create (form
: TMainForm
; path
: String);
2572 Assert(form
<> nil);
2577 procedure TRecentHandler
.Execute (Sender
: TObject
);
2580 fn
:= g_ExtractWadName(FPath
);
2581 if FileExists(fn
) then
2582 OpenMap(fn
, g_ExtractFilePathName(FPath
))
2584 Application
.MessageBox('', 'File not available anymore', MB_OK
);
2585 // if Application.MessageBox(PChar(MsgMsgDelRecentPromt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
2587 // RecentFiles.Delete(n);
2588 // RefreshRecentMenu();
2592 procedure TMainForm
.RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
2593 var i
: Integer; MI
: TMenuItem
; cb
: TMethod
; h
: TRecentHandler
; s
: AnsiString;
2595 Assert(menu
<> nil);
2597 Assert(start
<= menu
.Count
);
2599 // clear all recent entries from menu
2601 while i
< menu
.Count
do
2603 MI
:= menu
.Items
[i
];
2604 cb
:= TMethod(MI
.OnClick
);
2605 if cb
.Code
= @TRecentHandler
.Execute
then
2607 // this is recent menu entry
2608 // remove it and free callback handler
2609 h
:= TRecentHandler(cb
.Data
);
2618 // fill with a new ones
2619 for i
:= 0 to RecentFiles
.Count
- 1 do
2621 s
:= RecentFiles
[i
];
2622 h
:= TRecentHandler
.Create(self
, s
);
2623 MI
:= TMenuItem
.Create(menu
);
2624 MI
.Caption
:= Format(fmt
, [i
+ 1, g_ExtractWadNameNoPath(s
), g_ExtractFilePathName(s
)]);
2625 MI
.OnClick
:= h
.Execute
;
2626 menu
.Insert(start
+ i
, MI
);
2630 procedure TMainForm
.RefreshRecentMenu();
2633 while RecentFiles
.Count
> RecentCount
do
2634 RecentFiles
.Delete(RecentFiles
.Count
- 1);
2636 if miMacRecentSubMenu
.Visible
then
2638 // Reconstruct OSX-like recent list
2639 RefillRecentMenu(miMacRecentSubMenu
, 0, '%1:s - %2:s');
2640 miMacRecentEnd
.Enabled
:= RecentFiles
.Count
<> 0;
2641 miMacRecentEnd
.Visible
:= RecentFiles
.Count
<> 0;
2644 if miWinRecentStart
.Visible
then
2646 // Reconstruct Windows-like recent list
2647 start
:= miMenuFile
.IndexOf(miWinRecent
);
2648 if start
< 0 then start
:= miMenuFile
.Count
else start
:= start
+ 1;
2649 RefillRecentMenu(miMenuFile
, start
, '%0:d %1:s:%2:s');
2650 miWinRecent
.Enabled
:= False;
2651 miWinRecent
.Visible
:= RecentFiles
.Count
= 0;
2655 procedure TMainForm
.miMacRecentClearClick(Sender
: TObject
);
2657 RecentFiles
.Clear();
2658 RefreshRecentMenu();
2661 procedure TMainForm
.aEditorOptionsExecute(Sender
: TObject
);
2663 OptionsForm
.ShowModal();
2666 procedure LoadStdFont(cfgres
, texture
: string; var FontID
: DWORD
);
2676 g_ReadResource(GameWad
, 'FONTS', cfgres
, cfgdata
, cfglen
);
2677 if cfgdata
<> nil then
2679 if not g_CreateTextureWAD('FONT_STD', GameWad
+ ':FONTS\' + texture
) then
2680 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING
);
2682 config
:= TConfig
.CreateMem(cfgdata
, cfglen
);
2683 cwdt
:= Min(Max(config
.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2684 chgt
:= Min(Max(config
.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2685 spc
:= Min(Max(config
.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2687 if g_GetTexture('FONT_STD', ID
) then
2688 e_TextureFontBuild(ID
, FontID
, cwdt
, chgt
, spc
- 2);
2695 e_WriteLog('Could not load FONT_STD', MSG_WARNING
)
2699 procedure TMainForm
.FormCreate(Sender
: TObject
);
2708 miApple
.Enabled
:= True;
2709 miApple
.Visible
:= True;
2710 miMacRecentSubMenu
.Enabled
:= True;
2711 miMacRecentSubMenu
.Visible
:= True;
2712 miWinRecentStart
.Enabled
:= False;
2713 miWinRecentStart
.Visible
:= False;
2714 miWinRecent
.Enabled
:= False;
2715 miWinRecent
.Visible
:= False;
2716 miLine2
.Enabled
:= False;
2717 miLine2
.Visible
:= False;
2718 miExit
.Enabled
:= False;
2719 miExit
.Visible
:= False;
2720 miOptions
.Enabled
:= False;
2721 miOptions
.Visible
:= False;
2722 miMenuWindow
.Enabled
:= True;
2723 miMenuWindow
.Visible
:= True;
2724 miAbout
.Enabled
:= False;
2725 miAbout
.Visible
:= False;
2727 miApple
.Enabled
:= False;
2728 miApple
.Visible
:= False;
2729 miMacRecentSubMenu
.Enabled
:= False;
2730 miMacRecentSubMenu
.Visible
:= False;
2731 miWinRecentStart
.Enabled
:= True;
2732 miWinRecentStart
.Visible
:= True;
2733 miWinRecent
.Enabled
:= True;
2734 miWinRecent
.Visible
:= True;
2735 miLine2
.Enabled
:= True;
2736 miLine2
.Visible
:= True;
2737 miExit
.Enabled
:= True;
2738 miExit
.Visible
:= True;
2739 miOptions
.Enabled
:= True;
2740 miOptions
.Visible
:= True;
2741 miMenuWindow
.Enabled
:= False;
2742 miMenuWindow
.Visible
:= False;
2743 miAbout
.Enabled
:= True;
2744 miAbout
.Visible
:= True;
2747 miNewMap
.ShortCut
:= ShortCut(VK_N
, [ssModifier
]);
2748 miOpenMap
.ShortCut
:= ShortCut(VK_O
, [ssModifier
]);
2749 miSaveMap
.ShortCut
:= ShortCut(VK_S
, [ssModifier
]);
2751 miSaveMapAs
.ShortCut
:= ShortCut(VK_S
, [ssModifier
, ssShift
]);
2752 miReopenMap
.ShortCut
:= ShortCut(VK_F5
, [ssModifier
]);
2754 miUndo
.ShortCut
:= ShortCut(VK_Z
, [ssModifier
]);
2755 miCopy
.ShortCut
:= ShortCut(VK_C
, [ssModifier
]);
2756 miCut
.ShortCut
:= ShortCut(VK_X
, [ssModifier
]);
2757 miPaste
.ShortCut
:= ShortCut(VK_V
, [ssModifier
]);
2758 miSelectAll
.ShortCut
:= ShortCut(VK_A
, [ssModifier
]);
2759 miToFore
.ShortCut
:= ShortCut(VK_LCL_CLOSE_BRACKET
, [ssModifier
]);
2760 miToBack
.ShortCut
:= ShortCut(VK_LCL_OPEN_BRACKET
, [ssModifier
]);
2762 miMapOptions
.Shortcut
:= ShortCut(VK_P
, [ssModifier
, ssAlt
]);
2763 selectall1
.Shortcut
:= ShortCut(VK_A
, [ssModifier
, ssAlt
]);
2766 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION
, MSG_NOTIFY
);
2767 e_WriteLog('Build date: ' + EDITOR_BUILDDATE
+ ' ' + EDITOR_BUILDTIME
, MSG_NOTIFY
);
2768 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY
);
2769 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY
);
2771 slInvalidTextures
:= TStringList
.Create
;
2773 ShowLayer(LAYER_BACK
, True);
2774 ShowLayer(LAYER_WALLS
, True);
2775 ShowLayer(LAYER_FOREGROUND
, True);
2776 ShowLayer(LAYER_STEPS
, True);
2777 ShowLayer(LAYER_WATER
, True);
2778 ShowLayer(LAYER_ITEMS
, True);
2779 ShowLayer(LAYER_MONSTERS
, True);
2780 ShowLayer(LAYER_AREAS
, True);
2781 ShowLayer(LAYER_TRIGGERS
, True);
2785 FormCaption
:= MainForm
.Caption
;
2789 config
:= TConfig
.CreateFile(CfgFileName
);
2791 if config
.ReadInt('Editor', 'XPos', -1) = -1 then
2792 Position
:= poDesktopCenter
2794 Left
:= config
.ReadInt('Editor', 'XPos', Left
);
2795 Top
:= config
.ReadInt('Editor', 'YPos', Top
);
2796 Width
:= config
.ReadInt('Editor', 'Width', Width
);
2797 Height
:= config
.ReadInt('Editor', 'Height', Height
);
2799 if config
.ReadBool('Editor', 'Maximize', False) then
2800 WindowState
:= wsMaximized
;
2801 ShowMap
:= config
.ReadBool('Editor', 'Minimap', False);
2802 PanelProps
.Width
:= config
.ReadInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
2803 Splitter1
.Left
:= PanelProps
.Left
;
2804 PanelObjs
.Height
:= config
.ReadInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
2805 Splitter2
.Top
:= PanelObjs
.Top
;
2806 StatusBar
.Top
:= PanelObjs
.BoundsRect
.Bottom
;
2807 DotEnable
:= config
.ReadBool('Editor', 'DotEnable', True);
2808 DotColor
:= config
.ReadInt('Editor', 'DotColor', $FFFFFF);
2809 DotStepOne
:= config
.ReadInt('Editor', 'DotStepOne', 16);
2810 DotStepTwo
:= config
.ReadInt('Editor', 'DotStepTwo', 8);
2811 DotStep
:= config
.ReadInt('Editor', 'DotStep', DotStepOne
);
2812 DrawTexturePanel
:= config
.ReadBool('Editor', 'DrawTexturePanel', True);
2813 DrawPanelSize
:= config
.ReadBool('Editor', 'DrawPanelSize', True);
2814 BackColor
:= config
.ReadInt('Editor', 'BackColor', $7F6040);
2815 PreviewColor
:= config
.ReadInt('Editor', 'PreviewColor', $00FF00);
2816 UseCheckerboard
:= config
.ReadBool('Editor', 'UseCheckerboard', True);
2817 gColorEdge
:= config
.ReadInt('Editor', 'EdgeColor', COLOR_EDGE
);
2818 gAlphaEdge
:= config
.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE
);
2819 if gAlphaEdge
= 255 then
2820 gAlphaEdge
:= ALPHA_EDGE
;
2821 drEdge
[0] := GetRValue(gColorEdge
);
2822 drEdge
[1] := GetGValue(gColorEdge
);
2823 drEdge
[2] := GetBValue(gColorEdge
);
2824 if not config
.ReadBool('Editor', 'EdgeShow', True) then
2827 drEdge
[3] := gAlphaEdge
;
2828 gAlphaTriggerLine
:= config
.ReadInt('Editor', 'LineAlpha', ALPHA_LINE
);
2829 if gAlphaTriggerLine
= 255 then
2830 gAlphaTriggerLine
:= ALPHA_LINE
;
2831 gAlphaTriggerArea
:= config
.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA
);
2832 if gAlphaTriggerArea
= 255 then
2833 gAlphaTriggerArea
:= ALPHA_AREA
;
2834 gAlphaMonsterRect
:= config
.ReadInt('Editor', 'MonsterRectAlpha', 0);
2835 gAlphaAreaRect
:= config
.ReadInt('Editor', 'AreaRectAlpha', 0);
2836 Scale
:= Max(config
.ReadInt('Editor', 'Scale', 1), 1);
2837 DotSize
:= Max(config
.ReadInt('Editor', 'DotSize', 1), 1);
2838 OpenDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastOpenDir', MapsDir
);
2839 SaveDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastSaveDir', MapsDir
);
2841 s
:= config
.ReadStr('Editor', 'Language', '');
2844 Compress
:= config
.ReadBool('Editor', 'Compress', True);
2845 Backup
:= config
.ReadBool('Editor', 'Backup', True);
2847 TestGameMode
:= config
.ReadStr('TestRun', 'GameMode', 'DM');
2848 TestLimTime
:= config
.ReadStr('TestRun', 'LimTime', '0');
2849 TestLimScore
:= config
.ReadStr('TestRun', 'LimScore', '0');
2850 TestOptionsTwoPlayers
:= config
.ReadBool('TestRun', 'TwoPlayers', False);
2851 TestOptionsTeamDamage
:= config
.ReadBool('TestRun', 'TeamDamage', False);
2852 TestOptionsAllowExit
:= config
.ReadBool('TestRun', 'AllowExit', True);
2853 TestOptionsWeaponStay
:= config
.ReadBool('TestRun', 'WeaponStay', False);
2854 TestOptionsMonstersDM
:= config
.ReadBool('TestRun', 'MonstersDM', False);
2855 TestMapOnce
:= config
.ReadBool('TestRun', 'MapOnce', False);
2856 {$IF DEFINED(DARWIN)}
2857 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeDrawin', GameExeFile
);
2858 {$ELSEIF DEFINED(WINDOWS)}
2859 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeWindows', GameExeFile
);
2861 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeUnix', GameExeFile
);
2863 TestD2DArgs
:= config
.ReadStr('TestRun', 'Args', '');
2865 RecentCount
:= config
.ReadInt('Editor', 'RecentCount', 5);
2866 if RecentCount
> 10 then
2868 if RecentCount
< 2 then
2871 RecentFiles
:= TStringList
.Create();
2872 for i
:= 0 to RecentCount
-1 do
2875 s
:= config
.ReadStr('RecentFilesWin', IntToStr(i
), '');
2877 s
:= config
.ReadStr('RecentFilesUnix', IntToStr(i
), '');
2882 RefreshRecentMenu();
2886 tbShowMap
.Down
:= ShowMap
;
2887 tbGridOn
.Down
:= DotEnable
;
2888 pcObjects
.ActivePageIndex
:= 0;
2889 Application
.Title
:= MsgEditorTitle
;
2891 Application
.OnIdle
:= OnIdle
;
2894 procedure PrintBlack(X
, Y
: Integer; Text: string; FontID
: DWORD
);
2896 // NOTE: all the font printing routines assume CP1251
2897 e_TextureFontPrintEx(X
, Y
, Text, FontID
, 0, 0, 0, 1.0);
2900 procedure TMainForm
.Draw();
2905 Width
, Height
: Word;
2908 aX
, aY
, aX2
, aY2
, XX
, ScaleSz
: Integer;
2917 e_Clear(GL_COLOR_BUFFER_BIT
,
2918 GetRValue(BackColor
)/255,
2919 GetGValue(BackColor
)/255,
2920 GetBValue(BackColor
)/255);
2924 ObjCount
:= SelectedObjectCount();
2926 // Обводим выделенные объекты красной рамкой:
2927 if ObjCount
> 0 then
2929 for a
:= 0 to High(SelectedObjects
) do
2930 if SelectedObjects
[a
].Live
then
2932 Rect
:= ObjectGetRect(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
);
2936 e_DrawQuad(X
+MapOffset
.X
, Y
+MapOffset
.Y
,
2937 X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+Height
-1,
2940 // Рисуем точки изменения размеров:
2941 if (ObjCount
= 1) and
2942 (SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) then
2944 e_DrawPoint(5, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2945 e_DrawPoint(5, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2946 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 255, 255);
2947 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 255, 255);
2949 e_DrawPoint(3, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2950 e_DrawPoint(3, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2951 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 0, 0);
2952 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 0, 0);
2959 if DotEnable
and (PreviewMode
= 0) then
2966 x
:= MapOffset
.X
mod DotStep
;
2967 y
:= MapOffset
.Y
mod DotStep
;
2969 while x
< RenderPanel
.Width
do
2971 while y
< RenderPanel
.Height
do
2973 e_DrawPoint(DotSize
, x
+ a
, y
+ a
,
2974 GetRValue(DotColor
),
2975 GetGValue(DotColor
),
2976 GetBValue(DotColor
));
2980 y
:= MapOffset
.Y
mod DotStep
;
2985 if (lbTextureList
.ItemIndex
<> -1) and (cbPreview
.Checked
) and
2986 (not IsSpecialTextureSel()) and (PreviewMode
= 0) then
2988 if not g_GetTexture(SelectedTexture(), ID
) then
2989 g_GetTexture('NOTEXTURE', ID
);
2990 g_GetTextureSizeByID(ID
, Width
, Height
);
2991 if UseCheckerboard
then
2993 if g_GetTexture('PREVIEW', PID
) then
2994 e_DrawFill(PID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, Width
div 16 + 1, Height
div 16 + 1, 0, True, False);
2996 e_DrawFillQuad(RenderPanel
.Width
-Width
-2, RenderPanel
.Height
-Height
-2,
2997 RenderPanel
.Width
-1, RenderPanel
.Height
-1,
2998 GetRValue(PreviewColor
), GetGValue(PreviewColor
), GetBValue(PreviewColor
), 0);
2999 e_Draw(ID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, 0, True, False);
3002 // Подсказка при выборе точки Телепорта:
3003 if SelectFlag
= SELECTFLAG_TELEPORT
then
3005 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3006 if Data
.d2d_teleport
then
3007 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
3008 MousePos
.X
+16, MousePos
.Y
-1,
3011 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+AreaSize
[AREA_DMPOINT
].Width
-1,
3012 MousePos
.Y
+AreaSize
[AREA_DMPOINT
].Height
-1, 255, 255, 255);
3014 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3015 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3016 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintTeleport
), gEditorFont
);
3019 // Подсказка при выборе точки появления:
3020 if SelectFlag
= SELECTFLAG_SPAWNPOINT
then
3022 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
3023 MousePos
.X
+16, MousePos
.Y
-1,
3025 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3026 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3027 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintSpawn
), gEditorFont
);
3030 // Подсказка при выборе панели двери:
3031 if SelectFlag
= SELECTFLAG_DOOR
then
3033 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3034 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3035 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelDoor
), gEditorFont
);
3038 // Подсказка при выборе панели с текстурой:
3039 if SelectFlag
= SELECTFLAG_TEXTURE
then
3041 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 192, 192, 192, 127);
3042 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 255, 255, 255);
3043 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelTexture
), gEditorFont
);
3046 // Подсказка при выборе панели индикации выстрела:
3047 if SelectFlag
= SELECTFLAG_SHOTPANEL
then
3049 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 192, 192, 192, 127);
3050 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 255, 255, 255);
3051 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelShot
), gEditorFont
);
3054 // Подсказка при выборе панели лифта:
3055 if SelectFlag
= SELECTFLAG_LIFT
then
3057 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3058 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3059 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelLift
), gEditorFont
);
3062 // Подсказка при выборе монстра:
3063 if SelectFlag
= SELECTFLAG_MONSTER
then
3065 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 192, 192, 192, 127);
3066 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 255, 255, 255);
3067 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintMonster
), gEditorFont
);
3070 // Подсказка при выборе области воздействия:
3071 if DrawPressRect
then
3073 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 192, 192, 192, 127);
3074 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 255, 255, 255);
3075 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintExtArea
), gEditorFont
);
3078 // Рисуем текстуры, если чертим панель:
3079 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and (DrawTexturePanel
) and
3080 (lbTextureList
.ItemIndex
<> -1) and (DrawRect
<> nil) and
3081 (lbPanelType
.ItemIndex
in [0..8]) and not IsSpecialTextureSel() then
3083 if not g_GetTexture(SelectedTexture(), ID
) then
3084 g_GetTexture('NOTEXTURE', ID
);
3085 g_GetTextureSizeByID(ID
, Width
, Height
);
3087 if (Abs(Right
-Left
) >= Width
) and (Abs(Bottom
-Top
) >= Height
) then
3088 e_DrawFill(ID
, Min(Left
, Right
), Min(Top
, Bottom
), Abs(Right
-Left
) div Width
,
3089 Abs(Bottom
-Top
) div Height
, 64, True, False);
3092 // Прямоугольник выделения:
3093 if DrawRect
<> nil then
3095 e_DrawQuad(Left
, Top
, Right
-1, Bottom
-1, 255, 255, 255);
3097 // Чертим мышью панель/триггер или меняем мышью их размер:
3098 if (((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3099 not(ssCtrl
in GetKeyShiftState())) or (MouseAction
= MOUSEACTION_RESIZE
)) and
3100 (DrawPanelSize
) then
3102 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 192, 192, 192, 127);
3103 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 255, 255, 255);
3105 if MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
] then
3106 begin // Чертим новый
3107 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
),
3108 [Abs(MousePos
.X
-MouseLDownPos
.X
)]), gEditorFont
);
3109 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
),
3110 [Abs(MousePos
.Y
-MouseLDownPos
.Y
)]), gEditorFont
);
3112 else // Растягиваем существующий
3113 if SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
3115 if SelectedObjects
[GetFirstSelected
].ObjectType
= OBJECT_PANEL
then
3117 Width
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3118 Height
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3122 Width
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3123 Height
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3126 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
), [Width
]),
3128 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
), [Height
]),
3133 // Ближайшая к курсору мыши точка на сетке:
3134 e_DrawPoint(3, MousePos
.X
, MousePos
.Y
, 0, 0, 255);
3139 // Сколько пикселов карты в 1 пикселе мини-карты:
3140 ScaleSz
:= 16 div Scale
;
3141 // Размеры мини-карты:
3142 aX
:= max(gMapInfo
.Width
div ScaleSz
, 1);
3143 aY
:= max(gMapInfo
.Height
div ScaleSz
, 1);
3144 // X-координата на RenderPanel нулевой x-координаты карты:
3145 XX
:= RenderPanel
.Width
- aX
- 1;
3147 e_DrawFillQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 0, 0, 0, 0);
3148 e_DrawQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 197, 197, 197);
3150 if gPanels
<> nil then
3153 for a
:= 0 to High(gPanels
) do
3155 if PanelType
<> 0 then
3157 // Левый верхний угол:
3158 aX
:= XX
+ (X
div ScaleSz
);
3159 aY
:= 1 + (Y
div ScaleSz
);
3161 aX2
:= max(Width
div ScaleSz
, 1);
3162 aY2
:= max(Height
div ScaleSz
, 1);
3163 // Правый нижний угол:
3164 aX2
:= aX
+ aX2
- 1;
3165 aY2
:= aY
+ aY2
- 1;
3168 PANEL_WALL
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 208, 208, 208, 0);
3169 PANEL_WATER
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 0, 192, 0);
3170 PANEL_ACID1
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 176, 0, 0);
3171 PANEL_ACID2
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 176, 0, 0, 0);
3172 PANEL_STEP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 128, 128, 128, 0);
3173 PANEL_LIFTUP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 72, 36, 0);
3174 PANEL_LIFTDOWN
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 124, 96, 0);
3175 PANEL_LIFTLEFT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 200, 80, 4, 0);
3176 PANEL_LIFTRIGHT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 252, 140, 56, 0);
3177 PANEL_OPENDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 100, 220, 92, 0);
3178 PANEL_CLOSEDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 212, 184, 64, 0);
3179 PANEL_BLOCKMON
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 192, 0, 192, 0);
3183 // Рисуем красным выделенные панели:
3184 if SelectedObjects
<> nil then
3185 for b
:= 0 to High(SelectedObjects
) do
3186 with SelectedObjects
[b
] do
3187 if Live
and (ObjectType
= OBJECT_PANEL
) then
3188 with gPanels
[SelectedObjects
[b
].ID
] do
3189 if PanelType
and not(PANEL_BACK
or PANEL_FORE
) <> 0 then
3191 // Левый верхний угол:
3192 aX
:= XX
+ (X
div ScaleSz
);
3193 aY
:= 1 + (Y
div ScaleSz
);
3195 aX2
:= max(Width
div ScaleSz
, 1);
3196 aY2
:= max(Height
div ScaleSz
, 1);
3197 // Правый нижний угол:
3198 aX2
:= aX
+ aX2
- 1;
3199 aY2
:= aY
+ aY2
- 1;
3201 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0, 0)
3205 if (gMapInfo
.Width
> RenderPanel
.Width
) or
3206 (gMapInfo
.Height
> RenderPanel
.Height
) then
3208 // Окно, показывающее текущее положение экрана на карте:
3210 x
:= max(min(RenderPanel
.Width
, gMapInfo
.Width
) div ScaleSz
, 1);
3211 y
:= max(min(RenderPanel
.Height
, gMapInfo
.Height
) div ScaleSz
, 1);
3212 // Левый верхний угол:
3213 aX
:= XX
+ ((-MapOffset
.X
) div ScaleSz
);
3214 aY
:= 1 + ((-MapOffset
.Y
) div ScaleSz
);
3215 // Правый нижний угол:
3219 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 127, 192, 127, 127, B_BLEND
);
3220 e_DrawQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0);
3225 RenderPanel
.SwapBuffers();
3228 procedure TMainForm
.FormResize(Sender
: TObject
);
3230 e_SetViewPort(0, 0, RenderPanel
.Width
, RenderPanel
.Height
);
3232 sbHorizontal
.Min
:= Min(gMapInfo
.Width
- RenderPanel
.Width
, -RenderPanel
.Width
div 2);
3233 sbHorizontal
.Max
:= Max(0, gMapInfo
.Width
- RenderPanel
.Width
div 2);
3234 sbVertical
.Min
:= Min(gMapInfo
.Height
- RenderPanel
.Height
, -RenderPanel
.Height
div 2);
3235 sbVertical
.Max
:= Max(0, gMapInfo
.Height
- RenderPanel
.Height
div 2);
3237 MapOffset
.X
:= -sbHorizontal
.Position
;
3238 MapOffset
.Y
:= -sbVertical
.Position
;
3241 procedure TMainForm
.FormWindowStateChange(Sender
: TObject
);
3247 // deactivate all menus when main window minimized
3248 e
:= self
.WindowState
<> wsMinimized
;
3249 miMenuFile
.Enabled
:= e
;
3250 miMenuEdit
.Enabled
:= e
;
3251 miMenuView
.Enabled
:= e
;
3252 miMenuService
.Enabled
:= e
;
3253 miMenuWindow
.Enabled
:= e
;
3254 miMenuHelp
.Enabled
:= e
;
3255 miMenuHidden
.Enabled
:= e
;
3259 procedure SelectNextObject(X
, Y
: Integer; ObjectType
: Byte; ID
: DWORD
);
3264 j_max
:= 0; // shut up compiler
3268 res
:= (gPanels
<> nil) and
3269 PanelInShownLayer(gPanels
[ID
].PanelType
) and
3270 g_CollidePoint(X
, Y
, gPanels
[ID
].X
, gPanels
[ID
].Y
,
3272 gPanels
[ID
].Height
);
3273 j_max
:= Length(gPanels
) - 1;
3278 res
:= (gItems
<> nil) and
3279 LayerEnabled
[LAYER_ITEMS
] and
3280 g_CollidePoint(X
, Y
, gItems
[ID
].X
, gItems
[ID
].Y
,
3281 ItemSize
[gItems
[ID
].ItemType
][0],
3282 ItemSize
[gItems
[ID
].ItemType
][1]);
3283 j_max
:= Length(gItems
) - 1;
3288 res
:= (gMonsters
<> nil) and
3289 LayerEnabled
[LAYER_MONSTERS
] and
3290 g_CollidePoint(X
, Y
, gMonsters
[ID
].X
, gMonsters
[ID
].Y
,
3291 MonsterSize
[gMonsters
[ID
].MonsterType
].Width
,
3292 MonsterSize
[gMonsters
[ID
].MonsterType
].Height
);
3293 j_max
:= Length(gMonsters
) - 1;
3298 res
:= (gAreas
<> nil) and
3299 LayerEnabled
[LAYER_AREAS
] and
3300 g_CollidePoint(X
, Y
, gAreas
[ID
].X
, gAreas
[ID
].Y
,
3301 AreaSize
[gAreas
[ID
].AreaType
].Width
,
3302 AreaSize
[gAreas
[ID
].AreaType
].Height
);
3303 j_max
:= Length(gAreas
) - 1;
3308 res
:= (gTriggers
<> nil) and
3309 LayerEnabled
[LAYER_TRIGGERS
] and
3310 g_CollidePoint(X
, Y
, gTriggers
[ID
].X
, gTriggers
[ID
].Y
,
3311 gTriggers
[ID
].Width
,
3312 gTriggers
[ID
].Height
);
3313 j_max
:= Length(gTriggers
) - 1;
3323 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3332 if j
= Integer(ID
) then
3337 res
:= PanelInShownLayer(gPanels
[j
].PanelType
) and
3338 g_CollidePoint(X
, Y
, gPanels
[j
].X
, gPanels
[j
].Y
,
3342 res
:= (gItems
[j
].ItemType
<> ITEM_NONE
) and
3343 g_CollidePoint(X
, Y
, gItems
[j
].X
, gItems
[j
].Y
,
3344 ItemSize
[gItems
[j
].ItemType
][0],
3345 ItemSize
[gItems
[j
].ItemType
][1]);
3347 res
:= (gMonsters
[j
].MonsterType
<> MONSTER_NONE
) and
3348 g_CollidePoint(X
, Y
, gMonsters
[j
].X
, gMonsters
[j
].Y
,
3349 MonsterSize
[gMonsters
[j
].MonsterType
].Width
,
3350 MonsterSize
[gMonsters
[j
].MonsterType
].Height
);
3352 res
:= (gAreas
[j
].AreaType
<> AREA_NONE
) and
3353 g_CollidePoint(X
, Y
, gAreas
[j
].X
, gAreas
[j
].Y
,
3354 AreaSize
[gAreas
[j
].AreaType
].Width
,
3355 AreaSize
[gAreas
[j
].AreaType
].Height
);
3357 res
:= (gTriggers
[j
].TriggerType
<> TRIGGER_NONE
) and
3358 g_CollidePoint(X
, Y
, gTriggers
[j
].X
, gTriggers
[j
].Y
,
3360 gTriggers
[j
].Height
);
3367 SetLength(SelectedObjects
, 1);
3369 SelectedObjects
[0].ObjectType
:= ObjectType
;
3370 SelectedObjects
[0].ID
:= j
;
3371 SelectedObjects
[0].Live
:= True;
3379 procedure TMainForm
.RenderPanelMouseDown(Sender
: TObject
;
3380 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3384 c1
, c2
, c3
, c4
: Boolean;
3390 MainForm
.ActiveControl
:= RenderPanel
;
3391 RenderPanel
.SetFocus();
3393 RenderPanelMouseMove(RenderPanel
, Shift
, X
, Y
);
3395 if Button
= mbLeft
then // Left Mouse Button
3397 // Двигаем карту с помощью мыши и мини-карты:
3399 g_CollidePoint(X
, Y
,
3400 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3402 max(gMapInfo
.Width
div (16 div Scale
), 1),
3403 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3406 MouseAction
:= MOUSEACTION_MOVEMAP
;
3408 else // Ставим предмет/монстра/область:
3409 if (pcObjects
.ActivePageIndex
in [1, 2, 3]) and
3410 (not (ssShift
in Shift
)) then
3412 case pcObjects
.ActivePageIndex
of
3414 if lbItemList
.ItemIndex
= -1 then
3415 ErrorMessageBox(MsgMsgChooseItem
)
3418 item
.ItemType
:= lbItemList
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
3419 if item
.ItemType
>= ITEM_WEAPON_KASTET
then
3420 item
.ItemType
:= item
.ItemType
+ 2;
3421 item
.X
:= MousePos
.X
-MapOffset
.X
;
3422 item
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3424 if not (ssCtrl
in Shift
) then
3426 item
.X
:= item
.X
- (ItemSize
[item
.ItemType
][0] div 2);
3427 item
.Y
:= item
.Y
- ItemSize
[item
.ItemType
][1];
3430 item
.OnlyDM
:= cbOnlyDM
.Checked
;
3431 item
.Fall
:= cbFall
.Checked
;
3432 Undo_Add(OBJECT_ITEM
, AddItem(item
));
3435 if lbMonsterList
.ItemIndex
= -1 then
3436 ErrorMessageBox(MsgMsgChooseMonster
)
3439 monster
.MonsterType
:= lbMonsterList
.ItemIndex
+ MONSTER_DEMON
;
3440 monster
.X
:= MousePos
.X
-MapOffset
.X
;
3441 monster
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3443 if not (ssCtrl
in Shift
) then
3445 monster
.X
:= monster
.X
- (MonsterSize
[monster
.MonsterType
].Width
div 2);
3446 monster
.Y
:= monster
.Y
- MonsterSize
[monster
.MonsterType
].Height
;
3449 if rbMonsterLeft
.Checked
then
3450 monster
.Direction
:= D_LEFT
3452 monster
.Direction
:= D_RIGHT
;
3453 Undo_Add(OBJECT_MONSTER
, AddMonster(monster
));
3456 if lbAreasList
.ItemIndex
= -1 then
3457 ErrorMessageBox(MsgMsgChooseArea
)
3459 if (lbAreasList
.ItemIndex
+ 1) <> AREA_DOMFLAG
then
3461 area
.AreaType
:= lbAreasList
.ItemIndex
+ AREA_PLAYERPOINT1
;
3462 area
.X
:= MousePos
.X
-MapOffset
.X
;
3463 area
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3465 if not (ssCtrl
in Shift
) then
3467 area
.X
:= area
.X
- (AreaSize
[area
.AreaType
].Width
div 2);
3468 area
.Y
:= area
.Y
- AreaSize
[area
.AreaType
].Height
;
3471 if rbAreaLeft
.Checked
then
3472 area
.Direction
:= D_LEFT
3474 area
.Direction
:= D_RIGHT
;
3475 Undo_Add(OBJECT_AREA
, AddArea(area
));
3481 i
:= GetFirstSelected();
3483 // Выбираем объект под текущим:
3484 if (SelectedObjects
<> nil) and
3485 (ssShift
in Shift
) and (i
>= 0) and
3486 (SelectedObjects
[i
].Live
) then
3488 if SelectedObjectCount() = 1 then
3489 SelectNextObject(X
-MapOffset
.X
, Y
-MapOffset
.Y
,
3490 SelectedObjects
[i
].ObjectType
,
3491 SelectedObjects
[i
].ID
);
3495 // Рисуем область триггера "Расширитель":
3496 if DrawPressRect
and (i
>= 0) and
3497 (SelectedObjects
[i
].ObjectType
= OBJECT_TRIGGER
) and
3498 (gTriggers
[SelectedObjects
[i
].ID
].TriggerType
in
3499 [TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
]) then
3500 MouseAction
:= MOUSEACTION_DRAWPRESS
3501 else // Рисуем панель:
3502 if pcObjects
.ActivePageIndex
= 0 then
3504 if (lbPanelType
.ItemIndex
>= 0) then
3505 MouseAction
:= MOUSEACTION_DRAWPANEL
3507 else // Рисуем триггер:
3508 if (lbTriggersList
.ItemIndex
>= 0) then
3510 MouseAction
:= MOUSEACTION_DRAWTRIGGER
;
3514 end; // if Button = mbLeft
3516 if Button
= mbRight
then // Right Mouse Button
3518 // Клик по мини-карте:
3520 g_CollidePoint(X
, Y
,
3521 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3523 max(gMapInfo
.Width
div (16 div Scale
), 1),
3524 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3526 MouseAction
:= MOUSEACTION_NOACTION
;
3528 else // Нужно что-то выбрать мышью:
3529 if SelectFlag
<> SELECTFLAG_NONE
then
3532 SELECTFLAG_TELEPORT
:
3533 // Точку назначения телепортации:
3534 with gTriggers
[SelectedObjects
[
3535 GetFirstSelected() ].ID
].Data
.TargetPoint
do
3537 X
:= MousePos
.X
-MapOffset
.X
;
3538 Y
:= MousePos
.Y
-MapOffset
.Y
;
3541 SELECTFLAG_SPAWNPOINT
:
3542 // Точку создания монстра:
3543 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3544 if TriggerType
= TRIGGER_SPAWNMONSTER
then
3546 Data
.MonPos
.X
:= MousePos
.X
-MapOffset
.X
;
3547 Data
.MonPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3549 else if TriggerType
= TRIGGER_SPAWNITEM
then
3550 begin // Точка создания предмета:
3551 Data
.ItemPos
.X
:= MousePos
.X
-MapOffset
.X
;
3552 Data
.ItemPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3554 else if TriggerType
= TRIGGER_SHOT
then
3555 begin // Точка создания выстрела:
3556 Data
.ShotPos
.X
:= MousePos
.X
-MapOffset
.X
;
3557 Data
.ShotPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3563 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3565 2, 2, OBJECT_PANEL
, True);
3566 if IDArray
<> nil then
3568 for i
:= 0 to High(IDArray
) do
3569 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3570 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
) then
3572 gTriggers
[SelectedObjects
[
3573 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3578 gTriggers
[SelectedObjects
[
3579 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3583 // Панель с текстурой:
3585 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3587 2, 2, OBJECT_PANEL
, True);
3588 if IDArray
<> nil then
3590 for i
:= 0 to High(IDArray
) do
3591 if ((gPanels
[IDArray
[i
]].PanelType
in
3592 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3593 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3595 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3596 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3597 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3599 gTriggers
[SelectedObjects
[
3600 GetFirstSelected() ].ID
].TexturePanel
:= IDArray
[i
];
3605 gTriggers
[SelectedObjects
[
3606 GetFirstSelected() ].ID
].TexturePanel
:= -1;
3612 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3614 2, 2, OBJECT_PANEL
, True);
3615 if IDArray
<> nil then
3617 for i
:= 0 to High(IDArray
) do
3618 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTUP
) or
3619 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTDOWN
) or
3620 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTLEFT
) or
3621 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTRIGHT
) then
3623 gTriggers
[SelectedObjects
[
3624 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3629 gTriggers
[SelectedObjects
[
3630 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3636 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3638 2, 2, OBJECT_MONSTER
, False);
3639 if IDArray
<> nil then
3640 gTriggers
[SelectedObjects
[
3641 GetFirstSelected() ].ID
].Data
.MonsterID
:= IDArray
[0]+1
3643 gTriggers
[SelectedObjects
[
3644 GetFirstSelected() ].ID
].Data
.MonsterID
:= 0;
3647 SELECTFLAG_SHOTPANEL
:
3648 // Панель индикации выстрела:
3650 if gTriggers
[SelectedObjects
[
3651 GetFirstSelected() ].ID
].TriggerType
= TRIGGER_SHOT
then
3653 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3655 2, 2, OBJECT_PANEL
, True);
3656 if IDArray
<> nil then
3658 for i
:= 0 to High(IDArray
) do
3659 if ((gPanels
[IDArray
[i
]].PanelType
in
3660 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3661 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3663 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3664 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3665 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3667 gTriggers
[SelectedObjects
[
3668 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= IDArray
[i
];
3673 gTriggers
[SelectedObjects
[
3674 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= -1;
3679 SelectFlag
:= SELECTFLAG_SELECTED
;
3681 else // if SelectFlag <> SELECTFLAG_NONE...
3683 // Что уже выбрано и не нажат Ctrl:
3684 if (SelectedObjects
<> nil) and
3685 (not (ssCtrl
in Shift
)) then
3686 for i
:= 0 to High(SelectedObjects
) do
3687 with SelectedObjects
[i
] do
3690 if (ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) and
3691 (SelectedObjectCount() = 1) then
3693 Rect
:= ObjectGetRect(ObjectType
, ID
);
3695 c1
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3696 Rect
.X
-2, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3697 c2
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3698 Rect
.X
+Rect
.Width
-3, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3699 c3
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3700 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
-2, 4, 4);
3701 c4
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3702 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
+Rect
.Height
-3, 4, 4);
3704 // Меняем размер панели или триггера:
3705 if c1
or c2
or c3
or c4
then
3707 MouseAction
:= MOUSEACTION_RESIZE
;
3708 LastMovePoint
:= MousePos
;
3712 ResizeType
:= RESIZETYPE_HORIZONTAL
;
3714 ResizeDirection
:= RESIZEDIR_LEFT
3716 ResizeDirection
:= RESIZEDIR_RIGHT
;
3717 RenderPanel
.Cursor
:= crSizeWE
;
3721 ResizeType
:= RESIZETYPE_VERTICAL
;
3723 ResizeDirection
:= RESIZEDIR_UP
3725 ResizeDirection
:= RESIZEDIR_DOWN
;
3726 RenderPanel
.Cursor
:= crSizeNS
;
3733 // Перемещаем панель или триггер:
3734 if ObjectCollide(ObjectType
, ID
,
3736 Y
-MapOffset
.Y
-1, 2, 2) then
3738 MouseAction
:= MOUSEACTION_MOVEOBJ
;
3739 LastMovePoint
:= MousePos
;
3745 end; // if Button = mbRight
3747 if Button
= mbMiddle
then // Middle Mouse Button
3749 SetCapture(RenderPanel
.Handle
);
3750 RenderPanel
.Cursor
:= crSize
;
3753 MouseMDown
:= Button
= mbMiddle
;
3755 MouseMDownPos
:= Mouse
.CursorPos
;
3757 MouseRDown
:= Button
= mbRight
;
3759 MouseRDownPos
:= MousePos
;
3761 MouseLDown
:= Button
= mbLeft
;
3763 MouseLDownPos
:= MousePos
;
3766 procedure TMainForm
.RenderPanelMouseUp(Sender
: TObject
;
3767 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3772 rSelectRect
: Boolean;
3773 wWidth
, wHeight
: Word;
3776 procedure SelectObjects(ObjectType
: Byte);
3781 IDArray
:= ObjectInRect(rRect
.X
, rRect
.Y
,
3782 rRect
.Width
, rRect
.Height
,
3783 ObjectType
, rSelectRect
);
3785 if IDArray
<> nil then
3786 for i
:= 0 to High(IDArray
) do
3787 SelectObject(ObjectType
, IDArray
[i
], (ssCtrl
in Shift
) or rSelectRect
);
3790 if Button
= mbLeft
then
3791 MouseLDown
:= False;
3792 if Button
= mbRight
then
3793 MouseRDown
:= False;
3794 if Button
= mbMiddle
then
3795 MouseMDown
:= False;
3798 ResizeType
:= RESIZETYPE_NONE
;
3801 if Button
= mbLeft
then // Left Mouse Button
3803 if MouseAction
<> MOUSEACTION_NONE
then
3804 begin // Было действие мышью
3805 // Мышь сдвинулась во время удержания клавиши,
3806 // либо активирован режим быстрого рисования:
3807 if ((MousePos
.X
<> MouseLDownPos
.X
) and
3808 (MousePos
.Y
<> MouseLDownPos
.Y
)) or
3809 ((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3810 (ssCtrl
in Shift
)) then
3813 MOUSEACTION_DRAWPANEL
:
3815 // Фон или передний план без текстуры - ошибка:
3816 if (lbPanelType
.ItemIndex
in [1, 2]) and
3817 (lbTextureList
.ItemIndex
= -1) then
3818 ErrorMessageBox(MsgMsgChooseTexture
)
3819 else // Назначаем параметры панели:
3821 case lbPanelType
.ItemIndex
of
3822 0: Panel
.PanelType
:= PANEL_WALL
;
3823 1: Panel
.PanelType
:= PANEL_BACK
;
3824 2: Panel
.PanelType
:= PANEL_FORE
;
3825 3: Panel
.PanelType
:= PANEL_OPENDOOR
;
3826 4: Panel
.PanelType
:= PANEL_CLOSEDOOR
;
3827 5: Panel
.PanelType
:= PANEL_STEP
;
3828 6: Panel
.PanelType
:= PANEL_WATER
;
3829 7: Panel
.PanelType
:= PANEL_ACID1
;
3830 8: Panel
.PanelType
:= PANEL_ACID2
;
3831 9: Panel
.PanelType
:= PANEL_LIFTUP
;
3832 10: Panel
.PanelType
:= PANEL_LIFTDOWN
;
3833 11: Panel
.PanelType
:= PANEL_LIFTLEFT
;
3834 12: Panel
.PanelType
:= PANEL_LIFTRIGHT
;
3835 13: Panel
.PanelType
:= PANEL_BLOCKMON
;
3838 Panel
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3839 Panel
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3840 if ssCtrl
in Shift
then
3844 if (lbTextureList
.ItemIndex
<> -1) and
3845 (not IsSpecialTextureSel()) then
3847 if not g_GetTexture(SelectedTexture(), TextureID
) then
3848 g_GetTexture('NOTEXTURE', TextureID
);
3849 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
3851 Panel
.Width
:= wWidth
;
3852 Panel
.Height
:= wHeight
;
3856 Panel
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3857 Panel
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3860 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3861 if (lbPanelType
.ItemIndex
in [9, 10, 11, 12, 13]) or
3862 (lbTextureList
.ItemIndex
= -1) then
3864 Panel
.TextureHeight
:= 1;
3865 Panel
.TextureWidth
:= 1;
3866 Panel
.TextureName
:= '';
3867 Panel
.TextureID
:= TEXTURE_SPECIAL_NONE
;
3869 else // Есть текстура:
3871 Panel
.TextureName
:= SelectedTexture();
3873 // Обычная текстура:
3874 if not IsSpecialTextureSel() then
3876 g_GetTextureSizeByName(Panel
.TextureName
,
3877 Panel
.TextureWidth
, Panel
.TextureHeight
);
3878 g_GetTexture(Panel
.TextureName
, Panel
.TextureID
);
3880 else // Спец.текстура:
3882 Panel
.TextureHeight
:= 1;
3883 Panel
.TextureWidth
:= 1;
3884 Panel
.TextureID
:= SpecialTextureID(SelectedTexture());
3889 Panel
.Blending
:= False;
3891 Undo_Add(OBJECT_PANEL
, AddPanel(Panel
));
3895 // Рисовали триггер:
3896 MOUSEACTION_DRAWTRIGGER
:
3898 trigger
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3899 trigger
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3900 if ssCtrl
in Shift
then
3904 trigger
.Width
:= wWidth
;
3905 trigger
.Height
:= wHeight
;
3909 trigger
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3910 trigger
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3913 trigger
.Enabled
:= True;
3914 trigger
.TriggerType
:= lbTriggersList
.ItemIndex
+1;
3915 trigger
.TexturePanel
:= -1;
3918 trigger
.ActivateType
:= 0;
3920 if clbActivationType
.Checked
[0] then
3921 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERCOLLIDE
;
3922 if clbActivationType
.Checked
[1] then
3923 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERCOLLIDE
;
3924 if clbActivationType
.Checked
[2] then
3925 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERPRESS
;
3926 if clbActivationType
.Checked
[3] then
3927 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERPRESS
;
3928 if clbActivationType
.Checked
[4] then
3929 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_SHOT
;
3930 if clbActivationType
.Checked
[5] then
3931 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_NOMONSTER
;
3933 // Необходимые для активации ключи:
3936 if clbKeys
.Checked
[0] then
3937 trigger
.Key
:= Trigger
.Key
or KEY_RED
;
3938 if clbKeys
.Checked
[1] then
3939 trigger
.Key
:= Trigger
.Key
or KEY_GREEN
;
3940 if clbKeys
.Checked
[2] then
3941 trigger
.Key
:= Trigger
.Key
or KEY_BLUE
;
3942 if clbKeys
.Checked
[3] then
3943 trigger
.Key
:= Trigger
.Key
or KEY_REDTEAM
;
3944 if clbKeys
.Checked
[4] then
3945 trigger
.Key
:= Trigger
.Key
or KEY_BLUETEAM
;
3947 // Параметры триггера:
3948 FillByte(trigger
.Data
.Default
[0], 128, 0);
3950 case trigger
.TriggerType
of
3951 // Переключаемая панель:
3952 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
3953 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
3954 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
3956 Trigger
.Data
.PanelID
:= -1;
3962 trigger
.Data
.TargetPoint
.X
:= trigger
.X
-64;
3963 trigger
.Data
.TargetPoint
.Y
:= trigger
.Y
-64;
3964 trigger
.Data
.d2d_teleport
:= True;
3965 trigger
.Data
.TlpDir
:= 0;
3968 // Изменение других триггеров:
3969 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
3972 trigger
.Data
.Count
:= 1;
3978 trigger
.Data
.Volume
:= 255;
3979 trigger
.Data
.Pan
:= 127;
3980 trigger
.Data
.PlayCount
:= 1;
3981 trigger
.Data
.Local
:= True;
3982 trigger
.Data
.SoundSwitch
:= False;
3988 trigger
.Data
.MusicAction
:= 1;
3991 // Создание монстра:
3992 TRIGGER_SPAWNMONSTER
:
3994 trigger
.Data
.MonType
:= MONSTER_ZOMBY
;
3995 trigger
.Data
.MonPos
.X
:= trigger
.X
-64;
3996 trigger
.Data
.MonPos
.Y
:= trigger
.Y
-64;
3997 trigger
.Data
.MonHealth
:= 0;
3998 trigger
.Data
.MonActive
:= False;
3999 trigger
.Data
.MonCount
:= 1;
4002 // Создание предмета:
4005 trigger
.Data
.ItemType
:= ITEM_AMMO_BULLETS
;
4006 trigger
.Data
.ItemPos
.X
:= trigger
.X
-64;
4007 trigger
.Data
.ItemPos
.Y
:= trigger
.Y
-64;
4008 trigger
.Data
.ItemOnlyDM
:= False;
4009 trigger
.Data
.ItemFalls
:= False;
4010 trigger
.Data
.ItemCount
:= 1;
4011 trigger
.Data
.ItemMax
:= 0;
4012 trigger
.Data
.ItemDelay
:= 0;
4018 trigger
.Data
.PushAngle
:= 90;
4019 trigger
.Data
.PushForce
:= 10;
4020 trigger
.Data
.ResetVel
:= True;
4025 trigger
.Data
.ScoreCount
:= 1;
4026 trigger
.Data
.ScoreCon
:= True;
4027 trigger
.Data
.ScoreMsg
:= True;
4032 trigger
.Data
.MessageKind
:= 0;
4033 trigger
.Data
.MessageSendTo
:= 0;
4034 trigger
.Data
.MessageText
:= '';
4035 trigger
.Data
.MessageTime
:= 144;
4040 trigger
.Data
.DamageValue
:= 5;
4041 trigger
.Data
.DamageInterval
:= 12;
4046 trigger
.Data
.HealValue
:= 5;
4047 trigger
.Data
.HealInterval
:= 36;
4052 trigger
.Data
.ShotType
:= TRIGGER_SHOT_BULLET
;
4053 trigger
.Data
.ShotSound
:= True;
4054 trigger
.Data
.ShotPanelID
:= -1;
4055 trigger
.Data
.ShotTarget
:= 0;
4056 trigger
.Data
.ShotIntSight
:= 0;
4057 trigger
.Data
.ShotAim
:= TRIGGER_SHOT_AIM_DEFAULT
;
4058 trigger
.Data
.ShotPos
.X
:= trigger
.X
-64;
4059 trigger
.Data
.ShotPos
.Y
:= trigger
.Y
-64;
4060 trigger
.Data
.ShotAngle
:= 0;
4061 trigger
.Data
.ShotWait
:= 18;
4062 trigger
.Data
.ShotAccuracy
:= 0;
4063 trigger
.Data
.ShotAmmo
:= 0;
4064 trigger
.Data
.ShotIntReload
:= 0;
4069 trigger
.Data
.FXCount
:= 1;
4070 trigger
.Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
4071 trigger
.Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
4072 trigger
.Data
.FXColorR
:= 0;
4073 trigger
.Data
.FXColorG
:= 0;
4074 trigger
.Data
.FXColorB
:= 255;
4075 trigger
.Data
.FXPos
:= TRIGGER_EFFECT_POS_CENTER
;
4076 trigger
.Data
.FXWait
:= 1;
4077 trigger
.Data
.FXVelX
:= 0;
4078 trigger
.Data
.FXVelY
:= -20;
4079 trigger
.Data
.FXSpreadL
:= 5;
4080 trigger
.Data
.FXSpreadR
:= 5;
4081 trigger
.Data
.FXSpreadU
:= 4;
4082 trigger
.Data
.FXSpreadD
:= 0;
4086 Undo_Add(OBJECT_TRIGGER
, AddTrigger(trigger
));
4089 // Рисовали область триггера "Расширитель":
4090 MOUSEACTION_DRAWPRESS
:
4091 with gTriggers
[SelectedObjects
[GetFirstSelected
].ID
] do
4093 Data
.tX
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
4094 Data
.tY
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
4095 Data
.tWidth
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
4096 Data
.tHeight
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
4098 DrawPressRect
:= False;
4102 MouseAction
:= MOUSEACTION_NONE
;
4104 end // if Button = mbLeft...
4105 else if Button
= mbRight
then // Right Mouse Button:
4107 if MouseAction
= MOUSEACTION_NOACTION
then
4109 MouseAction
:= MOUSEACTION_NONE
;
4113 // Объект передвинут или изменен в размере:
4114 if MouseAction
in [MOUSEACTION_MOVEOBJ
, MOUSEACTION_RESIZE
] then
4116 RenderPanel
.Cursor
:= crDefault
;
4117 MouseAction
:= MOUSEACTION_NONE
;
4122 // Еще не все выбрали:
4123 if SelectFlag
<> SELECTFLAG_NONE
then
4125 if SelectFlag
= SELECTFLAG_SELECTED
then
4126 SelectFlag
:= SELECTFLAG_NONE
;
4131 // Мышь сдвинулась во время удержания клавиши:
4132 if (MousePos
.X
<> MouseRDownPos
.X
) and
4133 (MousePos
.Y
<> MouseRDownPos
.Y
) then
4135 rSelectRect
:= True;
4137 rRect
.X
:= Min(MousePos
.X
, MouseRDownPos
.X
)-MapOffset
.X
;
4138 rRect
.Y
:= Min(MousePos
.Y
, MouseRDownPos
.Y
)-MapOffset
.Y
;
4139 rRect
.Width
:= Abs(MousePos
.X
-MouseRDownPos
.X
);
4140 rRect
.Height
:= Abs(MousePos
.Y
-MouseRDownPos
.Y
);
4142 else // Мышь не сдвинулась - нет прямоугольника:
4144 rSelectRect
:= False;
4146 rRect
.X
:= X
-MapOffset
.X
-1;
4147 rRect
.Y
:= Y
-MapOffset
.Y
-1;
4152 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4153 if not (ssCtrl
in Shift
) then
4154 RemoveSelectFromObjects();
4156 // Выделяем всё в выбранном прямоугольнике:
4157 if (ssCtrl
in Shift
) and (ssAlt
in Shift
) then
4159 SelectObjects(OBJECT_PANEL
);
4160 SelectObjects(OBJECT_ITEM
);
4161 SelectObjects(OBJECT_MONSTER
);
4162 SelectObjects(OBJECT_AREA
);
4163 SelectObjects(OBJECT_TRIGGER
);
4166 SelectObjects(pcObjects
.ActivePageIndex
+1);
4171 else // Middle Mouse Button
4173 RenderPanel
.Cursor
:= crDefault
;
4178 procedure TMainForm
.RenderPanelPaint(Sender
: TObject
);
4183 function TMainForm
.RenderMousePos(): Types
.TPoint
;
4185 Result
:= RenderPanel
.ScreenToClient(Mouse
.CursorPos
);
4188 procedure TMainForm
.RecountSelectedObjects();
4190 if SelectedObjectCount() = 0 then
4191 StatusBar
.Panels
[0].Text := ''
4193 StatusBar
.Panels
[0].Text := Format(MsgCapStatSelected
, [SelectedObjectCount()]);
4196 procedure TMainForm
.RenderPanelMouseMove(Sender
: TObject
;
4197 Shift
: TShiftState
; X
, Y
: Integer);
4200 dWidth
, dHeight
: Integer;
4203 wWidth
, wHeight
: Word;
4205 _id
:= GetFirstSelected();
4208 // Рисуем панель с текстурой, сетка - размеры текстуры:
4209 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and
4210 (lbPanelType
.ItemIndex
in [0..8]) and
4211 (lbTextureList
.ItemIndex
<> -1) and
4212 (not IsSpecialTextureSel()) then
4214 sX
:= StrToIntDef(lTextureWidth
.Caption
, DotStep
);
4215 sY
:= StrToIntDef(lTextureHeight
.Caption
, DotStep
);
4218 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4219 if (MouseAction
= MOUSEACTION_RESIZE
) and
4220 ( (SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
) and
4221 IsTexturedPanel(gPanels
[SelectedObjects
[_id
].ID
].PanelType
) and
4222 (gPanels
[SelectedObjects
[_id
].ID
].TextureName
<> '') and
4223 (not IsSpecialTexture(gPanels
[SelectedObjects
[_id
].ID
].TextureName
)) ) then
4225 sX
:= gPanels
[SelectedObjects
[_id
].ID
].TextureWidth
;
4226 sY
:= gPanels
[SelectedObjects
[_id
].ID
].TextureHeight
;
4229 // Выравнивание по сетке:
4235 else // Нет выравнивания по сетке:
4241 // Новая позиция мыши:
4243 begin // Зажата левая кнопка мыши
4244 MousePos
.X
:= (Round((X
-MouseLDownPos
.X
)/sX
)*sX
)+MouseLDownPos
.X
;
4245 MousePos
.Y
:= (Round((Y
-MouseLDownPos
.Y
)/sY
)*sY
)+MouseLDownPos
.Y
;
4249 begin // Зажата правая кнопка мыши
4250 MousePos
.X
:= (Round((X
-MouseRDownPos
.X
)/sX
)*sX
)+MouseRDownPos
.X
;
4251 MousePos
.Y
:= (Round((Y
-MouseRDownPos
.Y
)/sY
)*sY
)+MouseRDownPos
.Y
;
4254 begin // Кнопки мыши не зажаты
4255 MousePos
.X
:= Round((-MapOffset
.X
+ X
) / sX
) * sX
+ MapOffset
.X
;
4256 MousePos
.Y
:= Round((-MapOffset
.Y
+ Y
) / sY
) * sY
+ MapOffset
.Y
;
4259 // Зажата только правая кнопка мыши:
4260 if (not MouseLDown
) and (MouseRDown
) and (not MouseMDown
) then
4262 // Рисуем прямоугольник выделения:
4263 if MouseAction
= MOUSEACTION_NONE
then
4265 if DrawRect
= nil then
4267 DrawRect
.Top
:= MouseRDownPos
.y
;
4268 DrawRect
.Left
:= MouseRDownPos
.x
;
4269 DrawRect
.Bottom
:= MousePos
.y
;
4270 DrawRect
.Right
:= MousePos
.x
;
4273 // Двигаем выделенные объекты:
4274 if MouseAction
= MOUSEACTION_MOVEOBJ
then
4276 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
,
4277 MousePos
.X
-LastMovePoint
.X
,
4278 MousePos
.Y
-LastMovePoint
.Y
);
4281 // Меняем размер выделенного объекта:
4282 if MouseAction
= MOUSEACTION_RESIZE
then
4284 if (SelectedObjectCount
= 1) and
4285 (SelectedObjects
[GetFirstSelected
].Live
) then
4287 dWidth
:= MousePos
.X
-LastMovePoint
.X
;
4288 dHeight
:= MousePos
.Y
-LastMovePoint
.Y
;
4291 RESIZETYPE_VERTICAL
: dWidth
:= 0;
4292 RESIZETYPE_HORIZONTAL
: dHeight
:= 0;
4295 case ResizeDirection
of
4296 RESIZEDIR_UP
: dHeight
:= -dHeight
;
4297 RESIZEDIR_LEFT
: dWidth
:= -dWidth
;
4300 if ResizeObject(SelectedObjects
[GetFirstSelected
].ObjectType
,
4301 SelectedObjects
[GetFirstSelected
].ID
,
4302 dWidth
, dHeight
, ResizeDirection
) then
4303 LastMovePoint
:= MousePos
;
4308 // Зажата только левая кнопка мыши:
4309 if (not MouseRDown
) and (MouseLDown
) and (not MouseMDown
) then
4311 // Рисуем прямоугольник планирования панели:
4312 if MouseAction
in [MOUSEACTION_DRAWPANEL
,
4313 MOUSEACTION_DRAWTRIGGER
,
4314 MOUSEACTION_DRAWPRESS
] then
4316 if DrawRect
= nil then
4318 if ssCtrl
in Shift
then
4322 if (lbTextureList
.ItemIndex
<> -1) and (not IsSpecialTextureSel()) and
4323 (MouseAction
= MOUSEACTION_DRAWPANEL
) then
4325 if not g_GetTexture(SelectedTexture(), TextureID
) then
4326 g_GetTexture('NOTEXTURE', TextureID
);
4327 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
4329 DrawRect
.Top
:= MouseLDownPos
.y
;
4330 DrawRect
.Left
:= MouseLDownPos
.x
;
4331 DrawRect
.Bottom
:= DrawRect
.Top
+ wHeight
;
4332 DrawRect
.Right
:= DrawRect
.Left
+ wWidth
;
4336 DrawRect
.Top
:= MouseLDownPos
.y
;
4337 DrawRect
.Left
:= MouseLDownPos
.x
;
4338 DrawRect
.Bottom
:= MousePos
.y
;
4339 DrawRect
.Right
:= MousePos
.x
;
4342 else // Двигаем карту:
4343 if MouseAction
= MOUSEACTION_MOVEMAP
then
4349 // Only Middle Mouse Button is pressed
4350 if (not MouseLDown
) and (not MouseRDown
) and (MouseMDown
) then
4352 MapOffset
.X
:= -EnsureRange(-MapOffset
.X
+ MouseMDownPos
.X
- Mouse
.CursorPos
.X
,
4353 sbHorizontal
.Min
, sbHorizontal
.Max
);
4354 sbHorizontal
.Position
:= -MapOffset
.X
;
4355 MapOffset
.Y
:= -EnsureRange(-MapOffset
.Y
+ MouseMDownPos
.Y
- Mouse
.CursorPos
.Y
,
4356 sbVertical
.Min
, sbVertical
.Max
);
4357 sbVertical
.Position
:= -MapOffset
.Y
;
4358 MouseMDownPos
:= Mouse
.CursorPos
;
4361 // Клавиши мыши не зажаты:
4362 if (not MouseRDown
) and (not MouseLDown
) then
4365 // Строка состояния - координаты мыши:
4366 StatusBar
.Panels
[1].Text := Format('(%d:%d)',
4367 [MousePos
.X
-MapOffset
.X
, MousePos
.Y
-MapOffset
.Y
]);
4369 RenderPanel
.Invalidate
;
4372 procedure TMainForm
.FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
4374 CanClose
:= Application
.MessageBox(PChar(MsgMsgExitPromt
),
4376 MB_ICONQUESTION
or MB_YESNO
or
4377 MB_DEFBUTTON1
) = idYes
;
4380 procedure TMainForm
.aExitExecute(Sender
: TObject
);
4385 procedure TMainForm
.FormDestroy(Sender
: TObject
);
4391 config
:= TConfig
.CreateFile(CfgFileName
);
4393 if WindowState
<> wsMaximized
then
4395 config
.WriteInt('Editor', 'XPos', Left
);
4396 config
.WriteInt('Editor', 'YPos', Top
);
4397 config
.WriteInt('Editor', 'Width', Width
);
4398 config
.WriteInt('Editor', 'Height', Height
);
4402 config
.WriteInt('Editor', 'XPos', RestoredLeft
);
4403 config
.WriteInt('Editor', 'YPos', RestoredTop
);
4404 config
.WriteInt('Editor', 'Width', RestoredWidth
);
4405 config
.WriteInt('Editor', 'Height', RestoredHeight
);
4407 config
.WriteBool('Editor', 'Maximize', WindowState
= wsMaximized
);
4408 config
.WriteBool('Editor', 'Minimap', ShowMap
);
4409 config
.WriteInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
4410 config
.WriteInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
4411 config
.WriteBool('Editor', 'DotEnable', DotEnable
);
4412 config
.WriteInt('Editor', 'DotStep', DotStep
);
4413 config
.WriteStr('Editor', 'LastOpenDir', OpenDialog
.InitialDir
);
4414 config
.WriteStr('Editor', 'LastSaveDir', SaveDialog
.InitialDir
);
4415 config
.WriteStr('Editor', 'Language', gLanguage
);
4416 config
.WriteBool('Editor', 'EdgeShow', drEdge
[3] < 255);
4417 config
.WriteInt('Editor', 'EdgeColor', gColorEdge
);
4418 config
.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge
);
4419 config
.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine
);
4420 config
.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea
);
4421 config
.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect
);
4422 config
.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect
);
4424 for i
:= 0 to RecentCount
- 1 do
4426 if i
< RecentFiles
.Count
then s
:= RecentFiles
[i
] else s
:= '';
4428 config
.WriteStr('RecentFilesWin', IntToStr(i
), s
);
4430 config
.WriteStr('RecentFilesUnix', IntToStr(i
), s
);
4435 config
.SaveFile(CfgFileName
);
4438 slInvalidTextures
.Free
;
4441 procedure TMainForm
.FormDropFiles(Sender
: TObject
;
4442 const FileNames
: array of String);
4444 if Length(FileNames
) <> 1 then
4447 OpenMapFile(FileNames
[0]);
4450 procedure TMainForm
.RenderPanelResize(Sender
: TObject
);
4452 if MainForm
.Visible
then
4456 procedure TMainForm
.Splitter1Moved(Sender
: TObject
);
4461 procedure TMainForm
.MapTestCheck(Sender
: TObject
);
4463 if MapTestProcess
<> nil then
4465 if MapTestProcess
.Running
= false then
4467 if MapTestProcess
.ExitCode
<> 0 then
4468 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
4469 SysUtils
.DeleteFile(MapTestFile
);
4471 FreeAndNil(MapTestProcess
);
4472 tbTestMap
.Enabled
:= True;
4477 procedure TMainForm
.aMapOptionsExecute(Sender
: TObject
);
4481 MapOptionsForm
.ShowModal();
4483 ResName
:= OpenedMap
;
4484 while (Pos(':\', ResName
) > 0) do
4485 Delete(ResName
, 1, Pos(':\', ResName
) + 1);
4487 UpdateCaption(gMapInfo
.Name
, ExtractFileName(OpenedWAD
), ResName
);
4490 procedure TMainForm
.aAboutExecute(Sender
: TObject
);
4492 AboutForm
.ShowModal();
4495 procedure TMainForm
.FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
4501 if (not EditingProperties
) then
4503 if ssCtrl
in Shift
then
4506 '1': ContourEnabled
[LAYER_BACK
] := not ContourEnabled
[LAYER_BACK
];
4507 '2': ContourEnabled
[LAYER_WALLS
] := not ContourEnabled
[LAYER_WALLS
];
4508 '3': ContourEnabled
[LAYER_FOREGROUND
] := not ContourEnabled
[LAYER_FOREGROUND
];
4509 '4': ContourEnabled
[LAYER_STEPS
] := not ContourEnabled
[LAYER_STEPS
];
4510 '5': ContourEnabled
[LAYER_WATER
] := not ContourEnabled
[LAYER_WATER
];
4511 '6': ContourEnabled
[LAYER_ITEMS
] := not ContourEnabled
[LAYER_ITEMS
];
4512 '7': ContourEnabled
[LAYER_MONSTERS
] := not ContourEnabled
[LAYER_MONSTERS
];
4513 '8': ContourEnabled
[LAYER_AREAS
] := not ContourEnabled
[LAYER_AREAS
];
4514 '9': ContourEnabled
[LAYER_TRIGGERS
] := not ContourEnabled
[LAYER_TRIGGERS
];
4518 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4519 if ContourEnabled
[i
] then
4521 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4522 ContourEnabled
[i
] := not ok
4529 '1': SwitchLayer(LAYER_BACK
);
4530 '2': SwitchLayer(LAYER_WALLS
);
4531 '3': SwitchLayer(LAYER_FOREGROUND
);
4532 '4': SwitchLayer(LAYER_STEPS
);
4533 '5': SwitchLayer(LAYER_WATER
);
4534 '6': SwitchLayer(LAYER_ITEMS
);
4535 '7': SwitchLayer(LAYER_MONSTERS
);
4536 '8': SwitchLayer(LAYER_AREAS
);
4537 '9': SwitchLayer(LAYER_TRIGGERS
);
4538 '0': tbShowClick(tbShow
);
4542 if Key
= Ord('V') then
4543 begin // Поворот монстров и областей:
4544 if (SelectedObjects
<> nil) then
4546 for i
:= 0 to High(SelectedObjects
) do
4547 if (SelectedObjects
[i
].Live
) then
4549 if (SelectedObjects
[i
].ObjectType
= OBJECT_MONSTER
) then
4551 g_ChangeDir(gMonsters
[SelectedObjects
[i
].ID
].Direction
);
4554 if (SelectedObjects
[i
].ObjectType
= OBJECT_AREA
) then
4556 g_ChangeDir(gAreas
[SelectedObjects
[i
].ID
].Direction
);
4562 if pcObjects
.ActivePage
= tsMonsters
then
4564 if rbMonsterLeft
.Checked
then
4565 rbMonsterRight
.Checked
:= True
4567 rbMonsterLeft
.Checked
:= True;
4569 if pcObjects
.ActivePage
= tsAreas
then
4571 if rbAreaLeft
.Checked
then
4572 rbAreaRight
.Checked
:= True
4574 rbAreaLeft
.Checked
:= True;
4579 if not (ssCtrl
in Shift
) then
4581 // Быстрое превью карты:
4582 if Key
= Ord('E') then
4584 if PreviewMode
= 0 then
4588 // Вертикальный скролл карты:
4591 if Key
= Ord('W') then
4594 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4595 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4596 MapOffset
.Y
:= -Position
;
4599 if (MouseLDown
or MouseRDown
) then
4601 if DrawRect
<> nil then
4603 Inc(MouseLDownPos
.y
, dy
);
4604 Inc(MouseRDownPos
.y
, dy
);
4606 Inc(LastMovePoint
.Y
, dy
);
4607 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4611 if Key
= Ord('S') then
4614 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4615 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4616 MapOffset
.Y
:= -Position
;
4619 if (MouseLDown
or MouseRDown
) then
4621 if DrawRect
<> nil then
4623 Inc(MouseLDownPos
.y
, dy
);
4624 Inc(MouseRDownPos
.y
, dy
);
4626 Inc(LastMovePoint
.Y
, dy
);
4627 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4632 // Горизонтальный скролл карты:
4633 with sbHorizontal
do
4635 if Key
= Ord('A') then
4638 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4639 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4640 MapOffset
.X
:= -Position
;
4643 if (MouseLDown
or MouseRDown
) then
4645 if DrawRect
<> nil then
4647 Inc(MouseLDownPos
.x
, dx
);
4648 Inc(MouseRDownPos
.x
, dx
);
4650 Inc(LastMovePoint
.X
, dx
);
4651 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4655 if Key
= Ord('D') then
4658 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4659 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4660 MapOffset
.X
:= -Position
;
4663 if (MouseLDown
or MouseRDown
) then
4665 if DrawRect
<> nil then
4667 Inc(MouseLDownPos
.x
, dx
);
4668 Inc(MouseRDownPos
.x
, dx
);
4670 Inc(LastMovePoint
.X
, dx
);
4671 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4676 else // ssCtrl in Shift
4678 if ssShift
in Shift
then
4680 // Вставка по абсолютному смещению:
4681 if Key
= Ord('V') then
4682 aPasteObjectExecute(Sender
);
4684 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4688 // Удалить выделенные объекты:
4689 if (Key
= VK_DELETE
) and (SelectedObjects
<> nil) and
4690 RenderPanel
.Focused() then
4691 DeleteSelectedObjects();
4694 if (Key
= VK_ESCAPE
) and (SelectedObjects
<> nil) then
4695 RemoveSelectFromObjects();
4697 // Передвинуть объекты:
4698 if MainForm
.ActiveControl
= RenderPanel
then
4703 if Key
= VK_NUMPAD4
then
4704 dx
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4705 if Key
= VK_NUMPAD6
then
4706 dx
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4707 if Key
= VK_NUMPAD8
then
4708 dy
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4709 if Key
= VK_NUMPAD5
then
4710 dy
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4712 if (dx
<> 0) or (dy
<> 0) then
4714 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
, dx
, dy
);
4719 if ssCtrl
in Shift
then
4721 // Выбор панели с текстурой для триггера
4722 if Key
= Ord('T') then
4724 DrawPressRect
:= False;
4725 if SelectFlag
= SELECTFLAG_TEXTURE
then
4727 SelectFlag
:= SELECTFLAG_NONE
;
4730 vleObjectProperty
.FindRow(MsgPropTrTexturePanel
, i
);
4732 SelectFlag
:= SELECTFLAG_TEXTURE
;
4735 if Key
= Ord('D') then
4737 SelectFlag
:= SELECTFLAG_NONE
;
4738 if DrawPressRect
then
4740 DrawPressRect
:= False;
4745 // Выбор области воздействия, в зависимости от типа триггера
4746 vleObjectProperty
.FindRow(MsgPropTrExArea
, i
);
4749 DrawPressRect
:= True;
4752 vleObjectProperty
.FindRow(MsgPropTrDoorPanel
, i
);
4754 vleObjectProperty
.FindRow(MsgPropTrTrapPanel
, i
);
4757 SelectFlag
:= SELECTFLAG_DOOR
;
4760 vleObjectProperty
.FindRow(MsgPropTrLiftPanel
, i
);
4763 SelectFlag
:= SELECTFLAG_LIFT
;
4766 vleObjectProperty
.FindRow(MsgPropTrTeleportTo
, i
);
4769 SelectFlag
:= SELECTFLAG_TELEPORT
;
4772 vleObjectProperty
.FindRow(MsgPropTrSpawnTo
, i
);
4775 SelectFlag
:= SELECTFLAG_SPAWNPOINT
;
4779 // Выбор основного параметра, в зависимости от типа триггера
4780 vleObjectProperty
.FindRow(MsgPropTrNextMap
, i
);
4783 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
4784 SelectMapForm
.Caption
:= MsgCapSelect
;
4785 SelectMapForm
.GetMaps(FileName
);
4787 if SelectMapForm
.ShowModal() = mrOK
then
4789 vleObjectProperty
.Cells
[1, i
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
4790 bApplyProperty
.Click();
4794 vleObjectProperty
.FindRow(MsgPropTrSoundName
, i
);
4796 vleObjectProperty
.FindRow(MsgPropTrMusicName
, i
);
4799 AddSoundForm
.OKFunction
:= nil;
4800 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
4801 AddSoundForm
.SetResource
:= vleObjectProperty
.Cells
[1, i
];
4803 if (AddSoundForm
.ShowModal() = mrOk
) then
4805 vleObjectProperty
.Cells
[1, i
] := AddSoundForm
.ResourceName
;
4806 bApplyProperty
.Click();
4810 vleObjectProperty
.FindRow(MsgPropTrPushAngle
, i
);
4812 vleObjectProperty
.FindRow(MsgPropTrMessageText
, i
);
4815 vleObjectProperty
.Row
:= i
;
4816 vleObjectProperty
.SetFocus();
4823 procedure TMainForm
.aOptimizeExecute(Sender
: TObject
);
4825 RemoveSelectFromObjects();
4826 MapOptimizationForm
.ShowModal();
4829 procedure TMainForm
.aCheckMapExecute(Sender
: TObject
);
4831 MapCheckForm
.ShowModal();
4834 procedure TMainForm
.bbAddTextureClick(Sender
: TObject
);
4836 AddTextureForm
.lbResourcesList
.MultiSelect
:= True;
4837 AddTextureForm
.ShowModal();
4840 procedure TMainForm
.lbTextureListClick(Sender
: TObject
);
4843 TextureWidth
, TextureHeight
: Word;
4848 if (lbTextureList
.ItemIndex
<> -1) and
4849 (not IsSpecialTextureSel()) then
4851 if g_GetTexture(SelectedTexture(), TextureID
) then
4853 g_GetTextureSizeByID(TextureID
, TextureWidth
, TextureHeight
);
4855 lTextureWidth
.Caption
:= IntToStr(TextureWidth
);
4856 lTextureHeight
.Caption
:= IntToStr(TextureHeight
);
4859 lTextureWidth
.Caption
:= MsgNotAccessible
;
4860 lTextureHeight
.Caption
:= MsgNotAccessible
;
4865 lTextureWidth
.Caption
:= '';
4866 lTextureHeight
.Caption
:= '';
4870 procedure TMainForm
.lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
4871 ARect
: TRect
; State
: TOwnerDrawState
);
4873 with Control
as TListBox
do
4875 if LCLType
.odSelected
in State
then
4877 Canvas
.Brush
.Color
:= clHighlight
;
4878 Canvas
.Font
.Color
:= clHighlightText
;
4880 if (Items
<> nil) and (Index
>= 0) then
4881 if slInvalidTextures
.IndexOf(Items
[Index
]) > -1 then
4883 Canvas
.Brush
.Color
:= clRed
;
4884 Canvas
.Font
.Color
:= clWhite
;
4886 Canvas
.FillRect(ARect
);
4887 Canvas
.TextRect(ARect
, ARect
.Left
, ARect
.Top
, Items
[Index
]);
4891 procedure TMainForm
.miMacMinimizeClick(Sender
: TObject
);
4893 self
.WindowState
:= wsMinimized
;
4894 self
.FormWindowStateChange(Sender
);
4897 procedure TMainForm
.miMacZoomClick(Sender
: TObject
);
4899 if self
.WindowState
= wsMaximized
then
4900 self
.WindowState
:= wsNormal
4902 self
.WindowState
:= wsMaximized
;
4903 self
.FormWindowStateChange(Sender
);
4906 procedure TMainForm
.miReopenMapClick(Sender
: TObject
);
4908 FileName
, Resource
: String;
4910 if OpenedMap
= '' then
4913 if Application
.MessageBox(PChar(MsgMsgReopenMapPromt
),
4914 PChar(MsgMenuFileReopen
), MB_ICONQUESTION
or MB_YESNO
) <> idYes
then
4917 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, @Resource
);
4918 OpenMap(FileName
, Resource
);
4921 procedure TMainForm
.vleObjectPropertyGetPickList(Sender
: TObject
;
4922 const KeyName
: String; Values
: TStrings
);
4924 if vleObjectProperty
.ItemProps
[KeyName
].EditStyle
= esPickList
then
4926 if KeyName
= MsgPropDirection
then
4928 Values
.Add(DirNames
[D_LEFT
]);
4929 Values
.Add(DirNames
[D_RIGHT
]);
4931 else if KeyName
= MsgPropTrTeleportDir
then
4933 Values
.Add(DirNamesAdv
[0]);
4934 Values
.Add(DirNamesAdv
[1]);
4935 Values
.Add(DirNamesAdv
[2]);
4936 Values
.Add(DirNamesAdv
[3]);
4938 else if KeyName
= MsgPropTrMusicAct
then
4940 Values
.Add(MsgPropTrMusicOn
);
4941 Values
.Add(MsgPropTrMusicOff
);
4943 else if KeyName
= MsgPropTrMonsterBehaviour
then
4945 Values
.Add(MsgPropTrMonsterBehaviour0
);
4946 Values
.Add(MsgPropTrMonsterBehaviour1
);
4947 Values
.Add(MsgPropTrMonsterBehaviour2
);
4948 Values
.Add(MsgPropTrMonsterBehaviour3
);
4949 Values
.Add(MsgPropTrMonsterBehaviour4
);
4950 Values
.Add(MsgPropTrMonsterBehaviour5
);
4952 else if KeyName
= MsgPropTrScoreAct
then
4954 Values
.Add(MsgPropTrScoreAct0
);
4955 Values
.Add(MsgPropTrScoreAct1
);
4956 Values
.Add(MsgPropTrScoreAct2
);
4957 Values
.Add(MsgPropTrScoreAct3
);
4959 else if KeyName
= MsgPropTrScoreTeam
then
4961 Values
.Add(MsgPropTrScoreTeam0
);
4962 Values
.Add(MsgPropTrScoreTeam1
);
4963 Values
.Add(MsgPropTrScoreTeam2
);
4964 Values
.Add(MsgPropTrScoreTeam3
);
4966 else if KeyName
= MsgPropTrMessageKind
then
4968 Values
.Add(MsgPropTrMessageKind0
);
4969 Values
.Add(MsgPropTrMessageKind1
);
4971 else if KeyName
= MsgPropTrMessageTo
then
4973 Values
.Add(MsgPropTrMessageTo0
);
4974 Values
.Add(MsgPropTrMessageTo1
);
4975 Values
.Add(MsgPropTrMessageTo2
);
4976 Values
.Add(MsgPropTrMessageTo3
);
4977 Values
.Add(MsgPropTrMessageTo4
);
4978 Values
.Add(MsgPropTrMessageTo5
);
4980 else if KeyName
= MsgPropTrShotTo
then
4982 Values
.Add(MsgPropTrShotTo0
);
4983 Values
.Add(MsgPropTrShotTo1
);
4984 Values
.Add(MsgPropTrShotTo2
);
4985 Values
.Add(MsgPropTrShotTo3
);
4986 Values
.Add(MsgPropTrShotTo4
);
4987 Values
.Add(MsgPropTrShotTo5
);
4988 Values
.Add(MsgPropTrShotTo6
);
4990 else if KeyName
= MsgPropTrShotAim
then
4992 Values
.Add(MsgPropTrShotAim0
);
4993 Values
.Add(MsgPropTrShotAim1
);
4994 Values
.Add(MsgPropTrShotAim2
);
4995 Values
.Add(MsgPropTrShotAim3
);
4997 else if KeyName
= MsgPropTrDamageKind
then
4999 Values
.Add(MsgPropTrDamageKind0
);
5000 Values
.Add(MsgPropTrDamageKind3
);
5001 Values
.Add(MsgPropTrDamageKind4
);
5002 Values
.Add(MsgPropTrDamageKind5
);
5003 Values
.Add(MsgPropTrDamageKind6
);
5004 Values
.Add(MsgPropTrDamageKind7
);
5005 Values
.Add(MsgPropTrDamageKind8
);
5007 else if (KeyName
= MsgPropPanelBlend
) or
5008 (KeyName
= MsgPropDmOnly
) or
5009 (KeyName
= MsgPropItemFalls
) or
5010 (KeyName
= MsgPropTrEnabled
) or
5011 (KeyName
= MsgPropTrD2d
) or
5012 (KeyName
= MsgPropTrSilent
) or
5013 (KeyName
= MsgPropTrTeleportSilent
) or
5014 (KeyName
= MsgPropTrExRandom
) or
5015 (KeyName
= MsgPropTrTextureOnce
) or
5016 (KeyName
= MsgPropTrTextureAnimOnce
) or
5017 (KeyName
= MsgPropTrSoundLocal
) or
5018 (KeyName
= MsgPropTrSoundSwitch
) or
5019 (KeyName
= MsgPropTrMonsterActive
) or
5020 (KeyName
= MsgPropTrPushReset
) or
5021 (KeyName
= MsgPropTrScoreCon
) or
5022 (KeyName
= MsgPropTrScoreMsg
) or
5023 (KeyName
= MsgPropTrHealthMax
) or
5024 (KeyName
= MsgPropTrShotSound
) or
5025 (KeyName
= MsgPropTrEffectCenter
) then
5027 Values
.Add(BoolNames
[True]);
5028 Values
.Add(BoolNames
[False]);
5033 procedure TMainForm
.bApplyPropertyClick(Sender
: TObject
);
5035 _id
, a
, r
, c
: Integer;
5045 if SelectedObjectCount() <> 1 then
5047 if not SelectedObjects
[GetFirstSelected()].Live
then
5051 if not CheckProperty() then
5057 _id
:= GetFirstSelected();
5059 r
:= vleObjectProperty
.Row
;
5060 c
:= vleObjectProperty
.Col
;
5062 case SelectedObjects
[_id
].ObjectType
of
5065 with gPanels
[SelectedObjects
[_id
].ID
] do
5067 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5068 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5069 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5070 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5072 PanelType
:= GetPanelType(vleObjectProperty
.Values
[MsgPropPanelType
]);
5074 // Сброс ссылки на триггеры смены текстуры:
5075 if not WordBool(PanelType
and (PANEL_WALL
or PANEL_FORE
or PANEL_BACK
)) then
5076 if gTriggers
<> nil then
5077 for a
:= 0 to High(gTriggers
) do
5079 if (gTriggers
[a
].TriggerType
<> 0) and
5080 (gTriggers
[a
].TexturePanel
= Integer(SelectedObjects
[_id
].ID
)) then
5081 gTriggers
[a
].TexturePanel
:= -1;
5082 if (gTriggers
[a
].TriggerType
= TRIGGER_SHOT
) and
5083 (gTriggers
[a
].Data
.ShotPanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5084 gTriggers
[a
].Data
.ShotPanelID
:= -1;
5087 // Сброс ссылки на триггеры лифта:
5088 if not WordBool(PanelType
and (PANEL_LIFTUP
or PANEL_LIFTDOWN
or PANEL_LIFTLEFT
or PANEL_LIFTRIGHT
)) then
5089 if gTriggers
<> nil then
5090 for a
:= 0 to High(gTriggers
) do
5091 if (gTriggers
[a
].TriggerType
in [TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
]) and
5092 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5093 gTriggers
[a
].Data
.PanelID
:= -1;
5095 // Сброс ссылки на триггеры двери:
5096 if not WordBool(PanelType
and (PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
5097 if gTriggers
<> nil then
5098 for a
:= 0 to High(gTriggers
) do
5099 if (gTriggers
[a
].TriggerType
in [TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5100 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
]) and
5101 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5102 gTriggers
[a
].Data
.PanelID
:= -1;
5104 if IsTexturedPanel(PanelType
) then
5105 begin // Может быть текстура
5106 if TextureName
<> '' then
5107 begin // Была текстура
5108 Alpha
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropPanelAlpha
]));
5109 Blending
:= NameToBool(vleObjectProperty
.Values
[MsgPropPanelBlend
]);
5118 TextureName
:= vleObjectProperty
.Values
[MsgPropPanelTex
];
5120 if TextureName
<> '' then
5121 begin // Есть текстура
5122 // Обычная текстура:
5123 if not IsSpecialTexture(TextureName
) then
5125 g_GetTextureSizeByName(TextureName
,
5126 TextureWidth
, TextureHeight
);
5128 // Проверка кратности размеров панели:
5130 if TextureWidth
<> 0 then
5131 if gPanels
[SelectedObjects
[_id
].ID
].Width
mod TextureWidth
<> 0 then
5133 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
5137 if Res
and (TextureHeight
<> 0) then
5138 if gPanels
[SelectedObjects
[_id
].ID
].Height
mod TextureHeight
<> 0 then
5140 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
5147 if not g_GetTexture(TextureName
, TextureID
) then
5148 // Не удалось загрузить текстуру, рисуем NOTEXTURE
5149 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5151 TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5152 g_GetTextureSizeByID(NoTextureID
, NW
, NH
);
5154 TextureHeight
:= NH
;
5157 TextureID
:= TEXTURE_SPECIAL_NONE
;
5167 TextureID
:= TEXTURE_SPECIAL_NONE
;
5170 else // Спец.текстура
5174 TextureID
:= SpecialTextureID(TextureName
);
5177 else // Нет текстуры
5181 TextureID
:= TEXTURE_SPECIAL_NONE
;
5184 else // Не может быть текстуры
5191 TextureID
:= TEXTURE_SPECIAL_NONE
;
5198 with gItems
[SelectedObjects
[_id
].ID
] do
5200 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5201 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5202 OnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5203 Fall
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5209 with gMonsters
[SelectedObjects
[_id
].ID
] do
5211 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5212 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5213 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5219 with gAreas
[SelectedObjects
[_id
].ID
] do
5221 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5222 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5223 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5229 with gTriggers
[SelectedObjects
[_id
].ID
] do
5231 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5232 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5233 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5234 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5235 Enabled
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrEnabled
]);
5236 ActivateType
:= StrToActivate(vleObjectProperty
.Values
[MsgPropTrActivation
]);
5237 Key
:= StrToKey(vleObjectProperty
.Values
[MsgPropTrKeys
]);
5242 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrNextMap
]);
5243 FillByte(Data
.MapName
[0], 16, 0);
5245 Move(s
[1], Data
.MapName
[0], Min(Length(s
), 16));
5250 Data
.ActivateOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureOnce
]);
5251 Data
.AnimOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureAnimOnce
]);
5254 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5256 Data
.Wait
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 65535);
5257 Data
.Count
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExCount
], 0), 65535);
5258 if Data
.Count
< 1 then
5260 if TriggerType
= TRIGGER_PRESS
then
5261 Data
.ExtRandom
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrExRandom
]);
5264 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
, TRIGGER_DOOR5
,
5265 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
, TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
,
5268 Data
.NoSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5269 Data
.d2d_doors
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5274 Data
.d2d_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5275 Data
.silent_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTeleportSilent
]);
5276 Data
.TlpDir
:= NameToDirAdv(vleObjectProperty
.Values
[MsgPropTrTeleportDir
]);
5281 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrSoundName
]);
5282 FillByte(Data
.SoundName
[0], 64, 0);
5284 Move(s
[1], Data
.SoundName
[0], Min(Length(s
), 64));
5286 Data
.Volume
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundVolume
], 0), 255);
5287 Data
.Pan
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundPan
], 0), 255);
5288 Data
.PlayCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundCount
], 0), 255);
5289 Data
.Local
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundLocal
]);
5290 Data
.SoundSwitch
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundSwitch
]);
5293 TRIGGER_SPAWNMONSTER
:
5295 Data
.MonType
:= StrToMonster(vleObjectProperty
.Values
[MsgPropTrMonsterType
]);
5296 Data
.MonDir
:= Byte(NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]));
5297 Data
.MonHealth
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 1000000);
5298 if Data
.MonHealth
< 0 then
5299 Data
.MonHealth
:= 0;
5300 Data
.MonActive
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrMonsterActive
]);
5301 Data
.MonCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5302 if Data
.MonCount
< 1 then
5304 Data
.MonEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5305 Data
.MonMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5306 Data
.MonDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5308 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour1
then
5310 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour2
then
5312 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour3
then
5314 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour4
then
5316 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour5
then
5322 Data
.ItemType
:= StrToItem(vleObjectProperty
.Values
[MsgPropTrItemType
]);
5323 Data
.ItemOnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5324 Data
.ItemFalls
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5325 Data
.ItemCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5326 if Data
.ItemCount
< 1 then
5327 Data
.ItemCount
:= 1;
5328 Data
.ItemEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5329 Data
.ItemMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5330 Data
.ItemDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5335 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMusicName
]);
5336 FillByte(Data
.MusicName
[0], 64, 0);
5338 Move(s
[1], Data
.MusicName
[0], Min(Length(s
), 64));
5340 if vleObjectProperty
.Values
[MsgPropTrMusicAct
] = MsgPropTrMusicOn
then
5341 Data
.MusicAction
:= 1
5343 Data
.MusicAction
:= 0;
5348 Data
.PushAngle
:= Min(
5349 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushAngle
], 0), 360);
5350 Data
.PushForce
:= Min(
5351 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushForce
], 0), 255);
5352 Data
.ResetVel
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrPushReset
]);
5357 Data
.ScoreAction
:= 0;
5358 if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct1
then
5359 Data
.ScoreAction
:= 1
5360 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct2
then
5361 Data
.ScoreAction
:= 2
5362 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct3
then
5363 Data
.ScoreAction
:= 3;
5364 Data
.ScoreCount
:= Min(Max(
5365 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5366 Data
.ScoreTeam
:= 0;
5367 if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam1
then
5369 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam2
then
5371 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam3
then
5372 Data
.ScoreTeam
:= 3;
5373 Data
.ScoreCon
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreCon
]);
5374 Data
.ScoreMsg
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreMsg
]);
5379 Data
.MessageKind
:= 0;
5380 if vleObjectProperty
.Values
[MsgPropTrMessageKind
] = MsgPropTrMessageKind1
then
5381 Data
.MessageKind
:= 1;
5383 Data
.MessageSendTo
:= 0;
5384 if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo1
then
5385 Data
.MessageSendTo
:= 1
5386 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo2
then
5387 Data
.MessageSendTo
:= 2
5388 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo3
then
5389 Data
.MessageSendTo
:= 3
5390 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo4
then
5391 Data
.MessageSendTo
:= 4
5392 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo5
then
5393 Data
.MessageSendTo
:= 5;
5395 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMessageText
]);
5396 FillByte(Data
.MessageText
[0], 100, 0);
5398 Move(s
[1], Data
.MessageText
[0], Min(Length(s
), 100));
5400 Data
.MessageTime
:= Min(Max(
5401 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrMessageTime
], 0), 0), 65535);
5406 Data
.DamageValue
:= Min(Max(
5407 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrDamageValue
], 0), 0), 65535);
5408 Data
.DamageInterval
:= Min(Max(
5409 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5410 s
:= vleObjectProperty
.Values
[MsgPropTrDamageKind
];
5411 if s
= MsgPropTrDamageKind3
then
5412 Data
.DamageKind
:= 3
5413 else if s
= MsgPropTrDamageKind4
then
5414 Data
.DamageKind
:= 4
5415 else if s
= MsgPropTrDamageKind5
then
5416 Data
.DamageKind
:= 5
5417 else if s
= MsgPropTrDamageKind6
then
5418 Data
.DamageKind
:= 6
5419 else if s
= MsgPropTrDamageKind7
then
5420 Data
.DamageKind
:= 7
5421 else if s
= MsgPropTrDamageKind8
then
5422 Data
.DamageKind
:= 8
5424 Data
.DamageKind
:= 0;
5429 Data
.HealValue
:= Min(Max(
5430 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 0), 65535);
5431 Data
.HealInterval
:= Min(Max(
5432 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5433 Data
.HealMax
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrHealthMax
]);
5434 Data
.HealSilent
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5439 Data
.ShotType
:= StrToShot(vleObjectProperty
.Values
[MsgPropTrShotType
]);
5440 Data
.ShotSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrShotSound
]);
5441 Data
.ShotTarget
:= 0;
5442 if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo1
then
5443 Data
.ShotTarget
:= 1
5444 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo2
then
5445 Data
.ShotTarget
:= 2
5446 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo3
then
5447 Data
.ShotTarget
:= 3
5448 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo4
then
5449 Data
.ShotTarget
:= 4
5450 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo5
then
5451 Data
.ShotTarget
:= 5
5452 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo6
then
5453 Data
.ShotTarget
:= 6;
5454 Data
.ShotIntSight
:= Min(Max(
5455 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotSight
], 0), 0), 65535);
5457 if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim1
then
5459 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim2
then
5461 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim3
then
5463 Data
.ShotAngle
:= Min(
5464 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAngle
], 0), 360);
5465 Data
.ShotWait
:= Min(Max(
5466 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5467 Data
.ShotAccuracy
:= Min(Max(
5468 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAcc
], 0), 0), 65535);
5469 Data
.ShotAmmo
:= Min(Max(
5470 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAmmo
], 0), 0), 65535);
5471 Data
.ShotIntReload
:= Min(Max(
5472 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotReload
], 0), 0), 65535);
5477 Data
.FXCount
:= Min(Max(
5478 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5479 if vleObjectProperty
.Values
[MsgPropTrEffectType
] = MsgPropTrEffectParticle
then
5481 Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
5482 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
5483 if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSliquid
then
5484 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
5485 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectLliquid
then
5486 Data
.FXSubType
:= TRIGGER_EFFECT_LLIQUID
5487 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectDliquid
then
5488 Data
.FXSubType
:= TRIGGER_EFFECT_DLIQUID
5489 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBlood
then
5490 Data
.FXSubType
:= TRIGGER_EFFECT_BLOOD
5491 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSpark
then
5492 Data
.FXSubType
:= TRIGGER_EFFECT_SPARK
5493 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBubble
then
5494 Data
.FXSubType
:= TRIGGER_EFFECT_BUBBLE
;
5497 Data
.FXType
:= TRIGGER_EFFECT_ANIMATION
;
5498 Data
.FXSubType
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrEffectSubtype
]);
5501 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectColor
], 0), 0), $FFFFFF);
5502 Data
.FXColorR
:= a
and $FF;
5503 Data
.FXColorG
:= (a
shr 8) and $FF;
5504 Data
.FXColorB
:= (a
shr 16) and $FF;
5505 if NameToBool(vleObjectProperty
.Values
[MsgPropTrEffectCenter
]) then
5509 Data
.FXWait
:= Min(Max(
5510 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5511 Data
.FXVelX
:= Min(Max(
5512 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVelx
], 0), -128), 127);
5513 Data
.FXVelY
:= Min(Max(
5514 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVely
], 0), -128), 127);
5515 Data
.FXSpreadL
:= Min(Max(
5516 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpl
], 0), 0), 255);
5517 Data
.FXSpreadR
:= Min(Max(
5518 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpr
], 0), 0), 255);
5519 Data
.FXSpreadU
:= Min(Max(
5520 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpu
], 0), 0), 255);
5521 Data
.FXSpreadD
:= Min(Max(
5522 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpd
], 0), 0), 255);
5531 vleObjectProperty
.Row
:= r
;
5532 vleObjectProperty
.Col
:= c
;
5535 procedure TMainForm
.bbRemoveTextureClick(Sender
: TObject
);
5539 i
:= lbTextureList
.ItemIndex
;
5543 if Application
.MessageBox(PChar(Format(MsgMsgDelTexturePromt
,
5544 [SelectedTexture()])),
5545 PChar(MsgMsgDelTexture
),
5546 MB_ICONQUESTION
or MB_YESNO
or
5547 MB_DEFBUTTON1
) <> idYes
then
5550 if gPanels
<> nil then
5551 for a
:= 0 to High(gPanels
) do
5552 if (gPanels
[a
].PanelType
<> 0) and
5553 (gPanels
[a
].TextureName
= SelectedTexture()) then
5555 ErrorMessageBox(MsgMsgDelTextureCant
);
5559 g_DeleteTexture(SelectedTexture());
5560 i
:= slInvalidTextures
.IndexOf(lbTextureList
.Items
[i
]);
5562 slInvalidTextures
.Delete(i
);
5563 if lbTextureList
.ItemIndex
> -1 then
5564 lbTextureList
.Items
.Delete(lbTextureList
.ItemIndex
)
5567 procedure TMainForm
.aNewMapExecute(Sender
: TObject
);
5569 if Application
.MessageBox(PChar(MsgMsgClearMapPromt
), PChar(MsgMsgClearMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON1
) = mrYes
then
5573 procedure TMainForm
.aUndoExecute(Sender
: TObject
);
5577 if UndoBuffer
= nil then
5579 if UndoBuffer
[High(UndoBuffer
)] = nil then
5582 for a
:= 0 to High(UndoBuffer
[High(UndoBuffer
)]) do
5583 with UndoBuffer
[High(UndoBuffer
)][a
] do
5591 UNDO_DELETE_ITEM
: AddItem(Item
);
5592 UNDO_DELETE_AREA
: AddArea(Area
);
5593 UNDO_DELETE_MONSTER
: AddMonster(Monster
);
5594 UNDO_DELETE_TRIGGER
: AddTrigger(Trigger
);
5595 UNDO_ADD_PANEL
: RemoveObject(AddID
, OBJECT_PANEL
);
5596 UNDO_ADD_ITEM
: RemoveObject(AddID
, OBJECT_ITEM
);
5597 UNDO_ADD_AREA
: RemoveObject(AddID
, OBJECT_AREA
);
5598 UNDO_ADD_MONSTER
: RemoveObject(AddID
, OBJECT_MONSTER
);
5599 UNDO_ADD_TRIGGER
: RemoveObject(AddID
, OBJECT_TRIGGER
);
5603 SetLength(UndoBuffer
, Length(UndoBuffer
)-1);
5605 RemoveSelectFromObjects();
5607 miUndo
.Enabled
:= UndoBuffer
<> nil;
5611 procedure TMainForm
.aCopyObjectExecute(Sender
: TObject
);
5614 CopyBuffer
: TCopyRecArray
;
5618 function CB_Compare(I1
, I2
: TCopyRec
): Integer;
5620 Result
:= Integer(I1
.ObjectType
) - Integer(I2
.ObjectType
);
5622 if Result
= 0 then // Одного типа
5623 Result
:= Integer(I1
.ID
) - Integer(I2
.ID
);
5626 procedure QuickSortCopyBuffer(L
, R
: Integer);
5634 P
:= CopyBuffer
[(L
+ R
) shr 1];
5637 while CB_Compare(CopyBuffer
[I
], P
) < 0 do
5639 while CB_Compare(CopyBuffer
[J
], P
) > 0 do
5645 CopyBuffer
[I
] := CopyBuffer
[J
];
5653 QuickSortCopyBuffer(L
, J
);
5660 if SelectedObjects
= nil then
5666 // Копируем объекты:
5667 for a
:= 0 to High(SelectedObjects
) do
5668 if SelectedObjects
[a
].Live
then
5669 with SelectedObjects
[a
] do
5671 SetLength(CopyBuffer
, Length(CopyBuffer
)+1);
5672 b
:= High(CopyBuffer
);
5673 CopyBuffer
[b
].ID
:= ID
;
5674 CopyBuffer
[b
].Panel
:= nil;
5679 CopyBuffer
[b
].ObjectType
:= OBJECT_PANEL
;
5680 New(CopyBuffer
[b
].Panel
);
5681 CopyBuffer
[b
].Panel
^ := gPanels
[ID
];
5686 CopyBuffer
[b
].ObjectType
:= OBJECT_ITEM
;
5687 CopyBuffer
[b
].Item
:= gItems
[ID
];
5692 CopyBuffer
[b
].ObjectType
:= OBJECT_MONSTER
;
5693 CopyBuffer
[b
].Monster
:= gMonsters
[ID
];
5698 CopyBuffer
[b
].ObjectType
:= OBJECT_AREA
;
5699 CopyBuffer
[b
].Area
:= gAreas
[ID
];
5704 CopyBuffer
[b
].ObjectType
:= OBJECT_TRIGGER
;
5705 CopyBuffer
[b
].Trigger
:= gTriggers
[ID
];
5710 // Сортировка по ID:
5711 if CopyBuffer
<> nil then
5713 QuickSortCopyBuffer(0, b
);
5716 // Постановка ссылок триггеров:
5717 for a
:= 0 to Length(CopyBuffer
)-1 do
5718 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5720 case CopyBuffer
[a
].Trigger
.TriggerType
of
5721 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5722 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5723 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5724 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5728 for b
:= 0 to Length(CopyBuffer
)-1 do
5729 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5730 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.PanelID
) then
5732 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= b
;
5737 // Этих панелей нет среди копируемых:
5739 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= -1;
5742 TRIGGER_PRESS
, TRIGGER_ON
,
5743 TRIGGER_OFF
, TRIGGER_ONOFF
:
5744 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5748 for b
:= 0 to Length(CopyBuffer
)-1 do
5749 if (CopyBuffer
[b
].ObjectType
= OBJECT_MONSTER
) and
5750 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1) then
5752 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= b
+1;
5757 // Этих монстров нет среди копируемых:
5759 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= 0;
5763 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5767 for b
:= 0 to Length(CopyBuffer
)-1 do
5768 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5769 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
) then
5771 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= b
;
5776 // Этих панелей нет среди копируемых:
5778 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= -1;
5782 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5786 for b
:= 0 to Length(CopyBuffer
)-1 do
5787 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5788 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.TexturePanel
) then
5790 CopyBuffer
[a
].Trigger
.TexturePanel
:= b
;
5795 // Этих панелей нет среди копируемых:
5797 CopyBuffer
[a
].Trigger
.TexturePanel
:= -1;
5802 str
:= CopyBufferToString(CopyBuffer
);
5803 ClipBoard
.AsText
:= str
;
5805 for a
:= 0 to Length(CopyBuffer
)-1 do
5806 if (CopyBuffer
[a
].ObjectType
= OBJECT_PANEL
) and
5807 (CopyBuffer
[a
].Panel
<> nil) then
5808 Dispose(CopyBuffer
[a
].Panel
);
5813 procedure TMainForm
.aPasteObjectExecute(Sender
: TObject
);
5816 CopyBuffer
: TCopyRecArray
;
5818 swad
, ssec
, sres
: String;
5821 xadj
, yadj
: LongInt;
5826 pmin
.X
:= High(pmin
.X
);
5827 pmin
.Y
:= High(pmin
.Y
);
5829 StringToCopyBuffer(ClipBoard
.AsText
, CopyBuffer
, pmin
);
5830 if CopyBuffer
= nil then
5833 rel
:= not(ssShift
in GetKeyShiftState());
5834 h
:= High(CopyBuffer
);
5835 RemoveSelectFromObjects();
5839 xadj
:= -pmin
.X
- Floor((MapOffset
.X
- 32) / DotStep
) * DotStep
;
5840 yadj
:= -pmin
.Y
- Floor((MapOffset
.Y
- 32) / DotStep
) * DotStep
;
5849 with CopyBuffer
[a
] do
5853 if Panel
<> nil then
5861 Panel
^.TextureID
:= TEXTURE_SPECIAL_NONE
;
5862 Panel
^.TextureWidth
:= 1;
5863 Panel
^.TextureHeight
:= 1;
5865 if (Panel
^.PanelType
= PANEL_LIFTUP
) or
5866 (Panel
^.PanelType
= PANEL_LIFTDOWN
) or
5867 (Panel
^.PanelType
= PANEL_LIFTLEFT
) or
5868 (Panel
^.PanelType
= PANEL_LIFTRIGHT
) or
5869 (Panel
^.PanelType
= PANEL_BLOCKMON
) or
5870 (Panel
^.TextureName
= '') then
5871 begin // Нет или не может быть текстуры:
5873 else // Есть текстура:
5875 // Обычная текстура:
5876 if not IsSpecialTexture(Panel
^.TextureName
) then
5878 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5882 g_ProcessResourceStr(Panel
^.TextureName
, swad
, ssec
, sres
);
5883 AddTexture(swad
, ssec
, sres
, True);
5884 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5888 g_GetTextureSizeByName(Panel
^.TextureName
,
5889 Panel
^.TextureWidth
, Panel
^.TextureHeight
)
5891 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5893 Panel
^.TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5894 g_GetTextureSizeByID(NoTextureID
, Panel
^.TextureWidth
, Panel
^.TextureHeight
);
5897 else // Спец.текстура:
5899 Panel
^.TextureID
:= SpecialTextureID(Panel
^.TextureName
);
5900 with MainForm
.lbTextureList
.Items
do
5901 if IndexOf(Panel
^.TextureName
) = -1 then
5902 Add(Panel
^.TextureName
);
5906 ID
:= AddPanel(Panel
^);
5908 Undo_Add(OBJECT_PANEL
, ID
, a
> 0);
5909 SelectObject(OBJECT_PANEL
, ID
, True);
5920 ID
:= AddItem(Item
);
5921 Undo_Add(OBJECT_ITEM
, ID
, a
> 0);
5922 SelectObject(OBJECT_ITEM
, ID
, True);
5933 ID
:= AddMonster(Monster
);
5934 Undo_Add(OBJECT_MONSTER
, ID
, a
> 0);
5935 SelectObject(OBJECT_MONSTER
, ID
, True);
5946 ID
:= AddArea(Area
);
5947 Undo_Add(OBJECT_AREA
, ID
, a
> 0);
5948 SelectObject(OBJECT_AREA
, ID
, True);
5962 Data
.TargetPoint
.X
+= xadj
;
5963 Data
.TargetPoint
.Y
+= yadj
;
5965 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5970 TRIGGER_SPAWNMONSTER
:
5972 Data
.MonPos
.X
+= xadj
;
5973 Data
.MonPos
.Y
+= yadj
;
5977 Data
.ItemPos
.X
+= xadj
;
5978 Data
.ItemPos
.Y
+= yadj
;
5982 Data
.ShotPos
.X
+= xadj
;
5983 Data
.ShotPos
.Y
+= yadj
;
5988 ID
:= AddTrigger(Trigger
);
5989 Undo_Add(OBJECT_TRIGGER
, ID
, a
> 0);
5990 SelectObject(OBJECT_TRIGGER
, ID
, True);
5995 // Переставляем ссылки триггеров:
5996 for a
:= 0 to High(CopyBuffer
) do
5997 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5999 case CopyBuffer
[a
].Trigger
.TriggerType
of
6000 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6001 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6002 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6003 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
6004 gTriggers
[CopyBuffer
[a
].ID
].Data
.PanelID
:=
6005 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.PanelID
].ID
;
6007 TRIGGER_PRESS
, TRIGGER_ON
,
6008 TRIGGER_OFF
, TRIGGER_ONOFF
:
6009 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
6010 gTriggers
[CopyBuffer
[a
].ID
].Data
.MonsterID
:=
6011 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1].ID
+1;
6014 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
6015 gTriggers
[CopyBuffer
[a
].ID
].Data
.ShotPanelID
:=
6016 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
].ID
;
6019 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
6020 gTriggers
[CopyBuffer
[a
].ID
].TexturePanel
:=
6021 CopyBuffer
[CopyBuffer
[a
].Trigger
.TexturePanel
].ID
;
6030 procedure TMainForm
.aCutObjectExecute(Sender
: TObject
);
6033 DeleteSelectedObjects();
6036 procedure TMainForm
.vleObjectPropertyEditButtonClick(Sender
: TObject
);
6038 Key
, FileName
: String;
6041 Key
:= vleObjectProperty
.Keys
[vleObjectProperty
.Row
];
6043 if Key
= MsgPropPanelType
then
6045 with ChooseTypeForm
, vleObjectProperty
do
6046 begin // Выбор типа панели:
6047 Caption
:= MsgPropPanelType
;
6048 lbTypeSelect
.Items
.Clear();
6050 for b
:= 0 to High(PANELNAMES
) do
6052 lbTypeSelect
.Items
.Add(PANELNAMES
[b
]);
6053 if Values
[Key
] = PANELNAMES
[b
] then
6054 lbTypeSelect
.ItemIndex
:= b
;
6057 if ShowModal() = mrOK
then
6059 b
:= lbTypeSelect
.ItemIndex
;
6060 Values
[Key
] := PANELNAMES
[b
];
6061 vleObjectPropertyApply(Sender
);
6065 else if Key
= MsgPropTrTeleportTo
then
6066 SelectFlag
:= SELECTFLAG_TELEPORT
6067 else if Key
= MsgPropTrSpawnTo
then
6068 SelectFlag
:= SELECTFLAG_SPAWNPOINT
6069 else if (Key
= MsgPropTrDoorPanel
) or
6070 (Key
= MsgPropTrTrapPanel
) then
6071 SelectFlag
:= SELECTFLAG_DOOR
6072 else if Key
= MsgPropTrTexturePanel
then
6074 DrawPressRect
:= False;
6075 SelectFlag
:= SELECTFLAG_TEXTURE
;
6077 else if Key
= MsgPropTrShotPanel
then
6078 SelectFlag
:= SELECTFLAG_SHOTPANEL
6079 else if Key
= MsgPropTrLiftPanel
then
6080 SelectFlag
:= SELECTFLAG_LIFT
6081 else if key
= MsgPropTrExMonster
then
6082 SelectFlag
:= SELECTFLAG_MONSTER
6083 else if Key
= MsgPropTrExArea
then
6085 SelectFlag
:= SELECTFLAG_NONE
;
6086 DrawPressRect
:= True;
6088 else if Key
= MsgPropTrNextMap
then
6089 begin // Выбор следующей карты:
6090 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
6091 SelectMapForm
.Caption
:= MsgCapSelect
;
6092 SelectMapForm
.GetMaps(FileName
);
6094 if SelectMapForm
.ShowModal() = mrOK
then
6096 vleObjectProperty
.Values
[Key
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6097 vleObjectPropertyApply(Sender
);
6100 else if (Key
= MsgPropTrSoundName
) or
6101 (Key
= MsgPropTrMusicName
) then
6102 begin // Выбор файла звука/музыки:
6103 AddSoundForm
.OKFunction
:= nil;
6104 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
6105 AddSoundForm
.SetResource
:= vleObjectProperty
.Values
[Key
];
6107 if (AddSoundForm
.ShowModal() = mrOk
) then
6109 vleObjectProperty
.Values
[Key
] := AddSoundForm
.ResourceName
;
6110 vleObjectPropertyApply(Sender
);
6113 else if Key
= MsgPropTrActivation
then
6114 with ActivationTypeForm
, vleObjectProperty
do
6115 begin // Выбор типов активации:
6116 cbPlayerCollide
.Checked
:= Pos('PC', Values
[Key
]) > 0;
6117 cbMonsterCollide
.Checked
:= Pos('MC', Values
[Key
]) > 0;
6118 cbPlayerPress
.Checked
:= Pos('PP', Values
[Key
]) > 0;
6119 cbMonsterPress
.Checked
:= Pos('MP', Values
[Key
]) > 0;
6120 cbShot
.Checked
:= Pos('SH', Values
[Key
]) > 0;
6121 cbNoMonster
.Checked
:= Pos('NM', Values
[Key
]) > 0;
6123 if ShowModal() = mrOK
then
6126 if cbPlayerCollide
.Checked
then
6127 b
:= ACTIVATE_PLAYERCOLLIDE
;
6128 if cbMonsterCollide
.Checked
then
6129 b
:= b
or ACTIVATE_MONSTERCOLLIDE
;
6130 if cbPlayerPress
.Checked
then
6131 b
:= b
or ACTIVATE_PLAYERPRESS
;
6132 if cbMonsterPress
.Checked
then
6133 b
:= b
or ACTIVATE_MONSTERPRESS
;
6134 if cbShot
.Checked
then
6135 b
:= b
or ACTIVATE_SHOT
;
6136 if cbNoMonster
.Checked
then
6137 b
:= b
or ACTIVATE_NOMONSTER
;
6139 Values
[Key
] := ActivateToStr(b
);
6140 vleObjectPropertyApply(Sender
);
6143 else if Key
= MsgPropTrKeys
then
6144 with KeysForm
, vleObjectProperty
do
6145 begin // Выбор необходимых ключей:
6146 cbRedKey
.Checked
:= Pos('RK', Values
[Key
]) > 0;
6147 cbGreenKey
.Checked
:= Pos('GK', Values
[Key
]) > 0;
6148 cbBlueKey
.Checked
:= Pos('BK', Values
[Key
]) > 0;
6149 cbRedTeam
.Checked
:= Pos('RT', Values
[Key
]) > 0;
6150 cbBlueTeam
.Checked
:= Pos('BT', Values
[Key
]) > 0;
6152 if ShowModal() = mrOK
then
6155 if cbRedKey
.Checked
then
6157 if cbGreenKey
.Checked
then
6158 b
:= b
or KEY_GREEN
;
6159 if cbBlueKey
.Checked
then
6161 if cbRedTeam
.Checked
then
6162 b
:= b
or KEY_REDTEAM
;
6163 if cbBlueTeam
.Checked
then
6164 b
:= b
or KEY_BLUETEAM
;
6166 Values
[Key
] := KeyToStr(b
);
6167 vleObjectPropertyApply(Sender
);
6170 else if Key
= MsgPropTrFxType
then
6171 with ChooseTypeForm
, vleObjectProperty
do
6172 begin // Выбор типа эффекта:
6173 Caption
:= MsgCapFxType
;
6174 lbTypeSelect
.Items
.Clear();
6176 for b
:= EFFECT_NONE
to EFFECT_FIRE
do
6177 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6179 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]);
6181 if ShowModal() = mrOK
then
6183 b
:= lbTypeSelect
.ItemIndex
;
6184 Values
[Key
] := EffectToStr(b
);
6185 vleObjectPropertyApply(Sender
);
6188 else if Key
= MsgPropTrMonsterType
then
6189 with ChooseTypeForm
, vleObjectProperty
do
6190 begin // Выбор типа монстра:
6191 Caption
:= MsgCapMonsterType
;
6192 lbTypeSelect
.Items
.Clear();
6194 for b
:= MONSTER_DEMON
to MONSTER_MAN
do
6195 lbTypeSelect
.Items
.Add(MonsterToStr(b
));
6197 lbTypeSelect
.ItemIndex
:= StrToMonster(Values
[Key
]) - MONSTER_DEMON
;
6199 if ShowModal() = mrOK
then
6201 b
:= lbTypeSelect
.ItemIndex
+ MONSTER_DEMON
;
6202 Values
[Key
] := MonsterToStr(b
);
6203 vleObjectPropertyApply(Sender
);
6206 else if Key
= MsgPropTrItemType
then
6207 with ChooseTypeForm
, vleObjectProperty
do
6208 begin // Выбор типа предмета:
6209 Caption
:= MsgCapItemType
;
6210 lbTypeSelect
.Items
.Clear();
6212 for b
:= ITEM_MEDKIT_SMALL
to ITEM_KEY_BLUE
do
6213 lbTypeSelect
.Items
.Add(ItemToStr(b
));
6214 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_BOTTLE
));
6215 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_HELMET
));
6216 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_JETPACK
));
6217 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_INVIS
));
6218 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER
));
6219 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_AMMO_FUELCAN
));
6221 b
:= StrToItem(Values
[Key
]);
6222 if b
>= ITEM_BOTTLE
then
6224 lbTypeSelect
.ItemIndex
:= b
- ITEM_MEDKIT_SMALL
;
6226 if ShowModal() = mrOK
then
6228 b
:= lbTypeSelect
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
6229 if b
>= ITEM_WEAPON_KASTET
then
6231 Values
[Key
] := ItemToStr(b
);
6232 vleObjectPropertyApply(Sender
);
6235 else if Key
= MsgPropTrShotType
then
6236 with ChooseTypeForm
, vleObjectProperty
do
6237 begin // Выбор типа предмета:
6238 Caption
:= MsgPropTrShotType
;
6239 lbTypeSelect
.Items
.Clear();
6241 for b
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
6242 lbTypeSelect
.Items
.Add(ShotToStr(b
));
6244 lbTypeSelect
.ItemIndex
:= StrToShot(Values
[Key
]);
6246 if ShowModal() = mrOK
then
6248 b
:= lbTypeSelect
.ItemIndex
;
6249 Values
[Key
] := ShotToStr(b
);
6250 vleObjectPropertyApply(Sender
);
6253 else if Key
= MsgPropTrEffectType
then
6254 with ChooseTypeForm
, vleObjectProperty
do
6255 begin // Выбор типа эффекта:
6256 Caption
:= MsgCapFxType
;
6257 lbTypeSelect
.Items
.Clear();
6259 lbTypeSelect
.Items
.Add(MsgPropTrEffectParticle
);
6260 lbTypeSelect
.Items
.Add(MsgPropTrEffectAnimation
);
6261 if Values
[Key
] = MsgPropTrEffectAnimation
then
6262 lbTypeSelect
.ItemIndex
:= 1
6264 lbTypeSelect
.ItemIndex
:= 0;
6266 if ShowModal() = mrOK
then
6268 b
:= lbTypeSelect
.ItemIndex
;
6270 Values
[Key
] := MsgPropTrEffectParticle
6272 Values
[Key
] := MsgPropTrEffectAnimation
;
6273 vleObjectPropertyApply(Sender
);
6276 else if Key
= MsgPropTrEffectSubtype
then
6277 with ChooseTypeForm
, vleObjectProperty
do
6278 begin // Выбор подтипа эффекта:
6279 Caption
:= MsgCapFxType
;
6280 lbTypeSelect
.Items
.Clear();
6282 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6284 for b
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
6285 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6287 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]) - 1;
6290 lbTypeSelect
.Items
.Add(MsgPropTrEffectSliquid
);
6291 lbTypeSelect
.Items
.Add(MsgPropTrEffectLliquid
);
6292 lbTypeSelect
.Items
.Add(MsgPropTrEffectDliquid
);
6293 lbTypeSelect
.Items
.Add(MsgPropTrEffectBlood
);
6294 lbTypeSelect
.Items
.Add(MsgPropTrEffectSpark
);
6295 lbTypeSelect
.Items
.Add(MsgPropTrEffectBubble
);
6296 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SLIQUID
;
6297 if Values
[Key
] = MsgPropTrEffectLliquid
then
6298 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_LLIQUID
;
6299 if Values
[Key
] = MsgPropTrEffectDliquid
then
6300 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_DLIQUID
;
6301 if Values
[Key
] = MsgPropTrEffectBlood
then
6302 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BLOOD
;
6303 if Values
[Key
] = MsgPropTrEffectSpark
then
6304 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SPARK
;
6305 if Values
[Key
] = MsgPropTrEffectBubble
then
6306 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BUBBLE
;
6309 if ShowModal() = mrOK
then
6311 b
:= lbTypeSelect
.ItemIndex
;
6313 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6314 Values
[Key
] := EffectToStr(b
+ 1)
6316 Values
[Key
] := MsgPropTrEffectSliquid
;
6317 if b
= TRIGGER_EFFECT_LLIQUID
then
6318 Values
[Key
] := MsgPropTrEffectLliquid
;
6319 if b
= TRIGGER_EFFECT_DLIQUID
then
6320 Values
[Key
] := MsgPropTrEffectDliquid
;
6321 if b
= TRIGGER_EFFECT_BLOOD
then
6322 Values
[Key
] := MsgPropTrEffectBlood
;
6323 if b
= TRIGGER_EFFECT_SPARK
then
6324 Values
[Key
] := MsgPropTrEffectSpark
;
6325 if b
= TRIGGER_EFFECT_BUBBLE
then
6326 Values
[Key
] := MsgPropTrEffectBubble
;
6329 vleObjectPropertyApply(Sender
);
6332 else if Key
= MsgPropTrEffectColor
then
6333 with vleObjectProperty
do
6334 begin // Выбор цвета эффекта:
6335 ColorDialog
.Color
:= StrToIntDef(Values
[Key
], 0);
6336 if ColorDialog
.Execute
then
6338 Values
[Key
] := IntToStr(ColorDialog
.Color
);
6339 vleObjectPropertyApply(Sender
);
6342 else if Key
= MsgPropPanelTex
then
6343 begin // Смена текстуры:
6344 vleObjectProperty
.Values
[Key
] := SelectedTexture();
6345 vleObjectPropertyApply(Sender
);
6349 procedure TMainForm
.vleObjectPropertyApply(Sender
: TObject
);
6351 // hack to prevent empty ID in list
6352 RenderPanel
.SetFocus();
6353 bApplyProperty
.Click();
6354 vleObjectProperty
.SetFocus();
6357 procedure TMainForm
.aSaveMapExecute(Sender
: TObject
);
6359 FileName
, Section
, Res
: String;
6361 if OpenedMap
= '' then
6363 aSaveMapAsExecute(nil);
6367 g_ProcessResourceStr(OpenedMap
, FileName
, Section
, Res
);
6369 SaveMap(FileName
+':\'+Res
);
6372 procedure TMainForm
.aOpenMapExecute(Sender
: TObject
);
6374 OpenDialog
.Filter
:= MsgFileFilterAll
;
6376 if OpenDialog
.Execute() then
6378 OpenMapFile(OpenDialog
.FileName
);
6379 OpenDialog
.InitialDir
:= ExtractFileDir(OpenDialog
.FileName
);
6383 procedure TMainForm
.OpenMapFile(FileName
: String);
6385 if (Pos('.ini', LowerCase(ExtractFileName(FileName
))) > 0) then
6389 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
6390 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
6391 pLoadProgress
.Show();
6396 LoadMapOld(FileName
);
6398 MainForm
.Caption
:= Format('%s - %s', [FormCaption
, ExtractFileName(FileName
)]);
6400 pLoadProgress
.Hide();
6401 MainForm
.FormResize(Self
);
6403 else // Карты из WAD:
6405 OpenMap(FileName
, '');
6409 procedure TMainForm
.FormActivate(Sender
: TObject
);
6411 MainForm
.ActiveControl
:= RenderPanel
;
6414 procedure TMainForm
.aDeleteMap(Sender
: TObject
);
6420 OpenDialog
.Filter
:= MsgFileFilterWad
;
6422 if not OpenDialog
.Execute() then
6425 FileName
:= OpenDialog
.FileName
;
6426 SelectMapForm
.Caption
:= MsgCapRemove
;
6427 SelectMapForm
.lbMapList
.Items
.Clear();
6428 SelectMapForm
.GetMaps(FileName
);
6430 if SelectMapForm
.ShowModal() <> mrOK
then
6433 MapName
:= SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6434 if Application
.MessageBox(PChar(Format(MsgMsgDeleteMapPromt
, [MapName
, OpenDialog
.FileName
])), PChar(MsgMsgDeleteMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON2
) <> mrYes
then
6437 g_DeleteResource(FileName
, '', MapName
, res
);
6440 Application
.MessageBox(PChar('Cant delete map res=' + IntToStr(res
)), PChar('Map not deleted!'), MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
6444 Application
.MessageBox(
6445 PChar(Format(MsgMsgMapDeletedPromt
, [MapName
])),
6446 PChar(MsgMsgMapDeleted
),
6447 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
6450 // Удалили текущую карту - сохранять по старому ее нельзя:
6451 if OpenedMap
= (FileName
+ ':\' + MapName
) then
6455 MainForm
.Caption
:= FormCaption
6459 procedure TMainForm
.vleObjectPropertyKeyDown(Sender
: TObject
;
6460 var Key
: Word; Shift
: TShiftState
);
6462 if Key
= VK_RETURN
then
6463 vleObjectPropertyApply(Sender
);
6466 procedure MovePanel(var ID
: DWORD
; MoveType
: Byte);
6471 if (ID
= 0) and (MoveType
= 0) then
6473 if (ID
= DWORD(High(gPanels
))) and (MoveType
<> 0) then
6475 if (ID
> DWORD(High(gPanels
))) then
6480 if MoveType
= 0 then // to Back
6482 if gTriggers
<> nil then
6483 for a
:= 0 to High(gTriggers
) do
6484 with gTriggers
[a
] do
6486 if TriggerType
= TRIGGER_NONE
then
6489 if TexturePanel
= _id
then
6492 if (TexturePanel
>= 0) and (TexturePanel
< _id
) then
6496 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6497 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6498 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6499 if Data
.PanelID
= _id
then
6502 if (Data
.PanelID
>= 0) and (Data
.PanelID
< _id
) then
6506 if Data
.ShotPanelID
= _id
then
6507 Data
.ShotPanelID
:= 0
6509 if (Data
.ShotPanelID
>= 0) and (Data
.ShotPanelID
< _id
) then
6510 Inc(Data
.ShotPanelID
);
6514 tmp
:= gPanels
[_id
];
6516 for a
:= _id
downto 1 do
6517 gPanels
[a
] := gPanels
[a
-1];
6525 if gTriggers
<> nil then
6526 for a
:= 0 to High(gTriggers
) do
6527 with gTriggers
[a
] do
6529 if TriggerType
= TRIGGER_NONE
then
6532 if TexturePanel
= _id
then
6533 TexturePanel
:= High(gPanels
)
6535 if TexturePanel
> _id
then
6539 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6540 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6541 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6542 if Data
.PanelID
= _id
then
6543 Data
.PanelID
:= High(gPanels
)
6545 if Data
.PanelID
> _id
then
6549 if Data
.ShotPanelID
= _id
then
6550 Data
.ShotPanelID
:= High(gPanels
)
6552 if Data
.ShotPanelID
> _id
then
6553 Dec(Data
.ShotPanelID
);
6557 tmp
:= gPanels
[_id
];
6559 for a
:= _id
to High(gPanels
)-1 do
6560 gPanels
[a
] := gPanels
[a
+1];
6562 gPanels
[High(gPanels
)] := tmp
;
6564 ID
:= High(gPanels
);
6568 procedure TMainForm
.aMoveToBack(Sender
: TObject
);
6572 if SelectedObjects
= nil then
6575 for a
:= 0 to High(SelectedObjects
) do
6576 with SelectedObjects
[a
] do
6577 if Live
and (ObjectType
= OBJECT_PANEL
) then
6579 SelectedObjects
[0] := SelectedObjects
[a
];
6580 SetLength(SelectedObjects
, 1);
6587 procedure TMainForm
.aMoveToFore(Sender
: TObject
);
6591 if SelectedObjects
= nil then
6594 for a
:= 0 to High(SelectedObjects
) do
6595 with SelectedObjects
[a
] do
6596 if Live
and (ObjectType
= OBJECT_PANEL
) then
6598 SelectedObjects
[0] := SelectedObjects
[a
];
6599 SetLength(SelectedObjects
, 1);
6606 procedure TMainForm
.aSaveMapAsExecute(Sender
: TObject
);
6610 SaveDialog
.Filter
:= MsgFileFilterWad
;
6612 if not SaveDialog
.Execute() then
6615 SaveMapForm
.GetMaps(SaveDialog
.FileName
, True);
6617 if SaveMapForm
.ShowModal() <> mrOK
then
6620 SaveDialog
.InitialDir
:= ExtractFileDir(SaveDialog
.FileName
);
6621 OpenedMap
:= SaveDialog
.FileName
+':\'+SaveMapForm
.eMapName
.Text;
6622 OpenedWAD
:= SaveDialog
.FileName
;
6624 idx
:= RecentFiles
.IndexOf(OpenedMap
);
6625 // Такая карта уже недавно открывалась:
6627 RecentFiles
.Delete(idx
);
6628 RecentFiles
.Insert(0, OpenedMap
);
6633 gMapInfo
.FileName
:= SaveDialog
.FileName
;
6634 gMapInfo
.MapName
:= SaveMapForm
.eMapName
.Text;
6635 UpdateCaption(gMapInfo
.Name
, ExtractFileName(gMapInfo
.FileName
), gMapInfo
.MapName
);
6638 procedure TMainForm
.aSelectAllExecute(Sender
: TObject
);
6642 RemoveSelectFromObjects();
6644 case pcObjects
.ActivePageIndex
+1 of
6646 if gPanels
<> nil then
6647 for a
:= 0 to High(gPanels
) do
6648 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6649 SelectObject(OBJECT_PANEL
, a
, True);
6651 if gItems
<> nil then
6652 for a
:= 0 to High(gItems
) do
6653 if gItems
[a
].ItemType
<> ITEM_NONE
then
6654 SelectObject(OBJECT_ITEM
, a
, True);
6656 if gMonsters
<> nil then
6657 for a
:= 0 to High(gMonsters
) do
6658 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6659 SelectObject(OBJECT_MONSTER
, a
, True);
6661 if gAreas
<> nil then
6662 for a
:= 0 to High(gAreas
) do
6663 if gAreas
[a
].AreaType
<> AREA_NONE
then
6664 SelectObject(OBJECT_AREA
, a
, True);
6666 if gTriggers
<> nil then
6667 for a
:= 0 to High(gTriggers
) do
6668 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6669 SelectObject(OBJECT_TRIGGER
, a
, True);
6672 RecountSelectedObjects();
6675 procedure TMainForm
.tbGridOnClick(Sender
: TObject
);
6677 DotEnable
:= not DotEnable
;
6678 (Sender
as TToolButton
).Down
:= DotEnable
;
6681 procedure TMainForm
.OnIdle(Sender
: TObject
; var Done
: Boolean);
6684 // FIXME: this is a shitty hack
6685 if not gDataLoaded
then
6687 e_WriteLog('Init OpenGL', MSG_NOTIFY
);
6689 e_WriteLog('Loading data', MSG_NOTIFY
);
6690 LoadStdFont('STDTXT', 'STDFONT', gEditorFont
);
6691 e_WriteLog('Loading more data', MSG_NOTIFY
);
6693 e_WriteLog('Loading even more data', MSG_NOTIFY
);
6694 gDataLoaded
:= True;
6695 MainForm
.FormResize(nil);
6698 if StartMap
<> '' then
6706 procedure TMainForm
.miMapPreviewClick(Sender
: TObject
);
6708 if PreviewMode
= 2 then
6711 if PreviewMode
= 0 then
6713 Splitter2
.Visible
:= False;
6714 Splitter1
.Visible
:= False;
6715 StatusBar
.Visible
:= False;
6716 PanelObjs
.Visible
:= False;
6717 PanelProps
.Visible
:= False;
6718 MainToolBar
.Visible
:= False;
6719 sbHorizontal
.Visible
:= False;
6720 sbVertical
.Visible
:= False;
6724 StatusBar
.Visible
:= True;
6725 PanelObjs
.Visible
:= True;
6726 PanelProps
.Visible
:= True;
6727 Splitter2
.Visible
:= True;
6728 Splitter1
.Visible
:= True;
6729 MainToolBar
.Visible
:= True;
6730 sbHorizontal
.Visible
:= True;
6731 sbVertical
.Visible
:= True;
6734 PreviewMode
:= PreviewMode
xor 1;
6735 (Sender
as TMenuItem
).Checked
:= PreviewMode
> 0;
6740 procedure TMainForm
.miLayer1Click(Sender
: TObject
);
6742 SwitchLayer(LAYER_BACK
);
6745 procedure TMainForm
.miLayer2Click(Sender
: TObject
);
6747 SwitchLayer(LAYER_WALLS
);
6750 procedure TMainForm
.miLayer3Click(Sender
: TObject
);
6752 SwitchLayer(LAYER_FOREGROUND
);
6755 procedure TMainForm
.miLayer4Click(Sender
: TObject
);
6757 SwitchLayer(LAYER_STEPS
);
6760 procedure TMainForm
.miLayer5Click(Sender
: TObject
);
6762 SwitchLayer(LAYER_WATER
);
6765 procedure TMainForm
.miLayer6Click(Sender
: TObject
);
6767 SwitchLayer(LAYER_ITEMS
);
6770 procedure TMainForm
.miLayer7Click(Sender
: TObject
);
6772 SwitchLayer(LAYER_MONSTERS
);
6775 procedure TMainForm
.miLayer8Click(Sender
: TObject
);
6777 SwitchLayer(LAYER_AREAS
);
6780 procedure TMainForm
.miLayer9Click(Sender
: TObject
);
6782 SwitchLayer(LAYER_TRIGGERS
);
6785 procedure TMainForm
.tbShowClick(Sender
: TObject
);
6791 for a
:= 0 to High(LayerEnabled
) do
6792 b
:= b
and LayerEnabled
[a
];
6796 ShowLayer(LAYER_BACK
, b
);
6797 ShowLayer(LAYER_WALLS
, b
);
6798 ShowLayer(LAYER_FOREGROUND
, b
);
6799 ShowLayer(LAYER_STEPS
, b
);
6800 ShowLayer(LAYER_WATER
, b
);
6801 ShowLayer(LAYER_ITEMS
, b
);
6802 ShowLayer(LAYER_MONSTERS
, b
);
6803 ShowLayer(LAYER_AREAS
, b
);
6804 ShowLayer(LAYER_TRIGGERS
, b
);
6807 procedure TMainForm
.miMiniMapClick(Sender
: TObject
);
6812 procedure TMainForm
.miSwitchGridClick(Sender
: TObject
);
6814 if DotStep
= DotStepOne
then
6815 DotStep
:= DotStepTwo
6817 DotStep
:= DotStepOne
;
6819 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6820 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6823 procedure TMainForm
.miShowEdgesClick(Sender
: TObject
);
6828 procedure TMainForm
.miSnapToGridClick(Sender
: TObject
);
6830 SnapToGrid
:= not SnapToGrid
;
6832 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6833 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6835 miSnapToGrid
.Checked
:= SnapToGrid
;
6838 procedure TMainForm
.minexttabClick(Sender
: TObject
);
6840 if pcObjects
.ActivePageIndex
< pcObjects
.PageCount
-1 then
6841 pcObjects
.ActivePageIndex
:= pcObjects
.ActivePageIndex
+1
6843 pcObjects
.ActivePageIndex
:= 0;
6846 procedure TMainForm
.miSaveMiniMapClick(Sender
: TObject
);
6848 SaveMiniMapForm
.ShowModal();
6851 procedure TMainForm
.bClearTextureClick(Sender
: TObject
);
6853 lbTextureList
.ItemIndex
:= -1;
6854 lTextureWidth
.Caption
:= '';
6855 lTextureHeight
.Caption
:= '';
6858 procedure TMainForm
.miPackMapClick(Sender
: TObject
);
6860 PackMapForm
.ShowModal();
6863 type SSArray
= array of String;
6865 function ParseString (Str
: AnsiString): SSArray
;
6866 function GetStr (var Str
: AnsiString): AnsiString;
6870 if Str
[1] = '"' then
6871 for b
:= 1 to Length(Str
) do
6872 if (b
= Length(Str
)) or (Str
[b
+ 1] = '"') then
6874 Result
:= Copy(Str
, 2, b
- 1);
6875 Delete(Str
, 1, b
+ 1);
6879 for a
:= 1 to Length(Str
) do
6880 if (a
= Length(Str
)) or (Str
[a
+ 1] = ' ') then
6882 Result
:= Copy(Str
, 1, a
);
6883 Delete(Str
, 1, a
+ 1);
6893 SetLength(Result
, Length(Result
)+1);
6894 Result
[High(Result
)] := GetStr(Str
);
6898 procedure TMainForm
.miTestMapClick(Sender
: TObject
);
6900 newWAD
, oldWAD
, tempMap
, ext
: String;
6907 // Ignore while map testing in progress
6908 if MapTestProcess
<> nil then
6911 // Сохраняем временную карту:
6914 newWAD
:= Format('%s/temp%.4d', [MapsDir
, time
]);
6916 until not FileExists(newWAD
);
6917 if OpenedMap
<> '' then
6919 oldWad
:= g_ExtractWadName(OpenedMap
);
6920 newWad
:= newWad
+ ExtractFileExt(oldWad
);
6921 if CopyFile(oldWad
, newWad
) = false then
6922 e_WriteLog('MapTest: unable to copy [' + oldWad
+ '] to [' + newWad
+ ']', MSG_WARNING
)
6926 newWad
:= newWad
+ '.wad'
6928 tempMap
:= newWAD
+ ':\' + TEST_MAP_NAME
;
6933 if TestOptionsTwoPlayers
then
6935 if TestOptionsTeamDamage
then
6937 if TestOptionsAllowExit
then
6939 if TestOptionsWeaponStay
then
6941 if TestOptionsMonstersDM
then
6945 proc
:= TProcessUTF8
.Create(nil);
6946 proc
.Executable
:= TestD2dExe
;
6948 // TODO: get real executable name from Info.plist
6949 if LowerCase(ExtractFileExt(TestD2dExe
)) = '.app' then
6950 proc
.Executable
:= TestD2dExe
+ DirectorySeparator
+ 'Contents' + DirectorySeparator
+ 'MacOS' + DirectorySeparator
+ 'Doom2DF';
6952 proc
.Parameters
.Add('-map');
6953 proc
.Parameters
.Add(tempMap
);
6954 proc
.Parameters
.Add('-gm');
6955 proc
.Parameters
.Add(TestGameMode
);
6956 proc
.Parameters
.Add('-limt');
6957 proc
.Parameters
.Add(TestLimTime
);
6958 proc
.Parameters
.Add('-lims');
6959 proc
.Parameters
.Add(TestLimScore
);
6960 proc
.Parameters
.Add('-opt');
6961 proc
.Parameters
.Add(IntToStr(opt
));
6962 proc
.Parameters
.Add('--debug');
6964 proc
.Parameters
.Add('--close');
6966 args
:= ParseString(TestD2DArgs
);
6967 for i
:= 0 to High(args
) do
6968 proc
.Parameters
.Add(args
[i
]);
6978 tbTestMap
.Enabled
:= False;
6979 MapTestFile
:= newWAD
;
6980 MapTestProcess
:= proc
;
6984 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
6985 SysUtils
.DeleteFile(newWAD
);
6990 procedure TMainForm
.sbVerticalScroll(Sender
: TObject
;
6991 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
6993 MapOffset
.Y
:= -sbVertical
.Position
;
6994 RenderPanel
.Invalidate
;
6997 procedure TMainForm
.sbHorizontalScroll(Sender
: TObject
;
6998 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
7000 MapOffset
.X
:= -sbHorizontal
.Position
;
7001 RenderPanel
.Invalidate
;
7004 procedure TMainForm
.miOpenWadMapClick(Sender
: TObject
);
7006 if OpenedWAD
<> '' then
7008 OpenMap(OpenedWAD
, '');
7012 procedure TMainForm
.selectall1Click(Sender
: TObject
);
7016 RemoveSelectFromObjects();
7018 if gPanels
<> nil then
7019 for a
:= 0 to High(gPanels
) do
7020 if gPanels
[a
].PanelType
<> PANEL_NONE
then
7021 SelectObject(OBJECT_PANEL
, a
, True);
7023 if gItems
<> nil then
7024 for a
:= 0 to High(gItems
) do
7025 if gItems
[a
].ItemType
<> ITEM_NONE
then
7026 SelectObject(OBJECT_ITEM
, a
, True);
7028 if gMonsters
<> nil then
7029 for a
:= 0 to High(gMonsters
) do
7030 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
7031 SelectObject(OBJECT_MONSTER
, a
, True);
7033 if gAreas
<> nil then
7034 for a
:= 0 to High(gAreas
) do
7035 if gAreas
[a
].AreaType
<> AREA_NONE
then
7036 SelectObject(OBJECT_AREA
, a
, True);
7038 if gTriggers
<> nil then
7039 for a
:= 0 to High(gTriggers
) do
7040 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
7041 SelectObject(OBJECT_TRIGGER
, a
, True);
7043 RecountSelectedObjects();
7046 procedure TMainForm
.Splitter1CanResize(Sender
: TObject
;
7047 var NewSize
: Integer; var Accept
: Boolean);
7049 Accept
:= (NewSize
> 140);
7052 procedure TMainForm
.Splitter2CanResize(Sender
: TObject
;
7053 var NewSize
: Integer; var Accept
: Boolean);
7055 Accept
:= (NewSize
> 110);
7058 procedure TMainForm
.vleObjectPropertyEnter(Sender
: TObject
);
7060 EditingProperties
:= True;
7063 procedure TMainForm
.vleObjectPropertyExit(Sender
: TObject
);
7065 EditingProperties
:= False;
7068 procedure TMainForm
.FormKeyUp(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
7070 // Объекты передвигались:
7071 if MainForm
.ActiveControl
= RenderPanel
then
7073 if (Key
= VK_NUMPAD4
) or
7074 (Key
= VK_NUMPAD6
) or
7075 (Key
= VK_NUMPAD8
) or
7076 (Key
= VK_NUMPAD5
) or
7077 (Key
= Ord('V')) then
7080 // Быстрое превью карты:
7081 if Key
= Ord('E') then
7083 if PreviewMode
= 2 then
7086 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);