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