3 {$INCLUDE ../shared/a_modes.inc}
8 LCLIntf
, LCLType
, SysUtils
, Variants
, Classes
, Graphics
,
9 Controls
, Forms
, Dialogs
, StdCtrls
, Buttons
,
10 ComCtrls
, ValEdit
, Types
, Menus
, ExtCtrls
,
11 CheckLst
, Grids
, OpenGLContext
, Utils
, UTF8Process
;
17 TMainForm
= class(TForm
)
21 StatusBar
: TStatusBar
;
22 OpenDialog
: TOpenDialog
;
23 SaveDialog
: TSaveDialog
;
24 ColorDialog
: TColorDialog
;
28 ImageList
: TImageList
;
31 miAppleAbout
: TMenuItem
;
32 miAppleLine0
: TMenuItem
;
33 miApplePref
: TMenuItem
;
34 miAppleLine1
: TMenuItem
;
36 miMenuFile
: TMenuItem
;
39 miMacRecentSubMenu
: TMenuItem
;
40 miMacRecentEnd
: TMenuItem
;
41 miMacRecentClear
: TMenuItem
;
42 Separator1
: TMenuItem
;
44 miSaveMapAs
: TMenuItem
;
45 miOpenWadMap
: TMenuItem
;
47 miReopenMap
: TMenuItem
;
48 miSaveMiniMap
: TMenuItem
;
49 miDeleteMap
: TMenuItem
;
51 miWinRecentStart
: TMenuItem
;
52 miWinRecent
: TMenuItem
;
56 miMenuEdit
: TMenuItem
;
63 miSelectAll
: TMenuItem
;
65 miSnapToGrid
: TMenuItem
;
66 miSwitchGrid
: TMenuItem
;
67 Separator2
: TMenuItem
;
71 miMapOptions
: TMenuItem
;
74 miMenuView
: TMenuItem
;
85 miViewLine1
: TMenuItem
;
87 miShowEdges
: TMenuItem
;
88 miViewLine2
: TMenuItem
;
89 miMapPreview
: TMenuItem
;
91 miMenuService
: TMenuItem
;
92 miCheckMap
: TMenuItem
;
93 miOptimmization
: TMenuItem
;
96 miMenuWindow
: TMenuItem
;
97 miMacMinimize
: TMenuItem
;
100 miMenuHelp
: TMenuItem
;
103 miMenuHidden
: TMenuItem
;
104 minexttab
: TMenuItem
;
105 selectall1
: TMenuItem
;
108 ilToolbar
: TImageList
;
109 MainToolBar
: TToolBar
;
110 tbNewMap
: TToolButton
;
111 tbOpenMap
: TToolButton
;
112 tbSaveMap
: TToolButton
;
113 tbOpenWadMap
: TToolButton
;
114 tbLine1
: TToolButton
;
115 tbShowMap
: TToolButton
;
116 tbLine2
: TToolButton
;
119 miLayerP1
: TMenuItem
;
120 miLayerP2
: TMenuItem
;
121 miLayerP3
: TMenuItem
;
122 miLayerP4
: TMenuItem
;
123 miLayerP5
: TMenuItem
;
124 miLayerP6
: TMenuItem
;
125 miLayerP7
: TMenuItem
;
126 miLayerP8
: TMenuItem
;
127 miLayerP9
: TMenuItem
;
128 tbLine3
: TToolButton
;
129 tbGridOn
: TToolButton
;
131 tbLine4
: TToolButton
;
132 tbTestMap
: TToolButton
;
135 pLoadProgress
: TPanel
;
137 pbLoad
: TProgressBar
;
141 RenderPanel
: TOpenGLControl
;
142 sbHorizontal
: TScrollBar
;
143 sbVertical
: TScrollBar
;
145 // Object propertiy editor:
147 PanelPropApply
: TPanel
;
148 bApplyProperty
: TButton
;
149 vleObjectProperty
: TValueListEditor
;
153 pcObjects
: TPageControl
;
156 PanelPanelType
: TPanel
;
157 lbPanelType
: TListBox
;
158 lbTextureList
: TListBox
;
159 PanelTextures
: TPanel
;
161 lTextureWidth
: TLabel
;
163 lTextureHeight
: TLabel
;
164 cbPreview
: TCheckBox
;
165 bbAddTexture
: TBitBtn
;
166 bbRemoveTexture
: TBitBtn
;
167 bClearTexture
: TButton
;
170 lbItemList
: TListBox
;
174 tsMonsters
: TTabSheet
;
175 lbMonsterList
: TListBox
;
176 rbMonsterLeft
: TRadioButton
;
177 rbMonsterRight
: TRadioButton
;
180 lbAreasList
: TListBox
;
181 rbAreaLeft
: TRadioButton
;
182 rbAreaRight
: TRadioButton
;
184 tsTriggers
: TTabSheet
;
185 lbTriggersList
: TListBox
;
186 clbActivationType
: TCheckListBox
;
187 clbKeys
: TCheckListBox
;
189 procedure aAboutExecute(Sender
: TObject
);
190 procedure aCheckMapExecute(Sender
: TObject
);
191 procedure aMoveToFore(Sender
: TObject
);
192 procedure aMoveToBack(Sender
: TObject
);
193 procedure aCopyObjectExecute(Sender
: TObject
);
194 procedure aCutObjectExecute(Sender
: TObject
);
195 procedure aEditorOptionsExecute(Sender
: TObject
);
196 procedure aExitExecute(Sender
: TObject
);
197 procedure aMapOptionsExecute(Sender
: TObject
);
198 procedure aNewMapExecute(Sender
: TObject
);
199 procedure aOpenMapExecute(Sender
: TObject
);
200 procedure aOptimizeExecute(Sender
: TObject
);
201 procedure aPasteObjectExecute(Sender
: TObject
);
202 procedure aSelectAllExecute(Sender
: TObject
);
203 procedure aSaveMapExecute(Sender
: TObject
);
204 procedure aSaveMapAsExecute(Sender
: TObject
);
205 procedure aUndoExecute(Sender
: TObject
);
206 procedure aDeleteMap(Sender
: TObject
);
207 procedure bApplyPropertyClick(Sender
: TObject
);
208 procedure bbAddTextureClick(Sender
: TObject
);
209 procedure bbRemoveTextureClick(Sender
: TObject
);
210 procedure FormActivate(Sender
: TObject
);
211 procedure FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
212 procedure FormCreate(Sender
: TObject
);
213 procedure FormDestroy(Sender
: TObject
);
214 procedure FormDropFiles(Sender
: TObject
; const FileNames
: array of String);
215 procedure FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
216 procedure FormResize(Sender
: TObject
);
217 procedure FormWindowStateChange(Sender
: TObject
);
218 procedure miRecentFileExecute(Sender
: TObject
);
219 procedure miMacRecentClearClick(Sender
: TObject
);
220 procedure miMacZoomClick(Sender
: TObject
);
221 procedure lbTextureListClick(Sender
: TObject
);
222 procedure lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
223 ARect
: TRect
; State
: TOwnerDrawState
);
224 procedure miMacMinimizeClick(Sender
: TObject
);
225 procedure miReopenMapClick(Sender
: TObject
);
226 procedure RenderPanelMouseDown(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
227 procedure RenderPanelMouseMove(Sender
: TObject
; Shift
: TShiftState
; X
, Y
: Integer);
228 procedure RenderPanelMouseUp(Sender
: TObject
; Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
229 procedure RenderPanelPaint(Sender
: TObject
);
230 procedure RenderPanelResize(Sender
: TObject
);
231 procedure Splitter1Moved(Sender
: TObject
);
232 procedure MapTestCheck(Sender
: TObject
);
233 procedure vleObjectPropertyEditButtonClick(Sender
: TObject
);
234 procedure vleObjectPropertyApply(Sender
: TObject
);
235 procedure vleObjectPropertyGetPickList(Sender
: TObject
; const KeyName
: String; Values
: TStrings
);
236 procedure vleObjectPropertyKeyDown(Sender
: TObject
; var Key
: Word;
238 procedure tbGridOnClick(Sender
: TObject
);
239 procedure miMapPreviewClick(Sender
: TObject
);
240 procedure miLayer1Click(Sender
: TObject
);
241 procedure miLayer2Click(Sender
: TObject
);
242 procedure miLayer3Click(Sender
: TObject
);
243 procedure miLayer4Click(Sender
: TObject
);
244 procedure miLayer5Click(Sender
: TObject
);
245 procedure miLayer6Click(Sender
: TObject
);
246 procedure miLayer7Click(Sender
: TObject
);
247 procedure miLayer8Click(Sender
: TObject
);
248 procedure miLayer9Click(Sender
: TObject
);
249 procedure tbShowClick(Sender
: TObject
);
250 procedure miSnapToGridClick(Sender
: TObject
);
251 procedure miMiniMapClick(Sender
: TObject
);
252 procedure miSwitchGridClick(Sender
: TObject
);
253 procedure miShowEdgesClick(Sender
: TObject
);
254 procedure minexttabClick(Sender
: TObject
);
255 procedure miSaveMiniMapClick(Sender
: TObject
);
256 procedure bClearTextureClick(Sender
: TObject
);
257 procedure miPackMapClick(Sender
: TObject
);
258 procedure miTestMapClick(Sender
: TObject
);
259 procedure sbVerticalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
260 var ScrollPos
: Integer);
261 procedure sbHorizontalScroll(Sender
: TObject
; ScrollCode
: TScrollCode
;
262 var ScrollPos
: Integer);
263 procedure miOpenWadMapClick(Sender
: TObject
);
264 procedure selectall1Click(Sender
: TObject
);
265 procedure Splitter1CanResize(Sender
: TObject
; var NewSize
: Integer;
266 var Accept
: Boolean);
267 procedure Splitter2CanResize(Sender
: TObject
; var NewSize
: Integer;
268 var Accept
: Boolean);
269 procedure vleObjectPropertyEnter(Sender
: TObject
);
270 procedure vleObjectPropertyExit(Sender
: TObject
);
271 procedure FormKeyUp(Sender
: TObject
; var Key
: Word;
275 procedure OnIdle(Sender
: TObject
; var Done
: Boolean);
276 procedure RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
278 procedure RefreshRecentMenu();
279 procedure OpenMapFile(FileName
: String);
280 function RenderMousePos(): TPoint
;
281 procedure RecountSelectedObjects();
287 LAYER_FOREGROUND
= 2;
295 TEST_MAP_NAME
= '$$$_TEST_$$$';
296 LANGUAGE_FILE_NAME
= '_Editor.txt';
307 DotStepOne
, DotStepTwo
: Word;
309 DrawTexturePanel
: Boolean;
310 DrawPanelSize
: Boolean;
312 PreviewColor
: TColor
;
313 UseCheckerboard
: Boolean;
315 RecentCount
: Integer;
316 RecentFiles
: TStringList
;
317 slInvalidTextures
: TStringList
;
319 TestGameMode
: String;
321 TestLimScore
: String;
322 TestOptionsTwoPlayers
: Boolean;
323 TestOptionsTeamDamage
: Boolean;
324 TestOptionsAllowExit
: Boolean;
325 TestOptionsWeaponStay
: Boolean;
326 TestOptionsMonstersDM
: Boolean;
327 TestD2dExe
, TestD2DArgs
: String;
328 TestMapOnce
: Boolean;
330 LayerEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
331 (True, True, True, True, True, True, True, True, True);
332 ContourEnabled
: Array [LAYER_BACK
..LAYER_TRIGGERS
] of Boolean =
333 (False, False, False, False, False, False, False, False, False);
334 PreviewMode
: Byte = 0;
340 procedure OpenMap(FileName
: String; mapN
: String);
341 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
342 procedure RemoveSelectFromObjects();
343 procedure ChangeShownProperty(Name
: String; NewValue
: String);
348 f_options
, e_graphics
, e_log
, GL
, Math
,
349 f_mapoptions
, g_basic
, f_about
, f_mapoptimization
,
350 f_mapcheck
, f_addresource_texture
, g_textures
,
351 f_activationtype
, f_keys
, wadreader
, fileutil
,
352 MAPREADER
, f_selectmap
, f_savemap
, WADEDITOR
, WADSTRUCT
, MAPDEF
,
353 g_map
, f_saveminimap
, f_addresource
, CONFIG
, f_packmap
,
354 f_addresource_sound
, f_choosetype
,
355 g_language
, ClipBrd
, g_options
;
358 UNDO_DELETE_PANEL
= 1;
359 UNDO_DELETE_ITEM
= 2;
360 UNDO_DELETE_AREA
= 3;
361 UNDO_DELETE_MONSTER
= 4;
362 UNDO_DELETE_TRIGGER
= 5;
366 UNDO_ADD_MONSTER
= 9;
367 UNDO_ADD_TRIGGER
= 10;
368 UNDO_MOVE_PANEL
= 11;
371 UNDO_MOVE_MONSTER
= 14;
372 UNDO_MOVE_TRIGGER
= 15;
373 UNDO_RESIZE_PANEL
= 16;
374 UNDO_RESIZE_TRIGGER
= 17;
376 MOUSEACTION_NONE
= 0;
377 MOUSEACTION_DRAWPANEL
= 1;
378 MOUSEACTION_DRAWTRIGGER
= 2;
379 MOUSEACTION_MOVEOBJ
= 3;
380 MOUSEACTION_RESIZE
= 4;
381 MOUSEACTION_MOVEMAP
= 5;
382 MOUSEACTION_DRAWPRESS
= 6;
383 MOUSEACTION_NOACTION
= 7;
386 RESIZETYPE_VERTICAL
= 1;
387 RESIZETYPE_HORIZONTAL
= 2;
396 SELECTFLAG_TELEPORT
= 1;
398 SELECTFLAG_TEXTURE
= 3;
400 SELECTFLAG_MONSTER
= 5;
401 SELECTFLAG_SPAWNPOINT
= 6;
402 SELECTFLAG_SHOTPANEL
= 7;
403 SELECTFLAG_SELECTED
= 8;
405 RECENT_FILES_MENU_START
= 12;
407 CLIPBOARD_SIG
= 'DF:ED';
411 case UndoType
: Byte of
412 UNDO_DELETE_PANEL
: (Panel
: ^TPanel
);
413 UNDO_DELETE_ITEM
: (Item
: TItem
);
414 UNDO_DELETE_AREA
: (Area
: TArea
);
415 UNDO_DELETE_MONSTER
: (Monster
: TMonster
);
416 UNDO_DELETE_TRIGGER
: (Trigger
: TTrigger
);
421 UNDO_ADD_TRIGGER
: (AddID
: DWORD
);
426 UNDO_MOVE_TRIGGER
: (MoveID
: DWORD
; dX
, dY
: Integer);
428 UNDO_RESIZE_TRIGGER
: (ResizeID
: DWORD
; dW
, dH
: Integer);
433 case ObjectType
: Byte of
434 OBJECT_PANEL
: (Panel
: ^TPanel
);
435 OBJECT_ITEM
: (Item
: TItem
);
436 OBJECT_AREA
: (Area
: TArea
);
437 OBJECT_MONSTER
: (Monster
: TMonster
);
438 OBJECT_TRIGGER
: (Trigger
: TTrigger
);
441 TCopyRecArray
= Array of TCopyRec
;
445 gDataLoaded
: Boolean = False;
446 ShowMap
: Boolean = False;
447 DrawRect
: PRect
= nil;
448 SnapToGrid
: Boolean = True;
450 MousePos
: Types
.TPoint
;
451 LastMovePoint
: Types
.TPoint
;
455 MouseLDownPos
: Types
.TPoint
;
456 MouseRDownPos
: Types
.TPoint
;
457 MouseMDownPos
: Types
.TPoint
;
459 SelectFlag
: Byte = SELECTFLAG_NONE
;
460 MouseAction
: Byte = MOUSEACTION_NONE
;
461 ResizeType
: Byte = RESIZETYPE_NONE
;
462 ResizeDirection
: Byte = RESIZEDIR_NONE
;
464 DrawPressRect
: Boolean = False;
465 EditingProperties
: Boolean = False;
467 UndoBuffer
: Array of Array of TUndoRec
= nil;
469 MapTestProcess
: TProcessUTF8
;
474 //----------------------------------------
475 //Далее идут вспомогательные процедуры
476 //----------------------------------------
478 function NameToBool(Name
: String): Boolean;
480 if Name
= BoolNames
[True] then
486 function NameToDir(Name
: String): TDirection
;
488 if Name
= DirNames
[D_LEFT
] then
494 function NameToDirAdv(Name
: String): Byte;
496 if Name
= DirNamesAdv
[1] then
499 if Name
= DirNamesAdv
[2] then
502 if Name
= DirNamesAdv
[3] then
508 function ActivateToStr(ActivateType
: Byte): String;
512 if ByteBool(ACTIVATE_PLAYERCOLLIDE
and ActivateType
) then
513 Result
:= Result
+ '+PC';
514 if ByteBool(ACTIVATE_MONSTERCOLLIDE
and ActivateType
) then
515 Result
:= Result
+ '+MC';
516 if ByteBool(ACTIVATE_PLAYERPRESS
and ActivateType
) then
517 Result
:= Result
+ '+PP';
518 if ByteBool(ACTIVATE_MONSTERPRESS
and ActivateType
) then
519 Result
:= Result
+ '+MP';
520 if ByteBool(ACTIVATE_SHOT
and ActivateType
) then
521 Result
:= Result
+ '+SH';
522 if ByteBool(ACTIVATE_NOMONSTER
and ActivateType
) then
523 Result
:= Result
+ '+NM';
525 if (Result
<> '') and (Result
[1] = '+') then
526 Delete(Result
, 1, 1);
529 function StrToActivate(Str
: String): Byte;
533 if Pos('PC', Str
) > 0 then
534 Result
:= ACTIVATE_PLAYERCOLLIDE
;
535 if Pos('MC', Str
) > 0 then
536 Result
:= Result
or ACTIVATE_MONSTERCOLLIDE
;
537 if Pos('PP', Str
) > 0 then
538 Result
:= Result
or ACTIVATE_PLAYERPRESS
;
539 if Pos('MP', Str
) > 0 then
540 Result
:= Result
or ACTIVATE_MONSTERPRESS
;
541 if Pos('SH', Str
) > 0 then
542 Result
:= Result
or ACTIVATE_SHOT
;
543 if Pos('NM', Str
) > 0 then
544 Result
:= Result
or ACTIVATE_NOMONSTER
;
547 function KeyToStr(Key
: Byte): String;
551 if ByteBool(KEY_RED
and Key
) then
552 Result
:= Result
+ '+RK';
553 if ByteBool(KEY_GREEN
and Key
) then
554 Result
:= Result
+ '+GK';
555 if ByteBool(KEY_BLUE
and Key
) then
556 Result
:= Result
+ '+BK';
557 if ByteBool(KEY_REDTEAM
and Key
) then
558 Result
:= Result
+ '+RT';
559 if ByteBool(KEY_BLUETEAM
and Key
) then
560 Result
:= Result
+ '+BT';
562 if (Result
<> '') and (Result
[1] = '+') then
563 Delete(Result
, 1, 1);
566 function StrToKey(Str
: String): Byte;
570 if Pos('RK', Str
) > 0 then
572 if Pos('GK', Str
) > 0 then
573 Result
:= Result
or KEY_GREEN
;
574 if Pos('BK', Str
) > 0 then
575 Result
:= Result
or KEY_BLUE
;
576 if Pos('RT', Str
) > 0 then
577 Result
:= Result
or KEY_REDTEAM
;
578 if Pos('BT', Str
) > 0 then
579 Result
:= Result
or KEY_BLUETEAM
;
582 function EffectToStr(Effect
: Byte): String;
584 if Effect
in [EFFECT_TELEPORT
..EFFECT_FIRE
] then
585 Result
:= EffectNames
[Effect
]
587 Result
:= EffectNames
[EFFECT_NONE
];
590 function StrToEffect(Str
: String): Byte;
594 Result
:= EFFECT_NONE
;
595 for i
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
596 if EffectNames
[i
] = Str
then
603 function MonsterToStr(MonType
: Byte): String;
605 if MonType
in [MONSTER_DEMON
..MONSTER_MAN
] then
606 Result
:= MonsterNames
[MonType
]
608 Result
:= MonsterNames
[MONSTER_ZOMBY
];
611 function StrToMonster(Str
: String): Byte;
615 Result
:= MONSTER_ZOMBY
;
616 for i
:= MONSTER_DEMON
to MONSTER_MAN
do
617 if MonsterNames
[i
] = Str
then
624 function ItemToStr(ItemType
: Byte): String;
626 if ItemType
in [ITEM_MEDKIT_SMALL
..ITEM_MAX
] then
627 Result
:= ItemNames
[ItemType
]
629 Result
:= ItemNames
[ITEM_AMMO_BULLETS
];
632 function StrToItem(Str
: String): Byte;
636 Result
:= ITEM_AMMO_BULLETS
;
637 for i
:= ITEM_MEDKIT_SMALL
to ITEM_MAX
do
638 if ItemNames
[i
] = Str
then
645 function ShotToStr(ShotType
: Byte): String;
647 if ShotType
in [TRIGGER_SHOT_PISTOL
..TRIGGER_SHOT_MAX
] then
648 Result
:= ShotNames
[ShotType
]
650 Result
:= ShotNames
[TRIGGER_SHOT_PISTOL
];
653 function StrToShot(Str
: String): Byte;
657 Result
:= TRIGGER_SHOT_PISTOL
;
658 for i
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
659 if ShotNames
[i
] = Str
then
666 function SelectedObjectCount(): Word;
672 if SelectedObjects
= nil then
675 for a
:= 0 to High(SelectedObjects
) do
676 if SelectedObjects
[a
].Live
then
677 Result
:= Result
+ 1;
680 function GetFirstSelected(): Integer;
686 if SelectedObjects
= nil then
689 for a
:= 0 to High(SelectedObjects
) do
690 if SelectedObjects
[a
].Live
then
697 function Normalize16(x
: Integer): Integer;
699 Result
:= (x
div 16) * 16;
702 procedure MoveMap(X
, Y
: Integer);
704 rx
, ry
, ScaleSz
: Integer;
706 with MainForm
.RenderPanel
do
708 ScaleSz
:= 16 div Scale
;
709 // Размер видимой части карты:
710 rx
:= Min(Normalize16(Width
), Normalize16(gMapInfo
.Width
)) div 2;
711 ry
:= Min(Normalize16(Height
), Normalize16(gMapInfo
.Height
)) div 2;
712 // Место клика на мини-карте:
713 MapOffset
.X
:= X
- (Width
- Max(gMapInfo
.Width
div ScaleSz
, 1) - 1);
714 MapOffset
.Y
:= Y
- 1;
715 // Это же место на "большой" карте:
716 MapOffset
.X
:= MapOffset
.X
* ScaleSz
;
717 MapOffset
.Y
:= MapOffset
.Y
* ScaleSz
;
718 // Левый верхний угол новой видимой части карты:
719 MapOffset
.X
:= MapOffset
.X
- rx
;
720 MapOffset
.Y
:= MapOffset
.Y
- ry
;
722 MapOffset
.X
:= EnsureRange(MapOffset
.X
, MainForm
.sbHorizontal
.Min
, MainForm
.sbHorizontal
.Max
);
723 MapOffset
.Y
:= EnsureRange(MapOffset
.Y
, MainForm
.sbVertical
.Min
, MainForm
.sbVertical
.Max
);
725 // MapOffset.X := Normalize16(MapOffset.X);
726 // MapOffset.Y := Normalize16(MapOffset.Y);
729 MainForm
.sbHorizontal
.Position
:= MapOffset
.X
;
730 MainForm
.sbVertical
.Position
:= MapOffset
.Y
;
732 MapOffset
.X
:= -MapOffset
.X
;
733 MapOffset
.Y
:= -MapOffset
.Y
;
738 function IsTexturedPanel(PanelType
: Word): Boolean;
740 Result
:= WordBool(PanelType
and (PANEL_WALL
or PANEL_BACK
or PANEL_FORE
or
741 PANEL_STEP
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
or
742 PANEL_WATER
or PANEL_ACID1
or PANEL_ACID2
));
745 procedure FillProperty();
750 MainForm
.vleObjectProperty
.Strings
.Clear();
751 MainForm
.RecountSelectedObjects();
753 // Отображаем свойства если выделен только один объект:
754 if SelectedObjectCount() <> 1 then
757 _id
:= GetFirstSelected();
758 if not SelectedObjects
[_id
].Live
then
761 with MainForm
.vleObjectProperty
do
762 with ItemProps
[InsertRow(MsgPropId
, IntToStr(SelectedObjects
[_id
].ID
), True)] do
764 EditStyle
:= esSimple
;
768 case SelectedObjects
[0].ObjectType
of
771 with MainForm
.vleObjectProperty
,
772 gPanels
[SelectedObjects
[_id
].ID
] do
774 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
776 EditStyle
:= esSimple
;
780 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
782 EditStyle
:= esSimple
;
786 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
788 EditStyle
:= esSimple
;
792 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
794 EditStyle
:= esSimple
;
798 with ItemProps
[InsertRow(MsgPropPanelType
, GetPanelName(PanelType
), True)] do
800 EditStyle
:= esEllipsis
;
804 if IsTexturedPanel(PanelType
) then
805 begin // Может быть текстура
806 with ItemProps
[InsertRow(MsgPropPanelTex
, TextureName
, True)] do
808 EditStyle
:= esEllipsis
;
812 if TextureName
<> '' then
813 begin // Есть текстура
814 with ItemProps
[InsertRow(MsgPropPanelAlpha
, IntToStr(Alpha
), True)] do
816 EditStyle
:= esSimple
;
820 with ItemProps
[InsertRow(MsgPropPanelBlend
, BoolNames
[Blending
], True)] do
822 EditStyle
:= esPickList
;
832 with MainForm
.vleObjectProperty
,
833 gItems
[SelectedObjects
[_id
].ID
] do
835 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
837 EditStyle
:= esSimple
;
841 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
843 EditStyle
:= esSimple
;
847 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[OnlyDM
], True)] do
849 EditStyle
:= esPickList
;
853 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Fall
], True)] do
855 EditStyle
:= esPickList
;
863 with MainForm
.vleObjectProperty
,
864 gMonsters
[SelectedObjects
[_id
].ID
] do
866 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
868 EditStyle
:= esSimple
;
872 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
874 EditStyle
:= esSimple
;
878 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
880 EditStyle
:= esPickList
;
888 with MainForm
.vleObjectProperty
,
889 gAreas
[SelectedObjects
[_id
].ID
] do
891 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
893 EditStyle
:= esSimple
;
897 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
899 EditStyle
:= esSimple
;
903 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[Direction
], True)] do
905 EditStyle
:= esPickList
;
913 with MainForm
.vleObjectProperty
,
914 gTriggers
[SelectedObjects
[_id
].ID
] do
916 with ItemProps
[InsertRow(MsgPropTrType
, GetTriggerName(TriggerType
), True)] do
918 EditStyle
:= esSimple
;
922 with ItemProps
[InsertRow(MsgPropX
, IntToStr(X
), True)] do
924 EditStyle
:= esSimple
;
928 with ItemProps
[InsertRow(MsgPropY
, IntToStr(Y
), True)] do
930 EditStyle
:= esSimple
;
934 with ItemProps
[InsertRow(MsgPropWidth
, IntToStr(Width
), True)] do
936 EditStyle
:= esSimple
;
940 with ItemProps
[InsertRow(MsgPropHeight
, IntToStr(Height
), True)] do
942 EditStyle
:= esSimple
;
946 with ItemProps
[InsertRow(MsgPropTrEnabled
, BoolNames
[Enabled
], True)] do
948 EditStyle
:= esPickList
;
952 with ItemProps
[InsertRow(MsgPropTrTexturePanel
, IntToStr(TexturePanel
), True)] do
954 EditStyle
:= esEllipsis
;
958 with ItemProps
[InsertRow(MsgPropTrActivation
, ActivateToStr(ActivateType
), True)] do
960 EditStyle
:= esEllipsis
;
964 with ItemProps
[InsertRow(MsgPropTrKeys
, KeyToStr(Key
), True)] do
966 EditStyle
:= esEllipsis
;
973 str
:= win2utf(Data
.MapName
);
974 with ItemProps
[InsertRow(MsgPropTrNextMap
, str
, True)] do
976 EditStyle
:= esEllipsis
;
983 with ItemProps
[InsertRow(MsgPropTrTeleportTo
, Format('(%d:%d)', [Data
.TargetPoint
.X
, Data
.TargetPoint
.Y
]), True)] do
985 EditStyle
:= esEllipsis
;
989 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_teleport
], True)] do
991 EditStyle
:= esPickList
;
995 with ItemProps
[InsertRow(MsgPropTrTeleportSilent
, BoolNames
[Data
.silent_teleport
], True)] do
997 EditStyle
:= esPickList
;
1001 with ItemProps
[InsertRow(MsgPropTrTeleportDir
, DirNamesAdv
[Data
.TlpDir
], True)] do
1003 EditStyle
:= esPickList
;
1008 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
,
1009 TRIGGER_DOOR
, TRIGGER_DOOR5
:
1011 with ItemProps
[InsertRow(MsgPropTrDoorPanel
, IntToStr(Data
.PanelID
), True)] do
1013 EditStyle
:= esEllipsis
;
1017 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1019 EditStyle
:= esPickList
;
1023 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1025 EditStyle
:= esPickList
;
1030 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
:
1032 with ItemProps
[InsertRow(MsgPropTrTrapPanel
, IntToStr(Data
.PanelID
), True)] do
1034 EditStyle
:= esEllipsis
;
1038 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1040 EditStyle
:= esPickList
;
1044 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1046 EditStyle
:= esPickList
;
1051 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
1054 with ItemProps
[InsertRow(MsgPropTrExArea
,
1055 Format('(%d:%d %d:%d)', [Data
.tX
, Data
.tY
, Data
.tWidth
, Data
.tHeight
]), True)] do
1057 EditStyle
:= esEllipsis
;
1061 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.Wait
), True)] do
1063 EditStyle
:= esSimple
;
1067 with ItemProps
[InsertRow(MsgPropTrExCount
, IntToStr(Data
.Count
), True)] do
1069 EditStyle
:= esSimple
;
1073 with ItemProps
[InsertRow(MsgPropTrExMonster
, IntToStr(Data
.MonsterID
-1), True)] do
1075 EditStyle
:= esEllipsis
;
1079 if TriggerType
= TRIGGER_PRESS
then
1080 with ItemProps
[InsertRow(MsgPropTrExRandom
, BoolNames
[Data
.ExtRandom
], True)] do
1082 EditStyle
:= esPickList
;
1090 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
1092 with ItemProps
[InsertRow(MsgPropTrLiftPanel
, IntToStr(Data
.PanelID
), True)] do
1094 EditStyle
:= esEllipsis
;
1098 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.NoSound
], True)] do
1100 EditStyle
:= esPickList
;
1104 with ItemProps
[InsertRow(MsgPropTrD2d
, BoolNames
[Data
.d2d_doors
], True)] do
1106 EditStyle
:= esPickList
;
1113 with ItemProps
[InsertRow(MsgPropTrTextureOnce
, BoolNames
[Data
.ActivateOnce
], True)] do
1115 EditStyle
:= esPickList
;
1119 with ItemProps
[InsertRow(MsgPropTrTextureAnimOnce
, BoolNames
[Data
.AnimOnce
], True)] do
1121 EditStyle
:= esPickList
;
1128 str
:= win2utf(Data
.SoundName
);
1129 with ItemProps
[InsertRow(MsgPropTrSoundName
, str
, True)] do
1131 EditStyle
:= esEllipsis
;
1135 with ItemProps
[InsertRow(MsgPropTrSoundVolume
, IntToStr(Data
.Volume
), True)] do
1137 EditStyle
:= esSimple
;
1141 with ItemProps
[InsertRow(MsgPropTrSoundPan
, IntToStr(Data
.Pan
), True)] do
1143 EditStyle
:= esSimple
;
1147 with ItemProps
[InsertRow(MsgPropTrSoundCount
, IntToStr(Data
.PlayCount
), True)] do
1149 EditStyle
:= esSimple
;
1153 with ItemProps
[InsertRow(MsgPropTrSoundLocal
, BoolNames
[Data
.Local
], True)] do
1155 EditStyle
:= esPickList
;
1159 with ItemProps
[InsertRow(MsgPropTrSoundSwitch
, BoolNames
[Data
.SoundSwitch
], True)] do
1161 EditStyle
:= esPickList
;
1166 TRIGGER_SPAWNMONSTER
:
1168 with ItemProps
[InsertRow(MsgPropTrMonsterType
, MonsterToStr(Data
.MonType
), True)] do
1170 EditStyle
:= esEllipsis
;
1174 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1175 Format('(%d:%d)', [Data
.MonPos
.X
, Data
.MonPos
.Y
]), True)] do
1177 EditStyle
:= esEllipsis
;
1181 with ItemProps
[InsertRow(MsgPropDirection
, DirNames
[TDirection(Data
.MonDir
)], True)] do
1183 EditStyle
:= esPickList
;
1187 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.MonHealth
), True)] do
1189 EditStyle
:= esSimple
;
1193 with ItemProps
[InsertRow(MsgPropTrMonsterActive
, BoolNames
[Data
.MonActive
], True)] do
1195 EditStyle
:= esPickList
;
1199 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.MonCount
), True)] do
1201 EditStyle
:= esSimple
;
1205 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.MonEffect
), True)] do
1207 EditStyle
:= esEllipsis
;
1211 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.MonMax
), True)] do
1213 EditStyle
:= esSimple
;
1217 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.MonDelay
), True)] do
1219 EditStyle
:= esSimple
;
1223 case Data
.MonBehav
of
1224 1: str
:= MsgPropTrMonsterBehaviour1
;
1225 2: str
:= MsgPropTrMonsterBehaviour2
;
1226 3: str
:= MsgPropTrMonsterBehaviour3
;
1227 4: str
:= MsgPropTrMonsterBehaviour4
;
1228 5: str
:= MsgPropTrMonsterBehaviour5
;
1229 else str
:= MsgPropTrMonsterBehaviour0
;
1231 with ItemProps
[InsertRow(MsgPropTrMonsterBehaviour
, str
, True)] do
1233 EditStyle
:= esPickList
;
1240 with ItemProps
[InsertRow(MsgPropTrItemType
, ItemToStr(Data
.ItemType
), True)] do
1242 EditStyle
:= esEllipsis
;
1246 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1247 Format('(%d:%d)', [Data
.ItemPos
.X
, Data
.ItemPos
.Y
]), True)] do
1249 EditStyle
:= esEllipsis
;
1253 with ItemProps
[InsertRow(MsgPropDmOnly
, BoolNames
[Data
.ItemOnlyDM
], True)] do
1255 EditStyle
:= esPickList
;
1259 with ItemProps
[InsertRow(MsgPropItemFalls
, BoolNames
[Data
.ItemFalls
], True)] do
1261 EditStyle
:= esPickList
;
1265 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ItemCount
), True)] do
1267 EditStyle
:= esSimple
;
1271 with ItemProps
[InsertRow(MsgPropTrFxType
, EffectToStr(Data
.ItemEffect
), True)] do
1273 EditStyle
:= esEllipsis
;
1277 with ItemProps
[InsertRow(MsgPropTrSpawnMax
, IntToStr(Data
.ItemMax
), True)] do
1279 EditStyle
:= esSimple
;
1283 with ItemProps
[InsertRow(MsgPropTrSpawnDelay
, IntToStr(Data
.ItemDelay
), True)] do
1285 EditStyle
:= esSimple
;
1292 str
:= win2utf(Data
.MusicName
);
1293 with ItemProps
[InsertRow(MsgPropTrMusicName
, str
, True)] do
1295 EditStyle
:= esEllipsis
;
1299 if Data
.MusicAction
= 1 then
1300 str
:= MsgPropTrMusicOn
1302 str
:= MsgPropTrMusicOff
;
1304 with ItemProps
[InsertRow(MsgPropTrMusicAct
, str
, True)] do
1306 EditStyle
:= esPickList
;
1313 with ItemProps
[InsertRow(MsgPropTrPushAngle
, IntToStr(Data
.PushAngle
), True)] do
1315 EditStyle
:= esSimple
;
1318 with ItemProps
[InsertRow(MsgPropTrPushForce
, IntToStr(Data
.PushForce
), True)] do
1320 EditStyle
:= esSimple
;
1323 with ItemProps
[InsertRow(MsgPropTrPushReset
, BoolNames
[Data
.ResetVel
], True)] do
1325 EditStyle
:= esPickList
;
1332 case Data
.ScoreAction
of
1333 1: str
:= MsgPropTrScoreAct1
;
1334 2: str
:= MsgPropTrScoreAct2
;
1335 3: str
:= MsgPropTrScoreAct3
;
1336 else str
:= MsgPropTrScoreAct0
;
1338 with ItemProps
[InsertRow(MsgPropTrScoreAct
, str
, True)] do
1340 EditStyle
:= esPickList
;
1343 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.ScoreCount
), True)] do
1345 EditStyle
:= esSimple
;
1348 case Data
.ScoreTeam
of
1349 1: str
:= MsgPropTrScoreTeam1
;
1350 2: str
:= MsgPropTrScoreTeam2
;
1351 3: str
:= MsgPropTrScoreTeam3
;
1352 else str
:= MsgPropTrScoreTeam0
;
1354 with ItemProps
[InsertRow(MsgPropTrScoreTeam
, str
, True)] do
1356 EditStyle
:= esPickList
;
1359 with ItemProps
[InsertRow(MsgPropTrScoreCon
, BoolNames
[Data
.ScoreCon
], True)] do
1361 EditStyle
:= esPickList
;
1364 with ItemProps
[InsertRow(MsgPropTrScoreMsg
, BoolNames
[Data
.ScoreMsg
], True)] do
1366 EditStyle
:= esPickList
;
1373 case Data
.MessageKind
of
1374 1: str
:= MsgPropTrMessageKind1
;
1375 else str
:= MsgPropTrMessageKind0
;
1377 with ItemProps
[InsertRow(MsgPropTrMessageKind
, str
, True)] do
1379 EditStyle
:= esPickList
;
1382 case Data
.MessageSendTo
of
1383 1: str
:= MsgPropTrMessageTo1
;
1384 2: str
:= MsgPropTrMessageTo2
;
1385 3: str
:= MsgPropTrMessageTo3
;
1386 4: str
:= MsgPropTrMessageTo4
;
1387 5: str
:= MsgPropTrMessageTo5
;
1388 else str
:= MsgPropTrMessageTo0
;
1390 with ItemProps
[InsertRow(MsgPropTrMessageTo
, str
, True)] do
1392 EditStyle
:= esPickList
;
1395 str
:= win2utf(Data
.MessageText
);
1396 with ItemProps
[InsertRow(MsgPropTrMessageText
, str
, True)] do
1398 EditStyle
:= esSimple
;
1401 with ItemProps
[InsertRow(MsgPropTrMessageTime
, IntToStr(Data
.MessageTime
), True)] do
1403 EditStyle
:= esSimple
;
1410 with ItemProps
[InsertRow(MsgPropTrDamageValue
, IntToStr(Data
.DamageValue
), True)] do
1412 EditStyle
:= esSimple
;
1415 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.DamageInterval
), True)] do
1417 EditStyle
:= esSimple
;
1420 case Data
.DamageKind
of
1421 3: str
:= MsgPropTrDamageKind3
;
1422 4: str
:= MsgPropTrDamageKind4
;
1423 5: str
:= MsgPropTrDamageKind5
;
1424 6: str
:= MsgPropTrDamageKind6
;
1425 7: str
:= MsgPropTrDamageKind7
;
1426 8: str
:= MsgPropTrDamageKind8
;
1427 else str
:= MsgPropTrDamageKind0
;
1429 with ItemProps
[InsertRow(MsgPropTrDamageKind
, str
, True)] do
1431 EditStyle
:= esPickList
;
1438 with ItemProps
[InsertRow(MsgPropTrHealth
, IntToStr(Data
.HealValue
), True)] do
1440 EditStyle
:= esSimple
;
1443 with ItemProps
[InsertRow(MsgPropTrInterval
, IntToStr(Data
.HealInterval
), True)] do
1445 EditStyle
:= esSimple
;
1448 with ItemProps
[InsertRow(MsgPropTrHealthMax
, BoolNames
[Data
.HealMax
], True)] do
1450 EditStyle
:= esPickList
;
1453 with ItemProps
[InsertRow(MsgPropTrSilent
, BoolNames
[Data
.HealSilent
], True)] do
1455 EditStyle
:= esPickList
;
1462 with ItemProps
[InsertRow(MsgPropTrShotType
, ShotToStr(Data
.ShotType
), True)] do
1464 EditStyle
:= esEllipsis
;
1468 with ItemProps
[InsertRow(MsgPropTrShotSound
, BoolNames
[Data
.ShotSound
], True)] do
1470 EditStyle
:= esPickList
;
1474 with ItemProps
[InsertRow(MsgPropTrShotPanel
, IntToStr(Data
.ShotPanelID
), True)] do
1476 EditStyle
:= esEllipsis
;
1480 case Data
.ShotTarget
of
1481 1: str
:= MsgPropTrShotTo1
;
1482 2: str
:= MsgPropTrShotTo2
;
1483 3: str
:= MsgPropTrShotTo3
;
1484 4: str
:= MsgPropTrShotTo4
;
1485 5: str
:= MsgPropTrShotTo5
;
1486 6: str
:= MsgPropTrShotTo6
;
1487 else str
:= MsgPropTrShotTo0
;
1489 with ItemProps
[InsertRow(MsgPropTrShotTo
, str
, True)] do
1491 EditStyle
:= esPickList
;
1495 with ItemProps
[InsertRow(MsgPropTrShotSight
, IntToStr(Data
.ShotIntSight
), True)] do
1497 EditStyle
:= esSimple
;
1501 case Data
.ShotAim
of
1502 1: str
:= MsgPropTrShotAim1
;
1503 2: str
:= MsgPropTrShotAim2
;
1504 3: str
:= MsgPropTrShotAim3
;
1505 else str
:= MsgPropTrShotAim0
;
1507 with ItemProps
[InsertRow(MsgPropTrShotAim
, str
, True)] do
1509 EditStyle
:= esPickList
;
1513 with ItemProps
[InsertRow(MsgPropTrSpawnTo
,
1514 Format('(%d:%d)', [Data
.ShotPos
.X
, Data
.ShotPos
.Y
]), True)] do
1516 EditStyle
:= esEllipsis
;
1520 with ItemProps
[InsertRow(MsgPropTrShotAngle
, IntToStr(Data
.ShotAngle
), True)] do
1522 EditStyle
:= esSimple
;
1526 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.ShotWait
), True)] do
1528 EditStyle
:= esSimple
;
1532 with ItemProps
[InsertRow(MsgPropTrShotAcc
, IntToStr(Data
.ShotAccuracy
), True)] do
1534 EditStyle
:= esSimple
;
1538 with ItemProps
[InsertRow(MsgPropTrShotAmmo
, IntToStr(Data
.ShotAmmo
), True)] do
1540 EditStyle
:= esSimple
;
1544 with ItemProps
[InsertRow(MsgPropTrShotReload
, IntToStr(Data
.ShotIntReload
), True)] do
1546 EditStyle
:= esSimple
;
1553 with ItemProps
[InsertRow(MsgPropTrCount
, IntToStr(Data
.FXCount
), True)] do
1555 EditStyle
:= esSimple
;
1559 if Data
.FXType
= 0 then
1560 str
:= MsgPropTrEffectParticle
1562 str
:= MsgPropTrEffectAnimation
;
1563 with ItemProps
[InsertRow(MsgPropTrEffectType
, str
, True)] do
1565 EditStyle
:= esEllipsis
;
1570 if Data
.FXType
= 0 then
1571 case Data
.FXSubType
of
1572 TRIGGER_EFFECT_SLIQUID
:
1573 str
:= MsgPropTrEffectSliquid
;
1574 TRIGGER_EFFECT_LLIQUID
:
1575 str
:= MsgPropTrEffectLliquid
;
1576 TRIGGER_EFFECT_DLIQUID
:
1577 str
:= MsgPropTrEffectDliquid
;
1578 TRIGGER_EFFECT_BLOOD
:
1579 str
:= MsgPropTrEffectBlood
;
1580 TRIGGER_EFFECT_SPARK
:
1581 str
:= MsgPropTrEffectSpark
;
1582 TRIGGER_EFFECT_BUBBLE
:
1583 str
:= MsgPropTrEffectBubble
;
1585 if Data
.FXType
= 1 then
1587 if (Data
.FXSubType
= 0) or (Data
.FXSubType
> EFFECT_FIRE
) then
1588 Data
.FXSubType
:= EFFECT_TELEPORT
;
1589 str
:= EffectToStr(Data
.FXSubType
);
1591 with ItemProps
[InsertRow(MsgPropTrEffectSubtype
, str
, True)] do
1593 EditStyle
:= esEllipsis
;
1597 with ItemProps
[InsertRow(MsgPropTrEffectColor
, IntToStr(Data
.FXColorR
or (Data
.FXColorG
shl 8) or (Data
.FXColorB
shl 16)), True)] do
1599 EditStyle
:= esEllipsis
;
1603 with ItemProps
[InsertRow(MsgPropTrEffectCenter
, BoolNames
[Data
.FXPos
= 0], True)] do
1605 EditStyle
:= esPickList
;
1609 with ItemProps
[InsertRow(MsgPropTrExDelay
, IntToStr(Data
.FXWait
), True)] do
1611 EditStyle
:= esSimple
;
1615 with ItemProps
[InsertRow(MsgPropTrEffectVelx
, IntToStr(Data
.FXVelX
), True)] do
1617 EditStyle
:= esSimple
;
1621 with ItemProps
[InsertRow(MsgPropTrEffectVely
, IntToStr(Data
.FXVelY
), True)] do
1623 EditStyle
:= esSimple
;
1627 with ItemProps
[InsertRow(MsgPropTrEffectSpl
, IntToStr(Data
.FXSpreadL
), True)] do
1629 EditStyle
:= esSimple
;
1633 with ItemProps
[InsertRow(MsgPropTrEffectSpr
, IntToStr(Data
.FXSpreadR
), True)] do
1635 EditStyle
:= esSimple
;
1639 with ItemProps
[InsertRow(MsgPropTrEffectSpu
, IntToStr(Data
.FXSpreadU
), True)] do
1641 EditStyle
:= esSimple
;
1645 with ItemProps
[InsertRow(MsgPropTrEffectSpd
, IntToStr(Data
.FXSpreadD
), True)] do
1647 EditStyle
:= esSimple
;
1651 end; //case TriggerType
1653 end; // OBJECT_TRIGGER:
1657 procedure ChangeShownProperty(Name
: String; NewValue
: String);
1661 if SelectedObjectCount() <> 1 then
1663 if not SelectedObjects
[GetFirstSelected()].Live
then
1666 // Есть ли такой ключ:
1667 if MainForm
.vleObjectProperty
.FindRow(Name
, row
) then
1669 MainForm
.vleObjectProperty
.Values
[Name
] := NewValue
;
1673 procedure SelectObject(fObjectType
: Byte; fID
: DWORD
; Multi
: Boolean);
1682 // Уже выделен - убираем:
1683 if SelectedObjects
<> nil then
1684 for a
:= 0 to High(SelectedObjects
) do
1685 with SelectedObjects
[a
] do
1686 if Live
and (ID
= fID
) and
1687 (ObjectType
= fObjectType
) then
1696 SetLength(SelectedObjects
, Length(SelectedObjects
)+1);
1698 with SelectedObjects
[High(SelectedObjects
)] do
1700 ObjectType
:= fObjectType
;
1707 SetLength(SelectedObjects
, 1);
1709 with SelectedObjects
[0] do
1711 ObjectType
:= fObjectType
;
1717 MainForm
.miCopy
.Enabled
:= True;
1718 MainForm
.miCut
.Enabled
:= True;
1720 if fObjectType
= OBJECT_PANEL
then
1722 MainForm
.miToFore
.Enabled
:= True;
1723 MainForm
.miToBack
.Enabled
:= True;
1727 procedure RemoveSelectFromObjects();
1729 SelectedObjects
:= nil;
1730 DrawPressRect
:= False;
1731 MouseLDown
:= False;
1732 MouseRDown
:= False;
1733 MouseAction
:= MOUSEACTION_NONE
;
1734 SelectFlag
:= SELECTFLAG_NONE
;
1735 ResizeType
:= RESIZETYPE_NONE
;
1736 ResizeDirection
:= RESIZEDIR_NONE
;
1738 MainForm
.vleObjectProperty
.Strings
.Clear();
1740 MainForm
.miCopy
.Enabled
:= False;
1741 MainForm
.miCut
.Enabled
:= False;
1742 MainForm
.miToFore
.Enabled
:= False;
1743 MainForm
.miToBack
.Enabled
:= False;
1746 procedure DeleteSelectedObjects();
1751 if SelectedObjects
= nil then
1757 for a
:= 0 to High(SelectedObjects
) do
1758 with SelectedObjects
[a
] do
1763 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1764 i
:= High(UndoBuffer
);
1768 SetLength(UndoBuffer
[i
], Length(UndoBuffer
[i
])+1);
1769 ii
:= High(UndoBuffer
[i
]);
1774 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_PANEL
;
1775 New(UndoBuffer
[i
, ii
].Panel
);
1776 UndoBuffer
[i
, ii
].Panel
^ := gPanels
[ID
];
1780 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_ITEM
;
1781 UndoBuffer
[i
, ii
].Item
:= gItems
[ID
];
1785 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_AREA
;
1786 UndoBuffer
[i
, ii
].Area
:= gAreas
[ID
];
1790 UndoBuffer
[i
, ii
].UndoType
:= UNDO_DELETE_TRIGGER
;
1791 UndoBuffer
[i
, ii
].Trigger
:= gTriggers
[ID
];
1795 RemoveObject(ID
, ObjectType
);
1798 RemoveSelectFromObjects();
1800 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1801 MainForm
.RecountSelectedObjects();
1804 procedure Undo_Add(ObjectType
: Byte; ID
: DWORD
; Group
: Boolean = False);
1808 if (not Group
) or (Length(UndoBuffer
) = 0) then
1809 SetLength(UndoBuffer
, Length(UndoBuffer
)+1);
1810 SetLength(UndoBuffer
[High(UndoBuffer
)], Length(UndoBuffer
[High(UndoBuffer
)])+1);
1811 i
:= High(UndoBuffer
);
1812 ii
:= High(UndoBuffer
[i
]);
1816 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_PANEL
;
1818 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_ITEM
;
1820 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_MONSTER
;
1822 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_AREA
;
1824 UndoBuffer
[i
, ii
].UndoType
:= UNDO_ADD_TRIGGER
;
1827 UndoBuffer
[i
, ii
].AddID
:= ID
;
1829 MainForm
.miUndo
.Enabled
:= UndoBuffer
<> nil;
1832 procedure FullClear();
1834 RemoveSelectFromObjects();
1836 LoadSky(gMapInfo
.SkyName
);
1838 slInvalidTextures
.Clear();
1839 MapCheckForm
.lbErrorList
.Clear();
1840 MapCheckForm
.mErrorDescription
.Clear();
1842 MainForm
.miUndo
.Enabled
:= False;
1843 MainForm
.sbHorizontal
.Position
:= 0;
1844 MainForm
.sbVertical
.Position
:= 0;
1845 MainForm
.FormResize(nil);
1846 MainForm
.Caption
:= FormCaption
;
1851 procedure ErrorMessageBox(str
: String);
1853 Application
.MessageBox(PChar(str
), PChar(MsgMsgError
),
1854 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
);
1857 function CheckProperty(): Boolean;
1863 _id
:= GetFirstSelected();
1865 if SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
then
1866 with gPanels
[SelectedObjects
[_id
].ID
] do
1868 if TextureWidth
<> 0 then
1869 if StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 1) mod TextureWidth
<> 0 then
1871 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
1876 if TextureHeight
<> 0 then
1877 if StrToIntDef(Trim(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
]), 1) mod TextureHeight
<> 0 then
1879 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
1884 if IsTexturedPanel(PanelType
) and (TextureName
<> '') then
1885 if not (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropPanelAlpha
], -1) in [0..255]) then
1887 ErrorMessageBox(MsgMsgWrongAlpha
);
1892 if SelectedObjects
[_id
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
1893 if (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropWidth
], 0) <= 0) or
1894 (StrToIntDef(MainForm
.vleObjectProperty
.Values
[MsgPropHeight
], 0) <= 0) then
1896 ErrorMessageBox(MsgMsgWrongSize
);
1900 if (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropX
]) = '') or
1901 (Trim(MainForm
.vleObjectProperty
.Values
[MsgPropY
]) = '') then
1903 ErrorMessageBox(MsgMsgWrongXy
);
1910 procedure SelectTexture(ID
: Integer);
1912 MainForm
.lbTextureList
.ItemIndex
:= ID
;
1913 MainForm
.lbTextureListClick(nil);
1916 function AddTexture(aWAD
, aSection
, aTex
: String; silent
: Boolean): Boolean;
1918 a
, FrameLen
: Integer;
1921 ResourceName
: String;
1922 FullResourceName
: String;
1923 SectionName
: String;
1925 Width
, Height
: Word;
1933 if aSection
= '..' then
1936 SectionName
:= aSection
;
1939 aWAD
:= MsgWadSpecialMap
;
1941 if aWAD
= MsgWadSpecialMap
then
1943 g_ProcessResourceStr(OpenedMap
, @fn
, nil, nil);
1945 ResourceName
:= ':'+SectionName
+'\'+aTex
;
1948 if aWAD
= MsgWadSpecialTexs
then
1949 begin // Спец. текстуры
1951 ResourceName
:= aTex
;
1954 begin // Внешний WAD
1955 FileName
:= WadsDir
+ DirectorySeparator
+ aWAD
;
1956 ResourceName
:= aWAD
+':'+SectionName
+'\'+aTex
;
1961 // Есть ли уже такая текстура:
1962 for a
:= 0 to MainForm
.lbTextureList
.Items
.Count
-1 do
1963 if ResourceName
= MainForm
.lbTextureList
.Items
[a
] then
1966 ErrorMessageBox(Format(MsgMsgTextureAlready
,
1971 // Название ресурса <= 64 символов:
1972 if Length(ResourceName
) > 64 then
1975 ErrorMessageBox(Format(MsgMsgResName64
,
1983 if aWAD
= MsgWadSpecialTexs
then
1985 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
1992 FullResourceName
:= FileName
+':'+SectionName
+'\'+aTex
;
1994 if IsAnim(FullResourceName
) then
1995 begin // Аним. текстура
1996 GetFrame(FullResourceName
, Data
, FrameLen
, Width
, Height
);
1998 if not g_CreateTextureMemorySize(Data
, FrameLen
, ResourceName
, 0, 0, Width
, Height
, 1) then
2000 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2002 else // Обычная текстура
2004 if not g_CreateTextureWAD(ResourceName
, FullResourceName
) then
2006 a
:= MainForm
.lbTextureList
.Items
.Add(ResourceName
);
2008 if (not ok
) and (slInvalidTextures
.IndexOf(ResourceName
) = -1) then
2010 slInvalidTextures
.Add(ResourceName
);
2013 if (a
> -1) and (not silent
) then
2020 procedure UpdateCaption(sMap
, sFile
, sRes
: String);
2023 if (sFile
= '') and (sRes
= '') and (sMap
= '') then
2024 Caption
:= FormCaption
2027 Caption
:= Format('%s - %s:%s', [FormCaption
, sFile
, sRes
])
2029 if (sFile
<> '') and (sRes
<> '') then
2030 Caption
:= Format('%s - %s (%s:%s)', [FormCaption
, sMap
, sFile
, sRes
])
2032 Caption
:= Format('%s - %s', [FormCaption
, sMap
]);
2035 procedure OpenMap(FileName
: String; mapN
: String);
2040 SelectMapForm
.Caption
:= MsgCapOpen
;
2041 SelectMapForm
.GetMaps(FileName
);
2043 if (FileName
= OpenedWAD
) and
2044 (OpenedMap
<> '') then
2046 MapName
:= OpenedMap
;
2047 while (Pos(':\', MapName
) > 0) do
2048 Delete(MapName
, 1, Pos(':\', MapName
) + 1);
2050 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(MapName
);
2051 SelectMapForm
.lbMapList
.ItemIndex
:= idx
;
2054 if SelectMapForm
.lbMapList
.Count
> 0 then
2055 SelectMapForm
.lbMapList
.ItemIndex
:= 0
2057 SelectMapForm
.lbMapList
.ItemIndex
:= -1;
2062 idx
:= SelectMapForm
.lbMapList
.Items
.IndexOf(mapN
);
2066 if (SelectMapForm
.ShowModal() = mrOK
) and
2067 (SelectMapForm
.lbMapList
.ItemIndex
<> -1) then
2068 idx
:= SelectMapForm
.lbMapList
.ItemIndex
2073 MapName
:= SelectMapForm
.lbMapList
.Items
[idx
];
2079 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
2080 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
2081 pLoadProgress
.Show();
2083 OpenedMap
:= FileName
+':\'+MapName
;
2084 OpenedWAD
:= FileName
;
2086 idx
:= RecentFiles
.IndexOf(OpenedMap
);
2087 // Такая карта уже недавно открывалась:
2089 RecentFiles
.Delete(idx
);
2090 RecentFiles
.Insert(0, OpenedMap
);
2091 RefreshRecentMenu();
2095 pLoadProgress
.Hide();
2098 lbTextureList
.Sorted
:= True;
2099 lbTextureList
.Sorted
:= False;
2101 UpdateCaption(gMapInfo
.Name
, ExtractFileName(FileName
), MapName
);
2105 procedure MoveSelectedObjects(Wall
, alt
: Boolean; dx
, dy
: Integer);
2110 if SelectedObjects
= nil then
2117 for a
:= 0 to High(SelectedObjects
) do
2118 if SelectedObjects
[a
].Live
then
2120 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, dx
, 0) then
2123 if ObjectCollideLevel(SelectedObjects
[a
].ID
, SelectedObjects
[a
].ObjectType
, 0, dy
) then
2126 if (not okX
) or (not okY
) then
2132 for a
:= 0 to High(SelectedObjects
) do
2133 if SelectedObjects
[a
].Live
then
2136 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, dx
, 0);
2139 MoveObject(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
, 0, dy
);
2141 if alt
and (SelectedObjects
[a
].ObjectType
= OBJECT_TRIGGER
) then
2143 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_PRESS
,
2144 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
] then
2145 begin // Двигаем зону Расширителя
2147 gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tX
+dx
;
2149 gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.tY
+dy
;
2152 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_TELEPORT
] then
2153 begin // Двигаем точку назначения Телепорта
2155 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.X
+dx
;
2157 gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.TargetPoint
.Y
+dy
;
2160 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNMONSTER
] then
2161 begin // Двигаем точку создания монстра
2163 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.X
+dx
;
2165 gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.MonPos
.Y
+dy
;
2168 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SPAWNITEM
] then
2169 begin // Двигаем точку создания предмета
2171 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.X
+dx
;
2173 gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ItemPos
.Y
+dy
;
2176 if gTriggers
[SelectedObjects
[a
].ID
].TriggerType
in [TRIGGER_SHOT
] then
2177 begin // Двигаем точку создания выстрела
2179 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.X
+dx
;
2181 gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
:= gTriggers
[SelectedObjects
[a
].ID
].Data
.ShotPos
.Y
+dy
;
2186 LastMovePoint
:= MousePos
;
2190 procedure ShowLayer(Layer
: Byte; show
: Boolean);
2192 LayerEnabled
[Layer
] := show
;
2197 MainForm
.miLayer1
.Checked
:= show
;
2198 MainForm
.miLayerP1
.Checked
:= show
;
2202 MainForm
.miLayer2
.Checked
:= show
;
2203 MainForm
.miLayerP2
.Checked
:= show
;
2207 MainForm
.miLayer3
.Checked
:= show
;
2208 MainForm
.miLayerP3
.Checked
:= show
;
2212 MainForm
.miLayer4
.Checked
:= show
;
2213 MainForm
.miLayerP4
.Checked
:= show
;
2217 MainForm
.miLayer5
.Checked
:= show
;
2218 MainForm
.miLayerP5
.Checked
:= show
;
2222 MainForm
.miLayer6
.Checked
:= show
;
2223 MainForm
.miLayerP6
.Checked
:= show
;
2227 MainForm
.miLayer7
.Checked
:= show
;
2228 MainForm
.miLayerP7
.Checked
:= show
;
2232 MainForm
.miLayer8
.Checked
:= show
;
2233 MainForm
.miLayerP8
.Checked
:= show
;
2237 MainForm
.miLayer9
.Checked
:= show
;
2238 MainForm
.miLayerP9
.Checked
:= show
;
2242 RemoveSelectFromObjects();
2245 procedure SwitchLayer(Layer
: Byte);
2247 ShowLayer(Layer
, not LayerEnabled
[Layer
]);
2250 procedure SwitchMap();
2252 ShowMap
:= not ShowMap
;
2253 MainForm
.tbShowMap
.Down
:= ShowMap
;
2254 MainForm
.miMiniMap
.Checked
:= ShowMap
;
2257 procedure ShowEdges();
2259 if drEdge
[3] < 255 then
2262 drEdge
[3] := gAlphaEdge
;
2263 MainForm
.miShowEdges
.Checked
:= drEdge
[3] <> 255;
2266 function SelectedTexture(): String;
2268 if MainForm
.lbTextureList
.ItemIndex
<> -1 then
2269 Result
:= MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]
2274 function IsSpecialTextureSel(): Boolean;
2276 Result
:= (MainForm
.lbTextureList
.ItemIndex
<> -1) and
2277 IsSpecialTexture(MainForm
.lbTextureList
.Items
[MainForm
.lbTextureList
.ItemIndex
]);
2280 function CopyBufferToString(var CopyBuf
: TCopyRecArray
): String;
2285 procedure AddInt(x
: Integer);
2287 Res
:= Res
+ IntToStr(x
) + ' ';
2293 if Length(CopyBuf
) = 0 then
2296 Res
:= CLIPBOARD_SIG
+ ' ';
2298 for i
:= 0 to High(CopyBuf
) do
2300 if (CopyBuf
[i
].ObjectType
= OBJECT_PANEL
) and
2301 (CopyBuf
[i
].Panel
= nil) then
2305 AddInt(CopyBuf
[i
].ObjectType
);
2308 // Свойства объекта:
2309 case CopyBuf
[i
].ObjectType
of
2311 with CopyBuf
[i
].Panel
^ do
2318 Res
:= Res
+ '"' + TextureName
+ '" ';
2320 AddInt(IfThen(Blending
, 1, 0));
2324 with CopyBuf
[i
].Item
do
2329 AddInt(IfThen(OnlyDM
, 1, 0));
2330 AddInt(IfThen(Fall
, 1, 0));
2334 with CopyBuf
[i
].Monster
do
2336 AddInt(MonsterType
);
2339 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2343 with CopyBuf
[i
].Area
do
2348 AddInt(IfThen(Direction
= D_LEFT
, 1, 0));
2352 with CopyBuf
[i
].Trigger
do
2354 AddInt(TriggerType
);
2359 AddInt(ActivateType
);
2361 AddInt(IfThen(Enabled
, 1, 0));
2362 AddInt(TexturePanel
);
2364 for j
:= 0 to 127 do
2365 AddInt(Data
.Default
[j
]);
2373 procedure StringToCopyBuffer(Str
: String; var CopyBuf
: TCopyRecArray
; var pmin
: TPoint
);
2376 minArea
, newArea
, newX
, newY
: LongInt;
2378 function GetNext(): String;
2383 if Str
[1] = '"' then
2395 Result
:= Copy(Str
, 1, p
-1);
2411 Result
:= Copy(Str
, 1, p
-1);
2419 minArea
:= High(minArea
);
2422 if GetNext() <> CLIPBOARD_SIG
then
2428 t
:= StrToIntDef(GetNext(), 0);
2430 if (t
< OBJECT_PANEL
) or (t
> OBJECT_TRIGGER
) or (GetNext() <> ';') then
2431 begin // Что-то не то => пропускаем:
2439 i
:= Length(CopyBuf
);
2440 SetLength(CopyBuf
, i
+ 1);
2442 CopyBuf
[i
].ObjectType
:= t
;
2443 CopyBuf
[i
].Panel
:= nil;
2445 // Свойства объекта:
2449 New(CopyBuf
[i
].Panel
);
2451 with CopyBuf
[i
].Panel
^ do
2453 PanelType
:= StrToIntDef(GetNext(), PANEL_WALL
);
2454 X
:= StrToIntDef(GetNext(), 0);
2455 Y
:= StrToIntDef(GetNext(), 0);
2456 Width
:= StrToIntDef(GetNext(), 16);
2457 Height
:= StrToIntDef(GetNext(), 16);
2458 TextureName
:= GetNext();
2459 Alpha
:= StrToIntDef(GetNext(), 0);
2460 Blending
:= (GetNext() = '1');
2461 newArea
:= X
* Y
- Width
* Height
;
2468 with CopyBuf
[i
].Item
do
2470 ItemType
:= StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL
);
2471 X
:= StrToIntDef(GetNext(), 0);
2472 Y
:= StrToIntDef(GetNext(), 0);
2473 OnlyDM
:= (GetNext() = '1');
2474 Fall
:= (GetNext() = '1');
2481 with CopyBuf
[i
].Monster
do
2483 MonsterType
:= StrToIntDef(GetNext(), MONSTER_DEMON
);
2484 X
:= StrToIntDef(GetNext(), 0);
2485 Y
:= StrToIntDef(GetNext(), 0);
2487 then Direction
:= D_LEFT
2488 else Direction
:= D_RIGHT
;
2495 with CopyBuf
[i
].Area
do
2497 AreaType
:= StrToIntDef(GetNext(), AREA_PLAYERPOINT1
);
2498 X
:= StrToIntDef(GetNext(), 0);
2499 Y
:= StrToIntDef(GetNext(), 0);
2501 then Direction
:= D_LEFT
2502 else Direction
:= D_RIGHT
;
2509 with CopyBuf
[i
].Trigger
do
2511 TriggerType
:= StrToIntDef(GetNext(), TRIGGER_EXIT
);
2512 X
:= StrToIntDef(GetNext(), 0);
2513 Y
:= StrToIntDef(GetNext(), 0);
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 do Data
.Default
[j
] := StrToIntDef(GetNext(), 0);
2522 newArea
:= X
* Y
- Width
* Height
;
2528 if newArea
< minArea
then
2537 //----------------------------------------
2538 //Закончились вспомогательные процедуры
2539 //----------------------------------------
2541 procedure TMainForm
.miRecentFileExecute (Sender
: TObject
);
2545 s
:= RecentFiles
[(Sender
as TMenuItem
).Tag
];
2546 fn
:= g_ExtractWadName(s
);
2547 if FileExists(fn
) then
2548 OpenMap(fn
, g_ExtractFilePathName(s
))
2550 Application
.MessageBox('', 'File not available anymore', MB_OK
);
2551 // if Application.MessageBox(PChar(MsgMsgDelRecentPrompt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
2553 // RecentFiles.Delete(n);
2554 // RefreshRecentMenu();
2558 procedure TMainForm
.RefillRecentMenu (menu
: TMenuItem
; start
: Integer; fmt
: AnsiString);
2559 var i
: Integer; MI
: TMenuItem
; s
: AnsiString;
2561 Assert(menu
<> nil);
2563 Assert(start
<= menu
.Count
);
2565 // clear all the recent entries from menu
2567 while i
< menu
.Count
do
2569 MI
:= menu
.Items
[i
];
2570 if @MI
.OnClick
<> @TMainForm
.miRecentFileExecute
then
2579 // fill with a new ones
2580 for i
:= 0 to RecentFiles
.Count
-1 do
2582 MI
:= TMenuItem
.Create(menu
);
2583 s
:= RecentFiles
[i
];
2584 MI
.Caption
:= Format(fmt
, [i
+1, g_ExtractWadNameNoPath(s
), g_ExtractFilePathName(s
)]);
2585 MI
.OnClick
:= miRecentFileExecute
;
2587 menu
.Insert(start
+ i
, MI
); // transfers ownership
2591 procedure TMainForm
.RefreshRecentMenu();
2594 while RecentFiles
.Count
> RecentCount
do
2595 RecentFiles
.Delete(RecentFiles
.Count
- 1);
2597 if miMacRecentSubMenu
.Visible
then
2599 // Reconstruct OSX-like recent list
2600 RefillRecentMenu(miMacRecentSubMenu
, 0, '%1:s - %2:s');
2601 miMacRecentEnd
.Enabled
:= RecentFiles
.Count
<> 0;
2602 miMacRecentEnd
.Visible
:= RecentFiles
.Count
<> 0;
2605 if miWinRecentStart
.Visible
then
2607 // Reconstruct Windows-like recent list
2608 start
:= miMenuFile
.IndexOf(miWinRecent
);
2609 if start
< 0 then start
:= miMenuFile
.Count
else start
+= 1;
2610 RefillRecentMenu(miMenuFile
, start
, '%0:d %1:s:%2:s');
2611 miWinRecent
.Enabled
:= False;
2612 miWinRecent
.Visible
:= RecentFiles
.Count
= 0;
2616 procedure TMainForm
.miMacRecentClearClick(Sender
: TObject
);
2618 RecentFiles
.Clear();
2619 RefreshRecentMenu();
2622 procedure TMainForm
.aEditorOptionsExecute(Sender
: TObject
);
2624 OptionsForm
.ShowModal();
2627 procedure LoadStdFont(cfgres
, texture
: string; var FontID
: DWORD
);
2641 wad
:= TWADEditor_1
.Create
;
2642 if wad
.ReadFile(GameWad
) then
2643 wad
.GetResource('FONTS', cfgres
, cfgdata
, cfglen
);
2648 if not g_CreateTextureWAD('FONT_STD', GameWad
+ ':FONTS\' + texture
) then
2649 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING
);
2651 config
:= TConfig
.CreateMem(cfgdata
, cfglen
);
2652 cwdt
:= Min(Max(config
.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2653 chgt
:= Min(Max(config
.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2654 spc
:= Min(Max(config
.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2656 if g_GetTexture('FONT_STD', ID
) then
2657 e_TextureFontBuild(ID
, FontID
, cwdt
, chgt
, spc
-2);
2662 e_WriteLog('Could not load FONT_STD', MSG_WARNING
);
2664 if cfglen
<> 0 then FreeMem(cfgdata
);
2667 procedure TMainForm
.FormCreate(Sender
: TObject
);
2676 miApple
.Enabled
:= True;
2677 miApple
.Visible
:= True;
2678 miMacRecentSubMenu
.Enabled
:= True;
2679 miMacRecentSubMenu
.Visible
:= True;
2680 miWinRecentStart
.Enabled
:= False;
2681 miWinRecentStart
.Visible
:= False;
2682 miWinRecent
.Enabled
:= False;
2683 miWinRecent
.Visible
:= False;
2684 miLine2
.Enabled
:= False;
2685 miLine2
.Visible
:= False;
2686 miExit
.Enabled
:= False;
2687 miExit
.Visible
:= False;
2688 miOptions
.Enabled
:= False;
2689 miOptions
.Visible
:= False;
2690 miMenuWindow
.Enabled
:= True;
2691 miMenuWindow
.Visible
:= True;
2692 miAbout
.Enabled
:= False;
2693 miAbout
.Visible
:= False;
2695 miApple
.Enabled
:= False;
2696 miApple
.Visible
:= False;
2697 miMacRecentSubMenu
.Enabled
:= False;
2698 miMacRecentSubMenu
.Visible
:= False;
2699 miWinRecentStart
.Enabled
:= True;
2700 miWinRecentStart
.Visible
:= True;
2701 miWinRecent
.Enabled
:= True;
2702 miWinRecent
.Visible
:= True;
2703 miLine2
.Enabled
:= True;
2704 miLine2
.Visible
:= True;
2705 miExit
.Enabled
:= True;
2706 miExit
.Visible
:= True;
2707 miOptions
.Enabled
:= True;
2708 miOptions
.Visible
:= True;
2709 miMenuWindow
.Enabled
:= False;
2710 miMenuWindow
.Visible
:= False;
2711 miAbout
.Enabled
:= True;
2712 miAbout
.Visible
:= True;
2715 miNewMap
.ShortCut
:= ShortCut(VK_N
, [ssModifier
]);
2716 miOpenMap
.ShortCut
:= ShortCut(VK_O
, [ssModifier
]);
2717 miSaveMap
.ShortCut
:= ShortCut(VK_S
, [ssModifier
]);
2719 miSaveMapAs
.ShortCut
:= ShortCut(VK_S
, [ssModifier
, ssShift
]);
2720 miReopenMap
.ShortCut
:= ShortCut(VK_F5
, [ssModifier
]);
2722 miUndo
.ShortCut
:= ShortCut(VK_Z
, [ssModifier
]);
2723 miCopy
.ShortCut
:= ShortCut(VK_C
, [ssModifier
]);
2724 miCut
.ShortCut
:= ShortCut(VK_X
, [ssModifier
]);
2725 miPaste
.ShortCut
:= ShortCut(VK_V
, [ssModifier
]);
2726 miSelectAll
.ShortCut
:= ShortCut(VK_A
, [ssModifier
]);
2727 miToFore
.ShortCut
:= ShortCut(VK_LCL_CLOSE_BRACKET
, [ssModifier
]);
2728 miToBack
.ShortCut
:= ShortCut(VK_LCL_OPEN_BRACKET
, [ssModifier
]);
2730 miMapOptions
.Shortcut
:= ShortCut(VK_P
, [ssModifier
, ssAlt
]);
2731 selectall1
.Shortcut
:= ShortCut(VK_A
, [ssModifier
, ssAlt
]);
2734 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION
, MSG_NOTIFY
);
2735 e_WriteLog('Build date: ' + EDITOR_BUILDDATE
+ ' ' + EDITOR_BUILDTIME
, MSG_NOTIFY
);
2736 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY
);
2737 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY
);
2739 slInvalidTextures
:= TStringList
.Create
;
2741 ShowLayer(LAYER_BACK
, True);
2742 ShowLayer(LAYER_WALLS
, True);
2743 ShowLayer(LAYER_FOREGROUND
, True);
2744 ShowLayer(LAYER_STEPS
, True);
2745 ShowLayer(LAYER_WATER
, True);
2746 ShowLayer(LAYER_ITEMS
, True);
2747 ShowLayer(LAYER_MONSTERS
, True);
2748 ShowLayer(LAYER_AREAS
, True);
2749 ShowLayer(LAYER_TRIGGERS
, True);
2753 FormCaption
:= MainForm
.Caption
;
2757 config
:= TConfig
.CreateFile(CfgFileName
);
2759 if config
.ReadInt('Editor', 'XPos', -1) = -1 then
2760 Position
:= poDesktopCenter
2762 Left
:= config
.ReadInt('Editor', 'XPos', Left
);
2763 Top
:= config
.ReadInt('Editor', 'YPos', Top
);
2764 Width
:= config
.ReadInt('Editor', 'Width', Width
);
2765 Height
:= config
.ReadInt('Editor', 'Height', Height
);
2767 if config
.ReadBool('Editor', 'Maximize', False) then
2768 WindowState
:= wsMaximized
;
2769 ShowMap
:= config
.ReadBool('Editor', 'Minimap', False);
2770 PanelProps
.Width
:= config
.ReadInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
2771 Splitter1
.Left
:= PanelProps
.Left
;
2772 PanelObjs
.Height
:= config
.ReadInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
2773 Splitter2
.Top
:= PanelObjs
.Top
;
2774 StatusBar
.Top
:= PanelObjs
.BoundsRect
.Bottom
;
2775 DotEnable
:= config
.ReadBool('Editor', 'DotEnable', True);
2776 DotColor
:= config
.ReadInt('Editor', 'DotColor', $FFFFFF);
2777 DotStepOne
:= config
.ReadInt('Editor', 'DotStepOne', 16);
2778 DotStepTwo
:= config
.ReadInt('Editor', 'DotStepTwo', 8);
2779 DotStep
:= config
.ReadInt('Editor', 'DotStep', DotStepOne
);
2780 DrawTexturePanel
:= config
.ReadBool('Editor', 'DrawTexturePanel', True);
2781 DrawPanelSize
:= config
.ReadBool('Editor', 'DrawPanelSize', True);
2782 BackColor
:= config
.ReadInt('Editor', 'BackColor', $7F6040);
2783 PreviewColor
:= config
.ReadInt('Editor', 'PreviewColor', $00FF00);
2784 UseCheckerboard
:= config
.ReadBool('Editor', 'UseCheckerboard', True);
2785 gColorEdge
:= config
.ReadInt('Editor', 'EdgeColor', COLOR_EDGE
);
2786 gAlphaEdge
:= config
.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE
);
2787 if gAlphaEdge
= 255 then
2788 gAlphaEdge
:= ALPHA_EDGE
;
2789 drEdge
[0] := GetRValue(gColorEdge
);
2790 drEdge
[1] := GetGValue(gColorEdge
);
2791 drEdge
[2] := GetBValue(gColorEdge
);
2792 if not config
.ReadBool('Editor', 'EdgeShow', True) then
2795 drEdge
[3] := gAlphaEdge
;
2796 gAlphaTriggerLine
:= config
.ReadInt('Editor', 'LineAlpha', ALPHA_LINE
);
2797 if gAlphaTriggerLine
= 255 then
2798 gAlphaTriggerLine
:= ALPHA_LINE
;
2799 gAlphaTriggerArea
:= config
.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA
);
2800 if gAlphaTriggerArea
= 255 then
2801 gAlphaTriggerArea
:= ALPHA_AREA
;
2802 gAlphaMonsterRect
:= config
.ReadInt('Editor', 'MonsterRectAlpha', 0);
2803 gAlphaAreaRect
:= config
.ReadInt('Editor', 'AreaRectAlpha', 0);
2804 Scale
:= Max(config
.ReadInt('Editor', 'Scale', 1), 1);
2805 DotSize
:= Max(config
.ReadInt('Editor', 'DotSize', 1), 1);
2806 OpenDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastOpenDir', MapsDir
);
2807 SaveDialog
.InitialDir
:= config
.ReadStr('Editor', 'LastSaveDir', MapsDir
);
2809 s
:= config
.ReadStr('Editor', 'Language', '');
2812 TestGameMode
:= config
.ReadStr('TestRun', 'GameMode', 'DM');
2813 TestLimTime
:= config
.ReadStr('TestRun', 'LimTime', '0');
2814 TestLimScore
:= config
.ReadStr('TestRun', 'LimScore', '0');
2815 TestOptionsTwoPlayers
:= config
.ReadBool('TestRun', 'TwoPlayers', False);
2816 TestOptionsTeamDamage
:= config
.ReadBool('TestRun', 'TeamDamage', False);
2817 TestOptionsAllowExit
:= config
.ReadBool('TestRun', 'AllowExit', True);
2818 TestOptionsWeaponStay
:= config
.ReadBool('TestRun', 'WeaponStay', False);
2819 TestOptionsMonstersDM
:= config
.ReadBool('TestRun', 'MonstersDM', False);
2820 TestMapOnce
:= config
.ReadBool('TestRun', 'MapOnce', False);
2821 {$IF DEFINED(DARWIN)}
2822 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeDrawin', GameExeFile
);
2823 {$ELSEIF DEFINED(WINDOWS)}
2824 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeWindows', GameExeFile
);
2826 TestD2dExe
:= config
.ReadStr('TestRun', 'ExeUnix', GameExeFile
);
2828 TestD2DArgs
:= config
.ReadStr('TestRun', 'Args', '');
2830 RecentCount
:= config
.ReadInt('Editor', 'RecentCount', 5);
2831 if RecentCount
> 10 then
2833 if RecentCount
< 2 then
2836 RecentFiles
:= TStringList
.Create();
2837 for i
:= 0 to RecentCount
-1 do
2840 s
:= config
.ReadStr('RecentFilesWin', IntToStr(i
), '');
2842 s
:= config
.ReadStr('RecentFilesUnix', IntToStr(i
), '');
2847 RefreshRecentMenu();
2851 tbShowMap
.Down
:= ShowMap
;
2852 tbGridOn
.Down
:= DotEnable
;
2853 pcObjects
.ActivePageIndex
:= 0;
2854 Application
.Title
:= MsgEditorTitle
;
2856 Application
.OnIdle
:= OnIdle
;
2859 procedure PrintBlack(X
, Y
: Integer; Text: string; FontID
: DWORD
);
2861 // NOTE: all the font printing routines assume CP1251
2862 e_TextureFontPrintEx(X
, Y
, Text, FontID
, 0, 0, 0, 1.0);
2865 procedure TMainForm
.Draw();
2870 Width
, Height
: Word;
2873 aX
, aY
, aX2
, aY2
, XX
, ScaleSz
: Integer;
2882 e_Clear(GL_COLOR_BUFFER_BIT
,
2883 GetRValue(BackColor
)/255,
2884 GetGValue(BackColor
)/255,
2885 GetBValue(BackColor
)/255);
2889 ObjCount
:= SelectedObjectCount();
2891 // Обводим выделенные объекты красной рамкой:
2892 if ObjCount
> 0 then
2894 for a
:= 0 to High(SelectedObjects
) do
2895 if SelectedObjects
[a
].Live
then
2897 Rect
:= ObjectGetRect(SelectedObjects
[a
].ObjectType
, SelectedObjects
[a
].ID
);
2901 e_DrawQuad(X
+MapOffset
.X
, Y
+MapOffset
.Y
,
2902 X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+Height
-1,
2905 // Рисуем точки изменения размеров:
2906 if (ObjCount
= 1) and
2907 (SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) then
2909 e_DrawPoint(5, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2910 e_DrawPoint(5, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 255, 255);
2911 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 255, 255);
2912 e_DrawPoint(5, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 255, 255);
2914 e_DrawPoint(3, X
+MapOffset
.X
, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2915 e_DrawPoint(3, X
+MapOffset
.X
+Width
-1, Y
+MapOffset
.Y
+(Height
div 2), 255, 0, 0);
2916 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
, 255, 0, 0);
2917 e_DrawPoint(3, X
+MapOffset
.X
+(Width
div 2), Y
+MapOffset
.Y
+Height
-1, 255, 0, 0);
2924 if DotEnable
and (PreviewMode
= 0) then
2931 x
:= MapOffset
.X
mod DotStep
;
2932 y
:= MapOffset
.Y
mod DotStep
;
2934 while x
< RenderPanel
.Width
do
2936 while y
< RenderPanel
.Height
do
2938 e_DrawPoint(DotSize
, x
+ a
, y
+ a
,
2939 GetRValue(DotColor
),
2940 GetGValue(DotColor
),
2941 GetBValue(DotColor
));
2945 y
:= MapOffset
.Y
mod DotStep
;
2950 if (lbTextureList
.ItemIndex
<> -1) and (cbPreview
.Checked
) and
2951 (not IsSpecialTextureSel()) and (PreviewMode
= 0) then
2953 if not g_GetTexture(SelectedTexture(), ID
) then
2954 g_GetTexture('NOTEXTURE', ID
);
2955 g_GetTextureSizeByID(ID
, Width
, Height
);
2956 if UseCheckerboard
then
2958 if g_GetTexture('PREVIEW', PID
) then
2959 e_DrawFill(PID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, Width
div 16 + 1, Height
div 16 + 1, 0, True, False);
2961 e_DrawFillQuad(RenderPanel
.Width
-Width
-2, RenderPanel
.Height
-Height
-2,
2962 RenderPanel
.Width
-1, RenderPanel
.Height
-1,
2963 GetRValue(PreviewColor
), GetGValue(PreviewColor
), GetBValue(PreviewColor
), 0);
2964 e_Draw(ID
, RenderPanel
.Width
-Width
, RenderPanel
.Height
-Height
, 0, True, False);
2967 // Подсказка при выборе точки Телепорта:
2968 if SelectFlag
= SELECTFLAG_TELEPORT
then
2970 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
2971 if Data
.d2d_teleport
then
2972 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2973 MousePos
.X
+16, MousePos
.Y
-1,
2976 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+AreaSize
[AREA_DMPOINT
].Width
-1,
2977 MousePos
.Y
+AreaSize
[AREA_DMPOINT
].Height
-1, 255, 255, 255);
2979 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2980 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2981 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintTeleport
), gEditorFont
);
2984 // Подсказка при выборе точки появления:
2985 if SelectFlag
= SELECTFLAG_SPAWNPOINT
then
2987 e_DrawLine(2, MousePos
.X
-16, MousePos
.Y
-1,
2988 MousePos
.X
+16, MousePos
.Y
-1,
2990 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2991 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
2992 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintSpawn
), gEditorFont
);
2995 // Подсказка при выборе панели двери:
2996 if SelectFlag
= SELECTFLAG_DOOR
then
2998 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
2999 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3000 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelDoor
), gEditorFont
);
3003 // Подсказка при выборе панели с текстурой:
3004 if SelectFlag
= SELECTFLAG_TEXTURE
then
3006 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 192, 192, 192, 127);
3007 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+196, MousePos
.Y
+18, 255, 255, 255);
3008 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelTexture
), gEditorFont
);
3011 // Подсказка при выборе панели индикации выстрела:
3012 if SelectFlag
= SELECTFLAG_SHOTPANEL
then
3014 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 192, 192, 192, 127);
3015 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+316, MousePos
.Y
+18, 255, 255, 255);
3016 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelShot
), gEditorFont
);
3019 // Подсказка при выборе панели лифта:
3020 if SelectFlag
= SELECTFLAG_LIFT
then
3022 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 192, 192, 192, 127);
3023 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+180, MousePos
.Y
+18, 255, 255, 255);
3024 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintPanelLift
), gEditorFont
);
3027 // Подсказка при выборе монстра:
3028 if SelectFlag
= SELECTFLAG_MONSTER
then
3030 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 192, 192, 192, 127);
3031 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+120, MousePos
.Y
+18, 255, 255, 255);
3032 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintMonster
), gEditorFont
);
3035 // Подсказка при выборе области воздействия:
3036 if DrawPressRect
then
3038 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 192, 192, 192, 127);
3039 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+204, MousePos
.Y
+18, 255, 255, 255);
3040 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, utf8to1251(MsgHintExtArea
), gEditorFont
);
3043 // Рисуем текстуры, если чертим панель:
3044 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and (DrawTexturePanel
) and
3045 (lbTextureList
.ItemIndex
<> -1) and (DrawRect
<> nil) and
3046 (lbPanelType
.ItemIndex
in [0..8]) and not IsSpecialTextureSel() then
3048 if not g_GetTexture(SelectedTexture(), ID
) then
3049 g_GetTexture('NOTEXTURE', ID
);
3050 g_GetTextureSizeByID(ID
, Width
, Height
);
3052 if (Abs(Right
-Left
) >= Width
) and (Abs(Bottom
-Top
) >= Height
) then
3053 e_DrawFill(ID
, Min(Left
, Right
), Min(Top
, Bottom
), Abs(Right
-Left
) div Width
,
3054 Abs(Bottom
-Top
) div Height
, 64, True, False);
3057 // Прямоугольник выделения:
3058 if DrawRect
<> nil then
3060 e_DrawQuad(Left
, Top
, Right
-1, Bottom
-1, 255, 255, 255);
3062 // Чертим мышью панель/триггер или меняем мышью их размер:
3063 if (((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3064 not(ssCtrl
in GetKeyShiftState())) or (MouseAction
= MOUSEACTION_RESIZE
)) and
3065 (DrawPanelSize
) then
3067 e_DrawFillQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 192, 192, 192, 127);
3068 e_DrawQuad(MousePos
.X
, MousePos
.Y
, MousePos
.X
+88, MousePos
.Y
+33, 255, 255, 255);
3070 if MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
] then
3071 begin // Чертим новый
3072 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
),
3073 [Abs(MousePos
.X
-MouseLDownPos
.X
)]), gEditorFont
);
3074 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
),
3075 [Abs(MousePos
.Y
-MouseLDownPos
.Y
)]), gEditorFont
);
3077 else // Растягиваем существующий
3078 if SelectedObjects
[GetFirstSelected
].ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
] then
3080 if SelectedObjects
[GetFirstSelected
].ObjectType
= OBJECT_PANEL
then
3082 Width
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3083 Height
:= gPanels
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3087 Width
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Width
;
3088 Height
:= gTriggers
[SelectedObjects
[GetFirstSelected
].ID
].Height
;
3091 PrintBlack(MousePos
.X
+2, MousePos
.Y
+2, Format(utf8to1251(MsgHintWidth
), [Width
]),
3093 PrintBlack(MousePos
.X
+2, MousePos
.Y
+16, Format(utf8to1251(MsgHintHeight
), [Height
]),
3098 // Ближайшая к курсору мыши точка на сетке:
3099 e_DrawPoint(3, MousePos
.X
, MousePos
.Y
, 0, 0, 255);
3104 // Сколько пикселов карты в 1 пикселе мини-карты:
3105 ScaleSz
:= 16 div Scale
;
3106 // Размеры мини-карты:
3107 aX
:= max(gMapInfo
.Width
div ScaleSz
, 1);
3108 aY
:= max(gMapInfo
.Height
div ScaleSz
, 1);
3109 // X-координата на RenderPanel нулевой x-координаты карты:
3110 XX
:= RenderPanel
.Width
- aX
- 1;
3112 e_DrawFillQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 0, 0, 0, 0);
3113 e_DrawQuad(XX
-1, 0, RenderPanel
.Width
-1, aY
+1, 197, 197, 197);
3115 if gPanels
<> nil then
3118 for a
:= 0 to High(gPanels
) do
3120 if PanelType
<> 0 then
3122 // Левый верхний угол:
3123 aX
:= XX
+ (X
div ScaleSz
);
3124 aY
:= 1 + (Y
div ScaleSz
);
3126 aX2
:= max(Width
div ScaleSz
, 1);
3127 aY2
:= max(Height
div ScaleSz
, 1);
3128 // Правый нижний угол:
3129 aX2
:= aX
+ aX2
- 1;
3130 aY2
:= aY
+ aY2
- 1;
3133 PANEL_WALL
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 208, 208, 208, 0);
3134 PANEL_WATER
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 0, 192, 0);
3135 PANEL_ACID1
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 0, 176, 0, 0);
3136 PANEL_ACID2
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 176, 0, 0, 0);
3137 PANEL_STEP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 128, 128, 128, 0);
3138 PANEL_LIFTUP
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 72, 36, 0);
3139 PANEL_LIFTDOWN
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 116, 124, 96, 0);
3140 PANEL_LIFTLEFT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 200, 80, 4, 0);
3141 PANEL_LIFTRIGHT
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 252, 140, 56, 0);
3142 PANEL_OPENDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 100, 220, 92, 0);
3143 PANEL_CLOSEDOOR
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 212, 184, 64, 0);
3144 PANEL_BLOCKMON
: e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 192, 0, 192, 0);
3148 // Рисуем красным выделенные панели:
3149 if SelectedObjects
<> nil then
3150 for b
:= 0 to High(SelectedObjects
) do
3151 with SelectedObjects
[b
] do
3152 if Live
and (ObjectType
= OBJECT_PANEL
) then
3153 with gPanels
[SelectedObjects
[b
].ID
] do
3154 if PanelType
and not(PANEL_BACK
or PANEL_FORE
) <> 0 then
3156 // Левый верхний угол:
3157 aX
:= XX
+ (X
div ScaleSz
);
3158 aY
:= 1 + (Y
div ScaleSz
);
3160 aX2
:= max(Width
div ScaleSz
, 1);
3161 aY2
:= max(Height
div ScaleSz
, 1);
3162 // Правый нижний угол:
3163 aX2
:= aX
+ aX2
- 1;
3164 aY2
:= aY
+ aY2
- 1;
3166 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0, 0)
3170 if (gMapInfo
.Width
> RenderPanel
.Width
) or
3171 (gMapInfo
.Height
> RenderPanel
.Height
) then
3173 // Окно, показывающее текущее положение экрана на карте:
3175 x
:= max(min(RenderPanel
.Width
, gMapInfo
.Width
) div ScaleSz
, 1);
3176 y
:= max(min(RenderPanel
.Height
, gMapInfo
.Height
) div ScaleSz
, 1);
3177 // Левый верхний угол:
3178 aX
:= XX
+ ((-MapOffset
.X
) div ScaleSz
);
3179 aY
:= 1 + ((-MapOffset
.Y
) div ScaleSz
);
3180 // Правый нижний угол:
3184 e_DrawFillQuad(aX
, aY
, aX2
, aY2
, 127, 192, 127, 127, B_BLEND
);
3185 e_DrawQuad(aX
, aY
, aX2
, aY2
, 255, 0, 0);
3190 RenderPanel
.SwapBuffers();
3193 procedure TMainForm
.FormResize(Sender
: TObject
);
3195 e_SetViewPort(0, 0, RenderPanel
.Width
, RenderPanel
.Height
);
3197 sbHorizontal
.Min
:= Min(gMapInfo
.Width
- RenderPanel
.Width
, -RenderPanel
.Width
div 2);
3198 sbHorizontal
.Max
:= Max(0, gMapInfo
.Width
- RenderPanel
.Width
div 2);
3199 sbVertical
.Min
:= Min(gMapInfo
.Height
- RenderPanel
.Height
, -RenderPanel
.Height
div 2);
3200 sbVertical
.Max
:= Max(0, gMapInfo
.Height
- RenderPanel
.Height
div 2);
3202 MapOffset
.X
:= -sbHorizontal
.Position
;
3203 MapOffset
.Y
:= -sbVertical
.Position
;
3206 procedure TMainForm
.FormWindowStateChange(Sender
: TObject
);
3212 // deactivate all menus when main window minimized
3213 e
:= self
.WindowState
<> wsMinimized
;
3214 miMenuFile
.Enabled
:= e
;
3215 miMenuEdit
.Enabled
:= e
;
3216 miMenuView
.Enabled
:= e
;
3217 miMenuService
.Enabled
:= e
;
3218 miMenuWindow
.Enabled
:= e
;
3219 miMenuHelp
.Enabled
:= e
;
3220 miMenuHidden
.Enabled
:= e
;
3224 procedure SelectNextObject(X
, Y
: Integer; ObjectType
: Byte; ID
: DWORD
);
3229 j_max
:= 0; // shut up compiler
3233 res
:= (gPanels
<> nil) and
3234 PanelInShownLayer(gPanels
[ID
].PanelType
) and
3235 g_CollidePoint(X
, Y
, gPanels
[ID
].X
, gPanels
[ID
].Y
,
3237 gPanels
[ID
].Height
);
3238 j_max
:= Length(gPanels
) - 1;
3243 res
:= (gItems
<> nil) and
3244 LayerEnabled
[LAYER_ITEMS
] and
3245 g_CollidePoint(X
, Y
, gItems
[ID
].X
, gItems
[ID
].Y
,
3246 ItemSize
[gItems
[ID
].ItemType
][0],
3247 ItemSize
[gItems
[ID
].ItemType
][1]);
3248 j_max
:= Length(gItems
) - 1;
3253 res
:= (gMonsters
<> nil) and
3254 LayerEnabled
[LAYER_MONSTERS
] and
3255 g_CollidePoint(X
, Y
, gMonsters
[ID
].X
, gMonsters
[ID
].Y
,
3256 MonsterSize
[gMonsters
[ID
].MonsterType
].Width
,
3257 MonsterSize
[gMonsters
[ID
].MonsterType
].Height
);
3258 j_max
:= Length(gMonsters
) - 1;
3263 res
:= (gAreas
<> nil) and
3264 LayerEnabled
[LAYER_AREAS
] and
3265 g_CollidePoint(X
, Y
, gAreas
[ID
].X
, gAreas
[ID
].Y
,
3266 AreaSize
[gAreas
[ID
].AreaType
].Width
,
3267 AreaSize
[gAreas
[ID
].AreaType
].Height
);
3268 j_max
:= Length(gAreas
) - 1;
3273 res
:= (gTriggers
<> nil) and
3274 LayerEnabled
[LAYER_TRIGGERS
] and
3275 g_CollidePoint(X
, Y
, gTriggers
[ID
].X
, gTriggers
[ID
].Y
,
3276 gTriggers
[ID
].Width
,
3277 gTriggers
[ID
].Height
);
3278 j_max
:= Length(gTriggers
) - 1;
3288 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3297 if j
= Integer(ID
) then
3302 res
:= PanelInShownLayer(gPanels
[j
].PanelType
) and
3303 g_CollidePoint(X
, Y
, gPanels
[j
].X
, gPanels
[j
].Y
,
3307 res
:= (gItems
[j
].ItemType
<> ITEM_NONE
) and
3308 g_CollidePoint(X
, Y
, gItems
[j
].X
, gItems
[j
].Y
,
3309 ItemSize
[gItems
[j
].ItemType
][0],
3310 ItemSize
[gItems
[j
].ItemType
][1]);
3312 res
:= (gMonsters
[j
].MonsterType
<> MONSTER_NONE
) and
3313 g_CollidePoint(X
, Y
, gMonsters
[j
].X
, gMonsters
[j
].Y
,
3314 MonsterSize
[gMonsters
[j
].MonsterType
].Width
,
3315 MonsterSize
[gMonsters
[j
].MonsterType
].Height
);
3317 res
:= (gAreas
[j
].AreaType
<> AREA_NONE
) and
3318 g_CollidePoint(X
, Y
, gAreas
[j
].X
, gAreas
[j
].Y
,
3319 AreaSize
[gAreas
[j
].AreaType
].Width
,
3320 AreaSize
[gAreas
[j
].AreaType
].Height
);
3322 res
:= (gTriggers
[j
].TriggerType
<> TRIGGER_NONE
) and
3323 g_CollidePoint(X
, Y
, gTriggers
[j
].X
, gTriggers
[j
].Y
,
3325 gTriggers
[j
].Height
);
3332 SetLength(SelectedObjects
, 1);
3334 SelectedObjects
[0].ObjectType
:= ObjectType
;
3335 SelectedObjects
[0].ID
:= j
;
3336 SelectedObjects
[0].Live
:= True;
3344 procedure TMainForm
.RenderPanelMouseDown(Sender
: TObject
;
3345 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3349 c1
, c2
, c3
, c4
: Boolean;
3355 MainForm
.ActiveControl
:= RenderPanel
;
3356 RenderPanel
.SetFocus();
3358 RenderPanelMouseMove(RenderPanel
, Shift
, X
, Y
);
3360 if Button
= mbLeft
then // Left Mouse Button
3362 // Двигаем карту с помощью мыши и мини-карты:
3364 g_CollidePoint(X
, Y
,
3365 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3367 max(gMapInfo
.Width
div (16 div Scale
), 1),
3368 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3371 MouseAction
:= MOUSEACTION_MOVEMAP
;
3373 else // Ставим предмет/монстра/область:
3374 if (pcObjects
.ActivePageIndex
in [1, 2, 3]) and
3375 (not (ssShift
in Shift
)) then
3377 case pcObjects
.ActivePageIndex
of
3379 if lbItemList
.ItemIndex
= -1 then
3380 ErrorMessageBox(MsgMsgChooseItem
)
3383 item
.ItemType
:= lbItemList
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
3384 if item
.ItemType
>= ITEM_WEAPON_KASTET
then
3385 item
.ItemType
:= item
.ItemType
+ 2;
3386 item
.X
:= MousePos
.X
-MapOffset
.X
;
3387 item
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3389 if not (ssCtrl
in Shift
) then
3391 item
.X
:= item
.X
- (ItemSize
[item
.ItemType
][0] div 2);
3392 item
.Y
:= item
.Y
- ItemSize
[item
.ItemType
][1];
3395 item
.OnlyDM
:= cbOnlyDM
.Checked
;
3396 item
.Fall
:= cbFall
.Checked
;
3397 Undo_Add(OBJECT_ITEM
, AddItem(item
));
3400 if lbMonsterList
.ItemIndex
= -1 then
3401 ErrorMessageBox(MsgMsgChooseMonster
)
3404 monster
.MonsterType
:= lbMonsterList
.ItemIndex
+ MONSTER_DEMON
;
3405 monster
.X
:= MousePos
.X
-MapOffset
.X
;
3406 monster
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3408 if not (ssCtrl
in Shift
) then
3410 monster
.X
:= monster
.X
- (MonsterSize
[monster
.MonsterType
].Width
div 2);
3411 monster
.Y
:= monster
.Y
- MonsterSize
[monster
.MonsterType
].Height
;
3414 if rbMonsterLeft
.Checked
then
3415 monster
.Direction
:= D_LEFT
3417 monster
.Direction
:= D_RIGHT
;
3418 Undo_Add(OBJECT_MONSTER
, AddMonster(monster
));
3421 if lbAreasList
.ItemIndex
= -1 then
3422 ErrorMessageBox(MsgMsgChooseArea
)
3424 if (lbAreasList
.ItemIndex
+ 1) <> AREA_DOMFLAG
then
3426 area
.AreaType
:= lbAreasList
.ItemIndex
+ AREA_PLAYERPOINT1
;
3427 area
.X
:= MousePos
.X
-MapOffset
.X
;
3428 area
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3430 if not (ssCtrl
in Shift
) then
3432 area
.X
:= area
.X
- (AreaSize
[area
.AreaType
].Width
div 2);
3433 area
.Y
:= area
.Y
- AreaSize
[area
.AreaType
].Height
;
3436 if rbAreaLeft
.Checked
then
3437 area
.Direction
:= D_LEFT
3439 area
.Direction
:= D_RIGHT
;
3440 Undo_Add(OBJECT_AREA
, AddArea(area
));
3446 i
:= GetFirstSelected();
3448 // Выбираем объект под текущим:
3449 if (SelectedObjects
<> nil) and
3450 (ssShift
in Shift
) and (i
>= 0) and
3451 (SelectedObjects
[i
].Live
) then
3453 if SelectedObjectCount() = 1 then
3454 SelectNextObject(X
-MapOffset
.X
, Y
-MapOffset
.Y
,
3455 SelectedObjects
[i
].ObjectType
,
3456 SelectedObjects
[i
].ID
);
3460 // Рисуем область триггера "Расширитель":
3461 if DrawPressRect
and (i
>= 0) and
3462 (SelectedObjects
[i
].ObjectType
= OBJECT_TRIGGER
) and
3463 (gTriggers
[SelectedObjects
[i
].ID
].TriggerType
in
3464 [TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
]) then
3465 MouseAction
:= MOUSEACTION_DRAWPRESS
3466 else // Рисуем панель:
3467 if pcObjects
.ActivePageIndex
= 0 then
3469 if (lbPanelType
.ItemIndex
>= 0) then
3470 MouseAction
:= MOUSEACTION_DRAWPANEL
3472 else // Рисуем триггер:
3473 if (lbTriggersList
.ItemIndex
>= 0) then
3475 MouseAction
:= MOUSEACTION_DRAWTRIGGER
;
3479 end; // if Button = mbLeft
3481 if Button
= mbRight
then // Right Mouse Button
3483 // Клик по мини-карте:
3485 g_CollidePoint(X
, Y
,
3486 RenderPanel
.Width
-max(gMapInfo
.Width
div (16 div Scale
), 1)-1,
3488 max(gMapInfo
.Width
div (16 div Scale
), 1),
3489 max(gMapInfo
.Height
div (16 div Scale
), 1) ) then
3491 MouseAction
:= MOUSEACTION_NOACTION
;
3493 else // Нужно что-то выбрать мышью:
3494 if SelectFlag
<> SELECTFLAG_NONE
then
3497 SELECTFLAG_TELEPORT
:
3498 // Точку назначения телепортации:
3499 with gTriggers
[SelectedObjects
[
3500 GetFirstSelected() ].ID
].Data
.TargetPoint
do
3502 X
:= MousePos
.X
-MapOffset
.X
;
3503 Y
:= MousePos
.Y
-MapOffset
.Y
;
3506 SELECTFLAG_SPAWNPOINT
:
3507 // Точку создания монстра:
3508 with gTriggers
[SelectedObjects
[GetFirstSelected()].ID
] do
3509 if TriggerType
= TRIGGER_SPAWNMONSTER
then
3511 Data
.MonPos
.X
:= MousePos
.X
-MapOffset
.X
;
3512 Data
.MonPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3514 else if TriggerType
= TRIGGER_SPAWNITEM
then
3515 begin // Точка создания предмета:
3516 Data
.ItemPos
.X
:= MousePos
.X
-MapOffset
.X
;
3517 Data
.ItemPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3519 else if TriggerType
= TRIGGER_SHOT
then
3520 begin // Точка создания выстрела:
3521 Data
.ShotPos
.X
:= MousePos
.X
-MapOffset
.X
;
3522 Data
.ShotPos
.Y
:= MousePos
.Y
-MapOffset
.Y
;
3528 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3530 2, 2, OBJECT_PANEL
, True);
3531 if IDArray
<> nil then
3533 for i
:= 0 to High(IDArray
) do
3534 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3535 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
) then
3537 gTriggers
[SelectedObjects
[
3538 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3543 gTriggers
[SelectedObjects
[
3544 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3548 // Панель с текстурой:
3550 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3552 2, 2, OBJECT_PANEL
, True);
3553 if IDArray
<> nil then
3555 for i
:= 0 to High(IDArray
) do
3556 if ((gPanels
[IDArray
[i
]].PanelType
in
3557 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3558 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3560 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3561 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3562 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3564 gTriggers
[SelectedObjects
[
3565 GetFirstSelected() ].ID
].TexturePanel
:= IDArray
[i
];
3570 gTriggers
[SelectedObjects
[
3571 GetFirstSelected() ].ID
].TexturePanel
:= -1;
3577 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3579 2, 2, OBJECT_PANEL
, True);
3580 if IDArray
<> nil then
3582 for i
:= 0 to High(IDArray
) do
3583 if (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTUP
) or
3584 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTDOWN
) or
3585 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTLEFT
) or
3586 (gPanels
[IDArray
[i
]].PanelType
= PANEL_LIFTRIGHT
) then
3588 gTriggers
[SelectedObjects
[
3589 GetFirstSelected() ].ID
].Data
.PanelID
:= IDArray
[i
];
3594 gTriggers
[SelectedObjects
[
3595 GetFirstSelected() ].ID
].Data
.PanelID
:= -1;
3601 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3603 2, 2, OBJECT_MONSTER
, False);
3604 if IDArray
<> nil then
3605 gTriggers
[SelectedObjects
[
3606 GetFirstSelected() ].ID
].Data
.MonsterID
:= IDArray
[0]+1
3608 gTriggers
[SelectedObjects
[
3609 GetFirstSelected() ].ID
].Data
.MonsterID
:= 0;
3612 SELECTFLAG_SHOTPANEL
:
3613 // Панель индикации выстрела:
3615 if gTriggers
[SelectedObjects
[
3616 GetFirstSelected() ].ID
].TriggerType
= TRIGGER_SHOT
then
3618 IDArray
:= ObjectInRect(X
-MapOffset
.X
,
3620 2, 2, OBJECT_PANEL
, True);
3621 if IDArray
<> nil then
3623 for i
:= 0 to High(IDArray
) do
3624 if ((gPanels
[IDArray
[i
]].PanelType
in
3625 [PANEL_WALL
, PANEL_BACK
, PANEL_FORE
,
3626 PANEL_WATER
, PANEL_ACID1
, PANEL_ACID2
,
3628 (gPanels
[IDArray
[i
]].PanelType
= PANEL_OPENDOOR
) or
3629 (gPanels
[IDArray
[i
]].PanelType
= PANEL_CLOSEDOOR
)) and
3630 (gPanels
[IDArray
[i
]].TextureName
<> '') then
3632 gTriggers
[SelectedObjects
[
3633 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= IDArray
[i
];
3638 gTriggers
[SelectedObjects
[
3639 GetFirstSelected() ].ID
].Data
.ShotPanelID
:= -1;
3644 SelectFlag
:= SELECTFLAG_SELECTED
;
3646 else // if SelectFlag <> SELECTFLAG_NONE...
3648 // Что уже выбрано и не нажат Ctrl:
3649 if (SelectedObjects
<> nil) and
3650 (not (ssCtrl
in Shift
)) then
3651 for i
:= 0 to High(SelectedObjects
) do
3652 with SelectedObjects
[i
] do
3655 if (ObjectType
in [OBJECT_PANEL
, OBJECT_TRIGGER
]) and
3656 (SelectedObjectCount() = 1) then
3658 Rect
:= ObjectGetRect(ObjectType
, ID
);
3660 c1
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3661 Rect
.X
-2, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3662 c2
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3663 Rect
.X
+Rect
.Width
-3, Rect
.Y
+(Rect
.Height
div 2)-2, 4, 4);
3664 c3
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3665 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
-2, 4, 4);
3666 c4
:= g_Collide(X
-MapOffset
.X
-1, Y
-MapOffset
.Y
-1, 2, 2,
3667 Rect
.X
+(Rect
.Width
div 2)-2, Rect
.Y
+Rect
.Height
-3, 4, 4);
3669 // Меняем размер панели или триггера:
3670 if c1
or c2
or c3
or c4
then
3672 MouseAction
:= MOUSEACTION_RESIZE
;
3673 LastMovePoint
:= MousePos
;
3677 ResizeType
:= RESIZETYPE_HORIZONTAL
;
3679 ResizeDirection
:= RESIZEDIR_LEFT
3681 ResizeDirection
:= RESIZEDIR_RIGHT
;
3682 RenderPanel
.Cursor
:= crSizeWE
;
3686 ResizeType
:= RESIZETYPE_VERTICAL
;
3688 ResizeDirection
:= RESIZEDIR_UP
3690 ResizeDirection
:= RESIZEDIR_DOWN
;
3691 RenderPanel
.Cursor
:= crSizeNS
;
3698 // Перемещаем панель или триггер:
3699 if ObjectCollide(ObjectType
, ID
,
3701 Y
-MapOffset
.Y
-1, 2, 2) then
3703 MouseAction
:= MOUSEACTION_MOVEOBJ
;
3704 LastMovePoint
:= MousePos
;
3710 end; // if Button = mbRight
3712 if Button
= mbMiddle
then // Middle Mouse Button
3714 SetCapture(RenderPanel
.Handle
);
3715 RenderPanel
.Cursor
:= crSize
;
3718 MouseMDown
:= Button
= mbMiddle
;
3720 MouseMDownPos
:= Mouse
.CursorPos
;
3722 MouseRDown
:= Button
= mbRight
;
3724 MouseRDownPos
:= MousePos
;
3726 MouseLDown
:= Button
= mbLeft
;
3728 MouseLDownPos
:= MousePos
;
3731 procedure TMainForm
.RenderPanelMouseUp(Sender
: TObject
;
3732 Button
: TMouseButton
; Shift
: TShiftState
; X
, Y
: Integer);
3737 rSelectRect
: Boolean;
3738 wWidth
, wHeight
: Word;
3741 procedure SelectObjects(ObjectType
: Byte);
3746 IDArray
:= ObjectInRect(rRect
.X
, rRect
.Y
,
3747 rRect
.Width
, rRect
.Height
,
3748 ObjectType
, rSelectRect
);
3750 if IDArray
<> nil then
3751 for i
:= 0 to High(IDArray
) do
3752 SelectObject(ObjectType
, IDArray
[i
], (ssCtrl
in Shift
) or rSelectRect
);
3755 if Button
= mbLeft
then
3756 MouseLDown
:= False;
3757 if Button
= mbRight
then
3758 MouseRDown
:= False;
3759 if Button
= mbMiddle
then
3760 MouseMDown
:= False;
3763 ResizeType
:= RESIZETYPE_NONE
;
3766 if Button
= mbLeft
then // Left Mouse Button
3768 if MouseAction
<> MOUSEACTION_NONE
then
3769 begin // Было действие мышью
3770 // Мышь сдвинулась во время удержания клавиши,
3771 // либо активирован режим быстрого рисования:
3772 if ((MousePos
.X
<> MouseLDownPos
.X
) and
3773 (MousePos
.Y
<> MouseLDownPos
.Y
)) or
3774 ((MouseAction
in [MOUSEACTION_DRAWPANEL
, MOUSEACTION_DRAWTRIGGER
]) and
3775 (ssCtrl
in Shift
)) then
3778 MOUSEACTION_DRAWPANEL
:
3780 // Фон или передний план без текстуры - ошибка:
3781 if (lbPanelType
.ItemIndex
in [1, 2]) and
3782 (lbTextureList
.ItemIndex
= -1) then
3783 ErrorMessageBox(MsgMsgChooseTexture
)
3784 else // Назначаем параметры панели:
3786 case lbPanelType
.ItemIndex
of
3787 0: Panel
.PanelType
:= PANEL_WALL
;
3788 1: Panel
.PanelType
:= PANEL_BACK
;
3789 2: Panel
.PanelType
:= PANEL_FORE
;
3790 3: Panel
.PanelType
:= PANEL_OPENDOOR
;
3791 4: Panel
.PanelType
:= PANEL_CLOSEDOOR
;
3792 5: Panel
.PanelType
:= PANEL_STEP
;
3793 6: Panel
.PanelType
:= PANEL_WATER
;
3794 7: Panel
.PanelType
:= PANEL_ACID1
;
3795 8: Panel
.PanelType
:= PANEL_ACID2
;
3796 9: Panel
.PanelType
:= PANEL_LIFTUP
;
3797 10: Panel
.PanelType
:= PANEL_LIFTDOWN
;
3798 11: Panel
.PanelType
:= PANEL_LIFTLEFT
;
3799 12: Panel
.PanelType
:= PANEL_LIFTRIGHT
;
3800 13: Panel
.PanelType
:= PANEL_BLOCKMON
;
3803 Panel
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3804 Panel
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3805 if ssCtrl
in Shift
then
3809 if (lbTextureList
.ItemIndex
<> -1) and
3810 (not IsSpecialTextureSel()) then
3812 if not g_GetTexture(SelectedTexture(), TextureID
) then
3813 g_GetTexture('NOTEXTURE', TextureID
);
3814 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
3816 Panel
.Width
:= wWidth
;
3817 Panel
.Height
:= wHeight
;
3821 Panel
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3822 Panel
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3825 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3826 if (lbPanelType
.ItemIndex
in [9, 10, 11, 12, 13]) or
3827 (lbTextureList
.ItemIndex
= -1) then
3829 Panel
.TextureHeight
:= 1;
3830 Panel
.TextureWidth
:= 1;
3831 Panel
.TextureName
:= '';
3832 Panel
.TextureID
:= TEXTURE_SPECIAL_NONE
;
3834 else // Есть текстура:
3836 Panel
.TextureName
:= SelectedTexture();
3838 // Обычная текстура:
3839 if not IsSpecialTextureSel() then
3841 g_GetTextureSizeByName(Panel
.TextureName
,
3842 Panel
.TextureWidth
, Panel
.TextureHeight
);
3843 g_GetTexture(Panel
.TextureName
, Panel
.TextureID
);
3845 else // Спец.текстура:
3847 Panel
.TextureHeight
:= 1;
3848 Panel
.TextureWidth
:= 1;
3849 Panel
.TextureID
:= SpecialTextureID(SelectedTexture());
3854 Panel
.Blending
:= False;
3856 Undo_Add(OBJECT_PANEL
, AddPanel(Panel
));
3860 // Рисовали триггер:
3861 MOUSEACTION_DRAWTRIGGER
:
3863 trigger
.X
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
3864 trigger
.Y
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
3865 if ssCtrl
in Shift
then
3869 trigger
.Width
:= wWidth
;
3870 trigger
.Height
:= wHeight
;
3874 trigger
.Width
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
3875 trigger
.Height
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
3878 trigger
.Enabled
:= True;
3879 trigger
.TriggerType
:= lbTriggersList
.ItemIndex
+1;
3880 trigger
.TexturePanel
:= -1;
3883 trigger
.ActivateType
:= 0;
3885 if clbActivationType
.Checked
[0] then
3886 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERCOLLIDE
;
3887 if clbActivationType
.Checked
[1] then
3888 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERCOLLIDE
;
3889 if clbActivationType
.Checked
[2] then
3890 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_PLAYERPRESS
;
3891 if clbActivationType
.Checked
[3] then
3892 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_MONSTERPRESS
;
3893 if clbActivationType
.Checked
[4] then
3894 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_SHOT
;
3895 if clbActivationType
.Checked
[5] then
3896 trigger
.ActivateType
:= Trigger
.ActivateType
or ACTIVATE_NOMONSTER
;
3898 // Необходимые для активации ключи:
3901 if clbKeys
.Checked
[0] then
3902 trigger
.Key
:= Trigger
.Key
or KEY_RED
;
3903 if clbKeys
.Checked
[1] then
3904 trigger
.Key
:= Trigger
.Key
or KEY_GREEN
;
3905 if clbKeys
.Checked
[2] then
3906 trigger
.Key
:= Trigger
.Key
or KEY_BLUE
;
3907 if clbKeys
.Checked
[3] then
3908 trigger
.Key
:= Trigger
.Key
or KEY_REDTEAM
;
3909 if clbKeys
.Checked
[4] then
3910 trigger
.Key
:= Trigger
.Key
or KEY_BLUETEAM
;
3912 // Параметры триггера:
3913 FillByte(trigger
.Data
.Default
[0], 128, 0);
3915 case trigger
.TriggerType
of
3916 // Переключаемая панель:
3917 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
3918 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
3919 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
3921 Trigger
.Data
.PanelID
:= -1;
3927 trigger
.Data
.TargetPoint
.X
:= trigger
.X
-64;
3928 trigger
.Data
.TargetPoint
.Y
:= trigger
.Y
-64;
3929 trigger
.Data
.d2d_teleport
:= True;
3930 trigger
.Data
.TlpDir
:= 0;
3933 // Изменение других триггеров:
3934 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
,
3937 trigger
.Data
.Count
:= 1;
3943 trigger
.Data
.Volume
:= 255;
3944 trigger
.Data
.Pan
:= 127;
3945 trigger
.Data
.PlayCount
:= 1;
3946 trigger
.Data
.Local
:= True;
3947 trigger
.Data
.SoundSwitch
:= False;
3953 trigger
.Data
.MusicAction
:= 1;
3956 // Создание монстра:
3957 TRIGGER_SPAWNMONSTER
:
3959 trigger
.Data
.MonType
:= MONSTER_ZOMBY
;
3960 trigger
.Data
.MonPos
.X
:= trigger
.X
-64;
3961 trigger
.Data
.MonPos
.Y
:= trigger
.Y
-64;
3962 trigger
.Data
.MonHealth
:= 0;
3963 trigger
.Data
.MonActive
:= False;
3964 trigger
.Data
.MonCount
:= 1;
3967 // Создание предмета:
3970 trigger
.Data
.ItemType
:= ITEM_AMMO_BULLETS
;
3971 trigger
.Data
.ItemPos
.X
:= trigger
.X
-64;
3972 trigger
.Data
.ItemPos
.Y
:= trigger
.Y
-64;
3973 trigger
.Data
.ItemOnlyDM
:= False;
3974 trigger
.Data
.ItemFalls
:= False;
3975 trigger
.Data
.ItemCount
:= 1;
3976 trigger
.Data
.ItemMax
:= 0;
3977 trigger
.Data
.ItemDelay
:= 0;
3983 trigger
.Data
.PushAngle
:= 90;
3984 trigger
.Data
.PushForce
:= 10;
3985 trigger
.Data
.ResetVel
:= True;
3990 trigger
.Data
.ScoreCount
:= 1;
3991 trigger
.Data
.ScoreCon
:= True;
3992 trigger
.Data
.ScoreMsg
:= True;
3997 trigger
.Data
.MessageKind
:= 0;
3998 trigger
.Data
.MessageSendTo
:= 0;
3999 trigger
.Data
.MessageText
:= '';
4000 trigger
.Data
.MessageTime
:= 144;
4005 trigger
.Data
.DamageValue
:= 5;
4006 trigger
.Data
.DamageInterval
:= 12;
4011 trigger
.Data
.HealValue
:= 5;
4012 trigger
.Data
.HealInterval
:= 36;
4017 trigger
.Data
.ShotType
:= TRIGGER_SHOT_BULLET
;
4018 trigger
.Data
.ShotSound
:= True;
4019 trigger
.Data
.ShotPanelID
:= -1;
4020 trigger
.Data
.ShotTarget
:= 0;
4021 trigger
.Data
.ShotIntSight
:= 0;
4022 trigger
.Data
.ShotAim
:= TRIGGER_SHOT_AIM_DEFAULT
;
4023 trigger
.Data
.ShotPos
.X
:= trigger
.X
-64;
4024 trigger
.Data
.ShotPos
.Y
:= trigger
.Y
-64;
4025 trigger
.Data
.ShotAngle
:= 0;
4026 trigger
.Data
.ShotWait
:= 18;
4027 trigger
.Data
.ShotAccuracy
:= 0;
4028 trigger
.Data
.ShotAmmo
:= 0;
4029 trigger
.Data
.ShotIntReload
:= 0;
4034 trigger
.Data
.FXCount
:= 1;
4035 trigger
.Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
4036 trigger
.Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
4037 trigger
.Data
.FXColorR
:= 0;
4038 trigger
.Data
.FXColorG
:= 0;
4039 trigger
.Data
.FXColorB
:= 255;
4040 trigger
.Data
.FXPos
:= TRIGGER_EFFECT_POS_CENTER
;
4041 trigger
.Data
.FXWait
:= 1;
4042 trigger
.Data
.FXVelX
:= 0;
4043 trigger
.Data
.FXVelY
:= -20;
4044 trigger
.Data
.FXSpreadL
:= 5;
4045 trigger
.Data
.FXSpreadR
:= 5;
4046 trigger
.Data
.FXSpreadU
:= 4;
4047 trigger
.Data
.FXSpreadD
:= 0;
4051 Undo_Add(OBJECT_TRIGGER
, AddTrigger(trigger
));
4054 // Рисовали область триггера "Расширитель":
4055 MOUSEACTION_DRAWPRESS
:
4056 with gTriggers
[SelectedObjects
[GetFirstSelected
].ID
] do
4058 Data
.tX
:= Min(MousePos
.X
-MapOffset
.X
, MouseLDownPos
.X
-MapOffset
.X
);
4059 Data
.tY
:= Min(MousePos
.Y
-MapOffset
.Y
, MouseLDownPos
.Y
-MapOffset
.Y
);
4060 Data
.tWidth
:= Abs(MousePos
.X
-MouseLDownPos
.X
);
4061 Data
.tHeight
:= Abs(MousePos
.Y
-MouseLDownPos
.Y
);
4063 DrawPressRect
:= False;
4067 MouseAction
:= MOUSEACTION_NONE
;
4069 end // if Button = mbLeft...
4070 else if Button
= mbRight
then // Right Mouse Button:
4072 if MouseAction
= MOUSEACTION_NOACTION
then
4074 MouseAction
:= MOUSEACTION_NONE
;
4078 // Объект передвинут или изменен в размере:
4079 if MouseAction
in [MOUSEACTION_MOVEOBJ
, MOUSEACTION_RESIZE
] then
4081 RenderPanel
.Cursor
:= crDefault
;
4082 MouseAction
:= MOUSEACTION_NONE
;
4087 // Еще не все выбрали:
4088 if SelectFlag
<> SELECTFLAG_NONE
then
4090 if SelectFlag
= SELECTFLAG_SELECTED
then
4091 SelectFlag
:= SELECTFLAG_NONE
;
4096 // Мышь сдвинулась во время удержания клавиши:
4097 if (MousePos
.X
<> MouseRDownPos
.X
) and
4098 (MousePos
.Y
<> MouseRDownPos
.Y
) then
4100 rSelectRect
:= True;
4102 rRect
.X
:= Min(MousePos
.X
, MouseRDownPos
.X
)-MapOffset
.X
;
4103 rRect
.Y
:= Min(MousePos
.Y
, MouseRDownPos
.Y
)-MapOffset
.Y
;
4104 rRect
.Width
:= Abs(MousePos
.X
-MouseRDownPos
.X
);
4105 rRect
.Height
:= Abs(MousePos
.Y
-MouseRDownPos
.Y
);
4107 else // Мышь не сдвинулась - нет прямоугольника:
4109 rSelectRect
:= False;
4111 rRect
.X
:= X
-MapOffset
.X
-1;
4112 rRect
.Y
:= Y
-MapOffset
.Y
-1;
4117 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4118 if not (ssCtrl
in Shift
) then
4119 RemoveSelectFromObjects();
4121 // Выделяем всё в выбранном прямоугольнике:
4122 if (ssCtrl
in Shift
) and (ssAlt
in Shift
) then
4124 SelectObjects(OBJECT_PANEL
);
4125 SelectObjects(OBJECT_ITEM
);
4126 SelectObjects(OBJECT_MONSTER
);
4127 SelectObjects(OBJECT_AREA
);
4128 SelectObjects(OBJECT_TRIGGER
);
4131 SelectObjects(pcObjects
.ActivePageIndex
+1);
4136 else // Middle Mouse Button
4138 RenderPanel
.Cursor
:= crDefault
;
4143 procedure TMainForm
.RenderPanelPaint(Sender
: TObject
);
4148 function TMainForm
.RenderMousePos(): Types
.TPoint
;
4150 Result
:= RenderPanel
.ScreenToClient(Mouse
.CursorPos
);
4153 procedure TMainForm
.RecountSelectedObjects();
4155 if SelectedObjectCount() = 0 then
4156 StatusBar
.Panels
[0].Text := ''
4158 StatusBar
.Panels
[0].Text := Format(MsgCapStatSelected
, [SelectedObjectCount()]);
4161 procedure TMainForm
.RenderPanelMouseMove(Sender
: TObject
;
4162 Shift
: TShiftState
; X
, Y
: Integer);
4165 dWidth
, dHeight
: Integer;
4168 wWidth
, wHeight
: Word;
4170 _id
:= GetFirstSelected();
4173 // Рисуем панель с текстурой, сетка - размеры текстуры:
4174 if (MouseAction
= MOUSEACTION_DRAWPANEL
) and
4175 (lbPanelType
.ItemIndex
in [0..8]) and
4176 (lbTextureList
.ItemIndex
<> -1) and
4177 (not IsSpecialTextureSel()) then
4179 sX
:= StrToIntDef(lTextureWidth
.Caption
, DotStep
);
4180 sY
:= StrToIntDef(lTextureHeight
.Caption
, DotStep
);
4183 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4184 if (MouseAction
= MOUSEACTION_RESIZE
) and
4185 ( (SelectedObjects
[_id
].ObjectType
= OBJECT_PANEL
) and
4186 IsTexturedPanel(gPanels
[SelectedObjects
[_id
].ID
].PanelType
) and
4187 (gPanels
[SelectedObjects
[_id
].ID
].TextureName
<> '') and
4188 (not IsSpecialTexture(gPanels
[SelectedObjects
[_id
].ID
].TextureName
)) ) then
4190 sX
:= gPanels
[SelectedObjects
[_id
].ID
].TextureWidth
;
4191 sY
:= gPanels
[SelectedObjects
[_id
].ID
].TextureHeight
;
4194 // Выравнивание по сетке:
4200 else // Нет выравнивания по сетке:
4206 // Новая позиция мыши:
4208 begin // Зажата левая кнопка мыши
4209 MousePos
.X
:= (Round((X
-MouseLDownPos
.X
)/sX
)*sX
)+MouseLDownPos
.X
;
4210 MousePos
.Y
:= (Round((Y
-MouseLDownPos
.Y
)/sY
)*sY
)+MouseLDownPos
.Y
;
4214 begin // Зажата правая кнопка мыши
4215 MousePos
.X
:= (Round((X
-MouseRDownPos
.X
)/sX
)*sX
)+MouseRDownPos
.X
;
4216 MousePos
.Y
:= (Round((Y
-MouseRDownPos
.Y
)/sY
)*sY
)+MouseRDownPos
.Y
;
4219 begin // Кнопки мыши не зажаты
4220 MousePos
.X
:= Round((-MapOffset
.X
+ X
) / sX
) * sX
+ MapOffset
.X
;
4221 MousePos
.Y
:= Round((-MapOffset
.Y
+ Y
) / sY
) * sY
+ MapOffset
.Y
;
4224 // Зажата только правая кнопка мыши:
4225 if (not MouseLDown
) and (MouseRDown
) and (not MouseMDown
) then
4227 // Рисуем прямоугольник выделения:
4228 if MouseAction
= MOUSEACTION_NONE
then
4230 if DrawRect
= nil then
4232 DrawRect
.Top
:= MouseRDownPos
.y
;
4233 DrawRect
.Left
:= MouseRDownPos
.x
;
4234 DrawRect
.Bottom
:= MousePos
.y
;
4235 DrawRect
.Right
:= MousePos
.x
;
4238 // Двигаем выделенные объекты:
4239 if MouseAction
= MOUSEACTION_MOVEOBJ
then
4241 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
,
4242 MousePos
.X
-LastMovePoint
.X
,
4243 MousePos
.Y
-LastMovePoint
.Y
);
4246 // Меняем размер выделенного объекта:
4247 if MouseAction
= MOUSEACTION_RESIZE
then
4249 if (SelectedObjectCount
= 1) and
4250 (SelectedObjects
[GetFirstSelected
].Live
) then
4252 dWidth
:= MousePos
.X
-LastMovePoint
.X
;
4253 dHeight
:= MousePos
.Y
-LastMovePoint
.Y
;
4256 RESIZETYPE_VERTICAL
: dWidth
:= 0;
4257 RESIZETYPE_HORIZONTAL
: dHeight
:= 0;
4260 case ResizeDirection
of
4261 RESIZEDIR_UP
: dHeight
:= -dHeight
;
4262 RESIZEDIR_LEFT
: dWidth
:= -dWidth
;
4265 if ResizeObject(SelectedObjects
[GetFirstSelected
].ObjectType
,
4266 SelectedObjects
[GetFirstSelected
].ID
,
4267 dWidth
, dHeight
, ResizeDirection
) then
4268 LastMovePoint
:= MousePos
;
4273 // Зажата только левая кнопка мыши:
4274 if (not MouseRDown
) and (MouseLDown
) and (not MouseMDown
) then
4276 // Рисуем прямоугольник планирования панели:
4277 if MouseAction
in [MOUSEACTION_DRAWPANEL
,
4278 MOUSEACTION_DRAWTRIGGER
,
4279 MOUSEACTION_DRAWPRESS
] then
4281 if DrawRect
= nil then
4283 if ssCtrl
in Shift
then
4287 if (lbTextureList
.ItemIndex
<> -1) and (not IsSpecialTextureSel()) and
4288 (MouseAction
= MOUSEACTION_DRAWPANEL
) then
4290 if not g_GetTexture(SelectedTexture(), TextureID
) then
4291 g_GetTexture('NOTEXTURE', TextureID
);
4292 g_GetTextureSizeByID(TextureID
, wWidth
, wHeight
);
4294 DrawRect
.Top
:= MouseLDownPos
.y
;
4295 DrawRect
.Left
:= MouseLDownPos
.x
;
4296 DrawRect
.Bottom
:= DrawRect
.Top
+ wHeight
;
4297 DrawRect
.Right
:= DrawRect
.Left
+ wWidth
;
4301 DrawRect
.Top
:= MouseLDownPos
.y
;
4302 DrawRect
.Left
:= MouseLDownPos
.x
;
4303 DrawRect
.Bottom
:= MousePos
.y
;
4304 DrawRect
.Right
:= MousePos
.x
;
4307 else // Двигаем карту:
4308 if MouseAction
= MOUSEACTION_MOVEMAP
then
4314 // Only Middle Mouse Button is pressed
4315 if (not MouseLDown
) and (not MouseRDown
) and (MouseMDown
) then
4317 MapOffset
.X
:= -EnsureRange(-MapOffset
.X
+ MouseMDownPos
.X
- Mouse
.CursorPos
.X
,
4318 sbHorizontal
.Min
, sbHorizontal
.Max
);
4319 sbHorizontal
.Position
:= -MapOffset
.X
;
4320 MapOffset
.Y
:= -EnsureRange(-MapOffset
.Y
+ MouseMDownPos
.Y
- Mouse
.CursorPos
.Y
,
4321 sbVertical
.Min
, sbVertical
.Max
);
4322 sbVertical
.Position
:= -MapOffset
.Y
;
4323 MouseMDownPos
:= Mouse
.CursorPos
;
4326 // Клавиши мыши не зажаты:
4327 if (not MouseRDown
) and (not MouseLDown
) then
4330 // Строка состояния - координаты мыши:
4331 StatusBar
.Panels
[1].Text := Format('(%d:%d)',
4332 [MousePos
.X
-MapOffset
.X
, MousePos
.Y
-MapOffset
.Y
]);
4334 RenderPanel
.Invalidate
;
4337 procedure TMainForm
.FormCloseQuery(Sender
: TObject
; var CanClose
: Boolean);
4339 CanClose
:= Application
.MessageBox(PChar(MsgMsgExitPrompt
),
4341 MB_ICONQUESTION
or MB_YESNO
or
4342 MB_DEFBUTTON1
) = idYes
;
4345 procedure TMainForm
.aExitExecute(Sender
: TObject
);
4350 procedure TMainForm
.FormDestroy(Sender
: TObject
);
4356 config
:= TConfig
.CreateFile(CfgFileName
);
4358 if WindowState
<> wsMaximized
then
4360 config
.WriteInt('Editor', 'XPos', Left
);
4361 config
.WriteInt('Editor', 'YPos', Top
);
4362 config
.WriteInt('Editor', 'Width', Width
);
4363 config
.WriteInt('Editor', 'Height', Height
);
4367 config
.WriteInt('Editor', 'XPos', RestoredLeft
);
4368 config
.WriteInt('Editor', 'YPos', RestoredTop
);
4369 config
.WriteInt('Editor', 'Width', RestoredWidth
);
4370 config
.WriteInt('Editor', 'Height', RestoredHeight
);
4372 config
.WriteBool('Editor', 'Maximize', WindowState
= wsMaximized
);
4373 config
.WriteBool('Editor', 'Minimap', ShowMap
);
4374 config
.WriteInt('Editor', 'PanelProps', PanelProps
.ClientWidth
);
4375 config
.WriteInt('Editor', 'PanelObjs', PanelObjs
.ClientHeight
);
4376 config
.WriteBool('Editor', 'DotEnable', DotEnable
);
4377 config
.WriteInt('Editor', 'DotStep', DotStep
);
4378 config
.WriteStr('Editor', 'LastOpenDir', OpenDialog
.InitialDir
);
4379 config
.WriteStr('Editor', 'LastSaveDir', SaveDialog
.InitialDir
);
4380 config
.WriteStr('Editor', 'Language', gLanguage
);
4381 config
.WriteBool('Editor', 'EdgeShow', drEdge
[3] < 255);
4382 config
.WriteInt('Editor', 'EdgeColor', gColorEdge
);
4383 config
.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge
);
4384 config
.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine
);
4385 config
.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea
);
4386 config
.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect
);
4387 config
.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect
);
4389 for i
:= 0 to RecentCount
- 1 do
4391 if i
< RecentFiles
.Count
then s
:= RecentFiles
[i
] else s
:= '';
4393 config
.WriteStr('RecentFilesWin', IntToStr(i
), s
);
4395 config
.WriteStr('RecentFilesUnix', IntToStr(i
), s
);
4400 config
.SaveFile(CfgFileName
);
4403 slInvalidTextures
.Free
;
4406 procedure TMainForm
.FormDropFiles(Sender
: TObject
;
4407 const FileNames
: array of String);
4409 if Length(FileNames
) <> 1 then
4412 OpenMapFile(FileNames
[0]);
4415 procedure TMainForm
.RenderPanelResize(Sender
: TObject
);
4417 if MainForm
.Visible
then
4421 procedure TMainForm
.Splitter1Moved(Sender
: TObject
);
4426 procedure TMainForm
.MapTestCheck(Sender
: TObject
);
4428 if MapTestProcess
<> nil then
4430 if MapTestProcess
.Running
= false then
4432 if MapTestProcess
.ExitCode
<> 0 then
4433 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
4434 SysUtils
.DeleteFile(MapTestFile
);
4436 FreeAndNil(MapTestProcess
);
4437 tbTestMap
.Enabled
:= True;
4442 procedure TMainForm
.aMapOptionsExecute(Sender
: TObject
);
4446 MapOptionsForm
.ShowModal();
4448 ResName
:= OpenedMap
;
4449 while (Pos(':\', ResName
) > 0) do
4450 Delete(ResName
, 1, Pos(':\', ResName
) + 1);
4452 UpdateCaption(gMapInfo
.Name
, ExtractFileName(OpenedWAD
), ResName
);
4455 procedure TMainForm
.aAboutExecute(Sender
: TObject
);
4457 AboutForm
.ShowModal();
4460 procedure TMainForm
.FormKeyDown(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
4466 if (not EditingProperties
) then
4468 if ssCtrl
in Shift
then
4471 '1': ContourEnabled
[LAYER_BACK
] := not ContourEnabled
[LAYER_BACK
];
4472 '2': ContourEnabled
[LAYER_WALLS
] := not ContourEnabled
[LAYER_WALLS
];
4473 '3': ContourEnabled
[LAYER_FOREGROUND
] := not ContourEnabled
[LAYER_FOREGROUND
];
4474 '4': ContourEnabled
[LAYER_STEPS
] := not ContourEnabled
[LAYER_STEPS
];
4475 '5': ContourEnabled
[LAYER_WATER
] := not ContourEnabled
[LAYER_WATER
];
4476 '6': ContourEnabled
[LAYER_ITEMS
] := not ContourEnabled
[LAYER_ITEMS
];
4477 '7': ContourEnabled
[LAYER_MONSTERS
] := not ContourEnabled
[LAYER_MONSTERS
];
4478 '8': ContourEnabled
[LAYER_AREAS
] := not ContourEnabled
[LAYER_AREAS
];
4479 '9': ContourEnabled
[LAYER_TRIGGERS
] := not ContourEnabled
[LAYER_TRIGGERS
];
4483 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4484 if ContourEnabled
[i
] then
4486 for i
:= Low(ContourEnabled
) to High(ContourEnabled
) do
4487 ContourEnabled
[i
] := not ok
4494 '1': SwitchLayer(LAYER_BACK
);
4495 '2': SwitchLayer(LAYER_WALLS
);
4496 '3': SwitchLayer(LAYER_FOREGROUND
);
4497 '4': SwitchLayer(LAYER_STEPS
);
4498 '5': SwitchLayer(LAYER_WATER
);
4499 '6': SwitchLayer(LAYER_ITEMS
);
4500 '7': SwitchLayer(LAYER_MONSTERS
);
4501 '8': SwitchLayer(LAYER_AREAS
);
4502 '9': SwitchLayer(LAYER_TRIGGERS
);
4503 '0': tbShowClick(tbShow
);
4507 if Key
= Ord('I') then
4508 begin // Поворот монстров и областей:
4509 if (SelectedObjects
<> nil) then
4511 for i
:= 0 to High(SelectedObjects
) do
4512 if (SelectedObjects
[i
].Live
) then
4514 if (SelectedObjects
[i
].ObjectType
= OBJECT_MONSTER
) then
4516 g_ChangeDir(gMonsters
[SelectedObjects
[i
].ID
].Direction
);
4519 if (SelectedObjects
[i
].ObjectType
= OBJECT_AREA
) then
4521 g_ChangeDir(gAreas
[SelectedObjects
[i
].ID
].Direction
);
4527 if pcObjects
.ActivePage
= tsMonsters
then
4529 if rbMonsterLeft
.Checked
then
4530 rbMonsterRight
.Checked
:= True
4532 rbMonsterLeft
.Checked
:= True;
4534 if pcObjects
.ActivePage
= tsAreas
then
4536 if rbAreaLeft
.Checked
then
4537 rbAreaRight
.Checked
:= True
4539 rbAreaLeft
.Checked
:= True;
4544 if not (ssCtrl
in Shift
) then
4546 // Быстрое превью карты:
4547 if Key
= Ord('E') then
4549 if PreviewMode
= 0 then
4553 // Вертикальный скролл карты:
4556 if Key
= Ord('W') then
4559 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4560 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4561 MapOffset
.Y
:= -Position
;
4564 if (MouseLDown
or MouseRDown
) then
4566 if DrawRect
<> nil then
4568 Inc(MouseLDownPos
.y
, dy
);
4569 Inc(MouseRDownPos
.y
, dy
);
4571 Inc(LastMovePoint
.Y
, dy
);
4572 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4576 if Key
= Ord('S') then
4579 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4580 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4581 MapOffset
.Y
:= -Position
;
4584 if (MouseLDown
or MouseRDown
) then
4586 if DrawRect
<> nil then
4588 Inc(MouseLDownPos
.y
, dy
);
4589 Inc(MouseRDownPos
.y
, dy
);
4591 Inc(LastMovePoint
.Y
, dy
);
4592 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4597 // Горизонтальный скролл карты:
4598 with sbHorizontal
do
4600 if Key
= Ord('A') then
4603 if ssShift
in Shift
then Position
:= EnsureRange(Position
- DotStep
* 4, Min
, Max
)
4604 else Position
:= EnsureRange(Position
- DotStep
, Min
, Max
);
4605 MapOffset
.X
:= -Position
;
4608 if (MouseLDown
or MouseRDown
) then
4610 if DrawRect
<> nil then
4612 Inc(MouseLDownPos
.x
, dx
);
4613 Inc(MouseRDownPos
.x
, dx
);
4615 Inc(LastMovePoint
.X
, dx
);
4616 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4620 if Key
= Ord('D') then
4623 if ssShift
in Shift
then Position
:= EnsureRange(Position
+ DotStep
* 4, Min
, Max
)
4624 else Position
:= EnsureRange(Position
+ DotStep
, Min
, Max
);
4625 MapOffset
.X
:= -Position
;
4628 if (MouseLDown
or MouseRDown
) then
4630 if DrawRect
<> nil then
4632 Inc(MouseLDownPos
.x
, dx
);
4633 Inc(MouseRDownPos
.x
, dx
);
4635 Inc(LastMovePoint
.X
, dx
);
4636 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4641 else // ssCtrl in Shift
4643 if ssShift
in Shift
then
4645 // Вставка по абсолютному смещению:
4646 if Key
= Ord('V') then
4647 aPasteObjectExecute(Sender
);
4649 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);
4653 // Удалить выделенные объекты:
4654 if (Key
= VK_DELETE
) and (SelectedObjects
<> nil) and
4655 RenderPanel
.Focused() then
4656 DeleteSelectedObjects();
4659 if (Key
= VK_ESCAPE
) and (SelectedObjects
<> nil) then
4660 RemoveSelectFromObjects();
4662 // Передвинуть объекты:
4663 if MainForm
.ActiveControl
= RenderPanel
then
4668 if Key
= VK_NUMPAD4
then
4669 dx
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4670 if Key
= VK_NUMPAD6
then
4671 dx
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4672 if Key
= VK_NUMPAD8
then
4673 dy
:= IfThen(ssAlt
in Shift
, -1, -DotStep
);
4674 if Key
= VK_NUMPAD5
then
4675 dy
:= IfThen(ssAlt
in Shift
, 1, DotStep
);
4677 if (dx
<> 0) or (dy
<> 0) then
4679 MoveSelectedObjects(ssShift
in Shift
, ssCtrl
in Shift
, dx
, dy
);
4684 if ssCtrl
in Shift
then
4686 // Выбор панели с текстурой для триггера
4687 if Key
= Ord('T') then
4689 DrawPressRect
:= False;
4690 if SelectFlag
= SELECTFLAG_TEXTURE
then
4692 SelectFlag
:= SELECTFLAG_NONE
;
4695 vleObjectProperty
.FindRow(MsgPropTrTexturePanel
, i
);
4697 SelectFlag
:= SELECTFLAG_TEXTURE
;
4700 if Key
= Ord('D') then
4702 SelectFlag
:= SELECTFLAG_NONE
;
4703 if DrawPressRect
then
4705 DrawPressRect
:= False;
4710 // Выбор области воздействия, в зависимости от типа триггера
4711 vleObjectProperty
.FindRow(MsgPropTrExArea
, i
);
4714 DrawPressRect
:= True;
4717 vleObjectProperty
.FindRow(MsgPropTrDoorPanel
, i
);
4719 vleObjectProperty
.FindRow(MsgPropTrTrapPanel
, i
);
4722 SelectFlag
:= SELECTFLAG_DOOR
;
4725 vleObjectProperty
.FindRow(MsgPropTrLiftPanel
, i
);
4728 SelectFlag
:= SELECTFLAG_LIFT
;
4731 vleObjectProperty
.FindRow(MsgPropTrTeleportTo
, i
);
4734 SelectFlag
:= SELECTFLAG_TELEPORT
;
4737 vleObjectProperty
.FindRow(MsgPropTrSpawnTo
, i
);
4740 SelectFlag
:= SELECTFLAG_SPAWNPOINT
;
4744 // Выбор основного параметра, в зависимости от типа триггера
4745 vleObjectProperty
.FindRow(MsgPropTrNextMap
, i
);
4748 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
4749 SelectMapForm
.Caption
:= MsgCapSelect
;
4750 SelectMapForm
.GetMaps(FileName
);
4752 if SelectMapForm
.ShowModal() = mrOK
then
4754 vleObjectProperty
.Cells
[1, i
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
4755 bApplyProperty
.Click();
4759 vleObjectProperty
.FindRow(MsgPropTrSoundName
, i
);
4761 vleObjectProperty
.FindRow(MsgPropTrMusicName
, i
);
4764 AddSoundForm
.OKFunction
:= nil;
4765 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
4766 AddSoundForm
.SetResource
:= vleObjectProperty
.Cells
[1, i
];
4768 if (AddSoundForm
.ShowModal() = mrOk
) then
4770 vleObjectProperty
.Cells
[1, i
] := AddSoundForm
.ResourceName
;
4771 bApplyProperty
.Click();
4775 vleObjectProperty
.FindRow(MsgPropTrPushAngle
, i
);
4777 vleObjectProperty
.FindRow(MsgPropTrMessageText
, i
);
4780 vleObjectProperty
.Row
:= i
;
4781 vleObjectProperty
.SetFocus();
4788 procedure TMainForm
.aOptimizeExecute(Sender
: TObject
);
4790 RemoveSelectFromObjects();
4791 MapOptimizationForm
.ShowModal();
4794 procedure TMainForm
.aCheckMapExecute(Sender
: TObject
);
4796 MapCheckForm
.ShowModal();
4799 procedure TMainForm
.bbAddTextureClick(Sender
: TObject
);
4801 AddTextureForm
.lbResourcesList
.MultiSelect
:= True;
4802 AddTextureForm
.ShowModal();
4805 procedure TMainForm
.lbTextureListClick(Sender
: TObject
);
4808 TextureWidth
, TextureHeight
: Word;
4813 if (lbTextureList
.ItemIndex
<> -1) and
4814 (not IsSpecialTextureSel()) then
4816 if g_GetTexture(SelectedTexture(), TextureID
) then
4818 g_GetTextureSizeByID(TextureID
, TextureWidth
, TextureHeight
);
4820 lTextureWidth
.Caption
:= IntToStr(TextureWidth
);
4821 lTextureHeight
.Caption
:= IntToStr(TextureHeight
);
4824 lTextureWidth
.Caption
:= MsgNotAccessible
;
4825 lTextureHeight
.Caption
:= MsgNotAccessible
;
4830 lTextureWidth
.Caption
:= '';
4831 lTextureHeight
.Caption
:= '';
4835 procedure TMainForm
.lbTextureListDrawItem(Control
: TWinControl
; Index
: Integer;
4836 ARect
: TRect
; State
: TOwnerDrawState
);
4838 with Control
as TListBox
do
4840 if LCLType
.odSelected
in State
then
4842 Canvas
.Brush
.Color
:= clHighlight
;
4843 Canvas
.Font
.Color
:= clHighlightText
;
4845 if (Items
<> nil) and (Index
>= 0) then
4846 if slInvalidTextures
.IndexOf(Items
[Index
]) > -1 then
4848 Canvas
.Brush
.Color
:= clRed
;
4849 Canvas
.Font
.Color
:= clWhite
;
4851 Canvas
.FillRect(ARect
);
4852 Canvas
.TextRect(ARect
, ARect
.Left
, ARect
.Top
, Items
[Index
]);
4856 procedure TMainForm
.miMacMinimizeClick(Sender
: TObject
);
4858 self
.WindowState
:= wsMinimized
;
4859 self
.FormWindowStateChange(Sender
);
4862 procedure TMainForm
.miMacZoomClick(Sender
: TObject
);
4864 if self
.WindowState
= wsMaximized
then
4865 self
.WindowState
:= wsNormal
4867 self
.WindowState
:= wsMaximized
;
4868 self
.FormWindowStateChange(Sender
);
4871 procedure TMainForm
.miReopenMapClick(Sender
: TObject
);
4873 FileName
, Resource
: String;
4875 if OpenedMap
= '' then
4878 if Application
.MessageBox(PChar(MsgMsgReopenMapPrompt
),
4879 PChar(MsgMenuFileReopen
), MB_ICONQUESTION
or MB_YESNO
) <> idYes
then
4882 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, @Resource
);
4883 OpenMap(FileName
, Resource
);
4886 procedure TMainForm
.vleObjectPropertyGetPickList(Sender
: TObject
;
4887 const KeyName
: String; Values
: TStrings
);
4889 if vleObjectProperty
.ItemProps
[KeyName
].EditStyle
= esPickList
then
4891 if KeyName
= MsgPropDirection
then
4893 Values
.Add(DirNames
[D_LEFT
]);
4894 Values
.Add(DirNames
[D_RIGHT
]);
4896 else if KeyName
= MsgPropTrTeleportDir
then
4898 Values
.Add(DirNamesAdv
[0]);
4899 Values
.Add(DirNamesAdv
[1]);
4900 Values
.Add(DirNamesAdv
[2]);
4901 Values
.Add(DirNamesAdv
[3]);
4903 else if KeyName
= MsgPropTrMusicAct
then
4905 Values
.Add(MsgPropTrMusicOn
);
4906 Values
.Add(MsgPropTrMusicOff
);
4908 else if KeyName
= MsgPropTrMonsterBehaviour
then
4910 Values
.Add(MsgPropTrMonsterBehaviour0
);
4911 Values
.Add(MsgPropTrMonsterBehaviour1
);
4912 Values
.Add(MsgPropTrMonsterBehaviour2
);
4913 Values
.Add(MsgPropTrMonsterBehaviour3
);
4914 Values
.Add(MsgPropTrMonsterBehaviour4
);
4915 Values
.Add(MsgPropTrMonsterBehaviour5
);
4917 else if KeyName
= MsgPropTrScoreAct
then
4919 Values
.Add(MsgPropTrScoreAct0
);
4920 Values
.Add(MsgPropTrScoreAct1
);
4921 Values
.Add(MsgPropTrScoreAct2
);
4922 Values
.Add(MsgPropTrScoreAct3
);
4924 else if KeyName
= MsgPropTrScoreTeam
then
4926 Values
.Add(MsgPropTrScoreTeam0
);
4927 Values
.Add(MsgPropTrScoreTeam1
);
4928 Values
.Add(MsgPropTrScoreTeam2
);
4929 Values
.Add(MsgPropTrScoreTeam3
);
4931 else if KeyName
= MsgPropTrMessageKind
then
4933 Values
.Add(MsgPropTrMessageKind0
);
4934 Values
.Add(MsgPropTrMessageKind1
);
4936 else if KeyName
= MsgPropTrMessageTo
then
4938 Values
.Add(MsgPropTrMessageTo0
);
4939 Values
.Add(MsgPropTrMessageTo1
);
4940 Values
.Add(MsgPropTrMessageTo2
);
4941 Values
.Add(MsgPropTrMessageTo3
);
4942 Values
.Add(MsgPropTrMessageTo4
);
4943 Values
.Add(MsgPropTrMessageTo5
);
4945 else if KeyName
= MsgPropTrShotTo
then
4947 Values
.Add(MsgPropTrShotTo0
);
4948 Values
.Add(MsgPropTrShotTo1
);
4949 Values
.Add(MsgPropTrShotTo2
);
4950 Values
.Add(MsgPropTrShotTo3
);
4951 Values
.Add(MsgPropTrShotTo4
);
4952 Values
.Add(MsgPropTrShotTo5
);
4953 Values
.Add(MsgPropTrShotTo6
);
4955 else if KeyName
= MsgPropTrShotAim
then
4957 Values
.Add(MsgPropTrShotAim0
);
4958 Values
.Add(MsgPropTrShotAim1
);
4959 Values
.Add(MsgPropTrShotAim2
);
4960 Values
.Add(MsgPropTrShotAim3
);
4962 else if KeyName
= MsgPropTrDamageKind
then
4964 Values
.Add(MsgPropTrDamageKind0
);
4965 Values
.Add(MsgPropTrDamageKind3
);
4966 Values
.Add(MsgPropTrDamageKind4
);
4967 Values
.Add(MsgPropTrDamageKind5
);
4968 Values
.Add(MsgPropTrDamageKind6
);
4969 Values
.Add(MsgPropTrDamageKind7
);
4970 Values
.Add(MsgPropTrDamageKind8
);
4972 else if (KeyName
= MsgPropPanelBlend
) or
4973 (KeyName
= MsgPropDmOnly
) or
4974 (KeyName
= MsgPropItemFalls
) or
4975 (KeyName
= MsgPropTrEnabled
) or
4976 (KeyName
= MsgPropTrD2d
) or
4977 (KeyName
= MsgPropTrSilent
) or
4978 (KeyName
= MsgPropTrTeleportSilent
) or
4979 (KeyName
= MsgPropTrExRandom
) or
4980 (KeyName
= MsgPropTrTextureOnce
) or
4981 (KeyName
= MsgPropTrTextureAnimOnce
) or
4982 (KeyName
= MsgPropTrSoundLocal
) or
4983 (KeyName
= MsgPropTrSoundSwitch
) or
4984 (KeyName
= MsgPropTrMonsterActive
) or
4985 (KeyName
= MsgPropTrPushReset
) or
4986 (KeyName
= MsgPropTrScoreCon
) or
4987 (KeyName
= MsgPropTrScoreMsg
) or
4988 (KeyName
= MsgPropTrHealthMax
) or
4989 (KeyName
= MsgPropTrShotSound
) or
4990 (KeyName
= MsgPropTrEffectCenter
) then
4992 Values
.Add(BoolNames
[True]);
4993 Values
.Add(BoolNames
[False]);
4998 procedure TMainForm
.bApplyPropertyClick(Sender
: TObject
);
5000 _id
, a
, r
, c
: Integer;
5010 if SelectedObjectCount() <> 1 then
5012 if not SelectedObjects
[GetFirstSelected()].Live
then
5016 if not CheckProperty() then
5022 _id
:= GetFirstSelected();
5024 r
:= vleObjectProperty
.Row
;
5025 c
:= vleObjectProperty
.Col
;
5027 case SelectedObjects
[_id
].ObjectType
of
5030 with gPanels
[SelectedObjects
[_id
].ID
] do
5032 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5033 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5034 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5035 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5037 PanelType
:= GetPanelType(vleObjectProperty
.Values
[MsgPropPanelType
]);
5039 // Сброс ссылки на триггеры смены текстуры:
5040 if not WordBool(PanelType
and (PANEL_WALL
or PANEL_FORE
or PANEL_BACK
)) then
5041 if gTriggers
<> nil then
5042 for a
:= 0 to High(gTriggers
) do
5044 if (gTriggers
[a
].TriggerType
<> 0) and
5045 (gTriggers
[a
].TexturePanel
= Integer(SelectedObjects
[_id
].ID
)) then
5046 gTriggers
[a
].TexturePanel
:= -1;
5047 if (gTriggers
[a
].TriggerType
= TRIGGER_SHOT
) and
5048 (gTriggers
[a
].Data
.ShotPanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5049 gTriggers
[a
].Data
.ShotPanelID
:= -1;
5052 // Сброс ссылки на триггеры лифта:
5053 if not WordBool(PanelType
and (PANEL_LIFTUP
or PANEL_LIFTDOWN
or PANEL_LIFTLEFT
or PANEL_LIFTRIGHT
)) then
5054 if gTriggers
<> nil then
5055 for a
:= 0 to High(gTriggers
) do
5056 if (gTriggers
[a
].TriggerType
in [TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
]) and
5057 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5058 gTriggers
[a
].Data
.PanelID
:= -1;
5060 // Сброс ссылки на триггеры двери:
5061 if not WordBool(PanelType
and (PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) then
5062 if gTriggers
<> nil then
5063 for a
:= 0 to High(gTriggers
) do
5064 if (gTriggers
[a
].TriggerType
in [TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5065 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
]) and
5066 (gTriggers
[a
].Data
.PanelID
= Integer(SelectedObjects
[_id
].ID
)) then
5067 gTriggers
[a
].Data
.PanelID
:= -1;
5069 if IsTexturedPanel(PanelType
) then
5070 begin // Может быть текстура
5071 if TextureName
<> '' then
5072 begin // Была текстура
5073 Alpha
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropPanelAlpha
]));
5074 Blending
:= NameToBool(vleObjectProperty
.Values
[MsgPropPanelBlend
]);
5083 TextureName
:= vleObjectProperty
.Values
[MsgPropPanelTex
];
5085 if TextureName
<> '' then
5086 begin // Есть текстура
5087 // Обычная текстура:
5088 if not IsSpecialTexture(TextureName
) then
5090 g_GetTextureSizeByName(TextureName
,
5091 TextureWidth
, TextureHeight
);
5093 // Проверка кратности размеров панели:
5095 if TextureWidth
<> 0 then
5096 if gPanels
[SelectedObjects
[_id
].ID
].Width
mod TextureWidth
<> 0 then
5098 ErrorMessageBox(Format(MsgMsgWrongTexwidth
,
5102 if Res
and (TextureHeight
<> 0) then
5103 if gPanels
[SelectedObjects
[_id
].ID
].Height
mod TextureHeight
<> 0 then
5105 ErrorMessageBox(Format(MsgMsgWrongTexheight
,
5112 if not g_GetTexture(TextureName
, TextureID
) then
5113 // Не удалось загрузить текстуру, рисуем NOTEXTURE
5114 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5116 TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5117 g_GetTextureSizeByID(NoTextureID
, NW
, NH
);
5119 TextureHeight
:= NH
;
5122 TextureID
:= TEXTURE_SPECIAL_NONE
;
5132 TextureID
:= TEXTURE_SPECIAL_NONE
;
5135 else // Спец.текстура
5139 TextureID
:= SpecialTextureID(TextureName
);
5142 else // Нет текстуры
5146 TextureID
:= TEXTURE_SPECIAL_NONE
;
5149 else // Не может быть текстуры
5156 TextureID
:= TEXTURE_SPECIAL_NONE
;
5163 with gItems
[SelectedObjects
[_id
].ID
] do
5165 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5166 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5167 OnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5168 Fall
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5174 with gMonsters
[SelectedObjects
[_id
].ID
] do
5176 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5177 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5178 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5184 with gAreas
[SelectedObjects
[_id
].ID
] do
5186 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5187 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5188 Direction
:= NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]);
5194 with gTriggers
[SelectedObjects
[_id
].ID
] do
5196 X
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropX
]));
5197 Y
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropY
]));
5198 Width
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropWidth
]));
5199 Height
:= StrToInt(Trim(vleObjectProperty
.Values
[MsgPropHeight
]));
5200 Enabled
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrEnabled
]);
5201 ActivateType
:= StrToActivate(vleObjectProperty
.Values
[MsgPropTrActivation
]);
5202 Key
:= StrToKey(vleObjectProperty
.Values
[MsgPropTrKeys
]);
5207 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrNextMap
]);
5208 FillByte(Data
.MapName
[0], 16, 0);
5210 Move(s
[1], Data
.MapName
[0], Min(Length(s
), 16));
5215 Data
.ActivateOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureOnce
]);
5216 Data
.AnimOnce
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTextureAnimOnce
]);
5219 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5221 Data
.Wait
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 65535);
5222 Data
.Count
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExCount
], 0), 65535);
5223 if Data
.Count
< 1 then
5225 if TriggerType
= TRIGGER_PRESS
then
5226 Data
.ExtRandom
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrExRandom
]);
5229 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
, TRIGGER_DOOR5
,
5230 TRIGGER_CLOSETRAP
, TRIGGER_TRAP
, TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
,
5233 Data
.NoSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5234 Data
.d2d_doors
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5239 Data
.d2d_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrD2d
]);
5240 Data
.silent_teleport
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrTeleportSilent
]);
5241 Data
.TlpDir
:= NameToDirAdv(vleObjectProperty
.Values
[MsgPropTrTeleportDir
]);
5246 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrSoundName
]);
5247 FillByte(Data
.SoundName
[0], 64, 0);
5249 Move(s
[1], Data
.SoundName
[0], Min(Length(s
), 64));
5251 Data
.Volume
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundVolume
], 0), 255);
5252 Data
.Pan
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundPan
], 0), 255);
5253 Data
.PlayCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSoundCount
], 0), 255);
5254 Data
.Local
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundLocal
]);
5255 Data
.SoundSwitch
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSoundSwitch
]);
5258 TRIGGER_SPAWNMONSTER
:
5260 Data
.MonType
:= StrToMonster(vleObjectProperty
.Values
[MsgPropTrMonsterType
]);
5261 Data
.MonDir
:= Byte(NameToDir(vleObjectProperty
.Values
[MsgPropDirection
]));
5262 Data
.MonHealth
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 1000000);
5263 if Data
.MonHealth
< 0 then
5264 Data
.MonHealth
:= 0;
5265 Data
.MonActive
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrMonsterActive
]);
5266 Data
.MonCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5267 if Data
.MonCount
< 1 then
5269 Data
.MonEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5270 Data
.MonMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5271 Data
.MonDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5273 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour1
then
5275 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour2
then
5277 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour3
then
5279 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour4
then
5281 if vleObjectProperty
.Values
[MsgPropTrMonsterBehaviour
] = MsgPropTrMonsterBehaviour5
then
5287 Data
.ItemType
:= StrToItem(vleObjectProperty
.Values
[MsgPropTrItemType
]);
5288 Data
.ItemOnlyDM
:= NameToBool(vleObjectProperty
.Values
[MsgPropDmOnly
]);
5289 Data
.ItemFalls
:= NameToBool(vleObjectProperty
.Values
[MsgPropItemFalls
]);
5290 Data
.ItemCount
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 64);
5291 if Data
.ItemCount
< 1 then
5292 Data
.ItemCount
:= 1;
5293 Data
.ItemEffect
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrFxType
]);
5294 Data
.ItemMax
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnMax
], 0), 65535);
5295 Data
.ItemDelay
:= Min(StrToIntDef(vleObjectProperty
.Values
[MsgPropTrSpawnDelay
], 0), 65535);
5300 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMusicName
]);
5301 FillByte(Data
.MusicName
[0], 64, 0);
5303 Move(s
[1], Data
.MusicName
[0], Min(Length(s
), 64));
5305 if vleObjectProperty
.Values
[MsgPropTrMusicAct
] = MsgPropTrMusicOn
then
5306 Data
.MusicAction
:= 1
5308 Data
.MusicAction
:= 0;
5313 Data
.PushAngle
:= Min(
5314 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushAngle
], 0), 360);
5315 Data
.PushForce
:= Min(
5316 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrPushForce
], 0), 255);
5317 Data
.ResetVel
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrPushReset
]);
5322 Data
.ScoreAction
:= 0;
5323 if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct1
then
5324 Data
.ScoreAction
:= 1
5325 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct2
then
5326 Data
.ScoreAction
:= 2
5327 else if vleObjectProperty
.Values
[MsgPropTrScoreAct
] = MsgPropTrScoreAct3
then
5328 Data
.ScoreAction
:= 3;
5329 Data
.ScoreCount
:= Min(Max(
5330 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5331 Data
.ScoreTeam
:= 0;
5332 if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam1
then
5334 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam2
then
5336 else if vleObjectProperty
.Values
[MsgPropTrScoreTeam
] = MsgPropTrScoreTeam3
then
5337 Data
.ScoreTeam
:= 3;
5338 Data
.ScoreCon
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreCon
]);
5339 Data
.ScoreMsg
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrScoreMsg
]);
5344 Data
.MessageKind
:= 0;
5345 if vleObjectProperty
.Values
[MsgPropTrMessageKind
] = MsgPropTrMessageKind1
then
5346 Data
.MessageKind
:= 1;
5348 Data
.MessageSendTo
:= 0;
5349 if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo1
then
5350 Data
.MessageSendTo
:= 1
5351 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo2
then
5352 Data
.MessageSendTo
:= 2
5353 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo3
then
5354 Data
.MessageSendTo
:= 3
5355 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo4
then
5356 Data
.MessageSendTo
:= 4
5357 else if vleObjectProperty
.Values
[MsgPropTrMessageTo
] = MsgPropTrMessageTo5
then
5358 Data
.MessageSendTo
:= 5;
5360 s
:= utf2win(vleObjectProperty
.Values
[MsgPropTrMessageText
]);
5361 FillByte(Data
.MessageText
[0], 100, 0);
5363 Move(s
[1], Data
.MessageText
[0], Min(Length(s
), 100));
5365 Data
.MessageTime
:= Min(Max(
5366 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrMessageTime
], 0), 0), 65535);
5371 Data
.DamageValue
:= Min(Max(
5372 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrDamageValue
], 0), 0), 65535);
5373 Data
.DamageInterval
:= Min(Max(
5374 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5375 s
:= vleObjectProperty
.Values
[MsgPropTrDamageKind
];
5376 if s
= MsgPropTrDamageKind3
then
5377 Data
.DamageKind
:= 3
5378 else if s
= MsgPropTrDamageKind4
then
5379 Data
.DamageKind
:= 4
5380 else if s
= MsgPropTrDamageKind5
then
5381 Data
.DamageKind
:= 5
5382 else if s
= MsgPropTrDamageKind6
then
5383 Data
.DamageKind
:= 6
5384 else if s
= MsgPropTrDamageKind7
then
5385 Data
.DamageKind
:= 7
5386 else if s
= MsgPropTrDamageKind8
then
5387 Data
.DamageKind
:= 8
5389 Data
.DamageKind
:= 0;
5394 Data
.HealValue
:= Min(Max(
5395 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrHealth
], 0), 0), 65535);
5396 Data
.HealInterval
:= Min(Max(
5397 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrInterval
], 0), 0), 65535);
5398 Data
.HealMax
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrHealthMax
]);
5399 Data
.HealSilent
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrSilent
]);
5404 Data
.ShotType
:= StrToShot(vleObjectProperty
.Values
[MsgPropTrShotType
]);
5405 Data
.ShotSound
:= NameToBool(vleObjectProperty
.Values
[MsgPropTrShotSound
]);
5406 Data
.ShotTarget
:= 0;
5407 if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo1
then
5408 Data
.ShotTarget
:= 1
5409 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo2
then
5410 Data
.ShotTarget
:= 2
5411 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo3
then
5412 Data
.ShotTarget
:= 3
5413 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo4
then
5414 Data
.ShotTarget
:= 4
5415 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo5
then
5416 Data
.ShotTarget
:= 5
5417 else if vleObjectProperty
.Values
[MsgPropTrShotTo
] = MsgPropTrShotTo6
then
5418 Data
.ShotTarget
:= 6;
5419 Data
.ShotIntSight
:= Min(Max(
5420 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotSight
], 0), 0), 65535);
5422 if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim1
then
5424 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim2
then
5426 else if vleObjectProperty
.Values
[MsgPropTrShotAim
] = MsgPropTrShotAim3
then
5428 Data
.ShotAngle
:= Min(
5429 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAngle
], 0), 360);
5430 Data
.ShotWait
:= Min(Max(
5431 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5432 Data
.ShotAccuracy
:= Min(Max(
5433 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAcc
], 0), 0), 65535);
5434 Data
.ShotAmmo
:= Min(Max(
5435 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotAmmo
], 0), 0), 65535);
5436 Data
.ShotIntReload
:= Min(Max(
5437 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrShotReload
], 0), 0), 65535);
5442 Data
.FXCount
:= Min(Max(
5443 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrCount
], 0), 0), 255);
5444 if vleObjectProperty
.Values
[MsgPropTrEffectType
] = MsgPropTrEffectParticle
then
5446 Data
.FXType
:= TRIGGER_EFFECT_PARTICLE
;
5447 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
;
5448 if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSliquid
then
5449 Data
.FXSubType
:= TRIGGER_EFFECT_SLIQUID
5450 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectLliquid
then
5451 Data
.FXSubType
:= TRIGGER_EFFECT_LLIQUID
5452 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectDliquid
then
5453 Data
.FXSubType
:= TRIGGER_EFFECT_DLIQUID
5454 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBlood
then
5455 Data
.FXSubType
:= TRIGGER_EFFECT_BLOOD
5456 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectSpark
then
5457 Data
.FXSubType
:= TRIGGER_EFFECT_SPARK
5458 else if vleObjectProperty
.Values
[MsgPropTrEffectSubtype
] = MsgPropTrEffectBubble
then
5459 Data
.FXSubType
:= TRIGGER_EFFECT_BUBBLE
;
5462 Data
.FXType
:= TRIGGER_EFFECT_ANIMATION
;
5463 Data
.FXSubType
:= StrToEffect(vleObjectProperty
.Values
[MsgPropTrEffectSubtype
]);
5466 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectColor
], 0), 0), $FFFFFF);
5467 Data
.FXColorR
:= a
and $FF;
5468 Data
.FXColorG
:= (a
shr 8) and $FF;
5469 Data
.FXColorB
:= (a
shr 16) and $FF;
5470 if NameToBool(vleObjectProperty
.Values
[MsgPropTrEffectCenter
]) then
5474 Data
.FXWait
:= Min(Max(
5475 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrExDelay
], 0), 0), 65535);
5476 Data
.FXVelX
:= Min(Max(
5477 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVelx
], 0), -128), 127);
5478 Data
.FXVelY
:= Min(Max(
5479 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectVely
], 0), -128), 127);
5480 Data
.FXSpreadL
:= Min(Max(
5481 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpl
], 0), 0), 255);
5482 Data
.FXSpreadR
:= Min(Max(
5483 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpr
], 0), 0), 255);
5484 Data
.FXSpreadU
:= Min(Max(
5485 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpu
], 0), 0), 255);
5486 Data
.FXSpreadD
:= Min(Max(
5487 StrToIntDef(vleObjectProperty
.Values
[MsgPropTrEffectSpd
], 0), 0), 255);
5496 vleObjectProperty
.Row
:= r
;
5497 vleObjectProperty
.Col
:= c
;
5500 procedure TMainForm
.bbRemoveTextureClick(Sender
: TObject
);
5504 i
:= lbTextureList
.ItemIndex
;
5508 if Application
.MessageBox(PChar(Format(MsgMsgDelTexturePrompt
,
5509 [SelectedTexture()])),
5510 PChar(MsgMsgDelTexture
),
5511 MB_ICONQUESTION
or MB_YESNO
or
5512 MB_DEFBUTTON1
) <> idYes
then
5515 if gPanels
<> nil then
5516 for a
:= 0 to High(gPanels
) do
5517 if (gPanels
[a
].PanelType
<> 0) and
5518 (gPanels
[a
].TextureName
= SelectedTexture()) then
5520 ErrorMessageBox(MsgMsgDelTextureCant
);
5524 g_DeleteTexture(SelectedTexture());
5525 i
:= slInvalidTextures
.IndexOf(lbTextureList
.Items
[i
]);
5527 slInvalidTextures
.Delete(i
);
5528 if lbTextureList
.ItemIndex
> -1 then
5529 lbTextureList
.Items
.Delete(lbTextureList
.ItemIndex
)
5532 procedure TMainForm
.aNewMapExecute(Sender
: TObject
);
5534 if Application
.MessageBox(PChar(MsgMsgClearMapPrompt
), PChar(MsgMsgClearMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON1
) = mrYes
then
5538 procedure TMainForm
.aUndoExecute(Sender
: TObject
);
5542 if UndoBuffer
= nil then
5544 if UndoBuffer
[High(UndoBuffer
)] = nil then
5547 for a
:= 0 to High(UndoBuffer
[High(UndoBuffer
)]) do
5548 with UndoBuffer
[High(UndoBuffer
)][a
] do
5556 UNDO_DELETE_ITEM
: AddItem(Item
);
5557 UNDO_DELETE_AREA
: AddArea(Area
);
5558 UNDO_DELETE_MONSTER
: AddMonster(Monster
);
5559 UNDO_DELETE_TRIGGER
: AddTrigger(Trigger
);
5560 UNDO_ADD_PANEL
: RemoveObject(AddID
, OBJECT_PANEL
);
5561 UNDO_ADD_ITEM
: RemoveObject(AddID
, OBJECT_ITEM
);
5562 UNDO_ADD_AREA
: RemoveObject(AddID
, OBJECT_AREA
);
5563 UNDO_ADD_MONSTER
: RemoveObject(AddID
, OBJECT_MONSTER
);
5564 UNDO_ADD_TRIGGER
: RemoveObject(AddID
, OBJECT_TRIGGER
);
5568 SetLength(UndoBuffer
, Length(UndoBuffer
)-1);
5570 RemoveSelectFromObjects();
5572 miUndo
.Enabled
:= UndoBuffer
<> nil;
5576 procedure TMainForm
.aCopyObjectExecute(Sender
: TObject
);
5579 CopyBuffer
: TCopyRecArray
;
5583 function CB_Compare(I1
, I2
: TCopyRec
): Integer;
5585 Result
:= Integer(I1
.ObjectType
) - Integer(I2
.ObjectType
);
5587 if Result
= 0 then // Одного типа
5588 Result
:= Integer(I1
.ID
) - Integer(I2
.ID
);
5591 procedure QuickSortCopyBuffer(L
, R
: Integer);
5599 P
:= CopyBuffer
[(L
+ R
) shr 1];
5602 while CB_Compare(CopyBuffer
[I
], P
) < 0 do
5604 while CB_Compare(CopyBuffer
[J
], P
) > 0 do
5610 CopyBuffer
[I
] := CopyBuffer
[J
];
5618 QuickSortCopyBuffer(L
, J
);
5625 if SelectedObjects
= nil then
5631 // Копируем объекты:
5632 for a
:= 0 to High(SelectedObjects
) do
5633 if SelectedObjects
[a
].Live
then
5634 with SelectedObjects
[a
] do
5636 SetLength(CopyBuffer
, Length(CopyBuffer
)+1);
5637 b
:= High(CopyBuffer
);
5638 CopyBuffer
[b
].ID
:= ID
;
5639 CopyBuffer
[b
].Panel
:= nil;
5644 CopyBuffer
[b
].ObjectType
:= OBJECT_PANEL
;
5645 New(CopyBuffer
[b
].Panel
);
5646 CopyBuffer
[b
].Panel
^ := gPanels
[ID
];
5651 CopyBuffer
[b
].ObjectType
:= OBJECT_ITEM
;
5652 CopyBuffer
[b
].Item
:= gItems
[ID
];
5657 CopyBuffer
[b
].ObjectType
:= OBJECT_MONSTER
;
5658 CopyBuffer
[b
].Monster
:= gMonsters
[ID
];
5663 CopyBuffer
[b
].ObjectType
:= OBJECT_AREA
;
5664 CopyBuffer
[b
].Area
:= gAreas
[ID
];
5669 CopyBuffer
[b
].ObjectType
:= OBJECT_TRIGGER
;
5670 CopyBuffer
[b
].Trigger
:= gTriggers
[ID
];
5675 // Сортировка по ID:
5676 if CopyBuffer
<> nil then
5678 QuickSortCopyBuffer(0, b
);
5681 // Постановка ссылок триггеров:
5682 for a
:= 0 to Length(CopyBuffer
)-1 do
5683 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5685 case CopyBuffer
[a
].Trigger
.TriggerType
of
5686 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5687 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5688 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5689 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5693 for b
:= 0 to Length(CopyBuffer
)-1 do
5694 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5695 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.PanelID
) then
5697 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= b
;
5702 // Этих панелей нет среди копируемых:
5704 CopyBuffer
[a
].Trigger
.Data
.PanelID
:= -1;
5707 TRIGGER_PRESS
, TRIGGER_ON
,
5708 TRIGGER_OFF
, TRIGGER_ONOFF
:
5709 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5713 for b
:= 0 to Length(CopyBuffer
)-1 do
5714 if (CopyBuffer
[b
].ObjectType
= OBJECT_MONSTER
) and
5715 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1) then
5717 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= b
+1;
5722 // Этих монстров нет среди копируемых:
5724 CopyBuffer
[a
].Trigger
.Data
.MonsterID
:= 0;
5728 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5732 for b
:= 0 to Length(CopyBuffer
)-1 do
5733 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5734 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
) then
5736 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= b
;
5741 // Этих панелей нет среди копируемых:
5743 CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
:= -1;
5747 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5751 for b
:= 0 to Length(CopyBuffer
)-1 do
5752 if (CopyBuffer
[b
].ObjectType
= OBJECT_PANEL
) and
5753 (Integer(CopyBuffer
[b
].ID
) = CopyBuffer
[a
].Trigger
.TexturePanel
) then
5755 CopyBuffer
[a
].Trigger
.TexturePanel
:= b
;
5760 // Этих панелей нет среди копируемых:
5762 CopyBuffer
[a
].Trigger
.TexturePanel
:= -1;
5767 str
:= CopyBufferToString(CopyBuffer
);
5768 ClipBoard
.AsText
:= str
;
5770 for a
:= 0 to Length(CopyBuffer
)-1 do
5771 if (CopyBuffer
[a
].ObjectType
= OBJECT_PANEL
) and
5772 (CopyBuffer
[a
].Panel
<> nil) then
5773 Dispose(CopyBuffer
[a
].Panel
);
5778 procedure TMainForm
.aPasteObjectExecute(Sender
: TObject
);
5781 CopyBuffer
: TCopyRecArray
;
5783 swad
, ssec
, sres
: String;
5786 xadj
, yadj
: LongInt;
5791 pmin
.X
:= High(pmin
.X
);
5792 pmin
.Y
:= High(pmin
.Y
);
5794 StringToCopyBuffer(ClipBoard
.AsText
, CopyBuffer
, pmin
);
5795 if CopyBuffer
= nil then
5798 rel
:= not(ssShift
in GetKeyShiftState());
5799 h
:= High(CopyBuffer
);
5800 RemoveSelectFromObjects();
5803 pmin
.X
, pmin
.Y
, -MapOffset
.X
-32, -MapOffset
.Y
-32, RenderPanel
.Width
, RenderPanel
.Height
) then
5810 xadj
:= Floor((-pmin
.X
- MapOffset
.X
+ 32) / DotStep
) * DotStep
;
5811 yadj
:= Floor((-pmin
.Y
- MapOffset
.Y
+ 32) / DotStep
) * DotStep
;
5815 with CopyBuffer
[a
] do
5819 if Panel
<> nil then
5827 Panel
^.TextureID
:= TEXTURE_SPECIAL_NONE
;
5828 Panel
^.TextureWidth
:= 1;
5829 Panel
^.TextureHeight
:= 1;
5831 if (Panel
^.PanelType
= PANEL_LIFTUP
) or
5832 (Panel
^.PanelType
= PANEL_LIFTDOWN
) or
5833 (Panel
^.PanelType
= PANEL_LIFTLEFT
) or
5834 (Panel
^.PanelType
= PANEL_LIFTRIGHT
) or
5835 (Panel
^.PanelType
= PANEL_BLOCKMON
) or
5836 (Panel
^.TextureName
= '') then
5837 begin // Нет или не может быть текстуры:
5839 else // Есть текстура:
5841 // Обычная текстура:
5842 if not IsSpecialTexture(Panel
^.TextureName
) then
5844 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5848 g_ProcessResourceStr(Panel
^.TextureName
, swad
, ssec
, sres
);
5849 AddTexture(swad
, ssec
, sres
, True);
5850 res
:= g_GetTexture(Panel
^.TextureName
, Panel
^.TextureID
);
5854 g_GetTextureSizeByName(Panel
^.TextureName
,
5855 Panel
^.TextureWidth
, Panel
^.TextureHeight
)
5857 if g_GetTexture('NOTEXTURE', NoTextureID
) then
5859 Panel
^.TextureID
:= TEXTURE_SPECIAL_NOTEXTURE
;
5860 g_GetTextureSizeByID(NoTextureID
, Panel
^.TextureWidth
, Panel
^.TextureHeight
);
5863 else // Спец.текстура:
5865 Panel
^.TextureID
:= SpecialTextureID(Panel
^.TextureName
);
5866 with MainForm
.lbTextureList
.Items
do
5867 if IndexOf(Panel
^.TextureName
) = -1 then
5868 Add(Panel
^.TextureName
);
5872 ID
:= AddPanel(Panel
^);
5874 Undo_Add(OBJECT_PANEL
, ID
, a
> 0);
5875 SelectObject(OBJECT_PANEL
, ID
, True);
5886 ID
:= AddItem(Item
);
5887 Undo_Add(OBJECT_ITEM
, ID
, a
> 0);
5888 SelectObject(OBJECT_ITEM
, ID
, True);
5899 ID
:= AddMonster(Monster
);
5900 Undo_Add(OBJECT_MONSTER
, ID
, a
> 0);
5901 SelectObject(OBJECT_MONSTER
, ID
, True);
5912 ID
:= AddArea(Area
);
5913 Undo_Add(OBJECT_AREA
, ID
, a
> 0);
5914 SelectObject(OBJECT_AREA
, ID
, True);
5928 Data
.TargetPoint
.X
+= xadj
;
5929 Data
.TargetPoint
.Y
+= yadj
;
5931 TRIGGER_PRESS
, TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
:
5936 TRIGGER_SPAWNMONSTER
:
5938 Data
.MonPos
.X
+= xadj
;
5939 Data
.MonPos
.Y
+= yadj
;
5943 Data
.ItemPos
.X
+= xadj
;
5944 Data
.ItemPos
.Y
+= yadj
;
5948 Data
.ShotPos
.X
+= xadj
;
5949 Data
.ShotPos
.Y
+= yadj
;
5954 ID
:= AddTrigger(Trigger
);
5955 Undo_Add(OBJECT_TRIGGER
, ID
, a
> 0);
5956 SelectObject(OBJECT_TRIGGER
, ID
, True);
5961 // Переставляем ссылки триггеров:
5962 for a
:= 0 to High(CopyBuffer
) do
5963 if CopyBuffer
[a
].ObjectType
= OBJECT_TRIGGER
then
5965 case CopyBuffer
[a
].Trigger
.TriggerType
of
5966 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
5967 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
5968 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
5969 if CopyBuffer
[a
].Trigger
.Data
.PanelID
<> -1 then
5970 gTriggers
[CopyBuffer
[a
].ID
].Data
.PanelID
:=
5971 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.PanelID
].ID
;
5973 TRIGGER_PRESS
, TRIGGER_ON
,
5974 TRIGGER_OFF
, TRIGGER_ONOFF
:
5975 if CopyBuffer
[a
].Trigger
.Data
.MonsterID
<> 0 then
5976 gTriggers
[CopyBuffer
[a
].ID
].Data
.MonsterID
:=
5977 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.MonsterID
-1].ID
+1;
5980 if CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
<> -1 then
5981 gTriggers
[CopyBuffer
[a
].ID
].Data
.ShotPanelID
:=
5982 CopyBuffer
[CopyBuffer
[a
].Trigger
.Data
.ShotPanelID
].ID
;
5985 if CopyBuffer
[a
].Trigger
.TexturePanel
<> -1 then
5986 gTriggers
[CopyBuffer
[a
].ID
].TexturePanel
:=
5987 CopyBuffer
[CopyBuffer
[a
].Trigger
.TexturePanel
].ID
;
5996 procedure TMainForm
.aCutObjectExecute(Sender
: TObject
);
5999 DeleteSelectedObjects();
6002 procedure TMainForm
.vleObjectPropertyEditButtonClick(Sender
: TObject
);
6004 Key
, FileName
: String;
6007 Key
:= vleObjectProperty
.Keys
[vleObjectProperty
.Row
];
6009 if Key
= MsgPropPanelType
then
6011 with ChooseTypeForm
, vleObjectProperty
do
6012 begin // Выбор типа панели:
6013 Caption
:= MsgPropPanelType
;
6014 lbTypeSelect
.Items
.Clear();
6016 for b
:= 0 to High(PANELNAMES
) do
6018 lbTypeSelect
.Items
.Add(PANELNAMES
[b
]);
6019 if Values
[Key
] = PANELNAMES
[b
] then
6020 lbTypeSelect
.ItemIndex
:= b
;
6023 if ShowModal() = mrOK
then
6025 b
:= lbTypeSelect
.ItemIndex
;
6026 Values
[Key
] := PANELNAMES
[b
];
6027 vleObjectPropertyApply(Sender
);
6031 else if Key
= MsgPropTrTeleportTo
then
6032 SelectFlag
:= SELECTFLAG_TELEPORT
6033 else if Key
= MsgPropTrSpawnTo
then
6034 SelectFlag
:= SELECTFLAG_SPAWNPOINT
6035 else if (Key
= MsgPropTrDoorPanel
) or
6036 (Key
= MsgPropTrTrapPanel
) then
6037 SelectFlag
:= SELECTFLAG_DOOR
6038 else if Key
= MsgPropTrTexturePanel
then
6040 DrawPressRect
:= False;
6041 SelectFlag
:= SELECTFLAG_TEXTURE
;
6043 else if Key
= MsgPropTrShotPanel
then
6044 SelectFlag
:= SELECTFLAG_SHOTPANEL
6045 else if Key
= MsgPropTrLiftPanel
then
6046 SelectFlag
:= SELECTFLAG_LIFT
6047 else if key
= MsgPropTrExMonster
then
6048 SelectFlag
:= SELECTFLAG_MONSTER
6049 else if Key
= MsgPropTrExArea
then
6051 SelectFlag
:= SELECTFLAG_NONE
;
6052 DrawPressRect
:= True;
6054 else if Key
= MsgPropTrNextMap
then
6055 begin // Выбор следующей карты:
6056 g_ProcessResourceStr(OpenedMap
, @FileName
, nil, nil);
6057 SelectMapForm
.Caption
:= MsgCapSelect
;
6058 SelectMapForm
.GetMaps(FileName
);
6060 if SelectMapForm
.ShowModal() = mrOK
then
6062 vleObjectProperty
.Values
[Key
] := SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6063 vleObjectPropertyApply(Sender
);
6066 else if (Key
= MsgPropTrSoundName
) or
6067 (Key
= MsgPropTrMusicName
) then
6068 begin // Выбор файла звука/музыки:
6069 AddSoundForm
.OKFunction
:= nil;
6070 AddSoundForm
.lbResourcesList
.MultiSelect
:= False;
6071 AddSoundForm
.SetResource
:= vleObjectProperty
.Values
[Key
];
6073 if (AddSoundForm
.ShowModal() = mrOk
) then
6075 vleObjectProperty
.Values
[Key
] := AddSoundForm
.ResourceName
;
6076 vleObjectPropertyApply(Sender
);
6079 else if Key
= MsgPropTrActivation
then
6080 with ActivationTypeForm
, vleObjectProperty
do
6081 begin // Выбор типов активации:
6082 cbPlayerCollide
.Checked
:= Pos('PC', Values
[Key
]) > 0;
6083 cbMonsterCollide
.Checked
:= Pos('MC', Values
[Key
]) > 0;
6084 cbPlayerPress
.Checked
:= Pos('PP', Values
[Key
]) > 0;
6085 cbMonsterPress
.Checked
:= Pos('MP', Values
[Key
]) > 0;
6086 cbShot
.Checked
:= Pos('SH', Values
[Key
]) > 0;
6087 cbNoMonster
.Checked
:= Pos('NM', Values
[Key
]) > 0;
6089 if ShowModal() = mrOK
then
6092 if cbPlayerCollide
.Checked
then
6093 b
:= ACTIVATE_PLAYERCOLLIDE
;
6094 if cbMonsterCollide
.Checked
then
6095 b
:= b
or ACTIVATE_MONSTERCOLLIDE
;
6096 if cbPlayerPress
.Checked
then
6097 b
:= b
or ACTIVATE_PLAYERPRESS
;
6098 if cbMonsterPress
.Checked
then
6099 b
:= b
or ACTIVATE_MONSTERPRESS
;
6100 if cbShot
.Checked
then
6101 b
:= b
or ACTIVATE_SHOT
;
6102 if cbNoMonster
.Checked
then
6103 b
:= b
or ACTIVATE_NOMONSTER
;
6105 Values
[Key
] := ActivateToStr(b
);
6106 vleObjectPropertyApply(Sender
);
6109 else if Key
= MsgPropTrKeys
then
6110 with KeysForm
, vleObjectProperty
do
6111 begin // Выбор необходимых ключей:
6112 cbRedKey
.Checked
:= Pos('RK', Values
[Key
]) > 0;
6113 cbGreenKey
.Checked
:= Pos('GK', Values
[Key
]) > 0;
6114 cbBlueKey
.Checked
:= Pos('BK', Values
[Key
]) > 0;
6115 cbRedTeam
.Checked
:= Pos('RT', Values
[Key
]) > 0;
6116 cbBlueTeam
.Checked
:= Pos('BT', Values
[Key
]) > 0;
6118 if ShowModal() = mrOK
then
6121 if cbRedKey
.Checked
then
6123 if cbGreenKey
.Checked
then
6124 b
:= b
or KEY_GREEN
;
6125 if cbBlueKey
.Checked
then
6127 if cbRedTeam
.Checked
then
6128 b
:= b
or KEY_REDTEAM
;
6129 if cbBlueTeam
.Checked
then
6130 b
:= b
or KEY_BLUETEAM
;
6132 Values
[Key
] := KeyToStr(b
);
6133 vleObjectPropertyApply(Sender
);
6136 else if Key
= MsgPropTrFxType
then
6137 with ChooseTypeForm
, vleObjectProperty
do
6138 begin // Выбор типа эффекта:
6139 Caption
:= MsgCapFxType
;
6140 lbTypeSelect
.Items
.Clear();
6142 for b
:= EFFECT_NONE
to EFFECT_FIRE
do
6143 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6145 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]);
6147 if ShowModal() = mrOK
then
6149 b
:= lbTypeSelect
.ItemIndex
;
6150 Values
[Key
] := EffectToStr(b
);
6151 vleObjectPropertyApply(Sender
);
6154 else if Key
= MsgPropTrMonsterType
then
6155 with ChooseTypeForm
, vleObjectProperty
do
6156 begin // Выбор типа монстра:
6157 Caption
:= MsgCapMonsterType
;
6158 lbTypeSelect
.Items
.Clear();
6160 for b
:= MONSTER_DEMON
to MONSTER_MAN
do
6161 lbTypeSelect
.Items
.Add(MonsterToStr(b
));
6163 lbTypeSelect
.ItemIndex
:= StrToMonster(Values
[Key
]) - MONSTER_DEMON
;
6165 if ShowModal() = mrOK
then
6167 b
:= lbTypeSelect
.ItemIndex
+ MONSTER_DEMON
;
6168 Values
[Key
] := MonsterToStr(b
);
6169 vleObjectPropertyApply(Sender
);
6172 else if Key
= MsgPropTrItemType
then
6173 with ChooseTypeForm
, vleObjectProperty
do
6174 begin // Выбор типа предмета:
6175 Caption
:= MsgCapItemType
;
6176 lbTypeSelect
.Items
.Clear();
6178 for b
:= ITEM_MEDKIT_SMALL
to ITEM_KEY_BLUE
do
6179 lbTypeSelect
.Items
.Add(ItemToStr(b
));
6180 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_BOTTLE
));
6181 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_HELMET
));
6182 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_JETPACK
));
6183 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_INVIS
));
6184 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER
));
6185 lbTypeSelect
.Items
.Add(ItemToStr(ITEM_AMMO_FUELCAN
));
6187 b
:= StrToItem(Values
[Key
]);
6188 if b
>= ITEM_BOTTLE
then
6190 lbTypeSelect
.ItemIndex
:= b
- ITEM_MEDKIT_SMALL
;
6192 if ShowModal() = mrOK
then
6194 b
:= lbTypeSelect
.ItemIndex
+ ITEM_MEDKIT_SMALL
;
6195 if b
>= ITEM_WEAPON_KASTET
then
6197 Values
[Key
] := ItemToStr(b
);
6198 vleObjectPropertyApply(Sender
);
6201 else if Key
= MsgPropTrShotType
then
6202 with ChooseTypeForm
, vleObjectProperty
do
6203 begin // Выбор типа предмета:
6204 Caption
:= MsgPropTrShotType
;
6205 lbTypeSelect
.Items
.Clear();
6207 for b
:= TRIGGER_SHOT_PISTOL
to TRIGGER_SHOT_MAX
do
6208 lbTypeSelect
.Items
.Add(ShotToStr(b
));
6210 lbTypeSelect
.ItemIndex
:= StrToShot(Values
[Key
]);
6212 if ShowModal() = mrOK
then
6214 b
:= lbTypeSelect
.ItemIndex
;
6215 Values
[Key
] := ShotToStr(b
);
6216 vleObjectPropertyApply(Sender
);
6219 else if Key
= MsgPropTrEffectType
then
6220 with ChooseTypeForm
, vleObjectProperty
do
6221 begin // Выбор типа эффекта:
6222 Caption
:= MsgCapFxType
;
6223 lbTypeSelect
.Items
.Clear();
6225 lbTypeSelect
.Items
.Add(MsgPropTrEffectParticle
);
6226 lbTypeSelect
.Items
.Add(MsgPropTrEffectAnimation
);
6227 if Values
[Key
] = MsgPropTrEffectAnimation
then
6228 lbTypeSelect
.ItemIndex
:= 1
6230 lbTypeSelect
.ItemIndex
:= 0;
6232 if ShowModal() = mrOK
then
6234 b
:= lbTypeSelect
.ItemIndex
;
6236 Values
[Key
] := MsgPropTrEffectParticle
6238 Values
[Key
] := MsgPropTrEffectAnimation
;
6239 vleObjectPropertyApply(Sender
);
6242 else if Key
= MsgPropTrEffectSubtype
then
6243 with ChooseTypeForm
, vleObjectProperty
do
6244 begin // Выбор подтипа эффекта:
6245 Caption
:= MsgCapFxType
;
6246 lbTypeSelect
.Items
.Clear();
6248 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6250 for b
:= EFFECT_TELEPORT
to EFFECT_FIRE
do
6251 lbTypeSelect
.Items
.Add(EffectToStr(b
));
6253 lbTypeSelect
.ItemIndex
:= StrToEffect(Values
[Key
]) - 1;
6256 lbTypeSelect
.Items
.Add(MsgPropTrEffectSliquid
);
6257 lbTypeSelect
.Items
.Add(MsgPropTrEffectLliquid
);
6258 lbTypeSelect
.Items
.Add(MsgPropTrEffectDliquid
);
6259 lbTypeSelect
.Items
.Add(MsgPropTrEffectBlood
);
6260 lbTypeSelect
.Items
.Add(MsgPropTrEffectSpark
);
6261 lbTypeSelect
.Items
.Add(MsgPropTrEffectBubble
);
6262 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SLIQUID
;
6263 if Values
[Key
] = MsgPropTrEffectLliquid
then
6264 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_LLIQUID
;
6265 if Values
[Key
] = MsgPropTrEffectDliquid
then
6266 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_DLIQUID
;
6267 if Values
[Key
] = MsgPropTrEffectBlood
then
6268 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BLOOD
;
6269 if Values
[Key
] = MsgPropTrEffectSpark
then
6270 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_SPARK
;
6271 if Values
[Key
] = MsgPropTrEffectBubble
then
6272 lbTypeSelect
.ItemIndex
:= TRIGGER_EFFECT_BUBBLE
;
6275 if ShowModal() = mrOK
then
6277 b
:= lbTypeSelect
.ItemIndex
;
6279 if Values
[MsgPropTrEffectType
] = MsgPropTrEffectAnimation
then
6280 Values
[Key
] := EffectToStr(b
+ 1)
6282 Values
[Key
] := MsgPropTrEffectSliquid
;
6283 if b
= TRIGGER_EFFECT_LLIQUID
then
6284 Values
[Key
] := MsgPropTrEffectLliquid
;
6285 if b
= TRIGGER_EFFECT_DLIQUID
then
6286 Values
[Key
] := MsgPropTrEffectDliquid
;
6287 if b
= TRIGGER_EFFECT_BLOOD
then
6288 Values
[Key
] := MsgPropTrEffectBlood
;
6289 if b
= TRIGGER_EFFECT_SPARK
then
6290 Values
[Key
] := MsgPropTrEffectSpark
;
6291 if b
= TRIGGER_EFFECT_BUBBLE
then
6292 Values
[Key
] := MsgPropTrEffectBubble
;
6295 vleObjectPropertyApply(Sender
);
6298 else if Key
= MsgPropTrEffectColor
then
6299 with vleObjectProperty
do
6300 begin // Выбор цвета эффекта:
6301 ColorDialog
.Color
:= StrToIntDef(Values
[Key
], 0);
6302 if ColorDialog
.Execute
then
6304 Values
[Key
] := IntToStr(ColorDialog
.Color
);
6305 vleObjectPropertyApply(Sender
);
6308 else if Key
= MsgPropPanelTex
then
6309 begin // Смена текстуры:
6310 vleObjectProperty
.Values
[Key
] := SelectedTexture();
6311 vleObjectPropertyApply(Sender
);
6315 procedure TMainForm
.vleObjectPropertyApply(Sender
: TObject
);
6317 // hack to prevent empty ID in list
6318 RenderPanel
.SetFocus();
6319 bApplyProperty
.Click();
6320 vleObjectProperty
.SetFocus();
6323 procedure TMainForm
.aSaveMapExecute(Sender
: TObject
);
6325 FileName
, Section
, Res
: String;
6327 if OpenedMap
= '' then
6329 aSaveMapAsExecute(nil);
6333 g_ProcessResourceStr(OpenedMap
, FileName
, Section
, Res
);
6335 SaveMap(FileName
+':\'+Res
, '');
6338 procedure TMainForm
.aOpenMapExecute(Sender
: TObject
);
6340 OpenDialog
.Filter
:= MsgFileFilterAll
;
6342 if OpenDialog
.Execute() then
6344 OpenMapFile(OpenDialog
.FileName
);
6345 OpenDialog
.InitialDir
:= ExtractFileDir(OpenDialog
.FileName
);
6349 procedure TMainForm
.OpenMapFile(FileName
: String);
6351 if (Pos('.ini', LowerCase(ExtractFileName(FileName
))) > 0) then
6355 pLoadProgress
.Left
:= (RenderPanel
.Width
div 2)-(pLoadProgress
.Width
div 2);
6356 pLoadProgress
.Top
:= (RenderPanel
.Height
div 2)-(pLoadProgress
.Height
div 2);
6357 pLoadProgress
.Show();
6362 LoadMapOld(FileName
);
6364 MainForm
.Caption
:= Format('%s - %s', [FormCaption
, ExtractFileName(FileName
)]);
6366 pLoadProgress
.Hide();
6367 MainForm
.FormResize(Self
);
6369 else // Карты из WAD:
6371 OpenMap(FileName
, '');
6375 procedure TMainForm
.FormActivate(Sender
: TObject
);
6377 MainForm
.ActiveControl
:= RenderPanel
;
6380 procedure TMainForm
.aDeleteMap(Sender
: TObject
);
6388 OpenDialog
.Filter
:= MsgFileFilterWad
;
6390 if not OpenDialog
.Execute() then
6393 WAD
:= TWADEditor_1
.Create();
6395 if not WAD
.ReadFile(OpenDialog
.FileName
) then
6403 MapList
:= WAD
.GetResourcesList('');
6405 SelectMapForm
.Caption
:= MsgCapRemove
;
6406 SelectMapForm
.lbMapList
.Items
.Clear();
6408 if MapList
<> nil then
6409 for a
:= 0 to High(MapList
) do
6410 SelectMapForm
.lbMapList
.Items
.Add(win2utf(MapList
[a
]));
6412 if (SelectMapForm
.ShowModal() = mrOK
) then
6414 str
:= SelectMapForm
.lbMapList
.Items
[SelectMapForm
.lbMapList
.ItemIndex
];
6416 Move(str
[1], MapName
[0], Min(16, Length(str
)));
6418 if Application
.MessageBox(PChar(Format(MsgMsgDeleteMapPrompt
, [MapName
, OpenDialog
.FileName
])), PChar(MsgMsgDeleteMap
), MB_ICONQUESTION
or MB_YESNO
or MB_DEFBUTTON2
) <> mrYes
then
6421 WAD
.RemoveResource('', utf2win(MapName
));
6423 Application
.MessageBox(
6424 PChar(Format(MsgMsgMapDeletedPrompt
, [MapName
])),
6425 PChar(MsgMsgMapDeleted
),
6426 MB_ICONINFORMATION
or MB_OK
or MB_DEFBUTTON1
6429 WAD
.SaveTo(OpenDialog
.FileName
);
6431 // Удалили текущую карту - сохранять по старому ее нельзя:
6432 if OpenedMap
= (OpenDialog
.FileName
+':\'+MapName
) then
6436 MainForm
.Caption
:= FormCaption
;
6443 procedure TMainForm
.vleObjectPropertyKeyDown(Sender
: TObject
;
6444 var Key
: Word; Shift
: TShiftState
);
6446 if Key
= VK_RETURN
then
6447 vleObjectPropertyApply(Sender
);
6450 procedure MovePanel(var ID
: DWORD
; MoveType
: Byte);
6455 if (ID
= 0) and (MoveType
= 0) then
6457 if (ID
= DWORD(High(gPanels
))) and (MoveType
<> 0) then
6459 if (ID
> DWORD(High(gPanels
))) then
6464 if MoveType
= 0 then // to Back
6466 if gTriggers
<> nil then
6467 for a
:= 0 to High(gTriggers
) do
6468 with gTriggers
[a
] do
6470 if TriggerType
= TRIGGER_NONE
then
6473 if TexturePanel
= _id
then
6476 if (TexturePanel
>= 0) and (TexturePanel
< _id
) then
6480 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6481 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6482 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6483 if Data
.PanelID
= _id
then
6486 if (Data
.PanelID
>= 0) and (Data
.PanelID
< _id
) then
6490 if Data
.ShotPanelID
= _id
then
6491 Data
.ShotPanelID
:= 0
6493 if (Data
.ShotPanelID
>= 0) and (Data
.ShotPanelID
< _id
) then
6494 Inc(Data
.ShotPanelID
);
6498 tmp
:= gPanels
[_id
];
6500 for a
:= _id
downto 1 do
6501 gPanels
[a
] := gPanels
[a
-1];
6509 if gTriggers
<> nil then
6510 for a
:= 0 to High(gTriggers
) do
6511 with gTriggers
[a
] do
6513 if TriggerType
= TRIGGER_NONE
then
6516 if TexturePanel
= _id
then
6517 TexturePanel
:= High(gPanels
)
6519 if TexturePanel
> _id
then
6523 TRIGGER_OPENDOOR
, TRIGGER_CLOSEDOOR
, TRIGGER_DOOR
,
6524 TRIGGER_DOOR5
, TRIGGER_CLOSETRAP
, TRIGGER_TRAP
,
6525 TRIGGER_LIFTUP
, TRIGGER_LIFTDOWN
, TRIGGER_LIFT
:
6526 if Data
.PanelID
= _id
then
6527 Data
.PanelID
:= High(gPanels
)
6529 if Data
.PanelID
> _id
then
6533 if Data
.ShotPanelID
= _id
then
6534 Data
.ShotPanelID
:= High(gPanels
)
6536 if Data
.ShotPanelID
> _id
then
6537 Dec(Data
.ShotPanelID
);
6541 tmp
:= gPanels
[_id
];
6543 for a
:= _id
to High(gPanels
)-1 do
6544 gPanels
[a
] := gPanels
[a
+1];
6546 gPanels
[High(gPanels
)] := tmp
;
6548 ID
:= High(gPanels
);
6552 procedure TMainForm
.aMoveToBack(Sender
: TObject
);
6556 if SelectedObjects
= nil then
6559 for a
:= 0 to High(SelectedObjects
) do
6560 with SelectedObjects
[a
] do
6561 if Live
and (ObjectType
= OBJECT_PANEL
) then
6563 SelectedObjects
[0] := SelectedObjects
[a
];
6564 SetLength(SelectedObjects
, 1);
6571 procedure TMainForm
.aMoveToFore(Sender
: TObject
);
6575 if SelectedObjects
= nil then
6578 for a
:= 0 to High(SelectedObjects
) do
6579 with SelectedObjects
[a
] do
6580 if Live
and (ObjectType
= OBJECT_PANEL
) then
6582 SelectedObjects
[0] := SelectedObjects
[a
];
6583 SetLength(SelectedObjects
, 1);
6590 procedure TMainForm
.aSaveMapAsExecute(Sender
: TObject
);
6591 var i
, idx
: Integer; list
: TStringList
; fmt
: String;
6593 list
:= TStringList
.Create();
6595 // TODO: get loclized strings automatically from language files
6596 SaveDialog
.DefaultExt
:= '.dfz';
6597 SaveDialog
.FilterIndex
:= 1;
6598 SaveDialog
.Filter
:= '';
6599 gWADEditorFactory
.GetRegistredEditors(list
);
6600 for i
:= 0 to list
.Count
- 1 do
6602 if list
[i
] = 'DFZIP' then
6603 SaveDialog
.FilterIndex
:= i
+ 1;
6606 SaveDialog
.Filter
:= SaveDialog
.Filter
+ '|';
6608 if list
[i
] = 'DFWAD' then
6609 SaveDialog
.Filter
:= SaveDialog
.Filter
+ MsgFileFilterSaveDFWAD
6610 else if list
[i
] = 'DFZIP' then
6611 SaveDialog
.Filter
:= SaveDialog
.Filter
+ MsgFileFilterSaveDFZIP
6613 SaveDialog
.Filter
:= SaveDialog
.Filter
+ list
[i
] + '|*.*';
6616 if SaveDialog
.Execute() then
6618 i
:= SaveDialog
.FilterIndex
- 1;
6619 if (i
>= 0) and (i
< list
.Count
) then fmt
:= list
[i
] else fmt
:= '';
6621 SaveMapForm
.GetMaps(SaveDialog
.FileName
, True, fmt
);
6622 if SaveMapForm
.ShowModal() = mrOK
then
6624 SaveDialog
.InitialDir
:= ExtractFileDir(SaveDialog
.FileName
);
6625 OpenedMap
:= SaveDialog
.FileName
+':\'+SaveMapForm
.eMapName
.Text;
6626 OpenedWAD
:= SaveDialog
.FileName
;
6628 idx
:= RecentFiles
.IndexOf(OpenedMap
);
6629 // Такая карта уже недавно открывалась:
6631 RecentFiles
.Delete(idx
);
6632 RecentFiles
.Insert(0, OpenedMap
);
6635 SaveMap(OpenedMap
, fmt
);
6637 gMapInfo
.FileName
:= SaveDialog
.FileName
;
6638 gMapInfo
.MapName
:= SaveMapForm
.eMapName
.Text;
6639 UpdateCaption(gMapInfo
.Name
, ExtractFileName(gMapInfo
.FileName
), gMapInfo
.MapName
);
6646 procedure TMainForm
.aSelectAllExecute(Sender
: TObject
);
6650 RemoveSelectFromObjects();
6652 case pcObjects
.ActivePageIndex
+1 of
6654 if gPanels
<> nil then
6655 for a
:= 0 to High(gPanels
) do
6656 if gPanels
[a
].PanelType
<> PANEL_NONE
then
6657 SelectObject(OBJECT_PANEL
, a
, True);
6659 if gItems
<> nil then
6660 for a
:= 0 to High(gItems
) do
6661 if gItems
[a
].ItemType
<> ITEM_NONE
then
6662 SelectObject(OBJECT_ITEM
, a
, True);
6664 if gMonsters
<> nil then
6665 for a
:= 0 to High(gMonsters
) do
6666 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
6667 SelectObject(OBJECT_MONSTER
, a
, True);
6669 if gAreas
<> nil then
6670 for a
:= 0 to High(gAreas
) do
6671 if gAreas
[a
].AreaType
<> AREA_NONE
then
6672 SelectObject(OBJECT_AREA
, a
, True);
6674 if gTriggers
<> nil then
6675 for a
:= 0 to High(gTriggers
) do
6676 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
6677 SelectObject(OBJECT_TRIGGER
, a
, True);
6680 RecountSelectedObjects();
6683 procedure TMainForm
.tbGridOnClick(Sender
: TObject
);
6685 DotEnable
:= not DotEnable
;
6686 (Sender
as TToolButton
).Down
:= DotEnable
;
6689 procedure TMainForm
.OnIdle(Sender
: TObject
; var Done
: Boolean);
6692 // FIXME: this is a shitty hack
6693 if not gDataLoaded
then
6695 e_WriteLog('Init OpenGL', MSG_NOTIFY
);
6697 e_WriteLog('Loading data', MSG_NOTIFY
);
6698 LoadStdFont('STDTXT', 'STDFONT', gEditorFont
);
6699 e_WriteLog('Loading more data', MSG_NOTIFY
);
6701 e_WriteLog('Loading even more data', MSG_NOTIFY
);
6702 gDataLoaded
:= True;
6703 MainForm
.FormResize(nil);
6706 if StartMap
<> '' then
6714 procedure TMainForm
.miMapPreviewClick(Sender
: TObject
);
6716 if PreviewMode
= 2 then
6719 if PreviewMode
= 0 then
6721 Splitter2
.Visible
:= False;
6722 Splitter1
.Visible
:= False;
6723 StatusBar
.Visible
:= False;
6724 PanelObjs
.Visible
:= False;
6725 PanelProps
.Visible
:= False;
6726 MainToolBar
.Visible
:= False;
6727 sbHorizontal
.Visible
:= False;
6728 sbVertical
.Visible
:= False;
6732 StatusBar
.Visible
:= True;
6733 PanelObjs
.Visible
:= True;
6734 PanelProps
.Visible
:= True;
6735 Splitter2
.Visible
:= True;
6736 Splitter1
.Visible
:= True;
6737 MainToolBar
.Visible
:= True;
6738 sbHorizontal
.Visible
:= True;
6739 sbVertical
.Visible
:= True;
6742 PreviewMode
:= PreviewMode
xor 1;
6743 (Sender
as TMenuItem
).Checked
:= PreviewMode
> 0;
6748 procedure TMainForm
.miLayer1Click(Sender
: TObject
);
6750 SwitchLayer(LAYER_BACK
);
6753 procedure TMainForm
.miLayer2Click(Sender
: TObject
);
6755 SwitchLayer(LAYER_WALLS
);
6758 procedure TMainForm
.miLayer3Click(Sender
: TObject
);
6760 SwitchLayer(LAYER_FOREGROUND
);
6763 procedure TMainForm
.miLayer4Click(Sender
: TObject
);
6765 SwitchLayer(LAYER_STEPS
);
6768 procedure TMainForm
.miLayer5Click(Sender
: TObject
);
6770 SwitchLayer(LAYER_WATER
);
6773 procedure TMainForm
.miLayer6Click(Sender
: TObject
);
6775 SwitchLayer(LAYER_ITEMS
);
6778 procedure TMainForm
.miLayer7Click(Sender
: TObject
);
6780 SwitchLayer(LAYER_MONSTERS
);
6783 procedure TMainForm
.miLayer8Click(Sender
: TObject
);
6785 SwitchLayer(LAYER_AREAS
);
6788 procedure TMainForm
.miLayer9Click(Sender
: TObject
);
6790 SwitchLayer(LAYER_TRIGGERS
);
6793 procedure TMainForm
.tbShowClick(Sender
: TObject
);
6799 for a
:= 0 to High(LayerEnabled
) do
6800 b
:= b
and LayerEnabled
[a
];
6804 ShowLayer(LAYER_BACK
, b
);
6805 ShowLayer(LAYER_WALLS
, b
);
6806 ShowLayer(LAYER_FOREGROUND
, b
);
6807 ShowLayer(LAYER_STEPS
, b
);
6808 ShowLayer(LAYER_WATER
, b
);
6809 ShowLayer(LAYER_ITEMS
, b
);
6810 ShowLayer(LAYER_MONSTERS
, b
);
6811 ShowLayer(LAYER_AREAS
, b
);
6812 ShowLayer(LAYER_TRIGGERS
, b
);
6815 procedure TMainForm
.miMiniMapClick(Sender
: TObject
);
6820 procedure TMainForm
.miSwitchGridClick(Sender
: TObject
);
6822 if DotStep
= DotStepOne
then
6823 DotStep
:= DotStepTwo
6825 DotStep
:= DotStepOne
;
6827 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6828 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6831 procedure TMainForm
.miShowEdgesClick(Sender
: TObject
);
6836 procedure TMainForm
.miSnapToGridClick(Sender
: TObject
);
6838 SnapToGrid
:= not SnapToGrid
;
6840 MousePos
.X
:= (MousePos
.X
div DotStep
) * DotStep
;
6841 MousePos
.Y
:= (MousePos
.Y
div DotStep
) * DotStep
;
6843 miSnapToGrid
.Checked
:= SnapToGrid
;
6846 procedure TMainForm
.minexttabClick(Sender
: TObject
);
6848 if pcObjects
.ActivePageIndex
< pcObjects
.PageCount
-1 then
6849 pcObjects
.ActivePageIndex
:= pcObjects
.ActivePageIndex
+1
6851 pcObjects
.ActivePageIndex
:= 0;
6854 procedure TMainForm
.miSaveMiniMapClick(Sender
: TObject
);
6856 SaveMiniMapForm
.ShowModal();
6859 procedure TMainForm
.bClearTextureClick(Sender
: TObject
);
6861 lbTextureList
.ItemIndex
:= -1;
6862 lTextureWidth
.Caption
:= '';
6863 lTextureHeight
.Caption
:= '';
6866 procedure TMainForm
.miPackMapClick(Sender
: TObject
);
6868 PackMapForm
.ShowModal();
6871 type SSArray
= array of String;
6873 function ParseString (Str
: AnsiString): SSArray
;
6874 function GetStr (var Str
: AnsiString): AnsiString;
6878 if Str
[1] = '"' then
6879 for b
:= 1 to Length(Str
) do
6880 if (b
= Length(Str
)) or (Str
[b
+ 1] = '"') then
6882 Result
:= Copy(Str
, 2, b
- 1);
6883 Delete(Str
, 1, b
+ 1);
6887 for a
:= 1 to Length(Str
) do
6888 if (a
= Length(Str
)) or (Str
[a
+ 1] = ' ') then
6890 Result
:= Copy(Str
, 1, a
);
6891 Delete(Str
, 1, a
+ 1);
6901 SetLength(Result
, Length(Result
)+1);
6902 Result
[High(Result
)] := GetStr(Str
);
6906 procedure TMainForm
.miTestMapClick(Sender
: TObject
);
6908 newWAD
, oldWAD
, tempMap
, ext
: String;
6915 // Ignore while map testing in progress
6916 if MapTestProcess
<> nil then
6919 // Сохраняем временную карту:
6922 newWAD
:= Format('%s/temp%.4d', [MapsDir
, time
]);
6924 until not FileExists(newWAD
);
6925 if OpenedMap
<> '' then
6927 oldWad
:= g_ExtractWadName(OpenedMap
);
6928 newWad
:= newWad
+ ExtractFileExt(oldWad
);
6929 if CopyFile(oldWad
, newWad
) = false then
6930 e_WriteLog('MapTest: unable to copy [' + oldWad
+ '] to [' + newWad
+ ']', MSG_WARNING
)
6934 newWad
:= newWad
+ '.wad'
6936 tempMap
:= newWAD
+ ':\' + TEST_MAP_NAME
;
6937 SaveMap(tempMap
, '');
6941 if TestOptionsTwoPlayers
then
6943 if TestOptionsTeamDamage
then
6945 if TestOptionsAllowExit
then
6947 if TestOptionsWeaponStay
then
6949 if TestOptionsMonstersDM
then
6953 proc
:= TProcessUTF8
.Create(nil);
6954 proc
.Executable
:= TestD2dExe
;
6956 // TODO: get real executable name from Info.plist
6957 if LowerCase(ExtractFileExt(TestD2dExe
)) = '.app' then
6958 proc
.Executable
:= TestD2dExe
+ DirectorySeparator
+ 'Contents' + DirectorySeparator
+ 'MacOS' + DirectorySeparator
+ 'Doom2DF';
6960 proc
.Parameters
.Add('-map');
6961 proc
.Parameters
.Add(tempMap
);
6962 proc
.Parameters
.Add('-gm');
6963 proc
.Parameters
.Add(TestGameMode
);
6964 proc
.Parameters
.Add('-limt');
6965 proc
.Parameters
.Add(TestLimTime
);
6966 proc
.Parameters
.Add('-lims');
6967 proc
.Parameters
.Add(TestLimScore
);
6968 proc
.Parameters
.Add('-opt');
6969 proc
.Parameters
.Add(IntToStr(opt
));
6970 proc
.Parameters
.Add('--debug');
6972 proc
.Parameters
.Add('--close');
6974 args
:= ParseString(TestD2DArgs
);
6975 for i
:= 0 to High(args
) do
6976 proc
.Parameters
.Add(args
[i
]);
6986 tbTestMap
.Enabled
:= False;
6987 MapTestFile
:= newWAD
;
6988 MapTestProcess
:= proc
;
6992 Application
.MessageBox(PChar(MsgMsgExecError
), 'FIXME', MB_OK
or MB_ICONERROR
);
6993 SysUtils
.DeleteFile(newWAD
);
6998 procedure TMainForm
.sbVerticalScroll(Sender
: TObject
;
6999 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
7001 MapOffset
.Y
:= -sbVertical
.Position
;
7002 RenderPanel
.Invalidate
;
7005 procedure TMainForm
.sbHorizontalScroll(Sender
: TObject
;
7006 ScrollCode
: TScrollCode
; var ScrollPos
: Integer);
7008 MapOffset
.X
:= -sbHorizontal
.Position
;
7009 RenderPanel
.Invalidate
;
7012 procedure TMainForm
.miOpenWadMapClick(Sender
: TObject
);
7014 if OpenedWAD
<> '' then
7016 OpenMap(OpenedWAD
, '');
7020 procedure TMainForm
.selectall1Click(Sender
: TObject
);
7024 RemoveSelectFromObjects();
7026 if gPanels
<> nil then
7027 for a
:= 0 to High(gPanels
) do
7028 if gPanels
[a
].PanelType
<> PANEL_NONE
then
7029 SelectObject(OBJECT_PANEL
, a
, True);
7031 if gItems
<> nil then
7032 for a
:= 0 to High(gItems
) do
7033 if gItems
[a
].ItemType
<> ITEM_NONE
then
7034 SelectObject(OBJECT_ITEM
, a
, True);
7036 if gMonsters
<> nil then
7037 for a
:= 0 to High(gMonsters
) do
7038 if gMonsters
[a
].MonsterType
<> MONSTER_NONE
then
7039 SelectObject(OBJECT_MONSTER
, a
, True);
7041 if gAreas
<> nil then
7042 for a
:= 0 to High(gAreas
) do
7043 if gAreas
[a
].AreaType
<> AREA_NONE
then
7044 SelectObject(OBJECT_AREA
, a
, True);
7046 if gTriggers
<> nil then
7047 for a
:= 0 to High(gTriggers
) do
7048 if gTriggers
[a
].TriggerType
<> TRIGGER_NONE
then
7049 SelectObject(OBJECT_TRIGGER
, a
, True);
7051 RecountSelectedObjects();
7054 procedure TMainForm
.Splitter1CanResize(Sender
: TObject
;
7055 var NewSize
: Integer; var Accept
: Boolean);
7057 Accept
:= (NewSize
> 140);
7060 procedure TMainForm
.Splitter2CanResize(Sender
: TObject
;
7061 var NewSize
: Integer; var Accept
: Boolean);
7063 Accept
:= (NewSize
> 110);
7066 procedure TMainForm
.vleObjectPropertyEnter(Sender
: TObject
);
7068 EditingProperties
:= True;
7071 procedure TMainForm
.vleObjectPropertyExit(Sender
: TObject
);
7073 EditingProperties
:= False;
7076 procedure TMainForm
.FormKeyUp(Sender
: TObject
; var Key
: Word; Shift
: TShiftState
);
7078 // Объекты передвигались:
7079 if MainForm
.ActiveControl
= RenderPanel
then
7081 if (Key
= VK_NUMPAD4
) or
7082 (Key
= VK_NUMPAD6
) or
7083 (Key
= VK_NUMPAD8
) or
7084 (Key
= VK_NUMPAD5
) or
7085 (Key
= Ord('V')) then
7088 // Быстрое превью карты:
7089 if Key
= Ord('E') then
7091 if PreviewMode
= 2 then
7094 RenderPanelMouseMove(Sender
, Shift
, RenderMousePos().X
, RenderMousePos().Y
);