DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
get rid of "kastet" and "pulemet" in symbols
[d2df-editor.git] / src / editor / f_main.pas
1 unit f_main;
2
3 {$INCLUDE ../shared/a_modes.inc}
4
5 interface
6
7 uses
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;
12
13 type
14
15 { TMainForm }
16
17 TMainForm = class(TForm)
18 MapTestTimer: TTimer;
19 Splitter1: TSplitter;
20 Splitter2: TSplitter;
21 StatusBar: TStatusBar;
22 OpenDialog: TOpenDialog;
23 SaveDialog: TSaveDialog;
24 ColorDialog: TColorDialog;
25
26 // Menu:
27 MainMenu: TMainMenu;
28 ImageList: TImageList;
29 // Apple menu:
30 miApple: TMenuItem;
31 miAppleAbout: TMenuItem;
32 miAppleLine0: TMenuItem;
33 miApplePref: TMenuItem;
34 miAppleLine1: TMenuItem;
35 // File menu:
36 miMenuFile: TMenuItem;
37 miNewMap: TMenuItem;
38 miOpenMap: TMenuItem;
39 miMacRecentSubMenu: TMenuItem;
40 miMacRecentEnd: TMenuItem;
41 miMacRecentClear: TMenuItem;
42 Separator1: TMenuItem;
43 miSaveMap: TMenuItem;
44 miSaveMapAs: TMenuItem;
45 miOpenWadMap: TMenuItem;
46 miLine1: TMenuItem;
47 miReopenMap: TMenuItem;
48 miSaveMiniMap: TMenuItem;
49 miDeleteMap: TMenuItem;
50 miPackMap: TMenuItem;
51 miWinRecentStart: TMenuItem;
52 miWinRecent: TMenuItem;
53 miLine2: TMenuItem;
54 miExit: TMenuItem;
55 // Edit menu:
56 miMenuEdit: TMenuItem;
57 miUndo: TMenuItem;
58 miLine3: TMenuItem;
59 miCopy: TMenuItem;
60 miCut: TMenuItem;
61 miPaste: TMenuItem;
62 miLine4: TMenuItem;
63 miSelectAll: TMenuItem;
64 miLine5: TMenuItem;
65 miSnapToGrid: TMenuItem;
66 miSwitchGrid: TMenuItem;
67 Separator2: TMenuItem;
68 miToFore: TMenuItem;
69 miToBack: TMenuItem;
70 miLine6: TMenuItem;
71 miMapOptions: TMenuItem;
72 miOptions: TMenuItem;
73 // View menu:
74 miMenuView: TMenuItem;
75 miLayers: TMenuItem;
76 miLayer1: TMenuItem;
77 miLayer2: TMenuItem;
78 miLayer3: TMenuItem;
79 miLayer4: TMenuItem;
80 miLayer5: TMenuItem;
81 miLayer6: TMenuItem;
82 miLayer7: TMenuItem;
83 miLayer8: TMenuItem;
84 miLayer9: TMenuItem;
85 miViewLine1: TMenuItem;
86 miMiniMap: TMenuItem;
87 miShowEdges: TMenuItem;
88 miViewLine2: TMenuItem;
89 miMapPreview: TMenuItem;
90 // Service menu:
91 miMenuService: TMenuItem;
92 miCheckMap: TMenuItem;
93 miOptimmization: TMenuItem;
94 miTestMap: TMenuItem;
95 // Window menu:
96 miMenuWindow: TMenuItem;
97 miMacMinimize: TMenuItem;
98 miMacZoom: TMenuItem;
99 // Help Menu:
100 miMenuHelp: TMenuItem;
101 miAbout: TMenuItem;
102 // HIDDEN menu:
103 miMenuHidden: TMenuItem;
104 minexttab: TMenuItem;
105 selectall1: TMenuItem;
106
107 // Toolbar:
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;
117 tbShow: TToolButton;
118 pmShow: TPopupMenu;
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;
130 tbGrid: TToolButton;
131 tbLine4: TToolButton;
132 tbTestMap: TToolButton;
133
134 // Progress bar:
135 pLoadProgress: TPanel;
136 lLoad: TLabel;
137 pbLoad: TProgressBar;
138
139 // Map edit area:
140 PanelMap: TPanel;
141 RenderPanel: TOpenGLControl;
142 sbHorizontal: TScrollBar;
143 sbVertical: TScrollBar;
144
145 // Object propertiy editor:
146 PanelProps: TPanel;
147 PanelPropApply: TPanel;
148 bApplyProperty: TButton;
149 vleObjectProperty: TValueListEditor;
150
151 // Object palette:
152 PanelObjs: TPanel;
153 pcObjects: TPageControl;
154 // Panels Tab:
155 tsPanels: TTabSheet;
156 PanelPanelType: TPanel;
157 lbPanelType: TListBox;
158 lbTextureList: TListBox;
159 PanelTextures: TPanel;
160 LabelTxW: TLabel;
161 lTextureWidth: TLabel;
162 LabelTxH: TLabel;
163 lTextureHeight: TLabel;
164 cbPreview: TCheckBox;
165 bbAddTexture: TBitBtn;
166 bbRemoveTexture: TBitBtn;
167 bClearTexture: TButton;
168 // Items Tab:
169 tsItems: TTabSheet;
170 lbItemList: TListBox;
171 cbOnlyDM: TCheckBox;
172 cbFall: TCheckBox;
173 // Monsters Tab:
174 tsMonsters: TTabSheet;
175 lbMonsterList: TListBox;
176 rbMonsterLeft: TRadioButton;
177 rbMonsterRight: TRadioButton;
178 // Areas Tab:
179 tsAreas: TTabSheet;
180 lbAreasList: TListBox;
181 rbAreaLeft: TRadioButton;
182 rbAreaRight: TRadioButton;
183 // Triggers Tab:
184 tsTriggers: TTabSheet;
185 lbTriggersList: TListBox;
186 clbActivationType: TCheckListBox;
187 clbKeys: TCheckListBox;
188
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;
237 Shift: TShiftState);
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;
272 Shift: TShiftState);
273 private
274 LastDrawTime: UInt64;
275 procedure Draw();
276 procedure OnIdle(Sender: TObject; var Done: Boolean);
277 procedure RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString);
278 public
279 procedure RefreshRecentMenu();
280 procedure OpenMapFile(FileName: String);
281 function RenderMousePos(): TPoint;
282 procedure RecountSelectedObjects();
283 end;
284
285 const
286 LAYER_BACK = 0;
287 LAYER_WALLS = 1;
288 LAYER_FOREGROUND = 2;
289 LAYER_STEPS = 3;
290 LAYER_WATER = 4;
291 LAYER_ITEMS = 5;
292 LAYER_MONSTERS = 6;
293 LAYER_AREAS = 7;
294 LAYER_TRIGGERS = 8;
295
296 TEST_MAP_NAME = '$$$_TEST_$$$';
297 LANGUAGE_FILE_NAME = '_Editor.txt';
298
299 var
300 MainForm: TMainForm;
301 StartMap: String;
302 OpenedMap: String;
303 OpenedWAD: String;
304
305 DotColor: TColor;
306 DotEnable: Boolean;
307 DotStep: Word;
308 DotStepOne, DotStepTwo: Word;
309 DotSize: Byte;
310 DrawTexturePanel: Boolean;
311 DrawPanelSize: Boolean;
312 BackColor: TColor;
313 PreviewColor: TColor;
314 UseCheckerboard: Boolean;
315 Scale: Byte;
316 RecentCount: Integer;
317 RecentFiles: TStringList;
318 slInvalidTextures: TStringList;
319
320 TestGameMode: String;
321 TestLimTime: String;
322 TestLimScore: String;
323 TestOptionsTwoPlayers: Boolean;
324 TestOptionsTeamDamage: Boolean;
325 TestOptionsAllowExit: Boolean;
326 TestOptionsWeaponStay: Boolean;
327 TestOptionsMonstersDM: Boolean;
328 TestD2dExe, TestD2DArgs: String;
329 TestMapOnce: Boolean;
330
331 LayerEnabled: Array [LAYER_BACK..LAYER_TRIGGERS] of Boolean =
332 (True, True, True, True, True, True, True, True, True);
333 ContourEnabled: Array [LAYER_BACK..LAYER_TRIGGERS] of Boolean =
334 (False, False, False, False, False, False, False, False, False);
335 PreviewMode: Byte = 0;
336 gLanguage: String;
337
338 FormCaption: String;
339
340
341 procedure OpenMap(FileName: String; mapN: String);
342 function AddTexture(aWAD, aSection, aTex: String; silent: Boolean): Boolean;
343 procedure RemoveSelectFromObjects();
344 procedure ChangeShownProperty(Name: String; NewValue: String);
345
346 implementation
347
348 uses
349 f_options, e_graphics, e_log, GL, Math,
350 f_mapoptions, g_basic, f_about, f_mapoptimization,
351 f_mapcheck, f_addresource_texture, g_textures,
352 f_activationtype, f_keys, wadreader, fileutil,
353 MAPREADER, f_selectmap, f_savemap, WADEDITOR, WADSTRUCT, MAPDEF,
354 g_map, f_saveminimap, f_addresource, CONFIG, f_packmap,
355 f_addresource_sound, f_choosetype,
356 g_language, ClipBrd, g_options;
357
358 const
359 UNDO_DELETE_PANEL = 1;
360 UNDO_DELETE_ITEM = 2;
361 UNDO_DELETE_AREA = 3;
362 UNDO_DELETE_MONSTER = 4;
363 UNDO_DELETE_TRIGGER = 5;
364 UNDO_ADD_PANEL = 6;
365 UNDO_ADD_ITEM = 7;
366 UNDO_ADD_AREA = 8;
367 UNDO_ADD_MONSTER = 9;
368 UNDO_ADD_TRIGGER = 10;
369 UNDO_MOVE_PANEL = 11;
370 UNDO_MOVE_ITEM = 12;
371 UNDO_MOVE_AREA = 13;
372 UNDO_MOVE_MONSTER = 14;
373 UNDO_MOVE_TRIGGER = 15;
374 UNDO_RESIZE_PANEL = 16;
375 UNDO_RESIZE_TRIGGER = 17;
376
377 MOUSEACTION_NONE = 0;
378 MOUSEACTION_DRAWPANEL = 1;
379 MOUSEACTION_DRAWTRIGGER = 2;
380 MOUSEACTION_MOVEOBJ = 3;
381 MOUSEACTION_RESIZE = 4;
382 MOUSEACTION_MOVEMAP = 5;
383 MOUSEACTION_DRAWPRESS = 6;
384 MOUSEACTION_NOACTION = 7;
385
386 RESIZETYPE_NONE = 0;
387 RESIZETYPE_VERTICAL = 1;
388 RESIZETYPE_HORIZONTAL = 2;
389
390 RESIZEDIR_NONE = 0;
391 RESIZEDIR_DOWN = 1;
392 RESIZEDIR_UP = 2;
393 RESIZEDIR_RIGHT = 3;
394 RESIZEDIR_LEFT = 4;
395
396 SELECTFLAG_NONE = 0;
397 SELECTFLAG_TELEPORT = 1;
398 SELECTFLAG_DOOR = 2;
399 SELECTFLAG_TEXTURE = 3;
400 SELECTFLAG_LIFT = 4;
401 SELECTFLAG_MONSTER = 5;
402 SELECTFLAG_SPAWNPOINT = 6;
403 SELECTFLAG_SHOTPANEL = 7;
404 SELECTFLAG_SELECTED = 8;
405
406 RECENT_FILES_MENU_START = 12;
407
408 CLIPBOARD_SIG = 'DF:ED';
409
410 type
411 TUndoRec = record
412 case UndoType: Byte of
413 UNDO_DELETE_PANEL: (Panel: ^TPanel);
414 UNDO_DELETE_ITEM: (Item: TItem);
415 UNDO_DELETE_AREA: (Area: TArea);
416 UNDO_DELETE_MONSTER: (Monster: TMonster);
417 UNDO_DELETE_TRIGGER: (Trigger: TTrigger);
418 UNDO_ADD_PANEL,
419 UNDO_ADD_ITEM,
420 UNDO_ADD_AREA,
421 UNDO_ADD_MONSTER,
422 UNDO_ADD_TRIGGER: (AddID: DWORD);
423 UNDO_MOVE_PANEL,
424 UNDO_MOVE_ITEM,
425 UNDO_MOVE_AREA,
426 UNDO_MOVE_MONSTER,
427 UNDO_MOVE_TRIGGER: (MoveID: DWORD; dX, dY: Integer);
428 UNDO_RESIZE_PANEL,
429 UNDO_RESIZE_TRIGGER: (ResizeID: DWORD; dW, dH: Integer);
430 end;
431
432 TCopyRec = record
433 ID: Cardinal;
434 case ObjectType: Byte of
435 OBJECT_PANEL: (Panel: ^TPanel);
436 OBJECT_ITEM: (Item: TItem);
437 OBJECT_AREA: (Area: TArea);
438 OBJECT_MONSTER: (Monster: TMonster);
439 OBJECT_TRIGGER: (Trigger: TTrigger);
440 end;
441
442 TCopyRecArray = Array of TCopyRec;
443
444 var
445 gEditorFont: DWORD;
446 gDataLoaded: Boolean = False;
447 ShowMap: Boolean = False;
448 DrawRect: PRect = nil;
449 SnapToGrid: Boolean = True;
450
451 MousePos: Types.TPoint;
452 LastMovePoint: Types.TPoint;
453 MouseLDown: Boolean;
454 MouseRDown: Boolean;
455 MouseMDown: Boolean;
456 MouseLDownPos: Types.TPoint;
457 MouseRDownPos: Types.TPoint;
458 MouseMDownPos: Types.TPoint;
459
460 SelectFlag: Byte = SELECTFLAG_NONE;
461 MouseAction: Byte = MOUSEACTION_NONE;
462 ResizeType: Byte = RESIZETYPE_NONE;
463 ResizeDirection: Byte = RESIZEDIR_NONE;
464
465 DrawPressRect: Boolean = False;
466 EditingProperties: Boolean = False;
467
468 UndoBuffer: Array of Array of TUndoRec = nil;
469
470 MapTestProcess: TProcessUTF8;
471 MapTestFile: String;
472
473 {$R *.lfm}
474
475 //----------------------------------------
476 //Далее идут вспомогательные процедуры
477 //----------------------------------------
478
479 function NameToBool(Name: String): Boolean;
480 begin
481 if Name = BoolNames[True] then
482 Result := True
483 else
484 Result := False;
485 end;
486
487 function NameToDir(Name: String): TDirection;
488 begin
489 if Name = DirNames[D_LEFT] then
490 Result := D_LEFT
491 else
492 Result := D_RIGHT;
493 end;
494
495 function NameToDirAdv(Name: String): Byte;
496 begin
497 if Name = DirNamesAdv[1] then
498 Result := 1
499 else
500 if Name = DirNamesAdv[2] then
501 Result := 2
502 else
503 if Name = DirNamesAdv[3] then
504 Result := 3
505 else
506 Result := 0;
507 end;
508
509 function ActivateToStr(ActivateType: Byte): String;
510 begin
511 Result := '';
512
513 if ByteBool(ACTIVATE_PLAYERCOLLIDE and ActivateType) then
514 Result := Result + '+PC';
515 if ByteBool(ACTIVATE_MONSTERCOLLIDE and ActivateType) then
516 Result := Result + '+MC';
517 if ByteBool(ACTIVATE_PLAYERPRESS and ActivateType) then
518 Result := Result + '+PP';
519 if ByteBool(ACTIVATE_MONSTERPRESS and ActivateType) then
520 Result := Result + '+MP';
521 if ByteBool(ACTIVATE_SHOT and ActivateType) then
522 Result := Result + '+SH';
523 if ByteBool(ACTIVATE_NOMONSTER and ActivateType) then
524 Result := Result + '+NM';
525
526 if (Result <> '') and (Result[1] = '+') then
527 Delete(Result, 1, 1);
528 end;
529
530 function StrToActivate(Str: String): Byte;
531 begin
532 Result := 0;
533
534 if Pos('PC', Str) > 0 then
535 Result := ACTIVATE_PLAYERCOLLIDE;
536 if Pos('MC', Str) > 0 then
537 Result := Result or ACTIVATE_MONSTERCOLLIDE;
538 if Pos('PP', Str) > 0 then
539 Result := Result or ACTIVATE_PLAYERPRESS;
540 if Pos('MP', Str) > 0 then
541 Result := Result or ACTIVATE_MONSTERPRESS;
542 if Pos('SH', Str) > 0 then
543 Result := Result or ACTIVATE_SHOT;
544 if Pos('NM', Str) > 0 then
545 Result := Result or ACTIVATE_NOMONSTER;
546 end;
547
548 function KeyToStr(Key: Byte): String;
549 begin
550 Result := '';
551
552 if ByteBool(KEY_RED and Key) then
553 Result := Result + '+RK';
554 if ByteBool(KEY_GREEN and Key) then
555 Result := Result + '+GK';
556 if ByteBool(KEY_BLUE and Key) then
557 Result := Result + '+BK';
558 if ByteBool(KEY_REDTEAM and Key) then
559 Result := Result + '+RT';
560 if ByteBool(KEY_BLUETEAM and Key) then
561 Result := Result + '+BT';
562
563 if (Result <> '') and (Result[1] = '+') then
564 Delete(Result, 1, 1);
565 end;
566
567 function StrToKey(Str: String): Byte;
568 begin
569 Result := 0;
570
571 if Pos('RK', Str) > 0 then
572 Result := KEY_RED;
573 if Pos('GK', Str) > 0 then
574 Result := Result or KEY_GREEN;
575 if Pos('BK', Str) > 0 then
576 Result := Result or KEY_BLUE;
577 if Pos('RT', Str) > 0 then
578 Result := Result or KEY_REDTEAM;
579 if Pos('BT', Str) > 0 then
580 Result := Result or KEY_BLUETEAM;
581 end;
582
583 function EffectToStr(Effect: Byte): String;
584 begin
585 if Effect in [EFFECT_TELEPORT..EFFECT_FIRE] then
586 Result := EffectNames[Effect]
587 else
588 Result := EffectNames[EFFECT_NONE];
589 end;
590
591 function StrToEffect(Str: String): Byte;
592 var
593 i: Integer;
594 begin
595 Result := EFFECT_NONE;
596 for i := EFFECT_TELEPORT to EFFECT_FIRE do
597 if EffectNames[i] = Str then
598 begin
599 Result := i;
600 Exit;
601 end;
602 end;
603
604 function MonsterToStr(MonType: Byte): String;
605 begin
606 if MonType in [MONSTER_DEMON..MONSTER_MAN] then
607 Result := MonsterNames[MonType]
608 else
609 Result := MonsterNames[MONSTER_ZOMBY];
610 end;
611
612 function StrToMonster(Str: String): Byte;
613 var
614 i: Integer;
615 begin
616 Result := MONSTER_ZOMBY;
617 for i := MONSTER_DEMON to MONSTER_MAN do
618 if MonsterNames[i] = Str then
619 begin
620 Result := i;
621 Exit;
622 end;
623 end;
624
625 function ItemToStr(ItemType: Byte): String;
626 begin
627 if ItemType in [ITEM_MEDKIT_SMALL..ITEM_MAX] then
628 Result := ItemNames[ItemType]
629 else
630 Result := ItemNames[ITEM_AMMO_BULLETS];
631 end;
632
633 function StrToItem(Str: String): Byte;
634 var
635 i: Integer;
636 begin
637 Result := ITEM_AMMO_BULLETS;
638 for i := ITEM_MEDKIT_SMALL to ITEM_MAX do
639 if ItemNames[i] = Str then
640 begin
641 Result := i;
642 Exit;
643 end;
644 end;
645
646 function ShotToStr(ShotType: Byte): String;
647 begin
648 if ShotType in [TRIGGER_SHOT_PISTOL..TRIGGER_SHOT_MAX] then
649 Result := ShotNames[ShotType]
650 else
651 Result := ShotNames[TRIGGER_SHOT_PISTOL];
652 end;
653
654 function StrToShot(Str: String): Byte;
655 var
656 i: Integer;
657 begin
658 Result := TRIGGER_SHOT_PISTOL;
659 for i := TRIGGER_SHOT_PISTOL to TRIGGER_SHOT_MAX do
660 if ShotNames[i] = Str then
661 begin
662 Result := i;
663 Exit;
664 end;
665 end;
666
667 function SelectedObjectCount(): Word;
668 var
669 a: Integer;
670 begin
671 Result := 0;
672
673 if SelectedObjects = nil then
674 Exit;
675
676 for a := 0 to High(SelectedObjects) do
677 if SelectedObjects[a].Live then
678 Result := Result + 1;
679 end;
680
681 function GetFirstSelected(): Integer;
682 var
683 a: Integer;
684 begin
685 Result := -1;
686
687 if SelectedObjects = nil then
688 Exit;
689
690 for a := 0 to High(SelectedObjects) do
691 if SelectedObjects[a].Live then
692 begin
693 Result := a;
694 Exit;
695 end;
696 end;
697
698 function Normalize16(x: Integer): Integer;
699 begin
700 Result := (x div 16) * 16;
701 end;
702
703 procedure MoveMap(X, Y: Integer);
704 var
705 rx, ry, ScaleSz: Integer;
706 begin
707 with MainForm.RenderPanel do
708 begin
709 ScaleSz := 16 div Scale;
710 // Размер видимой части карты:
711 rx := Min(Normalize16(Width), Normalize16(gMapInfo.Width)) div 2;
712 ry := Min(Normalize16(Height), Normalize16(gMapInfo.Height)) div 2;
713 // Место клика на мини-карте:
714 MapOffset.X := X - (Width - Max(gMapInfo.Width div ScaleSz, 1) - 1);
715 MapOffset.Y := Y - 1;
716 // Это же место на "большой" карте:
717 MapOffset.X := MapOffset.X * ScaleSz;
718 MapOffset.Y := MapOffset.Y * ScaleSz;
719 // Левый верхний угол новой видимой части карты:
720 MapOffset.X := MapOffset.X - rx;
721 MapOffset.Y := MapOffset.Y - ry;
722 // Выход за границы:
723 MapOffset.X := EnsureRange(MapOffset.X, MainForm.sbHorizontal.Min, MainForm.sbHorizontal.Max);
724 MapOffset.Y := EnsureRange(MapOffset.Y, MainForm.sbVertical.Min, MainForm.sbVertical.Max);
725 // Кратно 16:
726 // MapOffset.X := Normalize16(MapOffset.X);
727 // MapOffset.Y := Normalize16(MapOffset.Y);
728 end;
729
730 MainForm.sbHorizontal.Position := MapOffset.X;
731 MainForm.sbVertical.Position := MapOffset.Y;
732
733 MapOffset.X := -MapOffset.X;
734 MapOffset.Y := -MapOffset.Y;
735
736 MainForm.Resize();
737 end;
738
739 function IsTexturedPanel(PanelType: Word): Boolean;
740 begin
741 Result := WordBool(PanelType and (PANEL_WALL or PANEL_BACK or PANEL_FORE or
742 PANEL_STEP or PANEL_OPENDOOR or PANEL_CLOSEDOOR or
743 PANEL_WATER or PANEL_ACID1 or PANEL_ACID2));
744 end;
745
746 procedure FillProperty();
747 var
748 _id: DWORD;
749 str: String;
750 begin
751 MainForm.vleObjectProperty.Strings.Clear();
752 MainForm.RecountSelectedObjects();
753
754 // Отображаем свойства если выделен только один объект:
755 if SelectedObjectCount() <> 1 then
756 Exit;
757
758 _id := GetFirstSelected();
759 if not SelectedObjects[_id].Live then
760 Exit;
761
762 with MainForm.vleObjectProperty do
763 with ItemProps[InsertRow(MsgPropId, IntToStr(SelectedObjects[_id].ID), True)] do
764 begin
765 EditStyle := esSimple;
766 ReadOnly := True;
767 end;
768
769 case SelectedObjects[0].ObjectType of
770 OBJECT_PANEL:
771 begin
772 with MainForm.vleObjectProperty,
773 gPanels[SelectedObjects[_id].ID] do
774 begin
775 with ItemProps[InsertRow(MsgPropX, IntToStr(X), True)] do
776 begin
777 EditStyle := esSimple;
778 MaxLength := 5;
779 end;
780
781 with ItemProps[InsertRow(MsgPropY, IntToStr(Y), True)] do
782 begin
783 EditStyle := esSimple;
784 MaxLength := 5;
785 end;
786
787 with ItemProps[InsertRow(MsgPropWidth, IntToStr(Width), True)] do
788 begin
789 EditStyle := esSimple;
790 MaxLength := 5;
791 end;
792
793 with ItemProps[InsertRow(MsgPropHeight, IntToStr(Height), True)] do
794 begin
795 EditStyle := esSimple;
796 MaxLength := 5;
797 end;
798
799 with ItemProps[InsertRow(MsgPropPanelType, GetPanelName(PanelType), True)] do
800 begin
801 EditStyle := esEllipsis;
802 ReadOnly := True;
803 end;
804
805 if IsTexturedPanel(PanelType) then
806 begin // Может быть текстура
807 with ItemProps[InsertRow(MsgPropPanelTex, TextureName, True)] do
808 begin
809 EditStyle := esEllipsis;
810 ReadOnly := True;
811 end;
812
813 if TextureName <> '' then
814 begin // Есть текстура
815 with ItemProps[InsertRow(MsgPropPanelAlpha, IntToStr(Alpha), True)] do
816 begin
817 EditStyle := esSimple;
818 MaxLength := 3;
819 end;
820
821 with ItemProps[InsertRow(MsgPropPanelBlend, BoolNames[Blending], True)] do
822 begin
823 EditStyle := esPickList;
824 ReadOnly := True;
825 end;
826 end;
827 end;
828 end;
829 end;
830
831 OBJECT_ITEM:
832 begin
833 with MainForm.vleObjectProperty,
834 gItems[SelectedObjects[_id].ID] do
835 begin
836 with ItemProps[InsertRow(MsgPropX, IntToStr(X), True)] do
837 begin
838 EditStyle := esSimple;
839 MaxLength := 5;
840 end;
841
842 with ItemProps[InsertRow(MsgPropY, IntToStr(Y), True)] do
843 begin
844 EditStyle := esSimple;
845 MaxLength := 5;
846 end;
847
848 with ItemProps[InsertRow(MsgPropDmOnly, BoolNames[OnlyDM], True)] do
849 begin
850 EditStyle := esPickList;
851 ReadOnly := True;
852 end;
853
854 with ItemProps[InsertRow(MsgPropItemFalls, BoolNames[Fall], True)] do
855 begin
856 EditStyle := esPickList;
857 ReadOnly := True;
858 end;
859 end;
860 end;
861
862 OBJECT_MONSTER:
863 begin
864 with MainForm.vleObjectProperty,
865 gMonsters[SelectedObjects[_id].ID] do
866 begin
867 with ItemProps[InsertRow(MsgPropX, IntToStr(X), True)] do
868 begin
869 EditStyle := esSimple;
870 MaxLength := 5;
871 end;
872
873 with ItemProps[InsertRow(MsgPropY, IntToStr(Y), True)] do
874 begin
875 EditStyle := esSimple;
876 MaxLength := 5;
877 end;
878
879 with ItemProps[InsertRow(MsgPropDirection, DirNames[Direction], True)] do
880 begin
881 EditStyle := esPickList;
882 ReadOnly := True;
883 end;
884 end;
885 end;
886
887 OBJECT_AREA:
888 begin
889 with MainForm.vleObjectProperty,
890 gAreas[SelectedObjects[_id].ID] do
891 begin
892 with ItemProps[InsertRow(MsgPropX, IntToStr(X), True)] do
893 begin
894 EditStyle := esSimple;
895 MaxLength := 5;
896 end;
897
898 with ItemProps[InsertRow(MsgPropY, IntToStr(Y), True)] do
899 begin
900 EditStyle := esSimple;
901 MaxLength := 5;
902 end;
903
904 with ItemProps[InsertRow(MsgPropDirection, DirNames[Direction], True)] do
905 begin
906 EditStyle := esPickList;
907 ReadOnly := True;
908 end;
909 end;
910 end;
911
912 OBJECT_TRIGGER:
913 begin
914 with MainForm.vleObjectProperty,
915 gTriggers[SelectedObjects[_id].ID] do
916 begin
917 with ItemProps[InsertRow(MsgPropTrType, GetTriggerName(TriggerType), True)] do
918 begin
919 EditStyle := esSimple;
920 ReadOnly := True;
921 end;
922
923 with ItemProps[InsertRow(MsgPropX, IntToStr(X), True)] do
924 begin
925 EditStyle := esSimple;
926 MaxLength := 5;
927 end;
928
929 with ItemProps[InsertRow(MsgPropY, IntToStr(Y), True)] do
930 begin
931 EditStyle := esSimple;
932 MaxLength := 5;
933 end;
934
935 with ItemProps[InsertRow(MsgPropWidth, IntToStr(Width), True)] do
936 begin
937 EditStyle := esSimple;
938 MaxLength := 5;
939 end;
940
941 with ItemProps[InsertRow(MsgPropHeight, IntToStr(Height), True)] do
942 begin
943 EditStyle := esSimple;
944 MaxLength := 5;
945 end;
946
947 with ItemProps[InsertRow(MsgPropTrEnabled, BoolNames[Enabled], True)] do
948 begin
949 EditStyle := esPickList;
950 ReadOnly := True;
951 end;
952
953 with ItemProps[InsertRow(MsgPropTrTexturePanel, IntToStr(TexturePanel), True)] do
954 begin
955 EditStyle := esEllipsis;
956 ReadOnly := True;
957 end;
958
959 with ItemProps[InsertRow(MsgPropTrActivation, ActivateToStr(ActivateType), True)] do
960 begin
961 EditStyle := esEllipsis;
962 ReadOnly := True;
963 end;
964
965 with ItemProps[InsertRow(MsgPropTrKeys, KeyToStr(Key), True)] do
966 begin
967 EditStyle := esEllipsis;
968 ReadOnly := True;
969 end;
970
971 case TriggerType of
972 TRIGGER_EXIT:
973 begin
974 str := win2utf(Data.MapName);
975 with ItemProps[InsertRow(MsgPropTrNextMap, str, True)] do
976 begin
977 EditStyle := esEllipsis;
978 ReadOnly := True;
979 end;
980 end;
981
982 TRIGGER_TELEPORT:
983 begin
984 with ItemProps[InsertRow(MsgPropTrTeleportTo, Format('(%d:%d)', [Data.TargetPoint.X, Data.TargetPoint.Y]), True)] do
985 begin
986 EditStyle := esEllipsis;
987 ReadOnly := True;
988 end;
989
990 with ItemProps[InsertRow(MsgPropTrD2d, BoolNames[Data.d2d_teleport], True)] do
991 begin
992 EditStyle := esPickList;
993 ReadOnly := True;
994 end;
995
996 with ItemProps[InsertRow(MsgPropTrTeleportSilent, BoolNames[Data.silent_teleport], True)] do
997 begin
998 EditStyle := esPickList;
999 ReadOnly := True;
1000 end;
1001
1002 with ItemProps[InsertRow(MsgPropTrTeleportDir, DirNamesAdv[Data.TlpDir], True)] do
1003 begin
1004 EditStyle := esPickList;
1005 ReadOnly := True;
1006 end;
1007 end;
1008
1009 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR,
1010 TRIGGER_DOOR, TRIGGER_DOOR5:
1011 begin
1012 with ItemProps[InsertRow(MsgPropTrDoorPanel, IntToStr(Data.PanelID), True)] do
1013 begin
1014 EditStyle := esEllipsis;
1015 ReadOnly := True;
1016 end;
1017
1018 with ItemProps[InsertRow(MsgPropTrSilent, BoolNames[Data.NoSound], True)] do
1019 begin
1020 EditStyle := esPickList;
1021 ReadOnly := True;
1022 end;
1023
1024 with ItemProps[InsertRow(MsgPropTrD2d, BoolNames[Data.d2d_doors], True)] do
1025 begin
1026 EditStyle := esPickList;
1027 ReadOnly := True;
1028 end;
1029 end;
1030
1031 TRIGGER_CLOSETRAP, TRIGGER_TRAP:
1032 begin
1033 with ItemProps[InsertRow(MsgPropTrTrapPanel, IntToStr(Data.PanelID), True)] do
1034 begin
1035 EditStyle := esEllipsis;
1036 ReadOnly := True;
1037 end;
1038
1039 with ItemProps[InsertRow(MsgPropTrSilent, BoolNames[Data.NoSound], True)] do
1040 begin
1041 EditStyle := esPickList;
1042 ReadOnly := True;
1043 end;
1044
1045 with ItemProps[InsertRow(MsgPropTrD2d, BoolNames[Data.d2d_doors], True)] do
1046 begin
1047 EditStyle := esPickList;
1048 ReadOnly := True;
1049 end;
1050 end;
1051
1052 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF,
1053 TRIGGER_ONOFF:
1054 begin
1055 with ItemProps[InsertRow(MsgPropTrExArea,
1056 Format('(%d:%d %d:%d)', [Data.tX, Data.tY, Data.tWidth, Data.tHeight]), True)] do
1057 begin
1058 EditStyle := esEllipsis;
1059 ReadOnly := True;
1060 end;
1061
1062 with ItemProps[InsertRow(MsgPropTrExDelay, IntToStr(Data.Wait), True)] do
1063 begin
1064 EditStyle := esSimple;
1065 MaxLength := 5;
1066 end;
1067
1068 with ItemProps[InsertRow(MsgPropTrExCount, IntToStr(Data.Count), True)] do
1069 begin
1070 EditStyle := esSimple;
1071 MaxLength := 5;
1072 end;
1073
1074 with ItemProps[InsertRow(MsgPropTrExMonster, IntToStr(Data.MonsterID-1), True)] do
1075 begin
1076 EditStyle := esEllipsis;
1077 ReadOnly := True;
1078 end;
1079
1080 if TriggerType = TRIGGER_PRESS then
1081 with ItemProps[InsertRow(MsgPropTrExRandom, BoolNames[Data.ExtRandom], True)] do
1082 begin
1083 EditStyle := esPickList;
1084 ReadOnly := True;
1085 end;
1086 end;
1087
1088 TRIGGER_SECRET:
1089 ;
1090
1091 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
1092 begin
1093 with ItemProps[InsertRow(MsgPropTrLiftPanel, IntToStr(Data.PanelID), True)] do
1094 begin
1095 EditStyle := esEllipsis;
1096 ReadOnly := True;
1097 end;
1098
1099 with ItemProps[InsertRow(MsgPropTrSilent, BoolNames[Data.NoSound], True)] do
1100 begin
1101 EditStyle := esPickList;
1102 ReadOnly := True;
1103 end;
1104
1105 with ItemProps[InsertRow(MsgPropTrD2d, BoolNames[Data.d2d_doors], True)] do
1106 begin
1107 EditStyle := esPickList;
1108 ReadOnly := True;
1109 end;
1110 end;
1111
1112 TRIGGER_TEXTURE:
1113 begin
1114 with ItemProps[InsertRow(MsgPropTrTextureOnce, BoolNames[Data.ActivateOnce], True)] do
1115 begin
1116 EditStyle := esPickList;
1117 ReadOnly := True;
1118 end;
1119
1120 with ItemProps[InsertRow(MsgPropTrTextureAnimOnce, BoolNames[Data.AnimOnce], True)] do
1121 begin
1122 EditStyle := esPickList;
1123 ReadOnly := True;
1124 end;
1125 end;
1126
1127 TRIGGER_SOUND:
1128 begin
1129 str := win2utf(Data.SoundName);
1130 with ItemProps[InsertRow(MsgPropTrSoundName, str, True)] do
1131 begin
1132 EditStyle := esEllipsis;
1133 ReadOnly := True;
1134 end;
1135
1136 with ItemProps[InsertRow(MsgPropTrSoundVolume, IntToStr(Data.Volume), True)] do
1137 begin
1138 EditStyle := esSimple;
1139 MaxLength := 3;
1140 end;
1141
1142 with ItemProps[InsertRow(MsgPropTrSoundPan, IntToStr(Data.Pan), True)] do
1143 begin
1144 EditStyle := esSimple;
1145 MaxLength := 3;
1146 end;
1147
1148 with ItemProps[InsertRow(MsgPropTrSoundCount, IntToStr(Data.PlayCount), True)] do
1149 begin
1150 EditStyle := esSimple;
1151 MaxLength := 3;
1152 end;
1153
1154 with ItemProps[InsertRow(MsgPropTrSoundLocal, BoolNames[Data.Local], True)] do
1155 begin
1156 EditStyle := esPickList;
1157 ReadOnly := True;
1158 end;
1159
1160 with ItemProps[InsertRow(MsgPropTrSoundSwitch, BoolNames[Data.SoundSwitch], True)] do
1161 begin
1162 EditStyle := esPickList;
1163 ReadOnly := True;
1164 end;
1165 end;
1166
1167 TRIGGER_SPAWNMONSTER:
1168 begin
1169 with ItemProps[InsertRow(MsgPropTrMonsterType, MonsterToStr(Data.MonType), True)] do
1170 begin
1171 EditStyle := esEllipsis;
1172 ReadOnly := True;
1173 end;
1174
1175 with ItemProps[InsertRow(MsgPropTrSpawnTo,
1176 Format('(%d:%d)', [Data.MonPos.X, Data.MonPos.Y]), True)] do
1177 begin
1178 EditStyle := esEllipsis;
1179 ReadOnly := True;
1180 end;
1181
1182 with ItemProps[InsertRow(MsgPropDirection, DirNames[TDirection(Data.MonDir)], True)] do
1183 begin
1184 EditStyle := esPickList;
1185 ReadOnly := True;
1186 end;
1187
1188 with ItemProps[InsertRow(MsgPropTrHealth, IntToStr(Data.MonHealth), True)] do
1189 begin
1190 EditStyle := esSimple;
1191 MaxLength := 5;
1192 end;
1193
1194 with ItemProps[InsertRow(MsgPropTrMonsterActive, BoolNames[Data.MonActive], True)] do
1195 begin
1196 EditStyle := esPickList;
1197 ReadOnly := True;
1198 end;
1199
1200 with ItemProps[InsertRow(MsgPropTrCount, IntToStr(Data.MonCount), True)] do
1201 begin
1202 EditStyle := esSimple;
1203 MaxLength := 5;
1204 end;
1205
1206 with ItemProps[InsertRow(MsgPropTrFxType, EffectToStr(Data.MonEffect), True)] do
1207 begin
1208 EditStyle := esEllipsis;
1209 ReadOnly := True;
1210 end;
1211
1212 with ItemProps[InsertRow(MsgPropTrSpawnMax, IntToStr(Data.MonMax), True)] do
1213 begin
1214 EditStyle := esSimple;
1215 MaxLength := 5;
1216 end;
1217
1218 with ItemProps[InsertRow(MsgPropTrSpawnDelay, IntToStr(Data.MonDelay), True)] do
1219 begin
1220 EditStyle := esSimple;
1221 MaxLength := 5;
1222 end;
1223
1224 case Data.MonBehav of
1225 1: str := MsgPropTrMonsterBehaviour1;
1226 2: str := MsgPropTrMonsterBehaviour2;
1227 3: str := MsgPropTrMonsterBehaviour3;
1228 4: str := MsgPropTrMonsterBehaviour4;
1229 5: str := MsgPropTrMonsterBehaviour5;
1230 else str := MsgPropTrMonsterBehaviour0;
1231 end;
1232 with ItemProps[InsertRow(MsgPropTrMonsterBehaviour, str, True)] do
1233 begin
1234 EditStyle := esPickList;
1235 ReadOnly := True;
1236 end;
1237 end;
1238
1239 TRIGGER_SPAWNITEM:
1240 begin
1241 with ItemProps[InsertRow(MsgPropTrItemType, ItemToStr(Data.ItemType), True)] do
1242 begin
1243 EditStyle := esEllipsis;
1244 ReadOnly := True;
1245 end;
1246
1247 with ItemProps[InsertRow(MsgPropTrSpawnTo,
1248 Format('(%d:%d)', [Data.ItemPos.X, Data.ItemPos.Y]), True)] do
1249 begin
1250 EditStyle := esEllipsis;
1251 ReadOnly := True;
1252 end;
1253
1254 with ItemProps[InsertRow(MsgPropDmOnly, BoolNames[Data.ItemOnlyDM], True)] do
1255 begin
1256 EditStyle := esPickList;
1257 ReadOnly := True;
1258 end;
1259
1260 with ItemProps[InsertRow(MsgPropItemFalls, BoolNames[Data.ItemFalls], True)] do
1261 begin
1262 EditStyle := esPickList;
1263 ReadOnly := True;
1264 end;
1265
1266 with ItemProps[InsertRow(MsgPropTrCount, IntToStr(Data.ItemCount), True)] do
1267 begin
1268 EditStyle := esSimple;
1269 MaxLength := 5;
1270 end;
1271
1272 with ItemProps[InsertRow(MsgPropTrFxType, EffectToStr(Data.ItemEffect), True)] do
1273 begin
1274 EditStyle := esEllipsis;
1275 ReadOnly := True;
1276 end;
1277
1278 with ItemProps[InsertRow(MsgPropTrSpawnMax, IntToStr(Data.ItemMax), True)] do
1279 begin
1280 EditStyle := esSimple;
1281 MaxLength := 5;
1282 end;
1283
1284 with ItemProps[InsertRow(MsgPropTrSpawnDelay, IntToStr(Data.ItemDelay), True)] do
1285 begin
1286 EditStyle := esSimple;
1287 MaxLength := 5;
1288 end;
1289 end;
1290
1291 TRIGGER_MUSIC:
1292 begin
1293 str := win2utf(Data.MusicName);
1294 with ItemProps[InsertRow(MsgPropTrMusicName, str, True)] do
1295 begin
1296 EditStyle := esEllipsis;
1297 ReadOnly := True;
1298 end;
1299
1300 if Data.MusicAction = 1 then
1301 str := MsgPropTrMusicOn
1302 else
1303 str := MsgPropTrMusicOff;
1304
1305 with ItemProps[InsertRow(MsgPropTrMusicAct, str, True)] do
1306 begin
1307 EditStyle := esPickList;
1308 ReadOnly := True;
1309 end;
1310 end;
1311
1312 TRIGGER_PUSH:
1313 begin
1314 with ItemProps[InsertRow(MsgPropTrPushAngle, IntToStr(Data.PushAngle), True)] do
1315 begin
1316 EditStyle := esSimple;
1317 MaxLength := 4;
1318 end;
1319 with ItemProps[InsertRow(MsgPropTrPushForce, IntToStr(Data.PushForce), True)] do
1320 begin
1321 EditStyle := esSimple;
1322 MaxLength := 4;
1323 end;
1324 with ItemProps[InsertRow(MsgPropTrPushReset, BoolNames[Data.ResetVel], True)] do
1325 begin
1326 EditStyle := esPickList;
1327 ReadOnly := True;
1328 end;
1329 end;
1330
1331 TRIGGER_SCORE:
1332 begin
1333 case Data.ScoreAction of
1334 1: str := MsgPropTrScoreAct1;
1335 2: str := MsgPropTrScoreAct2;
1336 3: str := MsgPropTrScoreAct3;
1337 else str := MsgPropTrScoreAct0;
1338 end;
1339 with ItemProps[InsertRow(MsgPropTrScoreAct, str, True)] do
1340 begin
1341 EditStyle := esPickList;
1342 ReadOnly := True;
1343 end;
1344 with ItemProps[InsertRow(MsgPropTrCount, IntToStr(Data.ScoreCount), True)] do
1345 begin
1346 EditStyle := esSimple;
1347 MaxLength := 3;
1348 end;
1349 case Data.ScoreTeam of
1350 1: str := MsgPropTrScoreTeam1;
1351 2: str := MsgPropTrScoreTeam2;
1352 3: str := MsgPropTrScoreTeam3;
1353 else str := MsgPropTrScoreTeam0;
1354 end;
1355 with ItemProps[InsertRow(MsgPropTrScoreTeam, str, True)] do
1356 begin
1357 EditStyle := esPickList;
1358 ReadOnly := True;
1359 end;
1360 with ItemProps[InsertRow(MsgPropTrScoreCon, BoolNames[Data.ScoreCon], True)] do
1361 begin
1362 EditStyle := esPickList;
1363 ReadOnly := True;
1364 end;
1365 with ItemProps[InsertRow(MsgPropTrScoreMsg, BoolNames[Data.ScoreMsg], True)] do
1366 begin
1367 EditStyle := esPickList;
1368 ReadOnly := True;
1369 end;
1370 end;
1371
1372 TRIGGER_MESSAGE:
1373 begin
1374 case Data.MessageKind of
1375 1: str := MsgPropTrMessageKind1;
1376 else str := MsgPropTrMessageKind0;
1377 end;
1378 with ItemProps[InsertRow(MsgPropTrMessageKind, str, True)] do
1379 begin
1380 EditStyle := esPickList;
1381 ReadOnly := True;
1382 end;
1383 case Data.MessageSendTo of
1384 1: str := MsgPropTrMessageTo1;
1385 2: str := MsgPropTrMessageTo2;
1386 3: str := MsgPropTrMessageTo3;
1387 4: str := MsgPropTrMessageTo4;
1388 5: str := MsgPropTrMessageTo5;
1389 else str := MsgPropTrMessageTo0;
1390 end;
1391 with ItemProps[InsertRow(MsgPropTrMessageTo, str, True)] do
1392 begin
1393 EditStyle := esPickList;
1394 ReadOnly := True;
1395 end;
1396 str := win2utf(Data.MessageText);
1397 with ItemProps[InsertRow(MsgPropTrMessageText, str, True)] do
1398 begin
1399 EditStyle := esSimple;
1400 MaxLength := 100;
1401 end;
1402 with ItemProps[InsertRow(MsgPropTrMessageTime, IntToStr(Data.MessageTime), True)] do
1403 begin
1404 EditStyle := esSimple;
1405 MaxLength := 5;
1406 end;
1407 end;
1408
1409 TRIGGER_DAMAGE:
1410 begin
1411 with ItemProps[InsertRow(MsgPropTrDamageValue, IntToStr(Data.DamageValue), True)] do
1412 begin
1413 EditStyle := esSimple;
1414 MaxLength := 5;
1415 end;
1416 with ItemProps[InsertRow(MsgPropTrInterval, IntToStr(Data.DamageInterval), True)] do
1417 begin
1418 EditStyle := esSimple;
1419 MaxLength := 5;
1420 end;
1421 case Data.DamageKind of
1422 3: str := MsgPropTrDamageKind3;
1423 4: str := MsgPropTrDamageKind4;
1424 5: str := MsgPropTrDamageKind5;
1425 6: str := MsgPropTrDamageKind6;
1426 7: str := MsgPropTrDamageKind7;
1427 8: str := MsgPropTrDamageKind8;
1428 else str := MsgPropTrDamageKind0;
1429 end;
1430 with ItemProps[InsertRow(MsgPropTrDamageKind, str, True)] do
1431 begin
1432 EditStyle := esPickList;
1433 ReadOnly := True;
1434 end;
1435 end;
1436
1437 TRIGGER_HEALTH:
1438 begin
1439 with ItemProps[InsertRow(MsgPropTrHealth, IntToStr(Data.HealValue), True)] do
1440 begin
1441 EditStyle := esSimple;
1442 MaxLength := 5;
1443 end;
1444 with ItemProps[InsertRow(MsgPropTrInterval, IntToStr(Data.HealInterval), True)] do
1445 begin
1446 EditStyle := esSimple;
1447 MaxLength := 5;
1448 end;
1449 with ItemProps[InsertRow(MsgPropTrHealthMax, BoolNames[Data.HealMax], True)] do
1450 begin
1451 EditStyle := esPickList;
1452 ReadOnly := True;
1453 end;
1454 with ItemProps[InsertRow(MsgPropTrSilent, BoolNames[Data.HealSilent], True)] do
1455 begin
1456 EditStyle := esPickList;
1457 ReadOnly := True;
1458 end;
1459 end;
1460
1461 TRIGGER_SHOT:
1462 begin
1463 with ItemProps[InsertRow(MsgPropTrShotType, ShotToStr(Data.ShotType), True)] do
1464 begin
1465 EditStyle := esEllipsis;
1466 ReadOnly := True;
1467 end;
1468
1469 with ItemProps[InsertRow(MsgPropTrShotSound, BoolNames[Data.ShotSound], True)] do
1470 begin
1471 EditStyle := esPickList;
1472 ReadOnly := True;
1473 end;
1474
1475 with ItemProps[InsertRow(MsgPropTrShotPanel, IntToStr(Data.ShotPanelID), True)] do
1476 begin
1477 EditStyle := esEllipsis;
1478 ReadOnly := True;
1479 end;
1480
1481 case Data.ShotTarget of
1482 1: str := MsgPropTrShotTo1;
1483 2: str := MsgPropTrShotTo2;
1484 3: str := MsgPropTrShotTo3;
1485 4: str := MsgPropTrShotTo4;
1486 5: str := MsgPropTrShotTo5;
1487 6: str := MsgPropTrShotTo6;
1488 else str := MsgPropTrShotTo0;
1489 end;
1490 with ItemProps[InsertRow(MsgPropTrShotTo, str, True)] do
1491 begin
1492 EditStyle := esPickList;
1493 ReadOnly := True;
1494 end;
1495
1496 with ItemProps[InsertRow(MsgPropTrShotSight, IntToStr(Data.ShotIntSight), True)] do
1497 begin
1498 EditStyle := esSimple;
1499 MaxLength := 3;
1500 end;
1501
1502 case Data.ShotAim of
1503 1: str := MsgPropTrShotAim1;
1504 2: str := MsgPropTrShotAim2;
1505 3: str := MsgPropTrShotAim3;
1506 else str := MsgPropTrShotAim0;
1507 end;
1508 with ItemProps[InsertRow(MsgPropTrShotAim, str, True)] do
1509 begin
1510 EditStyle := esPickList;
1511 ReadOnly := True;
1512 end;
1513
1514 with ItemProps[InsertRow(MsgPropTrSpawnTo,
1515 Format('(%d:%d)', [Data.ShotPos.X, Data.ShotPos.Y]), True)] do
1516 begin
1517 EditStyle := esEllipsis;
1518 ReadOnly := True;
1519 end;
1520
1521 with ItemProps[InsertRow(MsgPropTrShotAngle, IntToStr(Data.ShotAngle), True)] do
1522 begin
1523 EditStyle := esSimple;
1524 MaxLength := 4;
1525 end;
1526
1527 with ItemProps[InsertRow(MsgPropTrExDelay, IntToStr(Data.ShotWait), True)] do
1528 begin
1529 EditStyle := esSimple;
1530 MaxLength := 5;
1531 end;
1532
1533 with ItemProps[InsertRow(MsgPropTrShotAcc, IntToStr(Data.ShotAccuracy), True)] do
1534 begin
1535 EditStyle := esSimple;
1536 MaxLength := 5;
1537 end;
1538
1539 with ItemProps[InsertRow(MsgPropTrShotAmmo, IntToStr(Data.ShotAmmo), True)] do
1540 begin
1541 EditStyle := esSimple;
1542 MaxLength := 5;
1543 end;
1544
1545 with ItemProps[InsertRow(MsgPropTrShotReload, IntToStr(Data.ShotIntReload), True)] do
1546 begin
1547 EditStyle := esSimple;
1548 MaxLength := 4;
1549 end;
1550 end;
1551
1552 TRIGGER_EFFECT:
1553 begin
1554 with ItemProps[InsertRow(MsgPropTrCount, IntToStr(Data.FXCount), True)] do
1555 begin
1556 EditStyle := esSimple;
1557 MaxLength := 3;
1558 end;
1559
1560 if Data.FXType = 0 then
1561 str := MsgPropTrEffectParticle
1562 else
1563 str := MsgPropTrEffectAnimation;
1564 with ItemProps[InsertRow(MsgPropTrEffectType, str, True)] do
1565 begin
1566 EditStyle := esEllipsis;
1567 ReadOnly := True;
1568 end;
1569
1570 str := '';
1571 if Data.FXType = 0 then
1572 case Data.FXSubType of
1573 TRIGGER_EFFECT_SLIQUID:
1574 str := MsgPropTrEffectSliquid;
1575 TRIGGER_EFFECT_LLIQUID:
1576 str := MsgPropTrEffectLliquid;
1577 TRIGGER_EFFECT_DLIQUID:
1578 str := MsgPropTrEffectDliquid;
1579 TRIGGER_EFFECT_BLOOD:
1580 str := MsgPropTrEffectBlood;
1581 TRIGGER_EFFECT_SPARK:
1582 str := MsgPropTrEffectSpark;
1583 TRIGGER_EFFECT_BUBBLE:
1584 str := MsgPropTrEffectBubble;
1585 end;
1586 if Data.FXType = 1 then
1587 begin
1588 if (Data.FXSubType = 0) or (Data.FXSubType > EFFECT_FIRE) then
1589 Data.FXSubType := EFFECT_TELEPORT;
1590 str := EffectToStr(Data.FXSubType);
1591 end;
1592 with ItemProps[InsertRow(MsgPropTrEffectSubtype, str, True)] do
1593 begin
1594 EditStyle := esEllipsis;
1595 ReadOnly := True;
1596 end;
1597
1598 with ItemProps[InsertRow(MsgPropTrEffectColor, IntToStr(Data.FXColorR or (Data.FXColorG shl 8) or (Data.FXColorB shl 16)), True)] do
1599 begin
1600 EditStyle := esEllipsis;
1601 ReadOnly := True;
1602 end;
1603
1604 with ItemProps[InsertRow(MsgPropTrEffectCenter, BoolNames[Data.FXPos = 0], True)] do
1605 begin
1606 EditStyle := esPickList;
1607 ReadOnly := True;
1608 end;
1609
1610 with ItemProps[InsertRow(MsgPropTrExDelay, IntToStr(Data.FXWait), True)] do
1611 begin
1612 EditStyle := esSimple;
1613 MaxLength := 5;
1614 end;
1615
1616 with ItemProps[InsertRow(MsgPropTrEffectVelx, IntToStr(Data.FXVelX), True)] do
1617 begin
1618 EditStyle := esSimple;
1619 MaxLength := 4;
1620 end;
1621
1622 with ItemProps[InsertRow(MsgPropTrEffectVely, IntToStr(Data.FXVelY), True)] do
1623 begin
1624 EditStyle := esSimple;
1625 MaxLength := 4;
1626 end;
1627
1628 with ItemProps[InsertRow(MsgPropTrEffectSpl, IntToStr(Data.FXSpreadL), True)] do
1629 begin
1630 EditStyle := esSimple;
1631 MaxLength := 3;
1632 end;
1633
1634 with ItemProps[InsertRow(MsgPropTrEffectSpr, IntToStr(Data.FXSpreadR), True)] do
1635 begin
1636 EditStyle := esSimple;
1637 MaxLength := 3;
1638 end;
1639
1640 with ItemProps[InsertRow(MsgPropTrEffectSpu, IntToStr(Data.FXSpreadU), True)] do
1641 begin
1642 EditStyle := esSimple;
1643 MaxLength := 3;
1644 end;
1645
1646 with ItemProps[InsertRow(MsgPropTrEffectSpd, IntToStr(Data.FXSpreadD), True)] do
1647 begin
1648 EditStyle := esSimple;
1649 MaxLength := 3;
1650 end;
1651 end;
1652 end; //case TriggerType
1653 end;
1654 end; // OBJECT_TRIGGER:
1655 end;
1656 end;
1657
1658 procedure ChangeShownProperty(Name: String; NewValue: String);
1659 var
1660 row: Integer;
1661 begin
1662 if SelectedObjectCount() <> 1 then
1663 Exit;
1664 if not SelectedObjects[GetFirstSelected()].Live then
1665 Exit;
1666
1667 // Есть ли такой ключ:
1668 if MainForm.vleObjectProperty.FindRow(Name, row) then
1669 begin
1670 MainForm.vleObjectProperty.Values[Name] := NewValue;
1671 end;
1672 end;
1673
1674 procedure SelectObject(fObjectType: Byte; fID: DWORD; Multi: Boolean);
1675 var
1676 a: Integer;
1677 b: Boolean;
1678 begin
1679 if Multi then
1680 begin
1681 b := False;
1682
1683 // Уже выделен - убираем:
1684 if SelectedObjects <> nil then
1685 for a := 0 to High(SelectedObjects) do
1686 with SelectedObjects[a] do
1687 if Live and (ID = fID) and
1688 (ObjectType = fObjectType) then
1689 begin
1690 Live := False;
1691 b := True;
1692 end;
1693
1694 if b then
1695 Exit;
1696
1697 SetLength(SelectedObjects, Length(SelectedObjects)+1);
1698
1699 with SelectedObjects[High(SelectedObjects)] do
1700 begin
1701 ObjectType := fObjectType;
1702 ID := fID;
1703 Live := True;
1704 end;
1705 end
1706 else // not Multi
1707 begin
1708 SetLength(SelectedObjects, 1);
1709
1710 with SelectedObjects[0] do
1711 begin
1712 ObjectType := fObjectType;
1713 ID := fID;
1714 Live := True;
1715 end;
1716 end;
1717
1718 MainForm.miCopy.Enabled := True;
1719 MainForm.miCut.Enabled := True;
1720
1721 if fObjectType = OBJECT_PANEL then
1722 begin
1723 MainForm.miToFore.Enabled := True;
1724 MainForm.miToBack.Enabled := True;
1725 end;
1726 end;
1727
1728 procedure RemoveSelectFromObjects();
1729 begin
1730 SelectedObjects := nil;
1731 DrawPressRect := False;
1732 MouseLDown := False;
1733 MouseRDown := False;
1734 MouseAction := MOUSEACTION_NONE;
1735 SelectFlag := SELECTFLAG_NONE;
1736 ResizeType := RESIZETYPE_NONE;
1737 ResizeDirection := RESIZEDIR_NONE;
1738
1739 MainForm.vleObjectProperty.Strings.Clear();
1740
1741 MainForm.miCopy.Enabled := False;
1742 MainForm.miCut.Enabled := False;
1743 MainForm.miToFore.Enabled := False;
1744 MainForm.miToBack.Enabled := False;
1745 end;
1746
1747 procedure DeleteSelectedObjects();
1748 var
1749 i, a, ii: Integer;
1750 b: Boolean;
1751 begin
1752 if SelectedObjects = nil then
1753 Exit;
1754
1755 b := False;
1756 i := 0;
1757
1758 for a := 0 to High(SelectedObjects) do
1759 with SelectedObjects[a] do
1760 if Live then
1761 begin
1762 if not b then
1763 begin
1764 SetLength(UndoBuffer, Length(UndoBuffer)+1);
1765 i := High(UndoBuffer);
1766 b := True;
1767 end;
1768
1769 SetLength(UndoBuffer[i], Length(UndoBuffer[i])+1);
1770 ii := High(UndoBuffer[i]);
1771
1772 case ObjectType of
1773 OBJECT_PANEL:
1774 begin
1775 UndoBuffer[i, ii].UndoType := UNDO_DELETE_PANEL;
1776 New(UndoBuffer[i, ii].Panel);
1777 UndoBuffer[i, ii].Panel^ := gPanels[ID];
1778 end;
1779 OBJECT_ITEM:
1780 begin
1781 UndoBuffer[i, ii].UndoType := UNDO_DELETE_ITEM;
1782 UndoBuffer[i, ii].Item := gItems[ID];
1783 end;
1784 OBJECT_AREA:
1785 begin
1786 UndoBuffer[i, ii].UndoType := UNDO_DELETE_AREA;
1787 UndoBuffer[i, ii].Area := gAreas[ID];
1788 end;
1789 OBJECT_TRIGGER:
1790 begin
1791 UndoBuffer[i, ii].UndoType := UNDO_DELETE_TRIGGER;
1792 UndoBuffer[i, ii].Trigger := gTriggers[ID];
1793 end;
1794 end;
1795
1796 RemoveObject(ID, ObjectType);
1797 end;
1798
1799 RemoveSelectFromObjects();
1800
1801 MainForm.miUndo.Enabled := UndoBuffer <> nil;
1802 MainForm.RecountSelectedObjects();
1803 end;
1804
1805 procedure Undo_Add(ObjectType: Byte; ID: DWORD; Group: Boolean = False);
1806 var
1807 i, ii: Integer;
1808 begin
1809 if (not Group) or (Length(UndoBuffer) = 0) then
1810 SetLength(UndoBuffer, Length(UndoBuffer)+1);
1811 SetLength(UndoBuffer[High(UndoBuffer)], Length(UndoBuffer[High(UndoBuffer)])+1);
1812 i := High(UndoBuffer);
1813 ii := High(UndoBuffer[i]);
1814
1815 case ObjectType of
1816 OBJECT_PANEL:
1817 UndoBuffer[i, ii].UndoType := UNDO_ADD_PANEL;
1818 OBJECT_ITEM:
1819 UndoBuffer[i, ii].UndoType := UNDO_ADD_ITEM;
1820 OBJECT_MONSTER:
1821 UndoBuffer[i, ii].UndoType := UNDO_ADD_MONSTER;
1822 OBJECT_AREA:
1823 UndoBuffer[i, ii].UndoType := UNDO_ADD_AREA;
1824 OBJECT_TRIGGER:
1825 UndoBuffer[i, ii].UndoType := UNDO_ADD_TRIGGER;
1826 end;
1827
1828 UndoBuffer[i, ii].AddID := ID;
1829 MainForm.miUndo.Enabled := UndoBuffer <> nil;
1830 end;
1831
1832 procedure DiscardUndoBuffer();
1833 var
1834 i, k: Integer;
1835 begin
1836 for i := 0 to High(UndoBuffer) do
1837 for k := 0 to High(UndoBuffer[i]) do
1838 with UndoBuffer[i][k] do
1839 if UndoType = UNDO_DELETE_PANEL then
1840 Dispose(Panel);
1841
1842 UndoBuffer := nil;
1843 end;
1844
1845 procedure FullClear();
1846 begin
1847 RemoveSelectFromObjects();
1848 ClearMap();
1849 LoadSky(gMapInfo.SkyName);
1850 DiscardUndoBuffer();
1851 slInvalidTextures.Clear();
1852 MapCheckForm.lbErrorList.Clear();
1853 MapCheckForm.mErrorDescription.Clear();
1854
1855 MainForm.miUndo.Enabled := False;
1856 MainForm.sbHorizontal.Position := 0;
1857 MainForm.sbVertical.Position := 0;
1858 MainForm.FormResize(nil);
1859 MainForm.Caption := FormCaption;
1860 OpenedMap := '';
1861 OpenedWAD := '';
1862 end;
1863
1864 procedure ErrorMessageBox(str: String);
1865 begin
1866 Application.MessageBox(PChar(str), PChar(MsgMsgError),
1867 MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
1868 end;
1869
1870 function CheckProperty(): Boolean;
1871 var
1872 _id: Integer;
1873 begin
1874 Result := False;
1875
1876 _id := GetFirstSelected();
1877
1878 if SelectedObjects[_id].ObjectType = OBJECT_PANEL then
1879 with gPanels[SelectedObjects[_id].ID] do
1880 begin
1881 if TextureWidth <> 0 then
1882 if StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropWidth], 1) mod TextureWidth <> 0 then
1883 begin
1884 ErrorMessageBox(Format(MsgMsgWrongTexwidth,
1885 [TextureWidth]));
1886 Exit;
1887 end;
1888
1889 if TextureHeight <> 0 then
1890 if StrToIntDef(Trim(MainForm.vleObjectProperty.Values[MsgPropHeight]), 1) mod TextureHeight <> 0 then
1891 begin
1892 ErrorMessageBox(Format(MsgMsgWrongTexheight,
1893 [TextureHeight]));
1894 Exit;
1895 end;
1896
1897 if IsTexturedPanel(PanelType) and (TextureName <> '') then
1898 if not (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropPanelAlpha], -1) in [0..255]) then
1899 begin
1900 ErrorMessageBox(MsgMsgWrongAlpha);
1901 Exit;
1902 end;
1903 end;
1904
1905 if SelectedObjects[_id].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
1906 if (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropWidth], 0) <= 0) or
1907 (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropHeight], 0) <= 0) then
1908 begin
1909 ErrorMessageBox(MsgMsgWrongSize);
1910 Exit;
1911 end;
1912
1913 if (Trim(MainForm.vleObjectProperty.Values[MsgPropX]) = '') or
1914 (Trim(MainForm.vleObjectProperty.Values[MsgPropY]) = '') then
1915 begin
1916 ErrorMessageBox(MsgMsgWrongXy);
1917 Exit;
1918 end;
1919
1920 Result := True;
1921 end;
1922
1923 procedure SelectTexture(ID: Integer);
1924 begin
1925 MainForm.lbTextureList.ItemIndex := ID;
1926 MainForm.lbTextureListClick(nil);
1927 end;
1928
1929 function AddTexture(aWAD, aSection, aTex: String; silent: Boolean): Boolean;
1930 var
1931 a, FrameLen: Integer;
1932 ok: Boolean;
1933 FileName: String;
1934 ResourceName: String;
1935 FullResourceName: String;
1936 SectionName: String;
1937 Data: Pointer;
1938 Width, Height: Word;
1939 fn: String;
1940 begin
1941 Data := nil;
1942 FrameLen := 0;
1943 Width := 0;
1944 Height := 0;
1945
1946 if aSection = '..' then
1947 SectionName := ''
1948 else
1949 SectionName := aSection;
1950
1951 if aWAD = '' then
1952 aWAD := MsgWadSpecialMap;
1953
1954 if aWAD = MsgWadSpecialMap then
1955 begin // Файл карты
1956 g_ProcessResourceStr(OpenedMap, @fn, nil, nil);
1957 FileName := fn;
1958 ResourceName := ':'+SectionName+'\'+aTex;
1959 end
1960 else
1961 if aWAD = MsgWadSpecialTexs then
1962 begin // Спец. текстуры
1963 FileName := '';
1964 ResourceName := aTex;
1965 end
1966 else
1967 begin // Внешний WAD
1968 FileName := WadsDir + DirectorySeparator + aWAD;
1969 ResourceName := aWAD+':'+SectionName+'\'+aTex;
1970 end;
1971
1972 ok := True;
1973
1974 // Есть ли уже такая текстура:
1975 for a := 0 to MainForm.lbTextureList.Items.Count-1 do
1976 if ResourceName = MainForm.lbTextureList.Items[a] then
1977 begin
1978 if not silent then
1979 ErrorMessageBox(Format(MsgMsgTextureAlready,
1980 [ResourceName]));
1981 ok := False;
1982 end;
1983
1984 // Название ресурса <= 64 символов:
1985 if Length(ResourceName) > 64 then
1986 begin
1987 if not silent then
1988 ErrorMessageBox(Format(MsgMsgResName64,
1989 [ResourceName]));
1990 ok := False;
1991 end;
1992
1993 if ok then
1994 begin
1995 a := -1;
1996 if aWAD = MsgWadSpecialTexs then
1997 begin
1998 a := MainForm.lbTextureList.Items.Add(ResourceName);
1999 if not silent then
2000 SelectTexture(a);
2001 Result := True;
2002 Exit;
2003 end;
2004
2005 FullResourceName := FileName+':'+SectionName+'\'+aTex;
2006
2007 if IsAnim(FullResourceName) then
2008 begin // Аним. текстура
2009 GetFrame(FullResourceName, Data, FrameLen, Width, Height);
2010
2011 if not g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then
2012 ok := False;
2013 a := MainForm.lbTextureList.Items.Add(ResourceName);
2014 end
2015 else // Обычная текстура
2016 begin
2017 if not g_CreateTextureWAD(ResourceName, FullResourceName) then
2018 ok := False;
2019 a := MainForm.lbTextureList.Items.Add(ResourceName);
2020 end;
2021 if (not ok) and (slInvalidTextures.IndexOf(ResourceName) = -1) then
2022 begin
2023 slInvalidTextures.Add(ResourceName);
2024 ok := True;
2025 end;
2026 if (a > -1) and (not silent) then
2027 SelectTexture(a);
2028 end;
2029
2030 Result := ok;
2031 end;
2032
2033 procedure UpdateCaption(sMap, sFile, sRes: String);
2034 begin
2035 with MainForm do
2036 if (sFile = '') and (sRes = '') and (sMap = '') then
2037 Caption := FormCaption
2038 else
2039 if sMap = '' then
2040 Caption := Format('%s - %s:%s', [FormCaption, sFile, sRes])
2041 else
2042 if (sFile <> '') and (sRes <> '') then
2043 Caption := Format('%s - %s (%s:%s)', [FormCaption, sMap, sFile, sRes])
2044 else
2045 Caption := Format('%s - %s', [FormCaption, sMap]);
2046 end;
2047
2048 procedure OpenMap(FileName: String; mapN: String);
2049 var
2050 MapName: String;
2051 idx: Integer;
2052 begin
2053 SelectMapForm.Caption := MsgCapOpen;
2054 SelectMapForm.GetMaps(FileName);
2055
2056 if (FileName = OpenedWAD) and
2057 (OpenedMap <> '') then
2058 begin
2059 MapName := OpenedMap;
2060 while (Pos(':\', MapName) > 0) do
2061 Delete(MapName, 1, Pos(':\', MapName) + 1);
2062
2063 idx := SelectMapForm.lbMapList.Items.IndexOf(MapName);
2064 SelectMapForm.lbMapList.ItemIndex := idx;
2065 end
2066 else
2067 if SelectMapForm.lbMapList.Count > 0 then
2068 SelectMapForm.lbMapList.ItemIndex := 0
2069 else
2070 SelectMapForm.lbMapList.ItemIndex := -1;
2071
2072 if mapN = '' then
2073 idx := -1
2074 else
2075 idx := SelectMapForm.lbMapList.Items.IndexOf(mapN);
2076
2077 if idx < 0 then
2078 begin
2079 if (SelectMapForm.ShowModal() = mrOK) and
2080 (SelectMapForm.lbMapList.ItemIndex <> -1) then
2081 idx := SelectMapForm.lbMapList.ItemIndex
2082 else
2083 Exit;
2084 end;
2085
2086 MapName := SelectMapForm.lbMapList.Items[idx];
2087
2088 with MainForm do
2089 begin
2090 FullClear();
2091
2092 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
2093 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
2094 pLoadProgress.Show();
2095
2096 OpenedMap := FileName+':\'+MapName;
2097 OpenedWAD := FileName;
2098
2099 idx := RecentFiles.IndexOf(OpenedMap);
2100 // Такая карта уже недавно открывалась:
2101 if idx >= 0 then
2102 RecentFiles.Delete(idx);
2103 RecentFiles.Insert(0, OpenedMap);
2104 RefreshRecentMenu();
2105
2106 LoadMap(OpenedMap);
2107
2108 pLoadProgress.Hide();
2109 FormResize(nil);
2110
2111 lbTextureList.Sorted := True;
2112 lbTextureList.Sorted := False;
2113
2114 UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName);
2115 end;
2116 end;
2117
2118 procedure MoveSelectedObjects(Wall, alt: Boolean; dx, dy: Integer);
2119 var
2120 okX, okY: Boolean;
2121 a: Integer;
2122 begin
2123 if SelectedObjects = nil then
2124 Exit;
2125
2126 okX := True;
2127 okY := True;
2128
2129 if Wall then
2130 for a := 0 to High(SelectedObjects) do
2131 if SelectedObjects[a].Live then
2132 begin
2133 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, dx, 0) then
2134 okX := False;
2135
2136 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, 0, dy) then
2137 okY := False;
2138
2139 if (not okX) or (not okY) then
2140 Break;
2141 end;
2142
2143 if okX or okY then
2144 begin
2145 for a := 0 to High(SelectedObjects) do
2146 if SelectedObjects[a].Live then
2147 begin
2148 if okX then
2149 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, dx, 0);
2150
2151 if okY then
2152 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, 0, dy);
2153
2154 if alt and (SelectedObjects[a].ObjectType = OBJECT_TRIGGER) then
2155 begin
2156 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_PRESS,
2157 TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF] then
2158 begin // Двигаем зону Расширителя
2159 if okX then
2160 gTriggers[SelectedObjects[a].ID].Data.tX := gTriggers[SelectedObjects[a].ID].Data.tX+dx;
2161 if okY then
2162 gTriggers[SelectedObjects[a].ID].Data.tY := gTriggers[SelectedObjects[a].ID].Data.tY+dy;
2163 end;
2164
2165 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_TELEPORT] then
2166 begin // Двигаем точку назначения Телепорта
2167 if okX then
2168 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X+dx;
2169 if okY then
2170 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y+dy;
2171 end;
2172
2173 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNMONSTER] then
2174 begin // Двигаем точку создания монстра
2175 if okX then
2176 gTriggers[SelectedObjects[a].ID].Data.MonPos.X := gTriggers[SelectedObjects[a].ID].Data.MonPos.X+dx;
2177 if okY then
2178 gTriggers[SelectedObjects[a].ID].Data.MonPos.Y := gTriggers[SelectedObjects[a].ID].Data.MonPos.Y+dy;
2179 end;
2180
2181 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNITEM] then
2182 begin // Двигаем точку создания предмета
2183 if okX then
2184 gTriggers[SelectedObjects[a].ID].Data.ItemPos.X := gTriggers[SelectedObjects[a].ID].Data.ItemPos.X+dx;
2185 if okY then
2186 gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y := gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y+dy;
2187 end;
2188
2189 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SHOT] then
2190 begin // Двигаем точку создания выстрела
2191 if okX then
2192 gTriggers[SelectedObjects[a].ID].Data.ShotPos.X := gTriggers[SelectedObjects[a].ID].Data.ShotPos.X+dx;
2193 if okY then
2194 gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y := gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y+dy;
2195 end;
2196 end;
2197 end;
2198
2199 LastMovePoint := MousePos;
2200 end;
2201 end;
2202
2203 procedure ShowLayer(Layer: Byte; show: Boolean);
2204 begin
2205 LayerEnabled[Layer] := show;
2206
2207 case Layer of
2208 LAYER_BACK:
2209 begin
2210 MainForm.miLayer1.Checked := show;
2211 MainForm.miLayerP1.Checked := show;
2212 end;
2213 LAYER_WALLS:
2214 begin
2215 MainForm.miLayer2.Checked := show;
2216 MainForm.miLayerP2.Checked := show;
2217 end;
2218 LAYER_FOREGROUND:
2219 begin
2220 MainForm.miLayer3.Checked := show;
2221 MainForm.miLayerP3.Checked := show;
2222 end;
2223 LAYER_STEPS:
2224 begin
2225 MainForm.miLayer4.Checked := show;
2226 MainForm.miLayerP4.Checked := show;
2227 end;
2228 LAYER_WATER:
2229 begin
2230 MainForm.miLayer5.Checked := show;
2231 MainForm.miLayerP5.Checked := show;
2232 end;
2233 LAYER_ITEMS:
2234 begin
2235 MainForm.miLayer6.Checked := show;
2236 MainForm.miLayerP6.Checked := show;
2237 end;
2238 LAYER_MONSTERS:
2239 begin
2240 MainForm.miLayer7.Checked := show;
2241 MainForm.miLayerP7.Checked := show;
2242 end;
2243 LAYER_AREAS:
2244 begin
2245 MainForm.miLayer8.Checked := show;
2246 MainForm.miLayerP8.Checked := show;
2247 end;
2248 LAYER_TRIGGERS:
2249 begin
2250 MainForm.miLayer9.Checked := show;
2251 MainForm.miLayerP9.Checked := show;
2252 end;
2253 end;
2254
2255 RemoveSelectFromObjects();
2256 end;
2257
2258 procedure SwitchLayer(Layer: Byte);
2259 begin
2260 ShowLayer(Layer, not LayerEnabled[Layer]);
2261 end;
2262
2263 procedure SwitchMap();
2264 begin
2265 ShowMap := not ShowMap;
2266 MainForm.tbShowMap.Down := ShowMap;
2267 MainForm.miMiniMap.Checked := ShowMap;
2268 end;
2269
2270 procedure ShowEdges();
2271 begin
2272 if drEdge[3] < 255 then
2273 drEdge[3] := 255
2274 else
2275 drEdge[3] := gAlphaEdge;
2276 MainForm.miShowEdges.Checked := drEdge[3] <> 255;
2277 end;
2278
2279 function SelectedTexture(): String;
2280 begin
2281 if MainForm.lbTextureList.ItemIndex <> -1 then
2282 Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]
2283 else
2284 Result := '';
2285 end;
2286
2287 function IsSpecialTextureSel(): Boolean;
2288 begin
2289 Result := (MainForm.lbTextureList.ItemIndex <> -1) and
2290 IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]);
2291 end;
2292
2293 function CopyBufferToString(var CopyBuf: TCopyRecArray): String;
2294 var
2295 i, j: Integer;
2296 Res: String;
2297
2298 procedure AddInt(x: Integer);
2299 begin
2300 Res := Res + IntToStr(x) + ' ';
2301 end;
2302
2303 begin
2304 Result := '';
2305
2306 if Length(CopyBuf) = 0 then
2307 Exit;
2308
2309 Res := CLIPBOARD_SIG + ' ';
2310
2311 for i := 0 to High(CopyBuf) do
2312 begin
2313 if (CopyBuf[i].ObjectType = OBJECT_PANEL) and
2314 (CopyBuf[i].Panel = nil) then
2315 Continue;
2316
2317 // Тип объекта:
2318 AddInt(CopyBuf[i].ObjectType);
2319 Res := Res + '; ';
2320
2321 // Свойства объекта:
2322 case CopyBuf[i].ObjectType of
2323 OBJECT_PANEL:
2324 with CopyBuf[i].Panel^ do
2325 begin
2326 AddInt(PanelType);
2327 AddInt(X);
2328 AddInt(Y);
2329 AddInt(Width);
2330 AddInt(Height);
2331 Res := Res + '"' + TextureName + '" ';
2332 AddInt(Alpha);
2333 AddInt(IfThen(Blending, 1, 0));
2334 end;
2335
2336 OBJECT_ITEM:
2337 with CopyBuf[i].Item do
2338 begin
2339 AddInt(ItemType);
2340 AddInt(X);
2341 AddInt(Y);
2342 AddInt(IfThen(OnlyDM, 1, 0));
2343 AddInt(IfThen(Fall, 1, 0));
2344 end;
2345
2346 OBJECT_MONSTER:
2347 with CopyBuf[i].Monster do
2348 begin
2349 AddInt(MonsterType);
2350 AddInt(X);
2351 AddInt(Y);
2352 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2353 end;
2354
2355 OBJECT_AREA:
2356 with CopyBuf[i].Area do
2357 begin
2358 AddInt(AreaType);
2359 AddInt(X);
2360 AddInt(Y);
2361 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2362 end;
2363
2364 OBJECT_TRIGGER:
2365 with CopyBuf[i].Trigger do
2366 begin
2367 AddInt(TriggerType);
2368 AddInt(X);
2369 AddInt(Y);
2370 AddInt(Width);
2371 AddInt(Height);
2372 AddInt(ActivateType);
2373 AddInt(Key);
2374 AddInt(IfThen(Enabled, 1, 0));
2375 AddInt(TexturePanel);
2376
2377 for j := 0 to 127 do
2378 AddInt(Data.Default[j]);
2379 end;
2380 end;
2381 end;
2382
2383 Result := Res;
2384 end;
2385
2386 procedure StringToCopyBuffer(Str: String; var CopyBuf: TCopyRecArray; var pmin: TPoint);
2387 var
2388 i, j, t: Integer;
2389 minArea, newArea, newX, newY: LongInt;
2390
2391 function GetNext(): String;
2392 var
2393 p: Integer;
2394
2395 begin
2396 if Str[1] = '"' then
2397 begin
2398 Delete(Str, 1, 1);
2399 p := Pos('"', Str);
2400
2401 if p = 0 then
2402 begin
2403 Result := Str;
2404 Str := '';
2405 end
2406 else
2407 begin
2408 Result := Copy(Str, 1, p-1);
2409 Delete(Str, 1, p);
2410 Str := Trim(Str);
2411 end;
2412 end
2413 else
2414 begin
2415 p := Pos(' ', Str);
2416
2417 if p = 0 then
2418 begin
2419 Result := Str;
2420 Str := '';
2421 end
2422 else
2423 begin
2424 Result := Copy(Str, 1, p-1);
2425 Delete(Str, 1, p);
2426 Str := Trim(Str);
2427 end;
2428 end;
2429 end;
2430
2431 begin
2432 minArea := High(minArea);
2433 Str := Trim(Str);
2434
2435 if GetNext() <> CLIPBOARD_SIG then
2436 Exit;
2437
2438 while Str <> '' do
2439 begin
2440 // Тип объекта:
2441 t := StrToIntDef(GetNext(), 0);
2442
2443 if (t < OBJECT_PANEL) or (t > OBJECT_TRIGGER) or (GetNext() <> ';') then
2444 begin // Что-то не то => пропускаем:
2445 t := Pos(';', Str);
2446 Delete(Str, 1, t);
2447 Str := Trim(Str);
2448
2449 Continue;
2450 end;
2451
2452 i := Length(CopyBuf);
2453 SetLength(CopyBuf, i + 1);
2454
2455 CopyBuf[i].ObjectType := t;
2456 CopyBuf[i].Panel := nil;
2457
2458 // Свойства объекта:
2459 case t of
2460 OBJECT_PANEL:
2461 begin
2462 New(CopyBuf[i].Panel);
2463
2464 with CopyBuf[i].Panel^ do
2465 begin
2466 PanelType := StrToIntDef(GetNext(), PANEL_WALL);
2467 X := StrToIntDef(GetNext(), 0);
2468 Y := StrToIntDef(GetNext(), 0);
2469 Width := StrToIntDef(GetNext(), 16);
2470 Height := StrToIntDef(GetNext(), 16);
2471 TextureName := GetNext();
2472 Alpha := StrToIntDef(GetNext(), 0);
2473 Blending := (GetNext() = '1');
2474 newArea := X * Y - Width * Height;
2475 newX := X;
2476 newY := Y;
2477 end;
2478 end;
2479
2480 OBJECT_ITEM:
2481 with CopyBuf[i].Item do
2482 begin
2483 ItemType := StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL);
2484 X := StrToIntDef(GetNext(), 0);
2485 Y := StrToIntDef(GetNext(), 0);
2486 OnlyDM := (GetNext() = '1');
2487 Fall := (GetNext() = '1');
2488 newArea := X * Y;
2489 newX := X;
2490 newY := Y;
2491 end;
2492
2493 OBJECT_MONSTER:
2494 with CopyBuf[i].Monster do
2495 begin
2496 MonsterType := StrToIntDef(GetNext(), MONSTER_DEMON);
2497 X := StrToIntDef(GetNext(), 0);
2498 Y := StrToIntDef(GetNext(), 0);
2499 if GetNext() = '1'
2500 then Direction := D_LEFT
2501 else Direction := D_RIGHT;
2502 newArea := X * Y;
2503 newX := X;
2504 newY := Y;
2505 end;
2506
2507 OBJECT_AREA:
2508 with CopyBuf[i].Area do
2509 begin
2510 AreaType := StrToIntDef(GetNext(), AREA_PLAYERPOINT1);
2511 X := StrToIntDef(GetNext(), 0);
2512 Y := StrToIntDef(GetNext(), 0);
2513 if GetNext() = '1'
2514 then Direction := D_LEFT
2515 else Direction := D_RIGHT;
2516 newArea := X * Y;
2517 newX := X;
2518 newY := Y;
2519 end;
2520
2521 OBJECT_TRIGGER:
2522 with CopyBuf[i].Trigger do
2523 begin
2524 TriggerType := StrToIntDef(GetNext(), TRIGGER_EXIT);
2525 X := StrToIntDef(GetNext(), 0);
2526 Y := StrToIntDef(GetNext(), 0);
2527 Width := StrToIntDef(GetNext(), 16);
2528 Height := StrToIntDef(GetNext(), 16);
2529 ActivateType := StrToIntDef(GetNext(), 0);
2530 Key := StrToIntDef(GetNext(), 0);
2531 Enabled := (GetNext() = '1');
2532 TexturePanel := StrToIntDef(GetNext(), 0);
2533 for j := 0 to 127
2534 do Data.Default[j] := StrToIntDef(GetNext(), 0);
2535 newArea := X * Y - Width * Height;
2536 newX := X;
2537 newY := Y;
2538 end;
2539 end;
2540
2541 if newArea < minArea then
2542 begin
2543 minArea := newArea;
2544 pmin.X := newX;
2545 pmin.Y := newY;
2546 end;
2547 end;
2548 end;
2549
2550 //----------------------------------------
2551 //Закончились вспомогательные процедуры
2552 //----------------------------------------
2553
2554 procedure TMainForm.miRecentFileExecute (Sender: TObject);
2555 var
2556 s, fn: AnsiString;
2557 n: LongInt;
2558 begin
2559 n := (Sender as TMenuItem).Tag;
2560 s := RecentFiles[n];
2561 fn := g_ExtractWadName(s);
2562 if FileExists(fn) then
2563 OpenMap(fn, g_ExtractFilePathName(s))
2564 else
2565 Application.MessageBox('File not available anymore', '', MB_OK);
2566 // if Application.MessageBox(PChar(MsgMsgDelRecentPrompt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
2567 // begin
2568 // RecentFiles.Delete(n);
2569 // RefreshRecentMenu();
2570 // end;
2571 end;
2572
2573 procedure TMainForm.RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString);
2574 var i: Integer; MI: TMenuItem; s: AnsiString;
2575 begin
2576 Assert(menu <> nil);
2577 Assert(start >= 0);
2578 Assert(start <= menu.Count);
2579
2580 // clear all the recent entries from menu
2581 i := start;
2582 while i < menu.Count do
2583 begin
2584 MI := menu.Items[i];
2585 if @MI.OnClick <> @TMainForm.miRecentFileExecute then
2586 i += 1
2587 else
2588 begin
2589 menu.Delete(i);
2590 Application.ReleaseComponent(MI);
2591 end;
2592 end;
2593
2594 // fill with a new ones
2595 for i := 0 to RecentFiles.Count-1 do
2596 begin
2597 MI := TMenuItem.Create(menu);
2598 s := RecentFiles[i];
2599 MI.Caption := Format(fmt, [i+1, g_ExtractWadNameNoPath(s), g_ExtractFilePathName(s)]);
2600 MI.OnClick := miRecentFileExecute;
2601 MI.Tag := i;
2602 menu.Insert(start + i, MI); // transfers ownership
2603 end;
2604 end;
2605
2606 procedure TMainForm.RefreshRecentMenu();
2607 var start: Integer;
2608 begin
2609 while RecentFiles.Count > RecentCount do
2610 RecentFiles.Delete(RecentFiles.Count - 1);
2611
2612 if miMacRecentSubMenu.Visible then
2613 begin
2614 // Reconstruct OSX-like recent list
2615 RefillRecentMenu(miMacRecentSubMenu, 0, '%1:s - %2:s');
2616 miMacRecentEnd.Enabled := RecentFiles.Count <> 0;
2617 miMacRecentEnd.Visible := RecentFiles.Count <> 0;
2618 end;
2619
2620 if miWinRecentStart.Visible then
2621 begin
2622 // Reconstruct Windows-like recent list
2623 start := miMenuFile.IndexOf(miWinRecent);
2624 if start < 0 then start := miMenuFile.Count else start += 1;
2625 RefillRecentMenu(miMenuFile, start, '%0:d %1:s:%2:s');
2626 miWinRecent.Enabled := False;
2627 miWinRecent.Visible := RecentFiles.Count = 0;
2628 end;
2629 end;
2630
2631 procedure TMainForm.miMacRecentClearClick(Sender: TObject);
2632 begin
2633 RecentFiles.Clear();
2634 RefreshRecentMenu();
2635 end;
2636
2637 procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
2638 begin
2639 OptionsForm.ShowModal();
2640 end;
2641
2642 procedure LoadStdFont(cfgres, texture: string; var FontID: DWORD);
2643 var
2644 cwdt, chgt: Byte;
2645 spc: ShortInt;
2646 ID: DWORD;
2647 wad: TWADEditor_1;
2648 cfgdata: Pointer;
2649 cfglen: Integer;
2650 config: TConfig;
2651 begin
2652 cfgdata := nil;
2653 cfglen := 0;
2654 ID := 0;
2655
2656 wad := TWADEditor_1.Create;
2657 if wad.ReadFile(GameWad) then
2658 wad.GetResource('FONTS', cfgres, cfgdata, cfglen);
2659 wad.Free();
2660
2661 if cfglen <> 0 then
2662 begin
2663 if not g_CreateTextureWAD('FONT_STD', GameWad + ':FONTS\' + texture) then
2664 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING);
2665
2666 config := TConfig.CreateMem(cfgdata, cfglen);
2667 cwdt := Min(Max(config.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2668 chgt := Min(Max(config.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2669 spc := Min(Max(config.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2670
2671 if g_GetTexture('FONT_STD', ID) then
2672 e_TextureFontBuild(ID, FontID, cwdt, chgt, spc-2);
2673
2674 config.Free();
2675 end
2676 else
2677 e_WriteLog('Could not load FONT_STD', MSG_WARNING);
2678
2679 if cfglen <> 0 then FreeMem(cfgdata);
2680 end;
2681
2682 procedure TMainForm.FormCreate(Sender: TObject);
2683 var
2684 config: TConfig;
2685 i: Integer;
2686 s: String;
2687 begin
2688 Randomize();
2689 LastDrawTime := 0;
2690
2691 {$IFDEF DARWIN}
2692 miApple.Enabled := True;
2693 miApple.Visible := True;
2694 miMacRecentSubMenu.Enabled := True;
2695 miMacRecentSubMenu.Visible := True;
2696 miWinRecentStart.Enabled := False;
2697 miWinRecentStart.Visible := False;
2698 miWinRecent.Enabled := False;
2699 miWinRecent.Visible := False;
2700 miLine2.Enabled := False;
2701 miLine2.Visible := False;
2702 miExit.Enabled := False;
2703 miExit.Visible := False;
2704 miOptions.Enabled := False;
2705 miOptions.Visible := False;
2706 miMenuWindow.Enabled := True;
2707 miMenuWindow.Visible := True;
2708 miAbout.Enabled := False;
2709 miAbout.Visible := False;
2710 {$ELSE}
2711 miApple.Enabled := False;
2712 miApple.Visible := False;
2713 miMacRecentSubMenu.Enabled := False;
2714 miMacRecentSubMenu.Visible := False;
2715 miWinRecentStart.Enabled := True;
2716 miWinRecentStart.Visible := True;
2717 miWinRecent.Enabled := True;
2718 miWinRecent.Visible := True;
2719 miLine2.Enabled := True;
2720 miLine2.Visible := True;
2721 miExit.Enabled := True;
2722 miExit.Visible := True;
2723 miOptions.Enabled := True;
2724 miOptions.Visible := True;
2725 miMenuWindow.Enabled := False;
2726 miMenuWindow.Visible := False;
2727 miAbout.Enabled := True;
2728 miAbout.Visible := True;
2729 {$ENDIF}
2730
2731 miNewMap.ShortCut := ShortCut(VK_N, [ssModifier]);
2732 miOpenMap.ShortCut := ShortCut(VK_O, [ssModifier]);
2733 miSaveMap.ShortCut := ShortCut(VK_S, [ssModifier]);
2734 {$IFDEF DARWIN}
2735 miSaveMapAs.ShortCut := ShortCut(VK_S, [ssModifier, ssShift]);
2736 miReopenMap.ShortCut := ShortCut(VK_F5, [ssModifier]);
2737 {$ENDIF}
2738 miUndo.ShortCut := ShortCut(VK_Z, [ssModifier]);
2739 miCopy.ShortCut := ShortCut(VK_C, [ssModifier]);
2740 miCut.ShortCut := ShortCut(VK_X, [ssModifier]);
2741 miPaste.ShortCut := ShortCut(VK_V, [ssModifier]);
2742 miSelectAll.ShortCut := ShortCut(VK_A, [ssModifier]);
2743 miToFore.ShortCut := ShortCut(VK_LCL_CLOSE_BRACKET, [ssModifier]);
2744 miToBack.ShortCut := ShortCut(VK_LCL_OPEN_BRACKET, [ssModifier]);
2745 {$IFDEF DARWIN}
2746 miMapOptions.Shortcut := ShortCut(VK_P, [ssModifier, ssAlt]);
2747 selectall1.Shortcut := ShortCut(VK_A, [ssModifier, ssAlt]);
2748 {$ENDIF}
2749
2750 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION, MSG_NOTIFY);
2751 e_WriteLog('Build date: ' + EDITOR_BUILDDATE + ' ' + EDITOR_BUILDTIME, MSG_NOTIFY);
2752 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY);
2753 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY);
2754
2755 slInvalidTextures := TStringList.Create;
2756
2757 ShowLayer(LAYER_BACK, True);
2758 ShowLayer(LAYER_WALLS, True);
2759 ShowLayer(LAYER_FOREGROUND, True);
2760 ShowLayer(LAYER_STEPS, True);
2761 ShowLayer(LAYER_WATER, True);
2762 ShowLayer(LAYER_ITEMS, True);
2763 ShowLayer(LAYER_MONSTERS, True);
2764 ShowLayer(LAYER_AREAS, True);
2765 ShowLayer(LAYER_TRIGGERS, True);
2766
2767 ClearMap();
2768
2769 FormCaption := MainForm.Caption;
2770 OpenedMap := '';
2771 OpenedWAD := '';
2772
2773 config := TConfig.CreateFile(CfgFileName);
2774
2775 gWADEditorLogLevel := config.ReadInt('WADEditor', 'LogLevel', DFWAD_LOG_DEFAULT);
2776
2777 if config.ReadInt('Editor', 'XPos', -1) = -1 then
2778 Position := poDesktopCenter
2779 else begin
2780 Left := config.ReadInt('Editor', 'XPos', Left);
2781 Top := config.ReadInt('Editor', 'YPos', Top);
2782 Width := config.ReadInt('Editor', 'Width', Width);
2783 Height := config.ReadInt('Editor', 'Height', Height);
2784 end;
2785 if config.ReadBool('Editor', 'Maximize', False) then
2786 WindowState := wsMaximized;
2787 ShowMap := config.ReadBool('Editor', 'Minimap', False);
2788 PanelProps.Width := config.ReadInt('Editor', 'PanelProps', PanelProps.ClientWidth);
2789 Splitter1.Left := PanelProps.Left;
2790 PanelObjs.Height := config.ReadInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
2791 Splitter2.Top := PanelObjs.Top;
2792 StatusBar.Top := PanelObjs.BoundsRect.Bottom;
2793 DotEnable := config.ReadBool('Editor', 'DotEnable', True);
2794 DotColor := config.ReadInt('Editor', 'DotColor', $FFFFFF);
2795 DotStepOne := config.ReadInt('Editor', 'DotStepOne', 16);
2796 DotStepTwo := config.ReadInt('Editor', 'DotStepTwo', 8);
2797 DotStep := config.ReadInt('Editor', 'DotStep', DotStepOne);
2798 DrawTexturePanel := config.ReadBool('Editor', 'DrawTexturePanel', True);
2799 DrawPanelSize := config.ReadBool('Editor', 'DrawPanelSize', True);
2800 BackColor := config.ReadInt('Editor', 'BackColor', $7F6040);
2801 PreviewColor := config.ReadInt('Editor', 'PreviewColor', $00FF00);
2802 UseCheckerboard := config.ReadBool('Editor', 'UseCheckerboard', True);
2803 gColorEdge := config.ReadInt('Editor', 'EdgeColor', COLOR_EDGE);
2804 gAlphaEdge := config.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE);
2805 if gAlphaEdge = 255 then
2806 gAlphaEdge := ALPHA_EDGE;
2807 drEdge[0] := GetRValue(gColorEdge);
2808 drEdge[1] := GetGValue(gColorEdge);
2809 drEdge[2] := GetBValue(gColorEdge);
2810 if not config.ReadBool('Editor', 'EdgeShow', True) then
2811 drEdge[3] := 255
2812 else
2813 drEdge[3] := gAlphaEdge;
2814 gAlphaTriggerLine := config.ReadInt('Editor', 'LineAlpha', ALPHA_LINE);
2815 if gAlphaTriggerLine = 255 then
2816 gAlphaTriggerLine := ALPHA_LINE;
2817 gAlphaTriggerArea := config.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA);
2818 if gAlphaTriggerArea = 255 then
2819 gAlphaTriggerArea := ALPHA_AREA;
2820 gAlphaMonsterRect := config.ReadInt('Editor', 'MonsterRectAlpha', 0);
2821 gAlphaAreaRect := config.ReadInt('Editor', 'AreaRectAlpha', 0);
2822 Scale := Max(config.ReadInt('Editor', 'Scale', 1), 1);
2823 DotSize := Max(config.ReadInt('Editor', 'DotSize', 1), 1);
2824 OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', MapsDir);
2825 SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', MapsDir);
2826
2827 s := config.ReadStr('Editor', 'Language', '');
2828 gLanguage := s;
2829
2830 TestGameMode := config.ReadStr('TestRun', 'GameMode', 'DM');
2831 TestLimTime := config.ReadStr('TestRun', 'LimTime', '0');
2832 TestLimScore := config.ReadStr('TestRun', 'LimScore', '0');
2833 TestOptionsTwoPlayers := config.ReadBool('TestRun', 'TwoPlayers', False);
2834 TestOptionsTeamDamage := config.ReadBool('TestRun', 'TeamDamage', False);
2835 TestOptionsAllowExit := config.ReadBool('TestRun', 'AllowExit', True);
2836 TestOptionsWeaponStay := config.ReadBool('TestRun', 'WeaponStay', False);
2837 TestOptionsMonstersDM := config.ReadBool('TestRun', 'MonstersDM', False);
2838 TestMapOnce := config.ReadBool('TestRun', 'MapOnce', False);
2839 {$IF DEFINED(DARWIN)}
2840 TestD2dExe := config.ReadStr('TestRun', 'ExeDrawin', GameExeFile);
2841 {$ELSEIF DEFINED(WINDOWS)}
2842 TestD2dExe := config.ReadStr('TestRun', 'ExeWindows', GameExeFile);
2843 {$ELSE}
2844 TestD2dExe := config.ReadStr('TestRun', 'ExeUnix', GameExeFile);
2845 {$ENDIF}
2846 TestD2DArgs := config.ReadStr('TestRun', 'Args', '');
2847
2848 RecentCount := config.ReadInt('Editor', 'RecentCount', 5);
2849 if RecentCount > 10 then
2850 RecentCount := 10;
2851 if RecentCount < 2 then
2852 RecentCount := 2;
2853
2854 RecentFiles := TStringList.Create();
2855 for i := 0 to RecentCount-1 do
2856 begin
2857 {$IFDEF WINDOWS}
2858 s := config.ReadStr('RecentFilesWin', IntToStr(i), '');
2859 {$ELSE}
2860 s := config.ReadStr('RecentFilesUnix', IntToStr(i), '');
2861 {$ENDIF}
2862 if s <> '' then
2863 RecentFiles.Add(s);
2864 end;
2865 RefreshRecentMenu();
2866
2867 config.Free();
2868
2869 tbShowMap.Down := ShowMap;
2870 tbGridOn.Down := DotEnable;
2871 pcObjects.ActivePageIndex := 0;
2872 Application.Title := MsgEditorTitle;
2873
2874 Application.OnIdle := OnIdle;
2875 end;
2876
2877 procedure PrintBlack(X, Y: Integer; Text: string; FontID: DWORD);
2878 begin
2879 // NOTE: all the font printing routines assume CP1251
2880 e_TextureFontPrintEx(X, Y, Text, FontID, 0, 0, 0, 1.0);
2881 end;
2882
2883 procedure InitGraphics;
2884 begin
2885 // FIXME: this is a shitty hack
2886 if not gDataLoaded then
2887 begin
2888 e_WriteLog('Init OpenGL', MSG_NOTIFY);
2889 e_InitGL();
2890 e_WriteLog('Loading data', MSG_NOTIFY);
2891 LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
2892 e_WriteLog('Loading more data', MSG_NOTIFY);
2893 LoadData();
2894 e_WriteLog('Loading even more data', MSG_NOTIFY);
2895 gDataLoaded := True;
2896 MainForm.FormResize(nil);
2897 end;
2898 end;
2899
2900 procedure TMainForm.Draw();
2901 var
2902 x, y: Integer;
2903 a, b: Integer;
2904 ID, PID: DWORD;
2905 Width, Height: Word;
2906 Rect: TRectWH;
2907 ObjCount: Word;
2908 aX, aY, aX2, aY2, XX, ScaleSz: Integer;
2909 begin
2910 LastDrawTime := GetTickCount64();
2911 ID := 0;
2912 PID := 0;
2913 Width := 0;
2914 Height := 0;
2915
2916 InitGraphics();
2917
2918 e_BeginRender();
2919
2920 e_Clear(GL_COLOR_BUFFER_BIT,
2921 GetRValue(BackColor)/255,
2922 GetGValue(BackColor)/255,
2923 GetBValue(BackColor)/255);
2924
2925 DrawMap();
2926
2927 ObjCount := SelectedObjectCount();
2928
2929 // Обводим выделенные объекты красной рамкой:
2930 if ObjCount > 0 then
2931 begin
2932 for a := 0 to High(SelectedObjects) do
2933 if SelectedObjects[a].Live then
2934 begin
2935 Rect := ObjectGetRect(SelectedObjects[a].ObjectType, SelectedObjects[a].ID);
2936
2937 with Rect do
2938 begin
2939 e_DrawQuad(X+MapOffset.X, Y+MapOffset.Y,
2940 X+MapOffset.X+Width-1, Y+MapOffset.Y+Height-1,
2941 255, 0, 0);
2942
2943 // Рисуем точки изменения размеров:
2944 if (ObjCount = 1) and
2945 (SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) then
2946 begin
2947 e_DrawPoint(5, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2948 e_DrawPoint(5, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2949 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 255, 255);
2950 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 255, 255);
2951
2952 e_DrawPoint(3, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2953 e_DrawPoint(3, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2954 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 0, 0);
2955 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 0, 0);
2956 end;
2957 end;
2958 end;
2959 end;
2960
2961 // Рисуем сетку:
2962 if DotEnable and (PreviewMode = 0) then
2963 begin
2964 if DotSize = 2 then
2965 a := -1
2966 else
2967 a := 0;
2968
2969 glDisable(GL_TEXTURE_2D);
2970 glColor3ub(GetRValue(DotColor), GetGValue(DotColor), GetBValue(DotColor));
2971 glPointSize(DotSize);
2972 glBegin(GL_POINTS);
2973 x := MapOffset.X mod DotStep;
2974 while x < RenderPanel.Width do
2975 begin
2976 y := MapOffset.Y mod DotStep;
2977 while y < RenderPanel.Height do
2978 begin
2979 glVertex2i(x + a, y + a);
2980 y += DotStep;
2981 end;
2982 x += DotStep;
2983 end;
2984 glEnd();
2985 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
2986 end;
2987
2988 // Превью текстуры:
2989 if (lbTextureList.ItemIndex <> -1) and (cbPreview.Checked) and
2990 (not IsSpecialTextureSel()) and (PreviewMode = 0) then
2991 begin
2992 if not g_GetTexture(SelectedTexture(), ID) then
2993 g_GetTexture('NOTEXTURE', ID);
2994 g_GetTextureSizeByID(ID, Width, Height);
2995 if UseCheckerboard then
2996 begin
2997 if g_GetTexture('PREVIEW', PID) then
2998 e_DrawFill(PID, RenderPanel.Width-Width, RenderPanel.Height-Height, Width div 16 + 1, Height div 16 + 1, 0, True, False);
2999 end else
3000 e_DrawFillQuad(RenderPanel.Width-Width-2, RenderPanel.Height-Height-2,
3001 RenderPanel.Width-1, RenderPanel.Height-1,
3002 GetRValue(PreviewColor), GetGValue(PreviewColor), GetBValue(PreviewColor), 0);
3003 e_Draw(ID, RenderPanel.Width-Width, RenderPanel.Height-Height, 0, True, False);
3004 end;
3005
3006 // Подсказка при выборе точки Телепорта:
3007 if SelectFlag = SELECTFLAG_TELEPORT then
3008 begin
3009 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
3010 if Data.d2d_teleport then
3011 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
3012 MousePos.X+16, MousePos.Y-1,
3013 0, 0, 255)
3014 else
3015 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+AreaSize[AREA_DMPOINT].Width-1,
3016 MousePos.Y+AreaSize[AREA_DMPOINT].Height-1, 255, 255, 255);
3017
3018 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3019 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3020 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintTeleport), gEditorFont);
3021 end;
3022
3023 // Подсказка при выборе точки появления:
3024 if SelectFlag = SELECTFLAG_SPAWNPOINT then
3025 begin
3026 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
3027 MousePos.X+16, MousePos.Y-1,
3028 0, 0, 255);
3029 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3030 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3031 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintSpawn), gEditorFont);
3032 end;
3033
3034 // Подсказка при выборе панели двери:
3035 if SelectFlag = SELECTFLAG_DOOR then
3036 begin
3037 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3038 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3039 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelDoor), gEditorFont);
3040 end;
3041
3042 // Подсказка при выборе панели с текстурой:
3043 if SelectFlag = SELECTFLAG_TEXTURE then
3044 begin
3045 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 192, 192, 192, 127);
3046 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 255, 255, 255);
3047 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelTexture), gEditorFont);
3048 end;
3049
3050 // Подсказка при выборе панели индикации выстрела:
3051 if SelectFlag = SELECTFLAG_SHOTPANEL then
3052 begin
3053 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 192, 192, 192, 127);
3054 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 255, 255, 255);
3055 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelShot), gEditorFont);
3056 end;
3057
3058 // Подсказка при выборе панели лифта:
3059 if SelectFlag = SELECTFLAG_LIFT then
3060 begin
3061 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3062 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3063 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelLift), gEditorFont);
3064 end;
3065
3066 // Подсказка при выборе монстра:
3067 if SelectFlag = SELECTFLAG_MONSTER then
3068 begin
3069 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 192, 192, 192, 127);
3070 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 255, 255, 255);
3071 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintMonster), gEditorFont);
3072 end;
3073
3074 // Подсказка при выборе области воздействия:
3075 if DrawPressRect then
3076 begin
3077 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 192, 192, 192, 127);
3078 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 255, 255, 255);
3079 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintExtArea), gEditorFont);
3080 end;
3081
3082 // Рисуем текстуры, если чертим панель:
3083 if (MouseAction = MOUSEACTION_DRAWPANEL) and (DrawTexturePanel) and
3084 (lbTextureList.ItemIndex <> -1) and (DrawRect <> nil) and
3085 (lbPanelType.ItemIndex in [0..8]) and not IsSpecialTextureSel() then
3086 begin
3087 if not g_GetTexture(SelectedTexture(), ID) then
3088 g_GetTexture('NOTEXTURE', ID);
3089 g_GetTextureSizeByID(ID, Width, Height);
3090 with DrawRect^ do
3091 if (Abs(Right-Left) >= Width) and (Abs(Bottom-Top) >= Height) then
3092 e_DrawFill(ID, Min(Left, Right), Min(Top, Bottom), Abs(Right-Left) div Width,
3093 Abs(Bottom-Top) div Height, 64, True, False);
3094 end;
3095
3096 // Прямоугольник выделения:
3097 if DrawRect <> nil then
3098 with DrawRect^ do
3099 e_DrawQuad(Left, Top, Right-1, Bottom-1, 255, 255, 255);
3100
3101 // Чертим мышью панель/триггер или меняем мышью их размер:
3102 if (((MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER]) and
3103 not(ssCtrl in GetKeyShiftState())) or (MouseAction = MOUSEACTION_RESIZE)) and
3104 (DrawPanelSize) then
3105 begin
3106 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 192, 192, 192, 127);
3107 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 255, 255, 255);
3108
3109 if MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER] then
3110 begin // Чертим новый
3111 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(utf8to1251(MsgHintWidth),
3112 [Abs(MousePos.X-MouseLDownPos.X)]), gEditorFont);
3113 PrintBlack(MousePos.X+2, MousePos.Y+16, Format(utf8to1251(MsgHintHeight),
3114 [Abs(MousePos.Y-MouseLDownPos.Y)]), gEditorFont);
3115 end
3116 else // Растягиваем существующий
3117 if SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
3118 begin
3119 if SelectedObjects[GetFirstSelected].ObjectType = OBJECT_PANEL then
3120 begin
3121 Width := gPanels[SelectedObjects[GetFirstSelected].ID].Width;
3122 Height := gPanels[SelectedObjects[GetFirstSelected].ID].Height;
3123 end
3124 else
3125 begin
3126 Width := gTriggers[SelectedObjects[GetFirstSelected].ID].Width;
3127 Height := gTriggers[SelectedObjects[GetFirstSelected].ID].Height;
3128 end;
3129
3130 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(utf8to1251(MsgHintWidth), [Width]),
3131 gEditorFont);
3132 PrintBlack(MousePos.X+2, MousePos.Y+16, Format(utf8to1251(MsgHintHeight), [Height]),
3133 gEditorFont);
3134 end;
3135 end;
3136
3137 // Ближайшая к курсору мыши точка на сетке:
3138 e_DrawPoint(3, MousePos.X, MousePos.Y, 0, 0, 255);
3139
3140 // Мини-карта:
3141 if ShowMap then
3142 begin
3143 // Сколько пикселов карты в 1 пикселе мини-карты:
3144 ScaleSz := 16 div Scale;
3145 // Размеры мини-карты:
3146 aX := max(gMapInfo.Width div ScaleSz, 1);
3147 aY := max(gMapInfo.Height div ScaleSz, 1);
3148 // X-координата на RenderPanel нулевой x-координаты карты:
3149 XX := RenderPanel.Width - aX - 1;
3150 // Рамка карты:
3151 e_DrawFillQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 0, 0, 0, 0);
3152 e_DrawQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 197, 197, 197);
3153
3154 if gPanels <> nil then
3155 begin
3156 // Рисуем панели:
3157 for a := 0 to High(gPanels) do
3158 with gPanels[a] do
3159 if PanelType <> 0 then
3160 begin
3161 // Левый верхний угол:
3162 aX := XX + (X div ScaleSz);
3163 aY := 1 + (Y div ScaleSz);
3164 // Размеры:
3165 aX2 := max(Width div ScaleSz, 1);
3166 aY2 := max(Height div ScaleSz, 1);
3167 // Правый нижний угол:
3168 aX2 := aX + aX2 - 1;
3169 aY2 := aY + aY2 - 1;
3170
3171 case PanelType of
3172 PANEL_WALL: e_DrawFillQuad(aX, aY, aX2, aY2, 208, 208, 208, 0);
3173 PANEL_WATER: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 0, 192, 0);
3174 PANEL_ACID1: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 176, 0, 0);
3175 PANEL_ACID2: e_DrawFillQuad(aX, aY, aX2, aY2, 176, 0, 0, 0);
3176 PANEL_STEP: e_DrawFillQuad(aX, aY, aX2, aY2, 128, 128, 128, 0);
3177 PANEL_LIFTUP: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 72, 36, 0);
3178 PANEL_LIFTDOWN: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 124, 96, 0);
3179 PANEL_LIFTLEFT: e_DrawFillQuad(aX, aY, aX2, aY2, 200, 80, 4, 0);
3180 PANEL_LIFTRIGHT: e_DrawFillQuad(aX, aY, aX2, aY2, 252, 140, 56, 0);
3181 PANEL_OPENDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 100, 220, 92, 0);
3182 PANEL_CLOSEDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 212, 184, 64, 0);
3183 PANEL_BLOCKMON: e_DrawFillQuad(aX, aY, aX2, aY2, 192, 0, 192, 0);
3184 end;
3185 end;
3186
3187 // Рисуем красным выделенные панели:
3188 if SelectedObjects <> nil then
3189 for b := 0 to High(SelectedObjects) do
3190 with SelectedObjects[b] do
3191 if Live and (ObjectType = OBJECT_PANEL) then
3192 with gPanels[SelectedObjects[b].ID] do
3193 if PanelType and not(PANEL_BACK or PANEL_FORE) <> 0 then
3194 begin
3195 // Левый верхний угол:
3196 aX := XX + (X div ScaleSz);
3197 aY := 1 + (Y div ScaleSz);
3198 // Размеры:
3199 aX2 := max(Width div ScaleSz, 1);
3200 aY2 := max(Height div ScaleSz, 1);
3201 // Правый нижний угол:
3202 aX2 := aX + aX2 - 1;
3203 aY2 := aY + aY2 - 1;
3204
3205 e_DrawFillQuad(aX, aY, aX2, aY2, 255, 0, 0, 0)
3206 end;
3207 end;
3208
3209 if (gMapInfo.Width > RenderPanel.Width) or
3210 (gMapInfo.Height > RenderPanel.Height) then
3211 begin
3212 // Окно, показывающее текущее положение экрана на карте:
3213 // Размеры окна:
3214 x := max(min(RenderPanel.Width, gMapInfo.Width) div ScaleSz, 1);
3215 y := max(min(RenderPanel.Height, gMapInfo.Height) div ScaleSz, 1);
3216 // Левый верхний угол:
3217 aX := XX + ((-MapOffset.X) div ScaleSz);
3218 aY := 1 + ((-MapOffset.Y) div ScaleSz);
3219 // Правый нижний угол:
3220 aX2 := aX + x - 1;
3221 aY2 := aY + y - 1;
3222
3223 e_DrawFillQuad(aX, aY, aX2, aY2, 127, 192, 127, 127, B_BLEND);
3224 e_DrawQuad(aX, aY, aX2, aY2, 255, 0, 0);
3225 end;
3226 end; // Мини-карта
3227
3228 e_EndRender();
3229 RenderPanel.SwapBuffers();
3230 end;
3231
3232 procedure TMainForm.FormResize(Sender: TObject);
3233 begin
3234 e_SetViewPort(0, 0, RenderPanel.Width, RenderPanel.Height);
3235
3236 sbHorizontal.Min := Min(gMapInfo.Width - RenderPanel.Width, -RenderPanel.Width div 2);
3237 sbHorizontal.Max := Max(0, gMapInfo.Width - RenderPanel.Width div 2);
3238 sbVertical.Min := Min(gMapInfo.Height - RenderPanel.Height, -RenderPanel.Height div 2);
3239 sbVertical.Max := Max(0, gMapInfo.Height - RenderPanel.Height div 2);
3240
3241 MapOffset.X := -sbHorizontal.Position;
3242 MapOffset.Y := -sbVertical.Position;
3243 end;
3244
3245 procedure TMainForm.FormWindowStateChange(Sender: TObject);
3246 {$IFDEF DARWIN}
3247 var e: Boolean;
3248 {$ENDIF}
3249 begin
3250 {$IFDEF DARWIN}
3251 // deactivate all menus when main window minimized
3252 e := self.WindowState <> wsMinimized;
3253 miMenuFile.Enabled := e;
3254 miMenuEdit.Enabled := e;
3255 miMenuView.Enabled := e;
3256 miMenuService.Enabled := e;
3257 miMenuWindow.Enabled := e;
3258 miMenuHelp.Enabled := e;
3259 miMenuHidden.Enabled := e;
3260 {$ENDIF}
3261 end;
3262
3263 procedure SelectNextObject(X, Y: Integer; ObjectType: Byte; ID: DWORD);
3264 var
3265 j, j_max: Integer;
3266 res: Boolean;
3267 begin
3268 j_max := 0; // shut up compiler
3269 case ObjectType of
3270 OBJECT_PANEL:
3271 begin
3272 res := (gPanels <> nil) and
3273 PanelInShownLayer(gPanels[ID].PanelType) and
3274 g_CollidePoint(X, Y, gPanels[ID].X, gPanels[ID].Y,
3275 gPanels[ID].Width,
3276 gPanels[ID].Height);
3277 j_max := Length(gPanels) - 1;
3278 end;
3279
3280 OBJECT_ITEM:
3281 begin
3282 res := (gItems <> nil) and
3283 LayerEnabled[LAYER_ITEMS] and
3284 g_CollidePoint(X, Y, gItems[ID].X, gItems[ID].Y,
3285 ItemSize[gItems[ID].ItemType][0],
3286 ItemSize[gItems[ID].ItemType][1]);
3287 j_max := Length(gItems) - 1;
3288 end;
3289
3290 OBJECT_MONSTER:
3291 begin
3292 res := (gMonsters <> nil) and
3293 LayerEnabled[LAYER_MONSTERS] and
3294 g_CollidePoint(X, Y, gMonsters[ID].X, gMonsters[ID].Y,
3295 MonsterSize[gMonsters[ID].MonsterType].Width,
3296 MonsterSize[gMonsters[ID].MonsterType].Height);
3297 j_max := Length(gMonsters) - 1;
3298 end;
3299
3300 OBJECT_AREA:
3301 begin
3302 res := (gAreas <> nil) and
3303 LayerEnabled[LAYER_AREAS] and
3304 g_CollidePoint(X, Y, gAreas[ID].X, gAreas[ID].Y,
3305 AreaSize[gAreas[ID].AreaType].Width,
3306 AreaSize[gAreas[ID].AreaType].Height);
3307 j_max := Length(gAreas) - 1;
3308 end;
3309
3310 OBJECT_TRIGGER:
3311 begin
3312 res := (gTriggers <> nil) and
3313 LayerEnabled[LAYER_TRIGGERS] and
3314 g_CollidePoint(X, Y, gTriggers[ID].X, gTriggers[ID].Y,
3315 gTriggers[ID].Width,
3316 gTriggers[ID].Height);
3317 j_max := Length(gTriggers) - 1;
3318 end;
3319
3320 else
3321 res := False;
3322 end;
3323
3324 if not res then
3325 Exit;
3326
3327 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3328 j := ID;
3329
3330 while True do
3331 begin
3332 Dec(j);
3333
3334 if j < 0 then
3335 j := j_max;
3336 if j = Integer(ID) then
3337 Break;
3338
3339 case ObjectType of
3340 OBJECT_PANEL:
3341 res := PanelInShownLayer(gPanels[j].PanelType) and
3342 g_CollidePoint(X, Y, gPanels[j].X, gPanels[j].Y,
3343 gPanels[j].Width,
3344 gPanels[j].Height);
3345 OBJECT_ITEM:
3346 res := (gItems[j].ItemType <> ITEM_NONE) and
3347 g_CollidePoint(X, Y, gItems[j].X, gItems[j].Y,
3348 ItemSize[gItems[j].ItemType][0],
3349 ItemSize[gItems[j].ItemType][1]);
3350 OBJECT_MONSTER:
3351 res := (gMonsters[j].MonsterType <> MONSTER_NONE) and
3352 g_CollidePoint(X, Y, gMonsters[j].X, gMonsters[j].Y,
3353 MonsterSize[gMonsters[j].MonsterType].Width,
3354 MonsterSize[gMonsters[j].MonsterType].Height);
3355 OBJECT_AREA:
3356 res := (gAreas[j].AreaType <> AREA_NONE) and
3357 g_CollidePoint(X, Y, gAreas[j].X, gAreas[j].Y,
3358 AreaSize[gAreas[j].AreaType].Width,
3359 AreaSize[gAreas[j].AreaType].Height);
3360 OBJECT_TRIGGER:
3361 res := (gTriggers[j].TriggerType <> TRIGGER_NONE) and
3362 g_CollidePoint(X, Y, gTriggers[j].X, gTriggers[j].Y,
3363 gTriggers[j].Width,
3364 gTriggers[j].Height);
3365 else
3366 res := False;
3367 end;
3368
3369 if res then
3370 begin
3371 SetLength(SelectedObjects, 1);
3372
3373 SelectedObjects[0].ObjectType := ObjectType;
3374 SelectedObjects[0].ID := j;
3375 SelectedObjects[0].Live := True;
3376
3377 FillProperty();
3378 Break;
3379 end;
3380 end;
3381 end;
3382
3383 procedure TMainForm.RenderPanelMouseDown(Sender: TObject;
3384 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3385 var
3386 i: Integer;
3387 Rect: TRectWH;
3388 c1, c2, c3, c4: Boolean;
3389 item: TItem;
3390 area: TArea;
3391 monster: TMonster;
3392 IDArray: DWArray;
3393 begin
3394 MainForm.ActiveControl := RenderPanel;
3395 RenderPanel.SetFocus();
3396
3397 RenderPanelMouseMove(RenderPanel, Shift, X, Y);
3398
3399 if Button = mbLeft then // Left Mouse Button
3400 begin
3401 // Двигаем карту с помощью мыши и мини-карты:
3402 if ShowMap and
3403 g_CollidePoint(X, Y,
3404 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3405 1,
3406 max(gMapInfo.Width div (16 div Scale), 1),
3407 max(gMapInfo.Height div (16 div Scale), 1) ) then
3408 begin
3409 MoveMap(X, Y);
3410 MouseAction := MOUSEACTION_MOVEMAP;
3411 end
3412 else // Ставим предмет/монстра/область:
3413 if (pcObjects.ActivePageIndex in [1, 2, 3]) and
3414 (not (ssShift in Shift)) then
3415 begin
3416 case pcObjects.ActivePageIndex of
3417 1:
3418 if lbItemList.ItemIndex = -1 then
3419 ErrorMessageBox(MsgMsgChooseItem)
3420 else
3421 begin
3422 item.ItemType := lbItemList.ItemIndex + ITEM_MEDKIT_SMALL;
3423 if item.ItemType >= ITEM_WEAPON_IRONFIST then
3424 item.ItemType := item.ItemType + 2;
3425 item.X := MousePos.X-MapOffset.X;
3426 item.Y := MousePos.Y-MapOffset.Y;
3427
3428 if not (ssCtrl in Shift) then
3429 begin
3430 item.X := item.X - (ItemSize[item.ItemType][0] div 2);
3431 item.Y := item.Y - ItemSize[item.ItemType][1];
3432 end;
3433
3434 item.OnlyDM := cbOnlyDM.Checked;
3435 item.Fall := cbFall.Checked;
3436 Undo_Add(OBJECT_ITEM, AddItem(item));
3437 end;
3438 2:
3439 if lbMonsterList.ItemIndex = -1 then
3440 ErrorMessageBox(MsgMsgChooseMonster)
3441 else
3442 begin
3443 monster.MonsterType := lbMonsterList.ItemIndex + MONSTER_DEMON;
3444 monster.X := MousePos.X-MapOffset.X;
3445 monster.Y := MousePos.Y-MapOffset.Y;
3446
3447 if not (ssCtrl in Shift) then
3448 begin
3449 monster.X := monster.X - (MonsterSize[monster.MonsterType].Width div 2);
3450 monster.Y := monster.Y - MonsterSize[monster.MonsterType].Height;
3451 end;
3452
3453 if rbMonsterLeft.Checked then
3454 monster.Direction := D_LEFT
3455 else
3456 monster.Direction := D_RIGHT;
3457 Undo_Add(OBJECT_MONSTER, AddMonster(monster));
3458 end;
3459 3:
3460 if lbAreasList.ItemIndex = -1 then
3461 ErrorMessageBox(MsgMsgChooseArea)
3462 else
3463 if (lbAreasList.ItemIndex + 1) <> AREA_DOMFLAG then
3464 begin
3465 area.AreaType := lbAreasList.ItemIndex + AREA_PLAYERPOINT1;
3466 area.X := MousePos.X-MapOffset.X;
3467 area.Y := MousePos.Y-MapOffset.Y;
3468
3469 if not (ssCtrl in Shift) then
3470 begin
3471 area.X := area.X - (AreaSize[area.AreaType].Width div 2);
3472 area.Y := area.Y - AreaSize[area.AreaType].Height;
3473 end;
3474
3475 if rbAreaLeft.Checked then
3476 area.Direction := D_LEFT
3477 else
3478 area.Direction := D_RIGHT;
3479 Undo_Add(OBJECT_AREA, AddArea(area));
3480 end;
3481 end;
3482 end
3483 else
3484 begin
3485 i := GetFirstSelected();
3486
3487 // Выбираем объект под текущим:
3488 if (SelectedObjects <> nil) and
3489 (ssShift in Shift) and (i >= 0) and
3490 (SelectedObjects[i].Live) then
3491 begin
3492 if SelectedObjectCount() = 1 then
3493 SelectNextObject(X-MapOffset.X, Y-MapOffset.Y,
3494 SelectedObjects[i].ObjectType,
3495 SelectedObjects[i].ID);
3496 end
3497 else
3498 begin
3499 // Рисуем область триггера "Расширитель":
3500 if DrawPressRect and (i >= 0) and
3501 (SelectedObjects[i].ObjectType = OBJECT_TRIGGER) and
3502 (gTriggers[SelectedObjects[i].ID].TriggerType in
3503 [TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF]) then
3504 MouseAction := MOUSEACTION_DRAWPRESS
3505 else // Рисуем панель:
3506 if pcObjects.ActivePageIndex = 0 then
3507 begin
3508 if (lbPanelType.ItemIndex >= 0) then
3509 MouseAction := MOUSEACTION_DRAWPANEL
3510 end
3511 else // Рисуем триггер:
3512 if (lbTriggersList.ItemIndex >= 0) then
3513 begin
3514 MouseAction := MOUSEACTION_DRAWTRIGGER;
3515 end;
3516 end;
3517 end;
3518 end; // if Button = mbLeft
3519
3520 if Button = mbRight then // Right Mouse Button
3521 begin
3522 // Клик по мини-карте:
3523 if ShowMap and
3524 g_CollidePoint(X, Y,
3525 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3526 1,
3527 max(gMapInfo.Width div (16 div Scale), 1),
3528 max(gMapInfo.Height div (16 div Scale), 1) ) then
3529 begin
3530 MouseAction := MOUSEACTION_NOACTION;
3531 end
3532 else // Нужно что-то выбрать мышью:
3533 if SelectFlag <> SELECTFLAG_NONE then
3534 begin
3535 case SelectFlag of
3536 SELECTFLAG_TELEPORT:
3537 // Точку назначения телепортации:
3538 with gTriggers[SelectedObjects[
3539 GetFirstSelected() ].ID].Data.TargetPoint do
3540 begin
3541 X := MousePos.X-MapOffset.X;
3542 Y := MousePos.Y-MapOffset.Y;
3543 end;
3544
3545 SELECTFLAG_SPAWNPOINT:
3546 // Точку создания монстра:
3547 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
3548 if TriggerType = TRIGGER_SPAWNMONSTER then
3549 begin
3550 Data.MonPos.X := MousePos.X-MapOffset.X;
3551 Data.MonPos.Y := MousePos.Y-MapOffset.Y;
3552 end
3553 else if TriggerType = TRIGGER_SPAWNITEM then
3554 begin // Точка создания предмета:
3555 Data.ItemPos.X := MousePos.X-MapOffset.X;
3556 Data.ItemPos.Y := MousePos.Y-MapOffset.Y;
3557 end
3558 else if TriggerType = TRIGGER_SHOT then
3559 begin // Точка создания выстрела:
3560 Data.ShotPos.X := MousePos.X-MapOffset.X;
3561 Data.ShotPos.Y := MousePos.Y-MapOffset.Y;
3562 end;
3563
3564 SELECTFLAG_DOOR:
3565 // Дверь:
3566 begin
3567 IDArray := ObjectInRect(X-MapOffset.X,
3568 Y-MapOffset.Y,
3569 2, 2, OBJECT_PANEL, True);
3570 if IDArray <> nil then
3571 begin
3572 for i := 0 to High(IDArray) do
3573 if (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3574 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR) then
3575 begin
3576 gTriggers[SelectedObjects[
3577 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3578 Break;
3579 end;
3580 end
3581 else
3582 gTriggers[SelectedObjects[
3583 GetFirstSelected() ].ID].Data.PanelID := -1;
3584 end;
3585
3586 SELECTFLAG_TEXTURE:
3587 // Панель с текстурой:
3588 begin
3589 IDArray := ObjectInRect(X-MapOffset.X,
3590 Y-MapOffset.Y,
3591 2, 2, OBJECT_PANEL, True);
3592 if IDArray <> nil then
3593 begin
3594 for i := 0 to High(IDArray) do
3595 if ((gPanels[IDArray[i]].PanelType in
3596 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3597 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3598 PANEL_STEP]) or
3599 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3600 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3601 (gPanels[IDArray[i]].TextureName <> '') then
3602 begin
3603 gTriggers[SelectedObjects[
3604 GetFirstSelected() ].ID].TexturePanel := IDArray[i];
3605 Break;
3606 end;
3607 end
3608 else
3609 gTriggers[SelectedObjects[
3610 GetFirstSelected() ].ID].TexturePanel := -1;
3611 end;
3612
3613 SELECTFLAG_LIFT:
3614 // Лифт:
3615 begin
3616 IDArray := ObjectInRect(X-MapOffset.X,
3617 Y-MapOffset.Y,
3618 2, 2, OBJECT_PANEL, True);
3619 if IDArray <> nil then
3620 begin
3621 for i := 0 to High(IDArray) do
3622 if (gPanels[IDArray[i]].PanelType = PANEL_LIFTUP) or
3623 (gPanels[IDArray[i]].PanelType = PANEL_LIFTDOWN) or
3624 (gPanels[IDArray[i]].PanelType = PANEL_LIFTLEFT) or
3625 (gPanels[IDArray[i]].PanelType = PANEL_LIFTRIGHT) then
3626 begin
3627 gTriggers[SelectedObjects[
3628 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3629 Break;
3630 end;
3631 end
3632 else
3633 gTriggers[SelectedObjects[
3634 GetFirstSelected() ].ID].Data.PanelID := -1;
3635 end;
3636
3637 SELECTFLAG_MONSTER:
3638 // Монстра:
3639 begin
3640 IDArray := ObjectInRect(X-MapOffset.X,
3641 Y-MapOffset.Y,
3642 2, 2, OBJECT_MONSTER, False);
3643 if IDArray <> nil then
3644 gTriggers[SelectedObjects[
3645 GetFirstSelected() ].ID].Data.MonsterID := IDArray[0]+1
3646 else
3647 gTriggers[SelectedObjects[
3648 GetFirstSelected() ].ID].Data.MonsterID := 0;
3649 end;
3650
3651 SELECTFLAG_SHOTPANEL:
3652 // Панель индикации выстрела:
3653 begin
3654 if gTriggers[SelectedObjects[
3655 GetFirstSelected() ].ID].TriggerType = TRIGGER_SHOT then
3656 begin
3657 IDArray := ObjectInRect(X-MapOffset.X,
3658 Y-MapOffset.Y,
3659 2, 2, OBJECT_PANEL, True);
3660 if IDArray <> nil then
3661 begin
3662 for i := 0 to High(IDArray) do
3663 if ((gPanels[IDArray[i]].PanelType in
3664 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3665 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3666 PANEL_STEP]) or
3667 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3668 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3669 (gPanels[IDArray[i]].TextureName <> '') then
3670 begin
3671 gTriggers[SelectedObjects[
3672 GetFirstSelected() ].ID].Data.ShotPanelID := IDArray[i];
3673 Break;
3674 end;
3675 end
3676 else
3677 gTriggers[SelectedObjects[
3678 GetFirstSelected() ].ID].Data.ShotPanelID := -1;
3679 end;
3680 end;
3681 end;
3682
3683 SelectFlag := SELECTFLAG_SELECTED;
3684 end
3685 else // if SelectFlag <> SELECTFLAG_NONE...
3686 begin
3687 // Что уже выбрано и не нажат Ctrl:
3688 if (SelectedObjects <> nil) and
3689 (not (ssCtrl in Shift)) then
3690 for i := 0 to High(SelectedObjects) do
3691 with SelectedObjects[i] do
3692 if Live then
3693 begin
3694 if (ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) and
3695 (SelectedObjectCount() = 1) then
3696 begin
3697 Rect := ObjectGetRect(ObjectType, ID);
3698
3699 c1 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3700 Rect.X-2, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3701 c2 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3702 Rect.X+Rect.Width-3, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3703 c3 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3704 Rect.X+(Rect.Width div 2)-2, Rect.Y-2, 4, 4);
3705 c4 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3706 Rect.X+(Rect.Width div 2)-2, Rect.Y+Rect.Height-3, 4, 4);
3707
3708 // Меняем размер панели или триггера:
3709 if c1 or c2 or c3 or c4 then
3710 begin
3711 MouseAction := MOUSEACTION_RESIZE;
3712 LastMovePoint := MousePos;
3713
3714 if c1 or c2 then
3715 begin // Шире/уже
3716 ResizeType := RESIZETYPE_HORIZONTAL;
3717 if c1 then
3718 ResizeDirection := RESIZEDIR_LEFT
3719 else
3720 ResizeDirection := RESIZEDIR_RIGHT;
3721 RenderPanel.Cursor := crSizeWE;
3722 end
3723 else
3724 begin // Выше/ниже
3725 ResizeType := RESIZETYPE_VERTICAL;
3726 if c3 then
3727 ResizeDirection := RESIZEDIR_UP
3728 else
3729 ResizeDirection := RESIZEDIR_DOWN;
3730 RenderPanel.Cursor := crSizeNS;
3731 end;
3732
3733 Break;
3734 end;
3735 end;
3736
3737 // Перемещаем панель или триггер:
3738 if ObjectCollide(ObjectType, ID,
3739 X-MapOffset.X-1,
3740 Y-MapOffset.Y-1, 2, 2) then
3741 begin
3742 MouseAction := MOUSEACTION_MOVEOBJ;
3743 LastMovePoint := MousePos;
3744
3745 Break;
3746 end;
3747 end;
3748 end;
3749 end; // if Button = mbRight
3750
3751 if Button = mbMiddle then // Middle Mouse Button
3752 begin
3753 SetCapture(RenderPanel.Handle);
3754 RenderPanel.Cursor := crSize;
3755 end;
3756
3757 MouseMDown := Button = mbMiddle;
3758 if MouseMDown then
3759 MouseMDownPos := Mouse.CursorPos;
3760
3761 MouseRDown := Button = mbRight;
3762 if MouseRDown then
3763 MouseRDownPos := MousePos;
3764
3765 MouseLDown := Button = mbLeft;
3766 if MouseLDown then
3767 MouseLDownPos := MousePos;
3768 end;
3769
3770 procedure TMainForm.RenderPanelMouseUp(Sender: TObject;
3771 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3772 var
3773 panel: TPanel;
3774 trigger: TTrigger;
3775 rRect: TRectWH;
3776 rSelectRect: Boolean;
3777 wWidth, wHeight: Word;
3778 TextureID: DWORD;
3779
3780 procedure SelectObjects(ObjectType: Byte);
3781 var
3782 i: Integer;
3783 IDArray: DWArray;
3784 begin
3785 IDArray := ObjectInRect(rRect.X, rRect.Y,
3786 rRect.Width, rRect.Height,
3787 ObjectType, rSelectRect);
3788
3789 if IDArray <> nil then
3790 for i := 0 to High(IDArray) do
3791 SelectObject(ObjectType, IDArray[i], (ssCtrl in Shift) or rSelectRect);
3792 end;
3793 begin
3794 if Button = mbLeft then
3795 MouseLDown := False;
3796 if Button = mbRight then
3797 MouseRDown := False;
3798 if Button = mbMiddle then
3799 MouseMDown := False;
3800
3801 if DrawRect <> nil then
3802 begin
3803 Dispose(DrawRect);
3804 DrawRect := nil;
3805 end;
3806
3807 ResizeType := RESIZETYPE_NONE;
3808 TextureID := 0;
3809
3810 if Button = mbLeft then // Left Mouse Button
3811 begin
3812 if MouseAction <> MOUSEACTION_NONE then
3813 begin // Было действие мышью
3814 // Мышь сдвинулась во время удержания клавиши,
3815 // либо активирован режим быстрого рисования:
3816 if ((MousePos.X <> MouseLDownPos.X) and
3817 (MousePos.Y <> MouseLDownPos.Y)) or
3818 ((MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER]) and
3819 (ssCtrl in Shift)) then
3820 case MouseAction of
3821 // Рисовали панель:
3822 MOUSEACTION_DRAWPANEL:
3823 begin
3824 // Фон или передний план без текстуры - ошибка:
3825 if (lbPanelType.ItemIndex in [1, 2]) and
3826 (lbTextureList.ItemIndex = -1) then
3827 ErrorMessageBox(MsgMsgChooseTexture)
3828 else // Назначаем параметры панели:
3829 begin
3830 case lbPanelType.ItemIndex of
3831 0: Panel.PanelType := PANEL_WALL;
3832 1: Panel.PanelType := PANEL_BACK;
3833 2: Panel.PanelType := PANEL_FORE;
3834 3: Panel.PanelType := PANEL_OPENDOOR;
3835 4: Panel.PanelType := PANEL_CLOSEDOOR;
3836 5: Panel.PanelType := PANEL_STEP;
3837 6: Panel.PanelType := PANEL_WATER;
3838 7: Panel.PanelType := PANEL_ACID1;
3839 8: Panel.PanelType := PANEL_ACID2;
3840 9: Panel.PanelType := PANEL_LIFTUP;
3841 10: Panel.PanelType := PANEL_LIFTDOWN;
3842 11: Panel.PanelType := PANEL_LIFTLEFT;
3843 12: Panel.PanelType := PANEL_LIFTRIGHT;
3844 13: Panel.PanelType := PANEL_BLOCKMON;
3845 end;
3846
3847 Panel.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3848 Panel.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3849 if ssCtrl in Shift then
3850 begin
3851 wWidth := DotStep;
3852 wHeight := DotStep;
3853 if (lbTextureList.ItemIndex <> -1) and
3854 (not IsSpecialTextureSel()) then
3855 begin
3856 if not g_GetTexture(SelectedTexture(), TextureID) then
3857 g_GetTexture('NOTEXTURE', TextureID);
3858 g_GetTextureSizeByID(TextureID, wWidth, wHeight);
3859 end;
3860 Panel.Width := wWidth;
3861 Panel.Height := wHeight;
3862 end
3863 else
3864 begin
3865 Panel.Width := Abs(MousePos.X-MouseLDownPos.X);
3866 Panel.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3867 end;
3868
3869 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3870 if (lbPanelType.ItemIndex in [9, 10, 11, 12, 13]) or
3871 (lbTextureList.ItemIndex = -1) then
3872 begin
3873 Panel.TextureHeight := 1;
3874 Panel.TextureWidth := 1;
3875 Panel.TextureName := '';
3876 Panel.TextureID := TEXTURE_SPECIAL_NONE;
3877 end
3878 else // Есть текстура:
3879 begin
3880 Panel.TextureName := SelectedTexture();
3881
3882 // Обычная текстура:
3883 if not IsSpecialTextureSel() then
3884 begin
3885 g_GetTextureSizeByName(Panel.TextureName,
3886 Panel.TextureWidth, Panel.TextureHeight);
3887 g_GetTexture(Panel.TextureName, Panel.TextureID);
3888 end
3889 else // Спец.текстура:
3890 begin
3891 Panel.TextureHeight := 1;
3892 Panel.TextureWidth := 1;
3893 Panel.TextureID := SpecialTextureID(SelectedTexture());
3894 end;
3895 end;
3896
3897 Panel.Alpha := 0;
3898 Panel.Blending := False;
3899
3900 Undo_Add(OBJECT_PANEL, AddPanel(Panel));
3901 end;
3902 end;
3903
3904 // Рисовали триггер:
3905 MOUSEACTION_DRAWTRIGGER:
3906 begin
3907 trigger.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3908 trigger.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3909 if ssCtrl in Shift then
3910 begin
3911 wWidth := DotStep;
3912 wHeight := DotStep;
3913 trigger.Width := wWidth;
3914 trigger.Height := wHeight;
3915 end
3916 else
3917 begin
3918 trigger.Width := Abs(MousePos.X-MouseLDownPos.X);
3919 trigger.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3920 end;
3921
3922 trigger.Enabled := True;
3923 trigger.TriggerType := lbTriggersList.ItemIndex+1;
3924 trigger.TexturePanel := -1;
3925
3926 // Типы активации:
3927 trigger.ActivateType := 0;
3928
3929 if clbActivationType.Checked[0] then
3930 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERCOLLIDE;
3931 if clbActivationType.Checked[1] then
3932 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERCOLLIDE;
3933 if clbActivationType.Checked[2] then
3934 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERPRESS;
3935 if clbActivationType.Checked[3] then
3936 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERPRESS;
3937 if clbActivationType.Checked[4] then
3938 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_SHOT;
3939 if clbActivationType.Checked[5] then
3940 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_NOMONSTER;
3941
3942 // Необходимые для активации ключи:
3943 trigger.Key := 0;
3944
3945 if clbKeys.Checked[0] then
3946 trigger.Key := Trigger.Key or KEY_RED;
3947 if clbKeys.Checked[1] then
3948 trigger.Key := Trigger.Key or KEY_GREEN;
3949 if clbKeys.Checked[2] then
3950 trigger.Key := Trigger.Key or KEY_BLUE;
3951 if clbKeys.Checked[3] then
3952 trigger.Key := Trigger.Key or KEY_REDTEAM;
3953 if clbKeys.Checked[4] then
3954 trigger.Key := Trigger.Key or KEY_BLUETEAM;
3955
3956 // Параметры триггера:
3957 FillByte(trigger.Data.Default[0], 128, 0);
3958
3959 case trigger.TriggerType of
3960 // Переключаемая панель:
3961 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
3962 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
3963 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
3964 begin
3965 Trigger.Data.PanelID := -1;
3966 end;
3967
3968 // Телепортация:
3969 TRIGGER_TELEPORT:
3970 begin
3971 trigger.Data.TargetPoint.X := trigger.X-64;
3972 trigger.Data.TargetPoint.Y := trigger.Y-64;
3973 trigger.Data.d2d_teleport := True;
3974 trigger.Data.TlpDir := 0;
3975 end;
3976
3977 // Изменение других триггеров:
3978 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF,
3979 TRIGGER_ONOFF:
3980 begin
3981 trigger.Data.Count := 1;
3982 end;
3983
3984 // Звук:
3985 TRIGGER_SOUND:
3986 begin
3987 trigger.Data.Volume := 255;
3988 trigger.Data.Pan := 127;
3989 trigger.Data.PlayCount := 1;
3990 trigger.Data.Local := True;
3991 trigger.Data.SoundSwitch := False;
3992 end;
3993
3994 // Музыка:
3995 TRIGGER_MUSIC:
3996 begin
3997 trigger.Data.MusicAction := 1;
3998 end;
3999
4000 // Создание монстра:
4001 TRIGGER_SPAWNMONSTER:
4002 begin
4003 trigger.Data.MonType := MONSTER_ZOMBY;
4004 trigger.Data.MonPos.X := trigger.X-64;
4005 trigger.Data.MonPos.Y := trigger.Y-64;
4006 trigger.Data.MonHealth := 0;
4007 trigger.Data.MonActive := False;
4008 trigger.Data.MonCount := 1;
4009 end;
4010
4011 // Создание предмета:
4012 TRIGGER_SPAWNITEM:
4013 begin
4014 trigger.Data.ItemType := ITEM_AMMO_BULLETS;
4015 trigger.Data.ItemPos.X := trigger.X-64;
4016 trigger.Data.ItemPos.Y := trigger.Y-64;
4017 trigger.Data.ItemOnlyDM := False;
4018 trigger.Data.ItemFalls := False;
4019 trigger.Data.ItemCount := 1;
4020 trigger.Data.ItemMax := 0;
4021 trigger.Data.ItemDelay := 0;
4022 end;
4023
4024 // Ускорение:
4025 TRIGGER_PUSH:
4026 begin
4027 trigger.Data.PushAngle := 90;
4028 trigger.Data.PushForce := 10;
4029 trigger.Data.ResetVel := True;
4030 end;
4031
4032 TRIGGER_SCORE:
4033 begin
4034 trigger.Data.ScoreCount := 1;
4035 trigger.Data.ScoreCon := True;
4036 trigger.Data.ScoreMsg := True;
4037 end;
4038
4039 TRIGGER_MESSAGE:
4040 begin
4041 trigger.Data.MessageKind := 0;
4042 trigger.Data.MessageSendTo := 0;
4043 trigger.Data.MessageText := '';
4044 trigger.Data.MessageTime := 144;
4045 end;
4046
4047 TRIGGER_DAMAGE:
4048 begin
4049 trigger.Data.DamageValue := 5;
4050 trigger.Data.DamageInterval := 12;
4051 end;
4052
4053 TRIGGER_HEALTH:
4054 begin
4055 trigger.Data.HealValue := 5;
4056 trigger.Data.HealInterval := 36;
4057 end;
4058
4059 TRIGGER_SHOT:
4060 begin
4061 trigger.Data.ShotType := TRIGGER_SHOT_BULLET;
4062 trigger.Data.ShotSound := True;
4063 trigger.Data.ShotPanelID := -1;
4064 trigger.Data.ShotTarget := 0;
4065 trigger.Data.ShotIntSight := 0;
4066 trigger.Data.ShotAim := TRIGGER_SHOT_AIM_DEFAULT;
4067 trigger.Data.ShotPos.X := trigger.X-64;
4068 trigger.Data.ShotPos.Y := trigger.Y-64;
4069 trigger.Data.ShotAngle := 0;
4070 trigger.Data.ShotWait := 18;
4071 trigger.Data.ShotAccuracy := 0;
4072 trigger.Data.ShotAmmo := 0;
4073 trigger.Data.ShotIntReload := 0;
4074 end;
4075
4076 TRIGGER_EFFECT:
4077 begin
4078 trigger.Data.FXCount := 1;
4079 trigger.Data.FXType := TRIGGER_EFFECT_PARTICLE;
4080 trigger.Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
4081 trigger.Data.FXColorR := 0;
4082 trigger.Data.FXColorG := 0;
4083 trigger.Data.FXColorB := 255;
4084 trigger.Data.FXPos := TRIGGER_EFFECT_POS_CENTER;
4085 trigger.Data.FXWait := 1;
4086 trigger.Data.FXVelX := 0;
4087 trigger.Data.FXVelY := -20;
4088 trigger.Data.FXSpreadL := 5;
4089 trigger.Data.FXSpreadR := 5;
4090 trigger.Data.FXSpreadU := 4;
4091 trigger.Data.FXSpreadD := 0;
4092 end;
4093 end;
4094
4095 Undo_Add(OBJECT_TRIGGER, AddTrigger(trigger));
4096 end;
4097
4098 // Рисовали область триггера "Расширитель":
4099 MOUSEACTION_DRAWPRESS:
4100 with gTriggers[SelectedObjects[GetFirstSelected].ID] do
4101 begin
4102 Data.tX := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
4103 Data.tY := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
4104 Data.tWidth := Abs(MousePos.X-MouseLDownPos.X);
4105 Data.tHeight := Abs(MousePos.Y-MouseLDownPos.Y);
4106
4107 DrawPressRect := False;
4108 end;
4109 end;
4110
4111 MouseAction := MOUSEACTION_NONE;
4112 end;
4113 end // if Button = mbLeft...
4114 else if Button = mbRight then // Right Mouse Button:
4115 begin
4116 if MouseAction = MOUSEACTION_NOACTION then
4117 begin
4118 MouseAction := MOUSEACTION_NONE;
4119 Exit;
4120 end;
4121
4122 // Объект передвинут или изменен в размере:
4123 if MouseAction in [MOUSEACTION_MOVEOBJ, MOUSEACTION_RESIZE] then
4124 begin
4125 RenderPanel.Cursor := crDefault;
4126 MouseAction := MOUSEACTION_NONE;
4127 FillProperty();
4128 Exit;
4129 end;
4130
4131 // Еще не все выбрали:
4132 if SelectFlag <> SELECTFLAG_NONE then
4133 begin
4134 if SelectFlag = SELECTFLAG_SELECTED then
4135 SelectFlag := SELECTFLAG_NONE;
4136 FillProperty();
4137 Exit;
4138 end;
4139
4140 // Мышь сдвинулась во время удержания клавиши:
4141 if (MousePos.X <> MouseRDownPos.X) and
4142 (MousePos.Y <> MouseRDownPos.Y) then
4143 begin
4144 rSelectRect := True;
4145
4146 rRect.X := Min(MousePos.X, MouseRDownPos.X)-MapOffset.X;
4147 rRect.Y := Min(MousePos.Y, MouseRDownPos.Y)-MapOffset.Y;
4148 rRect.Width := Abs(MousePos.X-MouseRDownPos.X);
4149 rRect.Height := Abs(MousePos.Y-MouseRDownPos.Y);
4150 end
4151 else // Мышь не сдвинулась - нет прямоугольника:
4152 begin
4153 rSelectRect := False;
4154
4155 rRect.X := X-MapOffset.X-1;
4156 rRect.Y := Y-MapOffset.Y-1;
4157 rRect.Width := 2;
4158 rRect.Height := 2;
4159 end;
4160
4161 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4162 if not (ssCtrl in Shift) then
4163 RemoveSelectFromObjects();
4164
4165 // Выделяем всё в выбранном прямоугольнике:
4166 if (ssCtrl in Shift) and (ssAlt in Shift) then
4167 begin
4168 SelectObjects(OBJECT_PANEL);
4169 SelectObjects(OBJECT_ITEM);
4170 SelectObjects(OBJECT_MONSTER);
4171 SelectObjects(OBJECT_AREA);
4172 SelectObjects(OBJECT_TRIGGER);
4173 end
4174 else
4175 SelectObjects(pcObjects.ActivePageIndex+1);
4176
4177 FillProperty();
4178 end
4179
4180 else // Middle Mouse Button
4181 begin
4182 RenderPanel.Cursor := crDefault;
4183 ReleaseCapture();
4184 end;
4185 end;
4186
4187 procedure TMainForm.RenderPanelPaint(Sender: TObject);
4188 begin
4189 Draw();
4190 end;
4191
4192 function TMainForm.RenderMousePos(): Types.TPoint;
4193 begin
4194 Result := RenderPanel.ScreenToClient(Mouse.CursorPos);
4195 end;
4196
4197 procedure TMainForm.RecountSelectedObjects();
4198 begin
4199 if SelectedObjectCount() = 0 then
4200 StatusBar.Panels[0].Text := ''
4201 else
4202 StatusBar.Panels[0].Text := Format(MsgCapStatSelected, [SelectedObjectCount()]);
4203 end;
4204
4205 procedure TMainForm.RenderPanelMouseMove(Sender: TObject;
4206 Shift: TShiftState; X, Y: Integer);
4207 var
4208 sX, sY: Integer;
4209 dWidth, dHeight: Integer;
4210 _id: Integer;
4211 TextureID: DWORD;
4212 wWidth, wHeight: Word;
4213 begin
4214 _id := GetFirstSelected();
4215 TextureID := 0;
4216
4217 // Рисуем панель с текстурой, сетка - размеры текстуры:
4218 if (MouseAction = MOUSEACTION_DRAWPANEL) and
4219 (lbPanelType.ItemIndex in [0..8]) and
4220 (lbTextureList.ItemIndex <> -1) and
4221 (not IsSpecialTextureSel()) then
4222 begin
4223 sX := StrToIntDef(lTextureWidth.Caption, DotStep);
4224 sY := StrToIntDef(lTextureHeight.Caption, DotStep);
4225 end
4226 else
4227 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4228 if (MouseAction = MOUSEACTION_RESIZE) and
4229 ( (SelectedObjects[_id].ObjectType = OBJECT_PANEL) and
4230 IsTexturedPanel(gPanels[SelectedObjects[_id].ID].PanelType) and
4231 (gPanels[SelectedObjects[_id].ID].TextureName <> '') and
4232 (not IsSpecialTexture(gPanels[SelectedObjects[_id].ID].TextureName)) ) then
4233 begin
4234 sX := gPanels[SelectedObjects[_id].ID].TextureWidth;
4235 sY := gPanels[SelectedObjects[_id].ID].TextureHeight;
4236 end
4237 else
4238 // Выравнивание по сетке:
4239 if SnapToGrid then
4240 begin
4241 sX := DotStep;
4242 sY := DotStep;
4243 end
4244 else // Нет выравнивания по сетке:
4245 begin
4246 sX := 1;
4247 sY := 1;
4248 end;
4249
4250 // Новая позиция мыши:
4251 if MouseLDown then
4252 begin // Зажата левая кнопка мыши
4253 MousePos.X := (Round((X-MouseLDownPos.X)/sX)*sX)+MouseLDownPos.X;
4254 MousePos.Y := (Round((Y-MouseLDownPos.Y)/sY)*sY)+MouseLDownPos.Y;
4255 end
4256 else
4257 if MouseRDown then
4258 begin // Зажата правая кнопка мыши
4259 MousePos.X := (Round((X-MouseRDownPos.X)/sX)*sX)+MouseRDownPos.X;
4260 MousePos.Y := (Round((Y-MouseRDownPos.Y)/sY)*sY)+MouseRDownPos.Y;
4261 end
4262 else
4263 begin // Кнопки мыши не зажаты
4264 MousePos.X := Round((-MapOffset.X + X) / sX) * sX + MapOffset.X;
4265 MousePos.Y := Round((-MapOffset.Y + Y) / sY) * sY + MapOffset.Y;
4266 end;
4267
4268 // Зажата только правая кнопка мыши:
4269 if (not MouseLDown) and (MouseRDown) and (not MouseMDown) then
4270 begin
4271 // Рисуем прямоугольник выделения:
4272 if MouseAction = MOUSEACTION_NONE then
4273 begin
4274 if DrawRect = nil then
4275 New(DrawRect);
4276 DrawRect.Top := MouseRDownPos.y;
4277 DrawRect.Left := MouseRDownPos.x;
4278 DrawRect.Bottom := MousePos.y;
4279 DrawRect.Right := MousePos.x;
4280 end
4281 else
4282 // Двигаем выделенные объекты:
4283 if MouseAction = MOUSEACTION_MOVEOBJ then
4284 begin
4285 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift,
4286 MousePos.X-LastMovePoint.X,
4287 MousePos.Y-LastMovePoint.Y);
4288 end
4289 else
4290 // Меняем размер выделенного объекта:
4291 if MouseAction = MOUSEACTION_RESIZE then
4292 begin
4293 if (SelectedObjectCount = 1) and
4294 (SelectedObjects[GetFirstSelected].Live) then
4295 begin
4296 dWidth := MousePos.X-LastMovePoint.X;
4297 dHeight := MousePos.Y-LastMovePoint.Y;
4298
4299 case ResizeType of
4300 RESIZETYPE_VERTICAL: dWidth := 0;
4301 RESIZETYPE_HORIZONTAL: dHeight := 0;
4302 end;
4303
4304 case ResizeDirection of
4305 RESIZEDIR_UP: dHeight := -dHeight;
4306 RESIZEDIR_LEFT: dWidth := -dWidth;
4307 end;
4308
4309 if ResizeObject(SelectedObjects[GetFirstSelected].ObjectType,
4310 SelectedObjects[GetFirstSelected].ID,
4311 dWidth, dHeight, ResizeDirection) then
4312 LastMovePoint := MousePos;
4313 end;
4314 end;
4315 end;
4316
4317 // Зажата только левая кнопка мыши:
4318 if (not MouseRDown) and (MouseLDown) and (not MouseMDown) then
4319 begin
4320 // Рисуем прямоугольник планирования панели:
4321 if MouseAction in [MOUSEACTION_DRAWPANEL,
4322 MOUSEACTION_DRAWTRIGGER,
4323 MOUSEACTION_DRAWPRESS] then
4324 begin
4325 if DrawRect = nil then
4326 New(DrawRect);
4327 if ssCtrl in Shift then
4328 begin
4329 wWidth := DotStep;
4330 wHeight := DotStep;
4331 if (lbTextureList.ItemIndex <> -1) and (not IsSpecialTextureSel()) and
4332 (MouseAction = MOUSEACTION_DRAWPANEL) then
4333 begin
4334 if not g_GetTexture(SelectedTexture(), TextureID) then
4335 g_GetTexture('NOTEXTURE', TextureID);
4336 g_GetTextureSizeByID(TextureID, wWidth, wHeight);
4337 end;
4338 DrawRect.Top := MouseLDownPos.y;
4339 DrawRect.Left := MouseLDownPos.x;
4340 DrawRect.Bottom := DrawRect.Top + wHeight;
4341 DrawRect.Right := DrawRect.Left + wWidth;
4342 end
4343 else
4344 begin
4345 DrawRect.Top := MouseLDownPos.y;
4346 DrawRect.Left := MouseLDownPos.x;
4347 DrawRect.Bottom := MousePos.y;
4348 DrawRect.Right := MousePos.x;
4349 end;
4350 end
4351 else // Двигаем карту:
4352 if MouseAction = MOUSEACTION_MOVEMAP then
4353 begin
4354 MoveMap(X, Y);
4355 end;
4356 end;
4357
4358 // Only Middle Mouse Button is pressed
4359 if (not MouseLDown) and (not MouseRDown) and (MouseMDown) then
4360 begin
4361 MapOffset.X := -EnsureRange(-MapOffset.X + MouseMDownPos.X - Mouse.CursorPos.X,
4362 sbHorizontal.Min, sbHorizontal.Max);
4363 sbHorizontal.Position := -MapOffset.X;
4364 MapOffset.Y := -EnsureRange(-MapOffset.Y + MouseMDownPos.Y - Mouse.CursorPos.Y,
4365 sbVertical.Min, sbVertical.Max);
4366 sbVertical.Position := -MapOffset.Y;
4367 MouseMDownPos := Mouse.CursorPos;
4368 end;
4369
4370 // Клавиши мыши не зажаты:
4371 if (not MouseRDown) and (not MouseLDown) and (DrawRect <> nil) then
4372 begin
4373 Dispose(DrawRect);
4374 DrawRect := nil;
4375 end;
4376
4377 // Строка состояния - координаты мыши:
4378 StatusBar.Panels[1].Text := Format('(%d:%d)',
4379 [MousePos.X-MapOffset.X, MousePos.Y-MapOffset.Y]);
4380
4381 RenderPanel.Invalidate;
4382 end;
4383
4384 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
4385 begin
4386 CanClose := Application.MessageBox(PChar(MsgMsgExitPrompt),
4387 PChar(MsgMsgExit),
4388 MB_ICONQUESTION or MB_YESNO or
4389 MB_DEFBUTTON1) = idYes;
4390 end;
4391
4392 procedure TMainForm.aExitExecute(Sender: TObject);
4393 begin
4394 Close();
4395 end;
4396
4397 procedure TMainForm.FormDestroy(Sender: TObject);
4398 var
4399 config: TConfig;
4400 s: AnsiString;
4401 i: Integer;
4402 begin
4403 config := TConfig.CreateFile(CfgFileName);
4404
4405 config.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel);
4406
4407 if WindowState <> wsMaximized then
4408 begin
4409 config.WriteInt('Editor', 'XPos', Left);
4410 config.WriteInt('Editor', 'YPos', Top);
4411 config.WriteInt('Editor', 'Width', Width);
4412 config.WriteInt('Editor', 'Height', Height);
4413 end
4414 else
4415 begin
4416 config.WriteInt('Editor', 'XPos', RestoredLeft);
4417 config.WriteInt('Editor', 'YPos', RestoredTop);
4418 config.WriteInt('Editor', 'Width', RestoredWidth);
4419 config.WriteInt('Editor', 'Height', RestoredHeight);
4420 end;
4421 config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
4422 config.WriteBool('Editor', 'Minimap', ShowMap);
4423 config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
4424 config.WriteInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
4425 config.WriteBool('Editor', 'DotEnable', DotEnable);
4426 config.WriteInt('Editor', 'DotStep', DotStep);
4427 config.WriteStr('Editor', 'LastOpenDir', OpenDialog.InitialDir);
4428 config.WriteStr('Editor', 'LastSaveDir', SaveDialog.InitialDir);
4429 config.WriteStr('Editor', 'Language', gLanguage);
4430 config.WriteBool('Editor', 'EdgeShow', drEdge[3] < 255);
4431 config.WriteInt('Editor', 'EdgeColor', gColorEdge);
4432 config.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge);
4433 config.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine);
4434 config.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea);
4435 config.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect);
4436 config.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect);
4437
4438 for i := 0 to RecentCount - 1 do
4439 begin
4440 if i < RecentFiles.Count then s := RecentFiles[i] else s := '';
4441 {$IFDEF WINDOWS}
4442 config.WriteStr('RecentFilesWin', IntToStr(i), s);
4443 {$ELSE}
4444 config.WriteStr('RecentFilesUnix', IntToStr(i), s);
4445 {$ENDIF}
4446 end;
4447 RecentFiles.Free();
4448
4449 config.SaveFile(CfgFileName);
4450 config.Free();
4451
4452 slInvalidTextures.Free();
4453 DiscardUndoBuffer();
4454 end;
4455
4456 procedure TMainForm.FormDropFiles(Sender: TObject;
4457 const FileNames: array of String);
4458 begin
4459 if Length(FileNames) <> 1 then
4460 Exit;
4461
4462 OpenMapFile(FileNames[0]);
4463 end;
4464
4465 procedure TMainForm.RenderPanelResize(Sender: TObject);
4466 begin
4467 if MainForm.Visible then
4468 MainForm.Resize();
4469 end;
4470
4471 procedure TMainForm.Splitter1Moved(Sender: TObject);
4472 begin
4473 FormResize(Sender);
4474 end;
4475
4476 procedure TMainForm.MapTestCheck(Sender: TObject);
4477 begin
4478 if MapTestProcess <> nil then
4479 begin
4480 if MapTestProcess.Running = false then
4481 begin
4482 if MapTestProcess.ExitCode <> 0 then
4483 Application.MessageBox(PChar(MsgMsgExecError), 'FIXME', MB_OK or MB_ICONERROR);
4484 SysUtils.DeleteFile(MapTestFile);
4485 MapTestFile := '';
4486 FreeAndNil(MapTestProcess);
4487 tbTestMap.Enabled := True;
4488 end;
4489 end;
4490 end;
4491
4492 procedure TMainForm.aMapOptionsExecute(Sender: TObject);
4493 var
4494 ResName: String;
4495 begin
4496 MapOptionsForm.ShowModal();
4497
4498 ResName := OpenedMap;
4499 while (Pos(':\', ResName) > 0) do
4500 Delete(ResName, 1, Pos(':\', ResName) + 1);
4501
4502 UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName);
4503 end;
4504
4505 procedure TMainForm.aAboutExecute(Sender: TObject);
4506 begin
4507 AboutForm.ShowModal();
4508 end;
4509
4510 procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
4511 var
4512 dx, dy, i: Integer;
4513 FileName: String;
4514 ok: Boolean;
4515 begin
4516 if (not EditingProperties) then
4517 begin
4518 if ssCtrl in Shift then
4519 begin
4520 case Chr(Key) of
4521 '1': ContourEnabled[LAYER_BACK] := not ContourEnabled[LAYER_BACK];
4522 '2': ContourEnabled[LAYER_WALLS] := not ContourEnabled[LAYER_WALLS];
4523 '3': ContourEnabled[LAYER_FOREGROUND] := not ContourEnabled[LAYER_FOREGROUND];
4524 '4': ContourEnabled[LAYER_STEPS] := not ContourEnabled[LAYER_STEPS];
4525 '5': ContourEnabled[LAYER_WATER] := not ContourEnabled[LAYER_WATER];
4526 '6': ContourEnabled[LAYER_ITEMS] := not ContourEnabled[LAYER_ITEMS];
4527 '7': ContourEnabled[LAYER_MONSTERS] := not ContourEnabled[LAYER_MONSTERS];
4528 '8': ContourEnabled[LAYER_AREAS] := not ContourEnabled[LAYER_AREAS];
4529 '9': ContourEnabled[LAYER_TRIGGERS] := not ContourEnabled[LAYER_TRIGGERS];
4530 '0':
4531 begin
4532 ok := False;
4533 for i := Low(ContourEnabled) to High(ContourEnabled) do
4534 if ContourEnabled[i] then
4535 ok := True;
4536 for i := Low(ContourEnabled) to High(ContourEnabled) do
4537 ContourEnabled[i] := not ok
4538 end
4539 end
4540 end
4541 else
4542 begin
4543 case Chr(key) of
4544 '1': SwitchLayer(LAYER_BACK);
4545 '2': SwitchLayer(LAYER_WALLS);
4546 '3': SwitchLayer(LAYER_FOREGROUND);
4547 '4': SwitchLayer(LAYER_STEPS);
4548 '5': SwitchLayer(LAYER_WATER);
4549 '6': SwitchLayer(LAYER_ITEMS);
4550 '7': SwitchLayer(LAYER_MONSTERS);
4551 '8': SwitchLayer(LAYER_AREAS);
4552 '9': SwitchLayer(LAYER_TRIGGERS);
4553 '0': tbShowClick(tbShow);
4554 end
4555 end;
4556
4557 if Key = Ord('I') then
4558 begin // Поворот монстров и областей:
4559 if (SelectedObjects <> nil) then
4560 begin
4561 for i := 0 to High(SelectedObjects) do
4562 if (SelectedObjects[i].Live) then
4563 begin
4564 if (SelectedObjects[i].ObjectType = OBJECT_MONSTER) then
4565 begin
4566 g_ChangeDir(gMonsters[SelectedObjects[i].ID].Direction);
4567 end
4568 else
4569 if (SelectedObjects[i].ObjectType = OBJECT_AREA) then
4570 begin
4571 g_ChangeDir(gAreas[SelectedObjects[i].ID].Direction);
4572 end;
4573 end;
4574 end
4575 else
4576 begin
4577 if pcObjects.ActivePage = tsMonsters then
4578 begin
4579 if rbMonsterLeft.Checked then
4580 rbMonsterRight.Checked := True
4581 else
4582 rbMonsterLeft.Checked := True;
4583 end;
4584 if pcObjects.ActivePage = tsAreas then
4585 begin
4586 if rbAreaLeft.Checked then
4587 rbAreaRight.Checked := True
4588 else
4589 rbAreaLeft.Checked := True;
4590 end;
4591 end;
4592 end;
4593
4594 if not (ssCtrl in Shift) then
4595 begin
4596 // Быстрое превью карты:
4597 if Key = Ord('E') then
4598 begin
4599 if PreviewMode = 0 then
4600 PreviewMode := 2;
4601 end;
4602
4603 // Вертикальный скролл карты:
4604 with sbVertical do
4605 begin
4606 if Key = Ord('W') then
4607 begin
4608 dy := Position;
4609 if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max)
4610 else Position := EnsureRange(Position - DotStep, Min, Max);
4611 MapOffset.Y := -Position;
4612 dy -= Position;
4613
4614 if (MouseLDown or MouseRDown) then
4615 begin
4616 if DrawRect <> nil then
4617 begin
4618 Inc(MouseLDownPos.y, dy);
4619 Inc(MouseRDownPos.y, dy);
4620 end;
4621 Inc(LastMovePoint.Y, dy);
4622 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4623 end;
4624 end;
4625
4626 if Key = Ord('S') then
4627 begin
4628 dy := Position;
4629 if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max)
4630 else Position := EnsureRange(Position + DotStep, Min, Max);
4631 MapOffset.Y := -Position;
4632 dy -= Position;
4633
4634 if (MouseLDown or MouseRDown) then
4635 begin
4636 if DrawRect <> nil then
4637 begin
4638 Inc(MouseLDownPos.y, dy);
4639 Inc(MouseRDownPos.y, dy);
4640 end;
4641 Inc(LastMovePoint.Y, dy);
4642 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4643 end;
4644 end;
4645 end;
4646
4647 // Горизонтальный скролл карты:
4648 with sbHorizontal do
4649 begin
4650 if Key = Ord('A') then
4651 begin
4652 dx := Position;
4653 if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max)
4654 else Position := EnsureRange(Position - DotStep, Min, Max);
4655 MapOffset.X := -Position;
4656 dx -= Position;
4657
4658 if (MouseLDown or MouseRDown) then
4659 begin
4660 if DrawRect <> nil then
4661 begin
4662 Inc(MouseLDownPos.x, dx);
4663 Inc(MouseRDownPos.x, dx);
4664 end;
4665 Inc(LastMovePoint.X, dx);
4666 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4667 end;
4668 end;
4669
4670 if Key = Ord('D') then
4671 begin
4672 dx := Position;
4673 if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max)
4674 else Position := EnsureRange(Position + DotStep, Min, Max);
4675 MapOffset.X := -Position;
4676 dx -= Position;
4677
4678 if (MouseLDown or MouseRDown) then
4679 begin
4680 if DrawRect <> nil then
4681 begin
4682 Inc(MouseLDownPos.x, dx);
4683 Inc(MouseRDownPos.x, dx);
4684 end;
4685 Inc(LastMovePoint.X, dx);
4686 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4687 end;
4688 end;
4689 end;
4690 end
4691 else // ssCtrl in Shift
4692 begin
4693 if ssShift in Shift then
4694 begin
4695 // Вставка по абсолютному смещению:
4696 if Key = Ord('V') then
4697 aPasteObjectExecute(Sender);
4698 end;
4699 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4700 end;
4701 end;
4702
4703 // Удалить выделенные объекты:
4704 if (Key = VK_DELETE) and (SelectedObjects <> nil) and RenderPanel.Focused() then
4705 DeleteSelectedObjects();
4706
4707 // Снять выделение:
4708 if (Key = VK_ESCAPE) and (SelectedObjects <> nil) then
4709 RemoveSelectFromObjects();
4710
4711 // Передвинуть объекты:
4712 if MainForm.ActiveControl = RenderPanel then
4713 begin
4714 dx := 0;
4715 dy := 0;
4716
4717 if Key = VK_NUMPAD4 then
4718 dx := IfThen(ssAlt in Shift, -1, -DotStep);
4719 if Key = VK_NUMPAD6 then
4720 dx := IfThen(ssAlt in Shift, 1, DotStep);
4721 if Key = VK_NUMPAD8 then
4722 dy := IfThen(ssAlt in Shift, -1, -DotStep);
4723 if Key = VK_NUMPAD5 then
4724 dy := IfThen(ssAlt in Shift, 1, DotStep);
4725
4726 if (dx <> 0) or (dy <> 0) then
4727 begin
4728 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift, dx, dy);
4729 Key := 0;
4730 end;
4731 end;
4732
4733 if ssCtrl in Shift then
4734 begin
4735 // Выбор панели с текстурой для триггера
4736 if Key = Ord('T') then
4737 begin
4738 DrawPressRect := False;
4739 if SelectFlag = SELECTFLAG_TEXTURE then
4740 begin
4741 SelectFlag := SELECTFLAG_NONE;
4742 Exit;
4743 end;
4744 vleObjectProperty.FindRow(MsgPropTrTexturePanel, i);
4745 if i > 0 then
4746 SelectFlag := SELECTFLAG_TEXTURE;
4747 end;
4748
4749 if Key = Ord('D') then
4750 begin
4751 SelectFlag := SELECTFLAG_NONE;
4752 if DrawPressRect then
4753 begin
4754 DrawPressRect := False;
4755 Exit;
4756 end;
4757 i := -1;
4758
4759 // Выбор области воздействия, в зависимости от типа триггера
4760 vleObjectProperty.FindRow(MsgPropTrExArea, i);
4761 if i > 0 then
4762 begin
4763 DrawPressRect := True;
4764 Exit;
4765 end;
4766 vleObjectProperty.FindRow(MsgPropTrDoorPanel, i);
4767 if i <= 0 then
4768 vleObjectProperty.FindRow(MsgPropTrTrapPanel, i);
4769 if i > 0 then
4770 begin
4771 SelectFlag := SELECTFLAG_DOOR;
4772 Exit;
4773 end;
4774 vleObjectProperty.FindRow(MsgPropTrLiftPanel, i);
4775 if i > 0 then
4776 begin
4777 SelectFlag := SELECTFLAG_LIFT;
4778 Exit;
4779 end;
4780 vleObjectProperty.FindRow(MsgPropTrTeleportTo, i);
4781 if i > 0 then
4782 begin
4783 SelectFlag := SELECTFLAG_TELEPORT;
4784 Exit;
4785 end;
4786 vleObjectProperty.FindRow(MsgPropTrSpawnTo, i);
4787 if i > 0 then
4788 begin
4789 SelectFlag := SELECTFLAG_SPAWNPOINT;
4790 Exit;
4791 end;
4792
4793 // Выбор основного параметра, в зависимости от типа триггера
4794 vleObjectProperty.FindRow(MsgPropTrNextMap, i);
4795 if i > 0 then
4796 begin
4797 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
4798 SelectMapForm.Caption := MsgCapSelect;
4799 SelectMapForm.GetMaps(FileName);
4800
4801 if SelectMapForm.ShowModal() = mrOK then
4802 begin
4803 vleObjectProperty.Cells[1, i] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
4804 bApplyProperty.Click();
4805 end;
4806 Exit;
4807 end;
4808 vleObjectProperty.FindRow(MsgPropTrSoundName, i);
4809 if i <= 0 then
4810 vleObjectProperty.FindRow(MsgPropTrMusicName, i);
4811 if i > 0 then
4812 begin
4813 AddSoundForm.OKFunction := nil;
4814 AddSoundForm.lbResourcesList.MultiSelect := False;
4815 AddSoundForm.SetResource := vleObjectProperty.Cells[1, i];
4816
4817 if (AddSoundForm.ShowModal() = mrOk) then
4818 begin
4819 vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName;
4820 bApplyProperty.Click();
4821 end;
4822 Exit;
4823 end;
4824 vleObjectProperty.FindRow(MsgPropTrPushAngle, i);
4825 if i <= 0 then
4826 vleObjectProperty.FindRow(MsgPropTrMessageText, i);
4827 if i > 0 then
4828 begin
4829 vleObjectProperty.Row := i;
4830 vleObjectProperty.SetFocus();
4831 Exit;
4832 end;
4833 end;
4834 end;
4835 end;
4836
4837 procedure TMainForm.aOptimizeExecute(Sender: TObject);
4838 begin
4839 RemoveSelectFromObjects();
4840 MapOptimizationForm.ShowModal();
4841 end;
4842
4843 procedure TMainForm.aCheckMapExecute(Sender: TObject);
4844 begin
4845 MapCheckForm.ShowModal();
4846 end;
4847
4848 procedure TMainForm.bbAddTextureClick(Sender: TObject);
4849 begin
4850 AddTextureForm.lbResourcesList.MultiSelect := True;
4851 AddTextureForm.ShowModal();
4852 end;
4853
4854 procedure TMainForm.lbTextureListClick(Sender: TObject);
4855 var
4856 TextureID: DWORD;
4857 TextureWidth, TextureHeight: Word;
4858 begin
4859 TextureID := 0;
4860 TextureWidth := 0;
4861 TextureHeight := 0;
4862 if (lbTextureList.ItemIndex <> -1) and
4863 (not IsSpecialTextureSel()) then
4864 begin
4865 if g_GetTexture(SelectedTexture(), TextureID) then
4866 begin
4867 g_GetTextureSizeByID(TextureID, TextureWidth, TextureHeight);
4868
4869 lTextureWidth.Caption := IntToStr(TextureWidth);
4870 lTextureHeight.Caption := IntToStr(TextureHeight);
4871 end else
4872 begin
4873 lTextureWidth.Caption := MsgNotAccessible;
4874 lTextureHeight.Caption := MsgNotAccessible;
4875 end;
4876 end
4877 else
4878 begin
4879 lTextureWidth.Caption := '';
4880 lTextureHeight.Caption := '';
4881 end;
4882 end;
4883
4884 procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
4885 ARect: TRect; State: TOwnerDrawState);
4886 begin
4887 with Control as TListBox do
4888 begin
4889 if LCLType.odSelected in State then
4890 begin
4891 Canvas.Brush.Color := clHighlight;
4892 Canvas.Font.Color := clHighlightText;
4893 end else
4894 if (Items <> nil) and (Index >= 0) then
4895 if slInvalidTextures.IndexOf(Items[Index]) > -1 then
4896 begin
4897 Canvas.Brush.Color := clRed;
4898 Canvas.Font.Color := clWhite;
4899 end;
4900 Canvas.FillRect(ARect);
4901 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
4902 end;
4903 end;
4904
4905 procedure TMainForm.miMacMinimizeClick(Sender: TObject);
4906 begin
4907 self.WindowState := wsMinimized;
4908 self.FormWindowStateChange(Sender);
4909 end;
4910
4911 procedure TMainForm.miMacZoomClick(Sender: TObject);
4912 begin
4913 if self.WindowState = wsMaximized then
4914 self.WindowState := wsNormal
4915 else
4916 self.WindowState := wsMaximized;
4917 self.FormWindowStateChange(Sender);
4918 end;
4919
4920 procedure TMainForm.miReopenMapClick(Sender: TObject);
4921 var
4922 FileName, Resource: String;
4923 begin
4924 if OpenedMap = '' then
4925 Exit;
4926
4927 if Application.MessageBox(PChar(MsgMsgReopenMapPrompt),
4928 PChar(MsgMenuFileReopen), MB_ICONQUESTION or MB_YESNO) <> idYes then
4929 Exit;
4930
4931 g_ProcessResourceStr(OpenedMap, @FileName, nil, @Resource);
4932 OpenMap(FileName, Resource);
4933 end;
4934
4935 procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
4936 const KeyName: String; Values: TStrings);
4937 begin
4938 if vleObjectProperty.ItemProps[KeyName].EditStyle = esPickList then
4939 begin
4940 if KeyName = MsgPropDirection then
4941 begin
4942 Values.Add(DirNames[D_LEFT]);
4943 Values.Add(DirNames[D_RIGHT]);
4944 end
4945 else if KeyName = MsgPropTrTeleportDir then
4946 begin
4947 Values.Add(DirNamesAdv[0]);
4948 Values.Add(DirNamesAdv[1]);
4949 Values.Add(DirNamesAdv[2]);
4950 Values.Add(DirNamesAdv[3]);
4951 end
4952 else if KeyName = MsgPropTrMusicAct then
4953 begin
4954 Values.Add(MsgPropTrMusicOn);
4955 Values.Add(MsgPropTrMusicOff);
4956 end
4957 else if KeyName = MsgPropTrMonsterBehaviour then
4958 begin
4959 Values.Add(MsgPropTrMonsterBehaviour0);
4960 Values.Add(MsgPropTrMonsterBehaviour1);
4961 Values.Add(MsgPropTrMonsterBehaviour2);
4962 Values.Add(MsgPropTrMonsterBehaviour3);
4963 Values.Add(MsgPropTrMonsterBehaviour4);
4964 Values.Add(MsgPropTrMonsterBehaviour5);
4965 end
4966 else if KeyName = MsgPropTrScoreAct then
4967 begin
4968 Values.Add(MsgPropTrScoreAct0);
4969 Values.Add(MsgPropTrScoreAct1);
4970 Values.Add(MsgPropTrScoreAct2);
4971 Values.Add(MsgPropTrScoreAct3);
4972 end
4973 else if KeyName = MsgPropTrScoreTeam then
4974 begin
4975 Values.Add(MsgPropTrScoreTeam0);
4976 Values.Add(MsgPropTrScoreTeam1);
4977 Values.Add(MsgPropTrScoreTeam2);
4978 Values.Add(MsgPropTrScoreTeam3);
4979 end
4980 else if KeyName = MsgPropTrMessageKind then
4981 begin
4982 Values.Add(MsgPropTrMessageKind0);
4983 Values.Add(MsgPropTrMessageKind1);
4984 end
4985 else if KeyName = MsgPropTrMessageTo then
4986 begin
4987 Values.Add(MsgPropTrMessageTo0);
4988 Values.Add(MsgPropTrMessageTo1);
4989 Values.Add(MsgPropTrMessageTo2);
4990 Values.Add(MsgPropTrMessageTo3);
4991 Values.Add(MsgPropTrMessageTo4);
4992 Values.Add(MsgPropTrMessageTo5);
4993 end
4994 else if KeyName = MsgPropTrShotTo then
4995 begin
4996 Values.Add(MsgPropTrShotTo0);
4997 Values.Add(MsgPropTrShotTo1);
4998 Values.Add(MsgPropTrShotTo2);
4999 Values.Add(MsgPropTrShotTo3);
5000 Values.Add(MsgPropTrShotTo4);
5001 Values.Add(MsgPropTrShotTo5);
5002 Values.Add(MsgPropTrShotTo6);
5003 end
5004 else if KeyName = MsgPropTrShotAim then
5005 begin
5006 Values.Add(MsgPropTrShotAim0);
5007 Values.Add(MsgPropTrShotAim1);
5008 Values.Add(MsgPropTrShotAim2);
5009 Values.Add(MsgPropTrShotAim3);
5010 end
5011 else if KeyName = MsgPropTrDamageKind then
5012 begin
5013 Values.Add(MsgPropTrDamageKind0);
5014 Values.Add(MsgPropTrDamageKind3);
5015 Values.Add(MsgPropTrDamageKind4);
5016 Values.Add(MsgPropTrDamageKind5);
5017 Values.Add(MsgPropTrDamageKind6);
5018 Values.Add(MsgPropTrDamageKind7);
5019 Values.Add(MsgPropTrDamageKind8);
5020 end
5021 else if (KeyName = MsgPropPanelBlend) or
5022 (KeyName = MsgPropDmOnly) or
5023 (KeyName = MsgPropItemFalls) or
5024 (KeyName = MsgPropTrEnabled) or
5025 (KeyName = MsgPropTrD2d) or
5026 (KeyName = MsgPropTrSilent) or
5027 (KeyName = MsgPropTrTeleportSilent) or
5028 (KeyName = MsgPropTrExRandom) or
5029 (KeyName = MsgPropTrTextureOnce) or
5030 (KeyName = MsgPropTrTextureAnimOnce) or
5031 (KeyName = MsgPropTrSoundLocal) or
5032 (KeyName = MsgPropTrSoundSwitch) or
5033 (KeyName = MsgPropTrMonsterActive) or
5034 (KeyName = MsgPropTrPushReset) or
5035 (KeyName = MsgPropTrScoreCon) or
5036 (KeyName = MsgPropTrScoreMsg) or
5037 (KeyName = MsgPropTrHealthMax) or
5038 (KeyName = MsgPropTrShotSound) or
5039 (KeyName = MsgPropTrEffectCenter) then
5040 begin
5041 Values.Add(BoolNames[True]);
5042 Values.Add(BoolNames[False]);
5043 end;
5044 end;
5045 end;
5046
5047 procedure TMainForm.bApplyPropertyClick(Sender: TObject);
5048 var
5049 _id, a, r, c: Integer;
5050 s: String;
5051 res: Boolean;
5052 NoTextureID: DWORD;
5053 NW, NH: Word;
5054 begin
5055 NoTextureID := 0;
5056 NW := 0;
5057 NH := 0;
5058
5059 if SelectedObjectCount() <> 1 then
5060 Exit;
5061 if not SelectedObjects[GetFirstSelected()].Live then
5062 Exit;
5063
5064 try
5065 if not CheckProperty() then
5066 Exit;
5067 except
5068 Exit;
5069 end;
5070
5071 _id := GetFirstSelected();
5072
5073 r := vleObjectProperty.Row;
5074 c := vleObjectProperty.Col;
5075
5076 case SelectedObjects[_id].ObjectType of
5077 OBJECT_PANEL:
5078 begin
5079 with gPanels[SelectedObjects[_id].ID] do
5080 begin
5081 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5082 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5083 Width := StrToInt(Trim(vleObjectProperty.Values[MsgPropWidth]));
5084 Height := StrToInt(Trim(vleObjectProperty.Values[MsgPropHeight]));
5085
5086 PanelType := GetPanelType(vleObjectProperty.Values[MsgPropPanelType]);
5087
5088 // Сброс ссылки на триггеры смены текстуры:
5089 if not WordBool(PanelType and (PANEL_WALL or PANEL_FORE or PANEL_BACK)) then
5090 if gTriggers <> nil then
5091 for a := 0 to High(gTriggers) do
5092 begin
5093 if (gTriggers[a].TriggerType <> 0) and
5094 (gTriggers[a].TexturePanel = Integer(SelectedObjects[_id].ID)) then
5095 gTriggers[a].TexturePanel := -1;
5096 if (gTriggers[a].TriggerType = TRIGGER_SHOT) and
5097 (gTriggers[a].Data.ShotPanelID = Integer(SelectedObjects[_id].ID)) then
5098 gTriggers[a].Data.ShotPanelID := -1;
5099 end;
5100
5101 // Сброс ссылки на триггеры лифта:
5102 if not WordBool(PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT)) then
5103 if gTriggers <> nil then
5104 for a := 0 to High(gTriggers) do
5105 if (gTriggers[a].TriggerType in [TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT]) and
5106 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
5107 gTriggers[a].Data.PanelID := -1;
5108
5109 // Сброс ссылки на триггеры двери:
5110 if not WordBool(PanelType and (PANEL_OPENDOOR or PANEL_CLOSEDOOR)) then
5111 if gTriggers <> nil then
5112 for a := 0 to High(gTriggers) do
5113 if (gTriggers[a].TriggerType in [TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5114 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP]) and
5115 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
5116 gTriggers[a].Data.PanelID := -1;
5117
5118 if IsTexturedPanel(PanelType) then
5119 begin // Может быть текстура
5120 if TextureName <> '' then
5121 begin // Была текстура
5122 Alpha := StrToInt(Trim(vleObjectProperty.Values[MsgPropPanelAlpha]));
5123 Blending := NameToBool(vleObjectProperty.Values[MsgPropPanelBlend]);
5124 end
5125 else // Не было
5126 begin
5127 Alpha := 0;
5128 Blending := False;
5129 end;
5130
5131 // Новая текстура:
5132 TextureName := vleObjectProperty.Values[MsgPropPanelTex];
5133
5134 if TextureName <> '' then
5135 begin // Есть текстура
5136 // Обычная текстура:
5137 if not IsSpecialTexture(TextureName) then
5138 begin
5139 g_GetTextureSizeByName(TextureName,
5140 TextureWidth, TextureHeight);
5141
5142 // Проверка кратности размеров панели:
5143 res := True;
5144 if TextureWidth <> 0 then
5145 if gPanels[SelectedObjects[_id].ID].Width mod TextureWidth <> 0 then
5146 begin
5147 ErrorMessageBox(Format(MsgMsgWrongTexwidth,
5148 [TextureWidth]));
5149 Res := False;
5150 end;
5151 if Res and (TextureHeight <> 0) then
5152 if gPanels[SelectedObjects[_id].ID].Height mod TextureHeight <> 0 then
5153 begin
5154 ErrorMessageBox(Format(MsgMsgWrongTexheight,
5155 [TextureHeight]));
5156 Res := False;
5157 end;
5158
5159 if Res then
5160 begin
5161 if not g_GetTexture(TextureName, TextureID) then
5162 // Не удалось загрузить текстуру, рисуем NOTEXTURE
5163 if g_GetTexture('NOTEXTURE', NoTextureID) then
5164 begin
5165 TextureID := TEXTURE_SPECIAL_NOTEXTURE;
5166 g_GetTextureSizeByID(NoTextureID, NW, NH);
5167 TextureWidth := NW;
5168 TextureHeight := NH;
5169 end else
5170 begin
5171 TextureID := TEXTURE_SPECIAL_NONE;
5172 TextureWidth := 1;
5173 TextureHeight := 1;
5174 end;
5175 end
5176 else
5177 begin
5178 TextureName := '';
5179 TextureWidth := 1;
5180 TextureHeight := 1;
5181 TextureID := TEXTURE_SPECIAL_NONE;
5182 end;
5183 end
5184 else // Спец.текстура
5185 begin
5186 TextureHeight := 1;
5187 TextureWidth := 1;
5188 TextureID := SpecialTextureID(TextureName);
5189 end;
5190 end
5191 else // Нет текстуры
5192 begin
5193 TextureWidth := 1;
5194 TextureHeight := 1;
5195 TextureID := TEXTURE_SPECIAL_NONE;
5196 end;
5197 end
5198 else // Не может быть текстуры
5199 begin
5200 Alpha := 0;
5201 Blending := False;
5202 TextureName := '';
5203 TextureWidth := 1;
5204 TextureHeight := 1;
5205 TextureID := TEXTURE_SPECIAL_NONE;
5206 end;
5207 end;
5208 end;
5209
5210 OBJECT_ITEM:
5211 begin
5212 with gItems[SelectedObjects[_id].ID] do
5213 begin
5214 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5215 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5216 OnlyDM := NameToBool(vleObjectProperty.Values[MsgPropDmOnly]);
5217 Fall := NameToBool(vleObjectProperty.Values[MsgPropItemFalls]);
5218 end;
5219 end;
5220
5221 OBJECT_MONSTER:
5222 begin
5223 with gMonsters[SelectedObjects[_id].ID] do
5224 begin
5225 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5226 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5227 Direction := NameToDir(vleObjectProperty.Values[MsgPropDirection]);
5228 end;
5229 end;
5230
5231 OBJECT_AREA:
5232 begin
5233 with gAreas[SelectedObjects[_id].ID] do
5234 begin
5235 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5236 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5237 Direction := NameToDir(vleObjectProperty.Values[MsgPropDirection]);
5238 end;
5239 end;
5240
5241 OBJECT_TRIGGER:
5242 begin
5243 with gTriggers[SelectedObjects[_id].ID] do
5244 begin
5245 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5246 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5247 Width := StrToInt(Trim(vleObjectProperty.Values[MsgPropWidth]));
5248 Height := StrToInt(Trim(vleObjectProperty.Values[MsgPropHeight]));
5249 Enabled := NameToBool(vleObjectProperty.Values[MsgPropTrEnabled]);
5250 ActivateType := StrToActivate(vleObjectProperty.Values[MsgPropTrActivation]);
5251 Key := StrToKey(vleObjectProperty.Values[MsgPropTrKeys]);
5252
5253 case TriggerType of
5254 TRIGGER_EXIT:
5255 begin
5256 s := utf2win(vleObjectProperty.Values[MsgPropTrNextMap]);
5257 FillByte(Data.MapName[0], 16, 0);
5258 if s <> '' then
5259 Move(s[1], Data.MapName[0], Min(Length(s), 16));
5260 end;
5261
5262 TRIGGER_TEXTURE:
5263 begin
5264 Data.ActivateOnce := NameToBool(vleObjectProperty.Values[MsgPropTrTextureOnce]);
5265 Data.AnimOnce := NameToBool(vleObjectProperty.Values[MsgPropTrTextureAnimOnce]);
5266 end;
5267
5268 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
5269 begin
5270 Data.Wait := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 65535);
5271 Data.Count := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrExCount], 0), 65535);
5272 if Data.Count < 1 then
5273 Data.Count := 1;
5274 if TriggerType = TRIGGER_PRESS then
5275 Data.ExtRandom := NameToBool(vleObjectProperty.Values[MsgPropTrExRandom]);
5276 end;
5277
5278 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR, TRIGGER_DOOR5,
5279 TRIGGER_CLOSETRAP, TRIGGER_TRAP, TRIGGER_LIFTUP, TRIGGER_LIFTDOWN,
5280 TRIGGER_LIFT:
5281 begin
5282 Data.NoSound := NameToBool(vleObjectProperty.Values[MsgPropTrSilent]);
5283 Data.d2d_doors := NameToBool(vleObjectProperty.Values[MsgPropTrD2d]);
5284 end;
5285
5286 TRIGGER_TELEPORT:
5287 begin
5288 Data.d2d_teleport := NameToBool(vleObjectProperty.Values[MsgPropTrD2d]);
5289 Data.silent_teleport := NameToBool(vleObjectProperty.Values[MsgPropTrTeleportSilent]);
5290 Data.TlpDir := NameToDirAdv(vleObjectProperty.Values[MsgPropTrTeleportDir]);
5291 end;
5292
5293 TRIGGER_SOUND:
5294 begin
5295 s := utf2win(vleObjectProperty.Values[MsgPropTrSoundName]);
5296 FillByte(Data.SoundName[0], 64, 0);
5297 if s <> '' then
5298 Move(s[1], Data.SoundName[0], Min(Length(s), 64));
5299
5300 Data.Volume := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundVolume], 0), 255);
5301 Data.Pan := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundPan], 0), 255);
5302 Data.PlayCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundCount], 0), 255);
5303 Data.Local := NameToBool(vleObjectProperty.Values[MsgPropTrSoundLocal]);
5304 Data.SoundSwitch := NameToBool(vleObjectProperty.Values[MsgPropTrSoundSwitch]);
5305 end;
5306
5307 TRIGGER_SPAWNMONSTER:
5308 begin
5309 Data.MonType := StrToMonster(vleObjectProperty.Values[MsgPropTrMonsterType]);
5310 Data.MonDir := Byte(NameToDir(vleObjectProperty.Values[MsgPropDirection]));
5311 Data.MonHealth := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrHealth], 0), 1000000);
5312 if Data.MonHealth < 0 then
5313 Data.MonHealth := 0;
5314 Data.MonActive := NameToBool(vleObjectProperty.Values[MsgPropTrMonsterActive]);
5315 Data.MonCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 64);
5316 if Data.MonCount < 1 then
5317 Data.MonCount := 1;
5318 Data.MonEffect := StrToEffect(vleObjectProperty.Values[MsgPropTrFxType]);
5319 Data.MonMax := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnMax], 0), 65535);
5320 Data.MonDelay := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnDelay], 0), 65535);
5321 Data.MonBehav := 0;
5322 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour1 then
5323 Data.MonBehav := 1;
5324 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour2 then
5325 Data.MonBehav := 2;
5326 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour3 then
5327 Data.MonBehav := 3;
5328 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour4 then
5329 Data.MonBehav := 4;
5330 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour5 then
5331 Data.MonBehav := 5;
5332 end;
5333
5334 TRIGGER_SPAWNITEM:
5335 begin
5336 Data.ItemType := StrToItem(vleObjectProperty.Values[MsgPropTrItemType]);
5337 Data.ItemOnlyDM := NameToBool(vleObjectProperty.Values[MsgPropDmOnly]);
5338 Data.ItemFalls := NameToBool(vleObjectProperty.Values[MsgPropItemFalls]);
5339 Data.ItemCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 64);
5340 if Data.ItemCount < 1 then
5341 Data.ItemCount := 1;
5342 Data.ItemEffect := StrToEffect(vleObjectProperty.Values[MsgPropTrFxType]);
5343 Data.ItemMax := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnMax], 0), 65535);
5344 Data.ItemDelay := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnDelay], 0), 65535);
5345 end;
5346
5347 TRIGGER_MUSIC:
5348 begin
5349 s := utf2win(vleObjectProperty.Values[MsgPropTrMusicName]);
5350 FillByte(Data.MusicName[0], 64, 0);
5351 if s <> '' then
5352 Move(s[1], Data.MusicName[0], Min(Length(s), 64));
5353
5354 if vleObjectProperty.Values[MsgPropTrMusicAct] = MsgPropTrMusicOn then
5355 Data.MusicAction := 1
5356 else
5357 Data.MusicAction := 0;
5358 end;
5359
5360 TRIGGER_PUSH:
5361 begin
5362 Data.PushAngle := Min(
5363 StrToIntDef(vleObjectProperty.Values[MsgPropTrPushAngle], 0), 360);
5364 Data.PushForce := Min(
5365 StrToIntDef(vleObjectProperty.Values[MsgPropTrPushForce], 0), 255);
5366 Data.ResetVel := NameToBool(vleObjectProperty.Values[MsgPropTrPushReset]);
5367 end;
5368
5369 TRIGGER_SCORE:
5370 begin
5371 Data.ScoreAction := 0;
5372 if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct1 then
5373 Data.ScoreAction := 1
5374 else if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct2 then
5375 Data.ScoreAction := 2
5376 else if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct3 then
5377 Data.ScoreAction := 3;
5378 Data.ScoreCount := Min(Max(
5379 StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 0), 255);
5380 Data.ScoreTeam := 0;
5381 if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam1 then
5382 Data.ScoreTeam := 1
5383 else if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam2 then
5384 Data.ScoreTeam := 2
5385 else if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam3 then
5386 Data.ScoreTeam := 3;
5387 Data.ScoreCon := NameToBool(vleObjectProperty.Values[MsgPropTrScoreCon]);
5388 Data.ScoreMsg := NameToBool(vleObjectProperty.Values[MsgPropTrScoreMsg]);
5389 end;
5390
5391 TRIGGER_MESSAGE:
5392 begin
5393 Data.MessageKind := 0;
5394 if vleObjectProperty.Values[MsgPropTrMessageKind] = MsgPropTrMessageKind1 then
5395 Data.MessageKind := 1;
5396
5397 Data.MessageSendTo := 0;
5398 if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo1 then
5399 Data.MessageSendTo := 1
5400 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo2 then
5401 Data.MessageSendTo := 2
5402 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo3 then
5403 Data.MessageSendTo := 3
5404 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo4 then
5405 Data.MessageSendTo := 4
5406 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo5 then
5407 Data.MessageSendTo := 5;
5408
5409 s := utf2win(vleObjectProperty.Values[MsgPropTrMessageText]);
5410 FillByte(Data.MessageText[0], 100, 0);
5411 if s <> '' then
5412 Move(s[1], Data.MessageText[0], Min(Length(s), 100));
5413
5414 Data.MessageTime := Min(Max(
5415 StrToIntDef(vleObjectProperty.Values[MsgPropTrMessageTime], 0), 0), 65535);
5416 end;
5417
5418 TRIGGER_DAMAGE:
5419 begin
5420 Data.DamageValue := Min(Max(
5421 StrToIntDef(vleObjectProperty.Values[MsgPropTrDamageValue], 0), 0), 65535);
5422 Data.DamageInterval := Min(Max(
5423 StrToIntDef(vleObjectProperty.Values[MsgPropTrInterval], 0), 0), 65535);
5424 s := vleObjectProperty.Values[MsgPropTrDamageKind];
5425 if s = MsgPropTrDamageKind3 then
5426 Data.DamageKind := 3
5427 else if s = MsgPropTrDamageKind4 then
5428 Data.DamageKind := 4
5429 else if s = MsgPropTrDamageKind5 then
5430 Data.DamageKind := 5
5431 else if s = MsgPropTrDamageKind6 then
5432 Data.DamageKind := 6
5433 else if s = MsgPropTrDamageKind7 then
5434 Data.DamageKind := 7
5435 else if s = MsgPropTrDamageKind8 then
5436 Data.DamageKind := 8
5437 else
5438 Data.DamageKind := 0;
5439 end;
5440
5441 TRIGGER_HEALTH:
5442 begin
5443 Data.HealValue := Min(Max(
5444 StrToIntDef(vleObjectProperty.Values[MsgPropTrHealth], 0), 0), 65535);
5445 Data.HealInterval := Min(Max(
5446 StrToIntDef(vleObjectProperty.Values[MsgPropTrInterval], 0), 0), 65535);
5447 Data.HealMax := NameToBool(vleObjectProperty.Values[MsgPropTrHealthMax]);
5448 Data.HealSilent := NameToBool(vleObjectProperty.Values[MsgPropTrSilent]);
5449 end;
5450
5451 TRIGGER_SHOT:
5452 begin
5453 Data.ShotType := StrToShot(vleObjectProperty.Values[MsgPropTrShotType]);
5454 Data.ShotSound := NameToBool(vleObjectProperty.Values[MsgPropTrShotSound]);
5455 Data.ShotTarget := 0;
5456 if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo1 then
5457 Data.ShotTarget := 1
5458 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo2 then
5459 Data.ShotTarget := 2
5460 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo3 then
5461 Data.ShotTarget := 3
5462 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo4 then
5463 Data.ShotTarget := 4
5464 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo5 then
5465 Data.ShotTarget := 5
5466 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo6 then
5467 Data.ShotTarget := 6;
5468 Data.ShotIntSight := Min(Max(
5469 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotSight], 0), 0), 65535);
5470 Data.ShotAim := 0;
5471 if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim1 then
5472 Data.ShotAim := 1
5473 else if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim2 then
5474 Data.ShotAim := 2
5475 else if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim3 then
5476 Data.ShotAim := 3;
5477 Data.ShotAngle := Min(
5478 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAngle], 0), 360);
5479 Data.ShotWait := Min(Max(
5480 StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 0), 65535);
5481 Data.ShotAccuracy := Min(Max(
5482 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAcc], 0), 0), 65535);
5483 Data.ShotAmmo := Min(Max(
5484 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAmmo], 0), 0), 65535);
5485 Data.ShotIntReload := Min(Max(
5486 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotReload], 0), 0), 65535);
5487 end;
5488
5489 TRIGGER_EFFECT:
5490 begin
5491 Data.FXCount := Min(Max(
5492 StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 0), 255);
5493 if vleObjectProperty.Values[MsgPropTrEffectType] = MsgPropTrEffectParticle then
5494 begin
5495 Data.FXType := TRIGGER_EFFECT_PARTICLE;
5496 Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
5497 if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectSliquid then
5498 Data.FXSubType := TRIGGER_EFFECT_SLIQUID
5499 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectLliquid then
5500 Data.FXSubType := TRIGGER_EFFECT_LLIQUID
5501 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectDliquid then
5502 Data.FXSubType := TRIGGER_EFFECT_DLIQUID
5503 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectBlood then
5504 Data.FXSubType := TRIGGER_EFFECT_BLOOD
5505 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectSpark then
5506 Data.FXSubType := TRIGGER_EFFECT_SPARK
5507 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectBubble then
5508 Data.FXSubType := TRIGGER_EFFECT_BUBBLE;
5509 end else
5510 begin
5511 Data.FXType := TRIGGER_EFFECT_ANIMATION;
5512 Data.FXSubType := StrToEffect(vleObjectProperty.Values[MsgPropTrEffectSubtype]);
5513 end;
5514 a := Min(Max(
5515 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectColor], 0), 0), $FFFFFF);
5516 Data.FXColorR := a and $FF;
5517 Data.FXColorG := (a shr 8) and $FF;
5518 Data.FXColorB := (a shr 16) and $FF;
5519 if NameToBool(vleObjectProperty.Values[MsgPropTrEffectCenter]) then
5520 Data.FXPos := 0
5521 else
5522 Data.FXPos := 1;
5523 Data.FXWait := Min(Max(
5524 StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 0), 65535);
5525 Data.FXVelX := Min(Max(
5526 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectVelx], 0), -128), 127);
5527 Data.FXVelY := Min(Max(
5528 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectVely], 0), -128), 127);
5529 Data.FXSpreadL := Min(Max(
5530 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpl], 0), 0), 255);
5531 Data.FXSpreadR := Min(Max(
5532 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpr], 0), 0), 255);
5533 Data.FXSpreadU := Min(Max(
5534 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpu], 0), 0), 255);
5535 Data.FXSpreadD := Min(Max(
5536 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpd], 0), 0), 255);
5537 end;
5538 end;
5539 end;
5540 end;
5541 end;
5542
5543 FillProperty();
5544
5545 vleObjectProperty.Row := r;
5546 vleObjectProperty.Col := c;
5547 end;
5548
5549 procedure TMainForm.bbRemoveTextureClick(Sender: TObject);
5550 var
5551 a, i: Integer;
5552 begin
5553 i := lbTextureList.ItemIndex;
5554 if i = -1 then
5555 Exit;
5556
5557 if Application.MessageBox(PChar(Format(MsgMsgDelTexturePrompt,
5558 [SelectedTexture()])),
5559 PChar(MsgMsgDelTexture),
5560 MB_ICONQUESTION or MB_YESNO or
5561 MB_DEFBUTTON1) <> idYes then
5562 Exit;
5563
5564 if gPanels <> nil then
5565 for a := 0 to High(gPanels) do
5566 if (gPanels[a].PanelType <> 0) and
5567 (gPanels[a].TextureName = SelectedTexture()) then
5568 begin
5569 ErrorMessageBox(MsgMsgDelTextureCant);
5570 Exit;
5571 end;
5572
5573 g_DeleteTexture(SelectedTexture());
5574 i := slInvalidTextures.IndexOf(lbTextureList.Items[i]);
5575 if i > -1 then
5576 slInvalidTextures.Delete(i);
5577 if lbTextureList.ItemIndex > -1 then
5578 lbTextureList.Items.Delete(lbTextureList.ItemIndex)
5579 end;
5580
5581 procedure TMainForm.aNewMapExecute(Sender: TObject);
5582 begin
5583 if Application.MessageBox(PChar(MsgMsgClearMapPrompt), PChar(MsgMsgClearMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = mrYes then
5584 FullClear();
5585 end;
5586
5587 procedure TMainForm.aUndoExecute(Sender: TObject);
5588 var
5589 a: Integer;
5590 begin
5591 if UndoBuffer = nil then
5592 Exit;
5593 if UndoBuffer[High(UndoBuffer)] = nil then
5594 Exit;
5595
5596 for a := 0 to High(UndoBuffer[High(UndoBuffer)]) do
5597 with UndoBuffer[High(UndoBuffer)][a] do
5598 begin
5599 case UndoType of
5600 UNDO_DELETE_PANEL:
5601 begin
5602 AddPanel(Panel^);
5603 Dispose(Panel);
5604 end;
5605 UNDO_DELETE_ITEM: AddItem(Item);
5606 UNDO_DELETE_AREA: AddArea(Area);
5607 UNDO_DELETE_MONSTER: AddMonster(Monster);
5608 UNDO_DELETE_TRIGGER: AddTrigger(Trigger);
5609 UNDO_ADD_PANEL: RemoveObject(AddID, OBJECT_PANEL);
5610 UNDO_ADD_ITEM: RemoveObject(AddID, OBJECT_ITEM);
5611 UNDO_ADD_AREA: RemoveObject(AddID, OBJECT_AREA);
5612 UNDO_ADD_MONSTER: RemoveObject(AddID, OBJECT_MONSTER);
5613 UNDO_ADD_TRIGGER: RemoveObject(AddID, OBJECT_TRIGGER);
5614 end;
5615 end;
5616
5617 SetLength(UndoBuffer, Length(UndoBuffer)-1);
5618 RemoveSelectFromObjects();
5619 miUndo.Enabled := UndoBuffer <> nil;
5620 end;
5621
5622
5623 procedure TMainForm.aCopyObjectExecute(Sender: TObject);
5624 var
5625 a, b: Integer;
5626 CopyBuffer: TCopyRecArray;
5627 str: String;
5628 ok: Boolean;
5629
5630 function CB_Compare(I1, I2: TCopyRec): Integer;
5631 begin
5632 Result := Integer(I1.ObjectType) - Integer(I2.ObjectType);
5633
5634 if Result = 0 then // Одного типа
5635 Result := Integer(I1.ID) - Integer(I2.ID);
5636 end;
5637
5638 procedure QuickSortCopyBuffer(L, R: Integer);
5639 var
5640 I, J: Integer;
5641 P, T: TCopyRec;
5642 begin
5643 repeat
5644 I := L;
5645 J := R;
5646 P := CopyBuffer[(L + R) shr 1];
5647
5648 repeat
5649 while CB_Compare(CopyBuffer[I], P) < 0 do
5650 Inc(I);
5651 while CB_Compare(CopyBuffer[J], P) > 0 do
5652 Dec(J);
5653
5654 if I <= J then
5655 begin
5656 T := CopyBuffer[I];
5657 CopyBuffer[I] := CopyBuffer[J];
5658 CopyBuffer[J] := T;
5659 Inc(I);
5660 Dec(J);
5661 end;
5662 until I > J;
5663
5664 if L < J then
5665 QuickSortCopyBuffer(L, J);
5666
5667 L := I;
5668 until I >= R;
5669 end;
5670
5671 begin
5672 if SelectedObjects = nil then
5673 Exit;
5674
5675 b := -1;
5676 CopyBuffer := nil;
5677
5678 // Копируем объекты:
5679 for a := 0 to High(SelectedObjects) do
5680 if SelectedObjects[a].Live then
5681 with SelectedObjects[a] do
5682 begin
5683 SetLength(CopyBuffer, Length(CopyBuffer)+1);
5684 b := High(CopyBuffer);
5685 CopyBuffer[b].ID := ID;
5686 CopyBuffer[b].Panel := nil;
5687
5688 case ObjectType of
5689 OBJECT_PANEL:
5690 begin
5691 CopyBuffer[b].ObjectType := OBJECT_PANEL;
5692 New(CopyBuffer[b].Panel);
5693 CopyBuffer[b].Panel^ := gPanels[ID];
5694 end;
5695
5696 OBJECT_ITEM:
5697 begin
5698 CopyBuffer[b].ObjectType := OBJECT_ITEM;
5699 CopyBuffer[b].Item := gItems[ID];
5700 end;
5701
5702 OBJECT_MONSTER:
5703 begin
5704 CopyBuffer[b].ObjectType := OBJECT_MONSTER;
5705 CopyBuffer[b].Monster := gMonsters[ID];
5706 end;
5707
5708 OBJECT_AREA:
5709 begin
5710 CopyBuffer[b].ObjectType := OBJECT_AREA;
5711 CopyBuffer[b].Area := gAreas[ID];
5712 end;
5713
5714 OBJECT_TRIGGER:
5715 begin
5716 CopyBuffer[b].ObjectType := OBJECT_TRIGGER;
5717 CopyBuffer[b].Trigger := gTriggers[ID];
5718 end;
5719 end;
5720 end;
5721
5722 // Сортировка по ID:
5723 if CopyBuffer <> nil then
5724 begin
5725 QuickSortCopyBuffer(0, b);
5726 end;
5727
5728 // Постановка ссылок триггеров:
5729 for a := 0 to Length(CopyBuffer)-1 do
5730 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
5731 begin
5732 case CopyBuffer[a].Trigger.TriggerType of
5733 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5734 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
5735 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
5736 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
5737 begin
5738 ok := False;
5739
5740 for b := 0 to Length(CopyBuffer)-1 do
5741 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5742 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.PanelID) then
5743 begin
5744 CopyBuffer[a].Trigger.Data.PanelID := b;
5745 ok := True;
5746 Break;
5747 end;
5748
5749 // Этих панелей нет среди копируемых:
5750 if not ok then
5751 CopyBuffer[a].Trigger.Data.PanelID := -1;
5752 end;
5753
5754 TRIGGER_PRESS, TRIGGER_ON,
5755 TRIGGER_OFF, TRIGGER_ONOFF:
5756 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
5757 begin
5758 ok := False;
5759
5760 for b := 0 to Length(CopyBuffer)-1 do
5761 if (CopyBuffer[b].ObjectType = OBJECT_MONSTER) and
5762 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.MonsterID-1) then
5763 begin
5764 CopyBuffer[a].Trigger.Data.MonsterID := b+1;
5765 ok := True;
5766 Break;
5767 end;
5768
5769 // Этих монстров нет среди копируемых:
5770 if not ok then
5771 CopyBuffer[a].Trigger.Data.MonsterID := 0;
5772 end;
5773
5774 TRIGGER_SHOT:
5775 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
5776 begin
5777 ok := False;
5778
5779 for b := 0 to Length(CopyBuffer)-1 do
5780 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5781 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.ShotPanelID) then
5782 begin
5783 CopyBuffer[a].Trigger.Data.ShotPanelID := b;
5784 ok := True;
5785 Break;
5786 end;
5787
5788 // Этих панелей нет среди копируемых:
5789 if not ok then
5790 CopyBuffer[a].Trigger.Data.ShotPanelID := -1;
5791 end;
5792 end;
5793
5794 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
5795 begin
5796 ok := False;
5797
5798 for b := 0 to Length(CopyBuffer)-1 do
5799 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5800 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.TexturePanel) then
5801 begin
5802 CopyBuffer[a].Trigger.TexturePanel := b;
5803 ok := True;
5804 Break;
5805 end;
5806
5807 // Этих панелей нет среди копируемых:
5808 if not ok then
5809 CopyBuffer[a].Trigger.TexturePanel := -1;
5810 end;
5811 end;
5812
5813 // В буфер обмена:
5814 str := CopyBufferToString(CopyBuffer);
5815 ClipBoard.AsText := str;
5816
5817 for a := 0 to Length(CopyBuffer)-1 do
5818 if (CopyBuffer[a].ObjectType = OBJECT_PANEL) and
5819 (CopyBuffer[a].Panel <> nil) then
5820 Dispose(CopyBuffer[a].Panel);
5821
5822 CopyBuffer := nil;
5823 end;
5824
5825 procedure TMainForm.aPasteObjectExecute(Sender: TObject);
5826 var
5827 a, h: Integer;
5828 CopyBuffer: TCopyRecArray;
5829 res, rel: Boolean;
5830 swad, ssec, sres: String;
5831 NoTextureID: DWORD;
5832 pmin: TPoint;
5833 xadj, yadj: LongInt;
5834 begin
5835 CopyBuffer := nil;
5836 NoTextureID := 0;
5837
5838 pmin.X := High(pmin.X);
5839 pmin.Y := High(pmin.Y);
5840
5841 StringToCopyBuffer(ClipBoard.AsText, CopyBuffer, pmin);
5842 if CopyBuffer = nil then
5843 Exit;
5844
5845 rel := not(ssShift in GetKeyShiftState());
5846 h := High(CopyBuffer);
5847 RemoveSelectFromObjects();
5848
5849 if g_CollidePoint(
5850 pmin.X, pmin.Y, -MapOffset.X-32, -MapOffset.Y-32, RenderPanel.Width, RenderPanel.Height) then
5851 begin
5852 xadj := DotStep;
5853 yadj := DotStep;
5854 end
5855 else
5856 begin
5857 xadj := Floor((-pmin.X - MapOffset.X + 32) / DotStep) * DotStep;
5858 yadj := Floor((-pmin.Y - MapOffset.Y + 32) / DotStep) * DotStep;
5859 end;
5860
5861 for a := 0 to h do
5862 with CopyBuffer[a] do
5863 begin
5864 case ObjectType of
5865 OBJECT_PANEL:
5866 if Panel <> nil then
5867 begin
5868 if rel then
5869 begin
5870 Panel^.X += xadj;
5871 Panel^.Y += yadj;
5872 end;
5873
5874 Panel^.TextureID := TEXTURE_SPECIAL_NONE;
5875 Panel^.TextureWidth := 1;
5876 Panel^.TextureHeight := 1;
5877
5878 if (Panel^.PanelType = PANEL_LIFTUP) or
5879 (Panel^.PanelType = PANEL_LIFTDOWN) or
5880 (Panel^.PanelType = PANEL_LIFTLEFT) or
5881 (Panel^.PanelType = PANEL_LIFTRIGHT) or
5882 (Panel^.PanelType = PANEL_BLOCKMON) or
5883 (Panel^.TextureName = '') then
5884 begin // Нет или не может быть текстуры:
5885 end
5886 else // Есть текстура:
5887 begin
5888 // Обычная текстура:
5889 if not IsSpecialTexture(Panel^.TextureName) then
5890 begin
5891 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5892
5893 if not res then
5894 begin
5895 g_ProcessResourceStr(Panel^.TextureName, swad, ssec, sres);
5896 AddTexture(swad, ssec, sres, True);
5897 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5898 end;
5899
5900 if res then
5901 g_GetTextureSizeByName(Panel^.TextureName,
5902 Panel^.TextureWidth, Panel^.TextureHeight)
5903 else
5904 if g_GetTexture('NOTEXTURE', NoTextureID) then
5905 begin
5906 Panel^.TextureID := TEXTURE_SPECIAL_NOTEXTURE;
5907 g_GetTextureSizeByID(NoTextureID, Panel^.TextureWidth, Panel^.TextureHeight);
5908 end;
5909 end
5910 else // Спец.текстура:
5911 begin
5912 Panel^.TextureID := SpecialTextureID(Panel^.TextureName);
5913 with MainForm.lbTextureList.Items do
5914 if IndexOf(Panel^.TextureName) = -1 then
5915 Add(Panel^.TextureName);
5916 end;
5917 end;
5918
5919 ID := AddPanel(Panel^);
5920 Dispose(Panel);
5921 Undo_Add(OBJECT_PANEL, ID, a > 0);
5922 SelectObject(OBJECT_PANEL, ID, True);
5923 end;
5924
5925 OBJECT_ITEM:
5926 begin
5927 if rel then
5928 begin
5929 Item.X += xadj;
5930 Item.Y += yadj;
5931 end;
5932
5933 ID := AddItem(Item);
5934 Undo_Add(OBJECT_ITEM, ID, a > 0);
5935 SelectObject(OBJECT_ITEM, ID, True);
5936 end;
5937
5938 OBJECT_MONSTER:
5939 begin
5940 if rel then
5941 begin
5942 Monster.X += xadj;
5943 Monster.Y += yadj;
5944 end;
5945
5946 ID := AddMonster(Monster);
5947 Undo_Add(OBJECT_MONSTER, ID, a > 0);
5948 SelectObject(OBJECT_MONSTER, ID, True);
5949 end;
5950
5951 OBJECT_AREA:
5952 begin
5953 if rel then
5954 begin
5955 Area.X += xadj;
5956 Area.Y += yadj;
5957 end;
5958
5959 ID := AddArea(Area);
5960 Undo_Add(OBJECT_AREA, ID, a > 0);
5961 SelectObject(OBJECT_AREA, ID, True);
5962 end;
5963
5964 OBJECT_TRIGGER:
5965 begin
5966 if rel then
5967 with Trigger do
5968 begin
5969 X += xadj;
5970 Y += yadj;
5971
5972 case TriggerType of
5973 TRIGGER_TELEPORT:
5974 begin
5975 Data.TargetPoint.X += xadj;
5976 Data.TargetPoint.Y += yadj;
5977 end;
5978 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
5979 begin
5980 Data.tX += xadj;
5981 Data.tY += yadj;
5982 end;
5983 TRIGGER_SPAWNMONSTER:
5984 begin
5985 Data.MonPos.X += xadj;
5986 Data.MonPos.Y += yadj;
5987 end;
5988 TRIGGER_SPAWNITEM:
5989 begin
5990 Data.ItemPos.X += xadj;
5991 Data.ItemPos.Y += yadj;
5992 end;
5993 TRIGGER_SHOT:
5994 begin
5995 Data.ShotPos.X += xadj;
5996 Data.ShotPos.Y += yadj;
5997 end;
5998 end;
5999 end;
6000
6001 ID := AddTrigger(Trigger);
6002 Undo_Add(OBJECT_TRIGGER, ID, a > 0);
6003 SelectObject(OBJECT_TRIGGER, ID, True);
6004 end;
6005 end;
6006 end;
6007
6008 // Переставляем ссылки триггеров:
6009 for a := 0 to High(CopyBuffer) do
6010 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
6011 begin
6012 case CopyBuffer[a].Trigger.TriggerType of
6013 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6014 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6015 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6016 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
6017 gTriggers[CopyBuffer[a].ID].Data.PanelID :=
6018 CopyBuffer[CopyBuffer[a].Trigger.Data.PanelID].ID;
6019
6020 TRIGGER_PRESS, TRIGGER_ON,
6021 TRIGGER_OFF, TRIGGER_ONOFF:
6022 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
6023 gTriggers[CopyBuffer[a].ID].Data.MonsterID :=
6024 CopyBuffer[CopyBuffer[a].Trigger.Data.MonsterID-1].ID+1;
6025
6026 TRIGGER_SHOT:
6027 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
6028 gTriggers[CopyBuffer[a].ID].Data.ShotPanelID :=
6029 CopyBuffer[CopyBuffer[a].Trigger.Data.ShotPanelID].ID;
6030 end;
6031
6032 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
6033 gTriggers[CopyBuffer[a].ID].TexturePanel :=
6034 CopyBuffer[CopyBuffer[a].Trigger.TexturePanel].ID;
6035 end;
6036
6037 CopyBuffer := nil;
6038
6039 if h = 0 then
6040 FillProperty();
6041 end;
6042
6043 procedure TMainForm.aCutObjectExecute(Sender: TObject);
6044 begin
6045 miCopy.Click();
6046 DeleteSelectedObjects();
6047 end;
6048
6049 procedure TMainForm.vleObjectPropertyEditButtonClick(Sender: TObject);
6050 var
6051 Key, FileName: String;
6052 b: Byte;
6053 begin
6054 Key := vleObjectProperty.Keys[vleObjectProperty.Row];
6055
6056 if Key = MsgPropPanelType then
6057 begin
6058 with ChooseTypeForm, vleObjectProperty do
6059 begin // Выбор типа панели:
6060 Caption := MsgPropPanelType;
6061 lbTypeSelect.Items.Clear();
6062
6063 for b := 0 to High(PANELNAMES) do
6064 begin
6065 lbTypeSelect.Items.Add(PANELNAMES[b]);
6066 if Values[Key] = PANELNAMES[b] then
6067 lbTypeSelect.ItemIndex := b;
6068 end;
6069
6070 if ShowModal() = mrOK then
6071 begin
6072 b := lbTypeSelect.ItemIndex;
6073 Values[Key] := PANELNAMES[b];
6074 vleObjectPropertyApply(Sender);
6075 end;
6076 end
6077 end
6078 else if Key = MsgPropTrTeleportTo then
6079 SelectFlag := SELECTFLAG_TELEPORT
6080 else if Key = MsgPropTrSpawnTo then
6081 SelectFlag := SELECTFLAG_SPAWNPOINT
6082 else if (Key = MsgPropTrDoorPanel) or
6083 (Key = MsgPropTrTrapPanel) then
6084 SelectFlag := SELECTFLAG_DOOR
6085 else if Key = MsgPropTrTexturePanel then
6086 begin
6087 DrawPressRect := False;
6088 SelectFlag := SELECTFLAG_TEXTURE;
6089 end
6090 else if Key = MsgPropTrShotPanel then
6091 SelectFlag := SELECTFLAG_SHOTPANEL
6092 else if Key = MsgPropTrLiftPanel then
6093 SelectFlag := SELECTFLAG_LIFT
6094 else if key = MsgPropTrExMonster then
6095 SelectFlag := SELECTFLAG_MONSTER
6096 else if Key = MsgPropTrExArea then
6097 begin
6098 SelectFlag := SELECTFLAG_NONE;
6099 DrawPressRect := True;
6100 end
6101 else if Key = MsgPropTrNextMap then
6102 begin // Выбор следующей карты:
6103 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
6104 SelectMapForm.Caption := MsgCapSelect;
6105 SelectMapForm.GetMaps(FileName);
6106
6107 if SelectMapForm.ShowModal() = mrOK then
6108 begin
6109 vleObjectProperty.Values[Key] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
6110 vleObjectPropertyApply(Sender);
6111 end;
6112 end
6113 else if (Key = MsgPropTrSoundName) or
6114 (Key = MsgPropTrMusicName) then
6115 begin // Выбор файла звука/музыки:
6116 AddSoundForm.OKFunction := nil;
6117 AddSoundForm.lbResourcesList.MultiSelect := False;
6118 AddSoundForm.SetResource := vleObjectProperty.Values[Key];
6119
6120 if (AddSoundForm.ShowModal() = mrOk) then
6121 begin
6122 vleObjectProperty.Values[Key] := AddSoundForm.ResourceName;
6123 vleObjectPropertyApply(Sender);
6124 end;
6125 end
6126 else if Key = MsgPropTrActivation then
6127 with ActivationTypeForm, vleObjectProperty do
6128 begin // Выбор типов активации:
6129 cbPlayerCollide.Checked := Pos('PC', Values[Key]) > 0;
6130 cbMonsterCollide.Checked := Pos('MC', Values[Key]) > 0;
6131 cbPlayerPress.Checked := Pos('PP', Values[Key]) > 0;
6132 cbMonsterPress.Checked := Pos('MP', Values[Key]) > 0;
6133 cbShot.Checked := Pos('SH', Values[Key]) > 0;
6134 cbNoMonster.Checked := Pos('NM', Values[Key]) > 0;
6135
6136 if ShowModal() = mrOK then
6137 begin
6138 b := 0;
6139 if cbPlayerCollide.Checked then
6140 b := ACTIVATE_PLAYERCOLLIDE;
6141 if cbMonsterCollide.Checked then
6142 b := b or ACTIVATE_MONSTERCOLLIDE;
6143 if cbPlayerPress.Checked then
6144 b := b or ACTIVATE_PLAYERPRESS;
6145 if cbMonsterPress.Checked then
6146 b := b or ACTIVATE_MONSTERPRESS;
6147 if cbShot.Checked then
6148 b := b or ACTIVATE_SHOT;
6149 if cbNoMonster.Checked then
6150 b := b or ACTIVATE_NOMONSTER;
6151
6152 Values[Key] := ActivateToStr(b);
6153 vleObjectPropertyApply(Sender);
6154 end;
6155 end
6156 else if Key = MsgPropTrKeys then
6157 with KeysForm, vleObjectProperty do
6158 begin // Выбор необходимых ключей:
6159 cbRedKey.Checked := Pos('RK', Values[Key]) > 0;
6160 cbGreenKey.Checked := Pos('GK', Values[Key]) > 0;
6161 cbBlueKey.Checked := Pos('BK', Values[Key]) > 0;
6162 cbRedTeam.Checked := Pos('RT', Values[Key]) > 0;
6163 cbBlueTeam.Checked := Pos('BT', Values[Key]) > 0;
6164
6165 if ShowModal() = mrOK then
6166 begin
6167 b := 0;
6168 if cbRedKey.Checked then
6169 b := KEY_RED;
6170 if cbGreenKey.Checked then
6171 b := b or KEY_GREEN;
6172 if cbBlueKey.Checked then
6173 b := b or KEY_BLUE;
6174 if cbRedTeam.Checked then
6175 b := b or KEY_REDTEAM;
6176 if cbBlueTeam.Checked then
6177 b := b or KEY_BLUETEAM;
6178
6179 Values[Key] := KeyToStr(b);
6180 vleObjectPropertyApply(Sender);
6181 end;
6182 end
6183 else if Key = MsgPropTrFxType then
6184 with ChooseTypeForm, vleObjectProperty do
6185 begin // Выбор типа эффекта:
6186 Caption := MsgCapFxType;
6187 lbTypeSelect.Items.Clear();
6188
6189 for b := EFFECT_NONE to EFFECT_FIRE do
6190 lbTypeSelect.Items.Add(EffectToStr(b));
6191
6192 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]);
6193
6194 if ShowModal() = mrOK then
6195 begin
6196 b := lbTypeSelect.ItemIndex;
6197 Values[Key] := EffectToStr(b);
6198 vleObjectPropertyApply(Sender);
6199 end;
6200 end
6201 else if Key = MsgPropTrMonsterType then
6202 with ChooseTypeForm, vleObjectProperty do
6203 begin // Выбор типа монстра:
6204 Caption := MsgCapMonsterType;
6205 lbTypeSelect.Items.Clear();
6206
6207 for b := MONSTER_DEMON to MONSTER_MAN do
6208 lbTypeSelect.Items.Add(MonsterToStr(b));
6209
6210 lbTypeSelect.ItemIndex := StrToMonster(Values[Key]) - MONSTER_DEMON;
6211
6212 if ShowModal() = mrOK then
6213 begin
6214 b := lbTypeSelect.ItemIndex + MONSTER_DEMON;
6215 Values[Key] := MonsterToStr(b);
6216 vleObjectPropertyApply(Sender);
6217 end;
6218 end
6219 else if Key = MsgPropTrItemType then
6220 with ChooseTypeForm, vleObjectProperty do
6221 begin // Выбор типа предмета:
6222 Caption := MsgCapItemType;
6223 lbTypeSelect.Items.Clear();
6224
6225 for b := ITEM_MEDKIT_SMALL to ITEM_KEY_BLUE do
6226 lbTypeSelect.Items.Add(ItemToStr(b));
6227 lbTypeSelect.Items.Add(ItemToStr(ITEM_BOTTLE));
6228 lbTypeSelect.Items.Add(ItemToStr(ITEM_HELMET));
6229 lbTypeSelect.Items.Add(ItemToStr(ITEM_JETPACK));
6230 lbTypeSelect.Items.Add(ItemToStr(ITEM_INVIS));
6231 lbTypeSelect.Items.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER));
6232 lbTypeSelect.Items.Add(ItemToStr(ITEM_AMMO_FUELCAN));
6233
6234 b := StrToItem(Values[Key]);
6235 if b >= ITEM_BOTTLE then
6236 b := b - 2;
6237 lbTypeSelect.ItemIndex := b - ITEM_MEDKIT_SMALL;
6238
6239 if ShowModal() = mrOK then
6240 begin
6241 b := lbTypeSelect.ItemIndex + ITEM_MEDKIT_SMALL;
6242 if b >= ITEM_WEAPON_IRONFIST then
6243 b := b + 2;
6244 Values[Key] := ItemToStr(b);
6245 vleObjectPropertyApply(Sender);
6246 end;
6247 end
6248 else if Key = MsgPropTrShotType then
6249 with ChooseTypeForm, vleObjectProperty do
6250 begin // Выбор типа предмета:
6251 Caption := MsgPropTrShotType;
6252 lbTypeSelect.Items.Clear();
6253
6254 for b := TRIGGER_SHOT_PISTOL to TRIGGER_SHOT_MAX do
6255 lbTypeSelect.Items.Add(ShotToStr(b));
6256
6257 lbTypeSelect.ItemIndex := StrToShot(Values[Key]);
6258
6259 if ShowModal() = mrOK then
6260 begin
6261 b := lbTypeSelect.ItemIndex;
6262 Values[Key] := ShotToStr(b);
6263 vleObjectPropertyApply(Sender);
6264 end;
6265 end
6266 else if Key = MsgPropTrEffectType then
6267 with ChooseTypeForm, vleObjectProperty do
6268 begin // Выбор типа эффекта:
6269 Caption := MsgCapFxType;
6270 lbTypeSelect.Items.Clear();
6271
6272 lbTypeSelect.Items.Add(MsgPropTrEffectParticle);
6273 lbTypeSelect.Items.Add(MsgPropTrEffectAnimation);
6274 if Values[Key] = MsgPropTrEffectAnimation then
6275 lbTypeSelect.ItemIndex := 1
6276 else
6277 lbTypeSelect.ItemIndex := 0;
6278
6279 if ShowModal() = mrOK then
6280 begin
6281 b := lbTypeSelect.ItemIndex;
6282 if b = 0 then
6283 Values[Key] := MsgPropTrEffectParticle
6284 else
6285 Values[Key] := MsgPropTrEffectAnimation;
6286 vleObjectPropertyApply(Sender);
6287 end;
6288 end
6289 else if Key = MsgPropTrEffectSubtype then
6290 with ChooseTypeForm, vleObjectProperty do
6291 begin // Выбор подтипа эффекта:
6292 Caption := MsgCapFxType;
6293 lbTypeSelect.Items.Clear();
6294
6295 if Values[MsgPropTrEffectType] = MsgPropTrEffectAnimation then
6296 begin
6297 for b := EFFECT_TELEPORT to EFFECT_FIRE do
6298 lbTypeSelect.Items.Add(EffectToStr(b));
6299
6300 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]) - 1;
6301 end else
6302 begin
6303 lbTypeSelect.Items.Add(MsgPropTrEffectSliquid);
6304 lbTypeSelect.Items.Add(MsgPropTrEffectLliquid);
6305 lbTypeSelect.Items.Add(MsgPropTrEffectDliquid);
6306 lbTypeSelect.Items.Add(MsgPropTrEffectBlood);
6307 lbTypeSelect.Items.Add(MsgPropTrEffectSpark);
6308 lbTypeSelect.Items.Add(MsgPropTrEffectBubble);
6309 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SLIQUID;
6310 if Values[Key] = MsgPropTrEffectLliquid then
6311 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_LLIQUID;
6312 if Values[Key] = MsgPropTrEffectDliquid then
6313 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_DLIQUID;
6314 if Values[Key] = MsgPropTrEffectBlood then
6315 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BLOOD;
6316 if Values[Key] = MsgPropTrEffectSpark then
6317 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SPARK;
6318 if Values[Key] = MsgPropTrEffectBubble then
6319 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BUBBLE;
6320 end;
6321
6322 if ShowModal() = mrOK then
6323 begin
6324 b := lbTypeSelect.ItemIndex;
6325
6326 if Values[MsgPropTrEffectType] = MsgPropTrEffectAnimation then
6327 Values[Key] := EffectToStr(b + 1)
6328 else begin
6329 Values[Key] := MsgPropTrEffectSliquid;
6330 if b = TRIGGER_EFFECT_LLIQUID then
6331 Values[Key] := MsgPropTrEffectLliquid;
6332 if b = TRIGGER_EFFECT_DLIQUID then
6333 Values[Key] := MsgPropTrEffectDliquid;
6334 if b = TRIGGER_EFFECT_BLOOD then
6335 Values[Key] := MsgPropTrEffectBlood;
6336 if b = TRIGGER_EFFECT_SPARK then
6337 Values[Key] := MsgPropTrEffectSpark;
6338 if b = TRIGGER_EFFECT_BUBBLE then
6339 Values[Key] := MsgPropTrEffectBubble;
6340 end;
6341
6342 vleObjectPropertyApply(Sender);
6343 end;
6344 end
6345 else if Key = MsgPropTrEffectColor then
6346 with vleObjectProperty do
6347 begin // Выбор цвета эффекта:
6348 ColorDialog.Color := StrToIntDef(Values[Key], 0);
6349 if ColorDialog.Execute then
6350 begin
6351 Values[Key] := IntToStr(ColorDialog.Color);
6352 vleObjectPropertyApply(Sender);
6353 end;
6354 end
6355 else if Key = MsgPropPanelTex then
6356 begin // Смена текстуры:
6357 vleObjectProperty.Values[Key] := SelectedTexture();
6358 vleObjectPropertyApply(Sender);
6359 end;
6360 end;
6361
6362 procedure TMainForm.vleObjectPropertyApply(Sender: TObject);
6363 begin
6364 // hack to prevent empty ID in list
6365 RenderPanel.SetFocus();
6366 bApplyProperty.Click();
6367 vleObjectProperty.SetFocus();
6368 end;
6369
6370 procedure TMainForm.aSaveMapExecute(Sender: TObject);
6371 var
6372 FileName, Section, Res: String;
6373 begin
6374 if OpenedMap = '' then
6375 begin
6376 aSaveMapAsExecute(nil);
6377 Exit;
6378 end;
6379
6380 g_ProcessResourceStr(OpenedMap, FileName, Section, Res);
6381
6382 SaveMap(FileName+':\'+Res, '');
6383 end;
6384
6385 procedure TMainForm.aOpenMapExecute(Sender: TObject);
6386 begin
6387 OpenDialog.Filter := MsgFileFilterAll;
6388
6389 if OpenDialog.Execute() then
6390 begin
6391 OpenMapFile(OpenDialog.FileName);
6392 OpenDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
6393 end;
6394 end;
6395
6396 procedure TMainForm.OpenMapFile(FileName: String);
6397 begin
6398 if (Pos('.ini', LowerCase(ExtractFileName(FileName))) > 0) then
6399 begin // INI карты:
6400 FullClear();
6401
6402 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
6403 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
6404 pLoadProgress.Show();
6405
6406 OpenedMap := '';
6407 OpenedWAD := '';
6408
6409 LoadMapOld(FileName);
6410
6411 MainForm.Caption := Format('%s - %s', [FormCaption, ExtractFileName(FileName)]);
6412
6413 pLoadProgress.Hide();
6414 MainForm.FormResize(Self);
6415 end
6416 else // Карты из WAD:
6417 begin
6418 OpenMap(FileName, '');
6419 end;
6420 end;
6421
6422 procedure TMainForm.FormActivate(Sender: TObject);
6423 begin
6424 MainForm.ActiveControl := RenderPanel;
6425 end;
6426
6427 procedure TMainForm.aDeleteMap(Sender: TObject);
6428 var
6429 WAD: TWADEditor_1;
6430 MapList: SArray;
6431 MapName: Char16;
6432 a: Integer;
6433 str: String;
6434 begin
6435 OpenDialog.Filter := MsgFileFilterWad;
6436
6437 if not OpenDialog.Execute() then
6438 Exit;
6439
6440 WAD := TWADEditor_1.Create();
6441
6442 if not WAD.ReadFile(OpenDialog.FileName) then
6443 begin
6444 WAD.Free();
6445 Exit;
6446 end;
6447
6448 WAD.CreateImage();
6449
6450 MapList := WAD.GetResourcesList('');
6451
6452 SelectMapForm.Caption := MsgCapRemove;
6453 SelectMapForm.lbMapList.Items.Clear();
6454
6455 if MapList <> nil then
6456 for a := 0 to High(MapList) do
6457 SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a]));
6458
6459 if (SelectMapForm.ShowModal() = mrOK) then
6460 begin
6461 str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
6462 MapName := '';
6463 Move(str[1], MapName[0], Min(16, Length(str)));
6464
6465 if Application.MessageBox(PChar(Format(MsgMsgDeleteMapPrompt, [MapName, OpenDialog.FileName])), PChar(MsgMsgDeleteMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
6466 Exit;
6467
6468 WAD.RemoveResource('', utf2win(MapName));
6469
6470 Application.MessageBox(
6471 PChar(Format(MsgMsgMapDeletedPrompt, [MapName])),
6472 PChar(MsgMsgMapDeleted),
6473 MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1
6474 );
6475
6476 WAD.SaveTo(OpenDialog.FileName);
6477
6478 // Удалили текущую карту - сохранять по старому ее нельзя:
6479 if OpenedMap = (OpenDialog.FileName+':\'+MapName) then
6480 begin
6481 OpenedMap := '';
6482 OpenedWAD := '';
6483 MainForm.Caption := FormCaption;
6484 end;
6485 end;
6486
6487 WAD.Free();
6488 end;
6489
6490 procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject;
6491 var Key: Word; Shift: TShiftState);
6492 begin
6493 if Key = VK_RETURN then
6494 vleObjectPropertyApply(Sender);
6495 end;
6496
6497 procedure MovePanel(var ID: DWORD; MoveType: Byte);
6498 var
6499 _id, a: Integer;
6500 tmp: TPanel;
6501 begin
6502 if (ID = 0) and (MoveType = 0) then
6503 Exit;
6504 if (ID = DWORD(High(gPanels))) and (MoveType <> 0) then
6505 Exit;
6506 if (ID > DWORD(High(gPanels))) then
6507 Exit;
6508
6509 _id := Integer(ID);
6510
6511 if MoveType = 0 then // to Back
6512 begin
6513 if gTriggers <> nil then
6514 for a := 0 to High(gTriggers) do
6515 with gTriggers[a] do
6516 begin
6517 if TriggerType = TRIGGER_NONE then
6518 Continue;
6519
6520 if TexturePanel = _id then
6521 TexturePanel := 0
6522 else
6523 if (TexturePanel >= 0) and (TexturePanel < _id) then
6524 Inc(TexturePanel);
6525
6526 case TriggerType of
6527 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6528 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6529 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6530 if Data.PanelID = _id then
6531 Data.PanelID := 0
6532 else
6533 if (Data.PanelID >= 0) and (Data.PanelID < _id) then
6534 Inc(Data.PanelID);
6535
6536 TRIGGER_SHOT:
6537 if Data.ShotPanelID = _id then
6538 Data.ShotPanelID := 0
6539 else
6540 if (Data.ShotPanelID >= 0) and (Data.ShotPanelID < _id) then
6541 Inc(Data.ShotPanelID);
6542 end;
6543 end;
6544
6545 tmp := gPanels[_id];
6546
6547 for a := _id downto 1 do
6548 gPanels[a] := gPanels[a-1];
6549
6550 gPanels[0] := tmp;
6551
6552 ID := 0;
6553 end
6554 else // to Front
6555 begin
6556 if gTriggers <> nil then
6557 for a := 0 to High(gTriggers) do
6558 with gTriggers[a] do
6559 begin
6560 if TriggerType = TRIGGER_NONE then
6561 Continue;
6562
6563 if TexturePanel = _id then
6564 TexturePanel := High(gPanels)
6565 else
6566 if TexturePanel > _id then
6567 Dec(TexturePanel);
6568
6569 case TriggerType of
6570 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6571 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6572 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6573 if Data.PanelID = _id then
6574 Data.PanelID := High(gPanels)
6575 else
6576 if Data.PanelID > _id then
6577 Dec(Data.PanelID);
6578
6579 TRIGGER_SHOT:
6580 if Data.ShotPanelID = _id then
6581 Data.ShotPanelID := High(gPanels)
6582 else
6583 if Data.ShotPanelID > _id then
6584 Dec(Data.ShotPanelID);
6585 end;
6586 end;
6587
6588 tmp := gPanels[_id];
6589
6590 for a := _id to High(gPanels)-1 do
6591 gPanels[a] := gPanels[a+1];
6592
6593 gPanels[High(gPanels)] := tmp;
6594
6595 ID := High(gPanels);
6596 end;
6597 end;
6598
6599 procedure TMainForm.aMoveToBack(Sender: TObject);
6600 var
6601 a: Integer;
6602 begin
6603 if SelectedObjects = nil then
6604 Exit;
6605
6606 for a := 0 to High(SelectedObjects) do
6607 with SelectedObjects[a] do
6608 if Live and (ObjectType = OBJECT_PANEL) then
6609 begin
6610 SelectedObjects[0] := SelectedObjects[a];
6611 SetLength(SelectedObjects, 1);
6612 MovePanel(ID, 0);
6613 FillProperty();
6614 Break;
6615 end;
6616 end;
6617
6618 procedure TMainForm.aMoveToFore(Sender: TObject);
6619 var
6620 a: Integer;
6621 begin
6622 if SelectedObjects = nil then
6623 Exit;
6624
6625 for a := 0 to High(SelectedObjects) do
6626 with SelectedObjects[a] do
6627 if Live and (ObjectType = OBJECT_PANEL) then
6628 begin
6629 SelectedObjects[0] := SelectedObjects[a];
6630 SetLength(SelectedObjects, 1);
6631 MovePanel(ID, 1);
6632 FillProperty();
6633 Break;
6634 end;
6635 end;
6636
6637 procedure TMainForm.aSaveMapAsExecute(Sender: TObject);
6638 var i, idx: Integer; list: TStringList; fmt: String;
6639 begin
6640 list := TStringList.Create();
6641
6642 // TODO: get loclized strings automatically from language files
6643 SaveDialog.DefaultExt := '.dfz';
6644 SaveDialog.FilterIndex := 1;
6645 SaveDialog.Filter := '';
6646 gWADEditorFactory.GetRegistredEditors(list);
6647 for i := 0 to list.Count - 1 do
6648 begin
6649 if list[i] = 'DFZIP' then
6650 SaveDialog.FilterIndex := i + 1;
6651
6652 if i <> 0 then
6653 SaveDialog.Filter := SaveDialog.Filter + '|';
6654
6655 if list[i] = 'DFWAD' then
6656 SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFWAD
6657 else if list[i] = 'DFZIP' then
6658 SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFZIP
6659 else
6660 SaveDialog.Filter := SaveDialog.Filter + list[i] + '|*.*';
6661 end;
6662
6663 if SaveDialog.Execute() then
6664 begin
6665 i := SaveDialog.FilterIndex - 1;
6666 if (i >= 0) and (i < list.Count) then fmt := list[i] else fmt := '';
6667
6668 SaveMapForm.GetMaps(SaveDialog.FileName, True, fmt);
6669 if SaveMapForm.ShowModal() = mrOK then
6670 begin
6671 SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName);
6672 OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text;
6673 OpenedWAD := SaveDialog.FileName;
6674
6675 idx := RecentFiles.IndexOf(OpenedMap);
6676 // Такая карта уже недавно открывалась:
6677 if idx >= 0 then
6678 RecentFiles.Delete(idx);
6679 RecentFiles.Insert(0, OpenedMap);
6680 RefreshRecentMenu;
6681
6682 SaveMap(OpenedMap, fmt);
6683
6684 gMapInfo.FileName := SaveDialog.FileName;
6685 gMapInfo.MapName := SaveMapForm.eMapName.Text;
6686 UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
6687 end;
6688 end;
6689
6690 list.Free();
6691 end;
6692
6693 procedure TMainForm.aSelectAllExecute(Sender: TObject);
6694 var
6695 a: Integer;
6696 begin
6697 RemoveSelectFromObjects();
6698
6699 case pcObjects.ActivePageIndex+1 of
6700 OBJECT_PANEL:
6701 if gPanels <> nil then
6702 for a := 0 to High(gPanels) do
6703 if gPanels[a].PanelType <> PANEL_NONE then
6704 SelectObject(OBJECT_PANEL, a, True);
6705 OBJECT_ITEM:
6706 if gItems <> nil then
6707 for a := 0 to High(gItems) do
6708 if gItems[a].ItemType <> ITEM_NONE then
6709 SelectObject(OBJECT_ITEM, a, True);
6710 OBJECT_MONSTER:
6711 if gMonsters <> nil then
6712 for a := 0 to High(gMonsters) do
6713 if gMonsters[a].MonsterType <> MONSTER_NONE then
6714 SelectObject(OBJECT_MONSTER, a, True);
6715 OBJECT_AREA:
6716 if gAreas <> nil then
6717 for a := 0 to High(gAreas) do
6718 if gAreas[a].AreaType <> AREA_NONE then
6719 SelectObject(OBJECT_AREA, a, True);
6720 OBJECT_TRIGGER:
6721 if gTriggers <> nil then
6722 for a := 0 to High(gTriggers) do
6723 if gTriggers[a].TriggerType <> TRIGGER_NONE then
6724 SelectObject(OBJECT_TRIGGER, a, True);
6725 end;
6726
6727 RecountSelectedObjects();
6728 end;
6729
6730 procedure TMainForm.tbGridOnClick(Sender: TObject);
6731 begin
6732 DotEnable := not DotEnable;
6733 (Sender as TToolButton).Down := DotEnable;
6734 end;
6735
6736 procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean);
6737 const MaxFPS = 60;
6738 var f: AnsiString;
6739 begin
6740 // TODO: move refresh to user actions (ask to repaint only when something changed)
6741 if GetTickCount64() - LastDrawTime >= 1000 div MaxFPS then
6742 begin
6743 PanelMap.Refresh;
6744 end;
6745
6746 if StartMap <> '' then
6747 begin
6748 f := StartMap;
6749 StartMap := '';
6750 OpenMap(f, '');
6751 end;
6752 end;
6753
6754 procedure TMainForm.miMapPreviewClick(Sender: TObject);
6755 begin
6756 if PreviewMode = 2 then
6757 Exit;
6758
6759 if PreviewMode = 0 then
6760 begin
6761 Splitter2.Visible := False;
6762 Splitter1.Visible := False;
6763 StatusBar.Visible := False;
6764 PanelObjs.Visible := False;
6765 PanelProps.Visible := False;
6766 MainToolBar.Visible := False;
6767 sbHorizontal.Visible := False;
6768 sbVertical.Visible := False;
6769 end
6770 else
6771 begin
6772 StatusBar.Visible := True;
6773 PanelObjs.Visible := True;
6774 PanelProps.Visible := True;
6775 Splitter2.Visible := True;
6776 Splitter1.Visible := True;
6777 MainToolBar.Visible := True;
6778 sbHorizontal.Visible := True;
6779 sbVertical.Visible := True;
6780 end;
6781
6782 PreviewMode := PreviewMode xor 1;
6783 (Sender as TMenuItem).Checked := PreviewMode > 0;
6784
6785 FormResize(Self);
6786 end;
6787
6788 procedure TMainForm.miLayer1Click(Sender: TObject);
6789 begin
6790 SwitchLayer(LAYER_BACK);
6791 end;
6792
6793 procedure TMainForm.miLayer2Click(Sender: TObject);
6794 begin
6795 SwitchLayer(LAYER_WALLS);
6796 end;
6797
6798 procedure TMainForm.miLayer3Click(Sender: TObject);
6799 begin
6800 SwitchLayer(LAYER_FOREGROUND);
6801 end;
6802
6803 procedure TMainForm.miLayer4Click(Sender: TObject);
6804 begin
6805 SwitchLayer(LAYER_STEPS);
6806 end;
6807
6808 procedure TMainForm.miLayer5Click(Sender: TObject);
6809 begin
6810 SwitchLayer(LAYER_WATER);
6811 end;
6812
6813 procedure TMainForm.miLayer6Click(Sender: TObject);
6814 begin
6815 SwitchLayer(LAYER_ITEMS);
6816 end;
6817
6818 procedure TMainForm.miLayer7Click(Sender: TObject);
6819 begin
6820 SwitchLayer(LAYER_MONSTERS);
6821 end;
6822
6823 procedure TMainForm.miLayer8Click(Sender: TObject);
6824 begin
6825 SwitchLayer(LAYER_AREAS);
6826 end;
6827
6828 procedure TMainForm.miLayer9Click(Sender: TObject);
6829 begin
6830 SwitchLayer(LAYER_TRIGGERS);
6831 end;
6832
6833 procedure TMainForm.tbShowClick(Sender: TObject);
6834 var
6835 a: Integer;
6836 b: Boolean;
6837 begin
6838 b := True;
6839 for a := 0 to High(LayerEnabled) do
6840 b := b and LayerEnabled[a];
6841
6842 b := not b;
6843
6844 ShowLayer(LAYER_BACK, b);
6845 ShowLayer(LAYER_WALLS, b);
6846 ShowLayer(LAYER_FOREGROUND, b);
6847 ShowLayer(LAYER_STEPS, b);
6848 ShowLayer(LAYER_WATER, b);
6849 ShowLayer(LAYER_ITEMS, b);
6850 ShowLayer(LAYER_MONSTERS, b);
6851 ShowLayer(LAYER_AREAS, b);
6852 ShowLayer(LAYER_TRIGGERS, b);
6853 end;
6854
6855 procedure TMainForm.miMiniMapClick(Sender: TObject);
6856 begin
6857 SwitchMap();
6858 end;
6859
6860 procedure TMainForm.miSwitchGridClick(Sender: TObject);
6861 begin
6862 if DotStep = DotStepOne then
6863 DotStep := DotStepTwo
6864 else
6865 DotStep := DotStepOne;
6866
6867 MousePos.X := (MousePos.X div DotStep) * DotStep;
6868 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6869 end;
6870
6871 procedure TMainForm.miShowEdgesClick(Sender: TObject);
6872 begin
6873 ShowEdges();
6874 end;
6875
6876 procedure TMainForm.miSnapToGridClick(Sender: TObject);
6877 begin
6878 SnapToGrid := not SnapToGrid;
6879
6880 MousePos.X := (MousePos.X div DotStep) * DotStep;
6881 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6882
6883 miSnapToGrid.Checked := SnapToGrid;
6884 end;
6885
6886 procedure TMainForm.minexttabClick(Sender: TObject);
6887 begin
6888 if pcObjects.ActivePageIndex < pcObjects.PageCount-1 then
6889 pcObjects.ActivePageIndex := pcObjects.ActivePageIndex+1
6890 else
6891 pcObjects.ActivePageIndex := 0;
6892 end;
6893
6894 procedure TMainForm.miSaveMiniMapClick(Sender: TObject);
6895 begin
6896 SaveMiniMapForm.ShowModal();
6897 end;
6898
6899 procedure TMainForm.bClearTextureClick(Sender: TObject);
6900 begin
6901 lbTextureList.ItemIndex := -1;
6902 lTextureWidth.Caption := '';
6903 lTextureHeight.Caption := '';
6904 end;
6905
6906 procedure TMainForm.miPackMapClick(Sender: TObject);
6907 begin
6908 PackMapForm.ShowModal();
6909 end;
6910
6911 type SSArray = array of String;
6912
6913 function ParseString (Str: AnsiString): SSArray;
6914 function GetStr (var Str: AnsiString): AnsiString;
6915 var a, b: Integer;
6916 begin
6917 Result := '';
6918 if Str[1] = '"' then
6919 for b := 1 to Length(Str) do
6920 if (b = Length(Str)) or (Str[b + 1] = '"') then
6921 begin
6922 Result := Copy(Str, 2, b - 1);
6923 Delete(Str, 1, b + 1);
6924 Str := Trim(Str);
6925 Exit;
6926 end;
6927 for a := 1 to Length(Str) do
6928 if (a = Length(Str)) or (Str[a + 1] = ' ') then
6929 begin
6930 Result := Copy(Str, 1, a);
6931 Delete(Str, 1, a + 1);
6932 Str := Trim(Str);
6933 Exit;
6934 end;
6935 end;
6936 begin
6937 Result := nil;
6938 Str := Trim(Str);
6939 while Str <> '' do
6940 begin
6941 SetLength(Result, Length(Result)+1);
6942 Result[High(Result)] := GetStr(Str);
6943 end;
6944 end;
6945
6946 procedure TMainForm.miTestMapClick(Sender: TObject);
6947 var
6948 newWAD, oldWAD, tempMap, ext: String;
6949 args: SSArray;
6950 opt: LongWord;
6951 time, i: Integer;
6952 proc: TProcessUTF8;
6953 res: Boolean;
6954 begin
6955 // Ignore while map testing in progress
6956 if MapTestProcess <> nil then
6957 Exit;
6958
6959 // Сохраняем временную карту:
6960 time := 0;
6961 repeat
6962 newWAD := Format('%s/temp%.4d', [MapsDir, time]);
6963 Inc(time);
6964 until not FileExists(newWAD);
6965 if OpenedMap <> '' then
6966 begin
6967 oldWad := g_ExtractWadName(OpenedMap);
6968 newWad := newWad + ExtractFileExt(oldWad);
6969 if CopyFile(oldWad, newWad) = false then
6970 e_WriteLog('MapTest: unable to copy [' + oldWad + '] to [' + newWad + ']', MSG_WARNING)
6971 end
6972 else
6973 begin
6974 newWad := newWad + '.wad'
6975 end;
6976 tempMap := newWAD + ':\' + TEST_MAP_NAME;
6977 SaveMap(tempMap, '');
6978
6979 // Опции игры:
6980 opt := 32 + 64;
6981 if TestOptionsTwoPlayers then
6982 opt := opt + 1;
6983 if TestOptionsTeamDamage then
6984 opt := opt + 2;
6985 if TestOptionsAllowExit then
6986 opt := opt + 4;
6987 if TestOptionsWeaponStay then
6988 opt := opt + 8;
6989 if TestOptionsMonstersDM then
6990 opt := opt + 16;
6991
6992 // Запускаем:
6993 proc := TProcessUTF8.Create(nil);
6994 proc.Executable := TestD2dExe;
6995 {$IFDEF DARWIN}
6996 // TODO: get real executable name from Info.plist
6997 if LowerCase(ExtractFileExt(TestD2dExe)) = '.app' then
6998 proc.Executable := TestD2dExe + DirectorySeparator + 'Contents' + DirectorySeparator + 'MacOS' + DirectorySeparator + 'Doom2DF';
6999 {$ENDIF}
7000 proc.Parameters.Add('-map');
7001 proc.Parameters.Add(tempMap);
7002 proc.Parameters.Add('-gm');
7003 proc.Parameters.Add(TestGameMode);
7004 proc.Parameters.Add('-limt');
7005 proc.Parameters.Add(TestLimTime);
7006 proc.Parameters.Add('-lims');
7007 proc.Parameters.Add(TestLimScore);
7008 proc.Parameters.Add('-opt');
7009 proc.Parameters.Add(IntToStr(opt));
7010 proc.Parameters.Add('--debug');
7011 if TestMapOnce then
7012 proc.Parameters.Add('--close');
7013
7014 args := ParseString(TestD2DArgs);
7015 for i := 0 to High(args) do
7016 proc.Parameters.Add(args[i]);
7017
7018 res := True;
7019 try
7020 proc.Execute();
7021 except
7022 res := False;
7023 end;
7024 if res then
7025 begin
7026 tbTestMap.Enabled := False;
7027 MapTestFile := newWAD;
7028 MapTestProcess := proc;
7029 end
7030 else
7031 begin
7032 Application.MessageBox(PChar(MsgMsgExecError), 'FIXME', MB_OK or MB_ICONERROR);
7033 SysUtils.DeleteFile(newWAD);
7034 proc.Free();
7035 end;
7036 end;
7037
7038 procedure TMainForm.sbVerticalScroll(Sender: TObject;
7039 ScrollCode: TScrollCode; var ScrollPos: Integer);
7040 begin
7041 MapOffset.Y := -sbVertical.Position;
7042 RenderPanel.Invalidate;
7043 end;
7044
7045 procedure TMainForm.sbHorizontalScroll(Sender: TObject;
7046 ScrollCode: TScrollCode; var ScrollPos: Integer);
7047 begin
7048 MapOffset.X := -sbHorizontal.Position;
7049 RenderPanel.Invalidate;
7050 end;
7051
7052 procedure TMainForm.miOpenWadMapClick(Sender: TObject);
7053 begin
7054 if OpenedWAD <> '' then
7055 begin
7056 OpenMap(OpenedWAD, '');
7057 end;
7058 end;
7059
7060 procedure TMainForm.selectall1Click(Sender: TObject);
7061 var
7062 a: Integer;
7063 begin
7064 RemoveSelectFromObjects();
7065
7066 if gPanels <> nil then
7067 for a := 0 to High(gPanels) do
7068 if gPanels[a].PanelType <> PANEL_NONE then
7069 SelectObject(OBJECT_PANEL, a, True);
7070
7071 if gItems <> nil then
7072 for a := 0 to High(gItems) do
7073 if gItems[a].ItemType <> ITEM_NONE then
7074 SelectObject(OBJECT_ITEM, a, True);
7075
7076 if gMonsters <> nil then
7077 for a := 0 to High(gMonsters) do
7078 if gMonsters[a].MonsterType <> MONSTER_NONE then
7079 SelectObject(OBJECT_MONSTER, a, True);
7080
7081 if gAreas <> nil then
7082 for a := 0 to High(gAreas) do
7083 if gAreas[a].AreaType <> AREA_NONE then
7084 SelectObject(OBJECT_AREA, a, True);
7085
7086 if gTriggers <> nil then
7087 for a := 0 to High(gTriggers) do
7088 if gTriggers[a].TriggerType <> TRIGGER_NONE then
7089 SelectObject(OBJECT_TRIGGER, a, True);
7090
7091 RecountSelectedObjects();
7092 end;
7093
7094 procedure TMainForm.Splitter1CanResize(Sender: TObject;
7095 var NewSize: Integer; var Accept: Boolean);
7096 begin
7097 Accept := (NewSize > 140);
7098 end;
7099
7100 procedure TMainForm.Splitter2CanResize(Sender: TObject;
7101 var NewSize: Integer; var Accept: Boolean);
7102 begin
7103 Accept := (NewSize > 110);
7104 end;
7105
7106 procedure TMainForm.vleObjectPropertyEnter(Sender: TObject);
7107 begin
7108 EditingProperties := True;
7109 end;
7110
7111 procedure TMainForm.vleObjectPropertyExit(Sender: TObject);
7112 begin
7113 EditingProperties := False;
7114 end;
7115
7116 procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
7117 begin
7118 // Объекты передвигались:
7119 if MainForm.ActiveControl = RenderPanel then
7120 begin
7121 if (Key = VK_NUMPAD4) or
7122 (Key = VK_NUMPAD6) or
7123 (Key = VK_NUMPAD8) or
7124 (Key = VK_NUMPAD5) or
7125 (Key = Ord('V')) then
7126 FillProperty();
7127 end;
7128 // Быстрое превью карты:
7129 if Key = Ord('E') then
7130 begin
7131 if PreviewMode = 2 then
7132 PreviewMode := 0;
7133 end;
7134 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
7135 end;
7136
7137 end.
[MIRROR] Doom2DF editor ported to FPC/Lazarus
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024