DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Fix mixed up message and title when opening a non-existent recent file
[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
1830 MainForm.miUndo.Enabled := UndoBuffer <> nil;
1831 end;
1832
1833 procedure FullClear();
1834 begin
1835 RemoveSelectFromObjects();
1836 ClearMap();
1837 LoadSky(gMapInfo.SkyName);
1838 UndoBuffer := nil;
1839 slInvalidTextures.Clear();
1840 MapCheckForm.lbErrorList.Clear();
1841 MapCheckForm.mErrorDescription.Clear();
1842
1843 MainForm.miUndo.Enabled := False;
1844 MainForm.sbHorizontal.Position := 0;
1845 MainForm.sbVertical.Position := 0;
1846 MainForm.FormResize(nil);
1847 MainForm.Caption := FormCaption;
1848 OpenedMap := '';
1849 OpenedWAD := '';
1850 end;
1851
1852 procedure ErrorMessageBox(str: String);
1853 begin
1854 Application.MessageBox(PChar(str), PChar(MsgMsgError),
1855 MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
1856 end;
1857
1858 function CheckProperty(): Boolean;
1859 var
1860 _id: Integer;
1861 begin
1862 Result := False;
1863
1864 _id := GetFirstSelected();
1865
1866 if SelectedObjects[_id].ObjectType = OBJECT_PANEL then
1867 with gPanels[SelectedObjects[_id].ID] do
1868 begin
1869 if TextureWidth <> 0 then
1870 if StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropWidth], 1) mod TextureWidth <> 0 then
1871 begin
1872 ErrorMessageBox(Format(MsgMsgWrongTexwidth,
1873 [TextureWidth]));
1874 Exit;
1875 end;
1876
1877 if TextureHeight <> 0 then
1878 if StrToIntDef(Trim(MainForm.vleObjectProperty.Values[MsgPropHeight]), 1) mod TextureHeight <> 0 then
1879 begin
1880 ErrorMessageBox(Format(MsgMsgWrongTexheight,
1881 [TextureHeight]));
1882 Exit;
1883 end;
1884
1885 if IsTexturedPanel(PanelType) and (TextureName <> '') then
1886 if not (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropPanelAlpha], -1) in [0..255]) then
1887 begin
1888 ErrorMessageBox(MsgMsgWrongAlpha);
1889 Exit;
1890 end;
1891 end;
1892
1893 if SelectedObjects[_id].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
1894 if (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropWidth], 0) <= 0) or
1895 (StrToIntDef(MainForm.vleObjectProperty.Values[MsgPropHeight], 0) <= 0) then
1896 begin
1897 ErrorMessageBox(MsgMsgWrongSize);
1898 Exit;
1899 end;
1900
1901 if (Trim(MainForm.vleObjectProperty.Values[MsgPropX]) = '') or
1902 (Trim(MainForm.vleObjectProperty.Values[MsgPropY]) = '') then
1903 begin
1904 ErrorMessageBox(MsgMsgWrongXy);
1905 Exit;
1906 end;
1907
1908 Result := True;
1909 end;
1910
1911 procedure SelectTexture(ID: Integer);
1912 begin
1913 MainForm.lbTextureList.ItemIndex := ID;
1914 MainForm.lbTextureListClick(nil);
1915 end;
1916
1917 function AddTexture(aWAD, aSection, aTex: String; silent: Boolean): Boolean;
1918 var
1919 a, FrameLen: Integer;
1920 ok: Boolean;
1921 FileName: String;
1922 ResourceName: String;
1923 FullResourceName: String;
1924 SectionName: String;
1925 Data: Pointer;
1926 Width, Height: Word;
1927 fn: String;
1928 begin
1929 Data := nil;
1930 FrameLen := 0;
1931 Width := 0;
1932 Height := 0;
1933
1934 if aSection = '..' then
1935 SectionName := ''
1936 else
1937 SectionName := aSection;
1938
1939 if aWAD = '' then
1940 aWAD := MsgWadSpecialMap;
1941
1942 if aWAD = MsgWadSpecialMap then
1943 begin // Файл карты
1944 g_ProcessResourceStr(OpenedMap, @fn, nil, nil);
1945 FileName := fn;
1946 ResourceName := ':'+SectionName+'\'+aTex;
1947 end
1948 else
1949 if aWAD = MsgWadSpecialTexs then
1950 begin // Спец. текстуры
1951 FileName := '';
1952 ResourceName := aTex;
1953 end
1954 else
1955 begin // Внешний WAD
1956 FileName := WadsDir + DirectorySeparator + aWAD;
1957 ResourceName := aWAD+':'+SectionName+'\'+aTex;
1958 end;
1959
1960 ok := True;
1961
1962 // Есть ли уже такая текстура:
1963 for a := 0 to MainForm.lbTextureList.Items.Count-1 do
1964 if ResourceName = MainForm.lbTextureList.Items[a] then
1965 begin
1966 if not silent then
1967 ErrorMessageBox(Format(MsgMsgTextureAlready,
1968 [ResourceName]));
1969 ok := False;
1970 end;
1971
1972 // Название ресурса <= 64 символов:
1973 if Length(ResourceName) > 64 then
1974 begin
1975 if not silent then
1976 ErrorMessageBox(Format(MsgMsgResName64,
1977 [ResourceName]));
1978 ok := False;
1979 end;
1980
1981 if ok then
1982 begin
1983 a := -1;
1984 if aWAD = MsgWadSpecialTexs then
1985 begin
1986 a := MainForm.lbTextureList.Items.Add(ResourceName);
1987 if not silent then
1988 SelectTexture(a);
1989 Result := True;
1990 Exit;
1991 end;
1992
1993 FullResourceName := FileName+':'+SectionName+'\'+aTex;
1994
1995 if IsAnim(FullResourceName) then
1996 begin // Аним. текстура
1997 GetFrame(FullResourceName, Data, FrameLen, Width, Height);
1998
1999 if not g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then
2000 ok := False;
2001 a := MainForm.lbTextureList.Items.Add(ResourceName);
2002 end
2003 else // Обычная текстура
2004 begin
2005 if not g_CreateTextureWAD(ResourceName, FullResourceName) then
2006 ok := False;
2007 a := MainForm.lbTextureList.Items.Add(ResourceName);
2008 end;
2009 if (not ok) and (slInvalidTextures.IndexOf(ResourceName) = -1) then
2010 begin
2011 slInvalidTextures.Add(ResourceName);
2012 ok := True;
2013 end;
2014 if (a > -1) and (not silent) then
2015 SelectTexture(a);
2016 end;
2017
2018 Result := ok;
2019 end;
2020
2021 procedure UpdateCaption(sMap, sFile, sRes: String);
2022 begin
2023 with MainForm do
2024 if (sFile = '') and (sRes = '') and (sMap = '') then
2025 Caption := FormCaption
2026 else
2027 if sMap = '' then
2028 Caption := Format('%s - %s:%s', [FormCaption, sFile, sRes])
2029 else
2030 if (sFile <> '') and (sRes <> '') then
2031 Caption := Format('%s - %s (%s:%s)', [FormCaption, sMap, sFile, sRes])
2032 else
2033 Caption := Format('%s - %s', [FormCaption, sMap]);
2034 end;
2035
2036 procedure OpenMap(FileName: String; mapN: String);
2037 var
2038 MapName: String;
2039 idx: Integer;
2040 begin
2041 SelectMapForm.Caption := MsgCapOpen;
2042 SelectMapForm.GetMaps(FileName);
2043
2044 if (FileName = OpenedWAD) and
2045 (OpenedMap <> '') then
2046 begin
2047 MapName := OpenedMap;
2048 while (Pos(':\', MapName) > 0) do
2049 Delete(MapName, 1, Pos(':\', MapName) + 1);
2050
2051 idx := SelectMapForm.lbMapList.Items.IndexOf(MapName);
2052 SelectMapForm.lbMapList.ItemIndex := idx;
2053 end
2054 else
2055 if SelectMapForm.lbMapList.Count > 0 then
2056 SelectMapForm.lbMapList.ItemIndex := 0
2057 else
2058 SelectMapForm.lbMapList.ItemIndex := -1;
2059
2060 if mapN = '' then
2061 idx := -1
2062 else
2063 idx := SelectMapForm.lbMapList.Items.IndexOf(mapN);
2064
2065 if idx < 0 then
2066 begin
2067 if (SelectMapForm.ShowModal() = mrOK) and
2068 (SelectMapForm.lbMapList.ItemIndex <> -1) then
2069 idx := SelectMapForm.lbMapList.ItemIndex
2070 else
2071 Exit;
2072 end;
2073
2074 MapName := SelectMapForm.lbMapList.Items[idx];
2075
2076 with MainForm do
2077 begin
2078 FullClear();
2079
2080 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
2081 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
2082 pLoadProgress.Show();
2083
2084 OpenedMap := FileName+':\'+MapName;
2085 OpenedWAD := FileName;
2086
2087 idx := RecentFiles.IndexOf(OpenedMap);
2088 // Такая карта уже недавно открывалась:
2089 if idx >= 0 then
2090 RecentFiles.Delete(idx);
2091 RecentFiles.Insert(0, OpenedMap);
2092 RefreshRecentMenu();
2093
2094 LoadMap(OpenedMap);
2095
2096 pLoadProgress.Hide();
2097 FormResize(nil);
2098
2099 lbTextureList.Sorted := True;
2100 lbTextureList.Sorted := False;
2101
2102 UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName);
2103 end;
2104 end;
2105
2106 procedure MoveSelectedObjects(Wall, alt: Boolean; dx, dy: Integer);
2107 var
2108 okX, okY: Boolean;
2109 a: Integer;
2110 begin
2111 if SelectedObjects = nil then
2112 Exit;
2113
2114 okX := True;
2115 okY := True;
2116
2117 if Wall then
2118 for a := 0 to High(SelectedObjects) do
2119 if SelectedObjects[a].Live then
2120 begin
2121 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, dx, 0) then
2122 okX := False;
2123
2124 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, 0, dy) then
2125 okY := False;
2126
2127 if (not okX) or (not okY) then
2128 Break;
2129 end;
2130
2131 if okX or okY then
2132 begin
2133 for a := 0 to High(SelectedObjects) do
2134 if SelectedObjects[a].Live then
2135 begin
2136 if okX then
2137 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, dx, 0);
2138
2139 if okY then
2140 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, 0, dy);
2141
2142 if alt and (SelectedObjects[a].ObjectType = OBJECT_TRIGGER) then
2143 begin
2144 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_PRESS,
2145 TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF] then
2146 begin // Двигаем зону Расширителя
2147 if okX then
2148 gTriggers[SelectedObjects[a].ID].Data.tX := gTriggers[SelectedObjects[a].ID].Data.tX+dx;
2149 if okY then
2150 gTriggers[SelectedObjects[a].ID].Data.tY := gTriggers[SelectedObjects[a].ID].Data.tY+dy;
2151 end;
2152
2153 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_TELEPORT] then
2154 begin // Двигаем точку назначения Телепорта
2155 if okX then
2156 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X+dx;
2157 if okY then
2158 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y+dy;
2159 end;
2160
2161 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNMONSTER] then
2162 begin // Двигаем точку создания монстра
2163 if okX then
2164 gTriggers[SelectedObjects[a].ID].Data.MonPos.X := gTriggers[SelectedObjects[a].ID].Data.MonPos.X+dx;
2165 if okY then
2166 gTriggers[SelectedObjects[a].ID].Data.MonPos.Y := gTriggers[SelectedObjects[a].ID].Data.MonPos.Y+dy;
2167 end;
2168
2169 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNITEM] then
2170 begin // Двигаем точку создания предмета
2171 if okX then
2172 gTriggers[SelectedObjects[a].ID].Data.ItemPos.X := gTriggers[SelectedObjects[a].ID].Data.ItemPos.X+dx;
2173 if okY then
2174 gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y := gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y+dy;
2175 end;
2176
2177 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SHOT] then
2178 begin // Двигаем точку создания выстрела
2179 if okX then
2180 gTriggers[SelectedObjects[a].ID].Data.ShotPos.X := gTriggers[SelectedObjects[a].ID].Data.ShotPos.X+dx;
2181 if okY then
2182 gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y := gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y+dy;
2183 end;
2184 end;
2185 end;
2186
2187 LastMovePoint := MousePos;
2188 end;
2189 end;
2190
2191 procedure ShowLayer(Layer: Byte; show: Boolean);
2192 begin
2193 LayerEnabled[Layer] := show;
2194
2195 case Layer of
2196 LAYER_BACK:
2197 begin
2198 MainForm.miLayer1.Checked := show;
2199 MainForm.miLayerP1.Checked := show;
2200 end;
2201 LAYER_WALLS:
2202 begin
2203 MainForm.miLayer2.Checked := show;
2204 MainForm.miLayerP2.Checked := show;
2205 end;
2206 LAYER_FOREGROUND:
2207 begin
2208 MainForm.miLayer3.Checked := show;
2209 MainForm.miLayerP3.Checked := show;
2210 end;
2211 LAYER_STEPS:
2212 begin
2213 MainForm.miLayer4.Checked := show;
2214 MainForm.miLayerP4.Checked := show;
2215 end;
2216 LAYER_WATER:
2217 begin
2218 MainForm.miLayer5.Checked := show;
2219 MainForm.miLayerP5.Checked := show;
2220 end;
2221 LAYER_ITEMS:
2222 begin
2223 MainForm.miLayer6.Checked := show;
2224 MainForm.miLayerP6.Checked := show;
2225 end;
2226 LAYER_MONSTERS:
2227 begin
2228 MainForm.miLayer7.Checked := show;
2229 MainForm.miLayerP7.Checked := show;
2230 end;
2231 LAYER_AREAS:
2232 begin
2233 MainForm.miLayer8.Checked := show;
2234 MainForm.miLayerP8.Checked := show;
2235 end;
2236 LAYER_TRIGGERS:
2237 begin
2238 MainForm.miLayer9.Checked := show;
2239 MainForm.miLayerP9.Checked := show;
2240 end;
2241 end;
2242
2243 RemoveSelectFromObjects();
2244 end;
2245
2246 procedure SwitchLayer(Layer: Byte);
2247 begin
2248 ShowLayer(Layer, not LayerEnabled[Layer]);
2249 end;
2250
2251 procedure SwitchMap();
2252 begin
2253 ShowMap := not ShowMap;
2254 MainForm.tbShowMap.Down := ShowMap;
2255 MainForm.miMiniMap.Checked := ShowMap;
2256 end;
2257
2258 procedure ShowEdges();
2259 begin
2260 if drEdge[3] < 255 then
2261 drEdge[3] := 255
2262 else
2263 drEdge[3] := gAlphaEdge;
2264 MainForm.miShowEdges.Checked := drEdge[3] <> 255;
2265 end;
2266
2267 function SelectedTexture(): String;
2268 begin
2269 if MainForm.lbTextureList.ItemIndex <> -1 then
2270 Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]
2271 else
2272 Result := '';
2273 end;
2274
2275 function IsSpecialTextureSel(): Boolean;
2276 begin
2277 Result := (MainForm.lbTextureList.ItemIndex <> -1) and
2278 IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]);
2279 end;
2280
2281 function CopyBufferToString(var CopyBuf: TCopyRecArray): String;
2282 var
2283 i, j: Integer;
2284 Res: String;
2285
2286 procedure AddInt(x: Integer);
2287 begin
2288 Res := Res + IntToStr(x) + ' ';
2289 end;
2290
2291 begin
2292 Result := '';
2293
2294 if Length(CopyBuf) = 0 then
2295 Exit;
2296
2297 Res := CLIPBOARD_SIG + ' ';
2298
2299 for i := 0 to High(CopyBuf) do
2300 begin
2301 if (CopyBuf[i].ObjectType = OBJECT_PANEL) and
2302 (CopyBuf[i].Panel = nil) then
2303 Continue;
2304
2305 // Тип объекта:
2306 AddInt(CopyBuf[i].ObjectType);
2307 Res := Res + '; ';
2308
2309 // Свойства объекта:
2310 case CopyBuf[i].ObjectType of
2311 OBJECT_PANEL:
2312 with CopyBuf[i].Panel^ do
2313 begin
2314 AddInt(PanelType);
2315 AddInt(X);
2316 AddInt(Y);
2317 AddInt(Width);
2318 AddInt(Height);
2319 Res := Res + '"' + TextureName + '" ';
2320 AddInt(Alpha);
2321 AddInt(IfThen(Blending, 1, 0));
2322 end;
2323
2324 OBJECT_ITEM:
2325 with CopyBuf[i].Item do
2326 begin
2327 AddInt(ItemType);
2328 AddInt(X);
2329 AddInt(Y);
2330 AddInt(IfThen(OnlyDM, 1, 0));
2331 AddInt(IfThen(Fall, 1, 0));
2332 end;
2333
2334 OBJECT_MONSTER:
2335 with CopyBuf[i].Monster do
2336 begin
2337 AddInt(MonsterType);
2338 AddInt(X);
2339 AddInt(Y);
2340 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2341 end;
2342
2343 OBJECT_AREA:
2344 with CopyBuf[i].Area do
2345 begin
2346 AddInt(AreaType);
2347 AddInt(X);
2348 AddInt(Y);
2349 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2350 end;
2351
2352 OBJECT_TRIGGER:
2353 with CopyBuf[i].Trigger do
2354 begin
2355 AddInt(TriggerType);
2356 AddInt(X);
2357 AddInt(Y);
2358 AddInt(Width);
2359 AddInt(Height);
2360 AddInt(ActivateType);
2361 AddInt(Key);
2362 AddInt(IfThen(Enabled, 1, 0));
2363 AddInt(TexturePanel);
2364
2365 for j := 0 to 127 do
2366 AddInt(Data.Default[j]);
2367 end;
2368 end;
2369 end;
2370
2371 Result := Res;
2372 end;
2373
2374 procedure StringToCopyBuffer(Str: String; var CopyBuf: TCopyRecArray; var pmin: TPoint);
2375 var
2376 i, j, t: Integer;
2377 minArea, newArea, newX, newY: LongInt;
2378
2379 function GetNext(): String;
2380 var
2381 p: Integer;
2382
2383 begin
2384 if Str[1] = '"' then
2385 begin
2386 Delete(Str, 1, 1);
2387 p := Pos('"', Str);
2388
2389 if p = 0 then
2390 begin
2391 Result := Str;
2392 Str := '';
2393 end
2394 else
2395 begin
2396 Result := Copy(Str, 1, p-1);
2397 Delete(Str, 1, p);
2398 Str := Trim(Str);
2399 end;
2400 end
2401 else
2402 begin
2403 p := Pos(' ', Str);
2404
2405 if p = 0 then
2406 begin
2407 Result := Str;
2408 Str := '';
2409 end
2410 else
2411 begin
2412 Result := Copy(Str, 1, p-1);
2413 Delete(Str, 1, p);
2414 Str := Trim(Str);
2415 end;
2416 end;
2417 end;
2418
2419 begin
2420 minArea := High(minArea);
2421 Str := Trim(Str);
2422
2423 if GetNext() <> CLIPBOARD_SIG then
2424 Exit;
2425
2426 while Str <> '' do
2427 begin
2428 // Тип объекта:
2429 t := StrToIntDef(GetNext(), 0);
2430
2431 if (t < OBJECT_PANEL) or (t > OBJECT_TRIGGER) or (GetNext() <> ';') then
2432 begin // Что-то не то => пропускаем:
2433 t := Pos(';', Str);
2434 Delete(Str, 1, t);
2435 Str := Trim(Str);
2436
2437 Continue;
2438 end;
2439
2440 i := Length(CopyBuf);
2441 SetLength(CopyBuf, i + 1);
2442
2443 CopyBuf[i].ObjectType := t;
2444 CopyBuf[i].Panel := nil;
2445
2446 // Свойства объекта:
2447 case t of
2448 OBJECT_PANEL:
2449 begin
2450 New(CopyBuf[i].Panel);
2451
2452 with CopyBuf[i].Panel^ do
2453 begin
2454 PanelType := StrToIntDef(GetNext(), PANEL_WALL);
2455 X := StrToIntDef(GetNext(), 0);
2456 Y := StrToIntDef(GetNext(), 0);
2457 Width := StrToIntDef(GetNext(), 16);
2458 Height := StrToIntDef(GetNext(), 16);
2459 TextureName := GetNext();
2460 Alpha := StrToIntDef(GetNext(), 0);
2461 Blending := (GetNext() = '1');
2462 newArea := X * Y - Width * Height;
2463 newX := X;
2464 newY := Y;
2465 end;
2466 end;
2467
2468 OBJECT_ITEM:
2469 with CopyBuf[i].Item do
2470 begin
2471 ItemType := StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL);
2472 X := StrToIntDef(GetNext(), 0);
2473 Y := StrToIntDef(GetNext(), 0);
2474 OnlyDM := (GetNext() = '1');
2475 Fall := (GetNext() = '1');
2476 newArea := X * Y;
2477 newX := X;
2478 newY := Y;
2479 end;
2480
2481 OBJECT_MONSTER:
2482 with CopyBuf[i].Monster do
2483 begin
2484 MonsterType := StrToIntDef(GetNext(), MONSTER_DEMON);
2485 X := StrToIntDef(GetNext(), 0);
2486 Y := StrToIntDef(GetNext(), 0);
2487 if GetNext() = '1'
2488 then Direction := D_LEFT
2489 else Direction := D_RIGHT;
2490 newArea := X * Y;
2491 newX := X;
2492 newY := Y;
2493 end;
2494
2495 OBJECT_AREA:
2496 with CopyBuf[i].Area do
2497 begin
2498 AreaType := StrToIntDef(GetNext(), AREA_PLAYERPOINT1);
2499 X := StrToIntDef(GetNext(), 0);
2500 Y := StrToIntDef(GetNext(), 0);
2501 if GetNext() = '1'
2502 then Direction := D_LEFT
2503 else Direction := D_RIGHT;
2504 newArea := X * Y;
2505 newX := X;
2506 newY := Y;
2507 end;
2508
2509 OBJECT_TRIGGER:
2510 with CopyBuf[i].Trigger do
2511 begin
2512 TriggerType := StrToIntDef(GetNext(), TRIGGER_EXIT);
2513 X := StrToIntDef(GetNext(), 0);
2514 Y := StrToIntDef(GetNext(), 0);
2515 Width := StrToIntDef(GetNext(), 16);
2516 Height := StrToIntDef(GetNext(), 16);
2517 ActivateType := StrToIntDef(GetNext(), 0);
2518 Key := StrToIntDef(GetNext(), 0);
2519 Enabled := (GetNext() = '1');
2520 TexturePanel := StrToIntDef(GetNext(), 0);
2521 for j := 0 to 127
2522 do Data.Default[j] := StrToIntDef(GetNext(), 0);
2523 newArea := X * Y - Width * Height;
2524 newX := X;
2525 newY := Y;
2526 end;
2527 end;
2528
2529 if newArea < minArea then
2530 begin
2531 minArea := newArea;
2532 pmin.X := newX;
2533 pmin.Y := newY;
2534 end;
2535 end;
2536 end;
2537
2538 //----------------------------------------
2539 //Закончились вспомогательные процедуры
2540 //----------------------------------------
2541
2542 procedure TMainForm.miRecentFileExecute (Sender: TObject);
2543 var
2544 s, fn: AnsiString;
2545 begin
2546 s := RecentFiles[(Sender as TMenuItem).Tag];
2547 fn := g_ExtractWadName(s);
2548 if FileExists(fn) then
2549 OpenMap(fn, g_ExtractFilePathName(s))
2550 else
2551 Application.MessageBox('File not available anymore', '', MB_OK);
2552 // if Application.MessageBox(PChar(MsgMsgDelRecentPrompt), PChar(MsgMsgDelRecent), MB_ICONQUESTION or MB_YESNO) = idYes then
2553 // begin
2554 // RecentFiles.Delete(n);
2555 // RefreshRecentMenu();
2556 // end;
2557 end;
2558
2559 procedure TMainForm.RefillRecentMenu (menu: TMenuItem; start: Integer; fmt: AnsiString);
2560 var i: Integer; MI: TMenuItem; s: AnsiString;
2561 begin
2562 Assert(menu <> nil);
2563 Assert(start >= 0);
2564 Assert(start <= menu.Count);
2565
2566 // clear all the recent entries from menu
2567 i := start;
2568 while i < menu.Count do
2569 begin
2570 MI := menu.Items[i];
2571 if @MI.OnClick <> @TMainForm.miRecentFileExecute then
2572 i += 1
2573 else
2574 begin
2575 menu.Delete(i);
2576 MI.Destroy();
2577 end;
2578 end;
2579
2580 // fill with a new ones
2581 for i := 0 to RecentFiles.Count-1 do
2582 begin
2583 MI := TMenuItem.Create(menu);
2584 s := RecentFiles[i];
2585 MI.Caption := Format(fmt, [i+1, g_ExtractWadNameNoPath(s), g_ExtractFilePathName(s)]);
2586 MI.OnClick := miRecentFileExecute;
2587 MI.Tag := i;
2588 menu.Insert(start + i, MI); // transfers ownership
2589 end;
2590 end;
2591
2592 procedure TMainForm.RefreshRecentMenu();
2593 var start: Integer;
2594 begin
2595 while RecentFiles.Count > RecentCount do
2596 RecentFiles.Delete(RecentFiles.Count - 1);
2597
2598 if miMacRecentSubMenu.Visible then
2599 begin
2600 // Reconstruct OSX-like recent list
2601 RefillRecentMenu(miMacRecentSubMenu, 0, '%1:s - %2:s');
2602 miMacRecentEnd.Enabled := RecentFiles.Count <> 0;
2603 miMacRecentEnd.Visible := RecentFiles.Count <> 0;
2604 end;
2605
2606 if miWinRecentStart.Visible then
2607 begin
2608 // Reconstruct Windows-like recent list
2609 start := miMenuFile.IndexOf(miWinRecent);
2610 if start < 0 then start := miMenuFile.Count else start += 1;
2611 RefillRecentMenu(miMenuFile, start, '%0:d %1:s:%2:s');
2612 miWinRecent.Enabled := False;
2613 miWinRecent.Visible := RecentFiles.Count = 0;
2614 end;
2615 end;
2616
2617 procedure TMainForm.miMacRecentClearClick(Sender: TObject);
2618 begin
2619 RecentFiles.Clear();
2620 RefreshRecentMenu();
2621 end;
2622
2623 procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
2624 begin
2625 OptionsForm.ShowModal();
2626 end;
2627
2628 procedure LoadStdFont(cfgres, texture: string; var FontID: DWORD);
2629 var
2630 cwdt, chgt: Byte;
2631 spc: ShortInt;
2632 ID: DWORD;
2633 wad: TWADEditor_1;
2634 cfgdata: Pointer;
2635 cfglen: Integer;
2636 config: TConfig;
2637 begin
2638 cfgdata := nil;
2639 cfglen := 0;
2640 ID := 0;
2641
2642 wad := TWADEditor_1.Create;
2643 if wad.ReadFile(GameWad) then
2644 wad.GetResource('FONTS', cfgres, cfgdata, cfglen);
2645 wad.Free();
2646
2647 if cfglen <> 0 then
2648 begin
2649 if not g_CreateTextureWAD('FONT_STD', GameWad + ':FONTS\' + texture) then
2650 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING);
2651
2652 config := TConfig.CreateMem(cfgdata, cfglen);
2653 cwdt := Min(Max(config.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2654 chgt := Min(Max(config.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2655 spc := Min(Max(config.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2656
2657 if g_GetTexture('FONT_STD', ID) then
2658 e_TextureFontBuild(ID, FontID, cwdt, chgt, spc-2);
2659
2660 config.Free();
2661 end
2662 else
2663 e_WriteLog('Could not load FONT_STD', MSG_WARNING);
2664
2665 if cfglen <> 0 then FreeMem(cfgdata);
2666 end;
2667
2668 procedure TMainForm.FormCreate(Sender: TObject);
2669 var
2670 config: TConfig;
2671 i: Integer;
2672 s: String;
2673 begin
2674 Randomize();
2675 LastDrawTime := 0;
2676
2677 {$IFDEF DARWIN}
2678 miApple.Enabled := True;
2679 miApple.Visible := True;
2680 miMacRecentSubMenu.Enabled := True;
2681 miMacRecentSubMenu.Visible := True;
2682 miWinRecentStart.Enabled := False;
2683 miWinRecentStart.Visible := False;
2684 miWinRecent.Enabled := False;
2685 miWinRecent.Visible := False;
2686 miLine2.Enabled := False;
2687 miLine2.Visible := False;
2688 miExit.Enabled := False;
2689 miExit.Visible := False;
2690 miOptions.Enabled := False;
2691 miOptions.Visible := False;
2692 miMenuWindow.Enabled := True;
2693 miMenuWindow.Visible := True;
2694 miAbout.Enabled := False;
2695 miAbout.Visible := False;
2696 {$ELSE}
2697 miApple.Enabled := False;
2698 miApple.Visible := False;
2699 miMacRecentSubMenu.Enabled := False;
2700 miMacRecentSubMenu.Visible := False;
2701 miWinRecentStart.Enabled := True;
2702 miWinRecentStart.Visible := True;
2703 miWinRecent.Enabled := True;
2704 miWinRecent.Visible := True;
2705 miLine2.Enabled := True;
2706 miLine2.Visible := True;
2707 miExit.Enabled := True;
2708 miExit.Visible := True;
2709 miOptions.Enabled := True;
2710 miOptions.Visible := True;
2711 miMenuWindow.Enabled := False;
2712 miMenuWindow.Visible := False;
2713 miAbout.Enabled := True;
2714 miAbout.Visible := True;
2715 {$ENDIF}
2716
2717 miNewMap.ShortCut := ShortCut(VK_N, [ssModifier]);
2718 miOpenMap.ShortCut := ShortCut(VK_O, [ssModifier]);
2719 miSaveMap.ShortCut := ShortCut(VK_S, [ssModifier]);
2720 {$IFDEF DARWIN}
2721 miSaveMapAs.ShortCut := ShortCut(VK_S, [ssModifier, ssShift]);
2722 miReopenMap.ShortCut := ShortCut(VK_F5, [ssModifier]);
2723 {$ENDIF}
2724 miUndo.ShortCut := ShortCut(VK_Z, [ssModifier]);
2725 miCopy.ShortCut := ShortCut(VK_C, [ssModifier]);
2726 miCut.ShortCut := ShortCut(VK_X, [ssModifier]);
2727 miPaste.ShortCut := ShortCut(VK_V, [ssModifier]);
2728 miSelectAll.ShortCut := ShortCut(VK_A, [ssModifier]);
2729 miToFore.ShortCut := ShortCut(VK_LCL_CLOSE_BRACKET, [ssModifier]);
2730 miToBack.ShortCut := ShortCut(VK_LCL_OPEN_BRACKET, [ssModifier]);
2731 {$IFDEF DARWIN}
2732 miMapOptions.Shortcut := ShortCut(VK_P, [ssModifier, ssAlt]);
2733 selectall1.Shortcut := ShortCut(VK_A, [ssModifier, ssAlt]);
2734 {$ENDIF}
2735
2736 e_WriteLog('Doom 2D: Forever Editor version ' + EDITOR_VERSION, MSG_NOTIFY);
2737 e_WriteLog('Build date: ' + EDITOR_BUILDDATE + ' ' + EDITOR_BUILDTIME, MSG_NOTIFY);
2738 e_WriteLog('Build hash: ' + g_GetBuildHash(), MSG_NOTIFY);
2739 e_WriteLog('Build by: ' + g_GetBuilderName(), MSG_NOTIFY);
2740
2741 slInvalidTextures := TStringList.Create;
2742
2743 ShowLayer(LAYER_BACK, True);
2744 ShowLayer(LAYER_WALLS, True);
2745 ShowLayer(LAYER_FOREGROUND, True);
2746 ShowLayer(LAYER_STEPS, True);
2747 ShowLayer(LAYER_WATER, True);
2748 ShowLayer(LAYER_ITEMS, True);
2749 ShowLayer(LAYER_MONSTERS, True);
2750 ShowLayer(LAYER_AREAS, True);
2751 ShowLayer(LAYER_TRIGGERS, True);
2752
2753 ClearMap();
2754
2755 FormCaption := MainForm.Caption;
2756 OpenedMap := '';
2757 OpenedWAD := '';
2758
2759 config := TConfig.CreateFile(CfgFileName);
2760
2761 gWADEditorLogLevel := config.ReadInt('WADEditor', 'LogLevel', DFWAD_LOG_DEFAULT);
2762
2763 if config.ReadInt('Editor', 'XPos', -1) = -1 then
2764 Position := poDesktopCenter
2765 else begin
2766 Left := config.ReadInt('Editor', 'XPos', Left);
2767 Top := config.ReadInt('Editor', 'YPos', Top);
2768 Width := config.ReadInt('Editor', 'Width', Width);
2769 Height := config.ReadInt('Editor', 'Height', Height);
2770 end;
2771 if config.ReadBool('Editor', 'Maximize', False) then
2772 WindowState := wsMaximized;
2773 ShowMap := config.ReadBool('Editor', 'Minimap', False);
2774 PanelProps.Width := config.ReadInt('Editor', 'PanelProps', PanelProps.ClientWidth);
2775 Splitter1.Left := PanelProps.Left;
2776 PanelObjs.Height := config.ReadInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
2777 Splitter2.Top := PanelObjs.Top;
2778 StatusBar.Top := PanelObjs.BoundsRect.Bottom;
2779 DotEnable := config.ReadBool('Editor', 'DotEnable', True);
2780 DotColor := config.ReadInt('Editor', 'DotColor', $FFFFFF);
2781 DotStepOne := config.ReadInt('Editor', 'DotStepOne', 16);
2782 DotStepTwo := config.ReadInt('Editor', 'DotStepTwo', 8);
2783 DotStep := config.ReadInt('Editor', 'DotStep', DotStepOne);
2784 DrawTexturePanel := config.ReadBool('Editor', 'DrawTexturePanel', True);
2785 DrawPanelSize := config.ReadBool('Editor', 'DrawPanelSize', True);
2786 BackColor := config.ReadInt('Editor', 'BackColor', $7F6040);
2787 PreviewColor := config.ReadInt('Editor', 'PreviewColor', $00FF00);
2788 UseCheckerboard := config.ReadBool('Editor', 'UseCheckerboard', True);
2789 gColorEdge := config.ReadInt('Editor', 'EdgeColor', COLOR_EDGE);
2790 gAlphaEdge := config.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE);
2791 if gAlphaEdge = 255 then
2792 gAlphaEdge := ALPHA_EDGE;
2793 drEdge[0] := GetRValue(gColorEdge);
2794 drEdge[1] := GetGValue(gColorEdge);
2795 drEdge[2] := GetBValue(gColorEdge);
2796 if not config.ReadBool('Editor', 'EdgeShow', True) then
2797 drEdge[3] := 255
2798 else
2799 drEdge[3] := gAlphaEdge;
2800 gAlphaTriggerLine := config.ReadInt('Editor', 'LineAlpha', ALPHA_LINE);
2801 if gAlphaTriggerLine = 255 then
2802 gAlphaTriggerLine := ALPHA_LINE;
2803 gAlphaTriggerArea := config.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA);
2804 if gAlphaTriggerArea = 255 then
2805 gAlphaTriggerArea := ALPHA_AREA;
2806 gAlphaMonsterRect := config.ReadInt('Editor', 'MonsterRectAlpha', 0);
2807 gAlphaAreaRect := config.ReadInt('Editor', 'AreaRectAlpha', 0);
2808 Scale := Max(config.ReadInt('Editor', 'Scale', 1), 1);
2809 DotSize := Max(config.ReadInt('Editor', 'DotSize', 1), 1);
2810 OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', MapsDir);
2811 SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', MapsDir);
2812
2813 s := config.ReadStr('Editor', 'Language', '');
2814 gLanguage := s;
2815
2816 TestGameMode := config.ReadStr('TestRun', 'GameMode', 'DM');
2817 TestLimTime := config.ReadStr('TestRun', 'LimTime', '0');
2818 TestLimScore := config.ReadStr('TestRun', 'LimScore', '0');
2819 TestOptionsTwoPlayers := config.ReadBool('TestRun', 'TwoPlayers', False);
2820 TestOptionsTeamDamage := config.ReadBool('TestRun', 'TeamDamage', False);
2821 TestOptionsAllowExit := config.ReadBool('TestRun', 'AllowExit', True);
2822 TestOptionsWeaponStay := config.ReadBool('TestRun', 'WeaponStay', False);
2823 TestOptionsMonstersDM := config.ReadBool('TestRun', 'MonstersDM', False);
2824 TestMapOnce := config.ReadBool('TestRun', 'MapOnce', False);
2825 {$IF DEFINED(DARWIN)}
2826 TestD2dExe := config.ReadStr('TestRun', 'ExeDrawin', GameExeFile);
2827 {$ELSEIF DEFINED(WINDOWS)}
2828 TestD2dExe := config.ReadStr('TestRun', 'ExeWindows', GameExeFile);
2829 {$ELSE}
2830 TestD2dExe := config.ReadStr('TestRun', 'ExeUnix', GameExeFile);
2831 {$ENDIF}
2832 TestD2DArgs := config.ReadStr('TestRun', 'Args', '');
2833
2834 RecentCount := config.ReadInt('Editor', 'RecentCount', 5);
2835 if RecentCount > 10 then
2836 RecentCount := 10;
2837 if RecentCount < 2 then
2838 RecentCount := 2;
2839
2840 RecentFiles := TStringList.Create();
2841 for i := 0 to RecentCount-1 do
2842 begin
2843 {$IFDEF WINDOWS}
2844 s := config.ReadStr('RecentFilesWin', IntToStr(i), '');
2845 {$ELSE}
2846 s := config.ReadStr('RecentFilesUnix', IntToStr(i), '');
2847 {$ENDIF}
2848 if s <> '' then
2849 RecentFiles.Add(s);
2850 end;
2851 RefreshRecentMenu();
2852
2853 config.Free();
2854
2855 tbShowMap.Down := ShowMap;
2856 tbGridOn.Down := DotEnable;
2857 pcObjects.ActivePageIndex := 0;
2858 Application.Title := MsgEditorTitle;
2859
2860 Application.OnIdle := OnIdle;
2861 end;
2862
2863 procedure PrintBlack(X, Y: Integer; Text: string; FontID: DWORD);
2864 begin
2865 // NOTE: all the font printing routines assume CP1251
2866 e_TextureFontPrintEx(X, Y, Text, FontID, 0, 0, 0, 1.0);
2867 end;
2868
2869 procedure InitGraphics;
2870 begin
2871 // FIXME: this is a shitty hack
2872 if not gDataLoaded then
2873 begin
2874 e_WriteLog('Init OpenGL', MSG_NOTIFY);
2875 e_InitGL();
2876 e_WriteLog('Loading data', MSG_NOTIFY);
2877 LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
2878 e_WriteLog('Loading more data', MSG_NOTIFY);
2879 LoadData();
2880 e_WriteLog('Loading even more data', MSG_NOTIFY);
2881 gDataLoaded := True;
2882 MainForm.FormResize(nil);
2883 end;
2884 end;
2885
2886 procedure TMainForm.Draw();
2887 var
2888 x, y: Integer;
2889 a, b: Integer;
2890 ID, PID: DWORD;
2891 Width, Height: Word;
2892 Rect: TRectWH;
2893 ObjCount: Word;
2894 aX, aY, aX2, aY2, XX, ScaleSz: Integer;
2895 begin
2896 LastDrawTime := GetTickCount64();
2897 ID := 0;
2898 PID := 0;
2899 Width := 0;
2900 Height := 0;
2901
2902 InitGraphics();
2903
2904 e_BeginRender();
2905
2906 e_Clear(GL_COLOR_BUFFER_BIT,
2907 GetRValue(BackColor)/255,
2908 GetGValue(BackColor)/255,
2909 GetBValue(BackColor)/255);
2910
2911 DrawMap();
2912
2913 ObjCount := SelectedObjectCount();
2914
2915 // Обводим выделенные объекты красной рамкой:
2916 if ObjCount > 0 then
2917 begin
2918 for a := 0 to High(SelectedObjects) do
2919 if SelectedObjects[a].Live then
2920 begin
2921 Rect := ObjectGetRect(SelectedObjects[a].ObjectType, SelectedObjects[a].ID);
2922
2923 with Rect do
2924 begin
2925 e_DrawQuad(X+MapOffset.X, Y+MapOffset.Y,
2926 X+MapOffset.X+Width-1, Y+MapOffset.Y+Height-1,
2927 255, 0, 0);
2928
2929 // Рисуем точки изменения размеров:
2930 if (ObjCount = 1) and
2931 (SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) then
2932 begin
2933 e_DrawPoint(5, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2934 e_DrawPoint(5, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2935 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 255, 255);
2936 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 255, 255);
2937
2938 e_DrawPoint(3, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2939 e_DrawPoint(3, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2940 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 0, 0);
2941 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 0, 0);
2942 end;
2943 end;
2944 end;
2945 end;
2946
2947 // Рисуем сетку:
2948 if DotEnable and (PreviewMode = 0) then
2949 begin
2950 if DotSize = 2 then
2951 a := -1
2952 else
2953 a := 0;
2954
2955 glDisable(GL_TEXTURE_2D);
2956 glColor3ub(GetRValue(DotColor), GetGValue(DotColor), GetBValue(DotColor));
2957 glPointSize(DotSize);
2958 glBegin(GL_POINTS);
2959 x := MapOffset.X mod DotStep;
2960 while x < RenderPanel.Width do
2961 begin
2962 y := MapOffset.Y mod DotStep;
2963 while y < RenderPanel.Height do
2964 begin
2965 glVertex2i(x + a, y + a);
2966 y += DotStep;
2967 end;
2968 x += DotStep;
2969 end;
2970 glEnd();
2971 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
2972 end;
2973
2974 // Превью текстуры:
2975 if (lbTextureList.ItemIndex <> -1) and (cbPreview.Checked) and
2976 (not IsSpecialTextureSel()) and (PreviewMode = 0) then
2977 begin
2978 if not g_GetTexture(SelectedTexture(), ID) then
2979 g_GetTexture('NOTEXTURE', ID);
2980 g_GetTextureSizeByID(ID, Width, Height);
2981 if UseCheckerboard then
2982 begin
2983 if g_GetTexture('PREVIEW', PID) then
2984 e_DrawFill(PID, RenderPanel.Width-Width, RenderPanel.Height-Height, Width div 16 + 1, Height div 16 + 1, 0, True, False);
2985 end else
2986 e_DrawFillQuad(RenderPanel.Width-Width-2, RenderPanel.Height-Height-2,
2987 RenderPanel.Width-1, RenderPanel.Height-1,
2988 GetRValue(PreviewColor), GetGValue(PreviewColor), GetBValue(PreviewColor), 0);
2989 e_Draw(ID, RenderPanel.Width-Width, RenderPanel.Height-Height, 0, True, False);
2990 end;
2991
2992 // Подсказка при выборе точки Телепорта:
2993 if SelectFlag = SELECTFLAG_TELEPORT then
2994 begin
2995 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
2996 if Data.d2d_teleport then
2997 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
2998 MousePos.X+16, MousePos.Y-1,
2999 0, 0, 255)
3000 else
3001 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+AreaSize[AREA_DMPOINT].Width-1,
3002 MousePos.Y+AreaSize[AREA_DMPOINT].Height-1, 255, 255, 255);
3003
3004 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3005 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3006 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintTeleport), gEditorFont);
3007 end;
3008
3009 // Подсказка при выборе точки появления:
3010 if SelectFlag = SELECTFLAG_SPAWNPOINT then
3011 begin
3012 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
3013 MousePos.X+16, MousePos.Y-1,
3014 0, 0, 255);
3015 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3016 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3017 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintSpawn), gEditorFont);
3018 end;
3019
3020 // Подсказка при выборе панели двери:
3021 if SelectFlag = SELECTFLAG_DOOR then
3022 begin
3023 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3024 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3025 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelDoor), gEditorFont);
3026 end;
3027
3028 // Подсказка при выборе панели с текстурой:
3029 if SelectFlag = SELECTFLAG_TEXTURE then
3030 begin
3031 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 192, 192, 192, 127);
3032 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 255, 255, 255);
3033 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelTexture), gEditorFont);
3034 end;
3035
3036 // Подсказка при выборе панели индикации выстрела:
3037 if SelectFlag = SELECTFLAG_SHOTPANEL then
3038 begin
3039 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 192, 192, 192, 127);
3040 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 255, 255, 255);
3041 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelShot), gEditorFont);
3042 end;
3043
3044 // Подсказка при выборе панели лифта:
3045 if SelectFlag = SELECTFLAG_LIFT then
3046 begin
3047 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
3048 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
3049 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintPanelLift), gEditorFont);
3050 end;
3051
3052 // Подсказка при выборе монстра:
3053 if SelectFlag = SELECTFLAG_MONSTER then
3054 begin
3055 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 192, 192, 192, 127);
3056 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 255, 255, 255);
3057 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintMonster), gEditorFont);
3058 end;
3059
3060 // Подсказка при выборе области воздействия:
3061 if DrawPressRect then
3062 begin
3063 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 192, 192, 192, 127);
3064 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 255, 255, 255);
3065 PrintBlack(MousePos.X+2, MousePos.Y+2, utf8to1251(MsgHintExtArea), gEditorFont);
3066 end;
3067
3068 // Рисуем текстуры, если чертим панель:
3069 if (MouseAction = MOUSEACTION_DRAWPANEL) and (DrawTexturePanel) and
3070 (lbTextureList.ItemIndex <> -1) and (DrawRect <> nil) and
3071 (lbPanelType.ItemIndex in [0..8]) and not IsSpecialTextureSel() then
3072 begin
3073 if not g_GetTexture(SelectedTexture(), ID) then
3074 g_GetTexture('NOTEXTURE', ID);
3075 g_GetTextureSizeByID(ID, Width, Height);
3076 with DrawRect^ do
3077 if (Abs(Right-Left) >= Width) and (Abs(Bottom-Top) >= Height) then
3078 e_DrawFill(ID, Min(Left, Right), Min(Top, Bottom), Abs(Right-Left) div Width,
3079 Abs(Bottom-Top) div Height, 64, True, False);
3080 end;
3081
3082 // Прямоугольник выделения:
3083 if DrawRect <> nil then
3084 with DrawRect^ do
3085 e_DrawQuad(Left, Top, Right-1, Bottom-1, 255, 255, 255);
3086
3087 // Чертим мышью панель/триггер или меняем мышью их размер:
3088 if (((MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER]) and
3089 not(ssCtrl in GetKeyShiftState())) or (MouseAction = MOUSEACTION_RESIZE)) and
3090 (DrawPanelSize) then
3091 begin
3092 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 192, 192, 192, 127);
3093 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 255, 255, 255);
3094
3095 if MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER] then
3096 begin // Чертим новый
3097 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(utf8to1251(MsgHintWidth),
3098 [Abs(MousePos.X-MouseLDownPos.X)]), gEditorFont);
3099 PrintBlack(MousePos.X+2, MousePos.Y+16, Format(utf8to1251(MsgHintHeight),
3100 [Abs(MousePos.Y-MouseLDownPos.Y)]), gEditorFont);
3101 end
3102 else // Растягиваем существующий
3103 if SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
3104 begin
3105 if SelectedObjects[GetFirstSelected].ObjectType = OBJECT_PANEL then
3106 begin
3107 Width := gPanels[SelectedObjects[GetFirstSelected].ID].Width;
3108 Height := gPanels[SelectedObjects[GetFirstSelected].ID].Height;
3109 end
3110 else
3111 begin
3112 Width := gTriggers[SelectedObjects[GetFirstSelected].ID].Width;
3113 Height := gTriggers[SelectedObjects[GetFirstSelected].ID].Height;
3114 end;
3115
3116 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(utf8to1251(MsgHintWidth), [Width]),
3117 gEditorFont);
3118 PrintBlack(MousePos.X+2, MousePos.Y+16, Format(utf8to1251(MsgHintHeight), [Height]),
3119 gEditorFont);
3120 end;
3121 end;
3122
3123 // Ближайшая к курсору мыши точка на сетке:
3124 e_DrawPoint(3, MousePos.X, MousePos.Y, 0, 0, 255);
3125
3126 // Мини-карта:
3127 if ShowMap then
3128 begin
3129 // Сколько пикселов карты в 1 пикселе мини-карты:
3130 ScaleSz := 16 div Scale;
3131 // Размеры мини-карты:
3132 aX := max(gMapInfo.Width div ScaleSz, 1);
3133 aY := max(gMapInfo.Height div ScaleSz, 1);
3134 // X-координата на RenderPanel нулевой x-координаты карты:
3135 XX := RenderPanel.Width - aX - 1;
3136 // Рамка карты:
3137 e_DrawFillQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 0, 0, 0, 0);
3138 e_DrawQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 197, 197, 197);
3139
3140 if gPanels <> nil then
3141 begin
3142 // Рисуем панели:
3143 for a := 0 to High(gPanels) do
3144 with gPanels[a] do
3145 if PanelType <> 0 then
3146 begin
3147 // Левый верхний угол:
3148 aX := XX + (X div ScaleSz);
3149 aY := 1 + (Y div ScaleSz);
3150 // Размеры:
3151 aX2 := max(Width div ScaleSz, 1);
3152 aY2 := max(Height div ScaleSz, 1);
3153 // Правый нижний угол:
3154 aX2 := aX + aX2 - 1;
3155 aY2 := aY + aY2 - 1;
3156
3157 case PanelType of
3158 PANEL_WALL: e_DrawFillQuad(aX, aY, aX2, aY2, 208, 208, 208, 0);
3159 PANEL_WATER: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 0, 192, 0);
3160 PANEL_ACID1: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 176, 0, 0);
3161 PANEL_ACID2: e_DrawFillQuad(aX, aY, aX2, aY2, 176, 0, 0, 0);
3162 PANEL_STEP: e_DrawFillQuad(aX, aY, aX2, aY2, 128, 128, 128, 0);
3163 PANEL_LIFTUP: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 72, 36, 0);
3164 PANEL_LIFTDOWN: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 124, 96, 0);
3165 PANEL_LIFTLEFT: e_DrawFillQuad(aX, aY, aX2, aY2, 200, 80, 4, 0);
3166 PANEL_LIFTRIGHT: e_DrawFillQuad(aX, aY, aX2, aY2, 252, 140, 56, 0);
3167 PANEL_OPENDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 100, 220, 92, 0);
3168 PANEL_CLOSEDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 212, 184, 64, 0);
3169 PANEL_BLOCKMON: e_DrawFillQuad(aX, aY, aX2, aY2, 192, 0, 192, 0);
3170 end;
3171 end;
3172
3173 // Рисуем красным выделенные панели:
3174 if SelectedObjects <> nil then
3175 for b := 0 to High(SelectedObjects) do
3176 with SelectedObjects[b] do
3177 if Live and (ObjectType = OBJECT_PANEL) then
3178 with gPanels[SelectedObjects[b].ID] do
3179 if PanelType and not(PANEL_BACK or PANEL_FORE) <> 0 then
3180 begin
3181 // Левый верхний угол:
3182 aX := XX + (X div ScaleSz);
3183 aY := 1 + (Y div ScaleSz);
3184 // Размеры:
3185 aX2 := max(Width div ScaleSz, 1);
3186 aY2 := max(Height div ScaleSz, 1);
3187 // Правый нижний угол:
3188 aX2 := aX + aX2 - 1;
3189 aY2 := aY + aY2 - 1;
3190
3191 e_DrawFillQuad(aX, aY, aX2, aY2, 255, 0, 0, 0)
3192 end;
3193 end;
3194
3195 if (gMapInfo.Width > RenderPanel.Width) or
3196 (gMapInfo.Height > RenderPanel.Height) then
3197 begin
3198 // Окно, показывающее текущее положение экрана на карте:
3199 // Размеры окна:
3200 x := max(min(RenderPanel.Width, gMapInfo.Width) div ScaleSz, 1);
3201 y := max(min(RenderPanel.Height, gMapInfo.Height) div ScaleSz, 1);
3202 // Левый верхний угол:
3203 aX := XX + ((-MapOffset.X) div ScaleSz);
3204 aY := 1 + ((-MapOffset.Y) div ScaleSz);
3205 // Правый нижний угол:
3206 aX2 := aX + x - 1;
3207 aY2 := aY + y - 1;
3208
3209 e_DrawFillQuad(aX, aY, aX2, aY2, 127, 192, 127, 127, B_BLEND);
3210 e_DrawQuad(aX, aY, aX2, aY2, 255, 0, 0);
3211 end;
3212 end; // Мини-карта
3213
3214 e_EndRender();
3215 RenderPanel.SwapBuffers();
3216 end;
3217
3218 procedure TMainForm.FormResize(Sender: TObject);
3219 begin
3220 e_SetViewPort(0, 0, RenderPanel.Width, RenderPanel.Height);
3221
3222 sbHorizontal.Min := Min(gMapInfo.Width - RenderPanel.Width, -RenderPanel.Width div 2);
3223 sbHorizontal.Max := Max(0, gMapInfo.Width - RenderPanel.Width div 2);
3224 sbVertical.Min := Min(gMapInfo.Height - RenderPanel.Height, -RenderPanel.Height div 2);
3225 sbVertical.Max := Max(0, gMapInfo.Height - RenderPanel.Height div 2);
3226
3227 MapOffset.X := -sbHorizontal.Position;
3228 MapOffset.Y := -sbVertical.Position;
3229 end;
3230
3231 procedure TMainForm.FormWindowStateChange(Sender: TObject);
3232 {$IFDEF DARWIN}
3233 var e: Boolean;
3234 {$ENDIF}
3235 begin
3236 {$IFDEF DARWIN}
3237 // deactivate all menus when main window minimized
3238 e := self.WindowState <> wsMinimized;
3239 miMenuFile.Enabled := e;
3240 miMenuEdit.Enabled := e;
3241 miMenuView.Enabled := e;
3242 miMenuService.Enabled := e;
3243 miMenuWindow.Enabled := e;
3244 miMenuHelp.Enabled := e;
3245 miMenuHidden.Enabled := e;
3246 {$ENDIF}
3247 end;
3248
3249 procedure SelectNextObject(X, Y: Integer; ObjectType: Byte; ID: DWORD);
3250 var
3251 j, j_max: Integer;
3252 res: Boolean;
3253 begin
3254 j_max := 0; // shut up compiler
3255 case ObjectType of
3256 OBJECT_PANEL:
3257 begin
3258 res := (gPanels <> nil) and
3259 PanelInShownLayer(gPanels[ID].PanelType) and
3260 g_CollidePoint(X, Y, gPanels[ID].X, gPanels[ID].Y,
3261 gPanels[ID].Width,
3262 gPanels[ID].Height);
3263 j_max := Length(gPanels) - 1;
3264 end;
3265
3266 OBJECT_ITEM:
3267 begin
3268 res := (gItems <> nil) and
3269 LayerEnabled[LAYER_ITEMS] and
3270 g_CollidePoint(X, Y, gItems[ID].X, gItems[ID].Y,
3271 ItemSize[gItems[ID].ItemType][0],
3272 ItemSize[gItems[ID].ItemType][1]);
3273 j_max := Length(gItems) - 1;
3274 end;
3275
3276 OBJECT_MONSTER:
3277 begin
3278 res := (gMonsters <> nil) and
3279 LayerEnabled[LAYER_MONSTERS] and
3280 g_CollidePoint(X, Y, gMonsters[ID].X, gMonsters[ID].Y,
3281 MonsterSize[gMonsters[ID].MonsterType].Width,
3282 MonsterSize[gMonsters[ID].MonsterType].Height);
3283 j_max := Length(gMonsters) - 1;
3284 end;
3285
3286 OBJECT_AREA:
3287 begin
3288 res := (gAreas <> nil) and
3289 LayerEnabled[LAYER_AREAS] and
3290 g_CollidePoint(X, Y, gAreas[ID].X, gAreas[ID].Y,
3291 AreaSize[gAreas[ID].AreaType].Width,
3292 AreaSize[gAreas[ID].AreaType].Height);
3293 j_max := Length(gAreas) - 1;
3294 end;
3295
3296 OBJECT_TRIGGER:
3297 begin
3298 res := (gTriggers <> nil) and
3299 LayerEnabled[LAYER_TRIGGERS] and
3300 g_CollidePoint(X, Y, gTriggers[ID].X, gTriggers[ID].Y,
3301 gTriggers[ID].Width,
3302 gTriggers[ID].Height);
3303 j_max := Length(gTriggers) - 1;
3304 end;
3305
3306 else
3307 res := False;
3308 end;
3309
3310 if not res then
3311 Exit;
3312
3313 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3314 j := ID;
3315
3316 while True do
3317 begin
3318 Dec(j);
3319
3320 if j < 0 then
3321 j := j_max;
3322 if j = Integer(ID) then
3323 Break;
3324
3325 case ObjectType of
3326 OBJECT_PANEL:
3327 res := PanelInShownLayer(gPanels[j].PanelType) and
3328 g_CollidePoint(X, Y, gPanels[j].X, gPanels[j].Y,
3329 gPanels[j].Width,
3330 gPanels[j].Height);
3331 OBJECT_ITEM:
3332 res := (gItems[j].ItemType <> ITEM_NONE) and
3333 g_CollidePoint(X, Y, gItems[j].X, gItems[j].Y,
3334 ItemSize[gItems[j].ItemType][0],
3335 ItemSize[gItems[j].ItemType][1]);
3336 OBJECT_MONSTER:
3337 res := (gMonsters[j].MonsterType <> MONSTER_NONE) and
3338 g_CollidePoint(X, Y, gMonsters[j].X, gMonsters[j].Y,
3339 MonsterSize[gMonsters[j].MonsterType].Width,
3340 MonsterSize[gMonsters[j].MonsterType].Height);
3341 OBJECT_AREA:
3342 res := (gAreas[j].AreaType <> AREA_NONE) and
3343 g_CollidePoint(X, Y, gAreas[j].X, gAreas[j].Y,
3344 AreaSize[gAreas[j].AreaType].Width,
3345 AreaSize[gAreas[j].AreaType].Height);
3346 OBJECT_TRIGGER:
3347 res := (gTriggers[j].TriggerType <> TRIGGER_NONE) and
3348 g_CollidePoint(X, Y, gTriggers[j].X, gTriggers[j].Y,
3349 gTriggers[j].Width,
3350 gTriggers[j].Height);
3351 else
3352 res := False;
3353 end;
3354
3355 if res then
3356 begin
3357 SetLength(SelectedObjects, 1);
3358
3359 SelectedObjects[0].ObjectType := ObjectType;
3360 SelectedObjects[0].ID := j;
3361 SelectedObjects[0].Live := True;
3362
3363 FillProperty();
3364 Break;
3365 end;
3366 end;
3367 end;
3368
3369 procedure TMainForm.RenderPanelMouseDown(Sender: TObject;
3370 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3371 var
3372 i: Integer;
3373 Rect: TRectWH;
3374 c1, c2, c3, c4: Boolean;
3375 item: TItem;
3376 area: TArea;
3377 monster: TMonster;
3378 IDArray: DWArray;
3379 begin
3380 MainForm.ActiveControl := RenderPanel;
3381 RenderPanel.SetFocus();
3382
3383 RenderPanelMouseMove(RenderPanel, Shift, X, Y);
3384
3385 if Button = mbLeft then // Left Mouse Button
3386 begin
3387 // Двигаем карту с помощью мыши и мини-карты:
3388 if ShowMap and
3389 g_CollidePoint(X, Y,
3390 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3391 1,
3392 max(gMapInfo.Width div (16 div Scale), 1),
3393 max(gMapInfo.Height div (16 div Scale), 1) ) then
3394 begin
3395 MoveMap(X, Y);
3396 MouseAction := MOUSEACTION_MOVEMAP;
3397 end
3398 else // Ставим предмет/монстра/область:
3399 if (pcObjects.ActivePageIndex in [1, 2, 3]) and
3400 (not (ssShift in Shift)) then
3401 begin
3402 case pcObjects.ActivePageIndex of
3403 1:
3404 if lbItemList.ItemIndex = -1 then
3405 ErrorMessageBox(MsgMsgChooseItem)
3406 else
3407 begin
3408 item.ItemType := lbItemList.ItemIndex + ITEM_MEDKIT_SMALL;
3409 if item.ItemType >= ITEM_WEAPON_KASTET then
3410 item.ItemType := item.ItemType + 2;
3411 item.X := MousePos.X-MapOffset.X;
3412 item.Y := MousePos.Y-MapOffset.Y;
3413
3414 if not (ssCtrl in Shift) then
3415 begin
3416 item.X := item.X - (ItemSize[item.ItemType][0] div 2);
3417 item.Y := item.Y - ItemSize[item.ItemType][1];
3418 end;
3419
3420 item.OnlyDM := cbOnlyDM.Checked;
3421 item.Fall := cbFall.Checked;
3422 Undo_Add(OBJECT_ITEM, AddItem(item));
3423 end;
3424 2:
3425 if lbMonsterList.ItemIndex = -1 then
3426 ErrorMessageBox(MsgMsgChooseMonster)
3427 else
3428 begin
3429 monster.MonsterType := lbMonsterList.ItemIndex + MONSTER_DEMON;
3430 monster.X := MousePos.X-MapOffset.X;
3431 monster.Y := MousePos.Y-MapOffset.Y;
3432
3433 if not (ssCtrl in Shift) then
3434 begin
3435 monster.X := monster.X - (MonsterSize[monster.MonsterType].Width div 2);
3436 monster.Y := monster.Y - MonsterSize[monster.MonsterType].Height;
3437 end;
3438
3439 if rbMonsterLeft.Checked then
3440 monster.Direction := D_LEFT
3441 else
3442 monster.Direction := D_RIGHT;
3443 Undo_Add(OBJECT_MONSTER, AddMonster(monster));
3444 end;
3445 3:
3446 if lbAreasList.ItemIndex = -1 then
3447 ErrorMessageBox(MsgMsgChooseArea)
3448 else
3449 if (lbAreasList.ItemIndex + 1) <> AREA_DOMFLAG then
3450 begin
3451 area.AreaType := lbAreasList.ItemIndex + AREA_PLAYERPOINT1;
3452 area.X := MousePos.X-MapOffset.X;
3453 area.Y := MousePos.Y-MapOffset.Y;
3454
3455 if not (ssCtrl in Shift) then
3456 begin
3457 area.X := area.X - (AreaSize[area.AreaType].Width div 2);
3458 area.Y := area.Y - AreaSize[area.AreaType].Height;
3459 end;
3460
3461 if rbAreaLeft.Checked then
3462 area.Direction := D_LEFT
3463 else
3464 area.Direction := D_RIGHT;
3465 Undo_Add(OBJECT_AREA, AddArea(area));
3466 end;
3467 end;
3468 end
3469 else
3470 begin
3471 i := GetFirstSelected();
3472
3473 // Выбираем объект под текущим:
3474 if (SelectedObjects <> nil) and
3475 (ssShift in Shift) and (i >= 0) and
3476 (SelectedObjects[i].Live) then
3477 begin
3478 if SelectedObjectCount() = 1 then
3479 SelectNextObject(X-MapOffset.X, Y-MapOffset.Y,
3480 SelectedObjects[i].ObjectType,
3481 SelectedObjects[i].ID);
3482 end
3483 else
3484 begin
3485 // Рисуем область триггера "Расширитель":
3486 if DrawPressRect and (i >= 0) and
3487 (SelectedObjects[i].ObjectType = OBJECT_TRIGGER) and
3488 (gTriggers[SelectedObjects[i].ID].TriggerType in
3489 [TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF]) then
3490 MouseAction := MOUSEACTION_DRAWPRESS
3491 else // Рисуем панель:
3492 if pcObjects.ActivePageIndex = 0 then
3493 begin
3494 if (lbPanelType.ItemIndex >= 0) then
3495 MouseAction := MOUSEACTION_DRAWPANEL
3496 end
3497 else // Рисуем триггер:
3498 if (lbTriggersList.ItemIndex >= 0) then
3499 begin
3500 MouseAction := MOUSEACTION_DRAWTRIGGER;
3501 end;
3502 end;
3503 end;
3504 end; // if Button = mbLeft
3505
3506 if Button = mbRight then // Right Mouse Button
3507 begin
3508 // Клик по мини-карте:
3509 if ShowMap and
3510 g_CollidePoint(X, Y,
3511 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3512 1,
3513 max(gMapInfo.Width div (16 div Scale), 1),
3514 max(gMapInfo.Height div (16 div Scale), 1) ) then
3515 begin
3516 MouseAction := MOUSEACTION_NOACTION;
3517 end
3518 else // Нужно что-то выбрать мышью:
3519 if SelectFlag <> SELECTFLAG_NONE then
3520 begin
3521 case SelectFlag of
3522 SELECTFLAG_TELEPORT:
3523 // Точку назначения телепортации:
3524 with gTriggers[SelectedObjects[
3525 GetFirstSelected() ].ID].Data.TargetPoint do
3526 begin
3527 X := MousePos.X-MapOffset.X;
3528 Y := MousePos.Y-MapOffset.Y;
3529 end;
3530
3531 SELECTFLAG_SPAWNPOINT:
3532 // Точку создания монстра:
3533 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
3534 if TriggerType = TRIGGER_SPAWNMONSTER then
3535 begin
3536 Data.MonPos.X := MousePos.X-MapOffset.X;
3537 Data.MonPos.Y := MousePos.Y-MapOffset.Y;
3538 end
3539 else if TriggerType = TRIGGER_SPAWNITEM then
3540 begin // Точка создания предмета:
3541 Data.ItemPos.X := MousePos.X-MapOffset.X;
3542 Data.ItemPos.Y := MousePos.Y-MapOffset.Y;
3543 end
3544 else if TriggerType = TRIGGER_SHOT then
3545 begin // Точка создания выстрела:
3546 Data.ShotPos.X := MousePos.X-MapOffset.X;
3547 Data.ShotPos.Y := MousePos.Y-MapOffset.Y;
3548 end;
3549
3550 SELECTFLAG_DOOR:
3551 // Дверь:
3552 begin
3553 IDArray := ObjectInRect(X-MapOffset.X,
3554 Y-MapOffset.Y,
3555 2, 2, OBJECT_PANEL, True);
3556 if IDArray <> nil then
3557 begin
3558 for i := 0 to High(IDArray) do
3559 if (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3560 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR) then
3561 begin
3562 gTriggers[SelectedObjects[
3563 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3564 Break;
3565 end;
3566 end
3567 else
3568 gTriggers[SelectedObjects[
3569 GetFirstSelected() ].ID].Data.PanelID := -1;
3570 end;
3571
3572 SELECTFLAG_TEXTURE:
3573 // Панель с текстурой:
3574 begin
3575 IDArray := ObjectInRect(X-MapOffset.X,
3576 Y-MapOffset.Y,
3577 2, 2, OBJECT_PANEL, True);
3578 if IDArray <> nil then
3579 begin
3580 for i := 0 to High(IDArray) do
3581 if ((gPanels[IDArray[i]].PanelType in
3582 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3583 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3584 PANEL_STEP]) or
3585 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3586 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3587 (gPanels[IDArray[i]].TextureName <> '') then
3588 begin
3589 gTriggers[SelectedObjects[
3590 GetFirstSelected() ].ID].TexturePanel := IDArray[i];
3591 Break;
3592 end;
3593 end
3594 else
3595 gTriggers[SelectedObjects[
3596 GetFirstSelected() ].ID].TexturePanel := -1;
3597 end;
3598
3599 SELECTFLAG_LIFT:
3600 // Лифт:
3601 begin
3602 IDArray := ObjectInRect(X-MapOffset.X,
3603 Y-MapOffset.Y,
3604 2, 2, OBJECT_PANEL, True);
3605 if IDArray <> nil then
3606 begin
3607 for i := 0 to High(IDArray) do
3608 if (gPanels[IDArray[i]].PanelType = PANEL_LIFTUP) or
3609 (gPanels[IDArray[i]].PanelType = PANEL_LIFTDOWN) or
3610 (gPanels[IDArray[i]].PanelType = PANEL_LIFTLEFT) or
3611 (gPanels[IDArray[i]].PanelType = PANEL_LIFTRIGHT) then
3612 begin
3613 gTriggers[SelectedObjects[
3614 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3615 Break;
3616 end;
3617 end
3618 else
3619 gTriggers[SelectedObjects[
3620 GetFirstSelected() ].ID].Data.PanelID := -1;
3621 end;
3622
3623 SELECTFLAG_MONSTER:
3624 // Монстра:
3625 begin
3626 IDArray := ObjectInRect(X-MapOffset.X,
3627 Y-MapOffset.Y,
3628 2, 2, OBJECT_MONSTER, False);
3629 if IDArray <> nil then
3630 gTriggers[SelectedObjects[
3631 GetFirstSelected() ].ID].Data.MonsterID := IDArray[0]+1
3632 else
3633 gTriggers[SelectedObjects[
3634 GetFirstSelected() ].ID].Data.MonsterID := 0;
3635 end;
3636
3637 SELECTFLAG_SHOTPANEL:
3638 // Панель индикации выстрела:
3639 begin
3640 if gTriggers[SelectedObjects[
3641 GetFirstSelected() ].ID].TriggerType = TRIGGER_SHOT then
3642 begin
3643 IDArray := ObjectInRect(X-MapOffset.X,
3644 Y-MapOffset.Y,
3645 2, 2, OBJECT_PANEL, True);
3646 if IDArray <> nil then
3647 begin
3648 for i := 0 to High(IDArray) do
3649 if ((gPanels[IDArray[i]].PanelType in
3650 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3651 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3652 PANEL_STEP]) or
3653 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3654 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3655 (gPanels[IDArray[i]].TextureName <> '') then
3656 begin
3657 gTriggers[SelectedObjects[
3658 GetFirstSelected() ].ID].Data.ShotPanelID := IDArray[i];
3659 Break;
3660 end;
3661 end
3662 else
3663 gTriggers[SelectedObjects[
3664 GetFirstSelected() ].ID].Data.ShotPanelID := -1;
3665 end;
3666 end;
3667 end;
3668
3669 SelectFlag := SELECTFLAG_SELECTED;
3670 end
3671 else // if SelectFlag <> SELECTFLAG_NONE...
3672 begin
3673 // Что уже выбрано и не нажат Ctrl:
3674 if (SelectedObjects <> nil) and
3675 (not (ssCtrl in Shift)) then
3676 for i := 0 to High(SelectedObjects) do
3677 with SelectedObjects[i] do
3678 if Live then
3679 begin
3680 if (ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) and
3681 (SelectedObjectCount() = 1) then
3682 begin
3683 Rect := ObjectGetRect(ObjectType, ID);
3684
3685 c1 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3686 Rect.X-2, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3687 c2 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3688 Rect.X+Rect.Width-3, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3689 c3 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3690 Rect.X+(Rect.Width div 2)-2, Rect.Y-2, 4, 4);
3691 c4 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3692 Rect.X+(Rect.Width div 2)-2, Rect.Y+Rect.Height-3, 4, 4);
3693
3694 // Меняем размер панели или триггера:
3695 if c1 or c2 or c3 or c4 then
3696 begin
3697 MouseAction := MOUSEACTION_RESIZE;
3698 LastMovePoint := MousePos;
3699
3700 if c1 or c2 then
3701 begin // Шире/уже
3702 ResizeType := RESIZETYPE_HORIZONTAL;
3703 if c1 then
3704 ResizeDirection := RESIZEDIR_LEFT
3705 else
3706 ResizeDirection := RESIZEDIR_RIGHT;
3707 RenderPanel.Cursor := crSizeWE;
3708 end
3709 else
3710 begin // Выше/ниже
3711 ResizeType := RESIZETYPE_VERTICAL;
3712 if c3 then
3713 ResizeDirection := RESIZEDIR_UP
3714 else
3715 ResizeDirection := RESIZEDIR_DOWN;
3716 RenderPanel.Cursor := crSizeNS;
3717 end;
3718
3719 Break;
3720 end;
3721 end;
3722
3723 // Перемещаем панель или триггер:
3724 if ObjectCollide(ObjectType, ID,
3725 X-MapOffset.X-1,
3726 Y-MapOffset.Y-1, 2, 2) then
3727 begin
3728 MouseAction := MOUSEACTION_MOVEOBJ;
3729 LastMovePoint := MousePos;
3730
3731 Break;
3732 end;
3733 end;
3734 end;
3735 end; // if Button = mbRight
3736
3737 if Button = mbMiddle then // Middle Mouse Button
3738 begin
3739 SetCapture(RenderPanel.Handle);
3740 RenderPanel.Cursor := crSize;
3741 end;
3742
3743 MouseMDown := Button = mbMiddle;
3744 if MouseMDown then
3745 MouseMDownPos := Mouse.CursorPos;
3746
3747 MouseRDown := Button = mbRight;
3748 if MouseRDown then
3749 MouseRDownPos := MousePos;
3750
3751 MouseLDown := Button = mbLeft;
3752 if MouseLDown then
3753 MouseLDownPos := MousePos;
3754 end;
3755
3756 procedure TMainForm.RenderPanelMouseUp(Sender: TObject;
3757 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3758 var
3759 panel: TPanel;
3760 trigger: TTrigger;
3761 rRect: TRectWH;
3762 rSelectRect: Boolean;
3763 wWidth, wHeight: Word;
3764 TextureID: DWORD;
3765
3766 procedure SelectObjects(ObjectType: Byte);
3767 var
3768 i: Integer;
3769 IDArray: DWArray;
3770 begin
3771 IDArray := ObjectInRect(rRect.X, rRect.Y,
3772 rRect.Width, rRect.Height,
3773 ObjectType, rSelectRect);
3774
3775 if IDArray <> nil then
3776 for i := 0 to High(IDArray) do
3777 SelectObject(ObjectType, IDArray[i], (ssCtrl in Shift) or rSelectRect);
3778 end;
3779 begin
3780 if Button = mbLeft then
3781 MouseLDown := False;
3782 if Button = mbRight then
3783 MouseRDown := False;
3784 if Button = mbMiddle then
3785 MouseMDown := False;
3786
3787 if DrawRect <> nil then
3788 begin
3789 Dispose(DrawRect);
3790 DrawRect := nil;
3791 end;
3792
3793 ResizeType := RESIZETYPE_NONE;
3794 TextureID := 0;
3795
3796 if Button = mbLeft then // Left Mouse Button
3797 begin
3798 if MouseAction <> MOUSEACTION_NONE then
3799 begin // Было действие мышью
3800 // Мышь сдвинулась во время удержания клавиши,
3801 // либо активирован режим быстрого рисования:
3802 if ((MousePos.X <> MouseLDownPos.X) and
3803 (MousePos.Y <> MouseLDownPos.Y)) or
3804 ((MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER]) and
3805 (ssCtrl in Shift)) then
3806 case MouseAction of
3807 // Рисовали панель:
3808 MOUSEACTION_DRAWPANEL:
3809 begin
3810 // Фон или передний план без текстуры - ошибка:
3811 if (lbPanelType.ItemIndex in [1, 2]) and
3812 (lbTextureList.ItemIndex = -1) then
3813 ErrorMessageBox(MsgMsgChooseTexture)
3814 else // Назначаем параметры панели:
3815 begin
3816 case lbPanelType.ItemIndex of
3817 0: Panel.PanelType := PANEL_WALL;
3818 1: Panel.PanelType := PANEL_BACK;
3819 2: Panel.PanelType := PANEL_FORE;
3820 3: Panel.PanelType := PANEL_OPENDOOR;
3821 4: Panel.PanelType := PANEL_CLOSEDOOR;
3822 5: Panel.PanelType := PANEL_STEP;
3823 6: Panel.PanelType := PANEL_WATER;
3824 7: Panel.PanelType := PANEL_ACID1;
3825 8: Panel.PanelType := PANEL_ACID2;
3826 9: Panel.PanelType := PANEL_LIFTUP;
3827 10: Panel.PanelType := PANEL_LIFTDOWN;
3828 11: Panel.PanelType := PANEL_LIFTLEFT;
3829 12: Panel.PanelType := PANEL_LIFTRIGHT;
3830 13: Panel.PanelType := PANEL_BLOCKMON;
3831 end;
3832
3833 Panel.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3834 Panel.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3835 if ssCtrl in Shift then
3836 begin
3837 wWidth := DotStep;
3838 wHeight := DotStep;
3839 if (lbTextureList.ItemIndex <> -1) and
3840 (not IsSpecialTextureSel()) then
3841 begin
3842 if not g_GetTexture(SelectedTexture(), TextureID) then
3843 g_GetTexture('NOTEXTURE', TextureID);
3844 g_GetTextureSizeByID(TextureID, wWidth, wHeight);
3845 end;
3846 Panel.Width := wWidth;
3847 Panel.Height := wHeight;
3848 end
3849 else
3850 begin
3851 Panel.Width := Abs(MousePos.X-MouseLDownPos.X);
3852 Panel.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3853 end;
3854
3855 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3856 if (lbPanelType.ItemIndex in [9, 10, 11, 12, 13]) or
3857 (lbTextureList.ItemIndex = -1) then
3858 begin
3859 Panel.TextureHeight := 1;
3860 Panel.TextureWidth := 1;
3861 Panel.TextureName := '';
3862 Panel.TextureID := TEXTURE_SPECIAL_NONE;
3863 end
3864 else // Есть текстура:
3865 begin
3866 Panel.TextureName := SelectedTexture();
3867
3868 // Обычная текстура:
3869 if not IsSpecialTextureSel() then
3870 begin
3871 g_GetTextureSizeByName(Panel.TextureName,
3872 Panel.TextureWidth, Panel.TextureHeight);
3873 g_GetTexture(Panel.TextureName, Panel.TextureID);
3874 end
3875 else // Спец.текстура:
3876 begin
3877 Panel.TextureHeight := 1;
3878 Panel.TextureWidth := 1;
3879 Panel.TextureID := SpecialTextureID(SelectedTexture());
3880 end;
3881 end;
3882
3883 Panel.Alpha := 0;
3884 Panel.Blending := False;
3885
3886 Undo_Add(OBJECT_PANEL, AddPanel(Panel));
3887 end;
3888 end;
3889
3890 // Рисовали триггер:
3891 MOUSEACTION_DRAWTRIGGER:
3892 begin
3893 trigger.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3894 trigger.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3895 if ssCtrl in Shift then
3896 begin
3897 wWidth := DotStep;
3898 wHeight := DotStep;
3899 trigger.Width := wWidth;
3900 trigger.Height := wHeight;
3901 end
3902 else
3903 begin
3904 trigger.Width := Abs(MousePos.X-MouseLDownPos.X);
3905 trigger.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3906 end;
3907
3908 trigger.Enabled := True;
3909 trigger.TriggerType := lbTriggersList.ItemIndex+1;
3910 trigger.TexturePanel := -1;
3911
3912 // Типы активации:
3913 trigger.ActivateType := 0;
3914
3915 if clbActivationType.Checked[0] then
3916 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERCOLLIDE;
3917 if clbActivationType.Checked[1] then
3918 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERCOLLIDE;
3919 if clbActivationType.Checked[2] then
3920 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERPRESS;
3921 if clbActivationType.Checked[3] then
3922 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERPRESS;
3923 if clbActivationType.Checked[4] then
3924 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_SHOT;
3925 if clbActivationType.Checked[5] then
3926 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_NOMONSTER;
3927
3928 // Необходимые для активации ключи:
3929 trigger.Key := 0;
3930
3931 if clbKeys.Checked[0] then
3932 trigger.Key := Trigger.Key or KEY_RED;
3933 if clbKeys.Checked[1] then
3934 trigger.Key := Trigger.Key or KEY_GREEN;
3935 if clbKeys.Checked[2] then
3936 trigger.Key := Trigger.Key or KEY_BLUE;
3937 if clbKeys.Checked[3] then
3938 trigger.Key := Trigger.Key or KEY_REDTEAM;
3939 if clbKeys.Checked[4] then
3940 trigger.Key := Trigger.Key or KEY_BLUETEAM;
3941
3942 // Параметры триггера:
3943 FillByte(trigger.Data.Default[0], 128, 0);
3944
3945 case trigger.TriggerType of
3946 // Переключаемая панель:
3947 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
3948 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
3949 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
3950 begin
3951 Trigger.Data.PanelID := -1;
3952 end;
3953
3954 // Телепортация:
3955 TRIGGER_TELEPORT:
3956 begin
3957 trigger.Data.TargetPoint.X := trigger.X-64;
3958 trigger.Data.TargetPoint.Y := trigger.Y-64;
3959 trigger.Data.d2d_teleport := True;
3960 trigger.Data.TlpDir := 0;
3961 end;
3962
3963 // Изменение других триггеров:
3964 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF,
3965 TRIGGER_ONOFF:
3966 begin
3967 trigger.Data.Count := 1;
3968 end;
3969
3970 // Звук:
3971 TRIGGER_SOUND:
3972 begin
3973 trigger.Data.Volume := 255;
3974 trigger.Data.Pan := 127;
3975 trigger.Data.PlayCount := 1;
3976 trigger.Data.Local := True;
3977 trigger.Data.SoundSwitch := False;
3978 end;
3979
3980 // Музыка:
3981 TRIGGER_MUSIC:
3982 begin
3983 trigger.Data.MusicAction := 1;
3984 end;
3985
3986 // Создание монстра:
3987 TRIGGER_SPAWNMONSTER:
3988 begin
3989 trigger.Data.MonType := MONSTER_ZOMBY;
3990 trigger.Data.MonPos.X := trigger.X-64;
3991 trigger.Data.MonPos.Y := trigger.Y-64;
3992 trigger.Data.MonHealth := 0;
3993 trigger.Data.MonActive := False;
3994 trigger.Data.MonCount := 1;
3995 end;
3996
3997 // Создание предмета:
3998 TRIGGER_SPAWNITEM:
3999 begin
4000 trigger.Data.ItemType := ITEM_AMMO_BULLETS;
4001 trigger.Data.ItemPos.X := trigger.X-64;
4002 trigger.Data.ItemPos.Y := trigger.Y-64;
4003 trigger.Data.ItemOnlyDM := False;
4004 trigger.Data.ItemFalls := False;
4005 trigger.Data.ItemCount := 1;
4006 trigger.Data.ItemMax := 0;
4007 trigger.Data.ItemDelay := 0;
4008 end;
4009
4010 // Ускорение:
4011 TRIGGER_PUSH:
4012 begin
4013 trigger.Data.PushAngle := 90;
4014 trigger.Data.PushForce := 10;
4015 trigger.Data.ResetVel := True;
4016 end;
4017
4018 TRIGGER_SCORE:
4019 begin
4020 trigger.Data.ScoreCount := 1;
4021 trigger.Data.ScoreCon := True;
4022 trigger.Data.ScoreMsg := True;
4023 end;
4024
4025 TRIGGER_MESSAGE:
4026 begin
4027 trigger.Data.MessageKind := 0;
4028 trigger.Data.MessageSendTo := 0;
4029 trigger.Data.MessageText := '';
4030 trigger.Data.MessageTime := 144;
4031 end;
4032
4033 TRIGGER_DAMAGE:
4034 begin
4035 trigger.Data.DamageValue := 5;
4036 trigger.Data.DamageInterval := 12;
4037 end;
4038
4039 TRIGGER_HEALTH:
4040 begin
4041 trigger.Data.HealValue := 5;
4042 trigger.Data.HealInterval := 36;
4043 end;
4044
4045 TRIGGER_SHOT:
4046 begin
4047 trigger.Data.ShotType := TRIGGER_SHOT_BULLET;
4048 trigger.Data.ShotSound := True;
4049 trigger.Data.ShotPanelID := -1;
4050 trigger.Data.ShotTarget := 0;
4051 trigger.Data.ShotIntSight := 0;
4052 trigger.Data.ShotAim := TRIGGER_SHOT_AIM_DEFAULT;
4053 trigger.Data.ShotPos.X := trigger.X-64;
4054 trigger.Data.ShotPos.Y := trigger.Y-64;
4055 trigger.Data.ShotAngle := 0;
4056 trigger.Data.ShotWait := 18;
4057 trigger.Data.ShotAccuracy := 0;
4058 trigger.Data.ShotAmmo := 0;
4059 trigger.Data.ShotIntReload := 0;
4060 end;
4061
4062 TRIGGER_EFFECT:
4063 begin
4064 trigger.Data.FXCount := 1;
4065 trigger.Data.FXType := TRIGGER_EFFECT_PARTICLE;
4066 trigger.Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
4067 trigger.Data.FXColorR := 0;
4068 trigger.Data.FXColorG := 0;
4069 trigger.Data.FXColorB := 255;
4070 trigger.Data.FXPos := TRIGGER_EFFECT_POS_CENTER;
4071 trigger.Data.FXWait := 1;
4072 trigger.Data.FXVelX := 0;
4073 trigger.Data.FXVelY := -20;
4074 trigger.Data.FXSpreadL := 5;
4075 trigger.Data.FXSpreadR := 5;
4076 trigger.Data.FXSpreadU := 4;
4077 trigger.Data.FXSpreadD := 0;
4078 end;
4079 end;
4080
4081 Undo_Add(OBJECT_TRIGGER, AddTrigger(trigger));
4082 end;
4083
4084 // Рисовали область триггера "Расширитель":
4085 MOUSEACTION_DRAWPRESS:
4086 with gTriggers[SelectedObjects[GetFirstSelected].ID] do
4087 begin
4088 Data.tX := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
4089 Data.tY := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
4090 Data.tWidth := Abs(MousePos.X-MouseLDownPos.X);
4091 Data.tHeight := Abs(MousePos.Y-MouseLDownPos.Y);
4092
4093 DrawPressRect := False;
4094 end;
4095 end;
4096
4097 MouseAction := MOUSEACTION_NONE;
4098 end;
4099 end // if Button = mbLeft...
4100 else if Button = mbRight then // Right Mouse Button:
4101 begin
4102 if MouseAction = MOUSEACTION_NOACTION then
4103 begin
4104 MouseAction := MOUSEACTION_NONE;
4105 Exit;
4106 end;
4107
4108 // Объект передвинут или изменен в размере:
4109 if MouseAction in [MOUSEACTION_MOVEOBJ, MOUSEACTION_RESIZE] then
4110 begin
4111 RenderPanel.Cursor := crDefault;
4112 MouseAction := MOUSEACTION_NONE;
4113 FillProperty();
4114 Exit;
4115 end;
4116
4117 // Еще не все выбрали:
4118 if SelectFlag <> SELECTFLAG_NONE then
4119 begin
4120 if SelectFlag = SELECTFLAG_SELECTED then
4121 SelectFlag := SELECTFLAG_NONE;
4122 FillProperty();
4123 Exit;
4124 end;
4125
4126 // Мышь сдвинулась во время удержания клавиши:
4127 if (MousePos.X <> MouseRDownPos.X) and
4128 (MousePos.Y <> MouseRDownPos.Y) then
4129 begin
4130 rSelectRect := True;
4131
4132 rRect.X := Min(MousePos.X, MouseRDownPos.X)-MapOffset.X;
4133 rRect.Y := Min(MousePos.Y, MouseRDownPos.Y)-MapOffset.Y;
4134 rRect.Width := Abs(MousePos.X-MouseRDownPos.X);
4135 rRect.Height := Abs(MousePos.Y-MouseRDownPos.Y);
4136 end
4137 else // Мышь не сдвинулась - нет прямоугольника:
4138 begin
4139 rSelectRect := False;
4140
4141 rRect.X := X-MapOffset.X-1;
4142 rRect.Y := Y-MapOffset.Y-1;
4143 rRect.Width := 2;
4144 rRect.Height := 2;
4145 end;
4146
4147 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
4148 if not (ssCtrl in Shift) then
4149 RemoveSelectFromObjects();
4150
4151 // Выделяем всё в выбранном прямоугольнике:
4152 if (ssCtrl in Shift) and (ssAlt in Shift) then
4153 begin
4154 SelectObjects(OBJECT_PANEL);
4155 SelectObjects(OBJECT_ITEM);
4156 SelectObjects(OBJECT_MONSTER);
4157 SelectObjects(OBJECT_AREA);
4158 SelectObjects(OBJECT_TRIGGER);
4159 end
4160 else
4161 SelectObjects(pcObjects.ActivePageIndex+1);
4162
4163 FillProperty();
4164 end
4165
4166 else // Middle Mouse Button
4167 begin
4168 RenderPanel.Cursor := crDefault;
4169 ReleaseCapture();
4170 end;
4171 end;
4172
4173 procedure TMainForm.RenderPanelPaint(Sender: TObject);
4174 begin
4175 Draw();
4176 end;
4177
4178 function TMainForm.RenderMousePos(): Types.TPoint;
4179 begin
4180 Result := RenderPanel.ScreenToClient(Mouse.CursorPos);
4181 end;
4182
4183 procedure TMainForm.RecountSelectedObjects();
4184 begin
4185 if SelectedObjectCount() = 0 then
4186 StatusBar.Panels[0].Text := ''
4187 else
4188 StatusBar.Panels[0].Text := Format(MsgCapStatSelected, [SelectedObjectCount()]);
4189 end;
4190
4191 procedure TMainForm.RenderPanelMouseMove(Sender: TObject;
4192 Shift: TShiftState; X, Y: Integer);
4193 var
4194 sX, sY: Integer;
4195 dWidth, dHeight: Integer;
4196 _id: Integer;
4197 TextureID: DWORD;
4198 wWidth, wHeight: Word;
4199 begin
4200 _id := GetFirstSelected();
4201 TextureID := 0;
4202
4203 // Рисуем панель с текстурой, сетка - размеры текстуры:
4204 if (MouseAction = MOUSEACTION_DRAWPANEL) and
4205 (lbPanelType.ItemIndex in [0..8]) and
4206 (lbTextureList.ItemIndex <> -1) and
4207 (not IsSpecialTextureSel()) then
4208 begin
4209 sX := StrToIntDef(lTextureWidth.Caption, DotStep);
4210 sY := StrToIntDef(lTextureHeight.Caption, DotStep);
4211 end
4212 else
4213 // Меняем размер панели с текстурой, сетка - размеры текстуры:
4214 if (MouseAction = MOUSEACTION_RESIZE) and
4215 ( (SelectedObjects[_id].ObjectType = OBJECT_PANEL) and
4216 IsTexturedPanel(gPanels[SelectedObjects[_id].ID].PanelType) and
4217 (gPanels[SelectedObjects[_id].ID].TextureName <> '') and
4218 (not IsSpecialTexture(gPanels[SelectedObjects[_id].ID].TextureName)) ) then
4219 begin
4220 sX := gPanels[SelectedObjects[_id].ID].TextureWidth;
4221 sY := gPanels[SelectedObjects[_id].ID].TextureHeight;
4222 end
4223 else
4224 // Выравнивание по сетке:
4225 if SnapToGrid then
4226 begin
4227 sX := DotStep;
4228 sY := DotStep;
4229 end
4230 else // Нет выравнивания по сетке:
4231 begin
4232 sX := 1;
4233 sY := 1;
4234 end;
4235
4236 // Новая позиция мыши:
4237 if MouseLDown then
4238 begin // Зажата левая кнопка мыши
4239 MousePos.X := (Round((X-MouseLDownPos.X)/sX)*sX)+MouseLDownPos.X;
4240 MousePos.Y := (Round((Y-MouseLDownPos.Y)/sY)*sY)+MouseLDownPos.Y;
4241 end
4242 else
4243 if MouseRDown then
4244 begin // Зажата правая кнопка мыши
4245 MousePos.X := (Round((X-MouseRDownPos.X)/sX)*sX)+MouseRDownPos.X;
4246 MousePos.Y := (Round((Y-MouseRDownPos.Y)/sY)*sY)+MouseRDownPos.Y;
4247 end
4248 else
4249 begin // Кнопки мыши не зажаты
4250 MousePos.X := Round((-MapOffset.X + X) / sX) * sX + MapOffset.X;
4251 MousePos.Y := Round((-MapOffset.Y + Y) / sY) * sY + MapOffset.Y;
4252 end;
4253
4254 // Зажата только правая кнопка мыши:
4255 if (not MouseLDown) and (MouseRDown) and (not MouseMDown) then
4256 begin
4257 // Рисуем прямоугольник выделения:
4258 if MouseAction = MOUSEACTION_NONE then
4259 begin
4260 if DrawRect = nil then
4261 New(DrawRect);
4262 DrawRect.Top := MouseRDownPos.y;
4263 DrawRect.Left := MouseRDownPos.x;
4264 DrawRect.Bottom := MousePos.y;
4265 DrawRect.Right := MousePos.x;
4266 end
4267 else
4268 // Двигаем выделенные объекты:
4269 if MouseAction = MOUSEACTION_MOVEOBJ then
4270 begin
4271 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift,
4272 MousePos.X-LastMovePoint.X,
4273 MousePos.Y-LastMovePoint.Y);
4274 end
4275 else
4276 // Меняем размер выделенного объекта:
4277 if MouseAction = MOUSEACTION_RESIZE then
4278 begin
4279 if (SelectedObjectCount = 1) and
4280 (SelectedObjects[GetFirstSelected].Live) then
4281 begin
4282 dWidth := MousePos.X-LastMovePoint.X;
4283 dHeight := MousePos.Y-LastMovePoint.Y;
4284
4285 case ResizeType of
4286 RESIZETYPE_VERTICAL: dWidth := 0;
4287 RESIZETYPE_HORIZONTAL: dHeight := 0;
4288 end;
4289
4290 case ResizeDirection of
4291 RESIZEDIR_UP: dHeight := -dHeight;
4292 RESIZEDIR_LEFT: dWidth := -dWidth;
4293 end;
4294
4295 if ResizeObject(SelectedObjects[GetFirstSelected].ObjectType,
4296 SelectedObjects[GetFirstSelected].ID,
4297 dWidth, dHeight, ResizeDirection) then
4298 LastMovePoint := MousePos;
4299 end;
4300 end;
4301 end;
4302
4303 // Зажата только левая кнопка мыши:
4304 if (not MouseRDown) and (MouseLDown) and (not MouseMDown) then
4305 begin
4306 // Рисуем прямоугольник планирования панели:
4307 if MouseAction in [MOUSEACTION_DRAWPANEL,
4308 MOUSEACTION_DRAWTRIGGER,
4309 MOUSEACTION_DRAWPRESS] then
4310 begin
4311 if DrawRect = nil then
4312 New(DrawRect);
4313 if ssCtrl in Shift then
4314 begin
4315 wWidth := DotStep;
4316 wHeight := DotStep;
4317 if (lbTextureList.ItemIndex <> -1) and (not IsSpecialTextureSel()) and
4318 (MouseAction = MOUSEACTION_DRAWPANEL) then
4319 begin
4320 if not g_GetTexture(SelectedTexture(), TextureID) then
4321 g_GetTexture('NOTEXTURE', TextureID);
4322 g_GetTextureSizeByID(TextureID, wWidth, wHeight);
4323 end;
4324 DrawRect.Top := MouseLDownPos.y;
4325 DrawRect.Left := MouseLDownPos.x;
4326 DrawRect.Bottom := DrawRect.Top + wHeight;
4327 DrawRect.Right := DrawRect.Left + wWidth;
4328 end
4329 else
4330 begin
4331 DrawRect.Top := MouseLDownPos.y;
4332 DrawRect.Left := MouseLDownPos.x;
4333 DrawRect.Bottom := MousePos.y;
4334 DrawRect.Right := MousePos.x;
4335 end;
4336 end
4337 else // Двигаем карту:
4338 if MouseAction = MOUSEACTION_MOVEMAP then
4339 begin
4340 MoveMap(X, Y);
4341 end;
4342 end;
4343
4344 // Only Middle Mouse Button is pressed
4345 if (not MouseLDown) and (not MouseRDown) and (MouseMDown) then
4346 begin
4347 MapOffset.X := -EnsureRange(-MapOffset.X + MouseMDownPos.X - Mouse.CursorPos.X,
4348 sbHorizontal.Min, sbHorizontal.Max);
4349 sbHorizontal.Position := -MapOffset.X;
4350 MapOffset.Y := -EnsureRange(-MapOffset.Y + MouseMDownPos.Y - Mouse.CursorPos.Y,
4351 sbVertical.Min, sbVertical.Max);
4352 sbVertical.Position := -MapOffset.Y;
4353 MouseMDownPos := Mouse.CursorPos;
4354 end;
4355
4356 // Клавиши мыши не зажаты:
4357 if (not MouseRDown) and (not MouseLDown) and (DrawRect <> nil) then
4358 begin
4359 Dispose(DrawRect);
4360 DrawRect := nil;
4361 end;
4362
4363 // Строка состояния - координаты мыши:
4364 StatusBar.Panels[1].Text := Format('(%d:%d)',
4365 [MousePos.X-MapOffset.X, MousePos.Y-MapOffset.Y]);
4366
4367 RenderPanel.Invalidate;
4368 end;
4369
4370 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
4371 begin
4372 CanClose := Application.MessageBox(PChar(MsgMsgExitPrompt),
4373 PChar(MsgMsgExit),
4374 MB_ICONQUESTION or MB_YESNO or
4375 MB_DEFBUTTON1) = idYes;
4376 end;
4377
4378 procedure TMainForm.aExitExecute(Sender: TObject);
4379 begin
4380 Close();
4381 end;
4382
4383 procedure TMainForm.FormDestroy(Sender: TObject);
4384 var
4385 config: TConfig;
4386 s: AnsiString;
4387 i: Integer;
4388 begin
4389 config := TConfig.CreateFile(CfgFileName);
4390
4391 config.WriteInt('WADEditor', 'LogLevel', gWADEditorLogLevel);
4392
4393 if WindowState <> wsMaximized then
4394 begin
4395 config.WriteInt('Editor', 'XPos', Left);
4396 config.WriteInt('Editor', 'YPos', Top);
4397 config.WriteInt('Editor', 'Width', Width);
4398 config.WriteInt('Editor', 'Height', Height);
4399 end
4400 else
4401 begin
4402 config.WriteInt('Editor', 'XPos', RestoredLeft);
4403 config.WriteInt('Editor', 'YPos', RestoredTop);
4404 config.WriteInt('Editor', 'Width', RestoredWidth);
4405 config.WriteInt('Editor', 'Height', RestoredHeight);
4406 end;
4407 config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
4408 config.WriteBool('Editor', 'Minimap', ShowMap);
4409 config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
4410 config.WriteInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
4411 config.WriteBool('Editor', 'DotEnable', DotEnable);
4412 config.WriteInt('Editor', 'DotStep', DotStep);
4413 config.WriteStr('Editor', 'LastOpenDir', OpenDialog.InitialDir);
4414 config.WriteStr('Editor', 'LastSaveDir', SaveDialog.InitialDir);
4415 config.WriteStr('Editor', 'Language', gLanguage);
4416 config.WriteBool('Editor', 'EdgeShow', drEdge[3] < 255);
4417 config.WriteInt('Editor', 'EdgeColor', gColorEdge);
4418 config.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge);
4419 config.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine);
4420 config.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea);
4421 config.WriteInt('Editor', 'MonsterRectAlpha', gAlphaMonsterRect);
4422 config.WriteInt('Editor', 'AreaRectAlpha', gAlphaAreaRect);
4423
4424 for i := 0 to RecentCount - 1 do
4425 begin
4426 if i < RecentFiles.Count then s := RecentFiles[i] else s := '';
4427 {$IFDEF WINDOWS}
4428 config.WriteStr('RecentFilesWin', IntToStr(i), s);
4429 {$ELSE}
4430 config.WriteStr('RecentFilesUnix', IntToStr(i), s);
4431 {$ENDIF}
4432 end;
4433 RecentFiles.Free();
4434
4435 config.SaveFile(CfgFileName);
4436 config.Free();
4437
4438 slInvalidTextures.Free;
4439 end;
4440
4441 procedure TMainForm.FormDropFiles(Sender: TObject;
4442 const FileNames: array of String);
4443 begin
4444 if Length(FileNames) <> 1 then
4445 Exit;
4446
4447 OpenMapFile(FileNames[0]);
4448 end;
4449
4450 procedure TMainForm.RenderPanelResize(Sender: TObject);
4451 begin
4452 if MainForm.Visible then
4453 MainForm.Resize();
4454 end;
4455
4456 procedure TMainForm.Splitter1Moved(Sender: TObject);
4457 begin
4458 FormResize(Sender);
4459 end;
4460
4461 procedure TMainForm.MapTestCheck(Sender: TObject);
4462 begin
4463 if MapTestProcess <> nil then
4464 begin
4465 if MapTestProcess.Running = false then
4466 begin
4467 if MapTestProcess.ExitCode <> 0 then
4468 Application.MessageBox(PChar(MsgMsgExecError), 'FIXME', MB_OK or MB_ICONERROR);
4469 SysUtils.DeleteFile(MapTestFile);
4470 MapTestFile := '';
4471 FreeAndNil(MapTestProcess);
4472 tbTestMap.Enabled := True;
4473 end;
4474 end;
4475 end;
4476
4477 procedure TMainForm.aMapOptionsExecute(Sender: TObject);
4478 var
4479 ResName: String;
4480 begin
4481 MapOptionsForm.ShowModal();
4482
4483 ResName := OpenedMap;
4484 while (Pos(':\', ResName) > 0) do
4485 Delete(ResName, 1, Pos(':\', ResName) + 1);
4486
4487 UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName);
4488 end;
4489
4490 procedure TMainForm.aAboutExecute(Sender: TObject);
4491 begin
4492 AboutForm.ShowModal();
4493 end;
4494
4495 procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
4496 var
4497 dx, dy, i: Integer;
4498 FileName: String;
4499 ok: Boolean;
4500 begin
4501 if (not EditingProperties) then
4502 begin
4503 if ssCtrl in Shift then
4504 begin
4505 case Chr(Key) of
4506 '1': ContourEnabled[LAYER_BACK] := not ContourEnabled[LAYER_BACK];
4507 '2': ContourEnabled[LAYER_WALLS] := not ContourEnabled[LAYER_WALLS];
4508 '3': ContourEnabled[LAYER_FOREGROUND] := not ContourEnabled[LAYER_FOREGROUND];
4509 '4': ContourEnabled[LAYER_STEPS] := not ContourEnabled[LAYER_STEPS];
4510 '5': ContourEnabled[LAYER_WATER] := not ContourEnabled[LAYER_WATER];
4511 '6': ContourEnabled[LAYER_ITEMS] := not ContourEnabled[LAYER_ITEMS];
4512 '7': ContourEnabled[LAYER_MONSTERS] := not ContourEnabled[LAYER_MONSTERS];
4513 '8': ContourEnabled[LAYER_AREAS] := not ContourEnabled[LAYER_AREAS];
4514 '9': ContourEnabled[LAYER_TRIGGERS] := not ContourEnabled[LAYER_TRIGGERS];
4515 '0':
4516 begin
4517 ok := False;
4518 for i := Low(ContourEnabled) to High(ContourEnabled) do
4519 if ContourEnabled[i] then
4520 ok := True;
4521 for i := Low(ContourEnabled) to High(ContourEnabled) do
4522 ContourEnabled[i] := not ok
4523 end
4524 end
4525 end
4526 else
4527 begin
4528 case Chr(key) of
4529 '1': SwitchLayer(LAYER_BACK);
4530 '2': SwitchLayer(LAYER_WALLS);
4531 '3': SwitchLayer(LAYER_FOREGROUND);
4532 '4': SwitchLayer(LAYER_STEPS);
4533 '5': SwitchLayer(LAYER_WATER);
4534 '6': SwitchLayer(LAYER_ITEMS);
4535 '7': SwitchLayer(LAYER_MONSTERS);
4536 '8': SwitchLayer(LAYER_AREAS);
4537 '9': SwitchLayer(LAYER_TRIGGERS);
4538 '0': tbShowClick(tbShow);
4539 end
4540 end;
4541
4542 if Key = Ord('I') then
4543 begin // Поворот монстров и областей:
4544 if (SelectedObjects <> nil) then
4545 begin
4546 for i := 0 to High(SelectedObjects) do
4547 if (SelectedObjects[i].Live) then
4548 begin
4549 if (SelectedObjects[i].ObjectType = OBJECT_MONSTER) then
4550 begin
4551 g_ChangeDir(gMonsters[SelectedObjects[i].ID].Direction);
4552 end
4553 else
4554 if (SelectedObjects[i].ObjectType = OBJECT_AREA) then
4555 begin
4556 g_ChangeDir(gAreas[SelectedObjects[i].ID].Direction);
4557 end;
4558 end;
4559 end
4560 else
4561 begin
4562 if pcObjects.ActivePage = tsMonsters then
4563 begin
4564 if rbMonsterLeft.Checked then
4565 rbMonsterRight.Checked := True
4566 else
4567 rbMonsterLeft.Checked := True;
4568 end;
4569 if pcObjects.ActivePage = tsAreas then
4570 begin
4571 if rbAreaLeft.Checked then
4572 rbAreaRight.Checked := True
4573 else
4574 rbAreaLeft.Checked := True;
4575 end;
4576 end;
4577 end;
4578
4579 if not (ssCtrl in Shift) then
4580 begin
4581 // Быстрое превью карты:
4582 if Key = Ord('E') then
4583 begin
4584 if PreviewMode = 0 then
4585 PreviewMode := 2;
4586 end;
4587
4588 // Вертикальный скролл карты:
4589 with sbVertical do
4590 begin
4591 if Key = Ord('W') then
4592 begin
4593 dy := Position;
4594 if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max)
4595 else Position := EnsureRange(Position - DotStep, Min, Max);
4596 MapOffset.Y := -Position;
4597 dy -= Position;
4598
4599 if (MouseLDown or MouseRDown) then
4600 begin
4601 if DrawRect <> nil then
4602 begin
4603 Inc(MouseLDownPos.y, dy);
4604 Inc(MouseRDownPos.y, dy);
4605 end;
4606 Inc(LastMovePoint.Y, dy);
4607 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4608 end;
4609 end;
4610
4611 if Key = Ord('S') then
4612 begin
4613 dy := Position;
4614 if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max)
4615 else Position := EnsureRange(Position + DotStep, Min, Max);
4616 MapOffset.Y := -Position;
4617 dy -= Position;
4618
4619 if (MouseLDown or MouseRDown) then
4620 begin
4621 if DrawRect <> nil then
4622 begin
4623 Inc(MouseLDownPos.y, dy);
4624 Inc(MouseRDownPos.y, dy);
4625 end;
4626 Inc(LastMovePoint.Y, dy);
4627 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4628 end;
4629 end;
4630 end;
4631
4632 // Горизонтальный скролл карты:
4633 with sbHorizontal do
4634 begin
4635 if Key = Ord('A') then
4636 begin
4637 dx := Position;
4638 if ssShift in Shift then Position := EnsureRange(Position - DotStep * 4, Min, Max)
4639 else Position := EnsureRange(Position - DotStep, Min, Max);
4640 MapOffset.X := -Position;
4641 dx -= Position;
4642
4643 if (MouseLDown or MouseRDown) then
4644 begin
4645 if DrawRect <> nil then
4646 begin
4647 Inc(MouseLDownPos.x, dx);
4648 Inc(MouseRDownPos.x, dx);
4649 end;
4650 Inc(LastMovePoint.X, dx);
4651 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4652 end;
4653 end;
4654
4655 if Key = Ord('D') then
4656 begin
4657 dx := Position;
4658 if ssShift in Shift then Position := EnsureRange(Position + DotStep * 4, Min, Max)
4659 else Position := EnsureRange(Position + DotStep, Min, Max);
4660 MapOffset.X := -Position;
4661 dx -= Position;
4662
4663 if (MouseLDown or MouseRDown) then
4664 begin
4665 if DrawRect <> nil then
4666 begin
4667 Inc(MouseLDownPos.x, dx);
4668 Inc(MouseRDownPos.x, dx);
4669 end;
4670 Inc(LastMovePoint.X, dx);
4671 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4672 end;
4673 end;
4674 end;
4675 end
4676 else // ssCtrl in Shift
4677 begin
4678 if ssShift in Shift then
4679 begin
4680 // Вставка по абсолютному смещению:
4681 if Key = Ord('V') then
4682 aPasteObjectExecute(Sender);
4683 end;
4684 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
4685 end;
4686 end;
4687
4688 // Удалить выделенные объекты:
4689 if (Key = VK_DELETE) and (SelectedObjects <> nil) and
4690 RenderPanel.Focused() then
4691 DeleteSelectedObjects();
4692
4693 // Снять выделение:
4694 if (Key = VK_ESCAPE) and (SelectedObjects <> nil) then
4695 RemoveSelectFromObjects();
4696
4697 // Передвинуть объекты:
4698 if MainForm.ActiveControl = RenderPanel then
4699 begin
4700 dx := 0;
4701 dy := 0;
4702
4703 if Key = VK_NUMPAD4 then
4704 dx := IfThen(ssAlt in Shift, -1, -DotStep);
4705 if Key = VK_NUMPAD6 then
4706 dx := IfThen(ssAlt in Shift, 1, DotStep);
4707 if Key = VK_NUMPAD8 then
4708 dy := IfThen(ssAlt in Shift, -1, -DotStep);
4709 if Key = VK_NUMPAD5 then
4710 dy := IfThen(ssAlt in Shift, 1, DotStep);
4711
4712 if (dx <> 0) or (dy <> 0) then
4713 begin
4714 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift, dx, dy);
4715 Key := 0;
4716 end;
4717 end;
4718
4719 if ssCtrl in Shift then
4720 begin
4721 // Выбор панели с текстурой для триггера
4722 if Key = Ord('T') then
4723 begin
4724 DrawPressRect := False;
4725 if SelectFlag = SELECTFLAG_TEXTURE then
4726 begin
4727 SelectFlag := SELECTFLAG_NONE;
4728 Exit;
4729 end;
4730 vleObjectProperty.FindRow(MsgPropTrTexturePanel, i);
4731 if i > 0 then
4732 SelectFlag := SELECTFLAG_TEXTURE;
4733 end;
4734
4735 if Key = Ord('D') then
4736 begin
4737 SelectFlag := SELECTFLAG_NONE;
4738 if DrawPressRect then
4739 begin
4740 DrawPressRect := False;
4741 Exit;
4742 end;
4743 i := -1;
4744
4745 // Выбор области воздействия, в зависимости от типа триггера
4746 vleObjectProperty.FindRow(MsgPropTrExArea, i);
4747 if i > 0 then
4748 begin
4749 DrawPressRect := True;
4750 Exit;
4751 end;
4752 vleObjectProperty.FindRow(MsgPropTrDoorPanel, i);
4753 if i <= 0 then
4754 vleObjectProperty.FindRow(MsgPropTrTrapPanel, i);
4755 if i > 0 then
4756 begin
4757 SelectFlag := SELECTFLAG_DOOR;
4758 Exit;
4759 end;
4760 vleObjectProperty.FindRow(MsgPropTrLiftPanel, i);
4761 if i > 0 then
4762 begin
4763 SelectFlag := SELECTFLAG_LIFT;
4764 Exit;
4765 end;
4766 vleObjectProperty.FindRow(MsgPropTrTeleportTo, i);
4767 if i > 0 then
4768 begin
4769 SelectFlag := SELECTFLAG_TELEPORT;
4770 Exit;
4771 end;
4772 vleObjectProperty.FindRow(MsgPropTrSpawnTo, i);
4773 if i > 0 then
4774 begin
4775 SelectFlag := SELECTFLAG_SPAWNPOINT;
4776 Exit;
4777 end;
4778
4779 // Выбор основного параметра, в зависимости от типа триггера
4780 vleObjectProperty.FindRow(MsgPropTrNextMap, i);
4781 if i > 0 then
4782 begin
4783 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
4784 SelectMapForm.Caption := MsgCapSelect;
4785 SelectMapForm.GetMaps(FileName);
4786
4787 if SelectMapForm.ShowModal() = mrOK then
4788 begin
4789 vleObjectProperty.Cells[1, i] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
4790 bApplyProperty.Click();
4791 end;
4792 Exit;
4793 end;
4794 vleObjectProperty.FindRow(MsgPropTrSoundName, i);
4795 if i <= 0 then
4796 vleObjectProperty.FindRow(MsgPropTrMusicName, i);
4797 if i > 0 then
4798 begin
4799 AddSoundForm.OKFunction := nil;
4800 AddSoundForm.lbResourcesList.MultiSelect := False;
4801 AddSoundForm.SetResource := vleObjectProperty.Cells[1, i];
4802
4803 if (AddSoundForm.ShowModal() = mrOk) then
4804 begin
4805 vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName;
4806 bApplyProperty.Click();
4807 end;
4808 Exit;
4809 end;
4810 vleObjectProperty.FindRow(MsgPropTrPushAngle, i);
4811 if i <= 0 then
4812 vleObjectProperty.FindRow(MsgPropTrMessageText, i);
4813 if i > 0 then
4814 begin
4815 vleObjectProperty.Row := i;
4816 vleObjectProperty.SetFocus();
4817 Exit;
4818 end;
4819 end;
4820 end;
4821 end;
4822
4823 procedure TMainForm.aOptimizeExecute(Sender: TObject);
4824 begin
4825 RemoveSelectFromObjects();
4826 MapOptimizationForm.ShowModal();
4827 end;
4828
4829 procedure TMainForm.aCheckMapExecute(Sender: TObject);
4830 begin
4831 MapCheckForm.ShowModal();
4832 end;
4833
4834 procedure TMainForm.bbAddTextureClick(Sender: TObject);
4835 begin
4836 AddTextureForm.lbResourcesList.MultiSelect := True;
4837 AddTextureForm.ShowModal();
4838 end;
4839
4840 procedure TMainForm.lbTextureListClick(Sender: TObject);
4841 var
4842 TextureID: DWORD;
4843 TextureWidth, TextureHeight: Word;
4844 begin
4845 TextureID := 0;
4846 TextureWidth := 0;
4847 TextureHeight := 0;
4848 if (lbTextureList.ItemIndex <> -1) and
4849 (not IsSpecialTextureSel()) then
4850 begin
4851 if g_GetTexture(SelectedTexture(), TextureID) then
4852 begin
4853 g_GetTextureSizeByID(TextureID, TextureWidth, TextureHeight);
4854
4855 lTextureWidth.Caption := IntToStr(TextureWidth);
4856 lTextureHeight.Caption := IntToStr(TextureHeight);
4857 end else
4858 begin
4859 lTextureWidth.Caption := MsgNotAccessible;
4860 lTextureHeight.Caption := MsgNotAccessible;
4861 end;
4862 end
4863 else
4864 begin
4865 lTextureWidth.Caption := '';
4866 lTextureHeight.Caption := '';
4867 end;
4868 end;
4869
4870 procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
4871 ARect: TRect; State: TOwnerDrawState);
4872 begin
4873 with Control as TListBox do
4874 begin
4875 if LCLType.odSelected in State then
4876 begin
4877 Canvas.Brush.Color := clHighlight;
4878 Canvas.Font.Color := clHighlightText;
4879 end else
4880 if (Items <> nil) and (Index >= 0) then
4881 if slInvalidTextures.IndexOf(Items[Index]) > -1 then
4882 begin
4883 Canvas.Brush.Color := clRed;
4884 Canvas.Font.Color := clWhite;
4885 end;
4886 Canvas.FillRect(ARect);
4887 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
4888 end;
4889 end;
4890
4891 procedure TMainForm.miMacMinimizeClick(Sender: TObject);
4892 begin
4893 self.WindowState := wsMinimized;
4894 self.FormWindowStateChange(Sender);
4895 end;
4896
4897 procedure TMainForm.miMacZoomClick(Sender: TObject);
4898 begin
4899 if self.WindowState = wsMaximized then
4900 self.WindowState := wsNormal
4901 else
4902 self.WindowState := wsMaximized;
4903 self.FormWindowStateChange(Sender);
4904 end;
4905
4906 procedure TMainForm.miReopenMapClick(Sender: TObject);
4907 var
4908 FileName, Resource: String;
4909 begin
4910 if OpenedMap = '' then
4911 Exit;
4912
4913 if Application.MessageBox(PChar(MsgMsgReopenMapPrompt),
4914 PChar(MsgMenuFileReopen), MB_ICONQUESTION or MB_YESNO) <> idYes then
4915 Exit;
4916
4917 g_ProcessResourceStr(OpenedMap, @FileName, nil, @Resource);
4918 OpenMap(FileName, Resource);
4919 end;
4920
4921 procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
4922 const KeyName: String; Values: TStrings);
4923 begin
4924 if vleObjectProperty.ItemProps[KeyName].EditStyle = esPickList then
4925 begin
4926 if KeyName = MsgPropDirection then
4927 begin
4928 Values.Add(DirNames[D_LEFT]);
4929 Values.Add(DirNames[D_RIGHT]);
4930 end
4931 else if KeyName = MsgPropTrTeleportDir then
4932 begin
4933 Values.Add(DirNamesAdv[0]);
4934 Values.Add(DirNamesAdv[1]);
4935 Values.Add(DirNamesAdv[2]);
4936 Values.Add(DirNamesAdv[3]);
4937 end
4938 else if KeyName = MsgPropTrMusicAct then
4939 begin
4940 Values.Add(MsgPropTrMusicOn);
4941 Values.Add(MsgPropTrMusicOff);
4942 end
4943 else if KeyName = MsgPropTrMonsterBehaviour then
4944 begin
4945 Values.Add(MsgPropTrMonsterBehaviour0);
4946 Values.Add(MsgPropTrMonsterBehaviour1);
4947 Values.Add(MsgPropTrMonsterBehaviour2);
4948 Values.Add(MsgPropTrMonsterBehaviour3);
4949 Values.Add(MsgPropTrMonsterBehaviour4);
4950 Values.Add(MsgPropTrMonsterBehaviour5);
4951 end
4952 else if KeyName = MsgPropTrScoreAct then
4953 begin
4954 Values.Add(MsgPropTrScoreAct0);
4955 Values.Add(MsgPropTrScoreAct1);
4956 Values.Add(MsgPropTrScoreAct2);
4957 Values.Add(MsgPropTrScoreAct3);
4958 end
4959 else if KeyName = MsgPropTrScoreTeam then
4960 begin
4961 Values.Add(MsgPropTrScoreTeam0);
4962 Values.Add(MsgPropTrScoreTeam1);
4963 Values.Add(MsgPropTrScoreTeam2);
4964 Values.Add(MsgPropTrScoreTeam3);
4965 end
4966 else if KeyName = MsgPropTrMessageKind then
4967 begin
4968 Values.Add(MsgPropTrMessageKind0);
4969 Values.Add(MsgPropTrMessageKind1);
4970 end
4971 else if KeyName = MsgPropTrMessageTo then
4972 begin
4973 Values.Add(MsgPropTrMessageTo0);
4974 Values.Add(MsgPropTrMessageTo1);
4975 Values.Add(MsgPropTrMessageTo2);
4976 Values.Add(MsgPropTrMessageTo3);
4977 Values.Add(MsgPropTrMessageTo4);
4978 Values.Add(MsgPropTrMessageTo5);
4979 end
4980 else if KeyName = MsgPropTrShotTo then
4981 begin
4982 Values.Add(MsgPropTrShotTo0);
4983 Values.Add(MsgPropTrShotTo1);
4984 Values.Add(MsgPropTrShotTo2);
4985 Values.Add(MsgPropTrShotTo3);
4986 Values.Add(MsgPropTrShotTo4);
4987 Values.Add(MsgPropTrShotTo5);
4988 Values.Add(MsgPropTrShotTo6);
4989 end
4990 else if KeyName = MsgPropTrShotAim then
4991 begin
4992 Values.Add(MsgPropTrShotAim0);
4993 Values.Add(MsgPropTrShotAim1);
4994 Values.Add(MsgPropTrShotAim2);
4995 Values.Add(MsgPropTrShotAim3);
4996 end
4997 else if KeyName = MsgPropTrDamageKind then
4998 begin
4999 Values.Add(MsgPropTrDamageKind0);
5000 Values.Add(MsgPropTrDamageKind3);
5001 Values.Add(MsgPropTrDamageKind4);
5002 Values.Add(MsgPropTrDamageKind5);
5003 Values.Add(MsgPropTrDamageKind6);
5004 Values.Add(MsgPropTrDamageKind7);
5005 Values.Add(MsgPropTrDamageKind8);
5006 end
5007 else if (KeyName = MsgPropPanelBlend) or
5008 (KeyName = MsgPropDmOnly) or
5009 (KeyName = MsgPropItemFalls) or
5010 (KeyName = MsgPropTrEnabled) or
5011 (KeyName = MsgPropTrD2d) or
5012 (KeyName = MsgPropTrSilent) or
5013 (KeyName = MsgPropTrTeleportSilent) or
5014 (KeyName = MsgPropTrExRandom) or
5015 (KeyName = MsgPropTrTextureOnce) or
5016 (KeyName = MsgPropTrTextureAnimOnce) or
5017 (KeyName = MsgPropTrSoundLocal) or
5018 (KeyName = MsgPropTrSoundSwitch) or
5019 (KeyName = MsgPropTrMonsterActive) or
5020 (KeyName = MsgPropTrPushReset) or
5021 (KeyName = MsgPropTrScoreCon) or
5022 (KeyName = MsgPropTrScoreMsg) or
5023 (KeyName = MsgPropTrHealthMax) or
5024 (KeyName = MsgPropTrShotSound) or
5025 (KeyName = MsgPropTrEffectCenter) then
5026 begin
5027 Values.Add(BoolNames[True]);
5028 Values.Add(BoolNames[False]);
5029 end;
5030 end;
5031 end;
5032
5033 procedure TMainForm.bApplyPropertyClick(Sender: TObject);
5034 var
5035 _id, a, r, c: Integer;
5036 s: String;
5037 res: Boolean;
5038 NoTextureID: DWORD;
5039 NW, NH: Word;
5040 begin
5041 NoTextureID := 0;
5042 NW := 0;
5043 NH := 0;
5044
5045 if SelectedObjectCount() <> 1 then
5046 Exit;
5047 if not SelectedObjects[GetFirstSelected()].Live then
5048 Exit;
5049
5050 try
5051 if not CheckProperty() then
5052 Exit;
5053 except
5054 Exit;
5055 end;
5056
5057 _id := GetFirstSelected();
5058
5059 r := vleObjectProperty.Row;
5060 c := vleObjectProperty.Col;
5061
5062 case SelectedObjects[_id].ObjectType of
5063 OBJECT_PANEL:
5064 begin
5065 with gPanels[SelectedObjects[_id].ID] do
5066 begin
5067 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5068 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5069 Width := StrToInt(Trim(vleObjectProperty.Values[MsgPropWidth]));
5070 Height := StrToInt(Trim(vleObjectProperty.Values[MsgPropHeight]));
5071
5072 PanelType := GetPanelType(vleObjectProperty.Values[MsgPropPanelType]);
5073
5074 // Сброс ссылки на триггеры смены текстуры:
5075 if not WordBool(PanelType and (PANEL_WALL or PANEL_FORE or PANEL_BACK)) then
5076 if gTriggers <> nil then
5077 for a := 0 to High(gTriggers) do
5078 begin
5079 if (gTriggers[a].TriggerType <> 0) and
5080 (gTriggers[a].TexturePanel = Integer(SelectedObjects[_id].ID)) then
5081 gTriggers[a].TexturePanel := -1;
5082 if (gTriggers[a].TriggerType = TRIGGER_SHOT) and
5083 (gTriggers[a].Data.ShotPanelID = Integer(SelectedObjects[_id].ID)) then
5084 gTriggers[a].Data.ShotPanelID := -1;
5085 end;
5086
5087 // Сброс ссылки на триггеры лифта:
5088 if not WordBool(PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT)) then
5089 if gTriggers <> nil then
5090 for a := 0 to High(gTriggers) do
5091 if (gTriggers[a].TriggerType in [TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT]) and
5092 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
5093 gTriggers[a].Data.PanelID := -1;
5094
5095 // Сброс ссылки на триггеры двери:
5096 if not WordBool(PanelType and (PANEL_OPENDOOR or PANEL_CLOSEDOOR)) then
5097 if gTriggers <> nil then
5098 for a := 0 to High(gTriggers) do
5099 if (gTriggers[a].TriggerType in [TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5100 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP]) and
5101 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
5102 gTriggers[a].Data.PanelID := -1;
5103
5104 if IsTexturedPanel(PanelType) then
5105 begin // Может быть текстура
5106 if TextureName <> '' then
5107 begin // Была текстура
5108 Alpha := StrToInt(Trim(vleObjectProperty.Values[MsgPropPanelAlpha]));
5109 Blending := NameToBool(vleObjectProperty.Values[MsgPropPanelBlend]);
5110 end
5111 else // Не было
5112 begin
5113 Alpha := 0;
5114 Blending := False;
5115 end;
5116
5117 // Новая текстура:
5118 TextureName := vleObjectProperty.Values[MsgPropPanelTex];
5119
5120 if TextureName <> '' then
5121 begin // Есть текстура
5122 // Обычная текстура:
5123 if not IsSpecialTexture(TextureName) then
5124 begin
5125 g_GetTextureSizeByName(TextureName,
5126 TextureWidth, TextureHeight);
5127
5128 // Проверка кратности размеров панели:
5129 res := True;
5130 if TextureWidth <> 0 then
5131 if gPanels[SelectedObjects[_id].ID].Width mod TextureWidth <> 0 then
5132 begin
5133 ErrorMessageBox(Format(MsgMsgWrongTexwidth,
5134 [TextureWidth]));
5135 Res := False;
5136 end;
5137 if Res and (TextureHeight <> 0) then
5138 if gPanels[SelectedObjects[_id].ID].Height mod TextureHeight <> 0 then
5139 begin
5140 ErrorMessageBox(Format(MsgMsgWrongTexheight,
5141 [TextureHeight]));
5142 Res := False;
5143 end;
5144
5145 if Res then
5146 begin
5147 if not g_GetTexture(TextureName, TextureID) then
5148 // Не удалось загрузить текстуру, рисуем NOTEXTURE
5149 if g_GetTexture('NOTEXTURE', NoTextureID) then
5150 begin
5151 TextureID := TEXTURE_SPECIAL_NOTEXTURE;
5152 g_GetTextureSizeByID(NoTextureID, NW, NH);
5153 TextureWidth := NW;
5154 TextureHeight := NH;
5155 end else
5156 begin
5157 TextureID := TEXTURE_SPECIAL_NONE;
5158 TextureWidth := 1;
5159 TextureHeight := 1;
5160 end;
5161 end
5162 else
5163 begin
5164 TextureName := '';
5165 TextureWidth := 1;
5166 TextureHeight := 1;
5167 TextureID := TEXTURE_SPECIAL_NONE;
5168 end;
5169 end
5170 else // Спец.текстура
5171 begin
5172 TextureHeight := 1;
5173 TextureWidth := 1;
5174 TextureID := SpecialTextureID(TextureName);
5175 end;
5176 end
5177 else // Нет текстуры
5178 begin
5179 TextureWidth := 1;
5180 TextureHeight := 1;
5181 TextureID := TEXTURE_SPECIAL_NONE;
5182 end;
5183 end
5184 else // Не может быть текстуры
5185 begin
5186 Alpha := 0;
5187 Blending := False;
5188 TextureName := '';
5189 TextureWidth := 1;
5190 TextureHeight := 1;
5191 TextureID := TEXTURE_SPECIAL_NONE;
5192 end;
5193 end;
5194 end;
5195
5196 OBJECT_ITEM:
5197 begin
5198 with gItems[SelectedObjects[_id].ID] do
5199 begin
5200 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5201 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5202 OnlyDM := NameToBool(vleObjectProperty.Values[MsgPropDmOnly]);
5203 Fall := NameToBool(vleObjectProperty.Values[MsgPropItemFalls]);
5204 end;
5205 end;
5206
5207 OBJECT_MONSTER:
5208 begin
5209 with gMonsters[SelectedObjects[_id].ID] do
5210 begin
5211 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5212 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5213 Direction := NameToDir(vleObjectProperty.Values[MsgPropDirection]);
5214 end;
5215 end;
5216
5217 OBJECT_AREA:
5218 begin
5219 with gAreas[SelectedObjects[_id].ID] do
5220 begin
5221 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5222 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5223 Direction := NameToDir(vleObjectProperty.Values[MsgPropDirection]);
5224 end;
5225 end;
5226
5227 OBJECT_TRIGGER:
5228 begin
5229 with gTriggers[SelectedObjects[_id].ID] do
5230 begin
5231 X := StrToInt(Trim(vleObjectProperty.Values[MsgPropX]));
5232 Y := StrToInt(Trim(vleObjectProperty.Values[MsgPropY]));
5233 Width := StrToInt(Trim(vleObjectProperty.Values[MsgPropWidth]));
5234 Height := StrToInt(Trim(vleObjectProperty.Values[MsgPropHeight]));
5235 Enabled := NameToBool(vleObjectProperty.Values[MsgPropTrEnabled]);
5236 ActivateType := StrToActivate(vleObjectProperty.Values[MsgPropTrActivation]);
5237 Key := StrToKey(vleObjectProperty.Values[MsgPropTrKeys]);
5238
5239 case TriggerType of
5240 TRIGGER_EXIT:
5241 begin
5242 s := utf2win(vleObjectProperty.Values[MsgPropTrNextMap]);
5243 FillByte(Data.MapName[0], 16, 0);
5244 if s <> '' then
5245 Move(s[1], Data.MapName[0], Min(Length(s), 16));
5246 end;
5247
5248 TRIGGER_TEXTURE:
5249 begin
5250 Data.ActivateOnce := NameToBool(vleObjectProperty.Values[MsgPropTrTextureOnce]);
5251 Data.AnimOnce := NameToBool(vleObjectProperty.Values[MsgPropTrTextureAnimOnce]);
5252 end;
5253
5254 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
5255 begin
5256 Data.Wait := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 65535);
5257 Data.Count := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrExCount], 0), 65535);
5258 if Data.Count < 1 then
5259 Data.Count := 1;
5260 if TriggerType = TRIGGER_PRESS then
5261 Data.ExtRandom := NameToBool(vleObjectProperty.Values[MsgPropTrExRandom]);
5262 end;
5263
5264 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR, TRIGGER_DOOR5,
5265 TRIGGER_CLOSETRAP, TRIGGER_TRAP, TRIGGER_LIFTUP, TRIGGER_LIFTDOWN,
5266 TRIGGER_LIFT:
5267 begin
5268 Data.NoSound := NameToBool(vleObjectProperty.Values[MsgPropTrSilent]);
5269 Data.d2d_doors := NameToBool(vleObjectProperty.Values[MsgPropTrD2d]);
5270 end;
5271
5272 TRIGGER_TELEPORT:
5273 begin
5274 Data.d2d_teleport := NameToBool(vleObjectProperty.Values[MsgPropTrD2d]);
5275 Data.silent_teleport := NameToBool(vleObjectProperty.Values[MsgPropTrTeleportSilent]);
5276 Data.TlpDir := NameToDirAdv(vleObjectProperty.Values[MsgPropTrTeleportDir]);
5277 end;
5278
5279 TRIGGER_SOUND:
5280 begin
5281 s := utf2win(vleObjectProperty.Values[MsgPropTrSoundName]);
5282 FillByte(Data.SoundName[0], 64, 0);
5283 if s <> '' then
5284 Move(s[1], Data.SoundName[0], Min(Length(s), 64));
5285
5286 Data.Volume := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundVolume], 0), 255);
5287 Data.Pan := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundPan], 0), 255);
5288 Data.PlayCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSoundCount], 0), 255);
5289 Data.Local := NameToBool(vleObjectProperty.Values[MsgPropTrSoundLocal]);
5290 Data.SoundSwitch := NameToBool(vleObjectProperty.Values[MsgPropTrSoundSwitch]);
5291 end;
5292
5293 TRIGGER_SPAWNMONSTER:
5294 begin
5295 Data.MonType := StrToMonster(vleObjectProperty.Values[MsgPropTrMonsterType]);
5296 Data.MonDir := Byte(NameToDir(vleObjectProperty.Values[MsgPropDirection]));
5297 Data.MonHealth := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrHealth], 0), 1000000);
5298 if Data.MonHealth < 0 then
5299 Data.MonHealth := 0;
5300 Data.MonActive := NameToBool(vleObjectProperty.Values[MsgPropTrMonsterActive]);
5301 Data.MonCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 64);
5302 if Data.MonCount < 1 then
5303 Data.MonCount := 1;
5304 Data.MonEffect := StrToEffect(vleObjectProperty.Values[MsgPropTrFxType]);
5305 Data.MonMax := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnMax], 0), 65535);
5306 Data.MonDelay := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnDelay], 0), 65535);
5307 Data.MonBehav := 0;
5308 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour1 then
5309 Data.MonBehav := 1;
5310 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour2 then
5311 Data.MonBehav := 2;
5312 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour3 then
5313 Data.MonBehav := 3;
5314 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour4 then
5315 Data.MonBehav := 4;
5316 if vleObjectProperty.Values[MsgPropTrMonsterBehaviour] = MsgPropTrMonsterBehaviour5 then
5317 Data.MonBehav := 5;
5318 end;
5319
5320 TRIGGER_SPAWNITEM:
5321 begin
5322 Data.ItemType := StrToItem(vleObjectProperty.Values[MsgPropTrItemType]);
5323 Data.ItemOnlyDM := NameToBool(vleObjectProperty.Values[MsgPropDmOnly]);
5324 Data.ItemFalls := NameToBool(vleObjectProperty.Values[MsgPropItemFalls]);
5325 Data.ItemCount := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 64);
5326 if Data.ItemCount < 1 then
5327 Data.ItemCount := 1;
5328 Data.ItemEffect := StrToEffect(vleObjectProperty.Values[MsgPropTrFxType]);
5329 Data.ItemMax := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnMax], 0), 65535);
5330 Data.ItemDelay := Min(StrToIntDef(vleObjectProperty.Values[MsgPropTrSpawnDelay], 0), 65535);
5331 end;
5332
5333 TRIGGER_MUSIC:
5334 begin
5335 s := utf2win(vleObjectProperty.Values[MsgPropTrMusicName]);
5336 FillByte(Data.MusicName[0], 64, 0);
5337 if s <> '' then
5338 Move(s[1], Data.MusicName[0], Min(Length(s), 64));
5339
5340 if vleObjectProperty.Values[MsgPropTrMusicAct] = MsgPropTrMusicOn then
5341 Data.MusicAction := 1
5342 else
5343 Data.MusicAction := 0;
5344 end;
5345
5346 TRIGGER_PUSH:
5347 begin
5348 Data.PushAngle := Min(
5349 StrToIntDef(vleObjectProperty.Values[MsgPropTrPushAngle], 0), 360);
5350 Data.PushForce := Min(
5351 StrToIntDef(vleObjectProperty.Values[MsgPropTrPushForce], 0), 255);
5352 Data.ResetVel := NameToBool(vleObjectProperty.Values[MsgPropTrPushReset]);
5353 end;
5354
5355 TRIGGER_SCORE:
5356 begin
5357 Data.ScoreAction := 0;
5358 if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct1 then
5359 Data.ScoreAction := 1
5360 else if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct2 then
5361 Data.ScoreAction := 2
5362 else if vleObjectProperty.Values[MsgPropTrScoreAct] = MsgPropTrScoreAct3 then
5363 Data.ScoreAction := 3;
5364 Data.ScoreCount := Min(Max(
5365 StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 0), 255);
5366 Data.ScoreTeam := 0;
5367 if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam1 then
5368 Data.ScoreTeam := 1
5369 else if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam2 then
5370 Data.ScoreTeam := 2
5371 else if vleObjectProperty.Values[MsgPropTrScoreTeam] = MsgPropTrScoreTeam3 then
5372 Data.ScoreTeam := 3;
5373 Data.ScoreCon := NameToBool(vleObjectProperty.Values[MsgPropTrScoreCon]);
5374 Data.ScoreMsg := NameToBool(vleObjectProperty.Values[MsgPropTrScoreMsg]);
5375 end;
5376
5377 TRIGGER_MESSAGE:
5378 begin
5379 Data.MessageKind := 0;
5380 if vleObjectProperty.Values[MsgPropTrMessageKind] = MsgPropTrMessageKind1 then
5381 Data.MessageKind := 1;
5382
5383 Data.MessageSendTo := 0;
5384 if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo1 then
5385 Data.MessageSendTo := 1
5386 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo2 then
5387 Data.MessageSendTo := 2
5388 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo3 then
5389 Data.MessageSendTo := 3
5390 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo4 then
5391 Data.MessageSendTo := 4
5392 else if vleObjectProperty.Values[MsgPropTrMessageTo] = MsgPropTrMessageTo5 then
5393 Data.MessageSendTo := 5;
5394
5395 s := utf2win(vleObjectProperty.Values[MsgPropTrMessageText]);
5396 FillByte(Data.MessageText[0], 100, 0);
5397 if s <> '' then
5398 Move(s[1], Data.MessageText[0], Min(Length(s), 100));
5399
5400 Data.MessageTime := Min(Max(
5401 StrToIntDef(vleObjectProperty.Values[MsgPropTrMessageTime], 0), 0), 65535);
5402 end;
5403
5404 TRIGGER_DAMAGE:
5405 begin
5406 Data.DamageValue := Min(Max(
5407 StrToIntDef(vleObjectProperty.Values[MsgPropTrDamageValue], 0), 0), 65535);
5408 Data.DamageInterval := Min(Max(
5409 StrToIntDef(vleObjectProperty.Values[MsgPropTrInterval], 0), 0), 65535);
5410 s := vleObjectProperty.Values[MsgPropTrDamageKind];
5411 if s = MsgPropTrDamageKind3 then
5412 Data.DamageKind := 3
5413 else if s = MsgPropTrDamageKind4 then
5414 Data.DamageKind := 4
5415 else if s = MsgPropTrDamageKind5 then
5416 Data.DamageKind := 5
5417 else if s = MsgPropTrDamageKind6 then
5418 Data.DamageKind := 6
5419 else if s = MsgPropTrDamageKind7 then
5420 Data.DamageKind := 7
5421 else if s = MsgPropTrDamageKind8 then
5422 Data.DamageKind := 8
5423 else
5424 Data.DamageKind := 0;
5425 end;
5426
5427 TRIGGER_HEALTH:
5428 begin
5429 Data.HealValue := Min(Max(
5430 StrToIntDef(vleObjectProperty.Values[MsgPropTrHealth], 0), 0), 65535);
5431 Data.HealInterval := Min(Max(
5432 StrToIntDef(vleObjectProperty.Values[MsgPropTrInterval], 0), 0), 65535);
5433 Data.HealMax := NameToBool(vleObjectProperty.Values[MsgPropTrHealthMax]);
5434 Data.HealSilent := NameToBool(vleObjectProperty.Values[MsgPropTrSilent]);
5435 end;
5436
5437 TRIGGER_SHOT:
5438 begin
5439 Data.ShotType := StrToShot(vleObjectProperty.Values[MsgPropTrShotType]);
5440 Data.ShotSound := NameToBool(vleObjectProperty.Values[MsgPropTrShotSound]);
5441 Data.ShotTarget := 0;
5442 if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo1 then
5443 Data.ShotTarget := 1
5444 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo2 then
5445 Data.ShotTarget := 2
5446 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo3 then
5447 Data.ShotTarget := 3
5448 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo4 then
5449 Data.ShotTarget := 4
5450 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo5 then
5451 Data.ShotTarget := 5
5452 else if vleObjectProperty.Values[MsgPropTrShotTo] = MsgPropTrShotTo6 then
5453 Data.ShotTarget := 6;
5454 Data.ShotIntSight := Min(Max(
5455 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotSight], 0), 0), 65535);
5456 Data.ShotAim := 0;
5457 if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim1 then
5458 Data.ShotAim := 1
5459 else if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim2 then
5460 Data.ShotAim := 2
5461 else if vleObjectProperty.Values[MsgPropTrShotAim] = MsgPropTrShotAim3 then
5462 Data.ShotAim := 3;
5463 Data.ShotAngle := Min(
5464 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAngle], 0), 360);
5465 Data.ShotWait := Min(Max(
5466 StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 0), 65535);
5467 Data.ShotAccuracy := Min(Max(
5468 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAcc], 0), 0), 65535);
5469 Data.ShotAmmo := Min(Max(
5470 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotAmmo], 0), 0), 65535);
5471 Data.ShotIntReload := Min(Max(
5472 StrToIntDef(vleObjectProperty.Values[MsgPropTrShotReload], 0), 0), 65535);
5473 end;
5474
5475 TRIGGER_EFFECT:
5476 begin
5477 Data.FXCount := Min(Max(
5478 StrToIntDef(vleObjectProperty.Values[MsgPropTrCount], 0), 0), 255);
5479 if vleObjectProperty.Values[MsgPropTrEffectType] = MsgPropTrEffectParticle then
5480 begin
5481 Data.FXType := TRIGGER_EFFECT_PARTICLE;
5482 Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
5483 if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectSliquid then
5484 Data.FXSubType := TRIGGER_EFFECT_SLIQUID
5485 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectLliquid then
5486 Data.FXSubType := TRIGGER_EFFECT_LLIQUID
5487 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectDliquid then
5488 Data.FXSubType := TRIGGER_EFFECT_DLIQUID
5489 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectBlood then
5490 Data.FXSubType := TRIGGER_EFFECT_BLOOD
5491 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectSpark then
5492 Data.FXSubType := TRIGGER_EFFECT_SPARK
5493 else if vleObjectProperty.Values[MsgPropTrEffectSubtype] = MsgPropTrEffectBubble then
5494 Data.FXSubType := TRIGGER_EFFECT_BUBBLE;
5495 end else
5496 begin
5497 Data.FXType := TRIGGER_EFFECT_ANIMATION;
5498 Data.FXSubType := StrToEffect(vleObjectProperty.Values[MsgPropTrEffectSubtype]);
5499 end;
5500 a := Min(Max(
5501 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectColor], 0), 0), $FFFFFF);
5502 Data.FXColorR := a and $FF;
5503 Data.FXColorG := (a shr 8) and $FF;
5504 Data.FXColorB := (a shr 16) and $FF;
5505 if NameToBool(vleObjectProperty.Values[MsgPropTrEffectCenter]) then
5506 Data.FXPos := 0
5507 else
5508 Data.FXPos := 1;
5509 Data.FXWait := Min(Max(
5510 StrToIntDef(vleObjectProperty.Values[MsgPropTrExDelay], 0), 0), 65535);
5511 Data.FXVelX := Min(Max(
5512 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectVelx], 0), -128), 127);
5513 Data.FXVelY := Min(Max(
5514 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectVely], 0), -128), 127);
5515 Data.FXSpreadL := Min(Max(
5516 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpl], 0), 0), 255);
5517 Data.FXSpreadR := Min(Max(
5518 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpr], 0), 0), 255);
5519 Data.FXSpreadU := Min(Max(
5520 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpu], 0), 0), 255);
5521 Data.FXSpreadD := Min(Max(
5522 StrToIntDef(vleObjectProperty.Values[MsgPropTrEffectSpd], 0), 0), 255);
5523 end;
5524 end;
5525 end;
5526 end;
5527 end;
5528
5529 FillProperty();
5530
5531 vleObjectProperty.Row := r;
5532 vleObjectProperty.Col := c;
5533 end;
5534
5535 procedure TMainForm.bbRemoveTextureClick(Sender: TObject);
5536 var
5537 a, i: Integer;
5538 begin
5539 i := lbTextureList.ItemIndex;
5540 if i = -1 then
5541 Exit;
5542
5543 if Application.MessageBox(PChar(Format(MsgMsgDelTexturePrompt,
5544 [SelectedTexture()])),
5545 PChar(MsgMsgDelTexture),
5546 MB_ICONQUESTION or MB_YESNO or
5547 MB_DEFBUTTON1) <> idYes then
5548 Exit;
5549
5550 if gPanels <> nil then
5551 for a := 0 to High(gPanels) do
5552 if (gPanels[a].PanelType <> 0) and
5553 (gPanels[a].TextureName = SelectedTexture()) then
5554 begin
5555 ErrorMessageBox(MsgMsgDelTextureCant);
5556 Exit;
5557 end;
5558
5559 g_DeleteTexture(SelectedTexture());
5560 i := slInvalidTextures.IndexOf(lbTextureList.Items[i]);
5561 if i > -1 then
5562 slInvalidTextures.Delete(i);
5563 if lbTextureList.ItemIndex > -1 then
5564 lbTextureList.Items.Delete(lbTextureList.ItemIndex)
5565 end;
5566
5567 procedure TMainForm.aNewMapExecute(Sender: TObject);
5568 begin
5569 if Application.MessageBox(PChar(MsgMsgClearMapPrompt), PChar(MsgMsgClearMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON1) = mrYes then
5570 FullClear();
5571 end;
5572
5573 procedure TMainForm.aUndoExecute(Sender: TObject);
5574 var
5575 a: Integer;
5576 begin
5577 if UndoBuffer = nil then
5578 Exit;
5579 if UndoBuffer[High(UndoBuffer)] = nil then
5580 Exit;
5581
5582 for a := 0 to High(UndoBuffer[High(UndoBuffer)]) do
5583 with UndoBuffer[High(UndoBuffer)][a] do
5584 begin
5585 case UndoType of
5586 UNDO_DELETE_PANEL:
5587 begin
5588 AddPanel(Panel^);
5589 Panel := nil;
5590 end;
5591 UNDO_DELETE_ITEM: AddItem(Item);
5592 UNDO_DELETE_AREA: AddArea(Area);
5593 UNDO_DELETE_MONSTER: AddMonster(Monster);
5594 UNDO_DELETE_TRIGGER: AddTrigger(Trigger);
5595 UNDO_ADD_PANEL: RemoveObject(AddID, OBJECT_PANEL);
5596 UNDO_ADD_ITEM: RemoveObject(AddID, OBJECT_ITEM);
5597 UNDO_ADD_AREA: RemoveObject(AddID, OBJECT_AREA);
5598 UNDO_ADD_MONSTER: RemoveObject(AddID, OBJECT_MONSTER);
5599 UNDO_ADD_TRIGGER: RemoveObject(AddID, OBJECT_TRIGGER);
5600 end;
5601 end;
5602
5603 SetLength(UndoBuffer, Length(UndoBuffer)-1);
5604
5605 RemoveSelectFromObjects();
5606
5607 miUndo.Enabled := UndoBuffer <> nil;
5608 end;
5609
5610
5611 procedure TMainForm.aCopyObjectExecute(Sender: TObject);
5612 var
5613 a, b: Integer;
5614 CopyBuffer: TCopyRecArray;
5615 str: String;
5616 ok: Boolean;
5617
5618 function CB_Compare(I1, I2: TCopyRec): Integer;
5619 begin
5620 Result := Integer(I1.ObjectType) - Integer(I2.ObjectType);
5621
5622 if Result = 0 then // Одного типа
5623 Result := Integer(I1.ID) - Integer(I2.ID);
5624 end;
5625
5626 procedure QuickSortCopyBuffer(L, R: Integer);
5627 var
5628 I, J: Integer;
5629 P, T: TCopyRec;
5630 begin
5631 repeat
5632 I := L;
5633 J := R;
5634 P := CopyBuffer[(L + R) shr 1];
5635
5636 repeat
5637 while CB_Compare(CopyBuffer[I], P) < 0 do
5638 Inc(I);
5639 while CB_Compare(CopyBuffer[J], P) > 0 do
5640 Dec(J);
5641
5642 if I <= J then
5643 begin
5644 T := CopyBuffer[I];
5645 CopyBuffer[I] := CopyBuffer[J];
5646 CopyBuffer[J] := T;
5647 Inc(I);
5648 Dec(J);
5649 end;
5650 until I > J;
5651
5652 if L < J then
5653 QuickSortCopyBuffer(L, J);
5654
5655 L := I;
5656 until I >= R;
5657 end;
5658
5659 begin
5660 if SelectedObjects = nil then
5661 Exit;
5662
5663 b := -1;
5664 CopyBuffer := nil;
5665
5666 // Копируем объекты:
5667 for a := 0 to High(SelectedObjects) do
5668 if SelectedObjects[a].Live then
5669 with SelectedObjects[a] do
5670 begin
5671 SetLength(CopyBuffer, Length(CopyBuffer)+1);
5672 b := High(CopyBuffer);
5673 CopyBuffer[b].ID := ID;
5674 CopyBuffer[b].Panel := nil;
5675
5676 case ObjectType of
5677 OBJECT_PANEL:
5678 begin
5679 CopyBuffer[b].ObjectType := OBJECT_PANEL;
5680 New(CopyBuffer[b].Panel);
5681 CopyBuffer[b].Panel^ := gPanels[ID];
5682 end;
5683
5684 OBJECT_ITEM:
5685 begin
5686 CopyBuffer[b].ObjectType := OBJECT_ITEM;
5687 CopyBuffer[b].Item := gItems[ID];
5688 end;
5689
5690 OBJECT_MONSTER:
5691 begin
5692 CopyBuffer[b].ObjectType := OBJECT_MONSTER;
5693 CopyBuffer[b].Monster := gMonsters[ID];
5694 end;
5695
5696 OBJECT_AREA:
5697 begin
5698 CopyBuffer[b].ObjectType := OBJECT_AREA;
5699 CopyBuffer[b].Area := gAreas[ID];
5700 end;
5701
5702 OBJECT_TRIGGER:
5703 begin
5704 CopyBuffer[b].ObjectType := OBJECT_TRIGGER;
5705 CopyBuffer[b].Trigger := gTriggers[ID];
5706 end;
5707 end;
5708 end;
5709
5710 // Сортировка по ID:
5711 if CopyBuffer <> nil then
5712 begin
5713 QuickSortCopyBuffer(0, b);
5714 end;
5715
5716 // Постановка ссылок триггеров:
5717 for a := 0 to Length(CopyBuffer)-1 do
5718 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
5719 begin
5720 case CopyBuffer[a].Trigger.TriggerType of
5721 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5722 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
5723 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
5724 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
5725 begin
5726 ok := False;
5727
5728 for b := 0 to Length(CopyBuffer)-1 do
5729 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5730 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.PanelID) then
5731 begin
5732 CopyBuffer[a].Trigger.Data.PanelID := b;
5733 ok := True;
5734 Break;
5735 end;
5736
5737 // Этих панелей нет среди копируемых:
5738 if not ok then
5739 CopyBuffer[a].Trigger.Data.PanelID := -1;
5740 end;
5741
5742 TRIGGER_PRESS, TRIGGER_ON,
5743 TRIGGER_OFF, TRIGGER_ONOFF:
5744 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
5745 begin
5746 ok := False;
5747
5748 for b := 0 to Length(CopyBuffer)-1 do
5749 if (CopyBuffer[b].ObjectType = OBJECT_MONSTER) and
5750 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.MonsterID-1) then
5751 begin
5752 CopyBuffer[a].Trigger.Data.MonsterID := b+1;
5753 ok := True;
5754 Break;
5755 end;
5756
5757 // Этих монстров нет среди копируемых:
5758 if not ok then
5759 CopyBuffer[a].Trigger.Data.MonsterID := 0;
5760 end;
5761
5762 TRIGGER_SHOT:
5763 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
5764 begin
5765 ok := False;
5766
5767 for b := 0 to Length(CopyBuffer)-1 do
5768 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5769 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.ShotPanelID) then
5770 begin
5771 CopyBuffer[a].Trigger.Data.ShotPanelID := b;
5772 ok := True;
5773 Break;
5774 end;
5775
5776 // Этих панелей нет среди копируемых:
5777 if not ok then
5778 CopyBuffer[a].Trigger.Data.ShotPanelID := -1;
5779 end;
5780 end;
5781
5782 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
5783 begin
5784 ok := False;
5785
5786 for b := 0 to Length(CopyBuffer)-1 do
5787 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5788 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.TexturePanel) then
5789 begin
5790 CopyBuffer[a].Trigger.TexturePanel := b;
5791 ok := True;
5792 Break;
5793 end;
5794
5795 // Этих панелей нет среди копируемых:
5796 if not ok then
5797 CopyBuffer[a].Trigger.TexturePanel := -1;
5798 end;
5799 end;
5800
5801 // В буфер обмена:
5802 str := CopyBufferToString(CopyBuffer);
5803 ClipBoard.AsText := str;
5804
5805 for a := 0 to Length(CopyBuffer)-1 do
5806 if (CopyBuffer[a].ObjectType = OBJECT_PANEL) and
5807 (CopyBuffer[a].Panel <> nil) then
5808 Dispose(CopyBuffer[a].Panel);
5809
5810 CopyBuffer := nil;
5811 end;
5812
5813 procedure TMainForm.aPasteObjectExecute(Sender: TObject);
5814 var
5815 a, h: Integer;
5816 CopyBuffer: TCopyRecArray;
5817 res, rel: Boolean;
5818 swad, ssec, sres: String;
5819 NoTextureID: DWORD;
5820 pmin: TPoint;
5821 xadj, yadj: LongInt;
5822 begin
5823 CopyBuffer := nil;
5824 NoTextureID := 0;
5825
5826 pmin.X := High(pmin.X);
5827 pmin.Y := High(pmin.Y);
5828
5829 StringToCopyBuffer(ClipBoard.AsText, CopyBuffer, pmin);
5830 if CopyBuffer = nil then
5831 Exit;
5832
5833 rel := not(ssShift in GetKeyShiftState());
5834 h := High(CopyBuffer);
5835 RemoveSelectFromObjects();
5836
5837 if g_CollidePoint(
5838 pmin.X, pmin.Y, -MapOffset.X-32, -MapOffset.Y-32, RenderPanel.Width, RenderPanel.Height) then
5839 begin
5840 xadj := DotStep;
5841 yadj := DotStep;
5842 end
5843 else
5844 begin
5845 xadj := Floor((-pmin.X - MapOffset.X + 32) / DotStep) * DotStep;
5846 yadj := Floor((-pmin.Y - MapOffset.Y + 32) / DotStep) * DotStep;
5847 end;
5848
5849 for a := 0 to h do
5850 with CopyBuffer[a] do
5851 begin
5852 case ObjectType of
5853 OBJECT_PANEL:
5854 if Panel <> nil then
5855 begin
5856 if rel then
5857 begin
5858 Panel^.X += xadj;
5859 Panel^.Y += yadj;
5860 end;
5861
5862 Panel^.TextureID := TEXTURE_SPECIAL_NONE;
5863 Panel^.TextureWidth := 1;
5864 Panel^.TextureHeight := 1;
5865
5866 if (Panel^.PanelType = PANEL_LIFTUP) or
5867 (Panel^.PanelType = PANEL_LIFTDOWN) or
5868 (Panel^.PanelType = PANEL_LIFTLEFT) or
5869 (Panel^.PanelType = PANEL_LIFTRIGHT) or
5870 (Panel^.PanelType = PANEL_BLOCKMON) or
5871 (Panel^.TextureName = '') then
5872 begin // Нет или не может быть текстуры:
5873 end
5874 else // Есть текстура:
5875 begin
5876 // Обычная текстура:
5877 if not IsSpecialTexture(Panel^.TextureName) then
5878 begin
5879 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5880
5881 if not res then
5882 begin
5883 g_ProcessResourceStr(Panel^.TextureName, swad, ssec, sres);
5884 AddTexture(swad, ssec, sres, True);
5885 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5886 end;
5887
5888 if res then
5889 g_GetTextureSizeByName(Panel^.TextureName,
5890 Panel^.TextureWidth, Panel^.TextureHeight)
5891 else
5892 if g_GetTexture('NOTEXTURE', NoTextureID) then
5893 begin
5894 Panel^.TextureID := TEXTURE_SPECIAL_NOTEXTURE;
5895 g_GetTextureSizeByID(NoTextureID, Panel^.TextureWidth, Panel^.TextureHeight);
5896 end;
5897 end
5898 else // Спец.текстура:
5899 begin
5900 Panel^.TextureID := SpecialTextureID(Panel^.TextureName);
5901 with MainForm.lbTextureList.Items do
5902 if IndexOf(Panel^.TextureName) = -1 then
5903 Add(Panel^.TextureName);
5904 end;
5905 end;
5906
5907 ID := AddPanel(Panel^);
5908 Dispose(Panel);
5909 Undo_Add(OBJECT_PANEL, ID, a > 0);
5910 SelectObject(OBJECT_PANEL, ID, True);
5911 end;
5912
5913 OBJECT_ITEM:
5914 begin
5915 if rel then
5916 begin
5917 Item.X += xadj;
5918 Item.Y += yadj;
5919 end;
5920
5921 ID := AddItem(Item);
5922 Undo_Add(OBJECT_ITEM, ID, a > 0);
5923 SelectObject(OBJECT_ITEM, ID, True);
5924 end;
5925
5926 OBJECT_MONSTER:
5927 begin
5928 if rel then
5929 begin
5930 Monster.X += xadj;
5931 Monster.Y += yadj;
5932 end;
5933
5934 ID := AddMonster(Monster);
5935 Undo_Add(OBJECT_MONSTER, ID, a > 0);
5936 SelectObject(OBJECT_MONSTER, ID, True);
5937 end;
5938
5939 OBJECT_AREA:
5940 begin
5941 if rel then
5942 begin
5943 Area.X += xadj;
5944 Area.Y += yadj;
5945 end;
5946
5947 ID := AddArea(Area);
5948 Undo_Add(OBJECT_AREA, ID, a > 0);
5949 SelectObject(OBJECT_AREA, ID, True);
5950 end;
5951
5952 OBJECT_TRIGGER:
5953 begin
5954 if rel then
5955 with Trigger do
5956 begin
5957 X += xadj;
5958 Y += yadj;
5959
5960 case TriggerType of
5961 TRIGGER_TELEPORT:
5962 begin
5963 Data.TargetPoint.X += xadj;
5964 Data.TargetPoint.Y += yadj;
5965 end;
5966 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
5967 begin
5968 Data.tX += xadj;
5969 Data.tY += yadj;
5970 end;
5971 TRIGGER_SPAWNMONSTER:
5972 begin
5973 Data.MonPos.X += xadj;
5974 Data.MonPos.Y += yadj;
5975 end;
5976 TRIGGER_SPAWNITEM:
5977 begin
5978 Data.ItemPos.X += xadj;
5979 Data.ItemPos.Y += yadj;
5980 end;
5981 TRIGGER_SHOT:
5982 begin
5983 Data.ShotPos.X += xadj;
5984 Data.ShotPos.Y += yadj;
5985 end;
5986 end;
5987 end;
5988
5989 ID := AddTrigger(Trigger);
5990 Undo_Add(OBJECT_TRIGGER, ID, a > 0);
5991 SelectObject(OBJECT_TRIGGER, ID, True);
5992 end;
5993 end;
5994 end;
5995
5996 // Переставляем ссылки триггеров:
5997 for a := 0 to High(CopyBuffer) do
5998 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
5999 begin
6000 case CopyBuffer[a].Trigger.TriggerType of
6001 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6002 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6003 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6004 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
6005 gTriggers[CopyBuffer[a].ID].Data.PanelID :=
6006 CopyBuffer[CopyBuffer[a].Trigger.Data.PanelID].ID;
6007
6008 TRIGGER_PRESS, TRIGGER_ON,
6009 TRIGGER_OFF, TRIGGER_ONOFF:
6010 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
6011 gTriggers[CopyBuffer[a].ID].Data.MonsterID :=
6012 CopyBuffer[CopyBuffer[a].Trigger.Data.MonsterID-1].ID+1;
6013
6014 TRIGGER_SHOT:
6015 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
6016 gTriggers[CopyBuffer[a].ID].Data.ShotPanelID :=
6017 CopyBuffer[CopyBuffer[a].Trigger.Data.ShotPanelID].ID;
6018 end;
6019
6020 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
6021 gTriggers[CopyBuffer[a].ID].TexturePanel :=
6022 CopyBuffer[CopyBuffer[a].Trigger.TexturePanel].ID;
6023 end;
6024
6025 CopyBuffer := nil;
6026
6027 if h = 0 then
6028 FillProperty();
6029 end;
6030
6031 procedure TMainForm.aCutObjectExecute(Sender: TObject);
6032 begin
6033 miCopy.Click();
6034 DeleteSelectedObjects();
6035 end;
6036
6037 procedure TMainForm.vleObjectPropertyEditButtonClick(Sender: TObject);
6038 var
6039 Key, FileName: String;
6040 b: Byte;
6041 begin
6042 Key := vleObjectProperty.Keys[vleObjectProperty.Row];
6043
6044 if Key = MsgPropPanelType then
6045 begin
6046 with ChooseTypeForm, vleObjectProperty do
6047 begin // Выбор типа панели:
6048 Caption := MsgPropPanelType;
6049 lbTypeSelect.Items.Clear();
6050
6051 for b := 0 to High(PANELNAMES) do
6052 begin
6053 lbTypeSelect.Items.Add(PANELNAMES[b]);
6054 if Values[Key] = PANELNAMES[b] then
6055 lbTypeSelect.ItemIndex := b;
6056 end;
6057
6058 if ShowModal() = mrOK then
6059 begin
6060 b := lbTypeSelect.ItemIndex;
6061 Values[Key] := PANELNAMES[b];
6062 vleObjectPropertyApply(Sender);
6063 end;
6064 end
6065 end
6066 else if Key = MsgPropTrTeleportTo then
6067 SelectFlag := SELECTFLAG_TELEPORT
6068 else if Key = MsgPropTrSpawnTo then
6069 SelectFlag := SELECTFLAG_SPAWNPOINT
6070 else if (Key = MsgPropTrDoorPanel) or
6071 (Key = MsgPropTrTrapPanel) then
6072 SelectFlag := SELECTFLAG_DOOR
6073 else if Key = MsgPropTrTexturePanel then
6074 begin
6075 DrawPressRect := False;
6076 SelectFlag := SELECTFLAG_TEXTURE;
6077 end
6078 else if Key = MsgPropTrShotPanel then
6079 SelectFlag := SELECTFLAG_SHOTPANEL
6080 else if Key = MsgPropTrLiftPanel then
6081 SelectFlag := SELECTFLAG_LIFT
6082 else if key = MsgPropTrExMonster then
6083 SelectFlag := SELECTFLAG_MONSTER
6084 else if Key = MsgPropTrExArea then
6085 begin
6086 SelectFlag := SELECTFLAG_NONE;
6087 DrawPressRect := True;
6088 end
6089 else if Key = MsgPropTrNextMap then
6090 begin // Выбор следующей карты:
6091 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
6092 SelectMapForm.Caption := MsgCapSelect;
6093 SelectMapForm.GetMaps(FileName);
6094
6095 if SelectMapForm.ShowModal() = mrOK then
6096 begin
6097 vleObjectProperty.Values[Key] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
6098 vleObjectPropertyApply(Sender);
6099 end;
6100 end
6101 else if (Key = MsgPropTrSoundName) or
6102 (Key = MsgPropTrMusicName) then
6103 begin // Выбор файла звука/музыки:
6104 AddSoundForm.OKFunction := nil;
6105 AddSoundForm.lbResourcesList.MultiSelect := False;
6106 AddSoundForm.SetResource := vleObjectProperty.Values[Key];
6107
6108 if (AddSoundForm.ShowModal() = mrOk) then
6109 begin
6110 vleObjectProperty.Values[Key] := AddSoundForm.ResourceName;
6111 vleObjectPropertyApply(Sender);
6112 end;
6113 end
6114 else if Key = MsgPropTrActivation then
6115 with ActivationTypeForm, vleObjectProperty do
6116 begin // Выбор типов активации:
6117 cbPlayerCollide.Checked := Pos('PC', Values[Key]) > 0;
6118 cbMonsterCollide.Checked := Pos('MC', Values[Key]) > 0;
6119 cbPlayerPress.Checked := Pos('PP', Values[Key]) > 0;
6120 cbMonsterPress.Checked := Pos('MP', Values[Key]) > 0;
6121 cbShot.Checked := Pos('SH', Values[Key]) > 0;
6122 cbNoMonster.Checked := Pos('NM', Values[Key]) > 0;
6123
6124 if ShowModal() = mrOK then
6125 begin
6126 b := 0;
6127 if cbPlayerCollide.Checked then
6128 b := ACTIVATE_PLAYERCOLLIDE;
6129 if cbMonsterCollide.Checked then
6130 b := b or ACTIVATE_MONSTERCOLLIDE;
6131 if cbPlayerPress.Checked then
6132 b := b or ACTIVATE_PLAYERPRESS;
6133 if cbMonsterPress.Checked then
6134 b := b or ACTIVATE_MONSTERPRESS;
6135 if cbShot.Checked then
6136 b := b or ACTIVATE_SHOT;
6137 if cbNoMonster.Checked then
6138 b := b or ACTIVATE_NOMONSTER;
6139
6140 Values[Key] := ActivateToStr(b);
6141 vleObjectPropertyApply(Sender);
6142 end;
6143 end
6144 else if Key = MsgPropTrKeys then
6145 with KeysForm, vleObjectProperty do
6146 begin // Выбор необходимых ключей:
6147 cbRedKey.Checked := Pos('RK', Values[Key]) > 0;
6148 cbGreenKey.Checked := Pos('GK', Values[Key]) > 0;
6149 cbBlueKey.Checked := Pos('BK', Values[Key]) > 0;
6150 cbRedTeam.Checked := Pos('RT', Values[Key]) > 0;
6151 cbBlueTeam.Checked := Pos('BT', Values[Key]) > 0;
6152
6153 if ShowModal() = mrOK then
6154 begin
6155 b := 0;
6156 if cbRedKey.Checked then
6157 b := KEY_RED;
6158 if cbGreenKey.Checked then
6159 b := b or KEY_GREEN;
6160 if cbBlueKey.Checked then
6161 b := b or KEY_BLUE;
6162 if cbRedTeam.Checked then
6163 b := b or KEY_REDTEAM;
6164 if cbBlueTeam.Checked then
6165 b := b or KEY_BLUETEAM;
6166
6167 Values[Key] := KeyToStr(b);
6168 vleObjectPropertyApply(Sender);
6169 end;
6170 end
6171 else if Key = MsgPropTrFxType then
6172 with ChooseTypeForm, vleObjectProperty do
6173 begin // Выбор типа эффекта:
6174 Caption := MsgCapFxType;
6175 lbTypeSelect.Items.Clear();
6176
6177 for b := EFFECT_NONE to EFFECT_FIRE do
6178 lbTypeSelect.Items.Add(EffectToStr(b));
6179
6180 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]);
6181
6182 if ShowModal() = mrOK then
6183 begin
6184 b := lbTypeSelect.ItemIndex;
6185 Values[Key] := EffectToStr(b);
6186 vleObjectPropertyApply(Sender);
6187 end;
6188 end
6189 else if Key = MsgPropTrMonsterType then
6190 with ChooseTypeForm, vleObjectProperty do
6191 begin // Выбор типа монстра:
6192 Caption := MsgCapMonsterType;
6193 lbTypeSelect.Items.Clear();
6194
6195 for b := MONSTER_DEMON to MONSTER_MAN do
6196 lbTypeSelect.Items.Add(MonsterToStr(b));
6197
6198 lbTypeSelect.ItemIndex := StrToMonster(Values[Key]) - MONSTER_DEMON;
6199
6200 if ShowModal() = mrOK then
6201 begin
6202 b := lbTypeSelect.ItemIndex + MONSTER_DEMON;
6203 Values[Key] := MonsterToStr(b);
6204 vleObjectPropertyApply(Sender);
6205 end;
6206 end
6207 else if Key = MsgPropTrItemType then
6208 with ChooseTypeForm, vleObjectProperty do
6209 begin // Выбор типа предмета:
6210 Caption := MsgCapItemType;
6211 lbTypeSelect.Items.Clear();
6212
6213 for b := ITEM_MEDKIT_SMALL to ITEM_KEY_BLUE do
6214 lbTypeSelect.Items.Add(ItemToStr(b));
6215 lbTypeSelect.Items.Add(ItemToStr(ITEM_BOTTLE));
6216 lbTypeSelect.Items.Add(ItemToStr(ITEM_HELMET));
6217 lbTypeSelect.Items.Add(ItemToStr(ITEM_JETPACK));
6218 lbTypeSelect.Items.Add(ItemToStr(ITEM_INVIS));
6219 lbTypeSelect.Items.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER));
6220 lbTypeSelect.Items.Add(ItemToStr(ITEM_AMMO_FUELCAN));
6221
6222 b := StrToItem(Values[Key]);
6223 if b >= ITEM_BOTTLE then
6224 b := b - 2;
6225 lbTypeSelect.ItemIndex := b - ITEM_MEDKIT_SMALL;
6226
6227 if ShowModal() = mrOK then
6228 begin
6229 b := lbTypeSelect.ItemIndex + ITEM_MEDKIT_SMALL;
6230 if b >= ITEM_WEAPON_KASTET then
6231 b := b + 2;
6232 Values[Key] := ItemToStr(b);
6233 vleObjectPropertyApply(Sender);
6234 end;
6235 end
6236 else if Key = MsgPropTrShotType then
6237 with ChooseTypeForm, vleObjectProperty do
6238 begin // Выбор типа предмета:
6239 Caption := MsgPropTrShotType;
6240 lbTypeSelect.Items.Clear();
6241
6242 for b := TRIGGER_SHOT_PISTOL to TRIGGER_SHOT_MAX do
6243 lbTypeSelect.Items.Add(ShotToStr(b));
6244
6245 lbTypeSelect.ItemIndex := StrToShot(Values[Key]);
6246
6247 if ShowModal() = mrOK then
6248 begin
6249 b := lbTypeSelect.ItemIndex;
6250 Values[Key] := ShotToStr(b);
6251 vleObjectPropertyApply(Sender);
6252 end;
6253 end
6254 else if Key = MsgPropTrEffectType then
6255 with ChooseTypeForm, vleObjectProperty do
6256 begin // Выбор типа эффекта:
6257 Caption := MsgCapFxType;
6258 lbTypeSelect.Items.Clear();
6259
6260 lbTypeSelect.Items.Add(MsgPropTrEffectParticle);
6261 lbTypeSelect.Items.Add(MsgPropTrEffectAnimation);
6262 if Values[Key] = MsgPropTrEffectAnimation then
6263 lbTypeSelect.ItemIndex := 1
6264 else
6265 lbTypeSelect.ItemIndex := 0;
6266
6267 if ShowModal() = mrOK then
6268 begin
6269 b := lbTypeSelect.ItemIndex;
6270 if b = 0 then
6271 Values[Key] := MsgPropTrEffectParticle
6272 else
6273 Values[Key] := MsgPropTrEffectAnimation;
6274 vleObjectPropertyApply(Sender);
6275 end;
6276 end
6277 else if Key = MsgPropTrEffectSubtype then
6278 with ChooseTypeForm, vleObjectProperty do
6279 begin // Выбор подтипа эффекта:
6280 Caption := MsgCapFxType;
6281 lbTypeSelect.Items.Clear();
6282
6283 if Values[MsgPropTrEffectType] = MsgPropTrEffectAnimation then
6284 begin
6285 for b := EFFECT_TELEPORT to EFFECT_FIRE do
6286 lbTypeSelect.Items.Add(EffectToStr(b));
6287
6288 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]) - 1;
6289 end else
6290 begin
6291 lbTypeSelect.Items.Add(MsgPropTrEffectSliquid);
6292 lbTypeSelect.Items.Add(MsgPropTrEffectLliquid);
6293 lbTypeSelect.Items.Add(MsgPropTrEffectDliquid);
6294 lbTypeSelect.Items.Add(MsgPropTrEffectBlood);
6295 lbTypeSelect.Items.Add(MsgPropTrEffectSpark);
6296 lbTypeSelect.Items.Add(MsgPropTrEffectBubble);
6297 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SLIQUID;
6298 if Values[Key] = MsgPropTrEffectLliquid then
6299 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_LLIQUID;
6300 if Values[Key] = MsgPropTrEffectDliquid then
6301 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_DLIQUID;
6302 if Values[Key] = MsgPropTrEffectBlood then
6303 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BLOOD;
6304 if Values[Key] = MsgPropTrEffectSpark then
6305 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SPARK;
6306 if Values[Key] = MsgPropTrEffectBubble then
6307 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BUBBLE;
6308 end;
6309
6310 if ShowModal() = mrOK then
6311 begin
6312 b := lbTypeSelect.ItemIndex;
6313
6314 if Values[MsgPropTrEffectType] = MsgPropTrEffectAnimation then
6315 Values[Key] := EffectToStr(b + 1)
6316 else begin
6317 Values[Key] := MsgPropTrEffectSliquid;
6318 if b = TRIGGER_EFFECT_LLIQUID then
6319 Values[Key] := MsgPropTrEffectLliquid;
6320 if b = TRIGGER_EFFECT_DLIQUID then
6321 Values[Key] := MsgPropTrEffectDliquid;
6322 if b = TRIGGER_EFFECT_BLOOD then
6323 Values[Key] := MsgPropTrEffectBlood;
6324 if b = TRIGGER_EFFECT_SPARK then
6325 Values[Key] := MsgPropTrEffectSpark;
6326 if b = TRIGGER_EFFECT_BUBBLE then
6327 Values[Key] := MsgPropTrEffectBubble;
6328 end;
6329
6330 vleObjectPropertyApply(Sender);
6331 end;
6332 end
6333 else if Key = MsgPropTrEffectColor then
6334 with vleObjectProperty do
6335 begin // Выбор цвета эффекта:
6336 ColorDialog.Color := StrToIntDef(Values[Key], 0);
6337 if ColorDialog.Execute then
6338 begin
6339 Values[Key] := IntToStr(ColorDialog.Color);
6340 vleObjectPropertyApply(Sender);
6341 end;
6342 end
6343 else if Key = MsgPropPanelTex then
6344 begin // Смена текстуры:
6345 vleObjectProperty.Values[Key] := SelectedTexture();
6346 vleObjectPropertyApply(Sender);
6347 end;
6348 end;
6349
6350 procedure TMainForm.vleObjectPropertyApply(Sender: TObject);
6351 begin
6352 // hack to prevent empty ID in list
6353 RenderPanel.SetFocus();
6354 bApplyProperty.Click();
6355 vleObjectProperty.SetFocus();
6356 end;
6357
6358 procedure TMainForm.aSaveMapExecute(Sender: TObject);
6359 var
6360 FileName, Section, Res: String;
6361 begin
6362 if OpenedMap = '' then
6363 begin
6364 aSaveMapAsExecute(nil);
6365 Exit;
6366 end;
6367
6368 g_ProcessResourceStr(OpenedMap, FileName, Section, Res);
6369
6370 SaveMap(FileName+':\'+Res, '');
6371 end;
6372
6373 procedure TMainForm.aOpenMapExecute(Sender: TObject);
6374 begin
6375 OpenDialog.Filter := MsgFileFilterAll;
6376
6377 if OpenDialog.Execute() then
6378 begin
6379 OpenMapFile(OpenDialog.FileName);
6380 OpenDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
6381 end;
6382 end;
6383
6384 procedure TMainForm.OpenMapFile(FileName: String);
6385 begin
6386 if (Pos('.ini', LowerCase(ExtractFileName(FileName))) > 0) then
6387 begin // INI карты:
6388 FullClear();
6389
6390 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
6391 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
6392 pLoadProgress.Show();
6393
6394 OpenedMap := '';
6395 OpenedWAD := '';
6396
6397 LoadMapOld(FileName);
6398
6399 MainForm.Caption := Format('%s - %s', [FormCaption, ExtractFileName(FileName)]);
6400
6401 pLoadProgress.Hide();
6402 MainForm.FormResize(Self);
6403 end
6404 else // Карты из WAD:
6405 begin
6406 OpenMap(FileName, '');
6407 end;
6408 end;
6409
6410 procedure TMainForm.FormActivate(Sender: TObject);
6411 begin
6412 MainForm.ActiveControl := RenderPanel;
6413 end;
6414
6415 procedure TMainForm.aDeleteMap(Sender: TObject);
6416 var
6417 WAD: TWADEditor_1;
6418 MapList: SArray;
6419 MapName: Char16;
6420 a: Integer;
6421 str: String;
6422 begin
6423 OpenDialog.Filter := MsgFileFilterWad;
6424
6425 if not OpenDialog.Execute() then
6426 Exit;
6427
6428 WAD := TWADEditor_1.Create();
6429
6430 if not WAD.ReadFile(OpenDialog.FileName) then
6431 begin
6432 WAD.Free();
6433 Exit;
6434 end;
6435
6436 WAD.CreateImage();
6437
6438 MapList := WAD.GetResourcesList('');
6439
6440 SelectMapForm.Caption := MsgCapRemove;
6441 SelectMapForm.lbMapList.Items.Clear();
6442
6443 if MapList <> nil then
6444 for a := 0 to High(MapList) do
6445 SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a]));
6446
6447 if (SelectMapForm.ShowModal() = mrOK) then
6448 begin
6449 str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
6450 MapName := '';
6451 Move(str[1], MapName[0], Min(16, Length(str)));
6452
6453 if Application.MessageBox(PChar(Format(MsgMsgDeleteMapPrompt, [MapName, OpenDialog.FileName])), PChar(MsgMsgDeleteMap), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
6454 Exit;
6455
6456 WAD.RemoveResource('', utf2win(MapName));
6457
6458 Application.MessageBox(
6459 PChar(Format(MsgMsgMapDeletedPrompt, [MapName])),
6460 PChar(MsgMsgMapDeleted),
6461 MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1
6462 );
6463
6464 WAD.SaveTo(OpenDialog.FileName);
6465
6466 // Удалили текущую карту - сохранять по старому ее нельзя:
6467 if OpenedMap = (OpenDialog.FileName+':\'+MapName) then
6468 begin
6469 OpenedMap := '';
6470 OpenedWAD := '';
6471 MainForm.Caption := FormCaption;
6472 end;
6473 end;
6474
6475 WAD.Free();
6476 end;
6477
6478 procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject;
6479 var Key: Word; Shift: TShiftState);
6480 begin
6481 if Key = VK_RETURN then
6482 vleObjectPropertyApply(Sender);
6483 end;
6484
6485 procedure MovePanel(var ID: DWORD; MoveType: Byte);
6486 var
6487 _id, a: Integer;
6488 tmp: TPanel;
6489 begin
6490 if (ID = 0) and (MoveType = 0) then
6491 Exit;
6492 if (ID = DWORD(High(gPanels))) and (MoveType <> 0) then
6493 Exit;
6494 if (ID > DWORD(High(gPanels))) then
6495 Exit;
6496
6497 _id := Integer(ID);
6498
6499 if MoveType = 0 then // to Back
6500 begin
6501 if gTriggers <> nil then
6502 for a := 0 to High(gTriggers) do
6503 with gTriggers[a] do
6504 begin
6505 if TriggerType = TRIGGER_NONE then
6506 Continue;
6507
6508 if TexturePanel = _id then
6509 TexturePanel := 0
6510 else
6511 if (TexturePanel >= 0) and (TexturePanel < _id) then
6512 Inc(TexturePanel);
6513
6514 case TriggerType of
6515 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6516 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6517 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6518 if Data.PanelID = _id then
6519 Data.PanelID := 0
6520 else
6521 if (Data.PanelID >= 0) and (Data.PanelID < _id) then
6522 Inc(Data.PanelID);
6523
6524 TRIGGER_SHOT:
6525 if Data.ShotPanelID = _id then
6526 Data.ShotPanelID := 0
6527 else
6528 if (Data.ShotPanelID >= 0) and (Data.ShotPanelID < _id) then
6529 Inc(Data.ShotPanelID);
6530 end;
6531 end;
6532
6533 tmp := gPanels[_id];
6534
6535 for a := _id downto 1 do
6536 gPanels[a] := gPanels[a-1];
6537
6538 gPanels[0] := tmp;
6539
6540 ID := 0;
6541 end
6542 else // to Front
6543 begin
6544 if gTriggers <> nil then
6545 for a := 0 to High(gTriggers) do
6546 with gTriggers[a] do
6547 begin
6548 if TriggerType = TRIGGER_NONE then
6549 Continue;
6550
6551 if TexturePanel = _id then
6552 TexturePanel := High(gPanels)
6553 else
6554 if TexturePanel > _id then
6555 Dec(TexturePanel);
6556
6557 case TriggerType of
6558 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6559 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6560 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6561 if Data.PanelID = _id then
6562 Data.PanelID := High(gPanels)
6563 else
6564 if Data.PanelID > _id then
6565 Dec(Data.PanelID);
6566
6567 TRIGGER_SHOT:
6568 if Data.ShotPanelID = _id then
6569 Data.ShotPanelID := High(gPanels)
6570 else
6571 if Data.ShotPanelID > _id then
6572 Dec(Data.ShotPanelID);
6573 end;
6574 end;
6575
6576 tmp := gPanels[_id];
6577
6578 for a := _id to High(gPanels)-1 do
6579 gPanels[a] := gPanels[a+1];
6580
6581 gPanels[High(gPanels)] := tmp;
6582
6583 ID := High(gPanels);
6584 end;
6585 end;
6586
6587 procedure TMainForm.aMoveToBack(Sender: TObject);
6588 var
6589 a: Integer;
6590 begin
6591 if SelectedObjects = nil then
6592 Exit;
6593
6594 for a := 0 to High(SelectedObjects) do
6595 with SelectedObjects[a] do
6596 if Live and (ObjectType = OBJECT_PANEL) then
6597 begin
6598 SelectedObjects[0] := SelectedObjects[a];
6599 SetLength(SelectedObjects, 1);
6600 MovePanel(ID, 0);
6601 FillProperty();
6602 Break;
6603 end;
6604 end;
6605
6606 procedure TMainForm.aMoveToFore(Sender: TObject);
6607 var
6608 a: Integer;
6609 begin
6610 if SelectedObjects = nil then
6611 Exit;
6612
6613 for a := 0 to High(SelectedObjects) do
6614 with SelectedObjects[a] do
6615 if Live and (ObjectType = OBJECT_PANEL) then
6616 begin
6617 SelectedObjects[0] := SelectedObjects[a];
6618 SetLength(SelectedObjects, 1);
6619 MovePanel(ID, 1);
6620 FillProperty();
6621 Break;
6622 end;
6623 end;
6624
6625 procedure TMainForm.aSaveMapAsExecute(Sender: TObject);
6626 var i, idx: Integer; list: TStringList; fmt: String;
6627 begin
6628 list := TStringList.Create();
6629
6630 // TODO: get loclized strings automatically from language files
6631 SaveDialog.DefaultExt := '.dfz';
6632 SaveDialog.FilterIndex := 1;
6633 SaveDialog.Filter := '';
6634 gWADEditorFactory.GetRegistredEditors(list);
6635 for i := 0 to list.Count - 1 do
6636 begin
6637 if list[i] = 'DFZIP' then
6638 SaveDialog.FilterIndex := i + 1;
6639
6640 if i <> 0 then
6641 SaveDialog.Filter := SaveDialog.Filter + '|';
6642
6643 if list[i] = 'DFWAD' then
6644 SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFWAD
6645 else if list[i] = 'DFZIP' then
6646 SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFZIP
6647 else
6648 SaveDialog.Filter := SaveDialog.Filter + list[i] + '|*.*';
6649 end;
6650
6651 if SaveDialog.Execute() then
6652 begin
6653 i := SaveDialog.FilterIndex - 1;
6654 if (i >= 0) and (i < list.Count) then fmt := list[i] else fmt := '';
6655
6656 SaveMapForm.GetMaps(SaveDialog.FileName, True, fmt);
6657 if SaveMapForm.ShowModal() = mrOK then
6658 begin
6659 SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName);
6660 OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text;
6661 OpenedWAD := SaveDialog.FileName;
6662
6663 idx := RecentFiles.IndexOf(OpenedMap);
6664 // Такая карта уже недавно открывалась:
6665 if idx >= 0 then
6666 RecentFiles.Delete(idx);
6667 RecentFiles.Insert(0, OpenedMap);
6668 RefreshRecentMenu;
6669
6670 SaveMap(OpenedMap, fmt);
6671
6672 gMapInfo.FileName := SaveDialog.FileName;
6673 gMapInfo.MapName := SaveMapForm.eMapName.Text;
6674 UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
6675 end;
6676 end;
6677
6678 list.Free();
6679 end;
6680
6681 procedure TMainForm.aSelectAllExecute(Sender: TObject);
6682 var
6683 a: Integer;
6684 begin
6685 RemoveSelectFromObjects();
6686
6687 case pcObjects.ActivePageIndex+1 of
6688 OBJECT_PANEL:
6689 if gPanels <> nil then
6690 for a := 0 to High(gPanels) do
6691 if gPanels[a].PanelType <> PANEL_NONE then
6692 SelectObject(OBJECT_PANEL, a, True);
6693 OBJECT_ITEM:
6694 if gItems <> nil then
6695 for a := 0 to High(gItems) do
6696 if gItems[a].ItemType <> ITEM_NONE then
6697 SelectObject(OBJECT_ITEM, a, True);
6698 OBJECT_MONSTER:
6699 if gMonsters <> nil then
6700 for a := 0 to High(gMonsters) do
6701 if gMonsters[a].MonsterType <> MONSTER_NONE then
6702 SelectObject(OBJECT_MONSTER, a, True);
6703 OBJECT_AREA:
6704 if gAreas <> nil then
6705 for a := 0 to High(gAreas) do
6706 if gAreas[a].AreaType <> AREA_NONE then
6707 SelectObject(OBJECT_AREA, a, True);
6708 OBJECT_TRIGGER:
6709 if gTriggers <> nil then
6710 for a := 0 to High(gTriggers) do
6711 if gTriggers[a].TriggerType <> TRIGGER_NONE then
6712 SelectObject(OBJECT_TRIGGER, a, True);
6713 end;
6714
6715 RecountSelectedObjects();
6716 end;
6717
6718 procedure TMainForm.tbGridOnClick(Sender: TObject);
6719 begin
6720 DotEnable := not DotEnable;
6721 (Sender as TToolButton).Down := DotEnable;
6722 end;
6723
6724 procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean);
6725 const MaxFPS = 60;
6726 var f: AnsiString;
6727 begin
6728 // TODO: move refresh to user actions (ask to repaint only when something changed)
6729 if GetTickCount64() - LastDrawTime >= 1000 div MaxFPS then
6730 begin
6731 PanelMap.Refresh;
6732 end;
6733
6734 if StartMap <> '' then
6735 begin
6736 f := StartMap;
6737 StartMap := '';
6738 OpenMap(f, '');
6739 end;
6740 end;
6741
6742 procedure TMainForm.miMapPreviewClick(Sender: TObject);
6743 begin
6744 if PreviewMode = 2 then
6745 Exit;
6746
6747 if PreviewMode = 0 then
6748 begin
6749 Splitter2.Visible := False;
6750 Splitter1.Visible := False;
6751 StatusBar.Visible := False;
6752 PanelObjs.Visible := False;
6753 PanelProps.Visible := False;
6754 MainToolBar.Visible := False;
6755 sbHorizontal.Visible := False;
6756 sbVertical.Visible := False;
6757 end
6758 else
6759 begin
6760 StatusBar.Visible := True;
6761 PanelObjs.Visible := True;
6762 PanelProps.Visible := True;
6763 Splitter2.Visible := True;
6764 Splitter1.Visible := True;
6765 MainToolBar.Visible := True;
6766 sbHorizontal.Visible := True;
6767 sbVertical.Visible := True;
6768 end;
6769
6770 PreviewMode := PreviewMode xor 1;
6771 (Sender as TMenuItem).Checked := PreviewMode > 0;
6772
6773 FormResize(Self);
6774 end;
6775
6776 procedure TMainForm.miLayer1Click(Sender: TObject);
6777 begin
6778 SwitchLayer(LAYER_BACK);
6779 end;
6780
6781 procedure TMainForm.miLayer2Click(Sender: TObject);
6782 begin
6783 SwitchLayer(LAYER_WALLS);
6784 end;
6785
6786 procedure TMainForm.miLayer3Click(Sender: TObject);
6787 begin
6788 SwitchLayer(LAYER_FOREGROUND);
6789 end;
6790
6791 procedure TMainForm.miLayer4Click(Sender: TObject);
6792 begin
6793 SwitchLayer(LAYER_STEPS);
6794 end;
6795
6796 procedure TMainForm.miLayer5Click(Sender: TObject);
6797 begin
6798 SwitchLayer(LAYER_WATER);
6799 end;
6800
6801 procedure TMainForm.miLayer6Click(Sender: TObject);
6802 begin
6803 SwitchLayer(LAYER_ITEMS);
6804 end;
6805
6806 procedure TMainForm.miLayer7Click(Sender: TObject);
6807 begin
6808 SwitchLayer(LAYER_MONSTERS);
6809 end;
6810
6811 procedure TMainForm.miLayer8Click(Sender: TObject);
6812 begin
6813 SwitchLayer(LAYER_AREAS);
6814 end;
6815
6816 procedure TMainForm.miLayer9Click(Sender: TObject);
6817 begin
6818 SwitchLayer(LAYER_TRIGGERS);
6819 end;
6820
6821 procedure TMainForm.tbShowClick(Sender: TObject);
6822 var
6823 a: Integer;
6824 b: Boolean;
6825 begin
6826 b := True;
6827 for a := 0 to High(LayerEnabled) do
6828 b := b and LayerEnabled[a];
6829
6830 b := not b;
6831
6832 ShowLayer(LAYER_BACK, b);
6833 ShowLayer(LAYER_WALLS, b);
6834 ShowLayer(LAYER_FOREGROUND, b);
6835 ShowLayer(LAYER_STEPS, b);
6836 ShowLayer(LAYER_WATER, b);
6837 ShowLayer(LAYER_ITEMS, b);
6838 ShowLayer(LAYER_MONSTERS, b);
6839 ShowLayer(LAYER_AREAS, b);
6840 ShowLayer(LAYER_TRIGGERS, b);
6841 end;
6842
6843 procedure TMainForm.miMiniMapClick(Sender: TObject);
6844 begin
6845 SwitchMap();
6846 end;
6847
6848 procedure TMainForm.miSwitchGridClick(Sender: TObject);
6849 begin
6850 if DotStep = DotStepOne then
6851 DotStep := DotStepTwo
6852 else
6853 DotStep := DotStepOne;
6854
6855 MousePos.X := (MousePos.X div DotStep) * DotStep;
6856 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6857 end;
6858
6859 procedure TMainForm.miShowEdgesClick(Sender: TObject);
6860 begin
6861 ShowEdges();
6862 end;
6863
6864 procedure TMainForm.miSnapToGridClick(Sender: TObject);
6865 begin
6866 SnapToGrid := not SnapToGrid;
6867
6868 MousePos.X := (MousePos.X div DotStep) * DotStep;
6869 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6870
6871 miSnapToGrid.Checked := SnapToGrid;
6872 end;
6873
6874 procedure TMainForm.minexttabClick(Sender: TObject);
6875 begin
6876 if pcObjects.ActivePageIndex < pcObjects.PageCount-1 then
6877 pcObjects.ActivePageIndex := pcObjects.ActivePageIndex+1
6878 else
6879 pcObjects.ActivePageIndex := 0;
6880 end;
6881
6882 procedure TMainForm.miSaveMiniMapClick(Sender: TObject);
6883 begin
6884 SaveMiniMapForm.ShowModal();
6885 end;
6886
6887 procedure TMainForm.bClearTextureClick(Sender: TObject);
6888 begin
6889 lbTextureList.ItemIndex := -1;
6890 lTextureWidth.Caption := '';
6891 lTextureHeight.Caption := '';
6892 end;
6893
6894 procedure TMainForm.miPackMapClick(Sender: TObject);
6895 begin
6896 PackMapForm.ShowModal();
6897 end;
6898
6899 type SSArray = array of String;
6900
6901 function ParseString (Str: AnsiString): SSArray;
6902 function GetStr (var Str: AnsiString): AnsiString;
6903 var a, b: Integer;
6904 begin
6905 Result := '';
6906 if Str[1] = '"' then
6907 for b := 1 to Length(Str) do
6908 if (b = Length(Str)) or (Str[b + 1] = '"') then
6909 begin
6910 Result := Copy(Str, 2, b - 1);
6911 Delete(Str, 1, b + 1);
6912 Str := Trim(Str);
6913 Exit;
6914 end;
6915 for a := 1 to Length(Str) do
6916 if (a = Length(Str)) or (Str[a + 1] = ' ') then
6917 begin
6918 Result := Copy(Str, 1, a);
6919 Delete(Str, 1, a + 1);
6920 Str := Trim(Str);
6921 Exit;
6922 end;
6923 end;
6924 begin
6925 Result := nil;
6926 Str := Trim(Str);
6927 while Str <> '' do
6928 begin
6929 SetLength(Result, Length(Result)+1);
6930 Result[High(Result)] := GetStr(Str);
6931 end;
6932 end;
6933
6934 procedure TMainForm.miTestMapClick(Sender: TObject);
6935 var
6936 newWAD, oldWAD, tempMap, ext: String;
6937 args: SSArray;
6938 opt: LongWord;
6939 time, i: Integer;
6940 proc: TProcessUTF8;
6941 res: Boolean;
6942 begin
6943 // Ignore while map testing in progress
6944 if MapTestProcess <> nil then
6945 Exit;
6946
6947 // Сохраняем временную карту:
6948 time := 0;
6949 repeat
6950 newWAD := Format('%s/temp%.4d', [MapsDir, time]);
6951 Inc(time);
6952 until not FileExists(newWAD);
6953 if OpenedMap <> '' then
6954 begin
6955 oldWad := g_ExtractWadName(OpenedMap);
6956 newWad := newWad + ExtractFileExt(oldWad);
6957 if CopyFile(oldWad, newWad) = false then
6958 e_WriteLog('MapTest: unable to copy [' + oldWad + '] to [' + newWad + ']', MSG_WARNING)
6959 end
6960 else
6961 begin
6962 newWad := newWad + '.wad'
6963 end;
6964 tempMap := newWAD + ':\' + TEST_MAP_NAME;
6965 SaveMap(tempMap, '');
6966
6967 // Опции игры:
6968 opt := 32 + 64;
6969 if TestOptionsTwoPlayers then
6970 opt := opt + 1;
6971 if TestOptionsTeamDamage then
6972 opt := opt + 2;
6973 if TestOptionsAllowExit then
6974 opt := opt + 4;
6975 if TestOptionsWeaponStay then
6976 opt := opt + 8;
6977 if TestOptionsMonstersDM then
6978 opt := opt + 16;
6979
6980 // Запускаем:
6981 proc := TProcessUTF8.Create(nil);
6982 proc.Executable := TestD2dExe;
6983 {$IFDEF DARWIN}
6984 // TODO: get real executable name from Info.plist
6985 if LowerCase(ExtractFileExt(TestD2dExe)) = '.app' then
6986 proc.Executable := TestD2dExe + DirectorySeparator + 'Contents' + DirectorySeparator + 'MacOS' + DirectorySeparator + 'Doom2DF';
6987 {$ENDIF}
6988 proc.Parameters.Add('-map');
6989 proc.Parameters.Add(tempMap);
6990 proc.Parameters.Add('-gm');
6991 proc.Parameters.Add(TestGameMode);
6992 proc.Parameters.Add('-limt');
6993 proc.Parameters.Add(TestLimTime);
6994 proc.Parameters.Add('-lims');
6995 proc.Parameters.Add(TestLimScore);
6996 proc.Parameters.Add('-opt');
6997 proc.Parameters.Add(IntToStr(opt));
6998 proc.Parameters.Add('--debug');
6999 if TestMapOnce then
7000 proc.Parameters.Add('--close');
7001
7002 args := ParseString(TestD2DArgs);
7003 for i := 0 to High(args) do
7004 proc.Parameters.Add(args[i]);
7005
7006 res := True;
7007 try
7008 proc.Execute();
7009 except
7010 res := False;
7011 end;
7012 if res then
7013 begin
7014 tbTestMap.Enabled := False;
7015 MapTestFile := newWAD;
7016 MapTestProcess := proc;
7017 end
7018 else
7019 begin
7020 Application.MessageBox(PChar(MsgMsgExecError), 'FIXME', MB_OK or MB_ICONERROR);
7021 SysUtils.DeleteFile(newWAD);
7022 proc.Free();
7023 end;
7024 end;
7025
7026 procedure TMainForm.sbVerticalScroll(Sender: TObject;
7027 ScrollCode: TScrollCode; var ScrollPos: Integer);
7028 begin
7029 MapOffset.Y := -sbVertical.Position;
7030 RenderPanel.Invalidate;
7031 end;
7032
7033 procedure TMainForm.sbHorizontalScroll(Sender: TObject;
7034 ScrollCode: TScrollCode; var ScrollPos: Integer);
7035 begin
7036 MapOffset.X := -sbHorizontal.Position;
7037 RenderPanel.Invalidate;
7038 end;
7039
7040 procedure TMainForm.miOpenWadMapClick(Sender: TObject);
7041 begin
7042 if OpenedWAD <> '' then
7043 begin
7044 OpenMap(OpenedWAD, '');
7045 end;
7046 end;
7047
7048 procedure TMainForm.selectall1Click(Sender: TObject);
7049 var
7050 a: Integer;
7051 begin
7052 RemoveSelectFromObjects();
7053
7054 if gPanels <> nil then
7055 for a := 0 to High(gPanels) do
7056 if gPanels[a].PanelType <> PANEL_NONE then
7057 SelectObject(OBJECT_PANEL, a, True);
7058
7059 if gItems <> nil then
7060 for a := 0 to High(gItems) do
7061 if gItems[a].ItemType <> ITEM_NONE then
7062 SelectObject(OBJECT_ITEM, a, True);
7063
7064 if gMonsters <> nil then
7065 for a := 0 to High(gMonsters) do
7066 if gMonsters[a].MonsterType <> MONSTER_NONE then
7067 SelectObject(OBJECT_MONSTER, a, True);
7068
7069 if gAreas <> nil then
7070 for a := 0 to High(gAreas) do
7071 if gAreas[a].AreaType <> AREA_NONE then
7072 SelectObject(OBJECT_AREA, a, True);
7073
7074 if gTriggers <> nil then
7075 for a := 0 to High(gTriggers) do
7076 if gTriggers[a].TriggerType <> TRIGGER_NONE then
7077 SelectObject(OBJECT_TRIGGER, a, True);
7078
7079 RecountSelectedObjects();
7080 end;
7081
7082 procedure TMainForm.Splitter1CanResize(Sender: TObject;
7083 var NewSize: Integer; var Accept: Boolean);
7084 begin
7085 Accept := (NewSize > 140);
7086 end;
7087
7088 procedure TMainForm.Splitter2CanResize(Sender: TObject;
7089 var NewSize: Integer; var Accept: Boolean);
7090 begin
7091 Accept := (NewSize > 110);
7092 end;
7093
7094 procedure TMainForm.vleObjectPropertyEnter(Sender: TObject);
7095 begin
7096 EditingProperties := True;
7097 end;
7098
7099 procedure TMainForm.vleObjectPropertyExit(Sender: TObject);
7100 begin
7101 EditingProperties := False;
7102 end;
7103
7104 procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
7105 begin
7106 // Объекты передвигались:
7107 if MainForm.ActiveControl = RenderPanel then
7108 begin
7109 if (Key = VK_NUMPAD4) or
7110 (Key = VK_NUMPAD6) or
7111 (Key = VK_NUMPAD8) or
7112 (Key = VK_NUMPAD5) or
7113 (Key = Ord('V')) then
7114 FillProperty();
7115 end;
7116 // Быстрое превью карты:
7117 if Key = Ord('E') then
7118 begin
7119 if PreviewMode = 2 then
7120 PreviewMode := 0;
7121 end;
7122 RenderPanelMouseMove(Sender, Shift, RenderMousePos().X, RenderMousePos().Y);
7123 end;
7124
7125 end.
[MIRROR] Doom2DF editor ported to FPC/Lazarus
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024