DEADSOFTWARE

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