DEADSOFTWARE

Menu: Add map reopen feature
[d2df-editor.git] / src / editor / f_main.pas
1 unit f_main;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
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;
13 type
15 { TMainForm }
17 TMainForm = class(TForm)
18 lLoad: TLabel;
19 // Главное меню:
20 MainMenu: TMainMenu;
21 // "Файл":
22 miMenuFile: TMenuItem;
23 miNewMap: TMenuItem;
24 miOpenMap: TMenuItem;
25 miSaveMap: TMenuItem;
26 miSaveMapAs: TMenuItem;
27 miOpenWadMap: TMenuItem;
28 miLine1: TMenuItem;
29 miReopenMap: TMenuItem;
30 miSaveMiniMap: TMenuItem;
31 miDeleteMap: TMenuItem;
32 miPackMap: TMenuItem;
33 miLine2: TMenuItem;
34 miExit: TMenuItem;
35 // "Правка":
36 miMenuEdit: TMenuItem;
37 miUndo: TMenuItem;
38 miLine3: TMenuItem;
39 miCopy: TMenuItem;
40 miCut: TMenuItem;
41 miPaste: TMenuItem;
42 miLine4: TMenuItem;
43 miSelectAll: TMenuItem;
44 miLine5: TMenuItem;
45 miToFore: TMenuItem;
46 miToBack: TMenuItem;
47 // "Инструменты":
48 miMenuTools: TMenuItem;
49 miSnapToGrid: TMenuItem;
50 miMiniMap: TMenuItem;
51 miSwitchGrid: TMenuItem;
52 miShowEdges: TMenuItem;
53 miLayers: TMenuItem;
54 miLayer1: TMenuItem;
55 miLayer2: TMenuItem;
56 miLayer3: TMenuItem;
57 miLayer4: TMenuItem;
58 miLayer5: TMenuItem;
59 miLayer6: TMenuItem;
60 miLayer7: TMenuItem;
61 miLayer8: TMenuItem;
62 miLayer9: TMenuItem;
63 // "Сервис":
64 miMenuService: TMenuItem;
65 miCheckMap: TMenuItem;
66 miOptimmization: TMenuItem;
67 miMapPreview: TMenuItem;
68 miTestMap: TMenuItem;
69 // "Настройка":
70 miMenuSettings: TMenuItem;
71 miMapOptions: TMenuItem;
72 miLine6: TMenuItem;
73 miOptions: TMenuItem;
74 miLine7: TMenuItem;
75 miMapTestSettings: TMenuItem;
76 // "Справка":
77 miMenuHelp: TMenuItem;
78 miAbout: TMenuItem;
79 // Скрытый пункт меню для Ctrl+Tab:
80 miHidden1: TMenuItem;
81 minexttab: TMenuItem;
83 // Панель инструментов:
84 MainToolBar: TToolBar;
85 pbLoad: TProgressBar;
86 pLoadProgress: TPanel;
87 RenderPanel: TOpenGLControl;
88 tbNewMap: TToolButton;
89 tbOpenMap: TToolButton;
90 tbSaveMap: TToolButton;
91 tbOpenWadMap: TToolButton;
92 tbLine1: TToolButton;
93 tbShowMap: TToolButton;
94 tbLine2: TToolButton;
95 tbShow: TToolButton;
96 tbLine3: TToolButton;
97 tbGridOn: TToolButton;
98 tbGrid: TToolButton;
99 tbLine4: TToolButton;
100 tbTestMap: TToolButton;
101 // Всплывающее меню для кнопки слоев:
102 pmShow: TPopupMenu;
103 miLayerP1: TMenuItem;
104 miLayerP2: TMenuItem;
105 miLayerP3: TMenuItem;
106 miLayerP4: TMenuItem;
107 miLayerP5: TMenuItem;
108 miLayerP6: TMenuItem;
109 miLayerP7: TMenuItem;
110 miLayerP8: TMenuItem;
111 miLayerP9: TMenuItem;
112 // Всплывающее меню для кнопки теста карты:
113 pmMapTest: TPopupMenu;
114 miMapTestPMSet: TMenuItem;
116 // Панель карты:
117 PanelMap: TPanel;
118 // Полосы прокрутки:
119 sbHorizontal: TScrollBar;
120 sbVertical: TScrollBar;
122 // Панель свойств:
123 PanelProps: TPanel;
124 // Панель применения свойств:
125 PanelPropApply: TPanel;
126 bApplyProperty: TButton;
127 // Редактор свойств объектов:
128 vleObjectProperty: TValueListEditor;
130 // Панель объектов - вкладки:
131 PanelObjs: TPanel;
132 pcObjects: TPageControl;
133 // Вкладка "Панели":
134 tsPanels: TTabSheet;
135 lbTextureList: TListBox;
136 // Панель настройки текстур:
137 PanelTextures: TPanel;
138 LabelTxW: TLabel;
139 lTextureWidth: TLabel;
140 LabelTxH: TLabel;
141 lTextureHeight: TLabel;
142 cbPreview: TCheckBox;
143 bbAddTexture: TBitBtn;
144 bbRemoveTexture: TBitBtn;
145 bClearTexture: TButton;
146 // Панель типов панелей:
147 PanelPanelType: TPanel;
148 lbPanelType: TListBox;
149 // Вкладка "Предметы":
150 tsItems: TTabSheet;
151 lbItemList: TListBox;
152 cbOnlyDM: TCheckBox;
153 cbFall: TCheckBox;
154 // Вкладка "Монстры":
155 tsMonsters: TTabSheet;
156 lbMonsterList: TListBox;
157 rbMonsterLeft: TRadioButton;
158 rbMonsterRight: TRadioButton;
159 // Вкладка "Области":
160 tsAreas: TTabSheet;
161 lbAreasList: TListBox;
162 rbAreaLeft: TRadioButton;
163 rbAreaRight: TRadioButton;
164 // Вкладка "Триггеры":
165 tsTriggers: TTabSheet;
166 lbTriggersList: TListBox;
167 clbActivationType: TCheckListBox;
168 clbKeys: TCheckListBox;
170 // Остальные панели
171 Splitter1: TSplitter;
172 Splitter2: TSplitter;
173 StatusBar: TStatusBar;
175 // Специальные объекты:
176 ImageList: TImageList;
177 ilToolbar: TImageList;
178 OpenDialog: TOpenDialog;
179 SaveDialog: TSaveDialog;
180 selectall1: TMenuItem;
181 ColorDialog: TColorDialog;
183 procedure aAboutExecute(Sender: TObject);
184 procedure aCheckMapExecute(Sender: TObject);
185 procedure aMoveToFore(Sender: TObject);
186 procedure aMoveToBack(Sender: TObject);
187 procedure aCopyObjectExecute(Sender: TObject);
188 procedure aCutObjectExecute(Sender: TObject);
189 procedure aEditorOptionsExecute(Sender: TObject);
190 procedure aExitExecute(Sender: TObject);
191 procedure aMapOptionsExecute(Sender: TObject);
192 procedure aNewMapExecute(Sender: TObject);
193 procedure aOpenMapExecute(Sender: TObject);
194 procedure aOptimizeExecute(Sender: TObject);
195 procedure aPasteObjectExecute(Sender: TObject);
196 procedure aSelectAllExecute(Sender: TObject);
197 procedure aSaveMapExecute(Sender: TObject);
198 procedure aSaveMapAsExecute(Sender: TObject);
199 procedure aUndoExecute(Sender: TObject);
200 procedure aDeleteMap(Sender: TObject);
201 procedure bApplyPropertyClick(Sender: TObject);
202 procedure bbAddTextureClick(Sender: TObject);
203 procedure bbRemoveTextureClick(Sender: TObject);
204 procedure FormActivate(Sender: TObject);
205 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
206 procedure FormCreate(Sender: TObject);
207 procedure FormDestroy(Sender: TObject);
208 procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
209 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
210 procedure FormResize(Sender: TObject);
211 procedure lbTextureListClick(Sender: TObject);
212 procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer;
213 ARect: TRect; State: TOwnerDrawState);
214 procedure miReopenMapClick(Sender: TObject);
215 procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
216 procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
217 procedure RenderPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
218 procedure RenderPanelPaint(Sender: TObject);
219 procedure RenderPanelResize(Sender: TObject);
220 procedure Splitter1Moved(Sender: TObject);
221 procedure vleObjectPropertyEditButtonClick(Sender: TObject);
222 procedure vleObjectPropertyApply(Sender: TObject);
223 procedure vleObjectPropertyGetPickList(Sender: TObject; const KeyName: String; Values: TStrings);
224 procedure vleObjectPropertyKeyDown(Sender: TObject; var Key: Word;
225 Shift: TShiftState);
226 procedure tbGridOnClick(Sender: TObject);
227 procedure miMapPreviewClick(Sender: TObject);
228 procedure miLayer1Click(Sender: TObject);
229 procedure miLayer2Click(Sender: TObject);
230 procedure miLayer3Click(Sender: TObject);
231 procedure miLayer4Click(Sender: TObject);
232 procedure miLayer5Click(Sender: TObject);
233 procedure miLayer6Click(Sender: TObject);
234 procedure miLayer7Click(Sender: TObject);
235 procedure miLayer8Click(Sender: TObject);
236 procedure miLayer9Click(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 aRecentFileExecute(Sender: TObject);
247 procedure miMapTestSettingsClick(Sender: TObject);
248 procedure miTestMapClick(Sender: TObject);
249 procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode;
250 var ScrollPos: Integer);
251 procedure sbHorizontalScroll(Sender: TObject; ScrollCode: TScrollCode;
252 var ScrollPos: Integer);
253 procedure miOpenWadMapClick(Sender: TObject);
254 procedure selectall1Click(Sender: TObject);
255 procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
256 var Accept: Boolean);
257 procedure Splitter2CanResize(Sender: TObject; var NewSize: Integer;
258 var Accept: Boolean);
259 procedure vleObjectPropertyEnter(Sender: TObject);
260 procedure vleObjectPropertyExit(Sender: TObject);
261 procedure FormKeyUp(Sender: TObject; var Key: Word;
262 Shift: TShiftState);
263 private
264 procedure Draw();
265 procedure OnIdle(Sender: TObject; var Done: Boolean);
266 public
267 procedure RefreshRecentMenu();
268 procedure OpenMapFile(FileName: String);
269 end;
271 const
272 LAYER_BACK = 0;
273 LAYER_WALLS = 1;
274 LAYER_FOREGROUND = 2;
275 LAYER_STEPS = 3;
276 LAYER_WATER = 4;
277 LAYER_ITEMS = 5;
278 LAYER_MONSTERS = 6;
279 LAYER_AREAS = 7;
280 LAYER_TRIGGERS = 8;
282 TEST_MAP_NAME = '$$$_TEST_$$$';
283 LANGUAGE_FILE_NAME = '_Editor.txt';
285 var
286 MainForm: TMainForm;
287 EditorDir: String;
288 OpenedMap: String;
289 OpenedWAD: String;
291 DotColor: TColor;
292 DotEnable: Boolean;
293 DotStep: Byte;
294 DotStepOne, DotStepTwo: Byte;
295 DotSize: Byte;
296 DrawTexturePanel: Boolean;
297 DrawPanelSize: Boolean;
298 BackColor: TColor;
299 PreviewColor: TColor;
300 UseCheckerboard: Boolean;
301 Scale: Byte;
302 RecentCount: Integer;
303 RecentFiles: TStringList;
304 slInvalidTextures: TStringList;
306 TestGameMode: String;
307 TestLimTime: String;
308 TestLimScore: String;
309 TestOptionsTwoPlayers: Boolean;
310 TestOptionsTeamDamage: Boolean;
311 TestOptionsAllowExit: Boolean;
312 TestOptionsWeaponStay: Boolean;
313 TestOptionsMonstersDM: Boolean;
314 TestD2dExe: String;
315 TestMapOnce: Boolean;
317 LayerEnabled: Array [LAYER_BACK..LAYER_TRIGGERS] of Boolean =
318 (True, True, True, True, True, True, True, True, True);
319 PreviewMode: Byte = 0;
320 gLanguage: String;
322 FormCaption: String;
325 procedure OpenMap(FileName: String; mapN: String);
326 function AddTexture(aWAD, aSection, aTex: String; silent: Boolean): Boolean;
327 procedure RemoveSelectFromObjects();
328 procedure ChangeShownProperty(Name: String; NewValue: String);
330 implementation
332 uses
333 f_options, e_graphics, e_log, GL, Math,
334 f_mapoptions, g_basic, f_about, f_mapoptimization,
335 f_mapcheck, f_addresource_texture, g_textures,
336 f_activationtype, f_keys,
337 MAPREADER, f_selectmap, f_savemap, WADEDITOR, WADSTRUCT, MAPDEF,
338 g_map, f_saveminimap, f_addresource, CONFIG, f_packmap,
339 f_addresource_sound, f_maptest, f_choosetype,
340 g_language, f_selectlang, ClipBrd;
342 const
343 UNDO_DELETE_PANEL = 1;
344 UNDO_DELETE_ITEM = 2;
345 UNDO_DELETE_AREA = 3;
346 UNDO_DELETE_MONSTER = 4;
347 UNDO_DELETE_TRIGGER = 5;
348 UNDO_ADD_PANEL = 6;
349 UNDO_ADD_ITEM = 7;
350 UNDO_ADD_AREA = 8;
351 UNDO_ADD_MONSTER = 9;
352 UNDO_ADD_TRIGGER = 10;
353 UNDO_MOVE_PANEL = 11;
354 UNDO_MOVE_ITEM = 12;
355 UNDO_MOVE_AREA = 13;
356 UNDO_MOVE_MONSTER = 14;
357 UNDO_MOVE_TRIGGER = 15;
358 UNDO_RESIZE_PANEL = 16;
359 UNDO_RESIZE_TRIGGER = 17;
361 MOUSEACTION_NONE = 0;
362 MOUSEACTION_DRAWPANEL = 1;
363 MOUSEACTION_DRAWTRIGGER = 2;
364 MOUSEACTION_MOVEOBJ = 3;
365 MOUSEACTION_RESIZE = 4;
366 MOUSEACTION_MOVEMAP = 5;
367 MOUSEACTION_DRAWPRESS = 6;
368 MOUSEACTION_NOACTION = 7;
370 RESIZETYPE_NONE = 0;
371 RESIZETYPE_VERTICAL = 1;
372 RESIZETYPE_HORIZONTAL = 2;
374 RESIZEDIR_NONE = 0;
375 RESIZEDIR_DOWN = 1;
376 RESIZEDIR_UP = 2;
377 RESIZEDIR_RIGHT = 3;
378 RESIZEDIR_LEFT = 4;
380 SELECTFLAG_NONE = 0;
381 SELECTFLAG_TELEPORT = 1;
382 SELECTFLAG_DOOR = 2;
383 SELECTFLAG_TEXTURE = 3;
384 SELECTFLAG_LIFT = 4;
385 SELECTFLAG_MONSTER = 5;
386 SELECTFLAG_SPAWNPOINT = 6;
387 SELECTFLAG_SHOTPANEL = 7;
388 SELECTFLAG_SELECTED = 8;
390 RECENT_FILES_MENU_START = 12;
392 CLIPBOARD_SIG = 'DF:ED';
394 type
395 TUndoRec = record
396 UndoType: Byte;
397 case Byte of
398 UNDO_DELETE_PANEL: (Panel: ^TPanel);
399 UNDO_DELETE_ITEM: (Item: TItem);
400 UNDO_DELETE_AREA: (Area: TArea);
401 UNDO_DELETE_MONSTER: (Monster: TMonster);
402 UNDO_DELETE_TRIGGER: (Trigger: TTrigger);
403 UNDO_ADD_PANEL,
404 UNDO_ADD_ITEM,
405 UNDO_ADD_AREA,
406 UNDO_ADD_MONSTER,
407 UNDO_ADD_TRIGGER: (AddID: DWORD);
408 UNDO_MOVE_PANEL,
409 UNDO_MOVE_ITEM,
410 UNDO_MOVE_AREA,
411 UNDO_MOVE_MONSTER,
412 UNDO_MOVE_TRIGGER: (MoveID: DWORD; dX, dY: Integer);
413 UNDO_RESIZE_PANEL,
414 UNDO_RESIZE_TRIGGER: (ResizeID: DWORD; dW, dH: Integer);
415 end;
417 TCopyRec = record
418 ObjectType: Byte;
419 ID: Cardinal;
420 case Byte of
421 OBJECT_PANEL: (Panel: ^TPanel);
422 OBJECT_ITEM: (Item: TItem);
423 OBJECT_AREA: (Area: TArea);
424 OBJECT_MONSTER: (Monster: TMonster);
425 OBJECT_TRIGGER: (Trigger: TTrigger);
426 end;
428 TCopyRecArray = Array of TCopyRec;
430 var
431 gEditorFont: DWORD;
432 gDataLoaded: Boolean = False;
433 ShowMap: Boolean = False;
434 DrawRect: PRect = nil;
435 SnapToGrid: Boolean = True;
437 MousePos: Types.TPoint;
438 LastMovePoint: Types.TPoint;
439 MouseLDown: Boolean;
440 MouseRDown: Boolean;
441 MouseLDownPos: Types.TPoint;
442 MouseRDownPos: Types.TPoint;
443 WASDOffset: TPoint;
445 SelectFlag: Byte = SELECTFLAG_NONE;
446 MouseAction: Byte = MOUSEACTION_NONE;
447 ResizeType: Byte = RESIZETYPE_NONE;
448 ResizeDirection: Byte = RESIZEDIR_NONE;
450 DrawPressRect: Boolean = False;
451 EditingProperties: Boolean = False;
453 UndoBuffer: Array of Array of TUndoRec = nil;
456 {$R *.lfm}
458 //----------------------------------------
459 //Далее идут вспомогательные процедуры
460 //----------------------------------------
462 function NameToBool(Name: String): Boolean;
463 begin
464 if Name = BoolNames[True] then
465 Result := True
466 else
467 Result := False;
468 end;
470 function NameToDir(Name: String): TDirection;
471 begin
472 if Name = DirNames[D_LEFT] then
473 Result := D_LEFT
474 else
475 Result := D_RIGHT;
476 end;
478 function NameToDirAdv(Name: String): Byte;
479 begin
480 if Name = DirNamesAdv[1] then
481 Result := 1
482 else
483 if Name = DirNamesAdv[2] then
484 Result := 2
485 else
486 if Name = DirNamesAdv[3] then
487 Result := 3
488 else
489 Result := 0;
490 end;
492 function ActivateToStr(ActivateType: Byte): String;
493 begin
494 Result := '';
496 if ByteBool(ACTIVATE_PLAYERCOLLIDE and ActivateType) then
497 Result := Result + '+PC';
498 if ByteBool(ACTIVATE_MONSTERCOLLIDE and ActivateType) then
499 Result := Result + '+MC';
500 if ByteBool(ACTIVATE_PLAYERPRESS and ActivateType) then
501 Result := Result + '+PP';
502 if ByteBool(ACTIVATE_MONSTERPRESS and ActivateType) then
503 Result := Result + '+MP';
504 if ByteBool(ACTIVATE_SHOT and ActivateType) then
505 Result := Result + '+SH';
506 if ByteBool(ACTIVATE_NOMONSTER and ActivateType) then
507 Result := Result + '+NM';
509 if (Result <> '') and (Result[1] = '+') then
510 Delete(Result, 1, 1);
511 end;
513 function StrToActivate(Str: String): Byte;
514 begin
515 Result := 0;
517 if Pos('PC', Str) > 0 then
518 Result := ACTIVATE_PLAYERCOLLIDE;
519 if Pos('MC', Str) > 0 then
520 Result := Result or ACTIVATE_MONSTERCOLLIDE;
521 if Pos('PP', Str) > 0 then
522 Result := Result or ACTIVATE_PLAYERPRESS;
523 if Pos('MP', Str) > 0 then
524 Result := Result or ACTIVATE_MONSTERPRESS;
525 if Pos('SH', Str) > 0 then
526 Result := Result or ACTIVATE_SHOT;
527 if Pos('NM', Str) > 0 then
528 Result := Result or ACTIVATE_NOMONSTER;
529 end;
531 function KeyToStr(Key: Byte): String;
532 begin
533 Result := '';
535 if ByteBool(KEY_RED and Key) then
536 Result := Result + '+RK';
537 if ByteBool(KEY_GREEN and Key) then
538 Result := Result + '+GK';
539 if ByteBool(KEY_BLUE and Key) then
540 Result := Result + '+BK';
541 if ByteBool(KEY_REDTEAM and Key) then
542 Result := Result + '+RT';
543 if ByteBool(KEY_BLUETEAM and Key) then
544 Result := Result + '+BT';
546 if (Result <> '') and (Result[1] = '+') then
547 Delete(Result, 1, 1);
548 end;
550 function StrToKey(Str: String): Byte;
551 begin
552 Result := 0;
554 if Pos('RK', Str) > 0 then
555 Result := KEY_RED;
556 if Pos('GK', Str) > 0 then
557 Result := Result or KEY_GREEN;
558 if Pos('BK', Str) > 0 then
559 Result := Result or KEY_BLUE;
560 if Pos('RT', Str) > 0 then
561 Result := Result or KEY_REDTEAM;
562 if Pos('BT', Str) > 0 then
563 Result := Result or KEY_BLUETEAM;
564 end;
566 function EffectToStr(Effect: Byte): String;
567 begin
568 if Effect in [EFFECT_TELEPORT..EFFECT_FIRE] then
569 Result := EffectNames[Effect]
570 else
571 Result := EffectNames[EFFECT_NONE];
572 end;
574 function StrToEffect(Str: String): Byte;
575 var
576 i: Integer;
577 begin
578 Result := EFFECT_NONE;
579 for i := EFFECT_TELEPORT to EFFECT_FIRE do
580 if EffectNames[i] = Str then
581 begin
582 Result := i;
583 Exit;
584 end;
585 end;
587 function MonsterToStr(MonType: Byte): String;
588 begin
589 if MonType in [MONSTER_DEMON..MONSTER_MAN] then
590 Result := MonsterNames[MonType]
591 else
592 Result := MonsterNames[MONSTER_ZOMBY];
593 end;
595 function StrToMonster(Str: String): Byte;
596 var
597 i: Integer;
598 begin
599 Result := MONSTER_ZOMBY;
600 for i := MONSTER_DEMON to MONSTER_MAN do
601 if MonsterNames[i] = Str then
602 begin
603 Result := i;
604 Exit;
605 end;
606 end;
608 function ItemToStr(ItemType: Byte): String;
609 begin
610 if ItemType in [ITEM_MEDKIT_SMALL..ITEM_MAX] then
611 Result := ItemNames[ItemType]
612 else
613 Result := ItemNames[ITEM_AMMO_BULLETS];
614 end;
616 function StrToItem(Str: String): Byte;
617 var
618 i: Integer;
619 begin
620 Result := ITEM_AMMO_BULLETS;
621 for i := ITEM_MEDKIT_SMALL to ITEM_MAX do
622 if ItemNames[i] = Str then
623 begin
624 Result := i;
625 Exit;
626 end;
627 end;
629 function ShotToStr(ShotType: Byte): String;
630 begin
631 if ShotType in [TRIGGER_SHOT_PISTOL..TRIGGER_SHOT_MAX] then
632 Result := ShotNames[ShotType]
633 else
634 Result := ShotNames[TRIGGER_SHOT_PISTOL];
635 end;
637 function StrToShot(Str: String): Byte;
638 var
639 i: Integer;
640 begin
641 Result := TRIGGER_SHOT_PISTOL;
642 for i := TRIGGER_SHOT_PISTOL to TRIGGER_SHOT_MAX do
643 if ShotNames[i] = Str then
644 begin
645 Result := i;
646 Exit;
647 end;
648 end;
650 function SelectedObjectCount(): Word;
651 var
652 a: Integer;
653 begin
654 Result := 0;
656 if SelectedObjects = nil then
657 Exit;
659 for a := 0 to High(SelectedObjects) do
660 if SelectedObjects[a].Live then
661 Result := Result + 1;
662 end;
664 function GetFirstSelected(): Integer;
665 var
666 a: Integer;
667 begin
668 Result := -1;
670 if SelectedObjects = nil then
671 Exit;
673 for a := 0 to High(SelectedObjects) do
674 if SelectedObjects[a].Live then
675 begin
676 Result := a;
677 Exit;
678 end;
679 end;
681 function Normalize16(x: Integer): Integer;
682 begin
683 Result := (x div 16) * 16;
684 end;
686 procedure MoveMap(X, Y: Integer);
687 var
688 rx, ry, ScaleSz: Integer;
689 begin
690 with MainForm.RenderPanel do
691 begin
692 ScaleSz := 16 div Scale;
693 // Размер видимой части карты:
694 rx := min(Normalize16(Width), Normalize16(gMapInfo.Width)) div 2;
695 ry := min(Normalize16(Height), Normalize16(gMapInfo.Height)) div 2;
696 // Место клика на мини-карте:
697 MapOffset.X := X - (Width-max(gMapInfo.Width div ScaleSz, 1)-1);
698 MapOffset.Y := Y - 1;
699 // Это же место на "большой" карте:
700 MapOffset.X := MapOffset.X * ScaleSz;
701 MapOffset.Y := MapOffset.Y * ScaleSz;
702 // Левый верхний угол новой видимой части карты:
703 MapOffset.X := MapOffset.X - rx;
704 MapOffset.Y := MapOffset.Y - ry;
705 // Выход за границы:
706 if MapOffset.X < 0 then
707 MapOffset.X := 0;
708 if MapOffset.Y < 0 then
709 MapOffset.Y := 0;
710 if MapOffset.X > MainForm.sbHorizontal.Max then
711 MapOffset.X := MainForm.sbHorizontal.Max;
712 if MapOffset.Y > MainForm.sbVertical.Max then
713 MapOffset.Y := MainForm.sbVertical.Max;
714 // Кратно 16:
715 MapOffset.X := Normalize16(MapOffset.X);
716 MapOffset.Y := Normalize16(MapOffset.Y);
717 end;
719 MainForm.sbHorizontal.Position := MapOffset.X;
720 MainForm.sbVertical.Position := MapOffset.Y;
722 MapOffset.X := -MapOffset.X;
723 MapOffset.Y := -MapOffset.Y;
725 MainForm.Resize();
726 end;
728 function IsTexturedPanel(PanelType: Word): Boolean;
729 begin
730 Result := WordBool(PanelType and (PANEL_WALL or PANEL_BACK or PANEL_FORE or
731 PANEL_STEP or PANEL_OPENDOOR or PANEL_CLOSEDOOR or
732 PANEL_WATER or PANEL_ACID1 or PANEL_ACID2));
733 end;
735 procedure FillProperty();
736 var
737 _id: DWORD;
738 str: String;
739 begin
740 MainForm.vleObjectProperty.Strings.Clear();
742 // Отображаем свойства если выделен только один объект:
743 if SelectedObjectCount() <> 1 then
744 Exit;
746 _id := GetFirstSelected();
747 if not SelectedObjects[_id].Live then
748 Exit;
750 with MainForm.vleObjectProperty do
751 with ItemProps[InsertRow(_lc[I_PROP_ID], IntToStr(SelectedObjects[_id].ID), True)] do
752 begin
753 EditStyle := esSimple;
754 ReadOnly := True;
755 end;
757 case SelectedObjects[0].ObjectType of
758 OBJECT_PANEL:
759 begin
760 with MainForm.vleObjectProperty,
761 gPanels[SelectedObjects[_id].ID] do
762 begin
763 with ItemProps[InsertRow(_lc[I_PROP_X], IntToStr(X), True)] do
764 begin
765 EditStyle := esSimple;
766 MaxLength := 5;
767 end;
769 with ItemProps[InsertRow(_lc[I_PROP_Y], IntToStr(Y), True)] do
770 begin
771 EditStyle := esSimple;
772 MaxLength := 5;
773 end;
775 with ItemProps[InsertRow(_lc[I_PROP_WIDTH], IntToStr(Width), True)] do
776 begin
777 EditStyle := esSimple;
778 MaxLength := 5;
779 end;
781 with ItemProps[InsertRow(_lc[I_PROP_HEIGHT], IntToStr(Height), True)] do
782 begin
783 EditStyle := esSimple;
784 MaxLength := 5;
785 end;
787 with ItemProps[InsertRow(_lc[I_PROP_PANEL_TYPE], GetPanelName(PanelType), True)] do
788 begin
789 EditStyle := esEllipsis;
790 ReadOnly := True;
791 end;
793 if IsTexturedPanel(PanelType) then
794 begin // Может быть текстура
795 with ItemProps[InsertRow(_lc[I_PROP_PANEL_TEX], TextureName, True)] do
796 begin
797 EditStyle := esEllipsis;
798 ReadOnly := True;
799 end;
801 if TextureName <> '' then
802 begin // Есть текстура
803 with ItemProps[InsertRow(_lc[I_PROP_PANEL_ALPHA], IntToStr(Alpha), True)] do
804 begin
805 EditStyle := esSimple;
806 MaxLength := 3;
807 end;
809 with ItemProps[InsertRow(_lc[I_PROP_PANEL_BLEND], BoolNames[Blending], True)] do
810 begin
811 EditStyle := esPickList;
812 ReadOnly := True;
813 end;
814 end;
815 end;
816 end;
817 end;
819 OBJECT_ITEM:
820 begin
821 with MainForm.vleObjectProperty,
822 gItems[SelectedObjects[_id].ID] do
823 begin
824 with ItemProps[InsertRow(_lc[I_PROP_X], IntToStr(X), True)] do
825 begin
826 EditStyle := esSimple;
827 MaxLength := 5;
828 end;
830 with ItemProps[InsertRow(_lc[I_PROP_Y], IntToStr(Y), True)] do
831 begin
832 EditStyle := esSimple;
833 MaxLength := 5;
834 end;
836 with ItemProps[InsertRow(_lc[I_PROP_DM_ONLY], BoolNames[OnlyDM], True)] do
837 begin
838 EditStyle := esPickList;
839 ReadOnly := True;
840 end;
842 with ItemProps[InsertRow(_lc[I_PROP_ITEM_FALLS], BoolNames[Fall], True)] do
843 begin
844 EditStyle := esPickList;
845 ReadOnly := True;
846 end;
847 end;
848 end;
850 OBJECT_MONSTER:
851 begin
852 with MainForm.vleObjectProperty,
853 gMonsters[SelectedObjects[_id].ID] do
854 begin
855 with ItemProps[InsertRow(_lc[I_PROP_X], IntToStr(X), True)] do
856 begin
857 EditStyle := esSimple;
858 MaxLength := 5;
859 end;
861 with ItemProps[InsertRow(_lc[I_PROP_Y], IntToStr(Y), True)] do
862 begin
863 EditStyle := esSimple;
864 MaxLength := 5;
865 end;
867 with ItemProps[InsertRow(_lc[I_PROP_DIRECTION], DirNames[Direction], True)] do
868 begin
869 EditStyle := esPickList;
870 ReadOnly := True;
871 end;
872 end;
873 end;
875 OBJECT_AREA:
876 begin
877 with MainForm.vleObjectProperty,
878 gAreas[SelectedObjects[_id].ID] do
879 begin
880 with ItemProps[InsertRow(_lc[I_PROP_X], IntToStr(X), True)] do
881 begin
882 EditStyle := esSimple;
883 MaxLength := 5;
884 end;
886 with ItemProps[InsertRow(_lc[I_PROP_Y], IntToStr(Y), True)] do
887 begin
888 EditStyle := esSimple;
889 MaxLength := 5;
890 end;
892 with ItemProps[InsertRow(_lc[I_PROP_DIRECTION], DirNames[Direction], True)] do
893 begin
894 EditStyle := esPickList;
895 ReadOnly := True;
896 end;
897 end;
898 end;
900 OBJECT_TRIGGER:
901 begin
902 with MainForm.vleObjectProperty,
903 gTriggers[SelectedObjects[_id].ID] do
904 begin
905 with ItemProps[InsertRow(_lc[I_PROP_TR_TYPE], GetTriggerName(TriggerType), True)] do
906 begin
907 EditStyle := esSimple;
908 ReadOnly := True;
909 end;
911 with ItemProps[InsertRow(_lc[I_PROP_X], IntToStr(X), True)] do
912 begin
913 EditStyle := esSimple;
914 MaxLength := 5;
915 end;
917 with ItemProps[InsertRow(_lc[I_PROP_Y], IntToStr(Y), True)] do
918 begin
919 EditStyle := esSimple;
920 MaxLength := 5;
921 end;
923 with ItemProps[InsertRow(_lc[I_PROP_WIDTH], IntToStr(Width), True)] do
924 begin
925 EditStyle := esSimple;
926 MaxLength := 5;
927 end;
929 with ItemProps[InsertRow(_lc[I_PROP_HEIGHT], IntToStr(Height), True)] do
930 begin
931 EditStyle := esSimple;
932 MaxLength := 5;
933 end;
935 with ItemProps[InsertRow(_lc[I_PROP_TR_ENABLED], BoolNames[Enabled], True)] do
936 begin
937 EditStyle := esPickList;
938 ReadOnly := True;
939 end;
941 with ItemProps[InsertRow(_lc[I_PROP_TR_TEXTURE_PANEL], IntToStr(TexturePanel), True)] do
942 begin
943 EditStyle := esEllipsis;
944 ReadOnly := True;
945 end;
947 with ItemProps[InsertRow(_lc[I_PROP_TR_ACTIVATION], ActivateToStr(ActivateType), True)] do
948 begin
949 EditStyle := esEllipsis;
950 ReadOnly := True;
951 end;
953 with ItemProps[InsertRow(_lc[I_PROP_TR_KEYS], KeyToStr(Key), True)] do
954 begin
955 EditStyle := esEllipsis;
956 ReadOnly := True;
957 end;
959 case TriggerType of
960 TRIGGER_EXIT:
961 begin
962 str := win2utf(Data.MapName);
963 with ItemProps[InsertRow(_lc[I_PROP_TR_NEXT_MAP], str, True)] do
964 begin
965 EditStyle := esEllipsis;
966 ReadOnly := True;
967 end;
968 end;
970 TRIGGER_TELEPORT:
971 begin
972 with ItemProps[InsertRow(_lc[I_PROP_TR_TELEPORT_TO], Format('(%d:%d)', [Data.TargetPoint.X, Data.TargetPoint.Y]), True)] do
973 begin
974 EditStyle := esEllipsis;
975 ReadOnly := True;
976 end;
978 with ItemProps[InsertRow(_lc[I_PROP_TR_D2D], BoolNames[Data.d2d_teleport], True)] do
979 begin
980 EditStyle := esPickList;
981 ReadOnly := True;
982 end;
984 with ItemProps[InsertRow(_lc[I_PROP_TR_TELEPORT_SILENT], BoolNames[Data.silent_teleport], True)] do
985 begin
986 EditStyle := esPickList;
987 ReadOnly := True;
988 end;
990 with ItemProps[InsertRow(_lc[I_PROP_TR_TELEPORT_DIR], DirNamesAdv[Data.TlpDir], True)] do
991 begin
992 EditStyle := esPickList;
993 ReadOnly := True;
994 end;
995 end;
997 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR,
998 TRIGGER_DOOR, TRIGGER_DOOR5:
999 begin
1000 with ItemProps[InsertRow(_lc[I_PROP_TR_DOOR_PANEL], IntToStr(Data.PanelID), True)] do
1001 begin
1002 EditStyle := esEllipsis;
1003 ReadOnly := True;
1004 end;
1006 with ItemProps[InsertRow(_lc[I_PROP_TR_SILENT], BoolNames[Data.NoSound], True)] do
1007 begin
1008 EditStyle := esPickList;
1009 ReadOnly := True;
1010 end;
1012 with ItemProps[InsertRow(_lc[I_PROP_TR_D2D], BoolNames[Data.d2d_doors], True)] do
1013 begin
1014 EditStyle := esPickList;
1015 ReadOnly := True;
1016 end;
1017 end;
1019 TRIGGER_CLOSETRAP, TRIGGER_TRAP:
1020 begin
1021 with ItemProps[InsertRow(_lc[I_PROP_TR_TRAP_PANEL], IntToStr(Data.PanelID), True)] do
1022 begin
1023 EditStyle := esEllipsis;
1024 ReadOnly := True;
1025 end;
1027 with ItemProps[InsertRow(_lc[I_PROP_TR_SILENT], BoolNames[Data.NoSound], True)] do
1028 begin
1029 EditStyle := esPickList;
1030 ReadOnly := True;
1031 end;
1033 with ItemProps[InsertRow(_lc[I_PROP_TR_D2D], BoolNames[Data.d2d_doors], True)] do
1034 begin
1035 EditStyle := esPickList;
1036 ReadOnly := True;
1037 end;
1038 end;
1040 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF,
1041 TRIGGER_ONOFF:
1042 begin
1043 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_AREA],
1044 Format('(%d:%d %d:%d)', [Data.tX, Data.tY, Data.tWidth, Data.tHeight]), True)] do
1045 begin
1046 EditStyle := esEllipsis;
1047 ReadOnly := True;
1048 end;
1050 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_DELAY], IntToStr(Data.Wait), True)] do
1051 begin
1052 EditStyle := esSimple;
1053 MaxLength := 5;
1054 end;
1056 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_COUNT], IntToStr(Data.Count), True)] do
1057 begin
1058 EditStyle := esSimple;
1059 MaxLength := 5;
1060 end;
1062 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_MONSTER], IntToStr(Data.MonsterID-1), True)] do
1063 begin
1064 EditStyle := esEllipsis;
1065 ReadOnly := True;
1066 end;
1068 if TriggerType = TRIGGER_PRESS then
1069 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_RANDOM], BoolNames[Data.ExtRandom], True)] do
1070 begin
1071 EditStyle := esPickList;
1072 ReadOnly := True;
1073 end;
1074 end;
1076 TRIGGER_SECRET:
1079 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
1080 begin
1081 with ItemProps[InsertRow(_lc[I_PROP_TR_LIFT_PANEL], IntToStr(Data.PanelID), True)] do
1082 begin
1083 EditStyle := esEllipsis;
1084 ReadOnly := True;
1085 end;
1087 with ItemProps[InsertRow(_lc[I_PROP_TR_SILENT], BoolNames[Data.NoSound], True)] do
1088 begin
1089 EditStyle := esPickList;
1090 ReadOnly := True;
1091 end;
1093 with ItemProps[InsertRow(_lc[I_PROP_TR_D2D], BoolNames[Data.d2d_doors], True)] do
1094 begin
1095 EditStyle := esPickList;
1096 ReadOnly := True;
1097 end;
1098 end;
1100 TRIGGER_TEXTURE:
1101 begin
1102 with ItemProps[InsertRow(_lc[I_PROP_TR_TEXTURE_ONCE], BoolNames[Data.ActivateOnce], True)] do
1103 begin
1104 EditStyle := esPickList;
1105 ReadOnly := True;
1106 end;
1108 with ItemProps[InsertRow(_lc[I_PROP_TR_TEXTURE_ANIM_ONCE], BoolNames[Data.AnimOnce], True)] do
1109 begin
1110 EditStyle := esPickList;
1111 ReadOnly := True;
1112 end;
1113 end;
1115 TRIGGER_SOUND:
1116 begin
1117 str := win2utf(Data.SoundName);
1118 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_NAME], str, True)] do
1119 begin
1120 EditStyle := esEllipsis;
1121 ReadOnly := True;
1122 end;
1124 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_VOLUME], IntToStr(Data.Volume), True)] do
1125 begin
1126 EditStyle := esSimple;
1127 MaxLength := 3;
1128 end;
1130 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_PAN], IntToStr(Data.Pan), True)] do
1131 begin
1132 EditStyle := esSimple;
1133 MaxLength := 3;
1134 end;
1136 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_COUNT], IntToStr(Data.PlayCount), True)] do
1137 begin
1138 EditStyle := esSimple;
1139 MaxLength := 3;
1140 end;
1142 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_LOCAL], BoolNames[Data.Local], True)] do
1143 begin
1144 EditStyle := esPickList;
1145 ReadOnly := True;
1146 end;
1148 with ItemProps[InsertRow(_lc[I_PROP_TR_SOUND_SWITCH], BoolNames[Data.SoundSwitch], True)] do
1149 begin
1150 EditStyle := esPickList;
1151 ReadOnly := True;
1152 end;
1153 end;
1155 TRIGGER_SPAWNMONSTER:
1156 begin
1157 with ItemProps[InsertRow(_lc[I_PROP_TR_MONSTER_TYPE], MonsterToStr(Data.MonType), True)] do
1158 begin
1159 EditStyle := esEllipsis;
1160 ReadOnly := True;
1161 end;
1163 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_TO],
1164 Format('(%d:%d)', [Data.MonPos.X, Data.MonPos.Y]), True)] do
1165 begin
1166 EditStyle := esEllipsis;
1167 ReadOnly := True;
1168 end;
1170 with ItemProps[InsertRow(_lc[I_PROP_DIRECTION], DirNames[TDirection(Data.MonDir)], True)] do
1171 begin
1172 EditStyle := esPickList;
1173 ReadOnly := True;
1174 end;
1176 with ItemProps[InsertRow(_lc[I_PROP_TR_HEALTH], IntToStr(Data.MonHealth), True)] do
1177 begin
1178 EditStyle := esSimple;
1179 MaxLength := 5;
1180 end;
1182 with ItemProps[InsertRow(_lc[I_PROP_TR_MONSTER_ACTIVE], BoolNames[Data.MonActive], True)] do
1183 begin
1184 EditStyle := esPickList;
1185 ReadOnly := True;
1186 end;
1188 with ItemProps[InsertRow(_lc[I_PROP_TR_COUNT], IntToStr(Data.MonCount), True)] do
1189 begin
1190 EditStyle := esSimple;
1191 MaxLength := 5;
1192 end;
1194 with ItemProps[InsertRow(_lc[I_PROP_TR_FX_TYPE], EffectToStr(Data.MonEffect), True)] do
1195 begin
1196 EditStyle := esEllipsis;
1197 ReadOnly := True;
1198 end;
1200 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_MAX], IntToStr(Data.MonMax), True)] do
1201 begin
1202 EditStyle := esSimple;
1203 MaxLength := 5;
1204 end;
1206 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_DELAY], IntToStr(Data.MonDelay), True)] do
1207 begin
1208 EditStyle := esSimple;
1209 MaxLength := 5;
1210 end;
1212 case Data.MonBehav of
1213 1: str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_1];
1214 2: str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_2];
1215 3: str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_3];
1216 4: str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_4];
1217 5: str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_5];
1218 else str := _lc[I_PROP_TR_MONSTER_BEHAVIOUR_0];
1219 end;
1220 with ItemProps[InsertRow(_lc[I_PROP_TR_MONSTER_BEHAVIOUR], str, True)] do
1221 begin
1222 EditStyle := esPickList;
1223 ReadOnly := True;
1224 end;
1225 end;
1227 TRIGGER_SPAWNITEM:
1228 begin
1229 with ItemProps[InsertRow(_lc[I_PROP_TR_ITEM_TYPE], ItemToStr(Data.ItemType), True)] do
1230 begin
1231 EditStyle := esEllipsis;
1232 ReadOnly := True;
1233 end;
1235 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_TO],
1236 Format('(%d:%d)', [Data.ItemPos.X, Data.ItemPos.Y]), True)] do
1237 begin
1238 EditStyle := esEllipsis;
1239 ReadOnly := True;
1240 end;
1242 with ItemProps[InsertRow(_lc[I_PROP_DM_ONLY], BoolNames[Data.ItemOnlyDM], True)] do
1243 begin
1244 EditStyle := esPickList;
1245 ReadOnly := True;
1246 end;
1248 with ItemProps[InsertRow(_lc[I_PROP_ITEM_FALLS], BoolNames[Data.ItemFalls], True)] do
1249 begin
1250 EditStyle := esPickList;
1251 ReadOnly := True;
1252 end;
1254 with ItemProps[InsertRow(_lc[I_PROP_TR_COUNT], IntToStr(Data.ItemCount), True)] do
1255 begin
1256 EditStyle := esSimple;
1257 MaxLength := 5;
1258 end;
1260 with ItemProps[InsertRow(_lc[I_PROP_TR_FX_TYPE], EffectToStr(Data.ItemEffect), True)] do
1261 begin
1262 EditStyle := esEllipsis;
1263 ReadOnly := True;
1264 end;
1266 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_MAX], IntToStr(Data.ItemMax), True)] do
1267 begin
1268 EditStyle := esSimple;
1269 MaxLength := 5;
1270 end;
1272 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_DELAY], IntToStr(Data.ItemDelay), True)] do
1273 begin
1274 EditStyle := esSimple;
1275 MaxLength := 5;
1276 end;
1277 end;
1279 TRIGGER_MUSIC:
1280 begin
1281 str := win2utf(Data.MusicName);
1282 with ItemProps[InsertRow(_lc[I_PROP_TR_MUSIC_NAME], str, True)] do
1283 begin
1284 EditStyle := esEllipsis;
1285 ReadOnly := True;
1286 end;
1288 if Data.MusicAction = 1 then
1289 str := _lc[I_PROP_TR_MUSIC_ON]
1290 else
1291 str := _lc[I_PROP_TR_MUSIC_OFF];
1293 with ItemProps[InsertRow(_lc[I_PROP_TR_MUSIC_ACT], str, True)] do
1294 begin
1295 EditStyle := esPickList;
1296 ReadOnly := True;
1297 end;
1298 end;
1300 TRIGGER_PUSH:
1301 begin
1302 with ItemProps[InsertRow(_lc[I_PROP_TR_PUSH_ANGLE], IntToStr(Data.PushAngle), True)] do
1303 begin
1304 EditStyle := esSimple;
1305 MaxLength := 4;
1306 end;
1307 with ItemProps[InsertRow(_lc[I_PROP_TR_PUSH_FORCE], IntToStr(Data.PushForce), True)] do
1308 begin
1309 EditStyle := esSimple;
1310 MaxLength := 4;
1311 end;
1312 with ItemProps[InsertRow(_lc[I_PROP_TR_PUSH_RESET], BoolNames[Data.ResetVel], True)] do
1313 begin
1314 EditStyle := esPickList;
1315 ReadOnly := True;
1316 end;
1317 end;
1319 TRIGGER_SCORE:
1320 begin
1321 case Data.ScoreAction of
1322 1: str := _lc[I_PROP_TR_SCORE_ACT_1];
1323 2: str := _lc[I_PROP_TR_SCORE_ACT_2];
1324 3: str := _lc[I_PROP_TR_SCORE_ACT_3];
1325 else str := _lc[I_PROP_TR_SCORE_ACT_0];
1326 end;
1327 with ItemProps[InsertRow(_lc[I_PROP_TR_SCORE_ACT], str, True)] do
1328 begin
1329 EditStyle := esPickList;
1330 ReadOnly := True;
1331 end;
1332 with ItemProps[InsertRow(_lc[I_PROP_TR_COUNT], IntToStr(Data.ScoreCount), True)] do
1333 begin
1334 EditStyle := esSimple;
1335 MaxLength := 3;
1336 end;
1337 case Data.ScoreTeam of
1338 1: str := _lc[I_PROP_TR_SCORE_TEAM_1];
1339 2: str := _lc[I_PROP_TR_SCORE_TEAM_2];
1340 3: str := _lc[I_PROP_TR_SCORE_TEAM_3];
1341 else str := _lc[I_PROP_TR_SCORE_TEAM_0];
1342 end;
1343 with ItemProps[InsertRow(_lc[I_PROP_TR_SCORE_TEAM], str, True)] do
1344 begin
1345 EditStyle := esPickList;
1346 ReadOnly := True;
1347 end;
1348 with ItemProps[InsertRow(_lc[I_PROP_TR_SCORE_CON], BoolNames[Data.ScoreCon], True)] do
1349 begin
1350 EditStyle := esPickList;
1351 ReadOnly := True;
1352 end;
1353 with ItemProps[InsertRow(_lc[I_PROP_TR_SCORE_MSG], BoolNames[Data.ScoreMsg], True)] do
1354 begin
1355 EditStyle := esPickList;
1356 ReadOnly := True;
1357 end;
1358 end;
1360 TRIGGER_MESSAGE:
1361 begin
1362 case Data.MessageKind of
1363 1: str := _lc[I_PROP_TR_MESSAGE_KIND_1];
1364 else str := _lc[I_PROP_TR_MESSAGE_KIND_0];
1365 end;
1366 with ItemProps[InsertRow(_lc[I_PROP_TR_MESSAGE_KIND], str, True)] do
1367 begin
1368 EditStyle := esPickList;
1369 ReadOnly := True;
1370 end;
1371 case Data.MessageSendTo of
1372 1: str := _lc[I_PROP_TR_MESSAGE_TO_1];
1373 2: str := _lc[I_PROP_TR_MESSAGE_TO_2];
1374 3: str := _lc[I_PROP_TR_MESSAGE_TO_3];
1375 4: str := _lc[I_PROP_TR_MESSAGE_TO_4];
1376 5: str := _lc[I_PROP_TR_MESSAGE_TO_5];
1377 else str := _lc[I_PROP_TR_MESSAGE_TO_0];
1378 end;
1379 with ItemProps[InsertRow(_lc[I_PROP_TR_MESSAGE_TO], str, True)] do
1380 begin
1381 EditStyle := esPickList;
1382 ReadOnly := True;
1383 end;
1384 str := win2utf(Data.MessageText);
1385 with ItemProps[InsertRow(_lc[I_PROP_TR_MESSAGE_TEXT], str, True)] do
1386 begin
1387 EditStyle := esSimple;
1388 MaxLength := 100;
1389 end;
1390 with ItemProps[InsertRow(_lc[I_PROP_TR_MESSAGE_TIME], IntToStr(Data.MessageTime), True)] do
1391 begin
1392 EditStyle := esSimple;
1393 MaxLength := 5;
1394 end;
1395 end;
1397 TRIGGER_DAMAGE:
1398 begin
1399 with ItemProps[InsertRow(_lc[I_PROP_TR_DAMAGE_VALUE], IntToStr(Data.DamageValue), True)] do
1400 begin
1401 EditStyle := esSimple;
1402 MaxLength := 5;
1403 end;
1404 with ItemProps[InsertRow(_lc[I_PROP_TR_INTERVAL], IntToStr(Data.DamageInterval), True)] do
1405 begin
1406 EditStyle := esSimple;
1407 MaxLength := 5;
1408 end;
1409 end;
1411 TRIGGER_HEALTH:
1412 begin
1413 with ItemProps[InsertRow(_lc[I_PROP_TR_HEALTH], IntToStr(Data.HealValue), True)] do
1414 begin
1415 EditStyle := esSimple;
1416 MaxLength := 5;
1417 end;
1418 with ItemProps[InsertRow(_lc[I_PROP_TR_INTERVAL], IntToStr(Data.HealInterval), True)] do
1419 begin
1420 EditStyle := esSimple;
1421 MaxLength := 5;
1422 end;
1423 with ItemProps[InsertRow(_lc[I_PROP_TR_HEALTH_MAX], BoolNames[Data.HealMax], True)] do
1424 begin
1425 EditStyle := esPickList;
1426 ReadOnly := True;
1427 end;
1428 with ItemProps[InsertRow(_lc[I_PROP_TR_SILENT], BoolNames[Data.HealSilent], True)] do
1429 begin
1430 EditStyle := esPickList;
1431 ReadOnly := True;
1432 end;
1433 end;
1435 TRIGGER_SHOT:
1436 begin
1437 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_TYPE], ShotToStr(Data.ShotType), True)] do
1438 begin
1439 EditStyle := esEllipsis;
1440 ReadOnly := True;
1441 end;
1443 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_SOUND], BoolNames[Data.ShotSound], True)] do
1444 begin
1445 EditStyle := esPickList;
1446 ReadOnly := True;
1447 end;
1449 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_PANEL], IntToStr(Data.ShotPanelID), True)] do
1450 begin
1451 EditStyle := esEllipsis;
1452 ReadOnly := True;
1453 end;
1455 case Data.ShotTarget of
1456 1: str := _lc[I_PROP_TR_SHOT_TO_1];
1457 2: str := _lc[I_PROP_TR_SHOT_TO_2];
1458 3: str := _lc[I_PROP_TR_SHOT_TO_3];
1459 4: str := _lc[I_PROP_TR_SHOT_TO_4];
1460 5: str := _lc[I_PROP_TR_SHOT_TO_5];
1461 6: str := _lc[I_PROP_TR_SHOT_TO_6];
1462 else str := _lc[I_PROP_TR_SHOT_TO_0];
1463 end;
1464 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_TO], str, True)] do
1465 begin
1466 EditStyle := esPickList;
1467 ReadOnly := True;
1468 end;
1470 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_SIGHT], IntToStr(Data.ShotIntSight), True)] do
1471 begin
1472 EditStyle := esSimple;
1473 MaxLength := 3;
1474 end;
1476 case Data.ShotAim of
1477 1: str := _lc[I_PROP_TR_SHOT_AIM_1];
1478 2: str := _lc[I_PROP_TR_SHOT_AIM_2];
1479 3: str := _lc[I_PROP_TR_SHOT_AIM_3];
1480 else str := _lc[I_PROP_TR_SHOT_AIM_0];
1481 end;
1482 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_AIM], str, True)-1] do
1483 begin
1484 EditStyle := esPickList;
1485 ReadOnly := True;
1486 end;
1488 with ItemProps[InsertRow(_lc[I_PROP_TR_SPAWN_TO],
1489 Format('(%d:%d)', [Data.ShotPos.X, Data.ShotPos.Y]), True)] do
1490 begin
1491 EditStyle := esEllipsis;
1492 ReadOnly := True;
1493 end;
1495 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_ANGLE], IntToStr(Data.ShotAngle), True)] do
1496 begin
1497 EditStyle := esSimple;
1498 MaxLength := 4;
1499 end;
1501 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_DELAY], IntToStr(Data.ShotWait), True)] do
1502 begin
1503 EditStyle := esSimple;
1504 MaxLength := 5;
1505 end;
1507 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_ACC], IntToStr(Data.ShotAccuracy), True)] do
1508 begin
1509 EditStyle := esSimple;
1510 MaxLength := 5;
1511 end;
1513 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_AMMO], IntToStr(Data.ShotAmmo), True)] do
1514 begin
1515 EditStyle := esSimple;
1516 MaxLength := 5;
1517 end;
1519 with ItemProps[InsertRow(_lc[I_PROP_TR_SHOT_RELOAD], IntToStr(Data.ShotIntReload), True)] do
1520 begin
1521 EditStyle := esSimple;
1522 MaxLength := 4;
1523 end;
1524 end;
1526 TRIGGER_EFFECT:
1527 begin
1528 with ItemProps[InsertRow(_lc[I_PROP_TR_COUNT], IntToStr(Data.FXCount), True)] do
1529 begin
1530 EditStyle := esSimple;
1531 MaxLength := 3;
1532 end;
1534 if Data.FXType = 0 then
1535 str := _lc[I_PROP_TR_EFFECT_PARTICLE]
1536 else
1537 str := _lc[I_PROP_TR_EFFECT_ANIMATION];
1538 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_TYPE], str, True)] do
1539 begin
1540 EditStyle := esEllipsis;
1541 ReadOnly := True;
1542 end;
1544 str := '';
1545 if Data.FXType = 0 then
1546 case Data.FXSubType of
1547 TRIGGER_EFFECT_SLIQUID:
1548 str := _lc[I_PROP_TR_EFFECT_SLIQUID];
1549 TRIGGER_EFFECT_LLIQUID:
1550 str := _lc[I_PROP_TR_EFFECT_LLIQUID];
1551 TRIGGER_EFFECT_DLIQUID:
1552 str := _lc[I_PROP_TR_EFFECT_DLIQUID];
1553 TRIGGER_EFFECT_BLOOD:
1554 str := _lc[I_PROP_TR_EFFECT_BLOOD];
1555 TRIGGER_EFFECT_SPARK:
1556 str := _lc[I_PROP_TR_EFFECT_SPARK];
1557 TRIGGER_EFFECT_BUBBLE:
1558 str := _lc[I_PROP_TR_EFFECT_BUBBLE];
1559 end;
1560 if Data.FXType = 1 then
1561 begin
1562 if (Data.FXSubType = 0) or (Data.FXSubType > EFFECT_FIRE) then
1563 Data.FXSubType := EFFECT_TELEPORT;
1564 str := EffectToStr(Data.FXSubType);
1565 end;
1566 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_SUBTYPE], str, True)] do
1567 begin
1568 EditStyle := esEllipsis;
1569 ReadOnly := True;
1570 end;
1572 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_COLOR], IntToStr(Data.FXColorR or (Data.FXColorG shl 8) or (Data.FXColorB shl 16)), True)] do
1573 begin
1574 EditStyle := esEllipsis;
1575 ReadOnly := True;
1576 end;
1578 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_CENTER], BoolNames[Data.FXPos = 0], True)] do
1579 begin
1580 EditStyle := esPickList;
1581 ReadOnly := True;
1582 end;
1584 with ItemProps[InsertRow(_lc[I_PROP_TR_EX_DELAY], IntToStr(Data.FXWait), True)] do
1585 begin
1586 EditStyle := esSimple;
1587 MaxLength := 5;
1588 end;
1590 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_VELX], IntToStr(Data.FXVelX), True)] do
1591 begin
1592 EditStyle := esSimple;
1593 MaxLength := 4;
1594 end;
1596 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_VELY], IntToStr(Data.FXVelY), True)] do
1597 begin
1598 EditStyle := esSimple;
1599 MaxLength := 4;
1600 end;
1602 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_SPL], IntToStr(Data.FXSpreadL), True)] do
1603 begin
1604 EditStyle := esSimple;
1605 MaxLength := 3;
1606 end;
1608 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_SPR], IntToStr(Data.FXSpreadR), True)] do
1609 begin
1610 EditStyle := esSimple;
1611 MaxLength := 3;
1612 end;
1614 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_SPU], IntToStr(Data.FXSpreadU), True)] do
1615 begin
1616 EditStyle := esSimple;
1617 MaxLength := 3;
1618 end;
1620 with ItemProps[InsertRow(_lc[I_PROP_TR_EFFECT_SPD], IntToStr(Data.FXSpreadD), True)] do
1621 begin
1622 EditStyle := esSimple;
1623 MaxLength := 3;
1624 end;
1625 end;
1626 end; //case TriggerType
1627 end;
1628 end; // OBJECT_TRIGGER:
1629 end;
1630 end;
1632 procedure ChangeShownProperty(Name: String; NewValue: String);
1633 var
1634 row: Integer;
1635 begin
1636 if SelectedObjectCount() <> 1 then
1637 Exit;
1638 if not SelectedObjects[GetFirstSelected()].Live then
1639 Exit;
1641 // Есть ли такой ключ:
1642 if MainForm.vleObjectProperty.FindRow(Name, row) then
1643 begin
1644 MainForm.vleObjectProperty.Values[Name] := NewValue;
1645 end;
1646 end;
1648 procedure SelectObject(fObjectType: Byte; fID: DWORD; Multi: Boolean);
1649 var
1650 a: Integer;
1651 b: Boolean;
1652 begin
1653 if Multi then
1654 begin
1655 b := False;
1657 // Уже выделен - убираем:
1658 if SelectedObjects <> nil then
1659 for a := 0 to High(SelectedObjects) do
1660 with SelectedObjects[a] do
1661 if Live and (ID = fID) and
1662 (ObjectType = fObjectType) then
1663 begin
1664 Live := False;
1665 b := True;
1666 end;
1668 if b then
1669 Exit;
1671 SetLength(SelectedObjects, Length(SelectedObjects)+1);
1673 with SelectedObjects[High(SelectedObjects)] do
1674 begin
1675 ObjectType := fObjectType;
1676 ID := fID;
1677 Live := True;
1678 end;
1679 end
1680 else // not Multi
1681 begin
1682 SetLength(SelectedObjects, 1);
1684 with SelectedObjects[0] do
1685 begin
1686 ObjectType := fObjectType;
1687 ID := fID;
1688 Live := True;
1689 end;
1690 end;
1692 MainForm.miCopy.Enabled := True;
1693 MainForm.miCut.Enabled := True;
1695 if fObjectType = OBJECT_PANEL then
1696 begin
1697 MainForm.miToFore.Enabled := True;
1698 MainForm.miToBack.Enabled := True;
1699 end;
1700 end;
1702 procedure RemoveSelectFromObjects();
1703 begin
1704 SelectedObjects := nil;
1705 DrawPressRect := False;
1706 MouseLDown := False;
1707 MouseRDown := False;
1708 MouseAction := MOUSEACTION_NONE;
1709 SelectFlag := SELECTFLAG_NONE;
1710 ResizeType := RESIZETYPE_NONE;
1711 ResizeDirection := RESIZEDIR_NONE;
1713 MainForm.vleObjectProperty.Strings.Clear();
1715 MainForm.miCopy.Enabled := False;
1716 MainForm.miCut.Enabled := False;
1717 MainForm.miToFore.Enabled := False;
1718 MainForm.miToBack.Enabled := False;
1719 end;
1721 procedure DeleteSelectedObjects();
1722 var
1723 i, a, ii: Integer;
1724 b: Boolean;
1725 begin
1726 if SelectedObjects = nil then
1727 Exit;
1729 b := False;
1730 i := 0;
1732 for a := 0 to High(SelectedObjects) do
1733 with SelectedObjects[a] do
1734 if Live then
1735 begin
1736 if not b then
1737 begin
1738 SetLength(UndoBuffer, Length(UndoBuffer)+1);
1739 i := High(UndoBuffer);
1740 b := True;
1741 end;
1743 SetLength(UndoBuffer[i], Length(UndoBuffer[i])+1);
1744 ii := High(UndoBuffer[i]);
1746 case ObjectType of
1747 OBJECT_PANEL:
1748 begin
1749 UndoBuffer[i, ii].UndoType := UNDO_DELETE_PANEL;
1750 New(UndoBuffer[i, ii].Panel);
1751 UndoBuffer[i, ii].Panel^ := gPanels[ID];
1752 end;
1753 OBJECT_ITEM:
1754 begin
1755 UndoBuffer[i, ii].UndoType := UNDO_DELETE_ITEM;
1756 UndoBuffer[i, ii].Item := gItems[ID];
1757 end;
1758 OBJECT_AREA:
1759 begin
1760 UndoBuffer[i, ii].UndoType := UNDO_DELETE_AREA;
1761 UndoBuffer[i, ii].Area := gAreas[ID];
1762 end;
1763 OBJECT_TRIGGER:
1764 begin
1765 UndoBuffer[i, ii].UndoType := UNDO_DELETE_TRIGGER;
1766 UndoBuffer[i, ii].Trigger := gTriggers[ID];
1767 end;
1768 end;
1770 RemoveObject(ID, ObjectType);
1771 end;
1773 RemoveSelectFromObjects();
1775 MainForm.miUndo.Enabled := UndoBuffer <> nil;
1776 end;
1778 procedure Undo_Add(ObjectType: Byte; ID: DWORD; Group: Boolean = False);
1779 var
1780 i, ii: Integer;
1781 begin
1782 if (not Group) or (Length(UndoBuffer) = 0) then
1783 SetLength(UndoBuffer, Length(UndoBuffer)+1);
1784 SetLength(UndoBuffer[High(UndoBuffer)], Length(UndoBuffer[High(UndoBuffer)])+1);
1785 i := High(UndoBuffer);
1786 ii := High(UndoBuffer[i]);
1788 case ObjectType of
1789 OBJECT_PANEL:
1790 UndoBuffer[i, ii].UndoType := UNDO_ADD_PANEL;
1791 OBJECT_ITEM:
1792 UndoBuffer[i, ii].UndoType := UNDO_ADD_ITEM;
1793 OBJECT_MONSTER:
1794 UndoBuffer[i, ii].UndoType := UNDO_ADD_MONSTER;
1795 OBJECT_AREA:
1796 UndoBuffer[i, ii].UndoType := UNDO_ADD_AREA;
1797 OBJECT_TRIGGER:
1798 UndoBuffer[i, ii].UndoType := UNDO_ADD_TRIGGER;
1799 end;
1801 UndoBuffer[i, ii].AddID := ID;
1803 MainForm.miUndo.Enabled := UndoBuffer <> nil;
1804 end;
1806 procedure FullClear();
1807 begin
1808 RemoveSelectFromObjects();
1809 ClearMap();
1810 LoadSky(gMapInfo.SkyName);
1811 UndoBuffer := nil;
1812 slInvalidTextures.Clear();
1813 MapCheckForm.lbErrorList.Clear();
1814 MapCheckForm.mErrorDescription.Clear();
1816 MainForm.miUndo.Enabled := False;
1817 MainForm.sbHorizontal.Position := 0;
1818 MainForm.sbVertical.Position := 0;
1819 MainForm.FormResize(nil);
1820 MainForm.Caption := FormCaption;
1821 OpenedMap := '';
1822 OpenedWAD := '';
1823 end;
1825 procedure ErrorMessageBox(str: String);
1826 begin
1827 MessageBox(0, PChar(str), PChar(_lc[I_MSG_ERROR]),
1828 MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
1829 end;
1831 function CheckProperty(): Boolean;
1832 var
1833 _id: Integer;
1834 begin
1835 Result := False;
1837 _id := GetFirstSelected();
1839 if SelectedObjects[_id].ObjectType = OBJECT_PANEL then
1840 with gPanels[SelectedObjects[_id].ID] do
1841 begin
1842 if TextureWidth <> 0 then
1843 if StrToIntDef(MainForm.vleObjectProperty.Values[_lc[I_PROP_WIDTH]], 1) mod TextureWidth <> 0 then
1844 begin
1845 ErrorMessageBox(Format(_lc[I_MSG_WRONG_TEXWIDTH],
1846 [TextureWidth]));
1847 Exit;
1848 end;
1850 if TextureHeight <> 0 then
1851 if StrToIntDef(Trim(MainForm.vleObjectProperty.Values[_lc[I_PROP_HEIGHT]]), 1) mod TextureHeight <> 0 then
1852 begin
1853 ErrorMessageBox(Format(_lc[I_MSG_WRONG_TEXHEIGHT],
1854 [TextureHeight]));
1855 Exit;
1856 end;
1858 if IsTexturedPanel(PanelType) and (TextureName <> '') then
1859 if not (StrToIntDef(MainForm.vleObjectProperty.Values[_lc[I_PROP_PANEL_ALPHA]], -1) in [0..255]) then
1860 begin
1861 ErrorMessageBox(_lc[I_MSG_WRONG_ALPHA]);
1862 Exit;
1863 end;
1864 end;
1866 if SelectedObjects[_id].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
1867 if (StrToIntDef(MainForm.vleObjectProperty.Values[_lc[I_PROP_WIDTH]], 0) <= 0) or
1868 (StrToIntDef(MainForm.vleObjectProperty.Values[_lc[I_PROP_HEIGHT]], 0) <= 0) then
1869 begin
1870 ErrorMessageBox(_lc[I_MSG_WRONG_SIZE]);
1871 Exit;
1872 end;
1874 if (Trim(MainForm.vleObjectProperty.Values[_lc[I_PROP_X]]) = '') or
1875 (Trim(MainForm.vleObjectProperty.Values[_lc[I_PROP_Y]]) = '') then
1876 begin
1877 ErrorMessageBox(_lc[I_MSG_WRONG_XY]);
1878 Exit;
1879 end;
1881 Result := True;
1882 end;
1884 procedure SelectTexture(ID: Integer);
1885 begin
1886 MainForm.lbTextureList.ItemIndex := ID;
1887 MainForm.lbTextureListClick(nil);
1888 end;
1890 function AddTexture(aWAD, aSection, aTex: String; silent: Boolean): Boolean;
1891 var
1892 a, FrameLen: Integer;
1893 ok: Boolean;
1894 FileName: String;
1895 ResourceName: String;
1896 FullResourceName: String;
1897 SectionName: String;
1898 Data: Pointer;
1899 Width, Height: Word;
1900 fn: String;
1901 begin
1902 Data := nil;
1903 FrameLen := 0;
1904 Width := 0;
1905 Height := 0;
1907 if aSection = '..' then
1908 SectionName := ''
1909 else
1910 SectionName := aSection;
1912 if aWAD = '' then
1913 aWAD := _lc[I_WAD_SPECIAL_MAP];
1915 if aWAD = _lc[I_WAD_SPECIAL_MAP] then
1916 begin // Файл карты
1917 g_ProcessResourceStr(OpenedMap, @fn, nil, nil);
1918 //FileName := EditorDir+'maps\'+ExtractFileName(fn);
1919 FileName := fn;
1920 ResourceName := ':'+SectionName+'\'+aTex;
1921 end
1922 else
1923 if aWAD = _lc[I_WAD_SPECIAL_TEXS] then
1924 begin // Спец. текстуры
1925 FileName := '';
1926 ResourceName := aTex;
1927 end
1928 else
1929 begin // Внешний WAD
1930 FileName := EditorDir+'wads/'+aWAD;
1931 ResourceName := aWAD+':'+SectionName+'\'+aTex;
1932 end;
1934 ok := True;
1936 // Есть ли уже такая текстура:
1937 for a := 0 to MainForm.lbTextureList.Items.Count-1 do
1938 if ResourceName = MainForm.lbTextureList.Items[a] then
1939 begin
1940 if not silent then
1941 ErrorMessageBox(Format(_lc[I_MSG_TEXTURE_ALREADY],
1942 [ResourceName]));
1943 ok := False;
1944 end;
1946 // Название ресурса <= 64 символов:
1947 if Length(ResourceName) > 64 then
1948 begin
1949 if not silent then
1950 ErrorMessageBox(Format(_lc[I_MSG_RES_NAME_64],
1951 [ResourceName]));
1952 ok := False;
1953 end;
1955 if ok then
1956 begin
1957 a := -1;
1958 if aWAD = _lc[I_WAD_SPECIAL_TEXS] then
1959 begin
1960 a := MainForm.lbTextureList.Items.Add(ResourceName);
1961 if not silent then
1962 SelectTexture(a);
1963 Result := True;
1964 Exit;
1965 end;
1967 FullResourceName := FileName+':'+SectionName+'\'+aTex;
1969 if IsAnim(FullResourceName) then
1970 begin // Аним. текстура
1971 GetFrame(FullResourceName, Data, FrameLen, Width, Height);
1973 if not g_CreateTextureMemorySize(Data, FrameLen, ResourceName, 0, 0, Width, Height, 1) then
1974 ok := False;
1975 a := MainForm.lbTextureList.Items.Add(ResourceName);
1976 end
1977 else // Обычная текстура
1978 begin
1979 if not g_CreateTextureWAD(ResourceName, FullResourceName) then
1980 ok := False;
1981 a := MainForm.lbTextureList.Items.Add(ResourceName);
1982 end;
1983 if (not ok) and (slInvalidTextures.IndexOf(ResourceName) = -1) then
1984 begin
1985 slInvalidTextures.Add(ResourceName);
1986 ok := True;
1987 end;
1988 if (a > -1) and (not silent) then
1989 SelectTexture(a);
1990 end;
1992 Result := ok;
1993 end;
1995 procedure UpdateCaption(sMap, sFile, sRes: String);
1996 begin
1997 with MainForm do
1998 if (sFile = '') and (sRes = '') and (sMap = '') then
1999 Caption := FormCaption
2000 else
2001 if sMap = '' then
2002 Caption := Format('%s - %s:%s', [FormCaption, sFile, sRes])
2003 else
2004 if (sFile <> '') and (sRes <> '') then
2005 Caption := Format('%s - %s (%s:%s)', [FormCaption, sMap, sFile, sRes])
2006 else
2007 Caption := Format('%s - %s', [FormCaption, sMap]);
2008 end;
2010 procedure OpenMap(FileName: String; mapN: String);
2011 var
2012 MapName: String;
2013 idx: Integer;
2014 begin
2015 SelectMapForm.Caption := _lc[I_CAP_OPEN];
2016 SelectMapForm.GetMaps(FileName);
2018 if (FileName = OpenedWAD) and
2019 (OpenedMap <> '') then
2020 begin
2021 MapName := OpenedMap;
2022 while (Pos(':\', MapName) > 0) do
2023 Delete(MapName, 1, Pos(':\', MapName) + 1);
2025 idx := SelectMapForm.lbMapList.Items.IndexOf(MapName);
2026 SelectMapForm.lbMapList.ItemIndex := idx;
2027 end
2028 else
2029 if SelectMapForm.lbMapList.Count > 0 then
2030 SelectMapForm.lbMapList.ItemIndex := 0
2031 else
2032 SelectMapForm.lbMapList.ItemIndex := -1;
2034 if mapN = '' then
2035 idx := -1
2036 else
2037 idx := SelectMapForm.lbMapList.Items.IndexOf(mapN);
2039 if idx < 0 then
2040 begin
2041 if (SelectMapForm.ShowModal() = mrOK) and
2042 (SelectMapForm.lbMapList.ItemIndex <> -1) then
2043 idx := SelectMapForm.lbMapList.ItemIndex
2044 else
2045 Exit;
2046 end;
2048 MapName := SelectMapForm.lbMapList.Items[idx];
2050 with MainForm do
2051 begin
2052 FullClear();
2054 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
2055 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
2056 pLoadProgress.Show();
2058 OpenedMap := FileName+':\'+MapName;
2059 OpenedWAD := FileName;
2061 idx := RecentFiles.IndexOf(OpenedMap);
2062 // Такая карта уже недавно открывалась:
2063 if idx >= 0 then
2064 RecentFiles.Delete(idx);
2065 RecentFiles.Insert(0, OpenedMap);
2066 RefreshRecentMenu();
2068 LoadMap(OpenedMap);
2070 pLoadProgress.Hide();
2071 FormResize(nil);
2073 lbTextureList.Sorted := True;
2074 lbTextureList.Sorted := False;
2076 UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName);
2077 end;
2078 end;
2080 procedure MoveSelectedObjects(Wall, alt: Boolean; dx, dy: Integer);
2081 var
2082 okX, okY: Boolean;
2083 a: Integer;
2084 begin
2085 if SelectedObjects = nil then
2086 Exit;
2088 okX := True;
2089 okY := True;
2091 if Wall then
2092 for a := 0 to High(SelectedObjects) do
2093 if SelectedObjects[a].Live then
2094 begin
2095 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, dx, 0) then
2096 okX := False;
2098 if ObjectCollideLevel(SelectedObjects[a].ID, SelectedObjects[a].ObjectType, 0, dy) then
2099 okY := False;
2101 if (not okX) or (not okY) then
2102 Break;
2103 end;
2105 if okX or okY then
2106 begin
2107 for a := 0 to High(SelectedObjects) do
2108 if SelectedObjects[a].Live then
2109 begin
2110 if okX then
2111 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, dx, 0);
2113 if okY then
2114 MoveObject(SelectedObjects[a].ObjectType, SelectedObjects[a].ID, 0, dy);
2116 if alt and (SelectedObjects[a].ObjectType = OBJECT_TRIGGER) then
2117 begin
2118 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_PRESS,
2119 TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF] then
2120 begin // Двигаем зону Расширителя
2121 if okX then
2122 gTriggers[SelectedObjects[a].ID].Data.tX := gTriggers[SelectedObjects[a].ID].Data.tX+dx;
2123 if okY then
2124 gTriggers[SelectedObjects[a].ID].Data.tY := gTriggers[SelectedObjects[a].ID].Data.tY+dy;
2125 end;
2127 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_TELEPORT] then
2128 begin // Двигаем точку назначения Телепорта
2129 if okX then
2130 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.X+dx;
2131 if okY then
2132 gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y := gTriggers[SelectedObjects[a].ID].Data.TargetPoint.Y+dy;
2133 end;
2135 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNMONSTER] then
2136 begin // Двигаем точку создания монстра
2137 if okX then
2138 gTriggers[SelectedObjects[a].ID].Data.MonPos.X := gTriggers[SelectedObjects[a].ID].Data.MonPos.X+dx;
2139 if okY then
2140 gTriggers[SelectedObjects[a].ID].Data.MonPos.Y := gTriggers[SelectedObjects[a].ID].Data.MonPos.Y+dy;
2141 end;
2143 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SPAWNITEM] then
2144 begin // Двигаем точку создания предмета
2145 if okX then
2146 gTriggers[SelectedObjects[a].ID].Data.ItemPos.X := gTriggers[SelectedObjects[a].ID].Data.ItemPos.X+dx;
2147 if okY then
2148 gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y := gTriggers[SelectedObjects[a].ID].Data.ItemPos.Y+dy;
2149 end;
2151 if gTriggers[SelectedObjects[a].ID].TriggerType in [TRIGGER_SHOT] then
2152 begin // Двигаем точку создания выстрела
2153 if okX then
2154 gTriggers[SelectedObjects[a].ID].Data.ShotPos.X := gTriggers[SelectedObjects[a].ID].Data.ShotPos.X+dx;
2155 if okY then
2156 gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y := gTriggers[SelectedObjects[a].ID].Data.ShotPos.Y+dy;
2157 end;
2158 end;
2159 end;
2161 LastMovePoint := MousePos;
2162 end;
2163 end;
2165 procedure ShowLayer(Layer: Byte; show: Boolean);
2166 begin
2167 LayerEnabled[Layer] := show;
2169 case Layer of
2170 LAYER_BACK:
2171 begin
2172 MainForm.miLayer1.Checked := show;
2173 MainForm.miLayerP1.Checked := show;
2174 end;
2175 LAYER_WALLS:
2176 begin
2177 MainForm.miLayer2.Checked := show;
2178 MainForm.miLayerP2.Checked := show;
2179 end;
2180 LAYER_FOREGROUND:
2181 begin
2182 MainForm.miLayer3.Checked := show;
2183 MainForm.miLayerP3.Checked := show;
2184 end;
2185 LAYER_STEPS:
2186 begin
2187 MainForm.miLayer4.Checked := show;
2188 MainForm.miLayerP4.Checked := show;
2189 end;
2190 LAYER_WATER:
2191 begin
2192 MainForm.miLayer5.Checked := show;
2193 MainForm.miLayerP5.Checked := show;
2194 end;
2195 LAYER_ITEMS:
2196 begin
2197 MainForm.miLayer6.Checked := show;
2198 MainForm.miLayerP6.Checked := show;
2199 end;
2200 LAYER_MONSTERS:
2201 begin
2202 MainForm.miLayer7.Checked := show;
2203 MainForm.miLayerP7.Checked := show;
2204 end;
2205 LAYER_AREAS:
2206 begin
2207 MainForm.miLayer8.Checked := show;
2208 MainForm.miLayerP8.Checked := show;
2209 end;
2210 LAYER_TRIGGERS:
2211 begin
2212 MainForm.miLayer9.Checked := show;
2213 MainForm.miLayerP9.Checked := show;
2214 end;
2215 end;
2217 RemoveSelectFromObjects();
2218 end;
2220 procedure SwitchLayer(Layer: Byte);
2221 begin
2222 ShowLayer(Layer, not LayerEnabled[Layer]);
2223 end;
2225 procedure SwitchMap();
2226 begin
2227 ShowMap := not ShowMap;
2228 MainForm.tbShowMap.Down := ShowMap;
2229 end;
2231 procedure ShowEdges();
2232 begin
2233 if drEdge[3] < 255 then
2234 drEdge[3] := 255
2235 else
2236 drEdge[3] := gAlphaEdge;
2237 end;
2239 function SelectedTexture(): String;
2240 begin
2241 if MainForm.lbTextureList.ItemIndex <> -1 then
2242 Result := MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]
2243 else
2244 Result := '';
2245 end;
2247 function IsSpecialTextureSel(): Boolean;
2248 begin
2249 Result := (MainForm.lbTextureList.ItemIndex <> -1) and
2250 IsSpecialTexture(MainForm.lbTextureList.Items[MainForm.lbTextureList.ItemIndex]);
2251 end;
2253 function CopyBufferToString(var CopyBuf: TCopyRecArray): String;
2254 var
2255 i, j: Integer;
2256 Res: String;
2258 procedure AddInt(x: Integer);
2259 begin
2260 Res := Res + IntToStr(x) + ' ';
2261 end;
2263 begin
2264 Result := '';
2266 if Length(CopyBuf) = 0 then
2267 Exit;
2269 Res := CLIPBOARD_SIG + ' ';
2271 for i := 0 to High(CopyBuf) do
2272 begin
2273 if (CopyBuf[i].ObjectType = OBJECT_PANEL) and
2274 (CopyBuf[i].Panel = nil) then
2275 Continue;
2277 // Тип объекта:
2278 AddInt(CopyBuf[i].ObjectType);
2279 Res := Res + '; ';
2281 // Свойства объекта:
2282 case CopyBuf[i].ObjectType of
2283 OBJECT_PANEL:
2284 with CopyBuf[i].Panel^ do
2285 begin
2286 AddInt(PanelType);
2287 AddInt(X);
2288 AddInt(Y);
2289 AddInt(Width);
2290 AddInt(Height);
2291 Res := Res + '"' + TextureName + '" ';
2292 AddInt(Alpha);
2293 AddInt(IfThen(Blending, 1, 0));
2294 end;
2296 OBJECT_ITEM:
2297 with CopyBuf[i].Item do
2298 begin
2299 AddInt(ItemType);
2300 AddInt(X);
2301 AddInt(Y);
2302 AddInt(IfThen(OnlyDM, 1, 0));
2303 AddInt(IfThen(Fall, 1, 0));
2304 end;
2306 OBJECT_MONSTER:
2307 with CopyBuf[i].Monster do
2308 begin
2309 AddInt(MonsterType);
2310 AddInt(X);
2311 AddInt(Y);
2312 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2313 end;
2315 OBJECT_AREA:
2316 with CopyBuf[i].Area do
2317 begin
2318 AddInt(AreaType);
2319 AddInt(X);
2320 AddInt(Y);
2321 AddInt(IfThen(Direction = D_LEFT, 1, 0));
2322 end;
2324 OBJECT_TRIGGER:
2325 with CopyBuf[i].Trigger do
2326 begin
2327 AddInt(TriggerType);
2328 AddInt(X);
2329 AddInt(Y);
2330 AddInt(Width);
2331 AddInt(Height);
2332 AddInt(ActivateType);
2333 AddInt(Key);
2334 AddInt(IfThen(Enabled, 1, 0));
2335 AddInt(TexturePanel);
2337 for j := 0 to 127 do
2338 AddInt(Data.Default[j]);
2339 end;
2340 end;
2341 end;
2343 Result := Res;
2344 end;
2346 procedure StringToCopyBuffer(Str: String; var CopyBuf: TCopyRecArray;
2347 var pmin: TPoint);
2348 var
2349 i, j, t: Integer;
2351 function GetNext(): String;
2352 var
2353 p: Integer;
2355 begin
2356 if Str[1] = '"' then
2357 begin
2358 Delete(Str, 1, 1);
2359 p := Pos('"', Str);
2361 if p = 0 then
2362 begin
2363 Result := Str;
2364 Str := '';
2365 end
2366 else
2367 begin
2368 Result := Copy(Str, 1, p-1);
2369 Delete(Str, 1, p);
2370 Str := Trim(Str);
2371 end;
2372 end
2373 else
2374 begin
2375 p := Pos(' ', Str);
2377 if p = 0 then
2378 begin
2379 Result := Str;
2380 Str := '';
2381 end
2382 else
2383 begin
2384 Result := Copy(Str, 1, p-1);
2385 Delete(Str, 1, p);
2386 Str := Trim(Str);
2387 end;
2388 end;
2389 end;
2391 begin
2392 Str := Trim(Str);
2394 if GetNext() <> CLIPBOARD_SIG then
2395 Exit;
2397 while Str <> '' do
2398 begin
2399 // Тип объекта:
2400 t := StrToIntDef(GetNext(), 0);
2402 if (t < OBJECT_PANEL) or (t > OBJECT_TRIGGER) or
2403 (GetNext() <> ';') then
2404 begin // Что-то не то => пропускаем:
2405 t := Pos(';', Str);
2406 Delete(Str, 1, t);
2407 Str := Trim(Str);
2409 Continue;
2410 end;
2412 i := Length(CopyBuf);
2413 SetLength(CopyBuf, i + 1);
2415 CopyBuf[i].ObjectType := t;
2416 CopyBuf[i].Panel := nil;
2418 // Свойства объекта:
2419 case t of
2420 OBJECT_PANEL:
2421 begin
2422 New(CopyBuf[i].Panel);
2424 with CopyBuf[i].Panel^ do
2425 begin
2426 PanelType := StrToIntDef(GetNext(), PANEL_WALL);
2427 X := StrToIntDef(GetNext(), 0);
2428 Y := StrToIntDef(GetNext(), 0);
2429 pmin.X := Min(X, pmin.X);
2430 pmin.Y := Min(Y, pmin.Y);
2431 Width := StrToIntDef(GetNext(), 16);
2432 Height := StrToIntDef(GetNext(), 16);
2433 TextureName := GetNext();
2434 Alpha := StrToIntDef(GetNext(), 0);
2435 Blending := (GetNext() = '1');
2436 end;
2437 end;
2439 OBJECT_ITEM:
2440 with CopyBuf[i].Item do
2441 begin
2442 ItemType := StrToIntDef(GetNext(), ITEM_MEDKIT_SMALL);
2443 X := StrToIntDef(GetNext(), 0);
2444 Y := StrToIntDef(GetNext(), 0);
2445 pmin.X := Min(X, pmin.X);
2446 pmin.Y := Min(Y, pmin.Y);
2447 OnlyDM := (GetNext() = '1');
2448 Fall := (GetNext() = '1');
2449 end;
2451 OBJECT_MONSTER:
2452 with CopyBuf[i].Monster do
2453 begin
2454 MonsterType := StrToIntDef(GetNext(), MONSTER_DEMON);
2455 X := StrToIntDef(GetNext(), 0);
2456 Y := StrToIntDef(GetNext(), 0);
2457 pmin.X := Min(X, pmin.X);
2458 pmin.Y := Min(Y, pmin.Y);
2460 if GetNext() = '1' then
2461 Direction := D_LEFT
2462 else
2463 Direction := D_RIGHT;
2464 end;
2466 OBJECT_AREA:
2467 with CopyBuf[i].Area do
2468 begin
2469 AreaType := StrToIntDef(GetNext(), AREA_PLAYERPOINT1);
2470 X := StrToIntDef(GetNext(), 0);
2471 Y := StrToIntDef(GetNext(), 0);
2472 pmin.X := Min(X, pmin.X);
2473 pmin.Y := Min(Y, pmin.Y);
2474 if GetNext() = '1' then
2475 Direction := D_LEFT
2476 else
2477 Direction := D_RIGHT;
2478 end;
2480 OBJECT_TRIGGER:
2481 with CopyBuf[i].Trigger do
2482 begin
2483 TriggerType := StrToIntDef(GetNext(), TRIGGER_EXIT);
2484 X := StrToIntDef(GetNext(), 0);
2485 Y := StrToIntDef(GetNext(), 0);
2486 pmin.X := Min(X, pmin.X);
2487 pmin.Y := Min(Y, pmin.Y);
2488 Width := StrToIntDef(GetNext(), 16);
2489 Height := StrToIntDef(GetNext(), 16);
2490 ActivateType := StrToIntDef(GetNext(), 0);
2491 Key := StrToIntDef(GetNext(), 0);
2492 Enabled := (GetNext() = '1');
2493 TexturePanel := StrToIntDef(GetNext(), 0);
2495 for j := 0 to 127 do
2496 Data.Default[j] := StrToIntDef(GetNext(), 0);
2498 case TriggerType of
2499 TRIGGER_TELEPORT:
2500 begin
2501 pmin.X := Min(Data.TargetPoint.X, pmin.X);
2502 pmin.Y := Min(Data.TargetPoint.Y, pmin.Y);
2503 end;
2504 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
2505 begin
2506 pmin.X := Min(Data.tX, pmin.X);
2507 pmin.Y := Min(Data.tY, pmin.Y);
2508 end;
2509 TRIGGER_SPAWNMONSTER:
2510 begin
2511 pmin.X := Min(Data.MonPos.X, pmin.X);
2512 pmin.Y := Min(Data.MonPos.Y, pmin.Y);
2513 end;
2514 TRIGGER_SPAWNITEM:
2515 begin
2516 pmin.X := Min(Data.ItemPos.X, pmin.X);
2517 pmin.Y := Min(Data.ItemPos.Y, pmin.Y);
2518 end;
2519 TRIGGER_SHOT:
2520 begin
2521 pmin.X := Min(Data.ShotPos.X, pmin.X);
2522 pmin.Y := Min(Data.ShotPos.Y, pmin.Y);
2523 end;
2524 end;
2525 end;
2526 end;
2527 end;
2528 end;
2530 //----------------------------------------
2531 //Закончились вспомогательные процедуры
2532 //----------------------------------------
2534 procedure TMainForm.RefreshRecentMenu();
2535 var
2536 i: Integer;
2537 MI: TMenuItem;
2538 begin
2539 // Лишние запомненные карты:
2540 while RecentFiles.Count > RecentCount do
2541 RecentFiles.Delete(RecentFiles.Count-1);
2543 // Лишние строки меню:
2544 while MainMenu.Items[0].Count > RECENT_FILES_MENU_START do
2545 MainMenu.Items[0].Delete(MainMenu.Items[0].Count-1);
2547 // Отделение списка карт от строки "Выход":
2548 if RecentFiles.Count > 0 then
2549 begin
2550 MI := TMenuItem.Create(MainMenu.Items[0]);
2551 MI.Caption := '-';
2552 MainMenu.Items[0].Add(MI);
2553 end;
2555 // Добавление в меню списка запомненных карт:
2556 for i := 0 to RecentFiles.Count-1 do
2557 begin
2558 MI := TMenuItem.Create(MainMenu.Items[0]);
2559 MI.Caption := IntToStr(i+1) + ' ' + RecentFiles[i];
2560 MI.OnClick := aRecentFileExecute;
2561 MainMenu.Items[0].Add(MI);
2562 end;
2563 end;
2565 procedure TMainForm.aRecentFileExecute(Sender: TObject);
2566 var
2567 n, pw: Integer;
2568 s, fn: String;
2569 b: Boolean;
2570 begin
2571 s := LowerCase((Sender as TMenuItem).Caption);
2572 Delete(s, Pos('&', s), 1);
2573 s := Trim(Copy(s, 1, 2));
2574 n := StrToIntDef(s, 0) - 1;
2576 if (n < 0) or (n >= RecentFiles.Count) then
2577 Exit;
2579 s := RecentFiles[n];
2580 pw := Pos('.wad:\', LowerCase(s));
2581 b := False;
2583 if pw > 0 then
2584 begin // Map name included
2585 fn := Copy(s, 1, pw + 3);
2586 Delete(s, 1, pw + 5);
2587 if (FileExists(fn)) then
2588 begin
2589 OpenMap(fn, s);
2590 b := True;
2591 end;
2592 end
2593 else // Only wad name
2594 if (FileExists(s)) then
2595 begin
2596 OpenMap(s, '');
2597 b := True;
2598 end;
2600 if (not b) and (MessageBox(0, PChar(_lc[I_MSG_DEL_RECENT_PROMT]),
2601 PChar(_lc[I_MSG_DEL_RECENT]), MB_ICONQUESTION or MB_YESNO) = idYes) then
2602 begin
2603 RecentFiles.Delete(n);
2604 RefreshRecentMenu();
2605 end;
2606 end;
2608 procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
2609 begin
2610 OptionsForm.ShowModal();
2611 end;
2613 procedure LoadStdFont(cfgres, texture: string; var FontID: DWORD);
2614 var
2615 cwdt, chgt: Byte;
2616 spc: ShortInt;
2617 ID: DWORD;
2618 wad: TWADEditor_1;
2619 cfgdata: Pointer;
2620 cfglen: Integer;
2621 config: TConfig;
2622 begin
2623 cfgdata := nil;
2624 cfglen := 0;
2625 ID := 0;
2627 wad := TWADEditor_1.Create;
2628 if wad.ReadFile(EditorDir+'data/Game.wad') then
2629 wad.GetResource('FONTS', cfgres, cfgdata, cfglen);
2630 wad.Free();
2632 if cfglen <> 0 then
2633 begin
2634 if not g_CreateTextureWAD('FONT_STD', EditorDir+'data/Game.wad:FONTS\'+texture) then
2635 e_WriteLog('ERROR ERROR ERROR', MSG_WARNING);
2637 config := TConfig.CreateMem(cfgdata, cfglen);
2638 cwdt := Min(Max(config.ReadInt('FontMap', 'CharWidth', 0), 0), 255);
2639 chgt := Min(Max(config.ReadInt('FontMap', 'CharHeight', 0), 0), 255);
2640 spc := Min(Max(config.ReadInt('FontMap', 'Kerning', 0), -128), 127);
2642 if g_GetTexture('FONT_STD', ID) then
2643 e_TextureFontBuild(ID, FontID, cwdt, chgt, spc-2);
2645 config.Free();
2646 end
2647 else
2648 e_WriteLog('Could not load FONT_STD', MSG_WARNING);
2650 if cfglen <> 0 then FreeMem(cfgdata);
2651 end;
2653 procedure TMainForm.FormCreate(Sender: TObject);
2654 var
2655 config: TConfig;
2656 i: Integer;
2657 s: String;
2658 begin
2659 Randomize();
2661 EditorDir := ExtractFilePath(Application.ExeName);
2663 e_InitLog(EditorDir+'Editor.log', WM_NEWFILE);
2665 slInvalidTextures := TStringList.Create;
2667 ShowLayer(LAYER_BACK, True);
2668 ShowLayer(LAYER_WALLS, True);
2669 ShowLayer(LAYER_FOREGROUND, True);
2670 ShowLayer(LAYER_STEPS, True);
2671 ShowLayer(LAYER_WATER, True);
2672 ShowLayer(LAYER_ITEMS, True);
2673 ShowLayer(LAYER_MONSTERS, True);
2674 ShowLayer(LAYER_AREAS, True);
2675 ShowLayer(LAYER_TRIGGERS, True);
2677 ClearMap();
2679 FormCaption := MainForm.Caption;
2680 OpenedMap := '';
2681 OpenedWAD := '';
2683 config := TConfig.CreateFile(EditorDir+'Editor.cfg');
2685 if config.ReadInt('Editor', 'XPos', -1) = -1 then
2686 Position := poDesktopCenter
2687 else begin
2688 Left := config.ReadInt('Editor', 'XPos', Left);
2689 Top := config.ReadInt('Editor', 'YPos', Top);
2690 Width := config.ReadInt('Editor', 'Width', Width);
2691 Height := config.ReadInt('Editor', 'Height', Height);
2692 end;
2693 if config.ReadBool('Editor', 'Maximize', False) then
2694 WindowState := wsMaximized;
2695 ShowMap := config.ReadBool('Editor', 'Minimap', False);
2696 PanelProps.Width := config.ReadInt('Editor', 'PanelProps', PanelProps.ClientWidth);
2697 Splitter1.Left := PanelProps.Left;
2698 PanelObjs.Height := config.ReadInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
2699 Splitter2.Top := PanelObjs.Top;
2700 StatusBar.Top := PanelObjs.BoundsRect.Bottom;
2701 DotEnable := config.ReadBool('Editor', 'DotEnable', True);
2702 DotColor := config.ReadInt('Editor', 'DotColor', $FFFFFF);
2703 DotStepOne := config.ReadInt('Editor', 'DotStepOne', 16);
2704 DotStepTwo := config.ReadInt('Editor', 'DotStepTwo', 8);
2705 DotStep := config.ReadInt('Editor', 'DotStep', DotStepOne);
2706 DrawTexturePanel := config.ReadBool('Editor', 'DrawTexturePanel', True);
2707 DrawPanelSize := config.ReadBool('Editor', 'DrawPanelSize', True);
2708 BackColor := config.ReadInt('Editor', 'BackColor', $7F6040);
2709 PreviewColor := config.ReadInt('Editor', 'PreviewColor', $00FF00);
2710 UseCheckerboard := config.ReadBool('Editor', 'UseCheckerboard', True);
2711 gColorEdge := config.ReadInt('Editor', 'EdgeColor', COLOR_EDGE);
2712 gAlphaEdge := config.ReadInt('Editor', 'EdgeAlpha', ALPHA_EDGE);
2713 if gAlphaEdge = 255 then
2714 gAlphaEdge := ALPHA_EDGE;
2715 drEdge[0] := GetRValue(gColorEdge);
2716 drEdge[1] := GetGValue(gColorEdge);
2717 drEdge[2] := GetBValue(gColorEdge);
2718 if not config.ReadBool('Editor', 'EdgeShow', True) then
2719 drEdge[3] := 255
2720 else
2721 drEdge[3] := gAlphaEdge;
2722 gAlphaTriggerLine := config.ReadInt('Editor', 'LineAlpha', ALPHA_LINE);
2723 if gAlphaTriggerLine = 255 then
2724 gAlphaTriggerLine := ALPHA_LINE;
2725 gAlphaTriggerArea := config.ReadInt('Editor', 'TriggerAlpha', ALPHA_AREA);
2726 if gAlphaTriggerArea = 255 then
2727 gAlphaTriggerArea := ALPHA_AREA;
2728 if config.ReadInt('Editor', 'Scale', 0) = 1 then
2729 Scale := 2
2730 else
2731 Scale := 1;
2732 if config.ReadInt('Editor', 'DotSize', 0) = 1 then
2733 DotSize := 2
2734 else
2735 DotSize := 1;
2736 OpenDialog.InitialDir := config.ReadStr('Editor', 'LastOpenDir', EditorDir);
2737 SaveDialog.InitialDir := config.ReadStr('Editor', 'LastSaveDir', EditorDir);
2739 s := config.ReadStr('Editor', 'Language', '');
2740 gLanguage := s;
2742 RecentCount := config.ReadInt('Editor', 'RecentCount', 5);
2743 if RecentCount > 10 then
2744 RecentCount := 10;
2745 if RecentCount < 2 then
2746 RecentCount := 2;
2748 RecentFiles := TStringList.Create();
2749 for i := 0 to RecentCount-1 do
2750 begin
2751 s := config.ReadStr('RecentFiles', IntToStr(i+1), '');
2752 if s <> '' then
2753 RecentFiles.Add(s);
2754 end;
2755 RefreshRecentMenu();
2757 config.Free();
2759 tbShowMap.Down := ShowMap;
2760 tbGridOn.Down := DotEnable;
2761 pcObjects.ActivePageIndex := 0;
2762 Application.Title := _lc[I_EDITOR_TITLE];
2764 Application.OnIdle := OnIdle;
2765 end;
2767 procedure PrintBlack(X, Y: Integer; Text: string; FontID: DWORD);
2768 begin
2769 // NOTE: all the font printing routines assume CP1251
2770 e_TextureFontPrintEx(X, Y, Text, FontID, 0, 0, 0, 1.0);
2771 end;
2773 procedure TMainForm.Draw();
2774 var
2775 x, y: Integer;
2776 a, b: Integer;
2777 ID, PID: DWORD;
2778 Width, Height: Word;
2779 Rect: TRectWH;
2780 ObjCount: Word;
2781 aX, aY, aX2, aY2, XX, ScaleSz: Integer;
2782 begin
2783 ID := 0;
2784 PID := 0;
2785 Width := 0;
2786 Height := 0;
2788 e_BeginRender();
2790 e_Clear(GL_COLOR_BUFFER_BIT,
2791 GetRValue(BackColor)/255,
2792 GetGValue(BackColor)/255,
2793 GetBValue(BackColor)/255);
2795 DrawMap();
2797 ObjCount := SelectedObjectCount();
2799 // Обводим выделенные объекты красной рамкой:
2800 if ObjCount > 0 then
2801 begin
2802 for a := 0 to High(SelectedObjects) do
2803 if SelectedObjects[a].Live then
2804 begin
2805 Rect := ObjectGetRect(SelectedObjects[a].ObjectType, SelectedObjects[a].ID);
2807 with Rect do
2808 begin
2809 e_DrawQuad(X+MapOffset.X, Y+MapOffset.Y,
2810 X+MapOffset.X+Width-1, Y+MapOffset.Y+Height-1,
2811 255, 0, 0);
2813 // Рисуем точки изменения размеров:
2814 if (ObjCount = 1) and
2815 (SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) then
2816 begin
2817 e_DrawPoint(5, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2818 e_DrawPoint(5, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 255, 255);
2819 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 255, 255);
2820 e_DrawPoint(5, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 255, 255);
2822 e_DrawPoint(3, X+MapOffset.X, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2823 e_DrawPoint(3, X+MapOffset.X+Width-1, Y+MapOffset.Y+(Height div 2), 255, 0, 0);
2824 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y, 255, 0, 0);
2825 e_DrawPoint(3, X+MapOffset.X+(Width div 2), Y+MapOffset.Y+Height-1, 255, 0, 0);
2826 end;
2827 end;
2828 end;
2829 end;
2831 // Рисуем сетку:
2832 if DotEnable and (PreviewMode = 0) then
2833 begin
2834 if DotSize = 2 then
2835 a := -1
2836 else
2837 a := 0;
2839 for x := 0 to (RenderPanel.Width div DotStep) do
2840 for y := 0 to (RenderPanel.Height div DotStep) do
2841 e_DrawPoint(DotSize, x*DotStep + a, y*DotStep + a,
2842 GetRValue(DotColor),
2843 GetGValue(DotColor),
2844 GetBValue(DotColor));
2845 end;
2847 // Превью текстуры:
2848 if (lbTextureList.ItemIndex <> -1) and (cbPreview.Checked) and
2849 (not IsSpecialTextureSel()) and (PreviewMode = 0) then
2850 begin
2851 if not g_GetTexture(SelectedTexture(), ID) then
2852 g_GetTexture('NOTEXTURE', ID);
2853 g_GetTextureSizeByID(ID, Width, Height);
2854 if UseCheckerboard then
2855 begin
2856 if g_GetTexture('PREVIEW', PID) then
2857 e_DrawFill(PID, RenderPanel.Width-Width, RenderPanel.Height-Height, Width div 16 + 1, Height div 16 + 1, 0, True, False);
2858 end else
2859 e_DrawFillQuad(RenderPanel.Width-Width-2, RenderPanel.Height-Height-2,
2860 RenderPanel.Width-1, RenderPanel.Height-1,
2861 GetRValue(PreviewColor), GetGValue(PreviewColor), GetBValue(PreviewColor), 0);
2862 e_Draw(ID, RenderPanel.Width-Width, RenderPanel.Height-Height, 0, True, False);
2863 end;
2865 // Подсказка при выборе точки Телепорта:
2866 if SelectFlag = SELECTFLAG_TELEPORT then
2867 begin
2868 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
2869 if Data.d2d_teleport then
2870 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
2871 MousePos.X+16, MousePos.Y-1,
2872 0, 0, 255)
2873 else
2874 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+AreaSize[AREA_DMPOINT].Width-1,
2875 MousePos.Y+AreaSize[AREA_DMPOINT].Height-1, 255, 255, 255);
2877 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
2878 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
2879 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_TELEPORT], gEditorFont);
2880 end;
2882 // Подсказка при выборе точки появления:
2883 if SelectFlag = SELECTFLAG_SPAWNPOINT then
2884 begin
2885 e_DrawLine(2, MousePos.X-16, MousePos.Y-1,
2886 MousePos.X+16, MousePos.Y-1,
2887 0, 0, 255);
2888 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
2889 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
2890 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_SPAWN], gEditorFont);
2891 end;
2893 // Подсказка при выборе панели двери:
2894 if SelectFlag = SELECTFLAG_DOOR then
2895 begin
2896 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
2897 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
2898 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_PANEL_DOOR], gEditorFont);
2899 end;
2901 // Подсказка при выборе панели с текстурой:
2902 if SelectFlag = SELECTFLAG_TEXTURE then
2903 begin
2904 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 192, 192, 192, 127);
2905 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+196, MousePos.Y+18, 255, 255, 255);
2906 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_PANEL_TEXTURE], gEditorFont);
2907 end;
2909 // Подсказка при выборе панели индикации выстрела:
2910 if SelectFlag = SELECTFLAG_SHOTPANEL then
2911 begin
2912 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 192, 192, 192, 127);
2913 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+316, MousePos.Y+18, 255, 255, 255);
2914 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_PANEL_SHOT], gEditorFont);
2915 end;
2917 // Подсказка при выборе панели лифта:
2918 if SelectFlag = SELECTFLAG_LIFT then
2919 begin
2920 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 192, 192, 192, 127);
2921 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+180, MousePos.Y+18, 255, 255, 255);
2922 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_PANEL_LIFT], gEditorFont);
2923 end;
2925 // Подсказка при выборе монстра:
2926 if SelectFlag = SELECTFLAG_MONSTER then
2927 begin
2928 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 192, 192, 192, 127);
2929 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+120, MousePos.Y+18, 255, 255, 255);
2930 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_MONSTER], gEditorFont);
2931 end;
2933 // Подсказка при выборе области воздействия:
2934 if DrawPressRect then
2935 begin
2936 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 192, 192, 192, 127);
2937 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+204, MousePos.Y+18, 255, 255, 255);
2938 PrintBlack(MousePos.X+2, MousePos.Y+2, _glc[I_HINT_EXT_AREA], gEditorFont);
2939 end;
2941 // Рисуем текстуры, если чертим панель:
2942 if (MouseAction = MOUSEACTION_DRAWPANEL) and (DrawTexturePanel) and
2943 (lbTextureList.ItemIndex <> -1) and (DrawRect <> nil) and
2944 (lbPanelType.ItemIndex in [0..8]) and not IsSpecialTextureSel() then
2945 begin
2946 if not g_GetTexture(SelectedTexture(), ID) then
2947 g_GetTexture('NOTEXTURE', ID);
2948 g_GetTextureSizeByID(ID, Width, Height);
2949 with DrawRect^ do
2950 e_DrawFill(ID, Min(Left, Right), Min(Top, Bottom), Abs(Right-Left) div Width,
2951 Abs(Bottom-Top) div Height, 0, True, False);
2952 end;
2954 // Прямоугольник выделения:
2955 if DrawRect <> nil then
2956 with DrawRect^ do
2957 e_DrawQuad(Left, Top, Right-1, Bottom-1, 255, 255, 255);
2959 // Чертим мышью панель/триггер или меняем мышью их размер:
2960 if (MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER, MOUSEACTION_RESIZE]) and
2961 (DrawPanelSize) then
2962 begin
2963 e_DrawFillQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 192, 192, 192, 127);
2964 e_DrawQuad(MousePos.X, MousePos.Y, MousePos.X+88, MousePos.Y+33, 255, 255, 255);
2966 if MouseAction in [MOUSEACTION_DRAWPANEL, MOUSEACTION_DRAWTRIGGER] then
2967 begin // Чертим новый
2968 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(_glc[I_HINT_WIDTH],
2969 [Abs(MousePos.X-MouseLDownPos.X)]), gEditorFont);
2970 PrintBlack(MousePos.X+2, MousePos.Y+14, Format(_glc[I_HINT_HEIGHT],
2971 [Abs(MousePos.Y-MouseLDownPos.Y)]), gEditorFont);
2972 end
2973 else // Растягиваем существующий
2974 if SelectedObjects[GetFirstSelected].ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER] then
2975 begin
2976 if SelectedObjects[GetFirstSelected].ObjectType = OBJECT_PANEL then
2977 begin
2978 Width := gPanels[SelectedObjects[GetFirstSelected].ID].Width;
2979 Height := gPanels[SelectedObjects[GetFirstSelected].ID].Height;
2980 end
2981 else
2982 begin
2983 Width := gTriggers[SelectedObjects[GetFirstSelected].ID].Width;
2984 Height := gTriggers[SelectedObjects[GetFirstSelected].ID].Height;
2985 end;
2987 PrintBlack(MousePos.X+2, MousePos.Y+2, Format(_glc[I_HINT_WIDTH], [Width]),
2988 gEditorFont);
2989 PrintBlack(MousePos.X+2, MousePos.Y+14, Format(_glc[I_HINT_HEIGHT], [Height]),
2990 gEditorFont);
2991 end;
2992 end;
2994 // Ближайшая к курсору мыши точка на сетке:
2995 e_DrawPoint(3, MousePos.X, MousePos.Y, 0, 0, 255);
2997 // Мини-карта:
2998 if ShowMap then
2999 begin
3000 // Сколько пикселов карты в 1 пикселе мини-карты:
3001 ScaleSz := 16 div Scale;
3002 // Размеры мини-карты:
3003 aX := max(gMapInfo.Width div ScaleSz, 1);
3004 aY := max(gMapInfo.Height div ScaleSz, 1);
3005 // X-координата на RenderPanel нулевой x-координаты карты:
3006 XX := RenderPanel.Width - aX - 1;
3007 // Рамка карты:
3008 e_DrawFillQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 0, 0, 0, 0);
3009 e_DrawQuad(XX-1, 0, RenderPanel.Width-1, aY+1, 197, 197, 197);
3011 if gPanels <> nil then
3012 begin
3013 // Рисуем панели:
3014 for a := 0 to High(gPanels) do
3015 with gPanels[a] do
3016 if PanelType <> 0 then
3017 begin
3018 // Левый верхний угол:
3019 aX := XX + (X div ScaleSz);
3020 aY := 1 + (Y div ScaleSz);
3021 // Размеры:
3022 aX2 := max(Width div ScaleSz, 1);
3023 aY2 := max(Height div ScaleSz, 1);
3024 // Правый нижний угол:
3025 aX2 := aX + aX2 - 1;
3026 aY2 := aY + aY2 - 1;
3028 case PanelType of
3029 PANEL_WALL: e_DrawFillQuad(aX, aY, aX2, aY2, 208, 208, 208, 0);
3030 PANEL_WATER: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 0, 192, 0);
3031 PANEL_ACID1: e_DrawFillQuad(aX, aY, aX2, aY2, 0, 176, 0, 0);
3032 PANEL_ACID2: e_DrawFillQuad(aX, aY, aX2, aY2, 176, 0, 0, 0);
3033 PANEL_STEP: e_DrawFillQuad(aX, aY, aX2, aY2, 128, 128, 128, 0);
3034 PANEL_LIFTUP: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 72, 36, 0);
3035 PANEL_LIFTDOWN: e_DrawFillQuad(aX, aY, aX2, aY2, 116, 124, 96, 0);
3036 PANEL_LIFTLEFT: e_DrawFillQuad(aX, aY, aX2, aY2, 200, 80, 4, 0);
3037 PANEL_LIFTRIGHT: e_DrawFillQuad(aX, aY, aX2, aY2, 252, 140, 56, 0);
3038 PANEL_OPENDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 100, 220, 92, 0);
3039 PANEL_CLOSEDOOR: e_DrawFillQuad(aX, aY, aX2, aY2, 212, 184, 64, 0);
3040 PANEL_BLOCKMON: e_DrawFillQuad(aX, aY, aX2, aY2, 192, 0, 192, 0);
3041 end;
3042 end;
3044 // Рисуем красным выделенные панели:
3045 if SelectedObjects <> nil then
3046 for b := 0 to High(SelectedObjects) do
3047 with SelectedObjects[b] do
3048 if Live and (ObjectType = OBJECT_PANEL) then
3049 with gPanels[SelectedObjects[b].ID] do
3050 if PanelType and not(PANEL_BACK or PANEL_FORE) <> 0 then
3051 begin
3052 // Левый верхний угол:
3053 aX := XX + (X div ScaleSz);
3054 aY := 1 + (Y div ScaleSz);
3055 // Размеры:
3056 aX2 := max(Width div ScaleSz, 1);
3057 aY2 := max(Height div ScaleSz, 1);
3058 // Правый нижний угол:
3059 aX2 := aX + aX2 - 1;
3060 aY2 := aY + aY2 - 1;
3062 e_DrawFillQuad(aX, aY, aX2, aY2, 255, 0, 0, 0)
3063 end;
3064 end;
3066 if (gMapInfo.Width > RenderPanel.Width) or
3067 (gMapInfo.Height > RenderPanel.Height) then
3068 begin
3069 // Окно, показывающее текущее положение экрана на карте:
3070 // Размеры окна:
3071 x := max(min(RenderPanel.Width, gMapInfo.Width) div ScaleSz, 1);
3072 y := max(min(RenderPanel.Height, gMapInfo.Height) div ScaleSz, 1);
3073 // Левый верхний угол:
3074 aX := XX + ((-MapOffset.X) div ScaleSz);
3075 aY := 1 + ((-MapOffset.Y) div ScaleSz);
3076 // Правый нижний угол:
3077 aX2 := aX + x - 1;
3078 aY2 := aY + y - 1;
3080 e_DrawFillQuad(aX, aY, aX2, aY2, 127, 192, 127, 127, B_BLEND);
3081 e_DrawQuad(aX, aY, aX2, aY2, 255, 0, 0);
3082 end;
3083 end; // Мини-карта
3085 e_EndRender();
3086 RenderPanel.SwapBuffers();
3087 end;
3089 procedure TMainForm.FormResize(Sender: TObject);
3090 begin
3091 e_SetViewPort(0, 0, RenderPanel.Width, RenderPanel.Height);
3093 if gMapInfo.Width >= RenderPanel.Width then
3094 sbHorizontal.Max := Normalize16(gMapInfo.Width-RenderPanel.Width+16)
3095 else
3096 sbHorizontal.Max := 0;
3098 if gMapInfo.Height >= RenderPanel.Height then
3099 sbVertical.Max := Normalize16(gMapInfo.Height-RenderPanel.Height+16)
3100 else
3101 sbVertical.Max := 0;
3103 MapOffset.X := -Normalize16(sbHorizontal.Position);
3104 MapOffset.Y := -Normalize16(sbVertical.Position);
3105 end;
3107 procedure SelectNextObject(X, Y: Integer; ObjectType: Byte; ID: DWORD);
3108 var
3109 j, j_max: Integer;
3110 res: Boolean;
3111 begin
3112 j_max := 0; // shut up compiler
3113 case ObjectType of
3114 OBJECT_PANEL:
3115 begin
3116 res := (gPanels <> nil) and
3117 PanelInShownLayer(gPanels[ID].PanelType) and
3118 g_CollidePoint(X, Y, gPanels[ID].X, gPanels[ID].Y,
3119 gPanels[ID].Width,
3120 gPanels[ID].Height);
3121 j_max := Length(gPanels) - 1;
3122 end;
3124 OBJECT_ITEM:
3125 begin
3126 res := (gItems <> nil) and
3127 LayerEnabled[LAYER_ITEMS] and
3128 g_CollidePoint(X, Y, gItems[ID].X, gItems[ID].Y,
3129 ItemSize[gItems[ID].ItemType][0],
3130 ItemSize[gItems[ID].ItemType][1]);
3131 j_max := Length(gItems) - 1;
3132 end;
3134 OBJECT_MONSTER:
3135 begin
3136 res := (gMonsters <> nil) and
3137 LayerEnabled[LAYER_MONSTERS] and
3138 g_CollidePoint(X, Y, gMonsters[ID].X, gMonsters[ID].Y,
3139 MonsterSize[gMonsters[ID].MonsterType].Width,
3140 MonsterSize[gMonsters[ID].MonsterType].Height);
3141 j_max := Length(gMonsters) - 1;
3142 end;
3144 OBJECT_AREA:
3145 begin
3146 res := (gAreas <> nil) and
3147 LayerEnabled[LAYER_AREAS] and
3148 g_CollidePoint(X, Y, gAreas[ID].X, gAreas[ID].Y,
3149 AreaSize[gAreas[ID].AreaType].Width,
3150 AreaSize[gAreas[ID].AreaType].Height);
3151 j_max := Length(gAreas) - 1;
3152 end;
3154 OBJECT_TRIGGER:
3155 begin
3156 res := (gTriggers <> nil) and
3157 LayerEnabled[LAYER_TRIGGERS] and
3158 g_CollidePoint(X, Y, gTriggers[ID].X, gTriggers[ID].Y,
3159 gTriggers[ID].Width,
3160 gTriggers[ID].Height);
3161 j_max := Length(gTriggers) - 1;
3162 end;
3164 else
3165 res := False;
3166 end;
3168 if not res then
3169 Exit;
3171 // Перебор ID: от ID-1 до 0; потом от High до ID+1:
3172 j := ID;
3174 while True do
3175 begin
3176 Dec(j);
3178 if j < 0 then
3179 j := j_max;
3180 if j = Integer(ID) then
3181 Break;
3183 case ObjectType of
3184 OBJECT_PANEL:
3185 res := PanelInShownLayer(gPanels[j].PanelType) and
3186 g_CollidePoint(X, Y, gPanels[j].X, gPanels[j].Y,
3187 gPanels[j].Width,
3188 gPanels[j].Height);
3189 OBJECT_ITEM:
3190 res := (gItems[j].ItemType <> ITEM_NONE) and
3191 g_CollidePoint(X, Y, gItems[j].X, gItems[j].Y,
3192 ItemSize[gItems[j].ItemType][0],
3193 ItemSize[gItems[j].ItemType][1]);
3194 OBJECT_MONSTER:
3195 res := (gMonsters[j].MonsterType <> MONSTER_NONE) and
3196 g_CollidePoint(X, Y, gMonsters[j].X, gMonsters[j].Y,
3197 MonsterSize[gMonsters[j].MonsterType].Width,
3198 MonsterSize[gMonsters[j].MonsterType].Height);
3199 OBJECT_AREA:
3200 res := (gAreas[j].AreaType <> AREA_NONE) and
3201 g_CollidePoint(X, Y, gAreas[j].X, gAreas[j].Y,
3202 AreaSize[gAreas[j].AreaType].Width,
3203 AreaSize[gAreas[j].AreaType].Height);
3204 OBJECT_TRIGGER:
3205 res := (gTriggers[j].TriggerType <> TRIGGER_NONE) and
3206 g_CollidePoint(X, Y, gTriggers[j].X, gTriggers[j].Y,
3207 gTriggers[j].Width,
3208 gTriggers[j].Height);
3209 else
3210 res := False;
3211 end;
3213 if res then
3214 begin
3215 SetLength(SelectedObjects, 1);
3217 SelectedObjects[0].ObjectType := ObjectType;
3218 SelectedObjects[0].ID := j;
3219 SelectedObjects[0].Live := True;
3221 FillProperty();
3222 Break;
3223 end;
3224 end;
3225 end;
3227 procedure TMainForm.RenderPanelMouseDown(Sender: TObject;
3228 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3229 var
3230 i: Integer;
3231 Rect: TRectWH;
3232 c1, c2, c3, c4: Boolean;
3233 item: TItem;
3234 area: TArea;
3235 monster: TMonster;
3236 IDArray: DWArray;
3237 begin
3238 MainForm.ActiveControl := RenderPanel;
3239 RenderPanel.SetFocus();
3241 RenderPanelMouseMove(RenderPanel, Shift, X, Y);
3243 if Button = mbLeft then // Left Mouse Button
3244 begin
3245 // Двигаем карту с помощью мыши и мини-карты:
3246 if ShowMap and
3247 g_CollidePoint(X, Y,
3248 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3249 1,
3250 max(gMapInfo.Width div (16 div Scale), 1),
3251 max(gMapInfo.Height div (16 div Scale), 1) ) then
3252 begin
3253 MoveMap(X, Y);
3254 MouseAction := MOUSEACTION_MOVEMAP;
3255 end
3256 else // Ставим предмет/монстра/область:
3257 if (pcObjects.ActivePageIndex in [1, 2, 3]) and
3258 (not (ssShift in Shift)) then
3259 begin
3260 case pcObjects.ActivePageIndex of
3261 1:
3262 if lbItemList.ItemIndex = -1 then
3263 ErrorMessageBox(_lc[I_MSG_CHOOSE_ITEM])
3264 else
3265 begin
3266 item.ItemType := lbItemList.ItemIndex + ITEM_MEDKIT_SMALL;
3267 if item.ItemType >= ITEM_WEAPON_KASTET then
3268 item.ItemType := item.ItemType + 2;
3269 item.X := MousePos.X-MapOffset.X;
3270 item.Y := MousePos.Y-MapOffset.Y;
3272 if not (ssCtrl in Shift) then
3273 begin
3274 item.X := item.X - (ItemSize[item.ItemType][0] div 2);
3275 item.Y := item.Y - ItemSize[item.ItemType][1];
3276 end;
3278 item.OnlyDM := cbOnlyDM.Checked;
3279 item.Fall := cbFall.Checked;
3280 Undo_Add(OBJECT_ITEM, AddItem(item));
3281 end;
3282 2:
3283 if lbMonsterList.ItemIndex = -1 then
3284 ErrorMessageBox(_lc[I_MSG_CHOOSE_MONSTER])
3285 else
3286 begin
3287 monster.MonsterType := lbMonsterList.ItemIndex + MONSTER_DEMON;
3288 monster.X := MousePos.X-MapOffset.X;
3289 monster.Y := MousePos.Y-MapOffset.Y;
3291 if not (ssCtrl in Shift) then
3292 begin
3293 monster.X := monster.X - (MonsterSize[monster.MonsterType].Width div 2);
3294 monster.Y := monster.Y - MonsterSize[monster.MonsterType].Height;
3295 end;
3297 if rbMonsterLeft.Checked then
3298 monster.Direction := D_LEFT
3299 else
3300 monster.Direction := D_RIGHT;
3301 Undo_Add(OBJECT_MONSTER, AddMonster(monster));
3302 end;
3303 3:
3304 if lbAreasList.ItemIndex = -1 then
3305 ErrorMessageBox(_lc[I_MSG_CHOOSE_AREA])
3306 else
3307 if (lbAreasList.ItemIndex + 1) <> AREA_DOMFLAG then
3308 begin
3309 area.AreaType := lbAreasList.ItemIndex + AREA_PLAYERPOINT1;
3310 area.X := MousePos.X-MapOffset.X;
3311 area.Y := MousePos.Y-MapOffset.Y;
3313 if not (ssCtrl in Shift) then
3314 begin
3315 area.X := area.X - (AreaSize[area.AreaType].Width div 2);
3316 area.Y := area.Y - AreaSize[area.AreaType].Height;
3317 end;
3319 if rbAreaLeft.Checked then
3320 area.Direction := D_LEFT
3321 else
3322 area.Direction := D_RIGHT;
3323 Undo_Add(OBJECT_AREA, AddArea(area));
3324 end;
3325 end;
3326 end
3327 else
3328 begin
3329 i := GetFirstSelected();
3331 // Выбираем объект под текущим:
3332 if (SelectedObjects <> nil) and
3333 (ssShift in Shift) and (i >= 0) and
3334 (SelectedObjects[i].Live) then
3335 begin
3336 if SelectedObjectCount() = 1 then
3337 SelectNextObject(X-MapOffset.X, Y-MapOffset.Y,
3338 SelectedObjects[i].ObjectType,
3339 SelectedObjects[i].ID);
3340 end
3341 else
3342 begin
3343 // Рисуем область триггера "Расширитель":
3344 if DrawPressRect and (i >= 0) and
3345 (SelectedObjects[i].ObjectType = OBJECT_TRIGGER) and
3346 (gTriggers[SelectedObjects[i].ID].TriggerType in
3347 [TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF]) then
3348 MouseAction := MOUSEACTION_DRAWPRESS
3349 else // Рисуем панель:
3350 if pcObjects.ActivePageIndex = 0 then
3351 begin
3352 if (lbPanelType.ItemIndex >= 0) then
3353 MouseAction := MOUSEACTION_DRAWPANEL
3354 end
3355 else // Рисуем триггер:
3356 if (lbTriggersList.ItemIndex >= 0) then
3357 begin
3358 MouseAction := MOUSEACTION_DRAWTRIGGER;
3359 end;
3360 end;
3361 end;
3362 end; // if Button = mbLeft
3364 if Button = mbRight then // Right Mouse Button
3365 begin
3366 // Клик по мини-карте:
3367 if ShowMap and
3368 g_CollidePoint(X, Y,
3369 RenderPanel.Width-max(gMapInfo.Width div (16 div Scale), 1)-1,
3370 1,
3371 max(gMapInfo.Width div (16 div Scale), 1),
3372 max(gMapInfo.Height div (16 div Scale), 1) ) then
3373 begin
3374 MouseAction := MOUSEACTION_NOACTION;
3375 end
3376 else // Нужно что-то выбрать мышью:
3377 if SelectFlag <> SELECTFLAG_NONE then
3378 begin
3379 case SelectFlag of
3380 SELECTFLAG_TELEPORT:
3381 // Точку назначения телепортации:
3382 with gTriggers[SelectedObjects[
3383 GetFirstSelected() ].ID].Data.TargetPoint do
3384 begin
3385 X := MousePos.X-MapOffset.X;
3386 Y := MousePos.Y-MapOffset.Y;
3387 end;
3389 SELECTFLAG_SPAWNPOINT:
3390 // Точку создания монстра:
3391 with gTriggers[SelectedObjects[GetFirstSelected()].ID] do
3392 if TriggerType = TRIGGER_SPAWNMONSTER then
3393 begin
3394 Data.MonPos.X := MousePos.X-MapOffset.X;
3395 Data.MonPos.Y := MousePos.Y-MapOffset.Y;
3396 end
3397 else if TriggerType = TRIGGER_SPAWNITEM then
3398 begin // Точка создания предмета:
3399 Data.ItemPos.X := MousePos.X-MapOffset.X;
3400 Data.ItemPos.Y := MousePos.Y-MapOffset.Y;
3401 end
3402 else if TriggerType = TRIGGER_SHOT then
3403 begin // Точка создания выстрела:
3404 Data.ShotPos.X := MousePos.X-MapOffset.X;
3405 Data.ShotPos.Y := MousePos.Y-MapOffset.Y;
3406 end;
3408 SELECTFLAG_DOOR:
3409 // Дверь:
3410 begin
3411 IDArray := ObjectInRect(X-MapOffset.X,
3412 Y-MapOffset.Y,
3413 2, 2, OBJECT_PANEL, True);
3414 if IDArray <> nil then
3415 begin
3416 for i := 0 to High(IDArray) do
3417 if (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3418 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR) then
3419 begin
3420 gTriggers[SelectedObjects[
3421 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3422 Break;
3423 end;
3424 end
3425 else
3426 gTriggers[SelectedObjects[
3427 GetFirstSelected() ].ID].Data.PanelID := -1;
3428 end;
3430 SELECTFLAG_TEXTURE:
3431 // Панель с текстурой:
3432 begin
3433 IDArray := ObjectInRect(X-MapOffset.X,
3434 Y-MapOffset.Y,
3435 2, 2, OBJECT_PANEL, True);
3436 if IDArray <> nil then
3437 begin
3438 for i := 0 to High(IDArray) do
3439 if ((gPanels[IDArray[i]].PanelType in
3440 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3441 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3442 PANEL_STEP]) or
3443 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3444 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3445 (gPanels[IDArray[i]].TextureName <> '') then
3446 begin
3447 gTriggers[SelectedObjects[
3448 GetFirstSelected() ].ID].TexturePanel := IDArray[i];
3449 Break;
3450 end;
3451 end
3452 else
3453 gTriggers[SelectedObjects[
3454 GetFirstSelected() ].ID].TexturePanel := -1;
3455 end;
3457 SELECTFLAG_LIFT:
3458 // Лифт:
3459 begin
3460 IDArray := ObjectInRect(X-MapOffset.X,
3461 Y-MapOffset.Y,
3462 2, 2, OBJECT_PANEL, True);
3463 if IDArray <> nil then
3464 begin
3465 for i := 0 to High(IDArray) do
3466 if (gPanels[IDArray[i]].PanelType = PANEL_LIFTUP) or
3467 (gPanels[IDArray[i]].PanelType = PANEL_LIFTDOWN) or
3468 (gPanels[IDArray[i]].PanelType = PANEL_LIFTLEFT) or
3469 (gPanels[IDArray[i]].PanelType = PANEL_LIFTRIGHT) then
3470 begin
3471 gTriggers[SelectedObjects[
3472 GetFirstSelected() ].ID].Data.PanelID := IDArray[i];
3473 Break;
3474 end;
3475 end
3476 else
3477 gTriggers[SelectedObjects[
3478 GetFirstSelected() ].ID].Data.PanelID := -1;
3479 end;
3481 SELECTFLAG_MONSTER:
3482 // Монстра:
3483 begin
3484 IDArray := ObjectInRect(X-MapOffset.X,
3485 Y-MapOffset.Y,
3486 2, 2, OBJECT_MONSTER, False);
3487 if IDArray <> nil then
3488 gTriggers[SelectedObjects[
3489 GetFirstSelected() ].ID].Data.MonsterID := IDArray[0]+1
3490 else
3491 gTriggers[SelectedObjects[
3492 GetFirstSelected() ].ID].Data.MonsterID := 0;
3493 end;
3495 SELECTFLAG_SHOTPANEL:
3496 // Панель индикации выстрела:
3497 begin
3498 if gTriggers[SelectedObjects[
3499 GetFirstSelected() ].ID].TriggerType = TRIGGER_SHOT then
3500 begin
3501 IDArray := ObjectInRect(X-MapOffset.X,
3502 Y-MapOffset.Y,
3503 2, 2, OBJECT_PANEL, True);
3504 if IDArray <> nil then
3505 begin
3506 for i := 0 to High(IDArray) do
3507 if ((gPanels[IDArray[i]].PanelType in
3508 [PANEL_WALL, PANEL_BACK, PANEL_FORE,
3509 PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
3510 PANEL_STEP]) or
3511 (gPanels[IDArray[i]].PanelType = PANEL_OPENDOOR) or
3512 (gPanels[IDArray[i]].PanelType = PANEL_CLOSEDOOR)) and
3513 (gPanels[IDArray[i]].TextureName <> '') then
3514 begin
3515 gTriggers[SelectedObjects[
3516 GetFirstSelected() ].ID].Data.ShotPanelID := IDArray[i];
3517 Break;
3518 end;
3519 end
3520 else
3521 gTriggers[SelectedObjects[
3522 GetFirstSelected() ].ID].Data.ShotPanelID := -1;
3523 end;
3524 end;
3525 end;
3527 SelectFlag := SELECTFLAG_SELECTED;
3528 end
3529 else // if SelectFlag <> SELECTFLAG_NONE...
3530 begin
3531 // Что уже выбрано и не нажат Ctrl:
3532 if (SelectedObjects <> nil) and
3533 (not (ssCtrl in Shift)) then
3534 for i := 0 to High(SelectedObjects) do
3535 with SelectedObjects[i] do
3536 if Live then
3537 begin
3538 if (ObjectType in [OBJECT_PANEL, OBJECT_TRIGGER]) and
3539 (SelectedObjectCount() = 1) then
3540 begin
3541 Rect := ObjectGetRect(ObjectType, ID);
3543 c1 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3544 Rect.X-2, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3545 c2 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3546 Rect.X+Rect.Width-3, Rect.Y+(Rect.Height div 2)-2, 4, 4);
3547 c3 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3548 Rect.X+(Rect.Width div 2)-2, Rect.Y-2, 4, 4);
3549 c4 := g_Collide(X-MapOffset.X-1, Y-MapOffset.Y-1, 2, 2,
3550 Rect.X+(Rect.Width div 2)-2, Rect.Y+Rect.Height-3, 4, 4);
3552 // Меняем размер панели или триггера:
3553 if c1 or c2 or c3 or c4 then
3554 begin
3555 MouseAction := MOUSEACTION_RESIZE;
3556 LastMovePoint := MousePos;
3558 if c1 or c2 then
3559 begin // Шире/уже
3560 ResizeType := RESIZETYPE_HORIZONTAL;
3561 if c1 then
3562 ResizeDirection := RESIZEDIR_LEFT
3563 else
3564 ResizeDirection := RESIZEDIR_RIGHT;
3565 RenderPanel.Cursor := crSizeWE;
3566 end
3567 else
3568 begin // Выше/ниже
3569 ResizeType := RESIZETYPE_VERTICAL;
3570 if c3 then
3571 ResizeDirection := RESIZEDIR_UP
3572 else
3573 ResizeDirection := RESIZEDIR_DOWN;
3574 RenderPanel.Cursor := crSizeNS;
3575 end;
3577 Break;
3578 end;
3579 end;
3581 // Перемещаем панель или триггер:
3582 if ObjectCollide(ObjectType, ID,
3583 X-MapOffset.X-1,
3584 Y-MapOffset.Y-1, 2, 2) then
3585 begin
3586 MouseAction := MOUSEACTION_MOVEOBJ;
3587 LastMovePoint := MousePos;
3589 Break;
3590 end;
3591 end;
3592 end;
3593 end; // if Button = mbRight
3595 MouseRDown := Button = mbRight;
3596 if MouseRDown then
3597 MouseRDownPos := MousePos;
3599 MouseLDown := Button = mbLeft;
3600 if MouseLDown then
3601 MouseLDownPos := MousePos;
3602 end;
3604 procedure TMainForm.RenderPanelMouseUp(Sender: TObject;
3605 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3606 var
3607 panel: TPanel;
3608 trigger: TTrigger;
3609 i: Integer;
3610 IDArray: DWArray;
3611 rRect: TRectWH;
3612 rSelectRect: Boolean;
3613 begin
3614 if Button = mbLeft then
3615 MouseLDown := False;
3616 if Button = mbRight then
3617 MouseRDown := False;
3619 DrawRect := nil;
3620 ResizeType := RESIZETYPE_NONE;
3622 if Button = mbLeft then // Left Mouse Button
3623 begin
3624 if MouseAction <> MOUSEACTION_NONE then
3625 begin // Было действие мышью
3626 // Мышь сдвинулась во время удержания клавиши:
3627 if (MousePos.X <> MouseLDownPos.X) and
3628 (MousePos.Y <> MouseLDownPos.Y) then
3629 case MouseAction of
3630 // Рисовали панель:
3631 MOUSEACTION_DRAWPANEL:
3632 begin
3633 // Фон или передний план без текстуры - ошибка:
3634 if (lbPanelType.ItemIndex in [1, 2]) and
3635 (lbTextureList.ItemIndex = -1) then
3636 ErrorMessageBox(_lc[I_MSG_CHOOSE_TEXTURE])
3637 else // Назначаем параметры панели:
3638 begin
3639 case lbPanelType.ItemIndex of
3640 0: Panel.PanelType := PANEL_WALL;
3641 1: Panel.PanelType := PANEL_BACK;
3642 2: Panel.PanelType := PANEL_FORE;
3643 3: Panel.PanelType := PANEL_OPENDOOR;
3644 4: Panel.PanelType := PANEL_CLOSEDOOR;
3645 5: Panel.PanelType := PANEL_STEP;
3646 6: Panel.PanelType := PANEL_WATER;
3647 7: Panel.PanelType := PANEL_ACID1;
3648 8: Panel.PanelType := PANEL_ACID2;
3649 9: Panel.PanelType := PANEL_LIFTUP;
3650 10: Panel.PanelType := PANEL_LIFTDOWN;
3651 11: Panel.PanelType := PANEL_LIFTLEFT;
3652 12: Panel.PanelType := PANEL_LIFTRIGHT;
3653 13: Panel.PanelType := PANEL_BLOCKMON;
3654 end;
3656 Panel.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3657 Panel.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3658 Panel.Width := Abs(MousePos.X-MouseLDownPos.X);
3659 Panel.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3661 // Лифты, блокМон или отсутствие текстуры - пустая текстура:
3662 if (lbPanelType.ItemIndex in [9, 10, 11, 12, 13]) or
3663 (lbTextureList.ItemIndex = -1) then
3664 begin
3665 Panel.TextureHeight := 1;
3666 Panel.TextureWidth := 1;
3667 Panel.TextureName := '';
3668 Panel.TextureID := TEXTURE_SPECIAL_NONE;
3669 end
3670 else // Есть текстура:
3671 begin
3672 Panel.TextureName := SelectedTexture();
3674 // Обычная текстура:
3675 if not IsSpecialTextureSel() then
3676 begin
3677 g_GetTextureSizeByName(Panel.TextureName,
3678 Panel.TextureWidth, Panel.TextureHeight);
3679 g_GetTexture(Panel.TextureName, Panel.TextureID);
3680 end
3681 else // Спец.текстура:
3682 begin
3683 Panel.TextureHeight := 1;
3684 Panel.TextureWidth := 1;
3685 Panel.TextureID := SpecialTextureID(SelectedTexture());
3686 end;
3687 end;
3689 Panel.Alpha := 0;
3690 Panel.Blending := False;
3692 Undo_Add(OBJECT_PANEL, AddPanel(Panel));
3693 end;
3694 end;
3696 // Рисовали триггер:
3697 MOUSEACTION_DRAWTRIGGER:
3698 begin
3699 trigger.X := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3700 trigger.Y := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3701 trigger.Width := Abs(MousePos.X-MouseLDownPos.X);
3702 trigger.Height := Abs(MousePos.Y-MouseLDownPos.Y);
3704 trigger.Enabled := True;
3705 trigger.TriggerType := lbTriggersList.ItemIndex+1;
3706 trigger.TexturePanel := -1;
3708 // Типы активации:
3709 trigger.ActivateType := 0;
3711 if clbActivationType.Checked[0] then
3712 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERCOLLIDE;
3713 if clbActivationType.Checked[1] then
3714 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERCOLLIDE;
3715 if clbActivationType.Checked[2] then
3716 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_PLAYERPRESS;
3717 if clbActivationType.Checked[3] then
3718 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_MONSTERPRESS;
3719 if clbActivationType.Checked[4] then
3720 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_SHOT;
3721 if clbActivationType.Checked[5] then
3722 trigger.ActivateType := Trigger.ActivateType or ACTIVATE_NOMONSTER;
3724 // Необходимые для активации ключи:
3725 trigger.Key := 0;
3727 if clbKeys.Checked[0] then
3728 trigger.Key := Trigger.Key or KEY_RED;
3729 if clbKeys.Checked[1] then
3730 trigger.Key := Trigger.Key or KEY_GREEN;
3731 if clbKeys.Checked[2] then
3732 trigger.Key := Trigger.Key or KEY_BLUE;
3733 if clbKeys.Checked[3] then
3734 trigger.Key := Trigger.Key or KEY_REDTEAM;
3735 if clbKeys.Checked[4] then
3736 trigger.Key := Trigger.Key or KEY_BLUETEAM;
3738 // Параметры триггера:
3739 FillByte(trigger.Data.Default[0], 128, 0);
3741 case trigger.TriggerType of
3742 // Переключаемая панель:
3743 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
3744 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
3745 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
3746 begin
3747 Trigger.Data.PanelID := -1;
3748 end;
3750 // Телепортация:
3751 TRIGGER_TELEPORT:
3752 begin
3753 trigger.Data.TargetPoint.X := trigger.X-64;
3754 trigger.Data.TargetPoint.Y := trigger.Y-64;
3755 trigger.Data.d2d_teleport := True;
3756 trigger.Data.TlpDir := 0;
3757 end;
3759 // Изменение других триггеров:
3760 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF,
3761 TRIGGER_ONOFF:
3762 begin
3763 trigger.Data.Count := 1;
3764 end;
3766 // Звук:
3767 TRIGGER_SOUND:
3768 begin
3769 trigger.Data.Volume := 255;
3770 trigger.Data.Pan := 127;
3771 trigger.Data.PlayCount := 1;
3772 trigger.Data.Local := True;
3773 trigger.Data.SoundSwitch := False;
3774 end;
3776 // Музыка:
3777 TRIGGER_MUSIC:
3778 begin
3779 trigger.Data.MusicAction := 1;
3780 end;
3782 // Создание монстра:
3783 TRIGGER_SPAWNMONSTER:
3784 begin
3785 trigger.Data.MonType := MONSTER_ZOMBY;
3786 trigger.Data.MonPos.X := trigger.X-64;
3787 trigger.Data.MonPos.Y := trigger.Y-64;
3788 trigger.Data.MonHealth := 0;
3789 trigger.Data.MonActive := False;
3790 trigger.Data.MonCount := 1;
3791 end;
3793 // Создание предмета:
3794 TRIGGER_SPAWNITEM:
3795 begin
3796 trigger.Data.ItemType := ITEM_AMMO_BULLETS;
3797 trigger.Data.ItemPos.X := trigger.X-64;
3798 trigger.Data.ItemPos.Y := trigger.Y-64;
3799 trigger.Data.ItemOnlyDM := False;
3800 trigger.Data.ItemFalls := False;
3801 trigger.Data.ItemCount := 1;
3802 trigger.Data.ItemMax := 0;
3803 trigger.Data.ItemDelay := 0;
3804 end;
3806 // Ускорение:
3807 TRIGGER_PUSH:
3808 begin
3809 trigger.Data.PushAngle := 90;
3810 trigger.Data.PushForce := 10;
3811 trigger.Data.ResetVel := True;
3812 end;
3814 TRIGGER_SCORE:
3815 begin
3816 trigger.Data.ScoreCount := 1;
3817 trigger.Data.ScoreCon := True;
3818 trigger.Data.ScoreMsg := True;
3819 end;
3821 TRIGGER_MESSAGE:
3822 begin
3823 trigger.Data.MessageKind := 0;
3824 trigger.Data.MessageSendTo := 0;
3825 trigger.Data.MessageText := '';
3826 trigger.Data.MessageTime := 144;
3827 end;
3829 TRIGGER_DAMAGE:
3830 begin
3831 trigger.Data.DamageValue := 5;
3832 trigger.Data.DamageInterval := 12;
3833 end;
3835 TRIGGER_HEALTH:
3836 begin
3837 trigger.Data.HealValue := 5;
3838 trigger.Data.HealInterval := 36;
3839 end;
3841 TRIGGER_SHOT:
3842 begin
3843 trigger.Data.ShotType := TRIGGER_SHOT_BULLET;
3844 trigger.Data.ShotSound := True;
3845 trigger.Data.ShotPanelID := -1;
3846 trigger.Data.ShotTarget := 0;
3847 trigger.Data.ShotIntSight := 0;
3848 trigger.Data.ShotAim := TRIGGER_SHOT_AIM_DEFAULT;
3849 trigger.Data.ShotPos.X := trigger.X-64;
3850 trigger.Data.ShotPos.Y := trigger.Y-64;
3851 trigger.Data.ShotAngle := 0;
3852 trigger.Data.ShotWait := 18;
3853 trigger.Data.ShotAccuracy := 0;
3854 trigger.Data.ShotAmmo := 0;
3855 trigger.Data.ShotIntReload := 0;
3856 end;
3858 TRIGGER_EFFECT:
3859 begin
3860 trigger.Data.FXCount := 1;
3861 trigger.Data.FXType := TRIGGER_EFFECT_PARTICLE;
3862 trigger.Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
3863 trigger.Data.FXColorR := 0;
3864 trigger.Data.FXColorG := 0;
3865 trigger.Data.FXColorB := 255;
3866 trigger.Data.FXPos := TRIGGER_EFFECT_POS_CENTER;
3867 trigger.Data.FXWait := 1;
3868 trigger.Data.FXVelX := 0;
3869 trigger.Data.FXVelY := -20;
3870 trigger.Data.FXSpreadL := 5;
3871 trigger.Data.FXSpreadR := 5;
3872 trigger.Data.FXSpreadU := 4;
3873 trigger.Data.FXSpreadD := 0;
3874 end;
3875 end;
3877 Undo_Add(OBJECT_TRIGGER, AddTrigger(trigger));
3878 end;
3880 // Рисовали область триггера "Расширитель":
3881 MOUSEACTION_DRAWPRESS:
3882 with gTriggers[SelectedObjects[GetFirstSelected].ID] do
3883 begin
3884 Data.tX := Min(MousePos.X-MapOffset.X, MouseLDownPos.X-MapOffset.X);
3885 Data.tY := Min(MousePos.Y-MapOffset.Y, MouseLDownPos.Y-MapOffset.Y);
3886 Data.tWidth := Abs(MousePos.X-MouseLDownPos.X);
3887 Data.tHeight := Abs(MousePos.Y-MouseLDownPos.Y);
3889 DrawPressRect := False;
3890 end;
3891 end;
3893 MouseAction := MOUSEACTION_NONE;
3894 end;
3895 end // if Button = mbLeft...
3896 else // Right Mouse Button:
3897 begin
3898 if MouseAction = MOUSEACTION_NOACTION then
3899 begin
3900 MouseAction := MOUSEACTION_NONE;
3901 Exit;
3902 end;
3904 // Объект передвинут или изменен в размере:
3905 if MouseAction in [MOUSEACTION_MOVEOBJ, MOUSEACTION_RESIZE] then
3906 begin
3907 MouseAction := MOUSEACTION_NONE;
3908 FillProperty();
3909 Exit;
3910 end;
3912 // Еще не все выбрали:
3913 if SelectFlag <> SELECTFLAG_NONE then
3914 begin
3915 if SelectFlag = SELECTFLAG_SELECTED then
3916 SelectFlag := SELECTFLAG_NONE;
3917 FillProperty();
3918 Exit;
3919 end;
3921 // Мышь сдвинулась во время удержания клавиши:
3922 if (MousePos.X <> MouseRDownPos.X) and
3923 (MousePos.Y <> MouseRDownPos.Y) then
3924 begin
3925 rSelectRect := True;
3927 rRect.X := Min(MousePos.X, MouseRDownPos.X)-MapOffset.X;
3928 rRect.Y := Min(MousePos.Y, MouseRDownPos.Y)-MapOffset.Y;
3929 rRect.Width := Abs(MousePos.X-MouseRDownPos.X);
3930 rRect.Height := Abs(MousePos.Y-MouseRDownPos.Y);
3931 end
3932 else // Мышь не сдвинулась - нет прямоугольника:
3933 begin
3934 rSelectRect := False;
3936 rRect.X := X-MapOffset.X-1;
3937 rRect.Y := Y-MapOffset.Y-1;
3938 rRect.Width := 2;
3939 rRect.Height := 2;
3940 end;
3942 // Если зажат Ctrl - выделять еще, иначе только один выделенный объект:
3943 if not (ssCtrl in Shift) then
3944 RemoveSelectFromObjects();
3946 // Выделяем всё в выбранном прямоугольнике:
3947 IDArray := ObjectInRect(rRect.X, rRect.Y,
3948 rRect.Width, rRect.Height,
3949 pcObjects.ActivePageIndex+1, rSelectRect);
3951 if IDArray <> nil then
3952 for i := 0 to High(IDArray) do
3953 SelectObject(pcObjects.ActivePageIndex+1, IDArray[i],
3954 (ssCtrl in Shift) or rSelectRect);
3956 FillProperty();
3957 end;
3958 end;
3960 procedure TMainForm.RenderPanelPaint(Sender: TObject);
3961 begin
3962 Draw();
3963 end;
3965 procedure TMainForm.RenderPanelMouseMove(Sender: TObject;
3966 Shift: TShiftState; X, Y: Integer);
3967 var
3968 sX, sY: Integer;
3969 dWidth, dHeight: Integer;
3970 _id: Integer;
3971 begin
3972 _id := GetFirstSelected();
3974 // Рисуем панель с текстурой, сетка - размеры текстуры:
3975 if (MouseAction = MOUSEACTION_DRAWPANEL) and
3976 (lbPanelType.ItemIndex in [0..8]) and
3977 (lbTextureList.ItemIndex <> -1) and
3978 (not IsSpecialTextureSel()) then
3979 begin
3980 sX := StrToIntDef(lTextureWidth.Caption, DotStep);
3981 sY := StrToIntDef(lTextureHeight.Caption, DotStep);
3982 end
3983 else
3984 // Меняем размер панели с текстурой, сетка - размеры текстуры:
3985 if (MouseAction = MOUSEACTION_RESIZE) and
3986 ( (SelectedObjects[_id].ObjectType = OBJECT_PANEL) and
3987 IsTexturedPanel(gPanels[SelectedObjects[_id].ID].PanelType) and
3988 (gPanels[SelectedObjects[_id].ID].TextureName <> '') and
3989 (not IsSpecialTexture(gPanels[SelectedObjects[_id].ID].TextureName)) ) then
3990 begin
3991 sX := gPanels[SelectedObjects[_id].ID].TextureWidth;
3992 sY := gPanels[SelectedObjects[_id].ID].TextureHeight;
3993 end
3994 else
3995 // Выравнивание по сетке:
3996 if SnapToGrid then
3997 begin
3998 sX := DotStep;
3999 sY := DotStep;
4000 end
4001 else // Нет выравнивания по сетке:
4002 begin
4003 sX := 1;
4004 sY := 1;
4005 end;
4007 // Новая позиция мыши:
4008 if MouseLDown then
4009 begin // Зажата левая кнопка мыши
4010 MousePos.X := (Round((X-MouseLDownPos.X)/sX)*sX)+MouseLDownPos.X;
4011 MousePos.Y := (Round((Y-MouseLDownPos.Y)/sY)*sY)+MouseLDownPos.Y;
4012 end
4013 else
4014 if MouseRDown then
4015 begin // Зажата правая кнопка мыши
4016 MousePos.X := (Round((X-MouseRDownPos.X)/sX)*sX)+MouseRDownPos.X;
4017 MousePos.Y := (Round((Y-MouseRDownPos.Y)/sY)*sY)+MouseRDownPos.Y;
4018 end
4019 else
4020 begin // Кнопки мыши не зажаты
4021 MousePos.X := (Round(X/sX)*sX);
4022 MousePos.Y := (Round(Y/sY)*sY);
4023 end;
4025 // Изменение размера закончилось - ставим обычный курсор:
4026 if ResizeType = RESIZETYPE_NONE then
4027 RenderPanel.Cursor := crDefault;
4029 // Зажата только правая кнопка мыши:
4030 if (not MouseLDown) and (MouseRDown) then
4031 begin
4032 // Рисуем прямоугольник выделения:
4033 if MouseAction = MOUSEACTION_NONE then
4034 begin
4035 if DrawRect = nil then
4036 New(DrawRect);
4037 DrawRect.Top := MouseRDownPos.y;
4038 DrawRect.Left := MouseRDownPos.x;
4039 DrawRect.Bottom := MousePos.y;
4040 DrawRect.Right := MousePos.x;
4041 end
4042 else
4043 // Двигаем выделенные объекты:
4044 if MouseAction = MOUSEACTION_MOVEOBJ then
4045 begin
4046 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift,
4047 MousePos.X-LastMovePoint.X+WASDOffset.X,
4048 MousePos.Y-LastMovePoint.Y+WASDOffset.Y);
4049 WASDOffset.X := 0;
4050 WASDOffset.Y := 0;
4051 end
4052 else
4053 // Меняем размер выделенного объекта:
4054 if MouseAction = MOUSEACTION_RESIZE then
4055 begin
4056 if (SelectedObjectCount = 1) and
4057 (SelectedObjects[GetFirstSelected].Live) then
4058 begin
4059 dWidth := MousePos.X-LastMovePoint.X+WASDOffset.X;
4060 dHeight := MousePos.Y-LastMovePoint.Y+WASDOffset.Y;
4061 WASDOffset.X := 0;
4062 WASDOffset.Y := 0;
4064 case ResizeType of
4065 RESIZETYPE_VERTICAL: dWidth := 0;
4066 RESIZETYPE_HORIZONTAL: dHeight := 0;
4067 end;
4069 case ResizeDirection of
4070 RESIZEDIR_UP: dHeight := -dHeight;
4071 RESIZEDIR_LEFT: dWidth := -dWidth;
4072 end;
4074 ResizeObject(SelectedObjects[GetFirstSelected].ObjectType,
4075 SelectedObjects[GetFirstSelected].ID,
4076 dWidth, dHeight, ResizeDirection);
4078 LastMovePoint := MousePos;
4079 end;
4080 end;
4081 end;
4083 // Зажата только левая кнопка мыши:
4084 if (not MouseRDown) and (MouseLDown) then
4085 begin
4086 // Рисуем прямоугольник планирования панели:
4087 if MouseAction in [MOUSEACTION_DRAWPANEL,
4088 MOUSEACTION_DRAWTRIGGER,
4089 MOUSEACTION_DRAWPRESS] then
4090 begin
4091 if DrawRect = nil then
4092 New(DrawRect);
4093 DrawRect.Top := MouseLDownPos.y;
4094 DrawRect.Left := MouseLDownPos.x;
4095 DrawRect.Bottom := MousePos.y;
4096 DrawRect.Right := MousePos.x;
4097 end
4098 else // Двигаем карту:
4099 if MouseAction = MOUSEACTION_MOVEMAP then
4100 begin
4101 MoveMap(X, Y);
4102 end;
4103 end;
4105 // Клавиши мыши не зажаты:
4106 if (not MouseRDown) and (not MouseLDown) then
4107 DrawRect := nil;
4109 // Строка состояния - координаты мыши:
4110 StatusBar.Panels[1].Text := Format('(%d:%d)',
4111 [MousePos.X-MapOffset.X, MousePos.Y-MapOffset.Y]);
4112 end;
4114 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
4115 begin
4116 CanClose := MessageBox(0, PChar(_lc[I_MSG_EXIT_PROMT]),
4117 PChar(_lc[I_MSG_EXIT]),
4118 MB_ICONQUESTION or MB_YESNO or
4119 MB_DEFBUTTON1) = idYes;
4120 end;
4122 procedure TMainForm.aExitExecute(Sender: TObject);
4123 begin
4124 Close();
4125 end;
4127 procedure TMainForm.FormDestroy(Sender: TObject);
4128 var
4129 config: TConfig;
4130 i: Integer;
4131 begin
4132 config := TConfig.CreateFile(EditorDir+'Editor.cfg');
4134 if WindowState <> wsMaximized then
4135 begin
4136 config.WriteInt('Editor', 'XPos', Left);
4137 config.WriteInt('Editor', 'YPos', Top);
4138 config.WriteInt('Editor', 'Width', Width);
4139 config.WriteInt('Editor', 'Height', Height);
4140 end
4141 else
4142 begin
4143 config.WriteInt('Editor', 'XPos', RestoredLeft);
4144 config.WriteInt('Editor', 'YPos', RestoredTop);
4145 config.WriteInt('Editor', 'Width', RestoredWidth);
4146 config.WriteInt('Editor', 'Height', RestoredHeight);
4147 end;
4148 config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
4149 config.WriteBool('Editor', 'Minimap', ShowMap);
4150 config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
4151 config.WriteInt('Editor', 'PanelObjs', PanelObjs.ClientHeight);
4152 config.WriteBool('Editor', 'DotEnable', DotEnable);
4153 config.WriteInt('Editor', 'DotStep', DotStep);
4154 config.WriteStr('Editor', 'LastOpenDir', OpenDialog.InitialDir);
4155 config.WriteStr('Editor', 'LastSaveDir', SaveDialog.InitialDir);
4156 config.WriteBool('Editor', 'EdgeShow', drEdge[3] < 255);
4157 config.WriteInt('Editor', 'EdgeColor', gColorEdge);
4158 config.WriteInt('Editor', 'EdgeAlpha', gAlphaEdge);
4159 config.WriteInt('Editor', 'LineAlpha', gAlphaTriggerLine);
4160 config.WriteInt('Editor', 'TriggerAlpha', gAlphaTriggerArea);
4162 for i := 0 to RecentCount-1 do
4163 if i < RecentFiles.Count then
4164 config.WriteStr('RecentFiles', IntToStr(i+1), RecentFiles[i])
4165 else
4166 config.WriteStr('RecentFiles', IntToStr(i+1), '');
4167 RecentFiles.Free();
4169 config.SaveFile(EditorDir+'Editor.cfg');
4170 config.Free();
4172 slInvalidTextures.Free;
4173 end;
4175 procedure TMainForm.FormDropFiles(Sender: TObject;
4176 const FileNames: array of String);
4177 begin
4178 if Length(FileNames) <> 1 then
4179 Exit;
4181 OpenMapFile(FileNames[0]);
4182 end;
4184 procedure TMainForm.RenderPanelResize(Sender: TObject);
4185 begin
4186 if MainForm.Visible then
4187 MainForm.Resize();
4188 end;
4190 procedure TMainForm.Splitter1Moved(Sender: TObject);
4191 begin
4192 FormResize(Sender);
4193 end;
4195 procedure TMainForm.aMapOptionsExecute(Sender: TObject);
4196 var
4197 ResName: String;
4198 begin
4199 MapOptionsForm.ShowModal();
4201 ResName := OpenedMap;
4202 while (Pos(':\', ResName) > 0) do
4203 Delete(ResName, 1, Pos(':\', ResName) + 1);
4205 UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName);
4206 end;
4208 procedure TMainForm.aAboutExecute(Sender: TObject);
4209 begin
4210 AboutForm.ShowModal();
4211 end;
4213 procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
4214 Shift: TShiftState);
4215 var
4216 dx, dy, i: Integer;
4217 FileName: String;
4218 begin
4219 if (not EditingProperties) then
4220 begin
4221 if Key = Ord('1') then
4222 SwitchLayer(LAYER_BACK);
4223 if Key = Ord('2') then
4224 SwitchLayer(LAYER_WALLS);
4225 if Key = Ord('3') then
4226 SwitchLayer(LAYER_FOREGROUND);
4227 if Key = Ord('4') then
4228 SwitchLayer(LAYER_STEPS);
4229 if Key = Ord('5') then
4230 SwitchLayer(LAYER_WATER);
4231 if Key = Ord('6') then
4232 SwitchLayer(LAYER_ITEMS);
4233 if Key = Ord('7') then
4234 SwitchLayer(LAYER_MONSTERS);
4235 if Key = Ord('8') then
4236 SwitchLayer(LAYER_AREAS);
4237 if Key = Ord('9') then
4238 SwitchLayer(LAYER_TRIGGERS);
4239 if Key = Ord('0') then
4240 tbShowClick(tbShow);
4242 if Key = Ord('V') then
4243 begin // Поворот монстров и областей:
4244 if (SelectedObjects <> nil) then
4245 begin
4246 for i := 0 to High(SelectedObjects) do
4247 if (SelectedObjects[i].Live) then
4248 begin
4249 if (SelectedObjects[i].ObjectType = OBJECT_MONSTER) then
4250 begin
4251 g_ChangeDir(gMonsters[SelectedObjects[i].ID].Direction);
4252 end
4253 else
4254 if (SelectedObjects[i].ObjectType = OBJECT_AREA) then
4255 begin
4256 g_ChangeDir(gAreas[SelectedObjects[i].ID].Direction);
4257 end;
4258 end;
4259 end
4260 else
4261 begin
4262 if pcObjects.ActivePage = tsMonsters then
4263 begin
4264 if rbMonsterLeft.Checked then
4265 rbMonsterRight.Checked := True
4266 else
4267 rbMonsterLeft.Checked := True;
4268 end;
4269 if pcObjects.ActivePage = tsAreas then
4270 begin
4271 if rbAreaLeft.Checked then
4272 rbAreaRight.Checked := True
4273 else
4274 rbAreaLeft.Checked := True;
4275 end;
4276 end;
4277 end;
4279 if not (ssCtrl in Shift) then
4280 begin
4281 // Быстрое превью карты:
4282 if Key = Ord('E') then
4283 begin
4284 if PreviewMode = 0 then
4285 PreviewMode := 2;
4286 end;
4288 // Вертикальный скролл карты:
4289 with sbVertical do
4290 begin
4291 if Key = Ord('W') then
4292 begin
4293 if (MouseLDown or MouseRDown) and (Position >= DotStep) then
4294 begin
4295 Dec(WASDOffset.Y, DotStep);
4296 RenderPanelMouseMove(Sender, Shift, LastMovePoint.X, LastMovePoint.Y);
4297 end;
4298 Position := IfThen(Position > DotStep, Position-DotStep, 0);
4299 MapOffset.Y := -Round(Position/16) * 16;
4300 end;
4302 if Key = Ord('S') then
4303 begin
4304 if (MouseLDown or MouseRDown) and (Position+DotStep <= Max) then
4305 begin
4306 Inc(WASDOffset.Y, DotStep);
4307 RenderPanelMouseMove(Sender, Shift, LastMovePoint.X, LastMovePoint.Y);
4308 end;
4309 Position := IfThen(Position+DotStep < Max, Position+DotStep, Max);
4310 MapOffset.Y := -Round(Position/16) * 16;
4311 end;
4312 end;
4314 // Горизонтальный скролл карты:
4315 with sbHorizontal do
4316 begin
4317 if Key = Ord('A') then
4318 begin
4319 if (MouseLDown or MouseRDown) and (Position >= DotStep) then
4320 begin
4321 Dec(WASDOffset.X, DotStep);
4322 RenderPanelMouseMove(Sender, Shift, LastMovePoint.X, LastMovePoint.Y);
4323 end;
4324 Position := IfThen(Position > DotStep, Position-DotStep, 0);
4325 MapOffset.X := -Round(Position/16) * 16;
4326 end;
4328 if Key = Ord('D') then
4329 begin
4330 if (MouseLDown or MouseRDown) and (Position+DotStep <= Max) then
4331 begin
4332 Inc(WASDOffset.X, DotStep);
4333 RenderPanelMouseMove(Sender, Shift, LastMovePoint.X, LastMovePoint.Y);
4334 end;
4335 Position := IfThen(Position+DotStep < Max, Position+DotStep, Max);
4336 MapOffset.X := -Round(Position/16) * 16;
4337 end;
4338 end;
4339 end
4340 else // ssCtrl in Shift
4341 begin
4342 if ssShift in Shift then
4343 begin
4344 // Вставка по абсолютному смещению:
4345 if Key = Ord('V') then
4346 aPasteObjectExecute(Sender);
4347 end;
4348 end;
4349 end;
4351 // Удалить выделенные объекты:
4352 if (Key = VK_DELETE) and (SelectedObjects <> nil) and
4353 RenderPanel.Focused() then
4354 DeleteSelectedObjects();
4356 // Снять выделение:
4357 if (Key = VK_ESCAPE) and (SelectedObjects <> nil) then
4358 RemoveSelectFromObjects();
4360 // Передвинуть объекты:
4361 if MainForm.ActiveControl = RenderPanel then
4362 begin
4363 dx := 0;
4364 dy := 0;
4366 if Key = VK_NUMPAD4 then
4367 dx := IfThen(ssAlt in Shift, -1, -DotStep);
4368 if Key = VK_NUMPAD6 then
4369 dx := IfThen(ssAlt in Shift, 1, DotStep);
4370 if Key = VK_NUMPAD8 then
4371 dy := IfThen(ssAlt in Shift, -1, -DotStep);
4372 if Key = VK_NUMPAD5 then
4373 dy := IfThen(ssAlt in Shift, 1, DotStep);
4375 if (dx <> 0) or (dy <> 0) then
4376 begin
4377 MoveSelectedObjects(ssShift in Shift, ssCtrl in Shift, dx, dy);
4378 Key := 0;
4379 end;
4380 end;
4382 if ssCtrl in Shift then
4383 begin
4384 // Выбор панели с текстурой для триггера
4385 if Key = Ord('T') then
4386 begin
4387 DrawPressRect := False;
4388 if SelectFlag = SELECTFLAG_TEXTURE then
4389 begin
4390 SelectFlag := SELECTFLAG_NONE;
4391 Exit;
4392 end;
4393 vleObjectProperty.FindRow(_lc[I_PROP_TR_TEXTURE_PANEL], i);
4394 if i > 0 then
4395 SelectFlag := SELECTFLAG_TEXTURE;
4396 end;
4398 if Key = Ord('D') then
4399 begin
4400 SelectFlag := SELECTFLAG_NONE;
4401 if DrawPressRect then
4402 begin
4403 DrawPressRect := False;
4404 Exit;
4405 end;
4406 i := -1;
4408 // Выбор области воздействия, в зависимости от типа триггера
4409 vleObjectProperty.FindRow(_lc[I_PROP_TR_EX_AREA], i);
4410 if i > 0 then
4411 begin
4412 DrawPressRect := True;
4413 Exit;
4414 end;
4415 vleObjectProperty.FindRow(_lc[I_PROP_TR_DOOR_PANEL], i);
4416 if i <= 0 then
4417 vleObjectProperty.FindRow(_lc[I_PROP_TR_TRAP_PANEL], i);
4418 if i > 0 then
4419 begin
4420 SelectFlag := SELECTFLAG_DOOR;
4421 Exit;
4422 end;
4423 vleObjectProperty.FindRow(_lc[I_PROP_TR_LIFT_PANEL], i);
4424 if i > 0 then
4425 begin
4426 SelectFlag := SELECTFLAG_LIFT;
4427 Exit;
4428 end;
4429 vleObjectProperty.FindRow(_lc[I_PROP_TR_TELEPORT_TO], i);
4430 if i > 0 then
4431 begin
4432 SelectFlag := SELECTFLAG_TELEPORT;
4433 Exit;
4434 end;
4435 vleObjectProperty.FindRow(_lc[I_PROP_TR_SPAWN_TO], i);
4436 if i > 0 then
4437 begin
4438 SelectFlag := SELECTFLAG_SPAWNPOINT;
4439 Exit;
4440 end;
4442 // Выбор основного параметра, в зависимости от типа триггера
4443 vleObjectProperty.FindRow(_lc[I_PROP_TR_NEXT_MAP], i);
4444 if i > 0 then
4445 begin
4446 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
4447 SelectMapForm.Caption := _lc[I_CAP_SELECT];
4448 SelectMapForm.GetMaps(FileName);
4450 if SelectMapForm.ShowModal() = mrOK then
4451 begin
4452 vleObjectProperty.Cells[1, i] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
4453 bApplyProperty.Click();
4454 end;
4455 Exit;
4456 end;
4457 vleObjectProperty.FindRow(_lc[I_PROP_TR_SOUND_NAME], i);
4458 if i <= 0 then
4459 vleObjectProperty.FindRow(_lc[I_PROP_TR_MUSIC_NAME], i);
4460 if i > 0 then
4461 begin
4462 AddSoundForm.OKFunction := nil;
4463 AddSoundForm.lbResourcesList.MultiSelect := False;
4464 AddSoundForm.SetResource := vleObjectProperty.Cells[1, i];
4466 if (AddSoundForm.ShowModal() = mrOk) then
4467 begin
4468 vleObjectProperty.Cells[1, i] := AddSoundForm.ResourceName;
4469 bApplyProperty.Click();
4470 end;
4471 Exit;
4472 end;
4473 vleObjectProperty.FindRow(_lc[I_PROP_TR_PUSH_ANGLE], i);
4474 if i <= 0 then
4475 vleObjectProperty.FindRow(_lc[I_PROP_TR_MESSAGE_TEXT], i);
4476 if i > 0 then
4477 begin
4478 vleObjectProperty.Row := i;
4479 vleObjectProperty.SetFocus();
4480 Exit;
4481 end;
4482 end;
4483 end;
4484 end;
4486 procedure TMainForm.aOptimizeExecute(Sender: TObject);
4487 begin
4488 RemoveSelectFromObjects();
4489 MapOptimizationForm.ShowModal();
4490 end;
4492 procedure TMainForm.aCheckMapExecute(Sender: TObject);
4493 begin
4494 MapCheckForm.ShowModal();
4495 end;
4497 procedure TMainForm.bbAddTextureClick(Sender: TObject);
4498 begin
4499 AddTextureForm.lbResourcesList.MultiSelect := True;
4500 AddTextureForm.ShowModal();
4501 end;
4503 procedure TMainForm.lbTextureListClick(Sender: TObject);
4504 var
4505 TextureID: DWORD;
4506 TextureWidth, TextureHeight: Word;
4507 begin
4508 TextureID := 0;
4509 TextureWidth := 0;
4510 TextureHeight := 0;
4511 if (lbTextureList.ItemIndex <> -1) and
4512 (not IsSpecialTextureSel()) then
4513 begin
4514 if g_GetTexture(SelectedTexture(), TextureID) then
4515 begin
4516 g_GetTextureSizeByID(TextureID, TextureWidth, TextureHeight);
4518 lTextureWidth.Caption := IntToStr(TextureWidth);
4519 lTextureHeight.Caption := IntToStr(TextureHeight);
4520 end else
4521 begin
4522 lTextureWidth.Caption := _lc[I_NOT_ACCESSIBLE];
4523 lTextureHeight.Caption := _lc[I_NOT_ACCESSIBLE];
4524 end;
4525 end
4526 else
4527 begin
4528 lTextureWidth.Caption := '';
4529 lTextureHeight.Caption := '';
4530 end;
4531 end;
4533 procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
4534 ARect: TRect; State: TOwnerDrawState);
4535 begin
4536 with Control as TListBox do
4537 begin
4538 if LCLType.odSelected in State then
4539 begin
4540 Canvas.Brush.Color := clHighlight;
4541 Canvas.Font.Color := clHighlightText;
4542 end else
4543 if (Items <> nil) and (Index >= 0) then
4544 if slInvalidTextures.IndexOf(Items[Index]) > -1 then
4545 begin
4546 Canvas.Brush.Color := clRed;
4547 Canvas.Font.Color := clWhite;
4548 end;
4549 Canvas.FillRect(ARect);
4550 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
4551 end;
4552 end;
4554 procedure TMainForm.miReopenMapClick(Sender: TObject);
4555 var
4556 FileName, Resource: String;
4557 begin
4558 if OpenedMap = '' then
4559 Exit;
4561 if MessageBox(0, PChar(_lc[I_MSG_REOPEN_MAP_PROMT]),
4562 PChar(_lc[I_MENU_FILE_REOPEN]), MB_ICONQUESTION or MB_YESNO) <> idYes then
4563 Exit;
4565 g_ProcessResourceStr(OpenedMap, @FileName, nil, @Resource);
4566 OpenMap(FileName, Resource);
4567 end;
4569 procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
4570 const KeyName: String; Values: TStrings);
4571 begin
4572 if vleObjectProperty.ItemProps[KeyName].EditStyle = esPickList then
4573 begin
4574 if KeyName = _lc[I_PROP_DIRECTION] then
4575 begin
4576 Values.Add(DirNames[D_LEFT]);
4577 Values.Add(DirNames[D_RIGHT]);
4578 end
4579 else if KeyName = _lc[I_PROP_TR_TELEPORT_DIR] then
4580 begin
4581 Values.Add(DirNamesAdv[0]);
4582 Values.Add(DirNamesAdv[1]);
4583 Values.Add(DirNamesAdv[2]);
4584 Values.Add(DirNamesAdv[3]);
4585 end
4586 else if KeyName = _lc[I_PROP_TR_MUSIC_ACT] then
4587 begin
4588 Values.Add(_lc[I_PROP_TR_MUSIC_ON]);
4589 Values.Add(_lc[I_PROP_TR_MUSIC_OFF]);
4590 end
4591 else if KeyName = _lc[I_PROP_TR_MONSTER_BEHAVIOUR] then
4592 begin
4593 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_0]);
4594 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_1]);
4595 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_2]);
4596 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_3]);
4597 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_4]);
4598 Values.Add(_lc[I_PROP_TR_MONSTER_BEHAVIOUR_5]);
4599 end
4600 else if KeyName = _lc[I_PROP_TR_SCORE_ACT] then
4601 begin
4602 Values.Add(_lc[I_PROP_TR_SCORE_ACT_0]);
4603 Values.Add(_lc[I_PROP_TR_SCORE_ACT_1]);
4604 Values.Add(_lc[I_PROP_TR_SCORE_ACT_2]);
4605 Values.Add(_lc[I_PROP_TR_SCORE_ACT_3]);
4606 end
4607 else if KeyName = _lc[I_PROP_TR_SCORE_TEAM] then
4608 begin
4609 Values.Add(_lc[I_PROP_TR_SCORE_TEAM_0]);
4610 Values.Add(_lc[I_PROP_TR_SCORE_TEAM_1]);
4611 Values.Add(_lc[I_PROP_TR_SCORE_TEAM_2]);
4612 Values.Add(_lc[I_PROP_TR_SCORE_TEAM_3]);
4613 end
4614 else if KeyName = _lc[I_PROP_TR_MESSAGE_KIND] then
4615 begin
4616 Values.Add(_lc[I_PROP_TR_MESSAGE_KIND_0]);
4617 Values.Add(_lc[I_PROP_TR_MESSAGE_KIND_1]);
4618 end
4619 else if KeyName = _lc[I_PROP_TR_MESSAGE_TO] then
4620 begin
4621 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_0]);
4622 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_1]);
4623 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_2]);
4624 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_3]);
4625 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_4]);
4626 Values.Add(_lc[I_PROP_TR_MESSAGE_TO_5]);
4627 end
4628 else if KeyName = _lc[I_PROP_TR_SHOT_TO] then
4629 begin
4630 Values.Add(_lc[I_PROP_TR_SHOT_TO_0]);
4631 Values.Add(_lc[I_PROP_TR_SHOT_TO_1]);
4632 Values.Add(_lc[I_PROP_TR_SHOT_TO_2]);
4633 Values.Add(_lc[I_PROP_TR_SHOT_TO_3]);
4634 Values.Add(_lc[I_PROP_TR_SHOT_TO_4]);
4635 Values.Add(_lc[I_PROP_TR_SHOT_TO_5]);
4636 Values.Add(_lc[I_PROP_TR_SHOT_TO_6]);
4637 end
4638 else if KeyName = _lc[I_PROP_TR_SHOT_AIM] then
4639 begin
4640 Values.Add(_lc[I_PROP_TR_SHOT_AIM_0]);
4641 Values.Add(_lc[I_PROP_TR_SHOT_AIM_1]);
4642 Values.Add(_lc[I_PROP_TR_SHOT_AIM_2]);
4643 Values.Add(_lc[I_PROP_TR_SHOT_AIM_3]);
4644 end
4645 else if (KeyName = _lc[I_PROP_PANEL_BLEND]) or
4646 (KeyName = _lc[I_PROP_DM_ONLY]) or
4647 (KeyName = _lc[I_PROP_ITEM_FALLS]) or
4648 (KeyName = _lc[I_PROP_TR_ENABLED]) or
4649 (KeyName = _lc[I_PROP_TR_D2D]) or
4650 (KeyName = _lc[I_PROP_TR_SILENT]) or
4651 (KeyName = _lc[I_PROP_TR_TELEPORT_SILENT]) or
4652 (KeyName = _lc[I_PROP_TR_EX_RANDOM]) or
4653 (KeyName = _lc[I_PROP_TR_TEXTURE_ONCE]) or
4654 (KeyName = _lc[I_PROP_TR_TEXTURE_ANIM_ONCE]) or
4655 (KeyName = _lc[I_PROP_TR_SOUND_LOCAL]) or
4656 (KeyName = _lc[I_PROP_TR_SOUND_SWITCH]) or
4657 (KeyName = _lc[I_PROP_TR_MONSTER_ACTIVE]) or
4658 (KeyName = _lc[I_PROP_TR_PUSH_RESET]) or
4659 (KeyName = _lc[I_PROP_TR_SCORE_CON]) or
4660 (KeyName = _lc[I_PROP_TR_SCORE_MSG]) or
4661 (KeyName = _lc[I_PROP_TR_HEALTH_MAX]) or
4662 (KeyName = _lc[I_PROP_TR_SHOT_SOUND]) or
4663 (KeyName = _lc[I_PROP_TR_EFFECT_CENTER]) then
4664 begin
4665 Values.Add(BoolNames[True]);
4666 Values.Add(BoolNames[False]);
4667 end;
4668 end;
4669 end;
4671 procedure TMainForm.bApplyPropertyClick(Sender: TObject);
4672 var
4673 _id, a, r, c: Integer;
4674 s: String;
4675 res: Boolean;
4676 NoTextureID: DWORD;
4677 NW, NH: Word;
4678 begin
4679 NoTextureID := 0;
4680 NW := 0;
4681 NH := 0;
4683 if SelectedObjectCount() <> 1 then
4684 Exit;
4685 if not SelectedObjects[GetFirstSelected()].Live then
4686 Exit;
4688 try
4689 if not CheckProperty() then
4690 Exit;
4691 except
4692 Exit;
4693 end;
4695 _id := GetFirstSelected();
4697 r := vleObjectProperty.Row;
4698 c := vleObjectProperty.Col;
4700 case SelectedObjects[_id].ObjectType of
4701 OBJECT_PANEL:
4702 begin
4703 with gPanels[SelectedObjects[_id].ID] do
4704 begin
4705 X := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_X]]));
4706 Y := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_Y]]));
4707 Width := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_WIDTH]]));
4708 Height := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_HEIGHT]]));
4710 PanelType := GetPanelType(vleObjectProperty.Values[_lc[I_PROP_PANEL_TYPE]]);
4712 // Сброс ссылки на триггеры смены текстуры:
4713 if not WordBool(PanelType and (PANEL_WALL or PANEL_FORE or PANEL_BACK)) then
4714 if gTriggers <> nil then
4715 for a := 0 to High(gTriggers) do
4716 begin
4717 if (gTriggers[a].TriggerType <> 0) and
4718 (gTriggers[a].TexturePanel = Integer(SelectedObjects[_id].ID)) then
4719 gTriggers[a].TexturePanel := -1;
4720 if (gTriggers[a].TriggerType = TRIGGER_SHOT) and
4721 (gTriggers[a].Data.ShotPanelID = Integer(SelectedObjects[_id].ID)) then
4722 gTriggers[a].Data.ShotPanelID := -1;
4723 end;
4725 // Сброс ссылки на триггеры лифта:
4726 if not WordBool(PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT)) then
4727 if gTriggers <> nil then
4728 for a := 0 to High(gTriggers) do
4729 if (gTriggers[a].TriggerType in [TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT]) and
4730 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
4731 gTriggers[a].Data.PanelID := -1;
4733 // Сброс ссылки на триггеры двери:
4734 if not WordBool(PanelType and (PANEL_OPENDOOR or PANEL_CLOSEDOOR)) then
4735 if gTriggers <> nil then
4736 for a := 0 to High(gTriggers) do
4737 if (gTriggers[a].TriggerType in [TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
4738 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP]) and
4739 (gTriggers[a].Data.PanelID = Integer(SelectedObjects[_id].ID)) then
4740 gTriggers[a].Data.PanelID := -1;
4742 if IsTexturedPanel(PanelType) then
4743 begin // Может быть текстура
4744 if TextureName <> '' then
4745 begin // Была текстура
4746 Alpha := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_PANEL_ALPHA]]));
4747 Blending := NameToBool(vleObjectProperty.Values[_lc[I_PROP_PANEL_BLEND]]);
4748 end
4749 else // Не было
4750 begin
4751 Alpha := 0;
4752 Blending := False;
4753 end;
4755 // Новая текстура:
4756 TextureName := vleObjectProperty.Values[_lc[I_PROP_PANEL_TEX]];
4758 if TextureName <> '' then
4759 begin // Есть текстура
4760 // Обычная текстура:
4761 if not IsSpecialTexture(TextureName) then
4762 begin
4763 g_GetTextureSizeByName(TextureName,
4764 TextureWidth, TextureHeight);
4766 // Проверка кратности размеров панели:
4767 res := True;
4768 if TextureWidth <> 0 then
4769 if gPanels[SelectedObjects[_id].ID].Width mod TextureWidth <> 0 then
4770 begin
4771 ErrorMessageBox(Format(_lc[I_MSG_WRONG_TEXWIDTH],
4772 [TextureWidth]));
4773 Res := False;
4774 end;
4775 if Res and (TextureHeight <> 0) then
4776 if gPanels[SelectedObjects[_id].ID].Height mod TextureHeight <> 0 then
4777 begin
4778 ErrorMessageBox(Format(_lc[I_MSG_WRONG_TEXHEIGHT],
4779 [TextureHeight]));
4780 Res := False;
4781 end;
4783 if Res then
4784 begin
4785 if not g_GetTexture(TextureName, TextureID) then
4786 // Не удалось загрузить текстуру, рисуем NOTEXTURE
4787 if g_GetTexture('NOTEXTURE', NoTextureID) then
4788 begin
4789 TextureID := TEXTURE_SPECIAL_NOTEXTURE;
4790 g_GetTextureSizeByID(NoTextureID, NW, NH);
4791 TextureWidth := NW;
4792 TextureHeight := NH;
4793 end else
4794 begin
4795 TextureID := TEXTURE_SPECIAL_NONE;
4796 TextureWidth := 1;
4797 TextureHeight := 1;
4798 end;
4799 end
4800 else
4801 begin
4802 TextureName := '';
4803 TextureWidth := 1;
4804 TextureHeight := 1;
4805 TextureID := TEXTURE_SPECIAL_NONE;
4806 end;
4807 end
4808 else // Спец.текстура
4809 begin
4810 TextureHeight := 1;
4811 TextureWidth := 1;
4812 TextureID := SpecialTextureID(TextureName);
4813 end;
4814 end
4815 else // Нет текстуры
4816 begin
4817 TextureWidth := 1;
4818 TextureHeight := 1;
4819 TextureID := TEXTURE_SPECIAL_NONE;
4820 end;
4821 end
4822 else // Не может быть текстуры
4823 begin
4824 Alpha := 0;
4825 Blending := False;
4826 TextureName := '';
4827 TextureWidth := 1;
4828 TextureHeight := 1;
4829 TextureID := TEXTURE_SPECIAL_NONE;
4830 end;
4831 end;
4832 end;
4834 OBJECT_ITEM:
4835 begin
4836 with gItems[SelectedObjects[_id].ID] do
4837 begin
4838 X := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_X]]));
4839 Y := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_Y]]));
4840 OnlyDM := NameToBool(vleObjectProperty.Values[_lc[I_PROP_DM_ONLY]]);
4841 Fall := NameToBool(vleObjectProperty.Values[_lc[I_PROP_ITEM_FALLS]]);
4842 end;
4843 end;
4845 OBJECT_MONSTER:
4846 begin
4847 with gMonsters[SelectedObjects[_id].ID] do
4848 begin
4849 X := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_X]]));
4850 Y := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_Y]]));
4851 Direction := NameToDir(vleObjectProperty.Values[_lc[I_PROP_DIRECTION]]);
4852 end;
4853 end;
4855 OBJECT_AREA:
4856 begin
4857 with gAreas[SelectedObjects[_id].ID] do
4858 begin
4859 X := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_X]]));
4860 Y := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_Y]]));
4861 Direction := NameToDir(vleObjectProperty.Values[_lc[I_PROP_DIRECTION]]);
4862 end;
4863 end;
4865 OBJECT_TRIGGER:
4866 begin
4867 with gTriggers[SelectedObjects[_id].ID] do
4868 begin
4869 X := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_X]]));
4870 Y := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_Y]]));
4871 Width := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_WIDTH]]));
4872 Height := StrToInt(Trim(vleObjectProperty.Values[_lc[I_PROP_HEIGHT]]));
4873 Enabled := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_ENABLED]]);
4874 ActivateType := StrToActivate(vleObjectProperty.Values[_lc[I_PROP_TR_ACTIVATION]]);
4875 Key := StrToKey(vleObjectProperty.Values[_lc[I_PROP_TR_KEYS]]);
4877 case TriggerType of
4878 TRIGGER_EXIT:
4879 begin
4880 s := utf2win(vleObjectProperty.Values[_lc[I_PROP_TR_NEXT_MAP]]);
4881 FillByte(Data.MapName[0], 16, 0);
4882 if s <> '' then
4883 Move(s[1], Data.MapName[0], Min(Length(s), 16));
4884 end;
4886 TRIGGER_TEXTURE:
4887 begin
4888 Data.ActivateOnce := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_TEXTURE_ONCE]]);
4889 Data.AnimOnce := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_TEXTURE_ANIM_ONCE]]);
4890 end;
4892 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
4893 begin
4894 Data.Wait := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EX_DELAY]], 0), 65535);
4895 Data.Count := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EX_COUNT]], 0), 65535);
4896 if Data.Count < 1 then
4897 Data.Count := 1;
4898 if TriggerType = TRIGGER_PRESS then
4899 Data.ExtRandom := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_EX_RANDOM]]);
4900 end;
4902 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR, TRIGGER_DOOR5,
4903 TRIGGER_CLOSETRAP, TRIGGER_TRAP, TRIGGER_LIFTUP, TRIGGER_LIFTDOWN,
4904 TRIGGER_LIFT:
4905 begin
4906 Data.NoSound := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SILENT]]);
4907 Data.d2d_doors := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_D2D]]);
4908 end;
4910 TRIGGER_TELEPORT:
4911 begin
4912 Data.d2d_teleport := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_D2D]]);
4913 Data.silent_teleport := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_TELEPORT_SILENT]]);
4914 Data.TlpDir := NameToDirAdv(vleObjectProperty.Values[_lc[I_PROP_TR_TELEPORT_DIR]]);
4915 end;
4917 TRIGGER_SOUND:
4918 begin
4919 s := utf2win(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_NAME]]);
4920 FillByte(Data.SoundName[0], 64, 0);
4921 if s <> '' then
4922 Move(s[1], Data.SoundName[0], Min(Length(s), 64));
4924 Data.Volume := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_VOLUME]], 0), 255);
4925 Data.Pan := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_PAN]], 0), 255);
4926 Data.PlayCount := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_COUNT]], 0), 255);
4927 Data.Local := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_LOCAL]]);
4928 Data.SoundSwitch := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SOUND_SWITCH]]);
4929 end;
4931 TRIGGER_SPAWNMONSTER:
4932 begin
4933 Data.MonType := StrToMonster(vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_TYPE]]);
4934 Data.MonDir := Byte(NameToDir(vleObjectProperty.Values[_lc[I_PROP_DIRECTION]]));
4935 Data.MonHealth := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_HEALTH]], 0), 1000000);
4936 if Data.MonHealth < 0 then
4937 Data.MonHealth := 0;
4938 Data.MonActive := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_ACTIVE]]);
4939 Data.MonCount := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_COUNT]], 0), 64);
4940 if Data.MonCount < 1 then
4941 Data.MonCount := 1;
4942 Data.MonEffect := StrToEffect(vleObjectProperty.Values[_lc[I_PROP_TR_FX_TYPE]]);
4943 Data.MonMax := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SPAWN_MAX]], 0), 65535);
4944 Data.MonDelay := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SPAWN_DELAY]], 0), 65535);
4945 Data.MonBehav := 0;
4946 if vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_BEHAVIOUR]] = _lc[I_PROP_TR_MONSTER_BEHAVIOUR_1] then
4947 Data.MonBehav := 1;
4948 if vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_BEHAVIOUR]] = _lc[I_PROP_TR_MONSTER_BEHAVIOUR_2] then
4949 Data.MonBehav := 2;
4950 if vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_BEHAVIOUR]] = _lc[I_PROP_TR_MONSTER_BEHAVIOUR_3] then
4951 Data.MonBehav := 3;
4952 if vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_BEHAVIOUR]] = _lc[I_PROP_TR_MONSTER_BEHAVIOUR_4] then
4953 Data.MonBehav := 4;
4954 if vleObjectProperty.Values[_lc[I_PROP_TR_MONSTER_BEHAVIOUR]] = _lc[I_PROP_TR_MONSTER_BEHAVIOUR_5] then
4955 Data.MonBehav := 5;
4956 end;
4958 TRIGGER_SPAWNITEM:
4959 begin
4960 Data.ItemType := StrToItem(vleObjectProperty.Values[_lc[I_PROP_TR_ITEM_TYPE]]);
4961 Data.ItemOnlyDM := NameToBool(vleObjectProperty.Values[_lc[I_PROP_DM_ONLY]]);
4962 Data.ItemFalls := NameToBool(vleObjectProperty.Values[_lc[I_PROP_ITEM_FALLS]]);
4963 Data.ItemCount := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_COUNT]], 0), 64);
4964 if Data.ItemCount < 1 then
4965 Data.ItemCount := 1;
4966 Data.ItemEffect := StrToEffect(vleObjectProperty.Values[_lc[I_PROP_TR_FX_TYPE]]);
4967 Data.ItemMax := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SPAWN_MAX]], 0), 65535);
4968 Data.ItemDelay := Min(StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SPAWN_DELAY]], 0), 65535);
4969 end;
4971 TRIGGER_MUSIC:
4972 begin
4973 s := utf2win(vleObjectProperty.Values[_lc[I_PROP_TR_MUSIC_NAME]]);
4974 FillByte(Data.MusicName[0], 64, 0);
4975 if s <> '' then
4976 Move(s[1], Data.MusicName[0], Min(Length(s), 64));
4978 if vleObjectProperty.Values[_lc[I_PROP_TR_MUSIC_ACT]] = _lc[I_PROP_TR_MUSIC_ON] then
4979 Data.MusicAction := 1
4980 else
4981 Data.MusicAction := 2;
4982 end;
4984 TRIGGER_PUSH:
4985 begin
4986 Data.PushAngle := Min(
4987 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_PUSH_ANGLE]], 0), 360);
4988 Data.PushForce := Min(
4989 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_PUSH_FORCE]], 0), 255);
4990 Data.ResetVel := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_PUSH_RESET]]);
4991 end;
4993 TRIGGER_SCORE:
4994 begin
4995 Data.ScoreAction := 0;
4996 if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_ACT]] = _lc[I_PROP_TR_SCORE_ACT_1] then
4997 Data.ScoreAction := 1
4998 else if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_ACT]] = _lc[I_PROP_TR_SCORE_ACT_2] then
4999 Data.ScoreAction := 2
5000 else if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_ACT]] = _lc[I_PROP_TR_SCORE_ACT_3] then
5001 Data.ScoreAction := 3;
5002 Data.ScoreCount := Min(Max(
5003 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_COUNT]], 0), 0), 255);
5004 Data.ScoreTeam := 0;
5005 if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_TEAM]] = _lc[I_PROP_TR_SCORE_TEAM_1] then
5006 Data.ScoreTeam := 1
5007 else if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_TEAM]] = _lc[I_PROP_TR_SCORE_TEAM_2] then
5008 Data.ScoreTeam := 2
5009 else if vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_TEAM]] = _lc[I_PROP_TR_SCORE_TEAM_3] then
5010 Data.ScoreTeam := 3;
5011 Data.ScoreCon := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_CON]]);
5012 Data.ScoreMsg := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SCORE_MSG]]);
5013 end;
5015 TRIGGER_MESSAGE:
5016 begin
5017 Data.MessageKind := 0;
5018 if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_KIND]] = _lc[I_PROP_TR_MESSAGE_KIND_1] then
5019 Data.MessageKind := 1;
5021 Data.MessageSendTo := 0;
5022 if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TO]] = _lc[I_PROP_TR_MESSAGE_TO_1] then
5023 Data.MessageSendTo := 1
5024 else if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TO]] = _lc[I_PROP_TR_MESSAGE_TO_2] then
5025 Data.MessageSendTo := 2
5026 else if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TO]] = _lc[I_PROP_TR_MESSAGE_TO_3] then
5027 Data.MessageSendTo := 3
5028 else if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TO]] = _lc[I_PROP_TR_MESSAGE_TO_4] then
5029 Data.MessageSendTo := 4
5030 else if vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TO]] = _lc[I_PROP_TR_MESSAGE_TO_5] then
5031 Data.MessageSendTo := 5;
5033 s := utf2win(vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TEXT]]);
5034 FillByte(Data.MessageText[0], 100, 0);
5035 if s <> '' then
5036 Move(s[1], Data.MessageText[0], Min(Length(s), 100));
5038 Data.MessageTime := Min(Max(
5039 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_MESSAGE_TIME]], 0), 0), 65535);
5040 end;
5042 TRIGGER_DAMAGE:
5043 begin
5044 Data.DamageValue := Min(Max(
5045 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_DAMAGE_VALUE]], 0), 0), 65535);
5046 Data.DamageInterval := Min(Max(
5047 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_INTERVAL]], 0), 0), 65535);
5048 end;
5050 TRIGGER_HEALTH:
5051 begin
5052 Data.HealValue := Min(Max(
5053 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_HEALTH]], 0), 0), 65535);
5054 Data.HealInterval := Min(Max(
5055 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_INTERVAL]], 0), 0), 65535);
5056 Data.HealMax := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_HEALTH_MAX]]);
5057 Data.HealSilent := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SILENT]]);
5058 end;
5060 TRIGGER_SHOT:
5061 begin
5062 Data.ShotType := StrToShot(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TYPE]]);
5063 Data.ShotSound := NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_SOUND]]);
5064 Data.ShotTarget := 0;
5065 if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_1] then
5066 Data.ShotTarget := 1
5067 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_2] then
5068 Data.ShotTarget := 2
5069 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_3] then
5070 Data.ShotTarget := 3
5071 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_4] then
5072 Data.ShotTarget := 4
5073 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_5] then
5074 Data.ShotTarget := 5
5075 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_TO]] = _lc[I_PROP_TR_SHOT_TO_6] then
5076 Data.ShotTarget := 6;
5077 Data.ShotIntSight := Min(Max(
5078 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_SIGHT]], 0), 0), 65535);
5079 Data.ShotAim := 0;
5080 if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_1] then
5081 Data.ShotAim := 1
5082 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_2] then
5083 Data.ShotAim := 2
5084 else if vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AIM]] = _lc[I_PROP_TR_SHOT_AIM_3] then
5085 Data.ShotAim := 3;
5086 Data.ShotAngle := Min(
5087 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_ANGLE]], 0), 360);
5088 Data.ShotWait := Min(Max(
5089 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EX_DELAY]], 0), 0), 65535);
5090 Data.ShotAccuracy := Min(Max(
5091 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_ACC]], 0), 0), 65535);
5092 Data.ShotAmmo := Min(Max(
5093 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_AMMO]], 0), 0), 65535);
5094 Data.ShotIntReload := Min(Max(
5095 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_SHOT_RELOAD]], 0), 0), 65535);
5096 end;
5098 TRIGGER_EFFECT:
5099 begin
5100 Data.FXCount := Min(Max(
5101 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_COUNT]], 0), 0), 255);
5102 if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_TYPE]] = _lc[I_PROP_TR_EFFECT_PARTICLE] then
5103 begin
5104 Data.FXType := TRIGGER_EFFECT_PARTICLE;
5105 Data.FXSubType := TRIGGER_EFFECT_SLIQUID;
5106 if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_SLIQUID] then
5107 Data.FXSubType := TRIGGER_EFFECT_SLIQUID
5108 else if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_LLIQUID] then
5109 Data.FXSubType := TRIGGER_EFFECT_LLIQUID
5110 else if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_DLIQUID] then
5111 Data.FXSubType := TRIGGER_EFFECT_DLIQUID
5112 else if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_BLOOD] then
5113 Data.FXSubType := TRIGGER_EFFECT_BLOOD
5114 else if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_SPARK] then
5115 Data.FXSubType := TRIGGER_EFFECT_SPARK
5116 else if vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]] = _lc[I_PROP_TR_EFFECT_BUBBLE] then
5117 Data.FXSubType := TRIGGER_EFFECT_BUBBLE;
5118 end else
5119 begin
5120 Data.FXType := TRIGGER_EFFECT_ANIMATION;
5121 Data.FXSubType := StrToEffect(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SUBTYPE]]);
5122 end;
5123 a := Min(Max(
5124 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_COLOR]], 0), 0), $FFFFFF);
5125 Data.FXColorR := a and $FF;
5126 Data.FXColorG := (a shr 8) and $FF;
5127 Data.FXColorB := (a shr 16) and $FF;
5128 if NameToBool(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_CENTER]]) then
5129 Data.FXPos := 0
5130 else
5131 Data.FXPos := 1;
5132 Data.FXWait := Min(Max(
5133 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EX_DELAY]], 0), 0), 65535);
5134 Data.FXVelX := Min(Max(
5135 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_VELX]], 0), -128), 127);
5136 Data.FXVelY := Min(Max(
5137 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_VELY]], 0), -128), 127);
5138 Data.FXSpreadL := Min(Max(
5139 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SPL]], 0), 0), 255);
5140 Data.FXSpreadR := Min(Max(
5141 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SPR]], 0), 0), 255);
5142 Data.FXSpreadU := Min(Max(
5143 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SPU]], 0), 0), 255);
5144 Data.FXSpreadD := Min(Max(
5145 StrToIntDef(vleObjectProperty.Values[_lc[I_PROP_TR_EFFECT_SPD]], 0), 0), 255);
5146 end;
5147 end;
5148 end;
5149 end;
5150 end;
5152 FillProperty();
5154 vleObjectProperty.Row := r;
5155 vleObjectProperty.Col := c;
5156 end;
5158 procedure TMainForm.bbRemoveTextureClick(Sender: TObject);
5159 var
5160 a, i: Integer;
5161 begin
5162 i := lbTextureList.ItemIndex;
5163 if i = -1 then
5164 Exit;
5166 if MessageBox(0, PChar(Format(_lc[I_MSG_DEL_TEXTURE_PROMT],
5167 [SelectedTexture()])),
5168 PChar(_lc[I_MSG_DEL_TEXTURE]),
5169 MB_ICONQUESTION or MB_YESNO or
5170 MB_DEFBUTTON1) <> idYes then
5171 Exit;
5173 if gPanels <> nil then
5174 for a := 0 to High(gPanels) do
5175 if (gPanels[a].PanelType <> 0) and
5176 (gPanels[a].TextureName = SelectedTexture()) then
5177 begin
5178 ErrorMessageBox(_lc[I_MSG_DEL_TEXTURE_CANT]);
5179 Exit;
5180 end;
5182 g_DeleteTexture(SelectedTexture());
5183 i := slInvalidTextures.IndexOf(lbTextureList.Items[i]);
5184 if i > -1 then
5185 slInvalidTextures.Delete(i);
5186 if lbTextureList.ItemIndex > -1 then
5187 lbTextureList.Items.Delete(lbTextureList.ItemIndex)
5188 end;
5190 procedure TMainForm.aNewMapExecute(Sender: TObject);
5191 begin
5192 if (MessageBox(0, PChar(_lc[I_MSG_CLEAR_MAP_PROMT]),
5193 PChar(_lc[I_MSG_CLEAR_MAP]),
5194 MB_ICONQUESTION or MB_YESNO or
5195 MB_DEFBUTTON1) = mrYes) then
5196 FullClear();
5197 end;
5199 procedure TMainForm.aUndoExecute(Sender: TObject);
5200 var
5201 a: Integer;
5202 begin
5203 if UndoBuffer = nil then
5204 Exit;
5205 if UndoBuffer[High(UndoBuffer)] = nil then
5206 Exit;
5208 for a := 0 to High(UndoBuffer[High(UndoBuffer)]) do
5209 with UndoBuffer[High(UndoBuffer)][a] do
5210 begin
5211 case UndoType of
5212 UNDO_DELETE_PANEL:
5213 begin
5214 AddPanel(Panel^);
5215 Panel := nil;
5216 end;
5217 UNDO_DELETE_ITEM: AddItem(Item);
5218 UNDO_DELETE_AREA: AddArea(Area);
5219 UNDO_DELETE_MONSTER: AddMonster(Monster);
5220 UNDO_DELETE_TRIGGER: AddTrigger(Trigger);
5221 UNDO_ADD_PANEL: RemoveObject(AddID, OBJECT_PANEL);
5222 UNDO_ADD_ITEM: RemoveObject(AddID, OBJECT_ITEM);
5223 UNDO_ADD_AREA: RemoveObject(AddID, OBJECT_AREA);
5224 UNDO_ADD_MONSTER: RemoveObject(AddID, OBJECT_MONSTER);
5225 UNDO_ADD_TRIGGER: RemoveObject(AddID, OBJECT_TRIGGER);
5226 end;
5227 end;
5229 SetLength(UndoBuffer, Length(UndoBuffer)-1);
5231 RemoveSelectFromObjects();
5233 miUndo.Enabled := UndoBuffer <> nil;
5234 end;
5237 procedure TMainForm.aCopyObjectExecute(Sender: TObject);
5238 var
5239 a, b: Integer;
5240 CopyBuffer: TCopyRecArray;
5241 str: String;
5242 ok: Boolean;
5244 function CB_Compare(I1, I2: TCopyRec): Integer;
5245 begin
5246 Result := Integer(I1.ObjectType) - Integer(I2.ObjectType);
5248 if Result = 0 then // Одного типа
5249 Result := Integer(I1.ID) - Integer(I2.ID);
5250 end;
5252 procedure QuickSortCopyBuffer(L, R: Integer);
5253 var
5254 I, J: Integer;
5255 P, T: TCopyRec;
5256 begin
5257 repeat
5258 I := L;
5259 J := R;
5260 P := CopyBuffer[(L + R) shr 1];
5262 repeat
5263 while CB_Compare(CopyBuffer[I], P) < 0 do
5264 Inc(I);
5265 while CB_Compare(CopyBuffer[J], P) > 0 do
5266 Dec(J);
5268 if I <= J then
5269 begin
5270 T := CopyBuffer[I];
5271 CopyBuffer[I] := CopyBuffer[J];
5272 CopyBuffer[J] := T;
5273 Inc(I);
5274 Dec(J);
5275 end;
5276 until I > J;
5278 if L < J then
5279 QuickSortCopyBuffer(L, J);
5281 L := I;
5282 until I >= R;
5283 end;
5285 begin
5286 if SelectedObjects = nil then
5287 Exit;
5289 b := -1;
5290 CopyBuffer := nil;
5292 // Копируем объекты:
5293 for a := 0 to High(SelectedObjects) do
5294 if SelectedObjects[a].Live then
5295 with SelectedObjects[a] do
5296 begin
5297 SetLength(CopyBuffer, Length(CopyBuffer)+1);
5298 b := High(CopyBuffer);
5299 CopyBuffer[b].ID := ID;
5300 CopyBuffer[b].Panel := nil;
5302 case ObjectType of
5303 OBJECT_PANEL:
5304 begin
5305 CopyBuffer[b].ObjectType := OBJECT_PANEL;
5306 New(CopyBuffer[b].Panel);
5307 CopyBuffer[b].Panel^ := gPanels[ID];
5308 end;
5310 OBJECT_ITEM:
5311 begin
5312 CopyBuffer[b].ObjectType := OBJECT_ITEM;
5313 CopyBuffer[b].Item := gItems[ID];
5314 end;
5316 OBJECT_MONSTER:
5317 begin
5318 CopyBuffer[b].ObjectType := OBJECT_MONSTER;
5319 CopyBuffer[b].Monster := gMonsters[ID];
5320 end;
5322 OBJECT_AREA:
5323 begin
5324 CopyBuffer[b].ObjectType := OBJECT_AREA;
5325 CopyBuffer[b].Area := gAreas[ID];
5326 end;
5328 OBJECT_TRIGGER:
5329 begin
5330 CopyBuffer[b].ObjectType := OBJECT_TRIGGER;
5331 CopyBuffer[b].Trigger := gTriggers[ID];
5332 end;
5333 end;
5334 end;
5336 // Сортировка по ID:
5337 if CopyBuffer <> nil then
5338 begin
5339 QuickSortCopyBuffer(0, b);
5340 end;
5342 // Пестановка ссылок триггеров:
5343 for a := 0 to Length(CopyBuffer)-1 do
5344 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
5345 begin
5346 case CopyBuffer[a].Trigger.TriggerType of
5347 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5348 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
5349 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
5350 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
5351 begin
5352 ok := False;
5354 for b := 0 to Length(CopyBuffer)-1 do
5355 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5356 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.PanelID) then
5357 begin
5358 CopyBuffer[a].Trigger.Data.PanelID := b;
5359 ok := True;
5360 Break;
5361 end;
5363 // Этих панелей нет среди копируемых:
5364 if not ok then
5365 CopyBuffer[a].Trigger.Data.PanelID := -1;
5366 end;
5368 TRIGGER_PRESS, TRIGGER_ON,
5369 TRIGGER_OFF, TRIGGER_ONOFF:
5370 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
5371 begin
5372 ok := False;
5374 for b := 0 to Length(CopyBuffer)-1 do
5375 if (CopyBuffer[b].ObjectType = OBJECT_MONSTER) and
5376 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.MonsterID-1) then
5377 begin
5378 CopyBuffer[a].Trigger.Data.MonsterID := b+1;
5379 ok := True;
5380 Break;
5381 end;
5383 // Этих монстров нет среди копируемых:
5384 if not ok then
5385 CopyBuffer[a].Trigger.Data.MonsterID := 0;
5386 end;
5388 TRIGGER_SHOT:
5389 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
5390 begin
5391 ok := False;
5393 for b := 0 to Length(CopyBuffer)-1 do
5394 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5395 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.Data.ShotPanelID) then
5396 begin
5397 CopyBuffer[a].Trigger.Data.ShotPanelID := b;
5398 ok := True;
5399 Break;
5400 end;
5402 // Этих панелей нет среди копируемых:
5403 if not ok then
5404 CopyBuffer[a].Trigger.Data.ShotPanelID := -1;
5405 end;
5406 end;
5408 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
5409 begin
5410 ok := False;
5412 for b := 0 to Length(CopyBuffer)-1 do
5413 if (CopyBuffer[b].ObjectType = OBJECT_PANEL) and
5414 (Integer(CopyBuffer[b].ID) = CopyBuffer[a].Trigger.TexturePanel) then
5415 begin
5416 CopyBuffer[a].Trigger.TexturePanel := b;
5417 ok := True;
5418 Break;
5419 end;
5421 // Этих панелей нет среди копируемых:
5422 if not ok then
5423 CopyBuffer[a].Trigger.TexturePanel := -1;
5424 end;
5425 end;
5427 // В буфер обмена:
5428 str := CopyBufferToString(CopyBuffer);
5429 ClipBoard.AsText := str;
5431 for a := 0 to Length(CopyBuffer)-1 do
5432 if (CopyBuffer[a].ObjectType = OBJECT_PANEL) and
5433 (CopyBuffer[a].Panel <> nil) then
5434 Dispose(CopyBuffer[a].Panel);
5436 CopyBuffer := nil;
5437 end;
5439 procedure TMainForm.aPasteObjectExecute(Sender: TObject);
5440 var
5441 a, h: Integer;
5442 CopyBuffer: TCopyRecArray;
5443 res, rel: Boolean;
5444 swad, ssec, sres: String;
5445 NoTextureID: DWORD;
5446 pmin: TPoint;
5447 begin
5448 CopyBuffer := nil;
5449 NoTextureID := 0;
5450 pmin.X := High(pmin.X);
5451 pmin.Y := High(pmin.Y);
5453 StringToCopyBuffer(ClipBoard.AsText, CopyBuffer, pmin);
5454 rel := not(ssShift in GetKeyShiftState());
5456 if CopyBuffer = nil then
5457 Exit;
5459 RemoveSelectFromObjects();
5461 h := High(CopyBuffer);
5462 for a := 0 to h do
5463 with CopyBuffer[a] do
5464 begin
5465 case ObjectType of
5466 OBJECT_PANEL:
5467 if Panel <> nil then
5468 begin
5469 if rel then
5470 begin
5471 Panel^.X := Panel^.X - pmin.X - MapOffset.X + 32;
5472 Panel^.Y := Panel^.Y - pmin.Y - MapOffset.Y + 32;
5473 end;
5475 Panel^.TextureID := TEXTURE_SPECIAL_NONE;
5476 Panel^.TextureWidth := 1;
5477 Panel^.TextureHeight := 1;
5479 if (Panel^.PanelType = PANEL_LIFTUP) or
5480 (Panel^.PanelType = PANEL_LIFTDOWN) or
5481 (Panel^.PanelType = PANEL_LIFTLEFT) or
5482 (Panel^.PanelType = PANEL_LIFTRIGHT) or
5483 (Panel^.PanelType = PANEL_BLOCKMON) or
5484 (Panel^.TextureName = '') then
5485 begin // Нет или не может быть текстуры:
5486 end
5487 else // Есть текстура:
5488 begin
5489 // Обычная текстура:
5490 if not IsSpecialTexture(Panel^.TextureName) then
5491 begin
5492 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5494 if not res then
5495 begin
5496 g_ProcessResourceStr(Panel^.TextureName, swad, ssec, sres);
5497 AddTexture(swad, ssec, sres, True);
5498 res := g_GetTexture(Panel^.TextureName, Panel^.TextureID);
5499 end;
5501 if res then
5502 g_GetTextureSizeByName(Panel^.TextureName,
5503 Panel^.TextureWidth, Panel^.TextureHeight)
5504 else
5505 if g_GetTexture('NOTEXTURE', NoTextureID) then
5506 begin
5507 Panel^.TextureID := TEXTURE_SPECIAL_NOTEXTURE;
5508 g_GetTextureSizeByID(NoTextureID, Panel^.TextureWidth, Panel^.TextureHeight);
5509 end;
5510 end
5511 else // Спец.текстура:
5512 begin
5513 Panel^.TextureID := SpecialTextureID(Panel^.TextureName);
5514 with MainForm.lbTextureList.Items do
5515 if IndexOf(Panel^.TextureName) = -1 then
5516 Add(Panel^.TextureName);
5517 end;
5518 end;
5520 ID := AddPanel(Panel^);
5521 Dispose(Panel);
5522 Undo_Add(OBJECT_PANEL, ID, a > 0);
5523 SelectObject(OBJECT_PANEL, ID, True);
5524 end;
5526 OBJECT_ITEM:
5527 begin
5528 if rel then
5529 begin
5530 Item.X := Item.X - pmin.X - MapOffset.X + 32;
5531 Item.Y := Item.Y - pmin.Y - MapOffset.Y + 32;
5532 end;
5534 ID := AddItem(Item);
5535 Undo_Add(OBJECT_ITEM, ID, a > 0);
5536 SelectObject(OBJECT_ITEM, ID, True);
5537 end;
5539 OBJECT_MONSTER:
5540 begin
5541 if rel then
5542 begin
5543 Monster.X := Monster.X - pmin.X - MapOffset.X + 32;
5544 Monster.Y := Monster.Y - pmin.Y - MapOffset.Y + 32;
5545 end;
5547 ID := AddMonster(Monster);
5548 Undo_Add(OBJECT_MONSTER, ID, a > 0);
5549 SelectObject(OBJECT_MONSTER, ID, True);
5550 end;
5552 OBJECT_AREA:
5553 begin
5554 if rel then
5555 begin
5556 Area.X := Area.X - pmin.X - MapOffset.X + 32;
5557 Area.Y := Area.Y - pmin.Y - MapOffset.Y + 32;
5558 end;
5560 ID := AddArea(Area);
5561 Undo_Add(OBJECT_AREA, ID, a > 0);
5562 SelectObject(OBJECT_AREA, ID, True);
5563 end;
5565 OBJECT_TRIGGER:
5566 begin
5567 if rel then
5568 with Trigger do
5569 begin
5570 X := X - pmin.X - MapOffset.X + 32;
5571 Y := Y - pmin.Y - MapOffset.Y + 32;
5573 case TriggerType of
5574 TRIGGER_TELEPORT:
5575 begin
5576 Data.TargetPoint.X :=
5577 Data.TargetPoint.X - pmin.X - MapOffset.X + 32;
5578 Data.TargetPoint.Y :=
5579 Data.TargetPoint.Y - pmin.Y - MapOffset.Y + 32;
5580 end;
5581 TRIGGER_PRESS, TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF:
5582 begin
5583 Data.tX := Data.tX - pmin.X - MapOffset.X + 32;
5584 Data.tY := Data.tY - pmin.Y - MapOffset.Y + 32;
5585 end;
5586 TRIGGER_SPAWNMONSTER:
5587 begin
5588 Data.MonPos.X :=
5589 Data.MonPos.X - pmin.X - MapOffset.X + 32;
5590 Data.MonPos.Y :=
5591 Data.MonPos.Y - pmin.Y - MapOffset.Y + 32;
5592 end;
5593 TRIGGER_SPAWNITEM:
5594 begin
5595 Data.ItemPos.X :=
5596 Data.ItemPos.X - pmin.X - MapOffset.X + 32;
5597 Data.ItemPos.Y :=
5598 Data.ItemPos.Y - pmin.Y - MapOffset.Y + 32;
5599 end;
5600 TRIGGER_SHOT:
5601 begin
5602 Data.ShotPos.X :=
5603 Data.ShotPos.X - pmin.X - MapOffset.X + 32;
5604 Data.ShotPos.Y :=
5605 Data.ShotPos.Y - pmin.Y - MapOffset.Y + 32;
5606 end;
5607 end;
5608 end;
5610 ID := AddTrigger(Trigger);
5611 Undo_Add(OBJECT_TRIGGER, ID, a > 0);
5612 SelectObject(OBJECT_TRIGGER, ID, True);
5613 end;
5614 end;
5615 end;
5617 // Переставляем ссылки триггеров:
5618 for a := 0 to High(CopyBuffer) do
5619 if CopyBuffer[a].ObjectType = OBJECT_TRIGGER then
5620 begin
5621 case CopyBuffer[a].Trigger.TriggerType of
5622 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
5623 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
5624 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
5625 if CopyBuffer[a].Trigger.Data.PanelID <> -1 then
5626 gTriggers[CopyBuffer[a].ID].Data.PanelID :=
5627 CopyBuffer[CopyBuffer[a].Trigger.Data.PanelID].ID;
5629 TRIGGER_PRESS, TRIGGER_ON,
5630 TRIGGER_OFF, TRIGGER_ONOFF:
5631 if CopyBuffer[a].Trigger.Data.MonsterID <> 0 then
5632 gTriggers[CopyBuffer[a].ID].Data.MonsterID :=
5633 CopyBuffer[CopyBuffer[a].Trigger.Data.MonsterID-1].ID+1;
5635 TRIGGER_SHOT:
5636 if CopyBuffer[a].Trigger.Data.ShotPanelID <> -1 then
5637 gTriggers[CopyBuffer[a].ID].Data.ShotPanelID :=
5638 CopyBuffer[CopyBuffer[a].Trigger.Data.ShotPanelID].ID;
5639 end;
5641 if CopyBuffer[a].Trigger.TexturePanel <> -1 then
5642 gTriggers[CopyBuffer[a].ID].TexturePanel :=
5643 CopyBuffer[CopyBuffer[a].Trigger.TexturePanel].ID;
5644 end;
5646 CopyBuffer := nil;
5648 if h = 0 then
5649 FillProperty();
5650 end;
5652 procedure TMainForm.aCutObjectExecute(Sender: TObject);
5653 begin
5654 miCopy.Click();
5655 DeleteSelectedObjects();
5656 end;
5658 procedure TMainForm.vleObjectPropertyEditButtonClick(Sender: TObject);
5659 var
5660 Key, FileName: String;
5661 b: Byte;
5662 begin
5663 Key := vleObjectProperty.Keys[vleObjectProperty.Row];
5665 if Key = _lc[I_PROP_PANEL_TYPE] then
5666 begin
5667 with ChooseTypeForm, vleObjectProperty do
5668 begin // Выбор типа панели:
5669 Caption := _lc[I_PROP_PANEL_TYPE];
5670 lbTypeSelect.Items.Clear();
5672 for b := 0 to High(PANELNAMES) do
5673 begin
5674 lbTypeSelect.Items.Add(PANELNAMES[b]);
5675 if Values[Key] = PANELNAMES[b] then
5676 lbTypeSelect.ItemIndex := b;
5677 end;
5679 if ShowModal() = mrOK then
5680 begin
5681 b := lbTypeSelect.ItemIndex;
5682 Values[Key] := PANELNAMES[b];
5683 vleObjectPropertyApply(Sender);
5684 end;
5685 end
5686 end
5687 else if Key = _lc[I_PROP_TR_TELEPORT_TO] then
5688 SelectFlag := SELECTFLAG_TELEPORT
5689 else if Key = _lc[I_PROP_TR_SPAWN_TO] then
5690 SelectFlag := SELECTFLAG_SPAWNPOINT
5691 else if (Key = _lc[I_PROP_TR_DOOR_PANEL]) or
5692 (Key = _lc[I_PROP_TR_TRAP_PANEL]) then
5693 SelectFlag := SELECTFLAG_DOOR
5694 else if Key = _lc[I_PROP_TR_TEXTURE_PANEL] then
5695 begin
5696 DrawPressRect := False;
5697 SelectFlag := SELECTFLAG_TEXTURE;
5698 end
5699 else if Key = _lc[I_PROP_TR_SHOT_PANEL] then
5700 SelectFlag := SELECTFLAG_SHOTPANEL
5701 else if Key = _lc[I_PROP_TR_LIFT_PANEL] then
5702 SelectFlag := SELECTFLAG_LIFT
5703 else if key = _lc[I_PROP_TR_EX_MONSTER] then
5704 SelectFlag := SELECTFLAG_MONSTER
5705 else if Key = _lc[I_PROP_TR_EX_AREA] then
5706 begin
5707 SelectFlag := SELECTFLAG_NONE;
5708 DrawPressRect := True;
5709 end
5710 else if Key = _lc[I_PROP_TR_NEXT_MAP] then
5711 begin // Выбор следующей карты:
5712 g_ProcessResourceStr(OpenedMap, @FileName, nil, nil);
5713 SelectMapForm.Caption := _lc[I_CAP_SELECT];
5714 SelectMapForm.GetMaps(FileName);
5716 if SelectMapForm.ShowModal() = mrOK then
5717 begin
5718 vleObjectProperty.Values[Key] := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
5719 vleObjectPropertyApply(Sender);
5720 end;
5721 end
5722 else if (Key = _lc[I_PROP_TR_SOUND_NAME]) or
5723 (Key = _lc[I_PROP_TR_MUSIC_NAME]) then
5724 begin // Выбор файла звука/музыки:
5725 AddSoundForm.OKFunction := nil;
5726 AddSoundForm.lbResourcesList.MultiSelect := False;
5727 AddSoundForm.SetResource := vleObjectProperty.Values[Key];
5729 if (AddSoundForm.ShowModal() = mrOk) then
5730 begin
5731 vleObjectProperty.Values[Key] := AddSoundForm.ResourceName;
5732 vleObjectPropertyApply(Sender);
5733 end;
5734 end
5735 else if Key = _lc[I_PROP_TR_ACTIVATION] then
5736 with ActivationTypeForm, vleObjectProperty do
5737 begin // Выбор типов активации:
5738 cbPlayerCollide.Checked := Pos('PC', Values[Key]) > 0;
5739 cbMonsterCollide.Checked := Pos('MC', Values[Key]) > 0;
5740 cbPlayerPress.Checked := Pos('PP', Values[Key]) > 0;
5741 cbMonsterPress.Checked := Pos('MP', Values[Key]) > 0;
5742 cbShot.Checked := Pos('SH', Values[Key]) > 0;
5743 cbNoMonster.Checked := Pos('NM', Values[Key]) > 0;
5745 if ShowModal() = mrOK then
5746 begin
5747 b := 0;
5748 if cbPlayerCollide.Checked then
5749 b := ACTIVATE_PLAYERCOLLIDE;
5750 if cbMonsterCollide.Checked then
5751 b := b or ACTIVATE_MONSTERCOLLIDE;
5752 if cbPlayerPress.Checked then
5753 b := b or ACTIVATE_PLAYERPRESS;
5754 if cbMonsterPress.Checked then
5755 b := b or ACTIVATE_MONSTERPRESS;
5756 if cbShot.Checked then
5757 b := b or ACTIVATE_SHOT;
5758 if cbNoMonster.Checked then
5759 b := b or ACTIVATE_NOMONSTER;
5761 Values[Key] := ActivateToStr(b);
5762 vleObjectPropertyApply(Sender);
5763 end;
5764 end
5765 else if Key = _lc[I_PROP_TR_KEYS] then
5766 with KeysForm, vleObjectProperty do
5767 begin // Выбор необходимых ключей:
5768 cbRedKey.Checked := Pos('RK', Values[Key]) > 0;
5769 cbGreenKey.Checked := Pos('GK', Values[Key]) > 0;
5770 cbBlueKey.Checked := Pos('BK', Values[Key]) > 0;
5771 cbRedTeam.Checked := Pos('RT', Values[Key]) > 0;
5772 cbBlueTeam.Checked := Pos('BT', Values[Key]) > 0;
5774 if ShowModal() = mrOK then
5775 begin
5776 b := 0;
5777 if cbRedKey.Checked then
5778 b := KEY_RED;
5779 if cbGreenKey.Checked then
5780 b := b or KEY_GREEN;
5781 if cbBlueKey.Checked then
5782 b := b or KEY_BLUE;
5783 if cbRedTeam.Checked then
5784 b := b or KEY_REDTEAM;
5785 if cbBlueTeam.Checked then
5786 b := b or KEY_BLUETEAM;
5788 Values[Key] := KeyToStr(b);
5789 vleObjectPropertyApply(Sender);
5790 end;
5791 end
5792 else if Key = _lc[I_PROP_TR_FX_TYPE] then
5793 with ChooseTypeForm, vleObjectProperty do
5794 begin // Выбор типа эффекта:
5795 Caption := _lc[I_CAP_FX_TYPE];
5796 lbTypeSelect.Items.Clear();
5798 for b := EFFECT_NONE to EFFECT_FIRE do
5799 lbTypeSelect.Items.Add(EffectToStr(b));
5801 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]);
5803 if ShowModal() = mrOK then
5804 begin
5805 b := lbTypeSelect.ItemIndex;
5806 Values[Key] := EffectToStr(b);
5807 vleObjectPropertyApply(Sender);
5808 end;
5809 end
5810 else if Key = _lc[I_PROP_TR_MONSTER_TYPE] then
5811 with ChooseTypeForm, vleObjectProperty do
5812 begin // Выбор типа монстра:
5813 Caption := _lc[I_CAP_MONSTER_TYPE];
5814 lbTypeSelect.Items.Clear();
5816 for b := MONSTER_DEMON to MONSTER_MAN do
5817 lbTypeSelect.Items.Add(MonsterToStr(b));
5819 lbTypeSelect.ItemIndex := StrToMonster(Values[Key]) - MONSTER_DEMON;
5821 if ShowModal() = mrOK then
5822 begin
5823 b := lbTypeSelect.ItemIndex + MONSTER_DEMON;
5824 Values[Key] := MonsterToStr(b);
5825 vleObjectPropertyApply(Sender);
5826 end;
5827 end
5828 else if Key = _lc[I_PROP_TR_ITEM_TYPE] then
5829 with ChooseTypeForm, vleObjectProperty do
5830 begin // Выбор типа предмета:
5831 Caption := _lc[I_CAP_ITEM_TYPE];
5832 lbTypeSelect.Items.Clear();
5834 for b := ITEM_MEDKIT_SMALL to ITEM_KEY_BLUE do
5835 lbTypeSelect.Items.Add(ItemToStr(b));
5836 lbTypeSelect.Items.Add(ItemToStr(ITEM_BOTTLE));
5837 lbTypeSelect.Items.Add(ItemToStr(ITEM_HELMET));
5838 lbTypeSelect.Items.Add(ItemToStr(ITEM_JETPACK));
5839 lbTypeSelect.Items.Add(ItemToStr(ITEM_INVIS));
5840 lbTypeSelect.Items.Add(ItemToStr(ITEM_WEAPON_FLAMETHROWER));
5841 lbTypeSelect.Items.Add(ItemToStr(ITEM_AMMO_FUELCAN));
5843 b := StrToItem(Values[Key]);
5844 if b >= ITEM_BOTTLE then
5845 b := b - 2;
5846 lbTypeSelect.ItemIndex := b - ITEM_MEDKIT_SMALL;
5848 if ShowModal() = mrOK then
5849 begin
5850 b := lbTypeSelect.ItemIndex + ITEM_MEDKIT_SMALL;
5851 if b >= ITEM_WEAPON_KASTET then
5852 b := b + 2;
5853 Values[Key] := ItemToStr(b);
5854 vleObjectPropertyApply(Sender);
5855 end;
5856 end
5857 else if Key = _lc[I_PROP_TR_SHOT_TYPE] then
5858 with ChooseTypeForm, vleObjectProperty do
5859 begin // Выбор типа предмета:
5860 Caption := _lc[I_PROP_TR_SHOT_TYPE];
5861 lbTypeSelect.Items.Clear();
5863 for b := TRIGGER_SHOT_PISTOL to TRIGGER_SHOT_MAX do
5864 lbTypeSelect.Items.Add(ShotToStr(b));
5866 lbTypeSelect.ItemIndex := StrToShot(Values[Key]);
5868 if ShowModal() = mrOK then
5869 begin
5870 b := lbTypeSelect.ItemIndex;
5871 Values[Key] := ShotToStr(b);
5872 vleObjectPropertyApply(Sender);
5873 end;
5874 end
5875 else if Key = _lc[I_PROP_TR_EFFECT_TYPE] then
5876 with ChooseTypeForm, vleObjectProperty do
5877 begin // Выбор типа эффекта:
5878 Caption := _lc[I_CAP_FX_TYPE];
5879 lbTypeSelect.Items.Clear();
5881 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_PARTICLE]);
5882 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_ANIMATION]);
5883 if Values[Key] = _lc[I_PROP_TR_EFFECT_ANIMATION] then
5884 lbTypeSelect.ItemIndex := 1
5885 else
5886 lbTypeSelect.ItemIndex := 0;
5888 if ShowModal() = mrOK then
5889 begin
5890 b := lbTypeSelect.ItemIndex;
5891 if b = 0 then
5892 Values[Key] := _lc[I_PROP_TR_EFFECT_PARTICLE]
5893 else
5894 Values[Key] := _lc[I_PROP_TR_EFFECT_ANIMATION];
5895 vleObjectPropertyApply(Sender);
5896 end;
5897 end
5898 else if Key = _lc[I_PROP_TR_EFFECT_SUBTYPE] then
5899 with ChooseTypeForm, vleObjectProperty do
5900 begin // Выбор подтипа эффекта:
5901 Caption := _lc[I_CAP_FX_TYPE];
5902 lbTypeSelect.Items.Clear();
5904 if Values[_lc[I_PROP_TR_EFFECT_TYPE]] = _lc[I_PROP_TR_EFFECT_ANIMATION] then
5905 begin
5906 for b := EFFECT_TELEPORT to EFFECT_FIRE do
5907 lbTypeSelect.Items.Add(EffectToStr(b));
5909 lbTypeSelect.ItemIndex := StrToEffect(Values[Key]) - 1;
5910 end else
5911 begin
5912 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_SLIQUID]);
5913 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_LLIQUID]);
5914 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_DLIQUID]);
5915 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_BLOOD]);
5916 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_SPARK]);
5917 lbTypeSelect.Items.Add(_lc[I_PROP_TR_EFFECT_BUBBLE]);
5918 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SLIQUID;
5919 if Values[Key] = _lc[I_PROP_TR_EFFECT_LLIQUID] then
5920 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_LLIQUID;
5921 if Values[Key] = _lc[I_PROP_TR_EFFECT_DLIQUID] then
5922 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_DLIQUID;
5923 if Values[Key] = _lc[I_PROP_TR_EFFECT_BLOOD] then
5924 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BLOOD;
5925 if Values[Key] = _lc[I_PROP_TR_EFFECT_SPARK] then
5926 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_SPARK;
5927 if Values[Key] = _lc[I_PROP_TR_EFFECT_BUBBLE] then
5928 lbTypeSelect.ItemIndex := TRIGGER_EFFECT_BUBBLE;
5929 end;
5931 if ShowModal() = mrOK then
5932 begin
5933 b := lbTypeSelect.ItemIndex;
5935 if Values[_lc[I_PROP_TR_EFFECT_TYPE]] = _lc[I_PROP_TR_EFFECT_ANIMATION] then
5936 Values[Key] := EffectToStr(b + 1)
5937 else begin
5938 Values[Key] := _lc[I_PROP_TR_EFFECT_SLIQUID];
5939 if b = TRIGGER_EFFECT_LLIQUID then
5940 Values[Key] := _lc[I_PROP_TR_EFFECT_LLIQUID];
5941 if b = TRIGGER_EFFECT_DLIQUID then
5942 Values[Key] := _lc[I_PROP_TR_EFFECT_DLIQUID];
5943 if b = TRIGGER_EFFECT_BLOOD then
5944 Values[Key] := _lc[I_PROP_TR_EFFECT_BLOOD];
5945 if b = TRIGGER_EFFECT_SPARK then
5946 Values[Key] := _lc[I_PROP_TR_EFFECT_SPARK];
5947 if b = TRIGGER_EFFECT_BUBBLE then
5948 Values[Key] := _lc[I_PROP_TR_EFFECT_BUBBLE];
5949 end;
5951 vleObjectPropertyApply(Sender);
5952 end;
5953 end
5954 else if Key = _lc[I_PROP_TR_EFFECT_COLOR] then
5955 with vleObjectProperty do
5956 begin // Выбор цвета эффекта:
5957 ColorDialog.Color := StrToIntDef(Values[Key], 0);
5958 if ColorDialog.Execute then
5959 begin
5960 Values[Key] := IntToStr(ColorDialog.Color);
5961 vleObjectPropertyApply(Sender);
5962 end;
5963 end
5964 else if Key = _lc[I_PROP_PANEL_TEX] then
5965 begin // Смена текстуры:
5966 vleObjectProperty.Values[Key] := SelectedTexture();
5967 vleObjectPropertyApply(Sender);
5968 end;
5969 end;
5971 procedure TMainForm.vleObjectPropertyApply(Sender: TObject);
5972 begin
5973 // hack to prevent empty ID in list
5974 RenderPanel.SetFocus();
5975 bApplyProperty.Click();
5976 vleObjectProperty.SetFocus();
5977 end;
5979 procedure TMainForm.aSaveMapExecute(Sender: TObject);
5980 var
5981 FileName, Section, Res: String;
5982 begin
5983 if OpenedMap = '' then
5984 begin
5985 aSaveMapAsExecute(nil);
5986 Exit;
5987 end;
5989 g_ProcessResourceStr(OpenedMap, FileName, Section, Res);
5991 SaveMap(FileName+':\'+Res);
5992 end;
5994 procedure TMainForm.aOpenMapExecute(Sender: TObject);
5995 begin
5996 OpenDialog.Filter := _lc[I_FILE_FILTER_ALL];
5998 if OpenDialog.Execute() then
5999 begin
6000 OpenMapFile(OpenDialog.FileName);
6001 OpenDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
6002 end;
6003 end;
6005 procedure TMainForm.OpenMapFile(FileName: String);
6006 begin
6007 if (Pos('.ini', LowerCase(ExtractFileName(FileName))) > 0) then
6008 begin // INI карты:
6009 FullClear();
6011 pLoadProgress.Left := (RenderPanel.Width div 2)-(pLoadProgress.Width div 2);
6012 pLoadProgress.Top := (RenderPanel.Height div 2)-(pLoadProgress.Height div 2);
6013 pLoadProgress.Show();
6015 OpenedMap := '';
6016 OpenedWAD := '';
6018 LoadMapOld(FileName);
6020 MainForm.Caption := Format('%s - %s', [FormCaption, ExtractFileName(FileName)]);
6022 pLoadProgress.Hide();
6023 MainForm.FormResize(Self);
6024 end
6025 else // Карты из WAD:
6026 begin
6027 OpenMap(FileName, '');
6028 end;
6029 end;
6031 procedure TMainForm.FormActivate(Sender: TObject);
6032 var
6033 lang: Integer;
6034 config: TConfig;
6035 begin
6036 MainForm.ActiveControl := RenderPanel;
6038 // Язык:
6039 if gLanguage = '' then
6040 begin
6041 lang := SelectLanguageForm.ShowModal();
6042 case lang of
6043 1: gLanguage := LANGUAGE_ENGLISH;
6044 else gLanguage := LANGUAGE_RUSSIAN;
6045 end;
6047 config := TConfig.CreateFile(EditorDir+'Editor.cfg');
6048 config.WriteStr('Editor', 'Language', gLanguage);
6049 config.SaveFile(EditorDir+'Editor.cfg');
6050 config.Free();
6051 end;
6053 //e_WriteLog('Read language file', MSG_NOTIFY);
6054 //g_Language_Load(EditorDir+'\data\'+gLanguage+LANGUAGE_FILE_NAME);
6055 g_Language_Set(gLanguage);
6056 end;
6058 procedure TMainForm.aDeleteMap(Sender: TObject);
6059 var
6060 WAD: TWADEditor_1;
6061 MapList: SArray;
6062 MapName: Char16;
6063 a: Integer;
6064 str: String;
6065 begin
6066 OpenDialog.Filter := _lc[I_FILE_FILTER_WAD];
6068 if not OpenDialog.Execute() then
6069 Exit;
6071 WAD := TWADEditor_1.Create();
6073 if not WAD.ReadFile(OpenDialog.FileName) then
6074 begin
6075 WAD.Free();
6076 Exit;
6077 end;
6079 WAD.CreateImage();
6081 MapList := WAD.GetResourcesList('');
6083 SelectMapForm.Caption := _lc[I_CAP_REMOVE];
6084 SelectMapForm.lbMapList.Items.Clear();
6086 if MapList <> nil then
6087 for a := 0 to High(MapList) do
6088 SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a]));
6090 if (SelectMapForm.ShowModal() = mrOK) then
6091 begin
6092 str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
6093 MapName := '';
6094 Move(str[1], MapName[0], Min(16, Length(str)));
6096 if MessageBox(0, PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT],
6097 [MapName, OpenDialog.FileName])),
6098 PChar(_lc[I_MSG_DELETE_MAP]),
6099 MB_ICONQUESTION or MB_YESNO or
6100 MB_DEFBUTTON2) <> mrYes then
6101 Exit;
6103 WAD.RemoveResource('', utf2win(MapName));
6105 MessageBox(0, PChar(Format(_lc[I_MSG_MAP_DELETED_PROMT],
6106 [MapName])),
6107 PChar(_lc[I_MSG_MAP_DELETED]),
6108 MB_ICONINFORMATION or MB_OK or
6109 MB_DEFBUTTON1);
6111 WAD.SaveTo(OpenDialog.FileName);
6113 // Удалили текущую карту - сохранять по старому ее нельзя:
6114 if OpenedMap = (OpenDialog.FileName+':\'+MapName) then
6115 begin
6116 OpenedMap := '';
6117 OpenedWAD := '';
6118 MainForm.Caption := FormCaption;
6119 end;
6120 end;
6122 WAD.Free();
6123 end;
6125 procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject;
6126 var Key: Word; Shift: TShiftState);
6127 begin
6128 if Key = VK_RETURN then
6129 vleObjectPropertyApply(Sender);
6130 end;
6132 procedure MovePanel(var ID: DWORD; MoveType: Byte);
6133 var
6134 _id, a: Integer;
6135 tmp: TPanel;
6136 begin
6137 if (ID = 0) and (MoveType = 0) then
6138 Exit;
6139 if (ID = DWORD(High(gPanels))) and (MoveType <> 0) then
6140 Exit;
6141 if (ID > DWORD(High(gPanels))) then
6142 Exit;
6144 _id := Integer(ID);
6146 if MoveType = 0 then // to Back
6147 begin
6148 if gTriggers <> nil then
6149 for a := 0 to High(gTriggers) do
6150 with gTriggers[a] do
6151 begin
6152 if TriggerType = TRIGGER_NONE then
6153 Continue;
6155 if TexturePanel = _id then
6156 TexturePanel := 0
6157 else
6158 if (TexturePanel >= 0) and (TexturePanel < _id) then
6159 Inc(TexturePanel);
6161 case TriggerType of
6162 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6163 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6164 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6165 if Data.PanelID = _id then
6166 Data.PanelID := 0
6167 else
6168 if (Data.PanelID >= 0) and (Data.PanelID < _id) then
6169 Inc(Data.PanelID);
6171 TRIGGER_SHOT:
6172 if Data.ShotPanelID = _id then
6173 Data.ShotPanelID := 0
6174 else
6175 if (Data.ShotPanelID >= 0) and (Data.ShotPanelID < _id) then
6176 Inc(Data.ShotPanelID);
6177 end;
6178 end;
6180 tmp := gPanels[_id];
6182 for a := _id downto 1 do
6183 gPanels[a] := gPanels[a-1];
6185 gPanels[0] := tmp;
6187 ID := 0;
6188 end
6189 else // to Front
6190 begin
6191 if gTriggers <> nil then
6192 for a := 0 to High(gTriggers) do
6193 with gTriggers[a] do
6194 begin
6195 if TriggerType = TRIGGER_NONE then
6196 Continue;
6198 if TexturePanel = _id then
6199 TexturePanel := High(gPanels)
6200 else
6201 if TexturePanel > _id then
6202 Dec(TexturePanel);
6204 case TriggerType of
6205 TRIGGER_OPENDOOR, TRIGGER_CLOSEDOOR, TRIGGER_DOOR,
6206 TRIGGER_DOOR5, TRIGGER_CLOSETRAP, TRIGGER_TRAP,
6207 TRIGGER_LIFTUP, TRIGGER_LIFTDOWN, TRIGGER_LIFT:
6208 if Data.PanelID = _id then
6209 Data.PanelID := High(gPanels)
6210 else
6211 if Data.PanelID > _id then
6212 Dec(Data.PanelID);
6214 TRIGGER_SHOT:
6215 if Data.ShotPanelID = _id then
6216 Data.ShotPanelID := High(gPanels)
6217 else
6218 if Data.ShotPanelID > _id then
6219 Dec(Data.ShotPanelID);
6220 end;
6221 end;
6223 tmp := gPanels[_id];
6225 for a := _id to High(gPanels)-1 do
6226 gPanels[a] := gPanels[a+1];
6228 gPanels[High(gPanels)] := tmp;
6230 ID := High(gPanels);
6231 end;
6232 end;
6234 procedure TMainForm.aMoveToBack(Sender: TObject);
6235 var
6236 a: Integer;
6237 begin
6238 if SelectedObjects = nil then
6239 Exit;
6241 for a := 0 to High(SelectedObjects) do
6242 with SelectedObjects[a] do
6243 if Live and (ObjectType = OBJECT_PANEL) then
6244 begin
6245 SelectedObjects[0] := SelectedObjects[a];
6246 SetLength(SelectedObjects, 1);
6247 MovePanel(ID, 0);
6248 FillProperty();
6249 Break;
6250 end;
6251 end;
6253 procedure TMainForm.aMoveToFore(Sender: TObject);
6254 var
6255 a: Integer;
6256 begin
6257 if SelectedObjects = nil then
6258 Exit;
6260 for a := 0 to High(SelectedObjects) do
6261 with SelectedObjects[a] do
6262 if Live and (ObjectType = OBJECT_PANEL) then
6263 begin
6264 SelectedObjects[0] := SelectedObjects[a];
6265 SetLength(SelectedObjects, 1);
6266 MovePanel(ID, 1);
6267 FillProperty();
6268 Break;
6269 end;
6270 end;
6272 procedure TMainForm.aSaveMapAsExecute(Sender: TObject);
6273 var
6274 idx: Integer;
6275 begin
6276 SaveDialog.Filter := _lc[I_FILE_FILTER_WAD];
6278 if not SaveDialog.Execute() then
6279 Exit;
6281 SaveMapForm.GetMaps(SaveDialog.FileName, True);
6283 if SaveMapForm.ShowModal() <> mrOK then
6284 Exit;
6286 SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName);
6287 OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text;
6288 OpenedWAD := SaveDialog.FileName;
6290 idx := RecentFiles.IndexOf(OpenedMap);
6291 // Такая карта уже недавно открывалась:
6292 if idx >= 0 then
6293 RecentFiles.Delete(idx);
6294 RecentFiles.Insert(0, OpenedMap);
6295 RefreshRecentMenu;
6297 SaveMap(OpenedMap);
6299 gMapInfo.FileName := SaveDialog.FileName;
6300 gMapInfo.MapName := SaveMapForm.eMapName.Text;
6301 UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
6302 end;
6304 procedure TMainForm.aSelectAllExecute(Sender: TObject);
6305 var
6306 a: Integer;
6307 begin
6308 RemoveSelectFromObjects();
6310 case pcObjects.ActivePageIndex+1 of
6311 OBJECT_PANEL:
6312 if gPanels <> nil then
6313 for a := 0 to High(gPanels) do
6314 if gPanels[a].PanelType <> PANEL_NONE then
6315 SelectObject(OBJECT_PANEL, a, True);
6316 OBJECT_ITEM:
6317 if gItems <> nil then
6318 for a := 0 to High(gItems) do
6319 if gItems[a].ItemType <> ITEM_NONE then
6320 SelectObject(OBJECT_ITEM, a, True);
6321 OBJECT_MONSTER:
6322 if gMonsters <> nil then
6323 for a := 0 to High(gMonsters) do
6324 if gMonsters[a].MonsterType <> MONSTER_NONE then
6325 SelectObject(OBJECT_MONSTER, a, True);
6326 OBJECT_AREA:
6327 if gAreas <> nil then
6328 for a := 0 to High(gAreas) do
6329 if gAreas[a].AreaType <> AREA_NONE then
6330 SelectObject(OBJECT_AREA, a, True);
6331 OBJECT_TRIGGER:
6332 if gTriggers <> nil then
6333 for a := 0 to High(gTriggers) do
6334 if gTriggers[a].TriggerType <> TRIGGER_NONE then
6335 SelectObject(OBJECT_TRIGGER, a, True);
6336 end;
6337 end;
6339 procedure TMainForm.tbGridOnClick(Sender: TObject);
6340 begin
6341 DotEnable := not DotEnable;
6342 (Sender as TToolButton).Down := DotEnable;
6343 end;
6345 procedure TMainForm.OnIdle(Sender: TObject; var Done: Boolean);
6346 begin
6347 // FIXME: this is a shitty hack
6348 if not gDataLoaded then
6349 begin
6350 e_WriteLog('Init OpenGL', MSG_NOTIFY);
6351 e_InitGL();
6352 e_WriteLog('Loading data', MSG_NOTIFY);
6353 LoadStdFont('STDTXT', 'STDFONT', gEditorFont);
6354 e_WriteLog('Loading more data', MSG_NOTIFY);
6355 LoadData();
6356 e_WriteLog('Loading even more data', MSG_NOTIFY);
6357 gDataLoaded := True;
6358 MainForm.FormResize(nil);
6359 end;
6360 Draw();
6361 end;
6363 procedure TMainForm.miMapPreviewClick(Sender: TObject);
6364 begin
6365 if PreviewMode = 2 then
6366 Exit;
6368 if PreviewMode = 0 then
6369 begin
6370 Splitter2.Visible := False;
6371 Splitter1.Visible := False;
6372 StatusBar.Visible := False;
6373 PanelObjs.Visible := False;
6374 PanelProps.Visible := False;
6375 MainToolBar.Visible := False;
6376 sbHorizontal.Visible := False;
6377 sbVertical.Visible := False;
6378 end
6379 else
6380 begin
6381 StatusBar.Visible := True;
6382 PanelObjs.Visible := True;
6383 PanelProps.Visible := True;
6384 Splitter2.Visible := True;
6385 Splitter1.Visible := True;
6386 MainToolBar.Visible := True;
6387 sbHorizontal.Visible := True;
6388 sbVertical.Visible := True;
6389 end;
6391 PreviewMode := PreviewMode xor 1;
6392 (Sender as TMenuItem).Checked := PreviewMode > 0;
6394 FormResize(Self);
6395 end;
6397 procedure TMainForm.miLayer1Click(Sender: TObject);
6398 begin
6399 SwitchLayer(LAYER_BACK);
6400 end;
6402 procedure TMainForm.miLayer2Click(Sender: TObject);
6403 begin
6404 SwitchLayer(LAYER_WALLS);
6405 end;
6407 procedure TMainForm.miLayer3Click(Sender: TObject);
6408 begin
6409 SwitchLayer(LAYER_FOREGROUND);
6410 end;
6412 procedure TMainForm.miLayer4Click(Sender: TObject);
6413 begin
6414 SwitchLayer(LAYER_STEPS);
6415 end;
6417 procedure TMainForm.miLayer5Click(Sender: TObject);
6418 begin
6419 SwitchLayer(LAYER_WATER);
6420 end;
6422 procedure TMainForm.miLayer6Click(Sender: TObject);
6423 begin
6424 SwitchLayer(LAYER_ITEMS);
6425 end;
6427 procedure TMainForm.miLayer7Click(Sender: TObject);
6428 begin
6429 SwitchLayer(LAYER_MONSTERS);
6430 end;
6432 procedure TMainForm.miLayer8Click(Sender: TObject);
6433 begin
6434 SwitchLayer(LAYER_AREAS);
6435 end;
6437 procedure TMainForm.miLayer9Click(Sender: TObject);
6438 begin
6439 SwitchLayer(LAYER_TRIGGERS);
6440 end;
6442 procedure TMainForm.tbShowClick(Sender: TObject);
6443 var
6444 a: Integer;
6445 b: Boolean;
6446 begin
6447 b := True;
6448 for a := 0 to High(LayerEnabled) do
6449 b := b and LayerEnabled[a];
6451 b := not b;
6453 ShowLayer(LAYER_BACK, b);
6454 ShowLayer(LAYER_WALLS, b);
6455 ShowLayer(LAYER_FOREGROUND, b);
6456 ShowLayer(LAYER_STEPS, b);
6457 ShowLayer(LAYER_WATER, b);
6458 ShowLayer(LAYER_ITEMS, b);
6459 ShowLayer(LAYER_MONSTERS, b);
6460 ShowLayer(LAYER_AREAS, b);
6461 ShowLayer(LAYER_TRIGGERS, b);
6462 end;
6464 procedure TMainForm.miMiniMapClick(Sender: TObject);
6465 begin
6466 SwitchMap();
6467 end;
6469 procedure TMainForm.miSwitchGridClick(Sender: TObject);
6470 begin
6471 if DotStep = DotStepOne then
6472 DotStep := DotStepTwo
6473 else
6474 DotStep := DotStepOne;
6476 MousePos.X := (MousePos.X div DotStep) * DotStep;
6477 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6478 end;
6480 procedure TMainForm.miShowEdgesClick(Sender: TObject);
6481 begin
6482 ShowEdges();
6483 end;
6485 procedure TMainForm.miSnapToGridClick(Sender: TObject);
6486 begin
6487 SnapToGrid := not SnapToGrid;
6489 MousePos.X := (MousePos.X div DotStep) * DotStep;
6490 MousePos.Y := (MousePos.Y div DotStep) * DotStep;
6492 miSnapToGrid.Checked := SnapToGrid;
6493 end;
6495 procedure TMainForm.minexttabClick(Sender: TObject);
6496 begin
6497 if pcObjects.ActivePageIndex < pcObjects.PageCount-1 then
6498 pcObjects.ActivePageIndex := pcObjects.ActivePageIndex+1
6499 else
6500 pcObjects.ActivePageIndex := 0;
6501 end;
6503 procedure TMainForm.miSaveMiniMapClick(Sender: TObject);
6504 begin
6505 SaveMiniMapForm.ShowModal();
6506 end;
6508 procedure TMainForm.bClearTextureClick(Sender: TObject);
6509 begin
6510 lbTextureList.ItemIndex := -1;
6511 lTextureWidth.Caption := '';
6512 lTextureHeight.Caption := '';
6513 end;
6515 procedure TMainForm.miPackMapClick(Sender: TObject);
6516 begin
6517 PackMapForm.ShowModal();
6518 end;
6520 procedure TMainForm.miMapTestSettingsClick(Sender: TObject);
6521 begin
6522 MapTestForm.ShowModal();
6523 end;
6525 procedure TMainForm.miTestMapClick(Sender: TObject);
6526 var
6527 cmd, mapWAD, mapToRun, tempWAD: String;
6528 opt: LongWord;
6529 time: Integer;
6530 proc: TProcessUTF8;
6531 res: Boolean;
6532 begin
6533 mapToRun := '';
6534 if OpenedMap <> '' then
6535 begin
6536 // Указываем текущую карту для теста:
6537 g_ProcessResourceStr(OpenedMap, @mapWAD, nil, @mapToRun);
6538 mapToRun := mapWAD + ':\' + mapToRun;
6539 mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', mapToRun);
6540 end;
6541 // Сохраняем временную карту:
6542 time := 0;
6543 repeat
6544 mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
6545 Inc(time);
6546 until not FileExists(mapWAD);
6547 tempWAD := mapWAD + ':\' + TEST_MAP_NAME;
6548 SaveMap(tempWAD);
6550 tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempWAD);
6551 // Если карта не была открыта, указываем временную в качестве текущей:
6552 if mapToRun = '' then
6553 mapToRun := tempWAD;
6555 // Опции игры:
6556 opt := 32 + 64;
6557 if TestOptionsTwoPlayers then
6558 opt := opt + 1;
6559 if TestOptionsTeamDamage then
6560 opt := opt + 2;
6561 if TestOptionsAllowExit then
6562 opt := opt + 4;
6563 if TestOptionsWeaponStay then
6564 opt := opt + 8;
6565 if TestOptionsMonstersDM then
6566 opt := opt + 16;
6568 // Составляем командную строку:
6569 cmd := '-map "' + mapToRun + '"';
6570 cmd := cmd + ' -testmap "' + tempWAD + '"';
6571 cmd := cmd + ' -gm ' + TestGameMode;
6572 cmd := cmd + ' -limt ' + TestLimTime;
6573 cmd := cmd + ' -lims ' + TestLimScore;
6574 cmd := cmd + ' -opt ' + IntToStr(opt);
6576 if TestMapOnce then
6577 cmd := cmd + ' --close';
6579 cmd := cmd + ' --debug';
6581 // Запускаем:
6582 proc := TProcessUTF8.Create(nil);
6583 proc.Executable := TestD2dExe;
6584 proc.Parameters.Add(cmd);
6585 res := True;
6586 try
6587 proc.Execute();
6588 except
6589 res := False;
6590 end;
6591 if res then
6592 begin
6593 Application.Minimize();
6594 proc.WaitOnExit();
6595 end;
6596 if (not res) or (proc.ExitCode < 0) then
6597 begin
6598 MessageBox(0, 'FIXME',
6599 PChar(_lc[I_MSG_EXEC_ERROR]),
6600 MB_OK or MB_ICONERROR);
6601 end;
6602 proc.Free();
6604 SysUtils.DeleteFile(mapWAD);
6605 Application.Restore();
6606 end;
6608 procedure TMainForm.sbVerticalScroll(Sender: TObject;
6609 ScrollCode: TScrollCode; var ScrollPos: Integer);
6610 begin
6611 MapOffset.Y := -Normalize16(sbVertical.Position);
6612 end;
6614 procedure TMainForm.sbHorizontalScroll(Sender: TObject;
6615 ScrollCode: TScrollCode; var ScrollPos: Integer);
6616 begin
6617 MapOffset.X := -Normalize16(sbHorizontal.Position);
6618 end;
6620 procedure TMainForm.miOpenWadMapClick(Sender: TObject);
6621 begin
6622 if OpenedWAD <> '' then
6623 begin
6624 OpenMap(OpenedWAD, '');
6625 end;
6626 end;
6628 procedure TMainForm.selectall1Click(Sender: TObject);
6629 var
6630 a: Integer;
6631 begin
6632 RemoveSelectFromObjects();
6634 if gPanels <> nil then
6635 for a := 0 to High(gPanels) do
6636 if gPanels[a].PanelType <> PANEL_NONE then
6637 SelectObject(OBJECT_PANEL, a, True);
6639 if gItems <> nil then
6640 for a := 0 to High(gItems) do
6641 if gItems[a].ItemType <> ITEM_NONE then
6642 SelectObject(OBJECT_ITEM, a, True);
6644 if gMonsters <> nil then
6645 for a := 0 to High(gMonsters) do
6646 if gMonsters[a].MonsterType <> MONSTER_NONE then
6647 SelectObject(OBJECT_MONSTER, a, True);
6649 if gAreas <> nil then
6650 for a := 0 to High(gAreas) do
6651 if gAreas[a].AreaType <> AREA_NONE then
6652 SelectObject(OBJECT_AREA, a, True);
6654 if gTriggers <> nil then
6655 for a := 0 to High(gTriggers) do
6656 if gTriggers[a].TriggerType <> TRIGGER_NONE then
6657 SelectObject(OBJECT_TRIGGER, a, True);
6658 end;
6660 procedure TMainForm.Splitter1CanResize(Sender: TObject;
6661 var NewSize: Integer; var Accept: Boolean);
6662 begin
6663 Accept := (NewSize > 140);
6664 end;
6666 procedure TMainForm.Splitter2CanResize(Sender: TObject;
6667 var NewSize: Integer; var Accept: Boolean);
6668 begin
6669 Accept := (NewSize > 110);
6670 end;
6672 procedure TMainForm.vleObjectPropertyEnter(Sender: TObject);
6673 begin
6674 EditingProperties := True;
6675 end;
6677 procedure TMainForm.vleObjectPropertyExit(Sender: TObject);
6678 begin
6679 EditingProperties := False;
6680 end;
6682 procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word;
6683 Shift: TShiftState);
6684 begin
6685 // Объекты передвигались:
6686 if MainForm.ActiveControl = RenderPanel then
6687 begin
6688 if (Key = VK_NUMPAD4) or
6689 (Key = VK_NUMPAD6) or
6690 (Key = VK_NUMPAD8) or
6691 (Key = VK_NUMPAD5) or
6692 (Key = Ord('V')) then
6693 FillProperty();
6694 end;
6695 // Быстрое превью карты:
6696 if Key = Ord('E') then
6697 begin
6698 if PreviewMode = 2 then
6699 PreviewMode := 0;
6700 end;
6701 end;
6703 end.