DEADSOFTWARE

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