DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob


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