OSDN -- Desenvolver e Download de Software Open Source
Estado tradução de Português translation status for pt
  • R/O
  • SSH
  • HTTPS

srcseek: Commit


Commit MetaInfo

Revisão4 (tree)
Hora2009-04-12 00:00:18
Autorcherrybell

Mensagem de Log

(mensagem de log vazia)

Mudança Sumário

Diff

--- MLNox/MMapEdit.pas (nonexistent)
+++ MLNox/MMapEdit.pas (revision 4)
@@ -0,0 +1,609 @@
1+unit MMapEdit;
2+
3+interface
4+
5+uses
6+ SysUtils, Classes, Controls, ExtCtrls, Windows, Graphics, ABitmap,
7+ ABitmapFilters32, CMap, CMapUndo, ActnList, ClipBrd, ImgList, MMap;
8+
9+type
10+ TMapEditDrawMode = (mdNone, mdPen, mdRect, mdEllipse, mdFill, mdSelect);
11+ TSendCanCutProc = procedure(const CanClip : Boolean) of Object;
12+ TMapSizeOptimizer = function(const MapWidth,MapHeight : Integer):Integer of object;
13+
14+ TMapEditModule = class(TDataModule)
15+ ActionList1: TActionList;
16+ ImageList1: TImageList;
17+ Undo1: TAction;
18+ Redo1: TAction;
19+ Cut1: TAction;
20+ Copy1: TAction;
21+ Paste1: TAction;
22+ Zoom1: TAction;
23+ Zoom2: TAction;
24+ Zoom4: TAction;
25+ Zoom8: TAction;
26+ ZoomIn1: TAction;
27+ ZoomOut1: TAction;
28+ RightZoom1: TAction;
29+ MapClear1: TAction;
30+ Option1: TAction;
31+ Delete1: TAction;
32+ procedure DataModuleCreate(Sender: TObject);
33+ procedure DataModuleDestroy(Sender: TObject);
34+ procedure Copy1Execute(Sender: TObject);
35+ procedure Cut1Execute(Sender: TObject);
36+ procedure ChangeZoom(Sender: TObject);
37+ procedure UndoProc(Sender: TObject);
38+ procedure MapFuncExecute(Sender: TObject);
39+ procedure Delete1Execute(Sender: TObject);
40+ private
41+ { Private 宣言 }
42+ FListDrawType : TMapListDrawType;
43+ FChipBitmap,FVisibleBitmap : TABitmap;
44+ FDrawMode : TMapEditDrawMode;
45+ FChipJanre : Integer;
46+ FEditChip : TSRCMapChip;
47+ FMapUndo : TSRCMapUndoList;
48+ FFirstSelect,FSecondSelect : TPoint;
49+
50+ FUseMMX, FShowGrid : Boolean;
51+ FZoomPixel : Integer;
52+ FMapPaintBox,FChipPaintBox,FMapChipPreviewPaintBox : TPaintBox;
53+
54+ FOnZoomChange : TNotifyEvent;
55+ FOnMapSizeOptimize : TMapSizeOptimizer;
56+ FOnChangeChip : TNotifyEvent;
57+ FOnBeforeSizeChange,FOnAfterSizeChange : TNotifyEvent;
58+ FOnChange : TNotifyEvent;
59+ FOnNoPenMouseDown : TMouseEvent;
60+ FOnMouseRide : TMouseMoveEvent;
61+ FOnMapResize : TNotifyEvent;
62+ FTurnEditStop: Boolean;
63+ FOnNoPenMouseMove: TMouseMoveEvent;
64+ FOnNoPenMouseUp: TMouseEvent;
65+ FDeletePen : Boolean;
66+ FZooming : Boolean;
67+
68+ procedure SetChipJanre(const Index : Integer);
69+ procedure SetZoomPixel(const val : Integer);
70+ procedure SetMapPaintBox(val : TPaintBox);
71+ procedure SetChipPaintBox(val: TPaintBox);
72+ procedure SetMapChipPreviewPaintBox(val:TPaintBox);
73+ procedure SetMapUndo(val: TSRCMapUndoList);
74+ procedure SetDrawMode(const val : TMapEditDrawMode);
75+ procedure SetShowGrid(const Val : Boolean);
76+ procedure SetUseMMX(const Val : Boolean);
77+ procedure SetListDrawType(const Value: TMapListDrawType);
78+ function GetEditChip : TSRCMapChip;
79+ protected
80+ procedure ChipPaintBoxPaint(Sender:TObject);virtual;
81+
82+ procedure ChipPreviewPaintBoxPaint(Sender:TObject);virtual;
83+ procedure ChipPreviewPaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
84+ Shift: TShiftState; X, Y: Integer);virtual;
85+
86+ procedure MapPaintBoxPaint(Sender:TObject);virtual;
87+ procedure MapPaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
88+ Shift: TShiftState; X, Y: Integer);virtual;
89+ procedure MapPaintBoxMouseMove(Sender: TObject; Shift: TShiftState;
90+ X, Y: Integer);virtual;
91+ procedure MapPaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
92+ Shift: TShiftState; X, Y: Integer);virtual;
93+
94+ procedure MapPaintBoxSizeChange(Sender : TObject);virtual;
95+ procedure DoMapChange(Sender : TObject);
96+ public
97+ { Public 宣言 }
98+ procedure PasteClip(const X,Y:Integer;Clip:TSRCMapBuffer);
99+ procedure MapPaintBoxUpdate(Sender : TObject);virtual;
100+
101+ published
102+ property ListDrawType : TMapListDrawType read FListDrawType write SetListDrawType;
103+ property ChipBitmap : TABitmap read FChipBitmap;
104+ property VisibleBitmap : TABitmap read FVisibleBitmap;
105+ property DrawMode : TMapEditDrawMode read FDrawMode write SetDrawMode;
106+ property ChipJanre : Integer read FChipJanre write SetChipJanre;
107+ property SelectedChip : TSRCMapChip read FEditChip write FEditChip;
108+ property UseMMX : Boolean read FUseMMX write SetUseMMX;
109+ property ShowGrid : Boolean read FShowGrid write SetShowGrid;
110+ property ZoomPixel : Integer read FZoomPixel write SetZoomPixel;
111+
112+ property MapPaintBox : TPaintBox read FMapPaintBox write SetMapPaintBox;
113+ property ChipPaintBox : TPaintBox read FChipPaintBox write SetChipPaintBox;
114+ property MapChipPreviewPaintBox : TPaintBox read FMapChipPreviewPaintBox write SetMapChipPreviewPaintBox;
115+ property MapUndo : TSRCMapUndoList read FMapUndo write SetMapUndo;
116+
117+ property OnZoomChange : TNotifyEvent read FOnZoomChange write FOnZoomChange;
118+ property OnMapSizeOptimize : TMapSizeOptimizer read FOnMapSizeOptimize write FOnMapSizeOptimize;
119+ property OnChangeChip : TNotifyEvent read FOnChangeChip write FOnChangeChip;
120+ property OnBeforeSizeChange : TNotifyEvent read FOnBeforeSizeChange write FOnBeforeSizeChange;
121+ property OnAfterSizeChange : TNotifyEvent read FOnAfterSizeChange write FOnAfterSizeChange;
122+ property OnChange : TNotifyEvent read FOnChange write FOnChange;
123+ property OnNoPenMapDown : TMouseEvent read FOnNoPenMouseDown write FOnNoPenMouseDown;
124+ property OnNoPenMapMove : TMouseMoveEvent read FOnNoPenMouseMove write FOnNoPenMouseMove;
125+ property OnNoPenMapUp : TMouseEvent read FOnNoPenMouseUp write FOnNoPenMouseUp;
126+ property OnMapResize : TNotifyEvent read FOnMapResize write FOnMapResize;
127+ property OnMouseRide : TMouseMoveEvent read FOnMouseRide write FOnMouseRide;
128+ property TurnEditStop : Boolean read FTurnEditStop write FTurnEditStop;
129+ property DeletePen : Boolean read FDeletePen write FDeletePen;
130+ end;
131+
132+var
133+ MapEditModule: TMapEditModule;
134+
135+implementation
136+
137+uses FMapSize;
138+
139+{$R *.dfm}
140+
141+procedure TMapEditModule.DataModuleCreate(Sender: TObject);
142+begin
143+ FChipBitmap := TABitmap.Create;
144+ FVisibleBitmap := TABitmap.Create;
145+ FListDrawType := mldtCustom;
146+
147+ FVisibleBitmap.Canvas.Pen.Color := RGB(64,64,64);
148+ FZoomPixel := 32;
149+ FZooming := False;
150+end;
151+
152+procedure TMapEditModule.DataModuleDestroy(Sender: TObject);
153+begin
154+ FChipBitmap.Free;
155+ FVisibleBitmap.Free;
156+end;
157+
158+function TMapEditModule.GetEditChip: TSRCMapChip;
159+const
160+ Layer1Deleter : TSRCMapChip = (Janre : 0;ID : 0);
161+ Layer2Deleter : TSRCMapChip = (Janre : 10000;ID : 10000);
162+begin
163+ if not FDeletePen then Result := FEditChip
164+ else if FMapUndo.Layer = 0 then Result := Layer1Deleter
165+ else Result := Layer2Deleter;
166+end;
167+
168+procedure TMapEditModule.SetZoomPixel(const val: Integer);
169+begin
170+ FZoomPixel := val;
171+
172+ MapPaintBoxSizeChange(Self);
173+ if Assigned(FOnZoomChange) then FOnZoomChange(Self);
174+end;
175+
176+procedure TMapEditModule.SetMapPaintBox(val: TPaintBox);
177+begin
178+ FMapPaintBox := val;
179+ Val.OnMouseDown := MapPaintBoxMouseDown;
180+ Val.OnMouseMove := MapPaintBoxMouseMove;
181+ Val.OnMouseUp := MapPaintBoxMouseUp;
182+ Val.OnPaint := MapPaintBoxPaint;
183+end;
184+
185+procedure TMapEditModule.SetChipPaintBox(val: TPaintBox);
186+begin
187+ FChipPaintBox := val;
188+ val.OnPaint := ChipPaintBoxPaint;
189+end;
190+
191+procedure TMapEditModule.SetMapChipPreviewPaintBox(val: TPaintBox);
192+begin
193+ FMapChipPreviewPaintBox := Val;
194+ Val.OnPaint := ChipPreviewPaintBoxPaint;
195+ Val.OnMouseUp := ChipPreviewPaintBoxMouseUp;
196+end;
197+
198+procedure TMapEditModule.SetMapUndo(val: TSRCMapUndoList);
199+begin
200+ FMapUndo := val;
201+ Cut1.Enabled := False;
202+ Copy1.Enabled := False;
203+ Delete1.Enabled := False;
204+ if Val <> NIL then begin
205+ DoMapChange(Self);
206+ FMapUndo.OnChange := MapPaintBoxUpdate;
207+ FMapUndo.OnSizeChange := MapPaintBoxSizeChange;
208+ end;
209+ {初期化処理}
210+ MapPaintBoxSizeChange(Self);
211+end;
212+
213+procedure TMapEditModule.SetDrawMode(const val: TMapEditDrawMode);
214+begin
215+ FDrawMode := val;
216+ Cut1.Enabled := False;
217+ Copy1.Enabled := False;
218+ FSecondSelect := FFirstSelect;
219+ FMapPaintBox.Invalidate;
220+end;
221+
222+procedure TMapEditModule.SetListDrawType(const Value: TMapListDrawType);
223+begin
224+ FListDrawType := Value;
225+ MapModule.MakeMapList(Self.ChipJanre,Value,FChipBitmap);
226+ FMapChipPreviewPaintBox.Width := FChipBitmap.Width;
227+ FMapChipPreviewPaintBox.Height := FChipBitmap.Height;
228+ FMapChipPreviewPaintBox.Invalidate;
229+end;
230+
231+procedure TMapEditModule.SetShowGrid(const Val: Boolean);
232+begin
233+ FShowGrid := Val;
234+ if Assigned(FMapUndo) then MapPaintBoxUpdate(Self);
235+end;
236+
237+procedure TMapEditModule.SetUseMMX(const Val: Boolean);
238+begin
239+ FUseMMX := Val;
240+ if Assigned(FMapUndo) then MapPaintBoxUpdate(Self);
241+end;
242+
243+{}
244+
245+procedure TMapEditModule.ChipPaintBoxPaint(Sender: TObject);
246+begin
247+ MapModule.CopyToCanvas(FChipPaintBox.Canvas,0,0,FEditChip.Janre,FEditChip.ID);
248+end;
249+
250+procedure TMapEditModule.ChipPreviewPaintBoxPaint(Sender: TObject);
251+begin
252+ BitBlt(TPaintBox(Sender).Canvas.Handle,0,0,FChipBitmap.Width,
253+ FChipBitmap.Height,FChipBitmap.Canvas.Handle,0,0,SRCCopy);
254+end;
255+
256+procedure TMapEditModule.ChipPreviewPaintBoxMouseUp(Sender: TObject;
257+Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
258+var
259+ MC : TSRCMapChip;
260+begin
261+ if FListDrawType = mldtCllasic then
262+ MC := MapModule.GetMapChipIndex(FListDrawType,FChipJanre, (y shr 5) * 3 + (X shr 5))
263+ else MC := MapModule.GetMapChipIndex(FListDrawType,FChipJanre, (y shr 5) * 6 + (X shr 5));
264+
265+ if (MC.ID > -32768) and (MC.ID <> 10000) then begin
266+ FEditChip := MC;
267+ if Assigned(FOnChangeChip) then FOnChangeChip(Sender);
268+ FChipPaintBox.Invalidate;
269+ end;
270+end;
271+
272+procedure TMapEditModule.SetChipJanre(const Index: Integer);
273+begin
274+ FChipJanre := Index;
275+ MapModule.MakeMapList(Index,FListDrawType,FChipBitmap);
276+ FMapChipPreviewPaintBox.Width := FChipBitmap.Width;
277+ FMapChipPreviewPaintBox.Height := FChipBitmap.Height;
278+ FMapChipPreviewPaintBox.Invalidate;
279+end;
280+
281+procedure TMapEditModule.MapPaintBoxPaint(Sender: TObject);
282+var
283+ L,U,D,R : Integer;
284+begin
285+ if Assigned(FVisibleBitmap) then begin
286+ BitBlt(FMapPaintBox.Canvas.Handle,0,0,FMapPaintBox.Width,
287+ FMapPaintBox.Height,FVisibleBitmap.Canvas.Handle,0,0,SRCCopy);
288+ {Nox_System Drawing (CNoxEditmoduleに回す)
289+ if Assigned(FCreateClip) then begin
290+ L := FClipPoint.X;
291+ R := FClipPoint.X + 1;
292+ U := FClipPoint.Y;
293+ D := FClipPoint.Y + 1;
294+
295+ MapPB.Canvas.Rectangle(L * FZoomPixel,
296+ U * FZoomPixel,R * FZoomPixel,D * FZoomPixel);
297+ end else begin}
298+
299+ if not (FDrawMode In [mdRect,mdEllipse,mdSelect]) then Exit;
300+ //AnyPen Rectangle
301+ if FFirstSelect.X > FSecondSelect.X then begin
302+ L := FSecondSelect.X;
303+ R := FFirstSelect.X;
304+ end else begin
305+ R := FSecondSelect.X;
306+ L := FFirstSelect.X;
307+ end;
308+
309+ if FFirstSelect.Y > FSecondSelect.Y then begin
310+ U := FSecondSelect.Y;
311+ D := FFirstSelect.Y;
312+ end else begin
313+ D := FSecondSelect.Y;
314+ U := FFirstSelect.Y;
315+ end;
316+ if (L <> R) or (D <> U) then begin
317+ inc(D);
318+ inc(R);
319+ FMapPaintBox.Canvas.Rectangle(L * FZoomPixel, U * FZoomPixel,
320+ R * FZoomPixel,D * FZoomPixel);
321+ end;
322+ end;
323+end;
324+
325+procedure TMapEditModule.MapPaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
326+begin
327+ if FDrawMode = mdNone then begin
328+ if Assigned(FOnNoPenMouseDown) then
329+ FOnNoPenMouseDown(Sender,Button,Shift,X,Y);
330+ Exit;
331+ end;
332+ FTurnEditStop := False;
333+ FFirstSelect := Point(X div FZoomPixel,y div FZoomPixel);
334+ FSecondSelect := FFirstSelect;
335+
336+ if Button = MBLeft then begin
337+ if FDrawMode = mdPen then begin
338+ FMapUndo.StartPenDraw(FFirstSelect.X,FFirstSelect.Y,GetEditChip);
339+ DoMapChange(Sender);
340+ end;
341+ end;
342+end;
343+
344+procedure TMapEditModule.MapPaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
345+var
346+ Place : TPoint;
347+ function EqualChip(const Chip1,Chip2:TSRCMapChip):Boolean;
348+ begin
349+ Result := (Chip1.Janre = Chip2.Janre) and (Chip1.ID = Chip2.ID);
350+ end;
351+begin
352+ if FDrawMode = mdNone then begin
353+ if Assigned(FOnNoPenMouseMove) then
354+ FOnNoPenMouseMove(Sender,Shift,X,Y);
355+ Exit;
356+ end;
357+ if FTurnEditStop then Exit;
358+
359+ if X < 0 then X := 0;
360+ if Y < 0 then Y := 0;
361+ if X >= FMapPaintBox.Width then X := FMapPaintBox.Width - 1;
362+ if Y >= FMapPaintBox.Height then Y := FMapPaintBox.Height - 1;
363+
364+ Place := Point(X div FZoomPixel,Y div FZoomPixel);
365+
366+ if ssLeft in Shift then begin
367+ if FDrawMode in [mdRect,mdEllipse,mdSelect] then begin
368+ FSecondSelect := Place;
369+ FMapPaintBox.Invalidate;
370+ end else if FDrawMode = mdPen then begin
371+ if (X < 0) or (X >= FMapPaintBox.Width) then Exit;
372+ if (Y < 0) or (Y >= FMapPaintBox.Height) then Exit;
373+
374+ if EqualChip(GetEditChip,FMapUndo.ActiveLayer[X div FZoomPixel,Y div FZoomPixel]) then Exit;
375+
376+ FMapUndo.AddPenDraw(X div FZoomPixel,Y div FZoomPixel);
377+ DoMapChange(Sender);
378+ end;
379+ end else begin
380+ if Assigned(FOnMouseRide) then begin
381+ FOnMouseRide(Sender,Shift,Place.X,Place.Y);
382+ end;
383+ end;
384+end;
385+
386+procedure TMapEditModule.MapPaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
387+ procedure ValBigSmallProcess(var Small,Big:Integer);
388+ var i : Integer;
389+ begin
390+ if Small > Big then begin
391+ I := Small;
392+ Small := Big;
393+ Big := i;
394+ end;
395+ end;
396+begin
397+ if FDrawMode = mdNone then begin
398+ if Assigned(FOnNoPenMouseUp) then
399+ FOnNoPenMouseUp(Sender,Button,Shift,X,Y);
400+ Exit;
401+ end;
402+ if FTurnEditStop then Exit;
403+
404+ if X < 0 then X := 0;
405+ if Y < 0 then Y := 0;
406+ if X >= FMapPaintBox.Width then X := FMapPaintBox.Width - 1;
407+ if Y >= FMapPaintBox.Height then Y := FMapPaintBox.Height - 1;
408+
409+ {Map Edit}
410+ if Button = mbLeft then begin
411+ Case FDrawMode of
412+ mdPen : FMapUndo.FinishPenDraw;
413+ mdFill : FMapUndo.StartFill(X div FZoomPixel,Y div FZoomPixel,GetEditChip);
414+ mdRect : begin
415+ ValBigSmallProcess(FFirstSelect.X,FSecondSelect.X);
416+ ValBigSmallProcess(FFirstSelect.Y,FSecondSelect.Y);
417+ inc(FSecondSelect.X);
418+ inc(FSecondSelect.Y);
419+ FMapUndo.StartRectDraw(FFirstSelect.X,FFirstSelect.Y,
420+ FSecondSelect.X,FSecondSelect.Y,GetEditChip);
421+ end;
422+ End;
423+
424+ if not (FDrawMode = mdSelect) then begin
425+ FFirstSelect := Point(0,0);
426+ FSecondSelect := Point(0,0);
427+ DoMapChange(Sender);
428+ end else begin
429+ ValBigSmallProcess(FFirstSelect.X,FSecondSelect.X);
430+ ValBigSmallProcess(FFirstSelect.Y,FSecondSelect.Y);
431+ Cut1.Enabled := True;
432+ Copy1.Enabled := True;
433+ end;
434+ end else if Button = mbRight then begin
435+ FSecondSelect := Point(X div FZoomPixel,Y div FZoomPixel);
436+ if PointsEqual(FFirstSelect,FSecondSelect) then begin
437+ FEditChip := FMapUndo.ActiveLayer[FFirstSelect.X,FFirstSelect.Y];
438+ if Assigned(FOnChangeChip) then FOnChangeChip(Sender);
439+ FChipPaintBox.Invalidate;
440+ end;
441+ end;
442+
443+end;
444+
445+procedure TMapEditModule.MapPaintBoxUpdate(Sender: TObject);
446+var
447+ ParVal : Integer;
448+begin
449+ if Assigned(FMapUndo) and (FMapUndo.Bitmap.Width > 0) then begin
450+ if FUseMMX then
451+ Stretch_ZoomIn_BiLinearMMX32(0,0,FMapUndo.Bitmap.Width,FMapUndo.Bitmap.Height,
452+ 0,0,FVisibleBitmap.Width,FVisibleBitmap.Height,FMapUndo.Bitmap,FVisibleBitmap)
453+ else
454+ Stretch_ZoomIn_Saikin32(0,0,FMapUndo.Bitmap.Width,FMapUndo.Bitmap.Height,
455+ 0,0,FVisibleBitmap.Width,FVisibleBitmap.Height,FMapUndo.Bitmap,FVisibleBitmap);
456+
457+ {Line}
458+ if FShowGrid then begin
459+ for ParVal:= 1 to FMapUndo.Bitmap.Width div 32 do begin
460+ FVisibleBitmap.Canvas.MoveTo(ParVal * FZoomPixel - 1,0);
461+ FVisibleBitmap.Canvas.LineTo(ParVal * FZoomPixel - 1,FVisibleBitmap.Height);
462+ end;
463+ for ParVal:= 1 to FMapUndo.Bitmap.Height div 32 do begin
464+ FVisibleBitmap.Canvas.MoveTo(0,ParVal * FZoomPixel - 1);
465+ FVisibleBitmap.Canvas.LineTo(FVisibleBitmap.Width,ParVal * FZoomPixel - 1);
466+ end;
467+ end;
468+ end;
469+
470+ //ClipUpdate;
471+ FMapPaintBox.Invalidate;
472+end;
473+
474+procedure TMapEditModule.MapPaintBoxSizeChange(Sender: TObject);
475+begin
476+ if Assigned(FOnBeforeSizeChange) then FOnBeforeSizeChange(Sender);
477+
478+ if Assigned(FMapUndo) then FVisibleBitmap.SetSize(
479+ FMapUndo.Map.Width * FZoomPixel,FMapUndo.Map.Height * FZoomPixel)
480+ else FVisibleBitmap.SetSize(0,0);
481+
482+ FMapPaintBox.Width := FVisibleBitmap.Width;
483+ FMapPaintBox.Height := FVisibleBitmap.Height;
484+
485+ MapPaintBoxUpdate(Sender);
486+
487+ {if ClipPB.Visible then begin
488+ ClipUpdate;
489+ ClipMove(FFirstSelect.X,FFirstSelect.Y);
490+ end;}
491+ if Assigned(FOnAfterSizeChange) then FOnAfterSizeChange(Sender);
492+end;
493+
494+procedure TMapEditModule.PasteClip(const X: Integer; const Y: Integer; Clip: TSRCMapBuffer);
495+begin
496+ FMapUndo.StartTileRect(X,Y,X + Clip.Width,Y + Clip.Height,Clip);
497+ DoMapChange(Paste1);
498+end;
499+
500+procedure TMapEditModule.DoMapChange(Sender: TObject);
501+begin
502+ Undo1.Enabled := MapUndo.CanUndo;
503+ Redo1.Enabled := MapUndo.CanRedo;
504+
505+ Cut1.Enabled := False;
506+ Copy1.Enabled := False;
507+ MapPaintBox.Invalidate;
508+ if Assigned(FOnChange) then FOnChange(Sender);
509+end;
510+
511+{Action Funx.}
512+
513+procedure TMapEditModule.Cut1Execute(Sender: TObject);
514+begin
515+ Copy1.Execute;
516+ Delete1.Execute;
517+end;
518+
519+procedure TMapEditModule.Copy1Execute(Sender: TObject);
520+var
521+ Clip : TSRCMapBuffer;
522+begin
523+ Clip := TSRCMapBuffer.Create;
524+ Clip.CopyFromMap(FMapUndo.ActiveLayer,FFirstSelect.X,FFirstSelect.Y,
525+ FSecondSelect.X + 1,FSecondSelect.Y + 1);
526+ Clipboard.AsText := inttostr(Clip.Width) + ',' + inttostr(Clip.Height) +
527+ #13#10 + Clip.GetData;
528+end;
529+
530+procedure TMapEditModule.Delete1Execute(Sender: TObject);
531+begin
532+ FMapUndo.StartRectDraw(FFirstSelect.X,FFirstSelect.Y,
533+ FSecondSelect.X + 1,FSecondSelect.Y + 1,GetEditChip);
534+ DoMapChange(Sender);
535+end;
536+
537+procedure TMapEditModule.ChangeZoom(Sender: TObject);
538+begin
539+ if FZooming then Exit;
540+ FZooming := True;
541+
542+ if TAction(Sender) = ZoomOut1 then Dec(FZoomPixel)
543+ else if TAction(Sender) = ZoomIn1 then Inc(FZoomPixel)
544+ else if TAction(Sender) = Zoom1 then FZoomPixel := 32
545+ else if TAction(Sender) = Zoom2 then FZoomPixel := 16
546+ else if TAction(Sender) = Zoom4 then FZoomPixel := 8
547+ else if TAction(Sender) = Zoom8 then FZoomPixel := 4
548+ else if TAction(Sender) = RightZoom1 then begin
549+ if FMapUndo.Map.Width > 0 then
550+ if Assigned(FOnMapSizeOptimize) then
551+ FZoomPixel := FOnMapSizeOptimize(FMapUndo.Map.Width,FMapUndo.Map.Height);
552+ end;
553+
554+ if FZoomPixel < 2 then FZoomPixel := 2;
555+ if FZoomPixel > 64 then FZoomPixel := 64;
556+ SetZoomPixel(FZoomPixel);
557+ FZooming := False;
558+end;
559+
560+procedure TMapEditModule.UndoProc(Sender: TObject);
561+var Width,Height : Integer;
562+begin
563+ Width := MapUndo.Bitmap.Width;
564+ Height := MapUndo.Bitmap.Height;
565+ if Sender is TAction then begin
566+ if TAction(Sender) = Undo1 then
567+ MapUndo.Undo
568+ else if TAction(Sender) = Redo1 then
569+ MapUndo.Redo;
570+ end;
571+
572+ DoMapChange(Sender);
573+
574+ if (Width = FMapUndo.Bitmap.Width) and (Height = FMapUndo.Bitmap.Height) then
575+ MapPaintBoxUpdate(Sender) else begin
576+ MapPaintBoxSizeChange(Sender);
577+ if Assigned(FOnMapResize) then FOnMapResize(Sender);
578+ end;
579+end;
580+
581+procedure TMapEditModule.MapFuncExecute(Sender: TObject);
582+begin
583+ if TAction(Sender) = MapClear1 then begin
584+ MapUndo.StartRectDraw(0,0,MapUndo.Map.Width,MapUndo.Map.Height,GetEditChip);
585+ DoMapChange(Sender);
586+ MapPaintBoxUpdate(Sender);
587+ {end else if TAction(Sender) = Reload1 then begin
588+ FMapUndo.LoadMap(MapUndo. + '\' + FMapFile);
589+ CallMapChange(Sender);
590+ MapPaintBoxUpdate(Sender);
591+ end else if TAction(Sender) = Save1 then begin
592+ FMapUndo.SaveMap(FGameDir + '\' + FMapFile);
593+ CallMapChange(Sender);}
594+ end else if TAction(Sender) = Option1 then begin
595+ MapSizeForm.Width := FMapUndo.Map.Width;
596+ MapSizeForm.Height := FMapUndo.Map.Height;
597+ MapSizeForm.OldVer := FMapUndo.Map.OldVersion;
598+ if MapSizeForm.Execute then begin
599+ FMapUndo.StartSetSize(MapSizeForm.Width,MapSizeForm.Height,FEditChip);
600+ FMapUndo.Map.OldVersion := MapSizeForm.OldVer;
601+ DoMapChange(Sender);
602+ MapPaintBoxSizeChange(Sender);
603+ if Assigned(FOnMapResize) then FOnMapResize(Sender);
604+ end;
605+ end;
606+end;
607+
608+end.
609+
--- MLNox/CSpecialPower.pas (nonexistent)
+++ MLNox/CSpecialPower.pas (revision 4)
@@ -0,0 +1,398 @@
1+unit CSpecialPower;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,CSeek3List;
6+type
7+ TSRCPilotSpecialPower = class(TPersistent)
8+ private
9+ FCaption :String;
10+ FCost,FPilotLevel:Integer;
11+ public
12+ procedure Assign(Source:TPersistent);override;
13+ published
14+ property Caption : String read FCaption write FCaption;
15+ property Cost : Integer read FCost write FCost;
16+ property PilotLevel:Integer read FPilotLevel write FPilotLevel;
17+ End;
18+
19+ TSRCPilotSpecialPowerList = Class(TPersistent)
20+ private
21+ FSpecialPowers:Array of TSRCPilotSpecialPower;
22+ FMaxSP : Integer;
23+
24+ function GetSpecialPower(ID:Integer):TSRCPilotSpecialPower;
25+ procedure SetSpecialPower(ID:Integer;val:TSRCPilotSpecialPower);
26+
27+ procedure SetMaxSP(va:Integer);
28+
29+ function GetCount:Integer;
30+ public
31+ property SpecialPower[ID:Integer]:TSRCPilotSpecialPower read GetSpecialPower write SetSpecialPower;default;
32+ procedure Clear;
33+ procedure Assign(Source:TPersistent);override;
34+
35+ property Count : Integer read GetCount;
36+
37+ function Add:TSRCPilotSpecialPower;
38+ procedure Insert(ID:Integer; val:TSRCPilotSpecialPower);
39+ procedure Delete(ID:Integer);
40+ published
41+ property MaxSP : Integer read FMaxSP write SetMaxSP;
42+ End;
43+
44+ TSRCSpecialPowerTarget = (STSelf,STFriend,STAllFriend,
45+ STDestructedFriend,STEnemy,STAllEnemy,STManual,STAll);
46+
47+ TSRCSpecialPowerEffectTime = (SESoon,SEAttack,SEDefence,
48+ SEHit,SEDamaged,SETurn,SEEnemyTurn,SEBattle,SEKillEnemy,
49+ SEMove,SEDefend,SEKilled);
50+
51+ TSRCSpecialPower = Class(TSRCData)
52+ private
53+ FName,FOmissionName,FSyllabary:String;
54+ FUseSP : Integer;
55+ FTarget : TSRCSpecialPowerTarget;
56+ FEffectTime : TSRCSpecialPowerEffectTime;
57+ FRuleofTargeting : String;
58+ FRuleofUse : String;
59+ FEffects : String;
60+ FExplanation : String;
61+ FAnimation : String;
62+ protected
63+ procedure AssignTo(Dest:TPersistent);override;
64+ public
65+ procedure WriteData(Dest:TStrings);override;
66+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
67+ published
68+ property Name : String read FName write FName;
69+ property OmissionName : String read FOmissionName write FOmissionName;
70+ property Syllabary : String read FSyllabary write FSyllabary;
71+ property UseSP : Integer read FUseSP write FUseSP;
72+ property Target : TSRCSpecialPowerTarget read FTarget write FTarget;
73+ property EffectTime : TSRCSpecialPowerEffectTime read FEffectTime write FEffectTime;
74+ property RuleofTargeting : String read FRuleofTargeting write FRuleofTargeting;
75+ property RuleofUse : String read FRuleofUse write FRuleofUse;
76+ property Effects : String read FEffects write FEffects;
77+ property Explanation : String read FExplanation write FExplanation;
78+ property Animation : String read FAnimation write FAnimation;
79+ End;
80+
81+ TSRCSpecialPowerList = Class(TSRCDataList)
82+ private
83+ function GetItems(ID:Integer):TSRCSpecialPower;
84+ procedure SetItems(ID:Integer;val:TSRCSpecialPower);
85+ protected
86+ function AddID(const ID:Integer):TSRCData;override;
87+ public
88+ function Add(out ID : integer):TSRCSpecialPower;overload;
89+ function Add():TSRCSpecialPower;overload;
90+
91+ property Items[ID:Integer]:TSRCSpecialPower read GetItems write SetItems;default;
92+ published
93+
94+ End;
95+implementation
96+
97+procedure TSRCPilotSpecialPower.Assign(Source:TPersistent);
98+begin
99+ if Source is TSRCPilotSpecialPower then begin
100+ Caption := TSRCPilotSpecialPower(Source).Caption;
101+ Cost := TSRCPilotSpecialPower(Source).Cost;
102+ PilotLevel := TSRCPilotSpecialPower(Source).PilotLevel;
103+ end else Inherited;
104+end;
105+
106+function TSRCPilotSpecialPowerList.Add;
107+begin
108+ SetLength(FSpecialPowers,GetCount + 1);
109+ FSpecialPowers[GetCount - 1] := TSRCPilotSpecialPower.Create;
110+ Result := FSpecialPowers[GetCount - 1];
111+end;
112+
113+procedure TSRCPilotSpecialPowerList.Insert(ID: Integer; val: TSRCPilotSpecialPower);
114+var
115+ List_CNT: Integer;
116+begin
117+ SetLength(FSpecialPowers,GetCount + 1);
118+
119+ for List_CNT := GetCount - 1 downto ID + 1 do
120+ FSpecialPowers[List_CNT] := FSpecialPowers[List_CNT - 1];
121+
122+ FSpecialPowers[ID] := TSRCPilotSpecialPower.Create;
123+ FSpecialPowers[ID].Assign(val);
124+end;
125+
126+procedure TSRCPilotSpecialPowerList.Delete(ID: Integer);
127+var
128+ List_CNT: Integer;
129+begin
130+ FSpecialPowers[ID].Free;
131+ for List_CNT := ID to GetCount - 2 do
132+ FSpecialPowers[List_CNT] := FSpecialPowers[List_CNT + 1];
133+
134+ SetLength(FSpecialPowers, GetCount - 1);
135+end;
136+
137+function TSRCPilotSpecialPowerList.GetCount;
138+begin
139+ if Assigned(FSpecialPowers) then
140+ Result := Length(FSpecialPowers)
141+ else
142+ Result := 0;
143+end;
144+
145+procedure TSRCPilotSpecialPowerList.Assign(Source: TPersistent);
146+var
147+ SP_CNT: Integer;
148+begin
149+ if Source is TSRCPilotSpecialPowerList then begin
150+ FMaxSP := TSRCPilotSpecialPowerList(Source).MaxSP;
151+
152+ for SP_CNT := 0 to GetCount - 1 do
153+ FSpecialPowers[SP_CNT].Free;
154+
155+ SetLength(FSpecialPowers,TSRCPilotSpecialPowerList(Source).Count);
156+
157+
158+ for SP_CNT := 0 to GetCount - 1 do begin
159+ FSpecialPowers[SP_CNT] := TSRCPilotSpecialPower.Create;
160+ FSpecialPowers[SP_CNT].Assign(TSRCPilotSpecialPowerList(Source)[SP_CNT]);
161+ end;
162+ end;
163+end;
164+
165+procedure TSRCPilotSpecialPowerList.SetSpecialPower(ID: Integer; val: TSRCPilotSpecialPower);
166+begin
167+ FSpecialPowers[ID].Assign(val);
168+end;
169+
170+function TSRCPilotSpecialPowerList.GetSpecialPower(ID: Integer) :TSRCPilotSpecialPower;
171+begin
172+ Result := FSpecialPowers[ID];
173+end;
174+
175+procedure TSRCPilotSpecialPowerList.SetMaxSP(va: Integer);
176+begin
177+ FMaxSP := va;
178+end;
179+
180+procedure TSRCPilotSpecialPowerList.Clear;
181+var
182+ List_CNT: Integer;
183+begin
184+ FMaxSP := 0;
185+
186+ for List_CNT := 0 to GetCount - 1 do begin
187+ FSpecialPowers[List_CNT].Free;
188+ end;
189+
190+ SetLength(FSpecialPowers,0);
191+end;
192+
193+{TSRCSpecialPower Func.}
194+
195+procedure TSRCSpecialPower.AssignTo(Dest: TPersistent);
196+begin
197+ if Dest is TSRCSpecialPower then begin
198+ TSRCSpecialPower(Dest).Name := FName;
199+ TSRCSpecialPower(Dest).OmissionName := FOmissionName;
200+ TSRCSpecialPower(Dest).Syllabary := FSyllabary;
201+ TSRCSpecialPower(Dest).UseSP := FUseSP;
202+ TSRCSpecialPower(Dest).Target := FTarget;
203+ TSRCSpecialPower(Dest).EffectTime := FEffectTime;
204+ TSRCSpecialPower(Dest).RuleofTargeting := FRuleofTargeting;
205+ TSRCSpecialPower(Dest).RuleofUse := FRuleofUse;
206+ TSRCSpecialPower(Dest).Effects := FEffects;
207+ TSRCSpecialPower(Dest).Explanation := FExplanation;
208+ TSRCSpecialPower(Dest).Animation := FAnimation;
209+ end else inherited;
210+end;
211+
212+procedure TSRCSpecialPower.WriteData(Dest:TStrings);
213+var
214+ S : String;
215+begin
216+ if FSyllabary = '' then
217+ Dest.Add(FName)
218+ else Dest.Add(FName + ',' + FSyllabary);
219+
220+ S := FOmissionName + ',' + inttoStr(FUseSP) + ',';
221+
222+ Case FTarget of
223+ STFriend : S := S + '味方';
224+ STAllFriend : S := S + '全味方';
225+ STDestructedFriend : S := S + '破壊味方';
226+ STEnemy : S := S + '敵';
227+ STAllEnemy : S := S + '全敵';
228+ STManual : S := S + '任意';
229+ STAll : S := S + '全';
230+ else S := S + '自分';
231+ end;
232+
233+ S := S + ',';
234+
235+ case FEffectTime of
236+ SEAttack : S := S + '攻撃';
237+ SEDefence : S := S + '防御';
238+ SEHit : S := S + '命中';
239+ SEDamaged : S := S + '被弾';
240+ SETurn : S := S + 'ターン';
241+ SEEnemyTurn : S := S + '敵ターン';
242+ SEBattle : S := S + '戦闘終了';
243+ SEKillEnemy : S := S + '敵破壊';
244+ SEMove : S := S + '移動';
245+ SEDefend : S := S + 'みがわり';
246+ SEKilled : S := S + '破壊';
247+ else S := S + '即効';
248+ end;
249+
250+ S := S + ',' + FRuleofTargeting + ',' + FRuleOfUse +
251+ ',' + FAnimation;
252+
253+ Dest.Add(S);
254+
255+ Dest.Add(FEffects);
256+ Dest.Add(FExplanation);
257+ Dest.Add('');
258+end;
259+
260+function TSRCSpecialPower.ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;
261+var
262+ Str : String;
263+ ASP :TSRCSpecialPower;
264+ procedure IncNum;
265+ var
266+ SS:String;
267+ begin
268+ inc(Index);
269+ while (Source.Count > Index) do begin
270+ SS := TrimJP(Source[Index]);
271+ if StartsStr('#',SS) then
272+ inc(Index) else break;
273+ end;
274+ end;
275+ procedure SendError(const Error:String);
276+ begin
277+ Result := False;
278+ if Errors <> '' then Errors := Errors + #13#10;
279+
280+ Errors := Errors + Error +'(' +
281+ inttostr(Index) + '行目)';
282+ end;
283+
284+ function StrToInt(const Val,SRCType:String):Integer;
285+ begin
286+ if not TryStrToInt(Val,Result) then begin
287+ Result := 0;
288+ SendError(SRCType + 'が数値ではありません。');
289+ end;
290+ end;
291+ function ReadLine:String;
292+ begin
293+ if Index >= Source.Count then begin
294+ SendError('項目が途切れています');
295+ Result := '';
296+ end else Result := Source[Index];
297+ end;
298+begin
299+ Result := True;
300+ if Source.Count <= Index then Exit;
301+
302+ Str := TrimJP(ReadLine);
303+ while (Str = '') OR (StartsStr('#',Str)) do begin
304+ IncNum;
305+ if Source.Count <= Index then break;
306+ Str := TrimJP(ReadLine);
307+ end;
308+
309+ if Source.Count <= Index then Exit;
310+
311+ ASP := TSRCSpecialPower.Create;
312+ ASP.Assign(Self);
313+ try
314+ Str := ReadLine;
315+ incNum;
316+
317+ FName := TrimJP(ExtractWordDem(Str));
318+ FSyllabary := TrimJP(ExtractWordDem(Str));
319+
320+ Str := ReadLine;
321+ incNum;
322+
323+ FOmissionName := TrimJP(ExtractWordDem(Str));
324+ FUseSP := strtoint(TrimJP(ExtractWordDem(Str)),'使用SP');
325+
326+ FTarget := STSelf;
327+ Str := TrimJP(ExtractWordDem(Str));
328+
329+ if Str = '自分' then FTarget := STSelf;
330+ if Str = '味方' then FTarget := STFriend;
331+ if Str = '全味方' then FTarget := STAllFriend;
332+ if Str = '破壊味方' then FTarget := STDestructedFriend;
333+ if Str = '敵' then FTarget := STEnemy;
334+ if Str = '全敵' then FTarget := STAllEnemy;
335+ if Str = '任意' then FTarget := STManual;
336+ if Str = '全' then FTarget := STAll;
337+
338+ FEffectTime := SESoon;
339+ Str := TrimJP(ExtractWordDem(Str));
340+
341+ if Str = '即効' then FEffectTime := SESoon;
342+ if Str = '攻撃' then FEffectTime := SEAttack;
343+ if Str = '防御' then FEffectTime := SEDefence;
344+ if Str = '命中' then FEffectTime := SEHit;
345+ if Str = '被弾' then FEffectTime := SEDamaged;
346+ if Str = 'ターン' then FEffectTime := SETurn;
347+ if Str = '敵ターン' then FEffectTime := SEEnemyTurn;
348+ if Str = '戦闘終了' then FEffectTime := SEBattle;
349+ if Str = '敵破壊' then FEffectTime := SEKillEnemy;
350+ if Str = '移動' then FEffectTime := SEMove;
351+ if Str = 'みがわり' then FEffectTime := SEDefend;
352+ if Str = '破壊' then FEffectTime := SEKilled;
353+
354+ FRuleofTargeting := TrimJP(ExtractWordDem(Str));
355+ FRuleofUse := TrimJP(ExtractWordDem(Str));
356+ FAnimation := TrimJP(ExtractWordDem(Str));
357+
358+ FEffects := TrimJP(ReadLine);
359+ incNum;
360+
361+ FExplanation := TrimJP(ReadLine);
362+ incNum;
363+ finally
364+ if not Result then
365+ Assign(ASP);
366+ ASP.Free;
367+ end;
368+end;
369+
370+{TSRCSpecialPowerList Func.}
371+
372+function TSRCSpecialPowerList.GetItems(ID: Integer):TSRCSpecialPower;
373+begin
374+ Result := TSRCSpecialPower(inherited GetItems(ID));
375+end;
376+
377+procedure TSRCSpecialPowerList.SetItems(ID: Integer; val: TSRCSpecialPower);
378+begin
379+ inherited SetItems(ID,val);
380+end;
381+
382+function TSRCSpecialPowerList.AddID(const ID: Integer):TSRCData;
383+begin
384+ FItems[ID] := TSRCSpecialPower.Create;
385+ Result := FItems[ID];
386+end;
387+
388+function TSRCSpecialPowerList.Add(out ID:Integer):TSRCSpecialPower;
389+begin
390+ Result := TSRCSpecialPower(inherited Add(ID));
391+end;
392+
393+function TSRCSpecialPowerList.Add:TSRCSpecialPower;
394+begin
395+ Result := TSRCSpecialPower(inherited Add);
396+end;
397+
398+end.
--- MLNox/CNonPilot.pas (nonexistent)
+++ MLNox/CNonPilot.pas (revision 4)
@@ -0,0 +1,171 @@
1+unit CNonPilot;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,CSeek3List;
6+type
7+ TSRCNonPilot = Class(TSRCData)
8+ private
9+ FName , FOmissionName: String;
10+ FExpression:String;
11+
12+ FGraphic : String;
13+ protected
14+ Procedure AssignTo(Dest:Tpersistent);override;
15+ public
16+
17+ procedure WriteData(Dest:TStrings);override;
18+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
19+ published
20+ property Name : String read FName write FName;
21+ property OmissionName : String read FOmissionName write FOmissionName;
22+ property Expression : String read FExpression write FExpression;
23+ property Graphic : String read FGraphic write FGraphic;
24+ End;
25+
26+ TSRCNonPilotList = Class(TSRCDataList)
27+ private
28+ function GetItems(ID:Integer):TSRCNonPilot;
29+ procedure SetItems(ID:Integer;val:TSRCNonPilot);
30+ protected
31+ function AddID(const ID:Integer):TSRCData;override;
32+ public
33+ property Items[ID:Integer]:TSRCNonPilot read GetItems write SetItems;default;
34+ procedure GetExpressions(const ChrName:String;Dest:TStrings);
35+
36+ function Add(out ID : integer):TSRCNonPilot;overload;
37+ function Add:TSRCNonPilot;overload;
38+ End;
39+implementation
40+
41+procedure TSRCNonPilot.AssignTo(Dest: TPersistent);
42+begin
43+ if Dest is TSRCNonPilot then begin
44+ TSRCNonPilot(Dest).Name := FName;
45+ TSRCNonPilot(Dest).OmissionName := FOmissionName;
46+ TSRCNonPilot(Dest).Expression := FExpression;
47+ TSRCNonPilot(Dest).Graphic := FGraphic;
48+ end else inherited;
49+end;
50+
51+procedure TSRCNonPilot.WriteData(Dest:TStrings);
52+begin
53+ Dest.Add(FName + '(' + FExpression + ')');
54+ Dest.Add(FOmissionName + ',' + FGraphic);
55+ Dest.Add('');
56+end;
57+
58+function TSRCNonPilot.ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;
59+var
60+ Str : String;
61+ NP : TSRCNonPilot;
62+ procedure IncNum;
63+ var
64+ SS:String;
65+ begin
66+ inc(Index);
67+ while (Source.Count > Index) do begin
68+ SS := TrimJP(Source[Index]);
69+ if StartsStr('#',SS) then
70+ inc(Index) else break;
71+ end;
72+ end;
73+ procedure SendError(const Error:String);
74+ begin
75+ Result := False;
76+ if Errors <> '' then Errors := Errors + #13#10;
77+
78+ Errors := Errors + Error +'(' +
79+ inttostr(Index) + '行目)';
80+ end;
81+ function ReadLine:String;
82+ begin
83+ if Index >= Source.Count then begin
84+ SendError('項目が途切れています');
85+ Result := '';
86+ end else Result := Source[Index];
87+ end;
88+begin
89+ Result := True;
90+ if Source.Count <= Index then Exit;
91+
92+ Str := TrimJP(ReadLine);
93+ while (Str = '') OR (StartsStr('#',Str)) do begin
94+ IncNum;
95+ if Source.Count <= Index then break;
96+ Str := TrimJP(ReadLine);
97+ end;
98+
99+ NP := TSRCNonPilot.Create;
100+ NP.Assign(Self);
101+ try
102+ Str := TrimJP(ReadLine);
103+ incNum;
104+ if inStr(',',Str) then
105+ SendError('パイロットの正式名称に当たる部分が変です');
106+
107+ if EndsStr(')',Str) then begin
108+ FExpression := Copy(Str,
109+ AnsiPosBackward('(',Str) + 1,MaxInt);
110+
111+ Delete(FExpression,Length(FExpression),1);
112+ Delete(Str,AnsiPosBackward('(',Str),MaxInt);
113+ end;
114+
115+ FName := Str;
116+ Str := ReadLine;
117+
118+ FOmissionName := TrimJP(ExtractWordDem(Str));
119+
120+ FGraphic := TrimJP(Str);
121+ finally
122+ if not Result then
123+ Assign(NP);
124+ NP.Free;
125+ end;
126+end;
127+
128+{TSRCNonPilotList Func.}
129+
130+function TSRCNonPilotList.GetItems(ID: Integer):TSRCNonPilot;
131+begin
132+ Result := TSRCNonPilot(inherited GetItems(ID));
133+end;
134+
135+procedure TSRCNonPilotList.SetItems(ID: Integer; val: TSRCNonPilot);
136+begin
137+ inherited SetItems(ID,val);
138+end;
139+
140+function TSRCNonPilotList.AddID(const ID: Integer):TSRCData;
141+begin
142+ FItems[ID] := TSRCNonPilot.Create;
143+ Result := FItems[ID];
144+end;
145+
146+function TSRCNonPilotList.Add(out ID : Integer):TSRCNonPilot;
147+begin
148+ Result := TSRCNonPilot(inherited Add(ID));
149+end;
150+
151+function TSRCNonPilotList.Add:TSRCNonPilot;
152+begin
153+ Result := TSRCNonPilot(inherited Add);
154+end;
155+
156+procedure TSRCNonPilotList.GetExpressions(const ChrName: string; Dest: TStrings);
157+var
158+ List_CNT: Integer;
159+begin
160+ Dest.Clear;
161+ for List_CNT := 0 to Count - 1 do begin
162+ with GetItems(List_CNT) do begin
163+ if (Name = ChrName) or (OmissionName = ChrName) then begin
164+ Dest.Add(Expression);
165+ Dest.Add(Graphic);
166+ end;
167+ end;
168+ end;
169+end;
170+
171+end.
--- MLNox/CNox.pas (nonexistent)
+++ MLNox/CNox.pas (revision 4)
@@ -0,0 +1,459 @@
1+unit CNox;
2+
3+interface
4+uses
5+ Classes, Types, SysUtils, NCommon, StringUnitLight, CSeek3List;
6+
7+{$IFNDEF NoUseDefaultScene}
8+const
9+ CSeek2DefaultScene = 'デフォルト' ;{SRC Seek2でのデフォルトシーン}
10+{$ENDIF}
11+
12+type
13+ TNoxCommand = (ncCreate,ncLaunch,ncOrganize);
14+ TNoxCamp = (ncpFriend,ncpNPC,ncpEnemy,ncpNeutral);
15+ TNoxAnimeOption =(naoNoting,naoNoAnimation,naoNoReload);
16+
17+ TNoxCreateCommand = Class(TPersistent)
18+ private
19+ FCommand : TNoxCommand;
20+ FPoint : TPoint;
21+ FCamp : TNoxCamp;
22+ FAnime : TNoxAnimeOption;
23+ FOvercrowd : Boolean;
24+ FSceneID : String;
25+
26+ FPilot,FUnit,FUnitID : String;
27+ FEquipItems : TStringList;
28+ FRank,FLevel,FBossRank : String;
29+
30+ function GetEquipItems:TStrings;
31+ procedure SetEquipItems(val:TStrings);
32+
33+ protected
34+ procedure AssignTo(Dest:TPersistent);override;
35+
36+ public
37+ Destructor Destroy;override;
38+ procedure GetDatatoStrings(Strings:TStrings);
39+ function GetData:String;
40+
41+ function SetFromStrings(Strings:TStrings;Index:Integer;var Errors:String):Boolean;
42+ published
43+ property Command : TNoxCommand read FCommand write FCommand;
44+ property Point : TPoint read FPoint write FPoint;
45+ property X : Integer read FPoint.X write FPoint.X;
46+ property Y : Integer read FPoint.Y write FPoint.Y;
47+ property Camp : TNoxCamp read FCamp write FCamp;
48+ property Anime : TNoxAnimeOption read FAnime write FAnime;
49+ property Overcrowd : Boolean read FOverCrowd write FOverCrowd;
50+
51+ property Pilot : String read FPilot write FPilot;
52+ property UnitName : String read FUnit write FUnit;
53+ property UnitID : String read FUnitID write FUnitID;
54+ property Rank : String read FRank write FRank;
55+ property Level : String read FLevel write FLevel;
56+ property BossRank : String read FBossRank write FBossRank;
57+ property EquipItems : TStrings read GetEquipItems write SetEquipItems;
58+ property SceneID : String read FSceneID write FSceneID;
59+ end;
60+
61+ TNoxCreateCommandList = Class(TPersistent)
62+ private
63+ FCommands: Array of TNoxCreateCommand;
64+
65+ procedure SetCommands(ID:Integer;val:TNoxCreateCommand);
66+ function GetCommands(ID:INteger):TNoxCreateCommand;
67+
68+ function GetCount:Integer;
69+ public
70+ Destructor Destroy;override;
71+ property Commands[ID:Integer]:TNoxCreateCommand read GetCommands write SetCommands;default;
72+ function Add:TNoxCreateCommand;
73+ procedure Delete(ID:Integer);
74+ procedure Insert(ID:Integer;val:TNoxCreateCommand);
75+ procedure Clear;
76+ procedure Assign(Source:TPersistent);override;
77+ function Find(const Charactor : String):TNoxCreateCommand;
78+ procedure GetIDList(IDs : TStrings);
79+ published
80+ property Count:Integer read GetCount;
81+ end;
82+
83+implementation
84+
85+Destructor TNoxCreateCommand.Destroy;
86+begin
87+ FEquipItems.Free;
88+ inherited;
89+end;
90+
91+function TNoxCreateCommand.GetEquipItems : TStrings;
92+begin
93+ if not Assigned(FEquipItems) then
94+ FEquipItems := TStringList.Create;
95+
96+ Result := FEquipItems;
97+end;
98+
99+procedure TNoxCreateCommand.SetEquipItems(val:TStrings);
100+begin
101+ if Val = NIL then begin
102+ FEquipItems.Free;
103+ FEquipItems := NIL;
104+ end else begin
105+ if not Assigned(FEquipItems) then FEquipItems := TStringList.Create;
106+ FEquipItems.Assign(val);
107+ end;
108+end;
109+
110+procedure TNoxCreateCommand.AssignTo(Dest:TPersistent);
111+begin
112+ if Dest is TNoxCreateCommand then begin
113+ TNoxCreateCommand(Dest).Command := FCommand;
114+ TNoxCreateCommand(Dest).X := FPoint.X;
115+ TNoxCreateCommand(Dest).Y := FPoint.Y;
116+ TNoxCreateCommand(Dest).Camp := FCamp;
117+ TNoxCreateCommand(Dest).Anime := FAnime;
118+ TNoxCreateCommand(Dest).Overcrowd := FOvercrowd;
119+
120+ TNoxCreateCommand(Dest).Pilot := FPilot;
121+ TNoxCreateCommand(Dest).UnitName := FUnit;
122+ TNoxCreateCommand(Dest).UnitID := FUnitID;
123+
124+ TNoxCreateCommand(Dest).EquipItems := FEquipItems;
125+
126+ TNoxCreateCommand(Dest).Rank := FRank;
127+ TNoxCreateCommand(Dest).Level := FLevel;
128+ TNoxCreateCommand(Dest).BossRank := FBossRank;
129+ TNoxCreateCommand(Dest).SceneID := FSceneID;
130+ end else inherited;
131+end;
132+
133+function TNoxCreateCommand.GetData: String;
134+var SL : TStringList;
135+begin
136+ SL := TStringList.Create;
137+ GetDatatoStrings(SL);
138+ Result := SL.Text;
139+ System.Delete(Result,Length(Result) - 1,2);
140+ SL.Free;
141+end;
142+
143+procedure TNoxCreateCommand.GetDatatoStrings(Strings:TStrings);
144+var
145+ S : String;
146+ LC : Integer;
147+begin
148+ if FCommand = ncCreate then begin
149+ S := 'Create ';
150+ if FCamp = ncpFriend then S := S + '味方 ';
151+ if FCamp = ncpNPC then S := S + 'ＮＰＣ ';
152+ if FCamp = ncpNeutral then S := S + '中立 ';
153+ if FCamp = ncpEnemy then S := S + '敵 ';
154+
155+ if inStr(' ',FRank) then
156+ S := S + FUnit + ' (' + FRank + ') '
157+ else S := S + FUnit + ' ' + FRank + ' ';
158+
159+ if inStr(' ',FLevel) then
160+ S := S + FPilot + ' (' + FLevel + ') '
161+ else S := S + FPilot + ' ' + FLevel + ' ';
162+
163+ S := S + inttostr(FPoint.X + 1) + ' ' + inttostr(FPoint.Y + 1);
164+ if FUnitID <> '' then begin
165+ if InStr(' ',FUnitID) then
166+ S := S + ' "' + FUnitID + '"'
167+ else
168+ S := S + ' ' + FUnitID;
169+ end;
170+
171+ if FAnime = naoNoAnimation then S := S +' アニメ非表示'
172+ else if FAnime = naoNoReload then S := S + ' 非同期';
173+
174+ Strings.Add(S);
175+ if (FUnitID <> '') then S := FUnitID else S := FPilot;
176+
177+ if (FBossRank <> '-1') and (FBossRank <> '') then
178+ Strings.Add('BossRank '+ S + ' ' + FBossRank);
179+
180+ if Assigned(FEquipItems) then begin
181+ for LC := 0 to FEquipItems.Count - 1 do begin
182+ if TrimJP(FEquipItems[LC]) <> '' then begin
183+ Strings.Add('Equip ' + S + ' ' + FEquipItems[LC]);
184+ end;
185+ end;
186+ end;
187+ end else if FCommand = ncLaunch then begin
188+ S := 'Launch ';
189+ if FUnitID <> '' then S := S + FUnitID else S := S + FUnit;
190+
191+ S := S + ' ' + inttostr(FPoint.X + 1) + ' ' + inttostr(FPoint.Y + 1);
192+ if FAnime = naoNoAnimation then S := S +' アニメ非表示'
193+ else if FAnime = naoNoReload then S := S + ' 非同期';
194+
195+ Strings.Add(S);
196+ end else begin
197+ S := 'Organize ' + FRank + ' ' + inttostr(FPoint.X + 1) + ' ' + inttostr(FPoint.Y + 1);
198+ if FAnime = naoNoAnimation then S := S +' アニメ非表示'
199+ else if FAnime = naoNoReload then S := S + ' 非同期';
200+ Strings.Add(S);
201+ end;
202+end;
203+
204+function TNoxCreateCommand.SetFromStrings(Strings:TStrings;Index:Integer;var Errors:String):Boolean;
205+var
206+ S, Val : String;
207+ procedure SendError(const Error:String);
208+ begin
209+ Result := False;
210+ if Errors <> '' then Errors := Errors + #13#10;
211+
212+ Errors := Errors + '○' + Error;
213+ end;
214+
215+ function StrToInt(const Val,SRCType:String):Integer;
216+ begin
217+ if not TryStrToInt(Val,Result) then begin
218+ Result := 0;
219+ SendError(SRCType + '(' + Val + ')が数値ではありません。');
220+ end;
221+ end;
222+ function EqStr(const S1,S2: String):Boolean;
223+ begin
224+ Result := CompareText(S1,S2) = 0;
225+ end;
226+ function ExtractKakkos(var S : String):String;
227+ var
228+ kakkoC : Integer;
229+ I, L: Integer;
230+ begin
231+ if S[1] <> '(' then Result := ExtractSpacesDem(Val)
232+ else begin
233+ kakkoC := 1;
234+ L := Length(S);
235+ I := 1;
236+ while I <= L do begin
237+ if IsDBCSLeadChar(S[I]) then begin
238+ if S[I] + S[I + 1] = '（' then Inc(kakkoC)
239+ else if S[I] + S[I + 1] = '）' then begin
240+ Dec(KakkoC);
241+ if KakkoC = 0 then break;
242+ end;
243+ Inc(I);
244+ end else begin
245+ if S[I] = '(' then Inc(kakkoC)
246+ else if S[I] = ')' then begin
247+ Dec(KakkoC);
248+ if KakkoC = 0 then break;
249+ end;
250+ end;
251+ Inc(I);
252+ end;
253+ Result := Copy(S,2,I - 2);
254+ Delete(S,1,I);
255+ end;
256+ end;
257+ procedure GetMapPoint;
258+ begin
259+ FPoint.X := StrToInt(ExtractSpacesDem(Val),'X') - 1;
260+ FPoint.Y := StrToInt(ExtractSpacesDem(Val),'Y') - 1;
261+ end;
262+ procedure GetCommonAnimation;
263+ begin
264+ if InStr('アニメ非表示',Val) then begin
265+ FAnime := naoNoAnimation;
266+ Val := ReplaceStr(Val,'アニメ非表示','');
267+ end else if Instr('非同期',Val) then begin
268+ FAnime := naoNoReload;
269+ Val := ReplaceStr(Val,'非同期','');
270+ end;
271+ end;
272+ procedure ReadCommands;
273+ var
274+ LC: Integer;
275+ S, Dest : String;
276+ begin
277+ if UnitID <> '' then Dest := FUnitID else Dest := FPilot;
278+
279+ for LC := Index to Strings.Count - 1 do begin
280+ S := TrimJP(Strings[LC]);
281+ if StartsText('BossRank',S) then begin
282+ ExtractSpacesDem(S);
283+ if SameText(ExtractSpacesDem(S),Dest) then begin
284+ FBossRank := S;
285+ end;
286+ end else if StartsText('Equip',S) then begin
287+ ExtractSpacesDem(S);
288+ if SameText(ExtractSpacesDem(S),Dest) then begin
289+ FEquipItems.Add(S);
290+ end;
291+ end;
292+ end;
293+ end;
294+begin
295+ Result := True;
296+ Val := TrimJP(Strings[Index]);
297+ S := ExtractSpacesDem(Val);
298+ FOvercrowd := False;
299+
300+ if EqStr('Create',S) then begin
301+ FCommand := ncCreate;
302+ S := ExtractSpacesDem(Val);
303+
304+ if EqStr(S,'味方') then FCamp := ncpFriend
305+ else if EqStr('ＮＰＣ',S) then FCamp := ncpNPC
306+ else if EqStr('敵',S) then FCamp := ncpEnemy
307+ else if EqStr('中立',S) then FCamp := ncpNeutral
308+ else SendError('所属の指定が間違っています');
309+
310+ FUnit := ExtractSpacesDem(Val);
311+ FRank := ExtractKakkos(Val);
312+ FPilot := ExtractSpacesDem(Val);
313+ FLevel := ExtractKakkos(Val);
314+
315+ GetMapPoint;
316+ GetCommonAnimation;
317+
318+ Val := TrimJP(Val);
319+ FUnitID := Val;
320+ FBossRank := '-1';
321+ EquipItems.Clear;
322+ ReadCommands;
323+ end else if EqStr('Launch',S) then begin
324+ FCommand := ncLaunch;
325+
326+ FPilot := ExtractSpacesDem(Val);
327+ FUnit := FPilot;
328+ FUnitID := '';
329+ GetMapPoint;
330+ GetCommonAnimation;
331+ end else if EqStr('Organize',S) then begin
332+ FCommand := ncOrganize;
333+ FRank := ExtractKakkos(Val);
334+ GetMapPoint;
335+
336+ if InStr('密集',Val) then begin
337+ FOvercrowd := True;
338+ Val := ReplaceStr(Val,'密集','');
339+ end;
340+
341+ GetCommonAnimation;
342+
343+ FPilot := Val;
344+ end else SendError('対応していないコマンドでユニットを製造しようとしました');
345+end;
346+
347+{TNoxCreateCommandList Funx.}
348+
349+Destructor TNoxCreateCommandList.Destroy;
350+begin
351+ Clear;
352+ inherited;
353+end;
354+
355+procedure TNoxCreateCommandList.Assign(Source: TPersistent);
356+var
357+ Item_CNT: Integer;
358+begin
359+ if Source is TNoxCreateCommandList then begin
360+ for Item_CNT := 0 to GetCount - 1 do
361+ FCommands[Item_CNT].Free;
362+
363+ SetLength(FCommands,TNoxCreateCommandList(Source).Count);
364+
365+ for Item_CNT := 0 to GetCount - 1 do begin
366+ FCommands[Item_CNT] := TNoxCreateCommand.Create;
367+ FCommands[Item_CNT].Assign(TNoxCreateCommandList(Source)[Item_CNT]);
368+ end;
369+ end;
370+end;
371+
372+function TNoxCreateCommandList.GetCount;
373+begin
374+ if Assigned(FCommands) then
375+ Result := Length(FCommands)
376+ else
377+ Result := 0;
378+end;
379+
380+procedure TNoxCreateCommandList.SetCommands(ID: Integer; val: TNoxCreateCommand);
381+begin
382+ FCommands[ID].Assign(val);
383+end;
384+
385+function TNoxCreateCommandList.GetCommands(ID: Integer):TNoxCreateCommand;
386+begin
387+ Result := FCommands[ID];
388+end;
389+
390+function TNoxCreateCommandList.Add;
391+begin
392+ SetLength(FCommands,GetCount + 1);
393+ FCommands[GetCount - 1]:= TNoxCreateCommand.Create;
394+ Result := FCommands[GetCount - 1];
395+end;
396+
397+procedure TNoxCreateCommandList.Delete(ID: Integer);
398+var
399+ Item_CNT: Integer;
400+begin
401+ FCommands[ID].Free;
402+
403+ for Item_CNT := ID to GetCount - 2 do
404+ FCommands[Item_CNT] := FCommands[Item_CNT + 1];
405+
406+ SetLength(FCommands,GetCount - 1);
407+end;
408+
409+procedure TNoxCreateCommandList.Insert(ID: Integer; val: TNoxCreateCommand);
410+var
411+ Item_CNT: Integer;
412+begin
413+ SetLength(FCommands,GetCount + 1);
414+
415+ for Item_CNT := GetCount - 1 downto ID + 1 do
416+ FCommands[Item_CNT] := FCommands[Item_CNT - 1];
417+
418+ FCommands[ID] := TNoxCreateCommand.Create;
419+ FCommands[ID].Assign(val);
420+end;
421+
422+procedure TNoxCreateCommandList.Clear;
423+var
424+ Item_CNT: Integer;
425+begin
426+ for Item_CNT := 0 to GetCount - 1 do FCommands[Item_CNT].Free;
427+ SetLength(FCommands,0);
428+end;
429+
430+function TNoxCreateCommandList.Find(const Charactor: string):TNoxCreateCommand;
431+var Item_CNT : Integer;
432+begin
433+ Result := NIL;
434+ for Item_CNT := 0 to GetCount - 1 do begin
435+ if FCommands[Item_CNT].Command = ncOrganize then Continue;
436+ if (FCommands[Item_CNT].Pilot = Charactor) or
437+ (FCommands[Item_CNT].UnitID = Charactor) then begin
438+ Result := FCommands[Item_CNT];
439+ break;
440+ end;
441+ end;
442+end;
443+
444+procedure TNoxCreateCommandList.GetIDList(IDs: TStrings);
445+var
446+ LC: Integer;
447+begin
448+ IDs.Clear;
449+ {$IF CSeek2DefaultScene <> ''}
450+ IDs.Add(CSeek2DefaultScene);
451+ {$IFEND}
452+
453+ for LC := 0 to Self.Count - 1 do begin
454+ if IDs.IndexOf(FCommands[LC].SceneID) < 0 then
455+ IDs.Add(FCommands[LC].SceneID);
456+ end;
457+end;
458+
459+end.
--- MLNox/CTerrain.pas (nonexistent)
+++ MLNox/CTerrain.pas (revision 4)
@@ -0,0 +1,270 @@
1+unit CTerrain;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,CSeek3List;
6+type
7+ TSRCTerrainType = (TTLand,TTIndoor,TTWater,TTDeepWater,
8+ TTAir,TTSpace,TTLunar);
9+
10+ TSRCTerrain = Class(TSRCData)
11+ private
12+ FName:String;
13+ FID : Integer;
14+ FFileName : String;
15+
16+ FLandType : TSRCTerrainType;
17+
18+ FMoveCost : Byte;{2倍してByte列で格納}
19+
20+ FHitBonus,FDamageBonus : Integer;
21+ FLandEffect : TStringList;
22+
23+ procedure SetLandEffect(val:TStringList);
24+ protected
25+
26+ procedure AssignTo(Dest:TPersistent);override;
27+ public
28+ Constructor Create;override;
29+ Destructor Destroy;override;
30+
31+ procedure WriteData(Dest:TStrings);override;
32+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
33+
34+ published
35+ property Name : String read FName write FName;
36+ property ID : Integer read FID write FID;
37+
38+ property FileName : String read FFileName write FFileName;
39+
40+ property LandType : TSRCTerrainType read FLandType write FLandType;
41+ property MoveCost : Byte read FMoveCost write FMoveCost;
42+
43+ property HitBonus : Integer read FHitBonus write FHitBonus;
44+ property DamageBonus : Integer read FDamageBonus write FDamageBonus;
45+
46+ property LandEffect : TStringList read FLandEffect write SetLandEffect;
47+ End;
48+
49+ TSRCTerrainList = Class(TSRCDataList)
50+ private
51+ function GetItems(ID:Integer):TSRCTerrain;
52+ procedure SetItems(ID:Integer;val:TSRCTerrain);
53+ protected
54+ function AddID(const ID:Integer):TSRCData;override;
55+ public
56+ property Items[ID:Integer] : TSRCTerrain read GetItems write SetItems;default;
57+
58+ function Add(var ID:Integer) :TSRCTerrain;overload;
59+ function Add :TSRCTerrain;overload;
60+ End;
61+
62+implementation
63+
64+Constructor TSRCTerrain.Create;
65+begin
66+ inherited;
67+ FLandEffect := TStringList.Create;
68+end;
69+
70+Destructor TSRCTerrain.Destroy;
71+begin
72+ FLandEffect.Free;
73+ inherited;
74+end;
75+
76+procedure TSRCTerrain.AssignTo(Dest: TPersistent);
77+begin
78+ if Dest is TSRCTerrain then begin
79+ TSRCTerrain(Dest).Name := FName;
80+ TSRCTerrain(Dest).ID := FID;
81+ TSRCTerrain(Dest).FileName := FFileName;
82+ TSRCTerrain(Dest).LandType := FLandType;
83+ TSRCTerrain(Dest).MoveCost := FMoveCost;
84+ TSRCTerrain(Dest).HitBonus := FHitBonus;
85+ TSRCTerrain(Dest).DamageBonus := FDamageBonus;
86+ TSRCTerrain(Dest).LandEffect := FLandEffect;
87+ end else inherited;
88+end;
89+
90+procedure TSRCTerrain.SetLandEffect(val: TStringList);
91+begin
92+ FLandEffect.Assign(val);
93+end;
94+
95+procedure TSRCTerrain.WriteData(Dest:TStrings);
96+var
97+ S : String;
98+begin
99+ Dest.Add(IntToStr(FID));
100+ Dest.Add(FName + ',' + FFileName);
101+
102+ Case FLandType of
103+ TTIndoor : S := '屋内,';
104+ TTWater : S := '水,';
105+ TTDeepWater : S := '深水,';
106+ TTAir : S := '空,';
107+ TTSpace : S := '宇宙,';
108+ TTLunar : S := '月面,';
109+ else S := '陸,';
110+ end;
111+
112+ if FMoveCost = 0 then
113+ S := S + '-'
114+ else begin
115+ S := S + IntToStr(FMoveCost div 2);
116+ if FMoveCost mod 2 = 1 then
117+ S := S + '.5';
118+ end;
119+
120+ S := S + ',' + inttostr(FHitBonus) + ',' +inttostr(FDamageBonus);
121+
122+ Dest.Add(S);
123+ Dest.AddStrings(FLandEffect);
124+ Dest.Add('');
125+end;
126+
127+function TSRCTerrain.ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;
128+var
129+ Str,SubStr : String;
130+ ATerrain :TSRCTerrain;
131+ List_CNT:Integer;
132+ procedure IncNum;
133+ var
134+ SS:String;
135+ begin
136+ inc(Index);
137+ while (Source.Count > Index) do begin
138+ SS := TrimJP(Source[Index]);
139+ if StartsStr('#',SS) then
140+ inc(Index) else break;
141+ end;
142+ end;
143+
144+ procedure SendError(const Error:String);
145+ begin
146+ Result := False;
147+ if Errors <> '' then Errors := Errors + #13#10;
148+
149+ Errors := Errors + Error +'(' +
150+ inttostr(Index) + '行目)';
151+ end;
152+
153+ function StrToInt(const Val,SRCType:String):Integer;
154+ begin
155+ if not TryStrToInt(Val,Result) then begin
156+ Result := 0;
157+ SendError(SRCType + 'が数値ではありません。');
158+ end;
159+ end;
160+
161+ function GetMoveCost(Val:String):Byte;
162+ begin
163+ if InStr('.',Val) then begin
164+ Result := StrToInt(ExtractWordDem(Val,'.'),'移動コスト(整数部)');
165+ if val[1] = '5' then
166+ Inc(Result);
167+ end else Result := StrToInt(Val,'移動コスト') * 2;
168+ end;
169+ function ReadLine:String;
170+ begin
171+ if Index >= Source.Count then begin
172+ SendError('項目が途切れています');
173+ Result := '';
174+ end else Result := Source[Index];
175+ end;
176+begin
177+ Result := True;
178+
179+ if Index >= Source.Count then Exit;
180+
181+ Str := TrimJP(ReadLine);
182+ while (Str = '') or (StartsStr('#',Str)) do begin
183+ incNum;
184+ if Index >= Source.Count then break;
185+ Str := TrimJP(ReadLine);
186+ end;
187+
188+ if Index >= Source.Count then Exit;
189+
190+ ATerrain := TSRCTerrain.Create;
191+ ATerrain.Assign(Self);
192+
193+ try
194+ FID := strtoint(Trim(ReadLine),'地形ID');
195+ incNum;
196+
197+ Str := ReadLine;
198+ incNum;
199+
200+ FName := TrimJP(ExtractWordDem(Str));
201+ FFileName := TrimJP(ExtractWordDem(Str));
202+
203+ Str := ReadLine;
204+ incNum;
205+
206+ SubStr := TrimJP(ExtractWordDem(Str));
207+
208+ FLandType := TTLand;
209+ if SubStr = '屋内' then FLandType := TTIndoor;
210+ if SubStr = '水' then FLandType := TTWater;
211+ if SubStr = '深水' then FLandType := TTDeepWater;
212+ if SubStr = '空' then FLandType := TTAir;
213+ if SubStr = '宇宙' then FLandType := TTSpace;
214+ if SubStr = '月面' then FLandType := TTLunar;
215+
216+ SubStr := TrimJP(ExtractWordDem(Str));
217+ if SubStr = '-' then
218+ FMoveCost := 0
219+ else
220+ FMoveCost := GetMoveCost(SubStr);
221+
222+ FHitBonus := Strtoint(TrimJP(ExtractWordDem(Str)),'命中率下降値');
223+ FDamageBonus := Strtoint(TrimJP(ExtractWordDem(Str)),'ダメージ下降値');
224+
225+ if Index >= Source.Count then Exit;
226+
227+ FLandEffect.Clear;
228+ Str := TrimJP(ReadLine);
229+ while (Str <> '') and (not TryStrToInt(Str,List_CNT)) do begin
230+ FLandEffect.Add(Str);
231+ IncNum;
232+
233+ if Index >= Source.Count then break;
234+ Str := TrimJP(ReadLine);
235+ end;
236+ finally
237+ if not Result then Assign(ATerrain);
238+ ATerrain.Free;
239+ end;
240+end;
241+
242+{ TSRCTerrainList Func. }
243+
244+function TSRCTerrainList.GetItems(ID: Integer):TSRCTerrain;
245+begin
246+ Result := TSRCTerrain(inherited GetItems(ID));
247+end;
248+
249+procedure TSRCTerrainList.SetItems(ID: Integer; val: TSRCTerrain);
250+begin
251+ Inherited SetItems(ID,val);
252+end;
253+
254+function TSRCTerrainList.AddID(const ID: Integer):TSRCData;
255+begin
256+ FItems[ID] := TSRCTerrain.Create;
257+ Result := FItems[ID];
258+end;
259+
260+function TSRCTerrainList.Add(var ID: Integer) : TSRCTerrain;
261+begin
262+ Result := TSRCTerrain(inherited Add(ID));
263+end;
264+
265+function TSRCTerrainList.Add: TSRCTerrain;
266+begin
267+ Result := TSRCTerrain(Inherited Add);
268+end;
269+
270+end.
--- MLNox/CEquips.pas (nonexistent)
+++ MLNox/CEquips.pas (revision 4)
@@ -0,0 +1,540 @@
1+unit CEquips;
2+
3+interface
4+uses
5+ Classes,SysUtils,NCommon,StringUnitLight,NCommonSRC;
6+
7+type
8+ TSRCEquip = Class(TPersistent)
9+ private
10+ FCaption:String;
11+ FAttackPower:Integer;
12+ FMinRange,FMaxRange:Byte;
13+ FHitBonus:SmallInt;
14+ FBullets:Byte;
15+ FUseEnergy:SmallInt;
16+ FNeedMind:Byte;
17+ FAirAttack,FLandAttack,FWaterAttack,FSpaceAttack:Byte;
18+ FCriticalBonus:SmallInt;
19+ FAttributes,FRuleofShow,FRuleOfUse:String;
20+
21+ function IntToRank(val:Byte):String;
22+ public
23+ function GetString:String;
24+ function SetString(const val:String;var Errors:String):Boolean;
25+ procedure Assign(Source:TPersistent);override;
26+published
27+ property Caption : String read FCaption write FCaption;
28+ property AttackPower : Integer read FAttackPower write FAttackPower;
29+ property MinRange : Byte read FMinRange write FMinRange;
30+ property MaxRange : Byte read FMaxRange write FMaxRange;
31+ property HitBonus : SmallInt read FHitBonus write FHitBonus;
32+ property CriticalBonus : SmallInt read FCriticalBonus write FCriticalBonus;
33+ property Bullets : Byte read FBullets write FBullets;
34+ property UseEnergy : SmallInt read FUseEnergy write FUseEnergy;
35+ property NeedMind : Byte read FNeedMind write FNeedMind;
36+ property AirAttack : Byte read FAirAttack write FAirAttack;
37+ property LandAttack : Byte read FLandAttack write FLandAttack;
38+ property WaterAttack : Byte read FWaterAttack write FWaterAttack;
39+ property SpaceAttack : Byte read FSpaceAttack write FSpaceAttack;
40+ property Attributes : String read FAttributes write FAttributes;
41+ property RuleofShow : String read FRuleofShow write FRuleofShow;
42+ property RuleOfUse : String read FRuleOfUse write FRuleOfUse;
43+ End;
44+
45+ TSRCEquipList = Class(TPersistent)
46+ private
47+ FEquips : Array of TSRCEquip;
48+
49+ function GetEquips(ID:Integer):TSRCEquip;
50+ procedure SetEquips(ID:Integer;val:TSRCEquip);
51+ function GetCount:Integer;
52+
53+ public
54+ procedure Delete(ID:Integer);
55+ function AddItem(const val:String;var Errors:String):Boolean;
56+
57+ function Add:TSRCEquip;
58+ procedure Insert(ID:Integer;val:TSRCEquip);
59+ property Equips[ID:Integer]:TSRCEquip read GetEquips write SetEquips;default;
60+
61+ procedure Assign(Source:TPersistent);override;
62+ published
63+ property Count:integer read GetCount;
64+ End;
65+
66+ TSRCAbility = Class(TPersistent)
67+ private
68+ FCaption:String;
69+ FEffects:String;
70+ FMaxRange:Byte;
71+ FBullets:Byte;
72+ FUseEnergy:SmallInt;
73+ FNeedMind:Byte;
74+ FAttributes,FRuleofShow,FRuleOfUse:String;
75+
76+ public
77+ procedure Assign(Source:TPersistent);override;
78+ function GetString:String;
79+ function SetString(const Str:String;var Errors:String):Boolean;
80+ published
81+ property Caption : String read FCaption write FCaption;
82+ property Effects : String read FEffects write FEffects;
83+ property MaxRange : Byte read FMaxRange write FMaxRange;
84+ property Bullets : Byte read FBullets write FBullets;
85+ property UseEnergy : SmallInt read FUseEnergy write FUseEnergy;
86+ property NeedMind : Byte read FNeedMind write FNeedMind;
87+ property Attributes : String read FAttributes write FAttributes;
88+ property RuleofShow : String read FRuleofShow write FRuleofShow;
89+ property RuleOfUse : String read FRuleOfUse write FRuleOfUse;
90+ End;
91+
92+ TSRCAbilityList = Class(TPersistent)
93+ private
94+ FAbilities : Array of TSRCAbility;
95+
96+ function GetAbilities(ID:Integer):TSRCAbility;
97+ procedure SetAbilities(ID:Integer;val:TSRCAbility);
98+ function GetCount:Integer;
99+ public
100+ procedure Delete(ID:Integer);
101+ function AddItem(const val:String;var Errors:String):Boolean;
102+ function Add:TSRCAbility;
103+ procedure Insert(ID:Integer;val:TSRCAbility);
104+ property Abilities[ID:Integer]:TSRCAbility read GetAbilities write SetAbilities;default;
105+ procedure Assign(Source:TPersistent);override;
106+
107+ published
108+ property Count:integer read GetCount;
109+ End;
110+
111+implementation
112+
113+{TSRCEquip Func.}
114+
115+procedure TSRCEquip.Assign(Source: TPersistent);
116+begin
117+ if Source is TSRCEquip then begin
118+ FCaption := TSRCEquip(Source).Caption;
119+ FAttackPower := TSRCEquip(Source).AttackPower;
120+ FMinRange := TSRCEquip(Source).MinRange;
121+ FMaxRange := TSRCEquip(Source).MaxRange;
122+ FHitBonus := TSRCEquip(Source).HitBonus;
123+ FBullets := TSRCEquip(Source).Bullets;
124+ FUseEnergy := TSRCEquip(Source).UseEnergy;
125+ FNeedMind := TSRCEquip(Source).NeedMind;
126+ FAirAttack := TSRCEquip(Source).AirAttack;
127+ FLandAttack := TSRCEquip(Source).LandAttack;
128+ FWaterAttack := TSRCEquip(Source).WaterAttack;
129+ FSpaceAttack := TSRCEquip(Source).SpaceAttack;
130+ FCriticalBonus := TSRCEquip(Source).CriticalBonus;
131+ FAttributes := TSRCEquip(Source).Attributes;
132+ FRuleofShow := TSRCEquip(Source).RuleofShow;
133+ FRuleOfUse := TSRCEquip(Source).RuleOfUse;
134+ end else inherited;
135+end;
136+
137+function TSRCEquip.GetString;
138+begin
139+ Result := Caption + ','+inttostr(AttackPower)+','+inttostr(MinRange)+',';
140+ Result := Result + inttostr(MaxRange)+',';
141+
142+ if HitBonus < 0 then
143+ Result := Result + inttostr(HitBonus)+','
144+ else
145+ Result := Result +'+'+ inttostr(HitBonus)+',';
146+
147+ if Bullets > 0 then
148+ Result := Result + inttostr(Bullets)+','
149+ else
150+ Result := Result +'-,';
151+
152+ if UseEnergy > 0 then
153+ Result := Result + inttostr(UseEnergy)+','
154+ else
155+ Result := Result +'-,';
156+
157+ if NeedMind > 0 then
158+ Result := Result + inttostr(NeedMind)+','
159+ else
160+ Result := Result +'-,';
161+
162+ Result := Result + IntToRank(AirAttack);
163+ Result := Result + IntToRank(LandAttack);
164+ Result := Result + IntToRank(WaterAttack);
165+ Result := Result + IntToRank(SpaceAttack)+',';
166+
167+ if CriticalBonus < 0 then
168+ Result := Result + inttostr(CriticalBonus)+','
169+ else
170+ Result := Result +'+'+ inttostr(CriticalBonus)+',';
171+
172+ Result := Result + Attributes;
173+
174+ if Trim(RuleOfUse) <> '' then
175+ Result := Result +'<'+ TrimJP(RuleOfUse) +'>';
176+
177+ if Trim(RuleofShow) <> '' then
178+ Result := Result +'('+ TrimJP(RuleofShow) +')';
179+end;
180+
181+function TSRCEquip.SetString(const val:String;var Errors:String):Boolean;
182+var
183+ CallRef:TStringList;
184+ S:String;
185+ Int_CNT:Integer;
186+ procedure SendError(const Error:String);
187+ begin
188+ Result := False;
189+ if Errors <> '' then Errors := Errors + #13#10;
190+
191+ Errors := Errors + '●' + Error;
192+ end;
193+ function TryStrToInt(const S,SType:String):Integer;
194+ begin
195+
196+ if not SysUtils.TryStrToInt(ReplaceStr(S,' ',''),Result) then begin
197+ Result := 0;
198+ SendError(SType + '(' + S + ')が整数ではありません');
199+ end;
200+ end;
201+
202+ function TryLineorStrToInt(const S,Stype:String):Integer;
203+ begin
204+ if S = '-' then Result := 0
205+ else Result := TryStrToInt(S,Stype);
206+ end;
207+begin
208+ CallRef := TStringList.Create;
209+ CallRef.Text := val;
210+ CallRef.Text := ReplaceStr(CallRef.Text,',',#13#10);
211+ Result := True;
212+
213+ if CallRef.Count <> 11 then begin
214+ SendError('武器の項目に過不足があります');
215+ end else begin
216+
217+
218+ for Int_CNT := 0 to 11 - 1 do begin
219+ CallRef[Int_CNT] := TrimJP(CallRef[Int_CNT]);
220+ end;
221+
222+ FCaption := CallRef[0];
223+
224+ FAttackPower := TryStrtoint(CallRef[1],'攻撃力');
225+ FMinRange := TryStrtoint(CallRef[2],'最小射程');
226+ FMaxRange := TryStrtoint(CallRef[3],'最大射程');
227+ FHitBonus := TryStrtoint(CallRef[4],'命中率修正');
228+
229+ FBullets := TryLineorStrToInt(CallRef[5],'弾数');
230+ UseEnergy := TryLineorStrToInt(CallRef[6],'消費EN');
231+ FNeedMind := TryLineorStrToInt(CallRef[7],'必要気力');
232+
233+ if Length(CallRef[8]) = 4 then begin
234+ FAirAttack := CharToRank(CallRef[8][1]);
235+ FLandAttack := CharToRank(CallRef[8][2]);
236+ FWaterAttack := CharToRank(CallRef[8][3]);
237+ FSpaceAttack := CharToRank(CallRef[8][4]);
238+ end else
239+ SendError('武器属性のバイト数が違います');
240+
241+ FCriticalBonus := TryStrToInt(CallRef[9],'クリティカル率');
242+
243+ S := CallRef[10];
244+
245+ if inStr('<',S) then begin {発動条件あり}
246+ Int_CNT := AnsiPos('<',S);
247+ FRuleOfUse := Copy(S, Int_CNT + 1,AnsiPos('>',S)- Int_CNT - 1);
248+ Delete(S,int_CNT,AnsiPos('>',S)- Int_CNT + 1);
249+ end;
250+
251+ if inStr('(',S) then begin {表示条件あり}
252+ Int_CNT := AnsiPos('(',S);
253+ FRuleofShow := Copy(S,Int_CNT + 1,AnsiPos(')',S)- Int_CNT - 1);
254+ Delete(S,Int_CNT,AnsiPos(')',S)- Int_CNT + 1);
255+ end;
256+
257+ FAttributes := S;
258+ end;
259+ CallRef.Free;
260+end;
261+
262+function TSRCEquip.IntToRank(val: Byte):String;
263+begin
264+ Case val of
265+ 0 : Result := 'S';
266+ 1 : Result := 'A';
267+ 3 : Result := 'C';
268+ 4 : Result := 'D';
269+ 5 : Result := '-';
270+ else Result := 'B';
271+ End;
272+end;
273+
274+{TSRCEquipList Func.}
275+
276+function TSRCEquipList.GetEquips(ID: Integer):TSRCEquip;
277+begin
278+ Result := FEquips[ID];
279+end;
280+
281+procedure TSRCEquipList.SetEquips(ID: Integer; val: TSRCEquip);
282+begin
283+ FEquips[ID].Assign(val);
284+end;
285+
286+function TSRCEquipList.GetCount;
287+begin
288+ if Assigned(FEquips) then
289+ Result := Length(FEquips)
290+ else
291+ Result := 0;
292+end;
293+
294+function TSRCEquipList.Add;
295+begin
296+ SetLength(FEquips,GetCount + 1);
297+ FEquips[GetCount - 1]:= TSRCEquip.Create;
298+ Result := FEquips[GetCount - 1];
299+end;
300+
301+procedure TSRCEquipList.Delete(ID: Integer);
302+var
303+ Equip_CNT: Integer;
304+begin
305+ FEquips[ID].Free;
306+
307+ for Equip_CNT := ID to GetCount - 2 do
308+ FEquips[Equip_CNT]:=FEquips[Equip_CNT + 1];
309+
310+ SetLength(FEquips,GetCount - 1);
311+end;
312+
313+procedure TSRCEquipList.Insert(ID: Integer; val: TSRCEquip);
314+var
315+ List_CNT:Integer;
316+begin
317+ SetLength(FEquips,GetCount + 1);
318+ for List_CNT := GetCount - 1 downto ID + 1 do
319+ FEquips[List_CNT] := FEquips[List_CNT - 1];
320+
321+ FEquips[ID] := TSRCEquip.Create;
322+ FEquips[ID].Assign(val);
323+end;
324+
325+function TSRCEquipList.AddItem(const val: string;var Errors:String):Boolean;
326+var
327+ E : TSRCEquip;
328+begin
329+ E := Self.Add;
330+ Result := E.SetString(Val,Errors);
331+end;
332+
333+procedure TSRCEquipList.Assign(Source: TPersistent);
334+var
335+ List_CNT: Integer;
336+begin
337+ if Source is TSRCEquipList then begin
338+
339+ for List_CNT := 0 to GetCount - 1 do
340+ FEquips[List_CNT].Free;
341+
342+ SetLength(FEquips,TSRCEquipList(Source).Count);
343+
344+ for List_CNT := 0 to GetCount - 1 do begin
345+ FEquips[List_CNT]:= TSRCEquip.Create;
346+ FEquips[List_CNT].Assign(TSRCEquipList(Source).Equips[List_CNT]);
347+ end;
348+ end else inherited;
349+end;
350+
351+{TSRCAbility Func.}
352+
353+procedure TSRCAbility.Assign(Source: TPersistent);
354+begin
355+ if Source is TSRCAbility then begin
356+ FCaption := TSRCAbility(Source).Caption;
357+ FEffects := TSRCAbility(Source).Effects;
358+ FMaxRange := TSRCAbility(Source).MaxRange;
359+ FBullets := TSRCAbility(Source).Bullets;
360+ FUseEnergy := TSRCAbility(Source).UseEnergy;
361+ FNeedMind := TSRCAbility(Source).NeedMind;
362+ FAttributes := TSRCAbility(Source).Attributes;
363+
364+ FRuleofShow := TSRCAbility(Source).RuleofShow;
365+ FRuleOfUse := TSRCAbility(Source).RuleOfUse;
366+ end else inherited;
367+end;
368+
369+function TSRCAbility.GetString;
370+begin
371+ Result := Caption + ',' + Effects + ',' + inttostr(MaxRange) + ',';
372+
373+ if Bullets > 0 then
374+ Result := Result + inttostr(Bullets)+','
375+ else
376+ Result := Result +'-,';
377+
378+ if UseEnergy > 0 then
379+ Result := Result + inttostr(UseEnergy)+','
380+ else
381+ Result := Result +'-,';
382+
383+ if NeedMind > 0 then
384+ Result := Result + inttostr(NeedMind)+','
385+ else
386+ Result := Result +'-,';
387+
388+ Result := Result + Attributes;
389+
390+ if RuleOfUse <> '' then
391+ Result := Result +'<'+ RuleOfUse +'>';
392+
393+ if RuleofShow <> '' then
394+ Result := Result +'('+ RuleofShow +')';
395+end;
396+
397+function TSRCAbility.SetString(const Str:String;var Errors:String):Boolean;
398+var
399+ CallRef : TStringList;
400+ ErrorBackUp : TSRCAbility;
401+ S:String;
402+ Int_CNT:Integer;
403+ procedure SendError(const Error:String);
404+ begin
405+ Result := False;
406+ if Errors <> '' then Errors := Errors + #13#10;
407+
408+ Errors := Errors + '◎' + Error;
409+ end;
410+ function TryStrToInt(const S,SType:String):Integer;
411+ begin
412+ if not SysUtils.TryStrToInt(S,Result) then begin
413+ Result := 0;
414+ SendError(SType + '(' + S + ')が整数ではありません');
415+ end;
416+ end;
417+
418+ function TryLineorStrToInt(const S,Stype:String):Integer;
419+ begin
420+ if S = '-' then Result := 0
421+ else Result := TryStrToInt(S,Stype);
422+ end;
423+begin
424+ CallRef := TStringList.Create;
425+ CallRef.Text := ReplaceStr(Str,',',#13#10);
426+ Result := True;
427+ ErrorBackUp := TSRCAbility.Create;
428+ ErrorBackup.Assign(Self);
429+
430+ if CallRef.Count <> 7 then begin
431+ SendError('アビリティの項目数に過不足('+inttostr(CallRef.Count - 7)+')があります');
432+ end else begin
433+ for Int_CNT := 0 to 7 - 1 do begin
434+ CallRef[Int_CNT] := TrimJP(CallRef[Int_CNT]);
435+ end;
436+ FCaption := CallRef[0];
437+ FEffects := CallRef[1];
438+
439+ FMaxRange := TryLineorStrToInt(CallRef[2],'射程');
440+ FBullets := TryLineOrStrtoint(CallRef[3],'使用回数');
441+ FUseEnergy := TryLineOrStrtoint(CallRef[4],'消費EN');
442+ FNeedMind := TryLineOrStrtoint(CallRef[5],'必要気力');
443+
444+ S := Trim(CallRef[6]);
445+
446+ if inStr('<',S) then begin {発動条件あり}
447+ Int_CNT := AnsiPos('<',S);
448+ FRuleOfUse := Copy(S,Int_CNT + 1,AnsiPos('>',S)- Int_CNT - 1);
449+ System.Delete(S,Int_CNT,AnsiPos('>',S)- Int_CNT + 1);
450+ end;
451+
452+ if inStr('(',S) then begin {表示条件あり}
453+ Int_CNT := AnsiPos('(',S);
454+ FRuleofShow := Copy(S,Int_CNT + 1,AnsiPos(')',S)- Int_CNT - 1);
455+ System.Delete(S,Int_CNT,AnsiPos(')',S)- Int_CNT + 1);
456+ end;
457+
458+ FAttributes := S;
459+ end;
460+
461+ if not Result then Assign(ErrorBackup);
462+ ErrorBackup.Free;
463+ CallRef.Free;
464+end;
465+
466+{TSRCAbilityList Func.}
467+
468+procedure TSRCAbilityList.Assign(Source: TPersistent);
469+var
470+ Ab_CNT: Integer;
471+begin
472+ if Source is TSRCAbilityList then begin
473+
474+ for Ab_CNT := 0 to GetCount - 1 do
475+ FAbilities[AB_CNT].Free;
476+
477+ SetLength(FAbilities,TSRCAbilityList(Source).Count);
478+
479+ for AB_CNT := 0 to GetCount - 1 do begin
480+ FAbilities[AB_CNT] := TSRCAbility.Create;
481+ FAbilities[AB_CNT].Assign(TSRCAbilityList(Source)[AB_CNT]);
482+ end;
483+ end else inherited;
484+end;
485+
486+function TSRCAbilityList.GetCount;
487+begin
488+ if Assigned(FAbilities) then
489+ Result := Length(FAbilities)
490+ else
491+ Result := 0;
492+end;
493+
494+function TSRCAbilityList.GetAbilities(ID: Integer):TSRCAbility;
495+begin
496+ Result := FAbilities[ID];
497+end;
498+
499+procedure TSRCAbilityList.SetAbilities(ID: Integer; val: TSRCAbility);
500+begin
501+ FAbilities[ID].Assign(val);
502+end;
503+
504+procedure TSRCAbilityList.Delete(ID: Integer);
505+var
506+ List_CNT: Integer;
507+begin
508+ FAbilities[ID].Free;
509+ for List_CNT := ID to GetCount - 2 do
510+ FAbilities[List_CNT] := FAbilities[List_CNT + 1];
511+
512+ SetLength(FAbilities,GetCount - 1 );
513+end;
514+
515+function TSRCAbilityList.Add;
516+begin
517+ SetLength(FAbilities,GetCount + 1);
518+ FAbilities[GetCount - 1] := TSRCAbility.Create;
519+
520+ Result := FAbilities[GetCount - 1];
521+end;
522+
523+procedure TSRCAbilityList.Insert(ID: Integer; val: TSRCAbility);
524+var
525+ List_CNT:Integer;
526+begin
527+ SetLength(FAbilities,GetCount + 1);
528+ for List_CNT := GetCount - 1 downto ID + 1 do
529+ FAbilities[List_CNT] := FAbilities[List_CNT - 1];
530+
531+ FAbilities[ID] := TSRCAbility.Create;
532+ FAbilities[ID].Assign(val);
533+end;
534+
535+function TSRCAbilityList.AddItem(const val: string;var Errors:String):Boolean;
536+begin
537+ Result := Self.Add.SetString(val,Errors);
538+end;
539+
540+end.
--- MLNox/FNoxUnit.pas (nonexistent)
+++ MLNox/FNoxUnit.pas (revision 4)
@@ -0,0 +1,666 @@
1+unit FNoxUnit;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, ExtCtrls, StdCtrls, WinSpinEdit, CNox, CPilot, CUnit, CItem,
8+ NCommon,StringUnitLight;
9+
10+type
11+ TNoxUnitForm = class(TForm)
12+ GroupBox4: TGroupBox;
13+ ComboBox1: TComboBox;
14+ Label1: TLabel;
15+ Label2: TLabel;
16+ ComboBox2: TComboBox;
17+ ComboBox3: TComboBox;
18+ Label3: TLabel;
19+ Edit1: TEdit;
20+ Label4: TLabel;
21+ Panel1: TPanel;
22+ Label5: TLabel;
23+ Panel2: TPanel;
24+ GroupBox5: TGroupBox;
25+ Label6: TLabel;
26+ WSE1: TWinSpinEdit;
27+ Edit2: TEdit;
28+ GroupBox10: TGroupBox;
29+ Memo1: TMemo;
30+ Button1: TButton;
31+ Button2: TButton;
32+ Button3: TButton;
33+ GroupBox11: TGroupBox;
34+ ComboBox4: TComboBox;
35+ GroupBox12: TGroupBox;
36+ ComboBox5: TComboBox;
37+ Button4: TButton;
38+ PaintBox1: TPaintBox;
39+ PaintBox2: TPaintBox;
40+ GroupBox13: TGroupBox;
41+ Label8: TLabel;
42+ Label10: TLabel;
43+ Label11: TLabel;
44+ Panel3: TPanel;
45+ OrganizeRB: TRadioButton;
46+ LaunchRB: TRadioButton;
47+ CreateRB: TRadioButton;
48+ Panel4: TPanel;
49+ RadioButton3: TRadioButton;
50+ RadioButton4: TRadioButton;
51+ RadioButton2: TRadioButton;
52+ RadioButton1: TRadioButton;
53+ OrganizeRB2: TRadioButton;
54+ RadioButton10: TRadioButton;
55+ RadioButton9: TRadioButton;
56+ RadioButton7: TRadioButton;
57+ Label12: TLabel;
58+ ComboBox6: TComboBox;
59+ Label7: TLabel;
60+ WSE2: TWinSpinEdit;
61+ Edit3: TEdit;
62+ CheckBox3: TCheckBox;
63+ CheckBox6: TCheckBox;
64+ CheckBox4: TCheckBox;
65+ WSE3: TWinSpinEdit;
66+ Edit4: TEdit;
67+ Label9: TLabel;
68+ WSE4: TWinSpinEdit;
69+ Edit5: TEdit;
70+ CheckBox2: TCheckBox;
71+ procedure FormCreate(Sender: TObject);
72+ procedure FormDestroy(Sender: TObject);
73+ procedure ComboBox1Change(Sender: TObject);
74+ procedure CommandRBClick(Sender: TObject);
75+ procedure Button4Click(Sender: TObject);
76+ procedure ComboBox4Change(Sender: TObject);
77+ procedure Button1Click(Sender: TObject);
78+ procedure ComboBox2Change(Sender: TObject);
79+ procedure PaintBox1Paint(Sender: TObject);
80+ procedure PaintBox2Paint(Sender: TObject);
81+ procedure ComboBox3Change(Sender: TObject);
82+ procedure CheckBox2Click(Sender: TObject);
83+ procedure CheckBox3Click(Sender: TObject);
84+ procedure CheckBox4Click(Sender: TObject);
85+ procedure CheckBox6Click(Sender: TObject);
86+ private
87+ { Private 宣言 }
88+ FGameDir,FSRCDir : String;
89+ FResult : TNoxCreateCommand;
90+ FPilots : TSRCPilotList;
91+ FUnits : TSRCUnitList;
92+ FRobots : TSRCUnitList;
93+ FItems : TSRCItemList;
94+
95+ procedure SetResult(val:TNoxCreateCommand);
96+ procedure SetUnitIDList(const Value: TStrings);
97+ procedure SetSceneID(const Value: String);
98+ public
99+ { Public 宣言 }
100+ procedure SetGameDir(val:String);
101+ procedure SetSRCDir(val:String);
102+
103+ property Result : TNoxCreateCommand read FResult write SetResult;
104+
105+ function Execute : Boolean;
106+ property GameDir : String read FGameDir write SetGameDir;
107+ property SRCDir : String read FSRCDir write SetSRCDir;
108+ property UnitIDList : TStrings write SetUnitIDList;
109+ property SceneID : String write SetSceneID;
110+ end;
111+
112+var
113+ NoxUnitForm: TNoxUnitForm;
114+
115+implementation
116+
117+{$R *.dfm}
118+
119+procedure TNoxUnitForm.FormCreate(Sender: TObject);
120+begin
121+ FPilots := TSRCPilotList.Create;
122+ FUnits := TSRCUnitList.Create;
123+ FRobots := TSRCUnitList.Create;
124+ FItems := TSRCItemList.Create;
125+
126+ CreateRB.OnClick(Self);
127+end;
128+
129+procedure TNoxUnitForm.FormDestroy(Sender: TObject);
130+begin
131+ FResult.Free;
132+ FPilots.Free;
133+ FUnits.Free;
134+ FRobots.Free;
135+ FItems.Free;
136+end;
137+
138+procedure TNoxUnitForm.SetGameDir(val:String);
139+var
140+ SR : TSearchRec;
141+begin
142+ val := IncludeTrailingPathDelimiter(val);
143+
144+ if DirectoryExists(val + 'Data\') then begin
145+ FGameDir := val;
146+
147+ ComboBox1.Items.Clear;
148+ ComboBox4.Items.Clear;
149+
150+ if FindFirst(FGameDir +'Data\*.*',faDirectory, sr) = 0 then begin
151+ repeat
152+ if ((sr.Attr and faDirectory) <> 0 ) and ( Sr.Name <>'..' ) then begin
153+ {SRCデータフォルダか確認}
154+ if FileExists(FGameDir +'Data\'+ SR.Name +'\Pilot.txt') or
155+ FileExists(FGameDir +'Data\'+ SR.Name +'\Unit.txt') or
156+ FileExists(FGameDir +'Data\'+ SR.Name +'\Robot.txt') then
157+ ComboBox1.Items.Add(SR.Name);
158+
159+ if FileExists(FGameDir +'Data\'+ SR.Name +'\Item.txt') then
160+ ComboBox4.Items.Add(SR.Name);
161+ end;
162+ until FindNext(sr) <> 0;
163+ end;
164+ FindClose(SR);
165+ end;
166+end;
167+
168+procedure TNoxUnitForm.SetSRCDir(val:String);
169+begin
170+ Val := IncludeTrailingPathDelimiter(val);
171+ if FileExists(val + 'SRC.exe') then begin
172+ FSRCDir := val;
173+ end;
174+end;
175+
176+procedure TNoxUnitForm.SetUnitIDList(const Value: TStrings);
177+begin
178+ ComboBox6.Items.Assign(Value);
179+end;
180+
181+procedure TNoxUnitForm.SetSceneID(const Value: String);
182+begin
183+ if Value = '' then ComboBox6.ItemIndex := 0 else begin
184+ if ComboBox6.Items.IndexOf(Value) >= 0 then
185+ ComboBox6.ItemIndex := ComboBox6.Items.IndexOf(Value)
186+ else ComboBox6.ItemIndex := 0;
187+ end;
188+end;
189+
190+procedure TNoxUnitForm.SetResult(val:TNoxCreateCommand);
191+var
192+ I : Integer;
193+begin
194+ if not Assigned(val) then begin
195+ FResult.Free;
196+ FResult := NIL;
197+ Exit;
198+ end;
199+
200+ if not Assigned(FResult) then
201+ FResult := TNoxCreateCommand.Create;
202+ FResult.Assign(Val);
203+
204+ SetSceneID(Val.SceneID);
205+
206+ if Val.Command = ncCreate then CreateRB.Checked := True;
207+ if Val.Command = ncLaunch then LaunchRB.Checked := True;
208+ if Val.Command = ncOrganize then begin
209+ if Val.Overcrowd then OrganizeRB2.Checked := True
210+ else OrganizeRB.Checked := True;
211+ end;
212+
213+ if Val.Camp = ncpFriend then RadioButton1.Checked := True;
214+ if Val.Camp = ncpNPC then RadioButton2.Checked := True;
215+ if Val.Camp = ncpEnemy then RadioButton4.Checked := True;
216+ if Val.Camp = ncpNeutral then RadioButton3.Checked := True;
217+
218+ if Val.Anime = naoNoting then RadioButton7.Checked := True;
219+ if Val.Anime = naoNoAnimation then RadioButton9.Checked := True;
220+ if Val.Anime = naoNoReload then RadioButton10.Checked := True;
221+
222+ ComboBox2.Text := Val.Pilot;
223+ ComboBox3.Text := Val.UnitName;
224+ Edit1.Text := val.UnitID;
225+
226+ if TryStrToInt(Val.Level,I) then begin
227+ Edit2.Text := '';
228+ WSE1.Value := I;
229+ CheckBox2.Checked := False;
230+ end else begin
231+ CheckBox2.Checked := True;
232+ Edit2.Text := Val.Level;
233+ end;
234+
235+ if Val.Command = ncOrganize then begin
236+ if TryStrToInt(Val.Rank,I) then begin
237+ Edit5.Text := '';
238+ WSE4.Value := I;
239+ CheckBox2.Checked := False;
240+ end else begin
241+ CheckBox2.Checked := True;
242+ Edit5.Text := Val.Rank;
243+ end;
244+ end else begin
245+ if TryStrToInt(Val.Rank,I) then begin
246+ Edit3.Text := '';
247+ WSE2.Value := I;
248+ CheckBox3.Checked := False;
249+ end else begin
250+ CheckBox3.Checked := True;
251+ Edit3.Text := Val.Rank;
252+ end;
253+ end;
254+
255+ if Val.BossRank = '-1' then begin
256+ Checkbox6.Checked := False;
257+ end else if TryStrToInt(Val.BossRank,I) then begin
258+ Edit4.Text := '';
259+ WSE3.Value := I;
260+ CheckBox4.Checked := False;
261+ Checkbox6.Checked := True;
262+ end else begin
263+ CheckBox4.Checked := True;
264+ Edit4.Text := Val.BossRank;
265+ Checkbox6.Checked := True;
266+ end;
267+
268+ Memo1.Lines.Assign(Val.EquipItems);
269+end;
270+
271+function TNoxUnitForm.Execute;
272+var I : Integer;
273+begin
274+ Result := False;
275+ if ComboBox6.ItemIndex < 0 then ComboBox6.ItemIndex := 0;
276+
277+ I := ShowModal;
278+ if I = MrOk then begin
279+ Result := True;
280+ if not Assigned(FResult) then FResult := TNoxCreateCommand.Create;
281+ FResult.SceneID := ComboBox6.Text;
282+
283+ if CreateRB.Checked then FResult.Command := ncCreate;
284+ if LaunchRB.Checked then FResult.Command := ncLaunch;
285+ if OrganizeRB.Checked then FResult.Command := ncOrganize;
286+ if OrganizeRB2.Checked then FResult.Command := ncOrganize;
287+
288+ if RadioButton1.Checked then FResult.Camp := ncpFriend;
289+ if RadioButton2.Checked then FResult.Camp := ncpNPC;
290+ if RadioButton4.Checked then FResult.Camp := ncpEnemy;
291+ if RadioButton3.Checked then FResult.Camp := ncpNeutral;
292+
293+ if RadioButton7.Checked then FResult.Anime := naoNoting;
294+ if RadioButton9.Checked then FResult.Anime := naoNoAnimation;
295+ if RadioButton10.Checked then FResult.Anime := naoNoReload;
296+
297+ if (OrganizeRB.Checked) or (OrganizeRB2.Checked) then begin
298+ FResult.Overcrowd := OrganizeRB2.Checked;
299+
300+ if CheckBox2.Checked then FResult.Rank := Edit5.Text
301+ else FResult.Rank := inttostr(WSE4.Value);
302+ FResult.EquipItems.Clear;
303+ end else begin
304+ FResult.Pilot := ComboBox2.Text;
305+
306+ FResult.UnitName := ComboBox3.Text;
307+ FResult.UnitID := Edit1.Text;
308+
309+ if CheckBox2.Checked then FResult.Level := Edit2.Text
310+ else FResult.Level := inttostr(WSE1.Value);
311+ if CheckBox3.Checked then FResult.Rank := Edit3.Text
312+ else FResult.Rank := inttostr(WSE2.Value);
313+ if not CheckBox6.Checked then FResult.BossRank := '-1' else
314+ if CheckBox4.Checked then FResult.BossRank := Edit4.Text
315+ else FResult.BossRank := inttostr(WSE3.Value);
316+
317+ I := 0;
318+ FResult.EquipItems.Assign(Memo1.Lines);
319+ while FResult.EquipItems.Count > i do begin
320+ if TrimJP(FResult.EquipItems[I]) = '' then
321+ FResult.EquipItems.Delete(i)
322+ else inc(i);
323+ end;
324+ end;
325+ end else if I = mrYes then begin
326+ Result := True;
327+ end;
328+end;
329+
330+procedure TNoxUnitForm.ComboBox1Change(Sender: TObject);
331+var
332+ List_CNT : Integer;
333+begin
334+ if FileExists(FGameDir +'Data\'+ ComboBox1.Text +'\Pilot.txt') then begin
335+ FPilots.LoadFromFile(FGameDir +'Data\'+ ComboBox1.Text +'\Pilot.txt');
336+ end else FPilots.Clear;
337+
338+ ComboBox2.Items.BeginUpdate;
339+ ComboBox2.Items.Clear;
340+
341+ for List_CNT := 0 to FPilots.Count - 1 do
342+ ComboBox2.Items.Add(FPilots[List_CNT].Name);
343+
344+ ComboBox2.Items.EndUpdate;
345+
346+ if FileExists(FGameDir +'Data\'+ ComboBox1.Text +'\Unit.txt') then begin
347+ FUnits.LoadFromFile(FGameDir +'Data\'+ ComboBox1.Text +'\Unit.txt');
348+ end else FUnits.Clear;
349+ if FileExists(FGameDir +'Data\'+ ComboBox1.Text +'\Robot.txt') then begin
350+ FRobots.LoadFromFile(FGameDir +'Data\'+ ComboBox1.Text +'\Robot.txt');
351+ end else FRobots.Clear;
352+
353+ ComboBox3.Items.BeginUpdate;
354+ ComboBox3.Items.Clear;
355+ for List_CNT := 0 to FUnits.Count - 1 do
356+ ComboBox3.Items.Add(FUnits[List_CNT].Name);
357+ for List_CNT := 0 to FRobots.Count - 1 do
358+ ComboBox3.Items.Add(FRobots[List_CNT].Name);
359+ ComboBox3.Items.EndUpdate;
360+end;
361+
362+procedure TNoxUnitForm.CommandRBClick(Sender: TObject);
363+ procedure LevelConster(const IsLevel : Boolean);
364+ begin
365+ Edit2.Visible := IsLevel;
366+ WSE1.Visible := IsLevel;
367+ Edit5.Visible := not IsLevel;
368+ WSE4.Visible := not IsLevel;
369+
370+ if IsLevel then begin
371+ Label6.Caption := 'レベル';
372+ end else begin
373+ Label6.Caption := 'ユニット数';
374+ end;
375+ Label6.Visible := True;
376+ CheckBox2.Visible := True;
377+
378+ Edit3.Visible := IsLevel;
379+ WSE2.Visible := IsLevel;
380+ CheckBox3.Visible := IsLevel;
381+
382+ Label7.Visible := IsLevel;
383+
384+ Edit4.Visible := IsLevel;
385+ WSE3.Visible := IsLevel;
386+ CheckBox6.Visible := IsLevel;
387+ CheckBox4.Visible := IsLevel;
388+ GroupBox5.Show;
389+ CheckBox2Click(Sender);
390+ if IsLevel then CheckBox3Click(Sender);
391+ CheckBox6Click(Sender);
392+ end;
393+ procedure UnitComboBoxConster(const Visible : Boolean);
394+ begin
395+ Label3.Visible := Visible;
396+ ComboBox3.Visible := Visible;
397+ Panel2.Visible := Visible;
398+ Label5.Visible := Visible;
399+ GroupBox4.Show;
400+ end;
401+ procedure PartyConster(const Visible:Boolean);
402+ begin
403+ Panel4.Visible := Visible;
404+ Label10.Visible := Visible;
405+ end;
406+begin
407+ if (OrganizeRB.Checked) or (OrganizeRB2.Checked) then begin
408+ LevelConster(False);
409+ GroupBox10.Hide;
410+ GroupBox4.Hide;
411+ PartyConster(False);
412+ end else if LaunchRB.Checked then begin
413+ GroupBox5.Hide;
414+ GroupBox10.Hide;
415+ {OrganizeなんでUnitを消去する}
416+ UnitComboBoxConster(False);
417+ PartyConster(False);
418+ end else begin
419+ UnitComboBoxConster(True);
420+ GroupBox10.Show;
421+ LevelConster(True);
422+ PartyConster(True);
423+ end;
424+end;
425+
426+procedure TNoxUnitForm.Button4Click(Sender: TObject);
427+begin
428+ if MessageDlg('本当に削除しますか？',mtInformation,mbOKCancel,0) = MrOk then begin
429+ FResult.Free;
430+ FResult := NIL;
431+ ModalResult := MrYes;
432+ end;
433+end;
434+
435+procedure TNoxUnitForm.ComboBox4Change(Sender: TObject);
436+var
437+ List_CNT : Integer;
438+begin
439+ if FileExists(FGameDir +'Data\'+ ComboBox4.Text +'\Item.txt') then begin
440+ FItems.LoadFromFile(FGameDir +'Data\'+ ComboBox4.Text +'\Item.txt');
441+ end else FItems.Clear;
442+
443+ ComboBox5.Items.BeginUpdate;
444+ ComboBox5.Items.Clear;
445+
446+ for List_CNT := 0 to FItems.Count - 1 do
447+ ComboBox5.Items.Add(FItems[List_CNT].Name);
448+
449+ ComboBox5.Items.EndUpdate;
450+end;
451+
452+procedure TNoxUnitForm.Button1Click(Sender: TObject);
453+begin
454+ if TrimJP(ComboBox5.Text) <> '' then
455+ Memo1.Lines.Add(TrimJP(ComboBox5.Text));
456+end;
457+
458+procedure TNoxUnitForm.ComboBox2Change(Sender: TObject);
459+var
460+ List_CNT : Integer;
461+ S : String;
462+begin
463+ //名前反映処理
464+ S := TrimJP(ComboBox2.Text);
465+ PaintBox1.Invalidate;
466+ PaintBox2.Invalidate;
467+
468+ for List_CNT := 0 to FUnits.Count - 1 do begin
469+ if S = FUnits[List_CNT].Name then begin
470+ ComboBox3.Text := FUnits[List_CNT].Name;
471+ Exit;
472+ end;
473+ end;
474+
475+ for List_CNT := 0 to FRobots.Count - 1 do begin
476+ if S = FRobots[List_CNT].Name then begin
477+ ComboBox3.Text := FRobots[List_CNT].Name;
478+ Exit;
479+ end;
480+ end;
481+
482+ S := ExtractWordDem(S,'(');
483+
484+ for List_CNT := 0 to FUnits.Count - 1 do begin
485+ if instr(S + '専用',FUnits[List_CNT].UnitClass) then begin
486+ ComboBox3.Text := FUnits[List_CNT].Name;
487+ Exit;
488+ end;
489+ end;
490+ for List_CNT := 0 to FRobots.Count - 1 do begin
491+ if instr(S + '専用',FRobots[List_CNT].UnitClass) then begin
492+ ComboBox3.Text := FRobots[List_CNT].Name;
493+ Exit;
494+ end;
495+ end;
496+ if ComboBox2.ItemIndex > - 1 then begin
497+ S := FPilots[ComboBox2.ItemIndex].OmissionName;
498+
499+ for List_CNT := 0 to FUnits.Count - 1 do begin
500+ if S = FUnits[List_CNT].OmissionName then begin
501+ ComboBox3.Text := FUnits[List_CNT].Name;
502+ Exit;
503+ end;
504+ end;
505+ for List_CNT := 0 to FRobots.Count - 1 do begin
506+ if S = FRobots[List_CNT].OmissionName then begin
507+ ComboBox3.Text := FRobots[List_CNT].Name;
508+ Exit;
509+ end;
510+ end;
511+ end;
512+
513+ S := TrimJP(ComboBox2.Text);
514+ S := ExtractWordDem(S,'(');
515+
516+ for List_CNT := 0 to FUnits.Count - 1 do begin
517+ if StartsStr(S,FUnits[List_CNT].Name) then begin
518+ ComboBox3.Text := FUnits[List_CNT].Name;
519+ Exit;
520+ end;
521+ end;
522+
523+ for List_CNT := 0 to FRobots.Count - 1 do begin
524+ if StartsStr(S,FRobots[List_CNT].Name) then begin
525+ ComboBox3.Text := FRobots[List_CNT].Name;
526+ Exit;
527+ end;
528+ end;
529+end;
530+
531+procedure TNoxUnitForm.ComboBox3Change(Sender: TObject);
532+begin
533+ PaintBox2.Invalidate;
534+end;
535+
536+procedure TNoxUnitForm.PaintBox1Paint(Sender: TObject);
537+var
538+ BMP : TBitmap;
539+ S : String;
540+ LC : Integer;
541+ PL : TSRCPilotList;
542+ SR : TSearchRec;
543+begin
544+ S := '';
545+ PL := TSRCPilotList.Create;
546+ if FindFirst(FGameDir +'Data\*.*',faDirectory, sr) = 0 then begin
547+ repeat
548+ if ((sr.Attr and faDirectory) <> 0 ) and ( Sr.Name <>'..' ) then begin
549+ {SRCデータフォルダか確認}
550+ if FileExists(FGameDir +'Data\'+ SR.Name +'\Pilot.txt') then begin
551+ PL.LoadFromFile(FGameDir +'Data\'+ SR.Name +'\Pilot.txt');
552+
553+ for LC := 0 to PL.Count - 1 do begin
554+ if ComboBox2.Text = PL[LC].Name then begin
555+ S := PL[LC].PilotGraphic;
556+ break;
557+ end;
558+ end;
559+ if S <> '' then break;
560+ end;
561+ end;
562+ until FindNext(sr) <> 0;
563+ end;
564+ FindClose(SR);
565+
566+ S := FGameDir +'Bitmap\Pilot\' + S;
567+ if FileExists(S) then begin
568+ BMP := TBitmap.Create;
569+ BMP.LoadFromFile(S);
570+
571+ PaintBox1.Canvas.CopyRect(Rect(0,0,64,64),BMP.Canvas,Rect(0,0,BMP.Width,BMP.Height));
572+ BMP.Free;
573+ end;
574+
575+ PL.Free;
576+end;
577+
578+procedure TNoxUnitForm.PaintBox2Paint(Sender: TObject);
579+var
580+ BMP : TBitmap;
581+ S : String;
582+ LC : Integer;
583+ UL : TSRCUnitList;
584+ SR : TSearchRec;
585+begin
586+ S := '';
587+ UL := TSRCUnitList.Create;
588+ if FindFirst(FGameDir +'Data\*.*',faDirectory, sr) = 0 then begin
589+ repeat
590+ if ((sr.Attr and faDirectory) <> 0 ) and ( Sr.Name <>'..' ) then begin
591+ {SRCデータフォルダか確認}
592+ if FileExists(FGameDir +'Data\'+ SR.Name +'\Unit.txt') then begin
593+ UL.LoadFromFile(FGameDir +'Data\'+ SR.Name +'\Unit.txt');
594+
595+ for LC := 0 to UL.Count - 1 do begin
596+ if ComboBox3.Text = UL[LC].Name then begin
597+ S := UL[LC].UnitGraphic;
598+ break;
599+ end;
600+ end;
601+ if S <> '' then break;
602+ end;
603+ if FileExists(FGameDir +'Data\'+ SR.Name +'\Robot.txt') then begin
604+ UL.LoadFromFile(FGameDir +'Data\'+ SR.Name +'\Robot.txt');
605+
606+ for LC := 0 to UL.Count - 1 do begin
607+ if ComboBox3.Text = UL[LC].Name then begin
608+ S := UL[LC].UnitGraphic;
609+ break;
610+ end;
611+ end;
612+ if S <> '' then break;
613+ end;
614+ end;
615+ until FindNext(sr) <> 0;
616+ end;
617+ FindClose(SR);
618+
619+ S := FGameDir +'Bitmap\Unit\' + S;
620+ if FileExists(S) then begin
621+ BMP := TBitmap.Create;
622+ BMP.LoadFromFile(S);
623+
624+ PaintBox2.Canvas.CopyRect(Rect(0,0,32,32),BMP.Canvas,Rect(0,0,BMP.Width,BMP.Height));
625+ BMP.Free;
626+ end;
627+
628+ UL.Free;
629+end;
630+
631+procedure TNoxUnitForm.CheckBox2Click(Sender: TObject);
632+begin
633+ if CreateRB.Checked then begin
634+ Edit2.Visible := CheckBox2.Checked;
635+ WSE1.Visible := not CheckBox2.Checked;
636+ end else begin
637+ Edit5.Visible := CheckBox2.Checked;
638+ WSE4.Visible := not CheckBox2.Checked;
639+ end;
640+end;
641+
642+procedure TNoxUnitForm.CheckBox3Click(Sender: TObject);
643+begin
644+ Edit3.Visible := CheckBox3.Checked;
645+ WSE2.Visible := not CheckBox3.Checked;
646+end;
647+
648+procedure TNoxUnitForm.CheckBox4Click(Sender: TObject);
649+begin
650+ Edit4.Visible := CheckBox4.Checked;
651+ WSE3.Visible := not CheckBox4.Checked;
652+end;
653+
654+procedure TNoxUnitForm.CheckBox6Click(Sender: TObject);
655+begin
656+ if not CheckBox6.Checked then begin
657+ CheckBox4.Hide;
658+ Edit4.Hide;
659+ WSE3.Hide;
660+ end else begin
661+ CheckBox4.Show;
662+ CheckBox4Click(Sender);
663+ end;
664+end;
665+
666+end.
--- MLNox/FMapSize.pas (nonexistent)
+++ MLNox/FMapSize.pas (revision 4)
@@ -0,0 +1,79 @@
1+unit FMapSize;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, StdCtrls, WinSpinEdit;
8+
9+type
10+ TMapSizeForm = class(TForm)
11+ GroupBox2: TGroupBox;
12+ Label3: TLabel;
13+ Label4: TLabel;
14+ WSE1: TWinSpinEdit;
15+ WSE2: TWinSpinEdit;
16+ CheckBox1: TCheckBox;
17+ Button1: TButton;
18+ Button2: TButton;
19+ private
20+ { Private 宣言 }
21+ procedure SetWidth(val:Integer);
22+ function GetWidth:Integer;
23+ procedure SetHeight(val:Integer);
24+ function GetHeight:Integer;
25+ procedure SetOldVer(val:Boolean);
26+ function GetOldver:Boolean;
27+ public
28+ { Public 宣言 }
29+ Function Execute:Boolean;
30+ published
31+ property Width:Integer read GetWidth write SetWidth;
32+ property Height:Integer read GetHeight write SetHeight;
33+
34+ property OldVer:Boolean read GetOldver write SetOldVer;
35+ end;
36+
37+var
38+ MapSizeForm: TMapSizeForm;
39+
40+implementation
41+
42+{$R *.dfm}
43+
44+procedure TMapSizeForm.SetWidth(val: Integer);
45+begin
46+ WSE1.Value := val;
47+end;
48+
49+function TMapSizeForm.GetWidth;
50+begin
51+ Result := WSE1.Value;
52+end;
53+
54+procedure TMapSizeForm.SetHeight(val: Integer);
55+begin
56+ WSE2.Value := val;
57+end;
58+
59+function TMapSizeForm.GetHeight;
60+begin
61+ Result := WSE2.Value;
62+end;
63+
64+procedure TMapSizeForm.SetOldVer(val: Boolean);
65+begin
66+ CheckBox1.Checked := val;
67+end;
68+
69+function TMapSizeForm.GetOldver;
70+begin
71+ Result := CheckBox1.Checked;
72+end;
73+
74+function TMapSizeForm.Execute;
75+begin
76+ Result := ShowModal = MrOk;
77+end;
78+
79+end.
--- MLNox/CMapChipBMP.pas (nonexistent)
+++ MLNox/CMapChipBMP.pas (revision 4)
@@ -0,0 +1,71 @@
1+unit CMapChipBMP;
2+
3+interface
4+uses
5+ SysUtils,Classes,Graphics;
6+type
7+ TSRCLandBitmaps = Class(TPersistent)
8+ private
9+ FBitmaps : Array of TBitmap;
10+ FIDs : Array of SmallInt;
11+
12+ function GetBitmaps(ID:Integer):TBitmap;
13+ function GetCount : Integer;
14+ public
15+ //procedure Assign
16+ Destructor Destroy;override;
17+ procedure Clear;
18+ property Bitmaps[ID:Integer]:TBitmap read GetBitmaps;default;
19+ function LoadBitmapFromFile(const ID : SmallInt;const FileName : String):TBitmap;
20+ property Count : Integer read GetCount;
21+ end;
22+implementation
23+
24+Destructor TSRCLandBitmaps.Destroy;
25+begin
26+ Clear;
27+ inherited;
28+end;
29+
30+function TSRCLandBitmaps.GetCount;
31+begin
32+ if Assigned(FBitmaps) then
33+ Result := Length(FBitmaps) else Result := 0;
34+end;
35+
36+procedure TSRCLandBitmaps.Clear;
37+var
38+ Land_CNT : integer;
39+begin
40+ for Land_CNT := 0 to GetCount - 1 do
41+ FBitmaps[Land_CNT].Free;
42+
43+ SetLength(FBitmaps,0);
44+ SetLength(FIDs,0);
45+end;
46+
47+function TSRCLandBitmaps.GetBitmaps(ID:Integer):TBitmap;
48+var Land_CNT : Integer;
49+begin
50+ Result := NIL;
51+ for Land_CNT := 0 to GetCount - 1 do begin
52+ if FIDs[Land_CNT] = ID then begin
53+ Result := FBitmaps[Land_CNT];
54+ break;
55+ end;
56+ end;
57+end;
58+
59+function TSRCLandBitmaps.LoadBitmapFromFile(const ID:SmallInt;const FileName:String):TBitmap;
60+begin
61+ SetLength(FBitmaps,GetCount + 1);
62+ SetLength(FIDs,GetCount);
63+
64+ FIDs[GetCount - 1] := ID;
65+ FBitmaps[GetCount - 1] := TBitmap.Create;
66+ FBitmaps[GetCount - 1].LoadFromFile(FileName);
67+ Result := FBitmaps[GetCount - 1];
68+ Result.PixelFormat := pf32Bit;
69+end;
70+
71+end.
--- MLNox/CMessage.pas (nonexistent)
+++ MLNox/CMessage.pas (revision 4)
@@ -0,0 +1,234 @@
1+unit CMessage;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,CSeek3List;
6+type
7+ TSRCMessage = Class(TPersistent)
8+ private
9+ FSituation : String;
10+ FMessages : String;
11+ protected
12+ procedure AssignTo(Dest:TPersistent);override;
13+ public
14+ Constructor Create;
15+
16+ function GetData : String;
17+ procedure SetData(Val: String);
18+ published
19+ property Situation : String read FSituation write FSituation;
20+ property Messages : String read FMessages write FMessages;
21+ End;
22+
23+ TSRCMessages = Class(TSRCDataArray)
24+ private
25+ FCharactor : String;
26+
27+ function GetItems(ID:Integer):TSRCMessage;
28+ procedure SetItems(ID:Integer;val:TSRCMessage);
29+ protected
30+ procedure AssignCommonData(Dest:TPersistent);override;
31+ function AddID(const ID:Integer):TPersistent;override;
32+ public
33+ function Add:TSRCMessage;
34+ procedure Insert(ID:Integer;val:TSRCMessage);
35+
36+ procedure WriteData(Dest:TStrings);override;
37+ function ReadData(Source:TStrings;
38+ Index:Integer;var Errors : String):Boolean;override;
39+ property Items[ID:Integer]:TSRCMessage read GetItems write SetItems;default;
40+ published
41+ property Charactor : String read FCharactor write FCharactor;
42+ End;
43+
44+ TSRCMessageList = Class(TSRCDataList)
45+ private
46+ function GetItems(ID:Integer):TSRCMessages;
47+ procedure SetItems(ID:Integer;val:TSRCMessages);
48+ protected
49+ function AddID(const ID:Integer):TSRCData;override;
50+ public
51+ function Add(out ID : integer):TSRCMessages;overload;
52+ function Add:TSRCMessages;overload;
53+
54+ property Items[ID:Integer] : TSRCMessages read GetItems write SetItems;default;
55+ published
56+ End;
57+
58+implementation
59+
60+{TSRCMessage Func.}
61+
62+Constructor TSRCMessage.Create;
63+begin
64+ inherited;
65+ FSituation := '新規メッセージ';
66+ FMessages := '';
67+end;
68+
69+procedure TSRCMessage.AssignTo(Dest: TPersistent);
70+begin
71+ if Dest is TSRCMessage then begin
72+ TSRCMessage(Dest).Situation := FSituation;
73+ TSRCMessage(Dest).Messages := FMessages;
74+ end else inherited;
75+end;
76+
77+function TSRCMessage.GetData : String;
78+begin
79+ Result := FSituation + ',' + FMessages;
80+end;
81+
82+procedure TSRCMessage.SetData(val:String);
83+begin
84+ FSituation := ExtractWordDem(Val);
85+ FMessages := val;
86+end;
87+
88+{TSRCMessages Func.}
89+
90+procedure TSRCMessages.AssignCommonData(Dest: TPersistent);
91+var
92+ List_CNT: Integer;
93+begin
94+ if Dest is TSRCMessages then begin
95+ TSRCMessages(Dest).Charactor := FCharactor;
96+ end else inherited;
97+end;
98+
99+function TSRCMessages.GetItems(ID: Integer) : TSRCMessage;
100+begin
101+ Result := TSRCMessage(inherited GetItems(ID));
102+end;
103+
104+procedure TSRCMessages.SetItems(ID: Integer; val: TSRCMessage);
105+begin
106+ inherited SetItems(ID,val);
107+end;
108+
109+function TSRCMessages.AddID(const ID: Integer):TPersistent;
110+begin
111+ FItems[ID] := TSRCMessage.Create;
112+ Result := FItems[ID];
113+end;
114+
115+function TSRCMessages.Add;
116+begin
117+ Result := TSRCMessage(inherited Add);
118+end;
119+
120+procedure TSRCMessages.Insert(ID: Integer; val: TSRCMessage);
121+var
122+ List_CNT: Integer;
123+begin
124+ Inherited Insert(ID,val);
125+end;
126+
127+procedure TSRCMessages.WriteData(Dest:TStrings);
128+var
129+ List_CNT: Integer;
130+begin
131+ Dest.Add(FCharactor);
132+
133+ for List_CNT := 0 to Count - 1 do
134+ Dest.Add(GetItems(List_CNT).GetData);
135+
136+ Dest.Add('');
137+end;
138+
139+function TSRCMessages.ReadData(Source:TStrings;Index:Integer;var Errors:String):Boolean;
140+var
141+ AMessages :TSRCMessages;
142+ AMessage : TSRCMessage;
143+ Str : String;
144+ procedure IncNum;
145+ var
146+ SS:String;
147+ begin
148+ inc(Index);
149+ while (Source.Count > Index) do begin
150+ SS := TrimJP(Source[Index]);
151+ if StartsStr('#',SS) then
152+ inc(Index) else break;
153+ end;
154+ end;
155+ procedure SendError(const Error:String);
156+ begin
157+ Result := False;
158+ if Errors <> '' then Errors := Errors + #13#10;
159+
160+ Errors := Errors + Error +'(' +
161+ inttostr(Index) + '行目)';
162+ end;
163+ function ReadLine:String;
164+ begin
165+ if Index >= Source.Count then begin
166+ SendError('項目が途切れています');
167+ Result := '';
168+ end else Result := Source[Index];
169+ end;
170+begin
171+ Result := True;
172+ if Source.Count <= Index then Exit;
173+
174+ Str := TrimJP(ReadLine);
175+ while (Str = '') OR (StartsText('#',Str)) do begin
176+ IncNum;
177+ if Source.Count <= Index then break;
178+ Str := TrimJP(ReadLine);
179+ end;
180+
181+ if Source.Count <= Index then Exit;
182+
183+ AMessages := TSRCMessages.Create;
184+
185+ try
186+ AMessages.Charactor := Trim(ReadLine);
187+ IncNum;
188+
189+ Str := TrimJP(ReadLine);
190+ while (inStr(',',Str)) and (Str <> '') do begin
191+ AMessage := AMessages.Add;
192+ AMessage.SetData(Str);
193+ incNum;
194+ if Source.Count <= Index then Break;
195+
196+ Str := TrimJP(ReadLine);
197+ end;
198+
199+ finally
200+ if Result then
201+ Assign(AMessages);
202+ AMessages.Free;
203+ end;
204+end;
205+
206+{TSRCMessageList Func.}
207+
208+function TSRCMessageList.GetItems(ID: Integer) : TSRCMessages;
209+begin
210+ Result := TSRCMessages(Inherited GetItems(ID));
211+end;
212+
213+procedure TSRCMessageList.SetItems(ID: Integer; val: TSRCMessages);
214+begin
215+ Inherited SetItems(ID,val);
216+end;
217+
218+function TSRCMessageList.AddID(const ID: Integer):TSRCData;
219+begin
220+ FItems[ID] := TSRCMessages.Create;
221+ Result := FItems[ID];
222+end;
223+
224+function TSRCMessageList.Add(out ID: Integer) : TSRCMessages;
225+begin
226+ Result := TSRCMessages(Inherited Add(ID));
227+end;
228+
229+function TSRCMessageList.Add:TSRCMessages;
230+begin
231+ Result := TSRCMessages(Inherited Add);
232+end;
233+
234+end.
--- MLNox/FMain.pas (nonexistent)
+++ MLNox/FMain.pas (revision 4)
@@ -0,0 +1,955 @@
1+unit FMain;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, ImgList, Menus, ActnList, ExtCtrls, ComCtrls, StdCtrls, ToolWin,
8+ IniFiles, CMapUndo, ABitmap, CNox, TB97Tlbr, TB97Ctls, TB97, ShellAPI,
9+ FormPosition, CNoxPrintEvent;
10+
11+type
12+ TNoxMapEditForm = class(TForm)
13+ ActionList1: TActionList;
14+ Save1: TAction;
15+ SaveAs1: TAction;
16+ ReLoad1: TAction;
17+ Paste1: TAction;
18+ Pen1: TAction;
19+ Rect1: TAction;
20+ Fill1: TAction;
21+ Select1: TAction;
22+ MMX1: TAction;
23+ Option2: TAction;
24+ MainMenu1: TMainMenu;
25+ M1: TMenuItem;
26+ C1: TMenuItem;
27+ O1: TMenuItem;
28+ Save2: TMenuItem;
29+ N1: TMenuItem;
30+ P1: TMenuItem;
31+ Close1: TMenuItem;
32+ Edit1: TMenuItem;
33+ Undo2: TMenuItem;
34+ R1: TMenuItem;
35+ N2: TMenuItem;
36+ Cut11: TMenuItem;
37+ Copy11: TMenuItem;
38+ Paste11: TMenuItem;
39+ P2: TMenuItem;
40+ P3: TMenuItem;
41+ R2: TMenuItem;
42+ F1: TMenuItem;
43+ S1: TMenuItem;
44+ V1: TMenuItem;
45+ I1: TMenuItem;
46+ O2: TMenuItem;
47+ O5: TMenuItem;
48+ N3: TMenuItem;
49+ N11: TMenuItem;
50+ N21: TMenuItem;
51+ N41: TMenuItem;
52+ N81: TMenuItem;
53+ O3: TMenuItem;
54+ G1: TMenuItem;
55+ MMXM1: TMenuItem;
56+ S2: TMenuItem;
57+ ImageList1: TImageList;
58+ L1: TMenuItem;
59+ G2: TMenuItem;
60+ A2: TMenuItem;
61+ E1: TMenuItem;
62+ Ground1: TAction;
63+ Air1: TAction;
64+ Event1: TAction;
65+ Panel2: TPanel;
66+ ListBox1: TListBox;
67+ Panel3: TPanel;
68+ ScrollBox2: TScrollBox;
69+ ChipPB: TPaintBox;
70+ Panel4: TPanel;
71+ Panel5: TPanel;
72+ SSPB: TPaintBox;
73+ Splitter1: TSplitter;
74+ Cllasic1: TAction;
75+ New1: TAction;
76+ Type61: TAction;
77+ N4: TMenuItem;
78+ C2: TMenuItem;
79+ N5: TMenuItem;
80+ N661: TMenuItem;
81+ ScrollBox1: TScrollBox;
82+ MapPB: TPaintBox;
83+ ClipPB: TPaintBox;
84+ OpenDialog1: TOpenDialog;
85+ SaveDialog1: TSaveDialog;
86+ NewFile1: TAction;
87+ R3: TMenuItem;
88+ ShowThis1: TAction;
89+ Dark1: TAction;
90+ Half1: TAction;
91+ V2: TMenuItem;
92+ H1: TMenuItem;
93+ D1: TMenuItem;
94+ T1: TMenuItem;
95+ Dock971: TDock97;
96+ Toolbar971: TToolbar97;
97+ ToolbarButton971: TToolbarButton97;
98+ ToolbarButton972: TToolbarButton97;
99+ ToolbarButton973: TToolbarButton97;
100+ ToolbarButton974: TToolbarButton97;
101+ ToolbarButton975: TToolbarButton97;
102+ Toolbar972: TToolbar97;
103+ ToolbarButton976: TToolbarButton97;
104+ ToolbarButton977: TToolbarButton97;
105+ ToolbarButton978: TToolbarButton97;
106+ ToolbarButton979: TToolbarButton97;
107+ ToolbarButton9710: TToolbarButton97;
108+ Toolbar973: TToolbar97;
109+ ToolbarButton9711: TToolbarButton97;
110+ ToolbarButton9712: TToolbarButton97;
111+ ToolbarButton9713: TToolbarButton97;
112+ Toolbar974: TToolbar97;
113+ ToolbarButton9714: TToolbarButton97;
114+ ToolbarButton9715: TToolbarButton97;
115+ ToolbarButton9716: TToolbarButton97;
116+ ToolbarButton9717: TToolbarButton97;
117+ Toolbar975: TToolbar97;
118+ ToolbarButton9718: TToolbarButton97;
119+ ToolbarButton9719: TToolbarButton97;
120+ ToolbarButton9720: TToolbarButton97;
121+ ToolbarSep971: TToolbarSep97;
122+ ToolbarButton9721: TToolbarButton97;
123+ ToolbarButton9722: TToolbarButton97;
124+ ToolbarButton9723: TToolbarButton97;
125+ ToolbarButton9724: TToolbarButton97;
126+ SceneToolBar: TToolbar97;
127+ ComboBox1: TComboBox;
128+ Print1: TAction;
129+ ToolbarButton9725: TToolbarButton97;
130+ ToolbarButton9726: TToolbarButton97;
131+ Delete1: TAction;
132+ D2: TMenuItem;
133+ FP1: TFormPosition;
134+ LoadPrint1: TAction;
135+ SavePrint1: TAction;
136+ EODiag: TOpenDialog;
137+ ESDiag: TSaveDialog;
138+ ToolbarButton9727: TToolbarButton97;
139+ ToolbarButton9728: TToolbarButton97;
140+ E2: TMenuItem;
141+ procedure FormDestroy(Sender: TObject);
142+ procedure ReLoad1Execute(Sender: TObject);
143+ procedure ListBox1Click(Sender: TObject);
144+ procedure ScrollBox1Resize(Sender: TObject);
145+ procedure ChangePenProc(Sender: TObject);
146+ procedure Paste1Execute(Sender: TObject);
147+ procedure G1Click(Sender: TObject);
148+ procedure NewFile1Execute(Sender: TObject);
149+ procedure Save1Execute(Sender: TObject);
150+ procedure SaveAs1Execute(Sender: TObject);
151+ procedure Close1Click(Sender: TObject);
152+ procedure TileDataExecute(Sender: TObject);
153+ procedure MMX1Execute(Sender: TObject);
154+ procedure R3Click(Sender: TObject);
155+ procedure LayerChangeExecute(Sender: TObject);
156+ procedure LayerShowExecute(Sender: TObject);
157+ procedure ComboBox1Change(Sender: TObject);
158+ procedure Print1Execute(Sender: TObject);
159+ procedure ChipPBMouseMove(Sender: TObject; Shift: TShiftState; X,
160+ Y: Integer);
161+ procedure ScrollBox2MouseWheelDown(Sender: TObject; Shift: TShiftState;
162+ MousePos: TPoint; var Handled: Boolean);
163+ procedure ScrollBox2MouseWheelUp(Sender: TObject; Shift: TShiftState;
164+ MousePos: TPoint; var Handled: Boolean);
165+ procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
166+ Y: Integer);
167+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
168+ procedure LoadPrint1Execute(Sender: TObject);
169+ procedure SavePrint1Execute(Sender: TObject);
170+ private
171+ { Private 宣言 }
172+ FOpenFile : String;
173+ FMapUndo : TSRCMapUndoList;
174+ FLockPlace : TPoint;
175+ FCommands : TNoxCreateCommandList;
176+ function GetOptimumMapSize(const MapWidth: Integer; const MapHeight: Integer):Integer;
177+ procedure CalcGameDir(const FN : String);
178+ procedure BeforeSizeChange(Sender: TObject);
179+ procedure AfterSizeChange(Sender: TObject);
180+ procedure HideClipBoard(Sender:TObject);
181+ procedure ClipEffect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
182+ procedure ClipUpEffect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
183+ procedure ZoomChange(Sender: TObject);
184+ procedure UpdateComboBox(const SL : TStrings = NIL);
185+ procedure WMDropFiles(var msg: TWMDROPFILES); message WM_DROPFILES;
186+ procedure OpenFile(const FileName : TFileName);
187+ procedure OpenEvent(const FileName: TFileName);
188+ procedure ChangeChip(Sender:TObject);
189+ function FileSaveAS:Boolean;
190+ function ConfirmSave : Boolean;
191+ public
192+ { Public 宣言 }
193+ procedure Start;
194+ procedure SetGameDir(const Dir:String);
195+ procedure SetSRCDir(const Dir:String);
196+ end;
197+
198+var
199+ NoxMapEditForm: TNoxMapEditForm;
200+const
201+ ProsessName : String = 'MultiLayered Nox';
202+
203+implementation
204+
205+uses MMap, MMapEdit, MClip, FSRCDir, CMap, FNoxUnit, FPrint;
206+
207+{$R *.dfm}
208+
209+{ TNoxMapEditForm }
210+
211+procedure TNoxMapEditForm.Start;
212+var
213+ ExePath,S : String;
214+ CL_CNT : Integer;
215+ Ini : TIniFile;
216+ SRCDirForm : TSRCDirForm;
217+begin
218+ ExePath := ExtractFilePath(Application.ExeName);
219+ Ini := TIniFile.Create(ExePath + 'Settings\SRCSeek.ini');
220+ FCommands := TNoxCreateCommandList.Create;
221+ FMapUndo := TSRCMapUndoList.Create;
222+
223+ SetSRCDir(Ini.ReadString('Project','SRCDir','C:\Program Files\SRC\'));
224+
225+ if MapModule.SRCDir = '' then begin
226+ SRCDirForm := TSRCDirForm.Create(Self);
227+ SRCDirForm.AppMame := ProsessName;
228+ SRCDirForm.IsExecute := True;
229+ if SRCDirForm.Execute then begin
230+ SetSRCDir(SRCDirForm.SRCDir);
231+ if Not DirectoryExists(ExePath + 'Settings\') then
232+ ForceDirectories(ExePath + 'Settings\');
233+ Ini.WriteString('Project','SRCDir',SRCDirForm.SRCDir);
234+ end else begin
235+ Application.Terminate;
236+ Exit;
237+ end;
238+ end;
239+
240+ if MapModule.SRCDir <> '' then
241+ MapModule.GetMapList(ListBox1.Items);
242+
243+ if not MMXCheck then begin
244+ MMX1.Checked := False;
245+ MMX1.Enabled := False;
246+ MMX1.Visible := False;
247+
248+ ShowMessage('このアプリケーションはMMX命令に対応していないPCでは動きません。');
249+ Application.Terminate;
250+ Exit;
251+ end;
252+
253+ MapEditModule.MapPaintBox := Self.MapPB;
254+ MapEditModule.ChipPaintBox := Self.SSPB;
255+ MapEditModule.MapChipPreviewPaintBox := Self.ChipPB;
256+
257+ MapEditModule.OnBeforeSizeChange := BeforeSizeChange;
258+ MapEditModule.OnAfterSizeChange := AfterSizeChange;
259+
260+ MapEditModule.MapUndo := FMapUndo;
261+ MapEditModule.OnMapSizeOptimize := GetOptimumMapSize;
262+ Pen1.Execute;
263+
264+ MapClipModule.ScrollBox := ScrollBox1;
265+ MapClipModule.MapPaintBox := MapPB;
266+ MapClipModule.ClipPaintBox := ClipPB;
267+ MapClipModule.ZoomPixel := MapEditModule.ZoomPixel;
268+ MapClipModule.ReloadDrawMode := HideClipBoard;
269+ MapEditModule.OnNoPenMapDown := ClipEffect;
270+ MapEditModule.OnNoPenMapUp := ClipUpEffect;
271+ MapEditModule.OnZoomChange := ZoomChange;
272+ MapEditModule.OnChangeChip := ChangeChip;
273+
274+ MapPB.Canvas.Pen.Color := clBlack;
275+ MapPB.Canvas.Brush.Color := clWhite;
276+ MapPB.Canvas.Brush.Style := bsDiagCross;
277+
278+ ClipPB.Canvas.Pen.Color := clWhite;
279+ ClipPB.Canvas.Brush.Color := clBlack;
280+ ClipPB.Canvas.Brush.Style := bsCross;
281+
282+ FMapUndo.Chips := MapModule.Chips;
283+
284+ if ParamCount > 0 then begin
285+ S := ' ';
286+ for CL_CNT := 1 to ParamCount do begin
287+ if S = ' ' then S := ParamStr(CL_CNT)
288+ else S := S + ' ' + ParamStr(CL_CNT);
289+
290+ if SameText(ExtractFileExt(S),'.map') and FileExists(S) then begin
291+ ListBox1.ItemIndex := 0;
292+ OpenFile(S);
293+ S := '';
294+ break;
295+ end;
296+ end;
297+ if S <> '' then NewFile1.Execute;
298+ end else NewFile1.Execute;
299+
300+ R3.Checked := Ini.ReadBool('MapEdit','RightMode',False);
301+ FMapUndo.Maximum := Ini.ReadInteger('MapEdit','MaxUndo',0);
302+ MapModule.MaxJanreBitmaps := Ini.ReadInteger('MapEdit','MaxJanreBitmap',0);
303+ G1.Checked := Ini.ReadBool('MapEdit','Grid',False);
304+ MMX1.Checked := Ini.ReadBool('MapEdit','MMX',True);
305+ S2.Checked := Ini.ReadBool('MapEdit','ReSizeOptimum',True);
306+ E2.Checked := Ini.ReadBool('Option','ShowMapSaveOption',True);
307+
308+ MMX1Execute(Self);
309+ G1Click(Self);
310+ R3Click(Self);
311+
312+ Dark1.Execute;
313+ FP1.LoadWindowState(Ini);
314+
315+ Ini.Free;
316+ DragAcceptFiles(Handle, true);
317+end;
318+
319+procedure TNoxMapEditForm.FormCloseQuery(Sender: TObject;
320+ var CanClose: Boolean);
321+begin
322+ CanClose := ConfirmSave;
323+end;
324+
325+procedure TNoxMapEditForm.FormDestroy(Sender: TObject);
326+var
327+ ExePath : String;
328+ Ini : TIniFile;
329+begin
330+ ExePath := ExtractFilePath(Application.ExeName);
331+ Ini := TIniFile.Create(ExePath + 'Settings\SRCSeek.ini');
332+
333+ Ini.WriteBool('MapEdit','RightMode',R3.Checked);
334+ Ini.WriteInteger('MapEdit','MaxUndo',FMapUndo.Maximum);
335+ Ini.WriteBool('MapEdit','Grid',G1.Checked);
336+ Ini.WriteBool('MapEdit','MMX',MMX1.Checked);
337+ Ini.WriteBool('MapEdit','ReSizeOptimum',S2.Checked);
338+ Ini.WriteBool('Option','ShowMapSaveOption',E2.Checked);
339+
340+ FP1.SaveWindowState(Ini);
341+ Ini.Free;
342+ FMapUndo.Free;
343+ FCommands.Free;
344+end;
345+
346+procedure TNoxMapEditForm.SetSRCDir(const Dir: String);
347+begin
348+ MapModule.SRCDir := Dir;
349+end;
350+
351+procedure TNoxMapEditForm.CalcGameDir(const FN: String);
352+var F,SF : String;
353+begin
354+ F := ExtractFileDir(FN);
355+ SF := ExtractFileDrive(FN);
356+ while F <> '' do begin
357+ if DirectoryExists(F + '\Data\') then begin
358+ MapModule.GameDir := F + '\';
359+ Event1.Enabled := True;
360+ NoxUnitForm.GameDir := F;
361+ NoxUnitForm.SRCDir := MapModule.SRCDir;
362+ SF := ListBox1.Items[ListBox1.ItemIndex];
363+ MapModule.GetMapList(ListBox1.Items);
364+
365+ if ListBox1.Items.IndexOf(SF) >= 0 then begin
366+ ListBox1.ItemIndex := ListBox1.Items.IndexOf(SF);
367+ ListBox1Click(Self);
368+ end;
369+
370+ FCommands.Clear;
371+ Exit;
372+ end else if F = SF + '\' then break else F := ExtractFileDir(F);
373+ end;
374+ Event1.Enabled := False;
375+ FCommands.Clear;
376+ if MapModule.SRCDir <> '' then
377+ MapModule.GetMapList(ListBox1.Items);
378+end;
379+
380+procedure TNoxMapEditForm.WMDropFiles(var msg: TWMDROPFILES);
381+var
382+ DropCount: Integer;
383+ pFilename: PChar;
384+begin
385+ try
386+ //ドロップされたファイル数をDropCountに取得
387+ DropCount := DragQueryFile(msg.Drop, $ffffffff, nil, 0);
388+ //複数ドロップを抑制する場合は処理を抜ける
389+ if DropCount > 1 then Exit;
390+ //ドロップされたファイル名のサイズを取得
391+ DropCount := DragQueryFile(msg.Drop, 0, nil, 0) + 1;
392+ //pFilenameに上で得たサイズ分のメモリを確保
393+ pFilename := AllocMem(DropCount);
394+ try
395+ //pFilenameにファイル名を取得
396+ DragQueryFile(msg.Drop, 0, pFilename, DropCount);
397+ if SameText(ExtractFileExt(pFileName),'.map') then OpenFile(pFileName);
398+ if SameText(ExtractFileExt(pFileName),'.eve') then OpenEvent(pFileName);
399+ finally
400+ //メモリ開放
401+ FreeMem(pFilename);
402+ end;
403+ finally
404+ //処理の終了をOSに通知
405+ DragFinish(msg.Drop);
406+ end;
407+end;
408+
409+procedure TNoxMapEditForm.ChangeChip(Sender: TObject);
410+var I : Integer;
411+begin
412+ if Sender = MapPB then begin
413+ I := MapModule.JanreToIndex(MapEditModule.SelectedChip.Janre);
414+ if (I >= 0) and (ListBox1.ItemIndex <> I) then begin
415+ ListBox1.ItemIndex := I;
416+ ListBox1Click(Sender);
417+ end;
418+ end;
419+end;
420+
421+procedure TNoxMapEditForm.ChangePenProc(Sender: TObject);
422+begin
423+ if ClipPB.Visible then begin
424+ MapClipModule.ClipEnter;
425+ end;
426+
427+ Pen1.Checked := False;
428+ Rect1.Checked := False;
429+ Fill1.Checked := False;
430+ Select1.Checked := False;
431+ Delete1.Checked := False;
432+ TAction(Sender).Checked := True;
433+
434+ if Event1.Checked then Exit;
435+ Paste1.Enabled := Select1.Checked;
436+ MapEditModule.DeletePen := False;
437+
438+ if Pen1.Checked then MapEditModule.DrawMode := mdPen
439+ else if Rect1.Checked then MapEditModule.DrawMode := mdRect
440+ else if Fill1.Checked then MapEditModule.DrawMode := mdFill
441+ else if Select1.Checked then MapEditModule.DrawMode := mdSelect
442+ else if Delete1.Checked then begin
443+ MapEditModule.DeletePen := True;
444+ MapEditModule.DrawMode := mdPen;
445+ end;
446+end;
447+
448+procedure TNoxMapEditForm.TileDataExecute(Sender: TObject);
449+begin
450+ Cllasic1.Checked := False;
451+ New1.Checked := False;
452+ Type61.Checked := False;
453+ TAction(Sender).Checked := True;
454+
455+ if Sender = Cllasic1 then begin
456+ Panel3.Width := 4 + 96 + 16;
457+ MapEditModule.ListDrawType := mldtCllasic;
458+ Panel5.Left := 40;
459+ end else begin
460+ Panel3.Width := 4 + 192 + 16;
461+ Panel5.Left := 84;
462+ if Sender = New1 then
463+ MapEditModule.ListDrawType := mldtCustom
464+ else MapEditModule.ListDrawType := mldtNumeric;
465+ end;
466+end;
467+
468+procedure TNoxMapEditForm.UpdateComboBox(const SL: TStrings = NIL);
469+var
470+ S : String;
471+begin
472+ ComboBox1.Items.BeginUpdate;
473+ S := ComboBox1.Text;
474+ if SL = NIL then
475+ FCommands.GetIDList(ComboBox1.Items)
476+ else ComboBox1.Items := SL;
477+
478+ ComboBox1.Items.Insert(0,'全て表示');
479+ if S <> '' then begin
480+ if ComboBox1.Items.IndexOf(S) >= 0 then
481+ ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(S)
482+ else ComboBox1.ItemIndex := 0;
483+ end else ComboBox1.ItemIndex := 0;
484+ ComboBox1.Items.EndUpdate;
485+end;
486+
487+procedure TNoxMapEditForm.Close1Click(Sender: TObject);
488+begin
489+ Application.Terminate;
490+end;
491+
492+procedure TNoxMapEditForm.LayerChangeExecute(Sender: TObject);
493+begin
494+ if Sender is TAction then begin
495+ Event1.Checked := False;
496+ Ground1.Checked := False;
497+ Air1.Checked := False;
498+
499+ TAction(Sender).Checked := True;
500+ end;
501+
502+ if Event1.Checked then begin
503+ MapEditModule.DrawMode := mdNone;
504+ FMapUndo.MapShower := dlmShow;
505+ Fill1.Enabled := False;
506+ Select1.Enabled := False;
507+ Delete1.Enabled := False;
508+ UpdateComboBox;
509+ ComboBox1Change(Sender);
510+ SceneToolBar.Show;
511+ end else begin
512+ SceneToolBar.Hide;
513+ HideClipBoard(Sender);
514+ LayerShowExecute(Self);
515+ Fill1.Enabled := True;
516+ Select1.Enabled := True;
517+ Delete1.Enabled := True;
518+ if Ground1.Checked then begin
519+ FMapUndo.Layer := 0;
520+ end else begin
521+ if FMapUndo.Map.Count = 1 then begin
522+ FMapUndo.AddLayer;
523+ end;
524+ FMapUndo.Layer := 1;
525+ end;
526+ end;
527+ MapEditModule.MapPaintBoxUpdate(Sender);
528+end;
529+
530+procedure TNoxMapEditForm.LayerShowExecute(Sender: TObject);
531+begin
532+ if Sender is TAction then begin
533+ ShowThis1.Checked := False;
534+ Dark1.Checked := False;
535+ Half1.Checked := False;
536+ TAction(Sender).Checked := True;
537+ end;
538+
539+ if Event1.Checked then Exit;
540+
541+ if ShowThis1.Checked then begin
542+ FMapUndo.MapShower := dlmHide;
543+ end else if Dark1.Checked then begin
544+ FMapUndo.MapShower := dlmDark;
545+ end else if Half1.Checked then begin
546+ FMapUndo.MapShower := dlmShow;
547+ end;
548+ MapEditModule.MapPaintBoxUpdate(Sender);
549+end;
550+
551+procedure TNoxMapEditForm.ListBox1Click(Sender: TObject);
552+begin
553+ if ListBox1.ItemIndex < 0 then ListBox1.ItemIndex := 0;
554+ MapEditModule.ChipJanre := ListBox1.ItemIndex;
555+end;
556+
557+procedure TNoxMapEditForm.MMX1Execute(Sender: TObject);
558+begin
559+ MapEditModule.UseMMX := MMX1.Checked;
560+end;
561+
562+procedure TNoxMapEditForm.Paste1Execute(Sender: TObject);
563+begin
564+ MapClipModule.MapData := FMapUndo.Map;
565+ MapClipModule.ZoomPixel := MapEditModule.ZoomPixel;
566+ MapClipModule.PasteProc;
567+end;
568+
569+procedure TNoxMapEditForm.Print1Execute(Sender: TObject);
570+begin
571+ PrintForm.Data := FCommands;
572+ if PrintForm.Execute then begin
573+ UpdateComboBox;
574+ ComboBox1Change(Sender);
575+ end;
576+end;
577+
578+procedure TNoxMapEditForm.NewFile1Execute(Sender: TObject);
579+var S : String;
580+begin
581+ if not ConfirmSave then Exit;
582+ MapClipModule.HideClipBoard;
583+ FOpenFile := '';
584+ MapModule.GameDir := '';
585+
586+ if ListBox1.ItemIndex >= 0 then begin
587+ S := ListBox1.Items[ListBox1.ItemIndex];
588+ MapModule.GetMapList(ListBox1.Items);
589+
590+ if ListBox1.Items.IndexOf(S) >= 0 then begin
591+ ListBox1.ItemIndex := ListBox1.Items.IndexOf(S);
592+ end else ListBox1.ItemIndex := 0;
593+ end;
594+
595+ Caption := ProsessName + ' : 新規';
596+ FMapUndo.NewMap(1);
597+ FMapUndo.Layer := 0;
598+ ScrollBox1Resize(Sender);
599+ MapEditModule.ZoomPixel := MapEditModule.ZoomPixel;
600+
601+ ListBox1Click(Sender);
602+ Event1.Enabled := False;
603+ if Event1.Checked then LayerChangeExecute(Ground1)
604+ else LayerChangeExecute(Self);
605+end;
606+
607+procedure TNoxMapEditForm.R3Click(Sender: TObject);
608+begin
609+ if R3.Checked then begin
610+ Panel2.Align := alRight;
611+ Splitter1.Align := alRight;
612+ Panel3.Align := alLeft;
613+ end else begin
614+ Panel2.Align := alLeft;
615+ Splitter1.Align := alLeft;
616+ Panel3.Align := alRight;
617+ end;
618+end;
619+
620+procedure TNoxMapEditForm.OpenFile(const FileName: TFileName);
621+begin
622+ FOpenFile := FileName;
623+ MapClipModule.HideClipBoard;
624+ CalcGameDir(FOpenFile);
625+ FMapUndo.LoadMap(FOpenFile);
626+
627+ ScrollBox1Resize(Self);
628+ Caption := ProsessName + ' : ' + ExtractFileName(FOpenFile);
629+ MapEditModule.TurnEditStop := True;
630+ ListBox1Click(Self);
631+ if Event1.Checked then Event1.Execute;
632+end;
633+
634+procedure TNoxMapEditForm.ReLoad1Execute(Sender: TObject);
635+begin
636+ if not ConfirmSave then Exit;
637+ MapClipModule.HideClipBoard;
638+ if OpenDialog1.Execute then begin
639+ OpenFile(OpenDialog1.FileName);
640+ end;
641+end;
642+
643+procedure TNoxMapEditForm.Save1Execute(Sender: TObject);
644+begin
645+ if FOpenFile = '' then SaveAs1.Execute else FMapUndo.SaveMap(FOpenFile);
646+end;
647+
648+function TNoxMapEditForm.FileSaveAS: Boolean;
649+begin
650+ if SaveDialog1.Execute then begin
651+ FOpenFile := SaveDialog1.FileName;
652+ Caption := ProsessName + ' : ' + ExtractFileName(FOpenFile);
653+ MapEditModule.TurnEditStop := True;
654+ FMapUndo.SaveMap(FOpenFile);
655+ CalcGameDir(FOpenFile);
656+ Result := True;
657+ end else Result := False;
658+end;
659+
660+function TNoxMapEditForm.ConfirmSave: Boolean;
661+var
662+ Res : Integer;
663+ function GetMapName : String;
664+ begin
665+ if FOpenFile = '' then Result := '無題'
666+ else Result := ExtractFileName(FOpenFile);
667+ end;
668+begin
669+ Result := True;
670+ if FMapUndo.Edited then begin
671+ Res := MessageDlg(GetMapName + 'は編集されています。保存しますか？',
672+ mtConfirmation,mbYesNoCancel,0);
673+ Case Res of
674+ mrYes : begin
675+ if FOpenFile <> '' then Save1Execute(Self)
676+ else if not FileSaveAs then Result := False;
677+ end;
678+ mrCancel : begin
679+ Result := False;
680+ end;
681+ End;
682+ end;
683+end;
684+
685+procedure TNoxMapEditForm.SaveAs1Execute(Sender: TObject);
686+begin
687+ FileSaveAs;
688+end;
689+
690+procedure TNoxMapEditForm.OpenEvent(const FileName: TFileName);
691+var NoxP : TNoxEventPrinter;
692+begin
693+ NoxP := TNoxEventPrinter.Create;
694+ NoxP.MapFile := FOpenFile;
695+ NoxP.MapData := NIL;
696+ NoxP.Commands := FCommands;
697+ NoxP.LoadFromFile(FileName);
698+
699+ NoxP.Free;
700+
701+ UpdateComboBox;
702+ ComboBox1Change(Self);
703+ LayerChangeExecute(Self);
704+end;
705+
706+procedure TNoxMapEditForm.LoadPrint1Execute(Sender: TObject);
707+
708+begin
709+ if EODiag.Execute then begin
710+ OpenEvent(EODiag.FileName);
711+ end;
712+end;
713+
714+procedure TNoxMapEditForm.SavePrint1Execute(Sender: TObject);
715+var NoxP : TNoxEventPrinter;
716+begin
717+ if ESDiag.Execute then begin
718+ NoxP := TNoxEventPrinter.Create;
719+ NoxP.MapFile := FOpenFile;
720+ NoxP.MapData := FMapUndo.Map;
721+ NoxP.Commands := FCommands;
722+ NoxP.SaveToFile(ESDiag.FileName);
723+
724+ if E2.Checked and NoxP.MapLayerSaved then
725+ ShowMessage('レイヤーデータとユニットデータを記録しました。' + #13#10 +
726+ 'レイヤーデータを描画する場合、シナリオファイル内で' +
727+ '以下の処理をCallしてください。' + #13#10#9 +
728+ ' ・マップ表示後に『' + NoxP.MapFile + '_上部レイヤ描画実行』' + #13#10#9 +
729+ ' ・再開時に『' + NoxP.MapFile + '_上部レイヤ描画実行 再開』');
730+ NoxP.Free;
731+ end;
732+end;
733+
734+procedure TNoxMapEditForm.ScrollBox1Resize(Sender: TObject);
735+begin
736+ if Assigned(FMapUndo) and S2.Checked then begin
737+ MapEditModule.RightZoom1.Execute;
738+ end;
739+end;
740+
741+procedure TNoxMapEditForm.SetGameDir(const Dir: String);
742+begin
743+ MapModule.GameDir := Dir;
744+ if MapModule.SRCDir <> '' then
745+ MapModule.GetMapList(ListBox1.Items);
746+end;
747+
748+procedure TNoxMapEditForm.G1Click(Sender: TObject);
749+begin
750+ MapEditModule.ShowGrid := G1.Checked;
751+end;
752+
753+function TNoxMapEditForm.GetOptimumMapSize(const MapWidth: Integer; const MapHeight: Integer):Integer;
754+ function Min(const n1,n2:Integer) : Integer;
755+ begin
756+ if n1 < n2 then Result := n1 else Result := n2;
757+ end;
758+begin
759+ Result := Min(ScrollBox1.ClientWidth div MapWidth,
760+ ScrollBox1.ClientHeight div MapHeight);
761+end;
762+
763+{Module Event}
764+procedure TNoxMapEditForm.BeforeSizeChange(Sender: TObject);
765+begin
766+ ScrollBox1.ControlStyle := ScrollBox1.ControlStyle - [csOpaque];
767+end;
768+
769+procedure TNoxMapEditForm.AfterSizeChange(Sender: TObject);
770+begin
771+ ScrollBox1.ControlStyle := ScrollBox1.ControlStyle + [csOpaque];
772+end;
773+
774+procedure TNoxMapEditForm.HideClipBoard(Sender:TObject);
775+begin
776+ if Pen1.Checked then MapEditModule.DrawMode := mdPen;
777+ if Rect1.Checked then MapEditModule.DrawMode := mdRect;
778+ if Fill1.Checked then MapEditModule.DrawMode := mdFill;
779+ if Select1.Checked then MapEditModule.DrawMode := mdSelect;
780+end;
781+
782+procedure TNoxMapEditForm.ClipEffect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
783+begin
784+ if Event1.Checked then begin
785+ if not Rect1.Checked then
786+ FLockPlace := Point(x div MapEditModule.ZoomPixel,y div MapEditModule.ZoomPixel);
787+ end else begin
788+ Case Button of
789+ mbLeft : MapClipModule.ClipEnter;
790+ mbRight : MapClipModule.HideClipBoard;
791+ End;
792+ end;
793+end;
794+
795+procedure TNoxMapEditForm.ClipUpEffect(Sender: TObject; Button: TMouseButton;
796+ Shift: TShiftState; X, Y: Integer);
797+var
798+ List_CNT : Integer;
799+ CC : TNoxCreateCommand;
800+ SL : TStringList;
801+ function CanPut(const NewID : String):Boolean;
802+ begin
803+ Result := (ComboBox1.ItemIndex = 0) or (NewID = ComboBox1.Text);
804+ end;
805+ function FindFirstUnit(const X,Y,StartID : Integer): Integer;
806+ var LC : Integer;
807+ begin
808+ for LC := StartID to FCommands.Count - 1 do begin
809+ if (X = FCommands[LC].X) and (Y = FCommands[LC].Y) and
810+ CanPut(FCommands[LC].SceneID) then begin
811+ Result := LC;
812+ Exit;
813+ end;
814+ end;
815+ Result := - 1;
816+ end;
817+begin
818+ SL := TStringList.Create;
819+ if not Event1.Checked then Exit;
820+
821+ X := x div MapEditModule.ZoomPixel;
822+ Y := y div MapEditModule.ZoomPixel;
823+ if (X >= FMapUndo.Map.Width) or (X < 0) then Exit;
824+ if (Y >= FMapUndo.Map.Height) or (Y < 0) then Exit;
825+
826+
827+ if Rect1.Checked then begin
828+ CC := NIL;
829+ for List_CNT := 0 to FCommands.Count - 1 do begin
830+ if PointsEqual(Point(X,Y),FCommands[List_CNT].Point) then begin
831+ FLockPlace := FCommands[List_CNT].Point;
832+ MapPB.Invalidate;
833+ Exit;
834+ end;
835+ end;
836+
837+ for List_CNT := 0 to FCommands.Count - 1 do begin
838+ if PointsEqual(FLockPlace,FCommands[List_CNT].Point) then begin
839+ CC := FCommands[List_CNT];
840+ break;
841+ end;
842+ end;
843+
844+ if CC = NIL then Exit;
845+ FCommands.Add.Assign(CC);
846+ CC := FCommands[FCommands.count - 1];
847+ CC.X := X;
848+ CC.Y := Y;
849+
850+ MapModule.PutUnit(FCommands[FCommands.Count - 1],FMapUndo.Bitmap);
851+ MapEditModule.MapPaintBoxUpdate(Sender);
852+
853+ end else if PointsEqual(Point(X,Y),FLockPlace) then begin
854+ List_CNT := FindFirstUnit(X,Y,0);
855+ if List_CNT > - 1 then begin
856+ FCommands.GetIDList(SL);
857+ NoxUnitForm.UnitIDList := SL;
858+ NoxUnitForm.Result := FCommands[List_CNT];
859+
860+ if NoxUnitForm.Execute then begin
861+ if Assigned(NoxUnitForm.Result) and
862+ CanPut(NoxUnitForm.Result.SceneID) then begin
863+ FCommands[List_CNT].Assign(NoxUnitForm.Result);
864+ MapModule.PutUnit(FCommands[List_CNT],FMapUndo.Bitmap);
865+ end else begin
866+ if not Assigned(NoxUnitForm.Result) then
867+ FCommands.Delete(List_CNT)
868+ else FCommands[List_CNT].Assign(NoxUnitForm.Result);
869+
870+ List_CNT := FindFirstUnit(X,Y,List_CNT);
871+ if List_CNT >= 0 then
872+ MapModule.PutUnit(FCommands[List_CNT],FMapUndo.Bitmap)
873+ else MapModule.PutTile(FMapUndo.Map,FMapUndo.Bitmap,X,Y);
874+ end;
875+ FCommands.GetIDList(SL);
876+ UpdateComboBox(SL);
877+ MapEditModule.MapPaintBoxUpdate(Sender);
878+ end;
879+ end else begin
880+ FCommands.GetIDList(SL);
881+ NoxUnitForm.UnitIDList := SL;
882+ if ComboBox1.ItemIndex = 0 then NoxUnitForm.SceneID := ''
883+ else NoxUnitForm.SceneID := ComboBox1.Text;
884+ if NoxUnitForm.Execute then begin
885+ if NoxUnitForm.Result = NIL then Exit;
886+ CC := FCommands.Add;
887+ CC.Assign(NoxUnitForm.Result);
888+ CC.X := X;
889+ CC.Y := Y;
890+ FCommands.GetIDList(SL);
891+ UpdateComboBox(SL);
892+ if CanPut(CC.SceneID) then
893+ MapModule.PutUnit(FCommands[FCommands.Count - 1],FMapUndo.Bitmap);
894+ MapEditModule.MapPaintBoxUpdate(Sender);
895+ end;
896+ end;
897+ end else begin
898+ CC := NIL;
899+ for List_CNT := 0 to FCommands.Count - 1 do begin
900+ if PointsEqual(Point(X,Y),FCommands[List_CNT].Point) then Exit;
901+ if PointsEqual(FLockPlace,FCommands[List_CNT].Point) then
902+ CC := FCommands[List_CNT];
903+ end;
904+ if CC <> NIL then begin
905+ MapModule.PutTile(FMapUndo.Map,FMapUndo.Bitmap,CC.X,CC.Y);
906+ CC.X := X;
907+ CC.Y := Y;
908+ MapModule.PutUnit(CC,FMapUndo.Bitmap);
909+ MapEditModule.MapPaintBoxUpdate(Sender);
910+ end;
911+ end;
912+ SL.Free;
913+end;
914+
915+procedure TNoxMapEditForm.ZoomChange(Sender: TObject);
916+begin
917+ MapClipModule.ZoomPixel := MapEditModule.ZoomPixel;
918+end;
919+
920+procedure TNoxMapEditForm.ComboBox1Change(Sender: TObject);
921+begin
922+ FMapUndo.MapShower := dlmShow; {Reset}
923+ if ComboBox1.ItemIndex = 0 then
924+ MapModule.PutAllUnit(FCommands,FMapUndo.Bitmap,'')
925+ else MapModule.PutAllUnit(FCommands,FMapUndo.Bitmap,ComboBox1.Text);
926+ MapEditModule.MapPaintBoxUpdate(Sender);
927+end;
928+
929+procedure TNoxMapEditForm.ChipPBMouseMove(Sender: TObject; Shift: TShiftState;
930+ X, Y: Integer);
931+begin
932+ Self.ActiveControl := ScrollBox2;
933+end;
934+
935+procedure TNoxMapEditForm.ScrollBox2MouseWheelDown(Sender: TObject;
936+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
937+begin
938+ Handled := True;
939+ ScrollBox2.VertScrollBar.Position := ScrollBox2.VertScrollBar.Position + 32;
940+end;
941+
942+procedure TNoxMapEditForm.ScrollBox2MouseWheelUp(Sender: TObject;
943+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
944+begin
945+ Handled := True;
946+ ScrollBox2.VertScrollBar.Position := ScrollBox2.VertScrollBar.Position - 32;
947+end;
948+
949+procedure TNoxMapEditForm.ListBox1MouseMove(Sender: TObject; Shift: TShiftState;
950+ X, Y: Integer);
951+begin
952+ Self.ActiveControl := ListBox1;
953+end;
954+
955+end.
--- MLNox/MLNox.dpr (nonexistent)
+++ MLNox/MLNox.dpr (revision 4)
@@ -0,0 +1,47 @@
1+program MLNox;
2+
3+
4+
5+
6+
7+uses
8+ Forms,
9+ CEquips in 'CEquips.pas',
10+ FMain in 'FMain.pas' {NoxMapEditForm},
11+ MMap in 'MMap.pas' {MapModule},
12+ MMapEdit in 'MMapEdit.pas' {MapEditModule},
13+ CItem in 'CItem.pas',
14+ CMap in 'CMap.pas',
15+ CMapChip in 'CMapChip.pas',
16+ CMapChipBMP in 'CMapChipBMP.pas',
17+ CMapChipList in 'CMapChipList.pas',
18+ CMapUndo in 'CMapUndo.pas',
19+ CPilot in 'CPilot.pas',
20+ CPilotAbility in 'CPilotAbility.pas',
21+ CSpecialPower in 'CSpecialPower.pas',
22+ CTerrain in 'CTerrain.pas',
23+ CUnit in 'CUnit.pas',
24+ CUnitAbility in 'CUnitAbility.pas',
25+ CNox in 'CNox.pas',
26+ FMapSize in 'FMapSize.pas' {MapSizeForm},
27+ MClip in 'MClip.pas' {MapClipModule},
28+ FSRCDir in 'FSRCDir.pas',
29+ FNoxUnit in 'FNoxUnit.pas' {NoxUnitForm},
30+ FPrint in 'FPrint.pas' {PrintForm},
31+ CNoxPrintEvent in 'CNoxPrintEvent.pas';
32+
33+{$R *.res}
34+
35+begin
36+ Application.Initialize;
37+ Application.Title := 'MultiLayered Nox';
38+ Application.CreateForm(TNoxMapEditForm, NoxMapEditForm);
39+ Application.CreateForm(TMapModule, MapModule);
40+ Application.CreateForm(TMapSizeForm, MapSizeForm);
41+ Application.CreateForm(TNoxUnitForm, NoxUnitForm);
42+ Application.CreateForm(TMapClipModule, MapClipModule);
43+ Application.CreateForm(TMapEditModule, MapEditModule);
44+ Application.CreateForm(TPrintForm, PrintForm);
45+ NoxMapEditForm.Start;
46+ Application.Run;
47+end.
--- MLNox/CUnitAbility.pas (nonexistent)
+++ MLNox/CUnitAbility.pas (revision 4)
@@ -0,0 +1,300 @@
1+unit CUnitAbility;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon;
6+type
7+ TSRCUnitAbility = Class(TPersistent)
8+ private
9+ FName : String;
10+ FOmissionName :String;
11+ FLevel : Double;
12+ FLevelAliable : Boolean;
13+ FExplanation : String;
14+ FRuleofShow,FRuleOfUse:String;
15+ public
16+ procedure Assign(Source:TPersistent);override;
17+ function GetString:String;
18+ published
19+ property Name:String read FName write FName;
20+ property OmissionName : String read FOmissionName write FOmissionName;
21+ property Level : Double read FLevel write FLevel;
22+ property LevelAliable : Boolean read FLevelAliable write FLevelAliable;
23+ property Explanation : String read FExplanation write FExplanation;
24+ property RuleofShow : String read FRuleofShow write FRuleofShow;
25+ property RuleOfUse : String read FRuleOfUse write FRuleOfUse;
26+ End;
27+
28+ TSRCUnitAbilityList = Class(TPersistent)
29+ private
30+ FItems: Array of TSRCUnitAbility;
31+
32+ procedure SetItems(ID:Integer;val:TSRCUnitAbility);
33+ function GetItems(ID:INteger):TSRCUnitAbility;
34+
35+ function GetCount:Integer;
36+ public
37+ Destructor Destroy;override;
38+ property Items[ID:Integer]:TSRCUnitAbility read GetItems write SetItems;default;
39+ function Add:TSRCUnitAbility;
40+ procedure Delete(ID:Integer);
41+ procedure Insert(ID:Integer;val:TSRCUnitAbility);
42+ procedure Clear;
43+ function AddItem(const val: string;var Errors : String):Boolean;
44+ procedure Assign(Source:TPersistent);override;
45+ published
46+ property Count:Integer read GetCount;
47+ End;
48+implementation
49+
50+{TUnitAbility Func.}
51+
52+procedure TSRCUnitAbility.Assign(Source: TPersistent);
53+begin
54+ if Source is TSRCUnitAbility then begin
55+ FName := TSRCUnitAbility(Source).Name;
56+ FOmissionName := TSRCUnitAbility(Source).OmissionName;
57+ FLevel := TSRCUnitAbility(Source).Level;
58+ FLevelAliable := TSRCUnitAbility(Source).LevelAliable;
59+ FExplanation := TSRCUnitAbility(Source).Explanation;
60+
61+ FRuleofShow := TSRCUnitAbility(Source).RuleofShow;
62+ FRuleOfUse := TSRCUnitAbility(Source).RuleOfUse;
63+ end;
64+end;
65+
66+function TSRCUnitAbility.GetString;
67+var
68+ ROmissionName : String;
69+begin
70+ Result := FName;
71+ if FLevelAliable then begin
72+ Result := Result + 'Lv' + Floattostr(FLevel);
73+ end;
74+ if FOmissionName<>'' then
75+ Result := Result + '=' + FOmissionName;
76+
77+ if FRuleOfUse <> '' then
78+ Result := Result + ' <' + FRuleOfUse + '>';
79+
80+ if FRuleOfShow <> '' then
81+ Result := Result + ' (' + FRuleOfShow + ')';
82+
83+ if FExplanation <> '' then begin
84+ ROmissionName := Trim(FOmissionName);
85+ ROmissionName := Copy(ROmissionName,0,AnsiPos(' ',ROmissionName) - 1);
86+ if ROmissionName = '' then ROmissionName := Trim(FOmissionName);
87+
88+ if ROmissionName <> '非表示' then
89+ if InStr(',',FExplanation) then
90+ Result := Result + #13#10 + ROmissionName + '=解説 "'+ FExplanation + '"'
91+ else
92+ Result := Result + #13#10 + ROmissionName + '=解説 '+ FExplanation;
93+ end;
94+
95+end;
96+
97+{TUnitAbilityList Func.}
98+
99+Destructor TSRCUnitAbilityList.Destroy;
100+begin
101+ Clear;
102+ inherited;
103+end;
104+
105+procedure TSRCUnitAbilityList.Assign(Source: TPersistent);
106+var
107+ Item_CNT: Integer;
108+begin
109+ if Source is TSRCUnitAbilityList then begin
110+ for Item_CNT := 0 to GetCount - 1 do
111+ FItems[Item_CNT].Free;
112+
113+ SetLength(FItems,TSRCUnitAbilityList(Source).Count);
114+
115+ for Item_CNT := 0 to GetCount - 1 do begin
116+ FItems[Item_CNT] := TSRCUnitAbility.Create;
117+ FItems[Item_CNT].Assign(TSRCUnitAbilityList(Source)[Item_CNT]);
118+ end;
119+ end;
120+end;
121+
122+function TSRCUnitAbilityList.GetCount;
123+begin
124+ if Assigned(FItems) then
125+ Result := Length(FItems)
126+ else
127+ Result := 0;
128+end;
129+
130+procedure TSRCUnitAbilityList.SetItems(ID: Integer; val: TSRCUnitAbility);
131+begin
132+ FItems[ID].Assign(val);
133+end;
134+
135+function TSRCUnitAbilityList.GetItems(ID: Integer):TSRCUnitAbility;
136+begin
137+ Result := FItems[ID];
138+end;
139+
140+function TSRCUnitAbilityList.Add;
141+begin
142+ SetLength(FItems,GetCount + 1);
143+ FItems[GetCount - 1]:= TSRCUnitAbility.Create;
144+ Result := FItems[GetCount - 1];
145+end;
146+
147+procedure TSRCUnitAbilityList.Delete(ID: Integer);
148+var
149+ Item_CNT: Integer;
150+begin
151+ FItems[ID].Free;
152+
153+ for Item_CNT := ID to GetCount - 2 do
154+ FItems[Item_CNT] := FItems[Item_CNT + 1];
155+
156+ SetLength(FItems,GetCount - 1);
157+end;
158+
159+procedure TSRCUnitAbilityList.Insert(ID: Integer; val: TSRCUnitAbility);
160+var
161+ Item_CNT: Integer;
162+begin
163+ SetLength(FItems,GetCount + 1);
164+
165+ for Item_CNT := GetCount - 1 downto ID + 1 do
166+ FItems[Item_CNT] := FItems[Item_CNT - 1];
167+
168+ FItems[ID] := TSRCUnitAbility.Create;
169+ FItems[ID].Assign(val);
170+end;
171+
172+procedure TSRCUnitAbilityList.Clear;
173+var
174+ Item_CNT: Integer;
175+begin
176+ for Item_CNT := 0 to GetCount - 1 do FItems[Item_CNT].Free;
177+ SetLength(FItems,0);
178+end;
179+
180+function TSRCUnitAbilityList.AddItem(const val: string;var Errors : String):Boolean;
181+var
182+ UA:TSRCUnitAbility;
183+ Parameter,S:String;
184+ ReadList_CNT,PropPos :Integer;
185+ TestPMT : TStringList;
186+ Float : Double;
187+ ValueLeft,DestItemName : String;
188+ SubS : String;
189+ procedure StrChange(var S1,S2:String);
190+ var S : String;
191+ begin
192+ S := S1;
193+ S1 := S2;
194+ S2 := S;
195+ end;
196+ procedure SendError(const Err : String);
197+ begin
198+ Result := False;
199+ if Errors <> '' then Errors := Errors + #13#10;
200+ Errors := Errors + Err;
201+ end;
202+
203+ function StrToFloat(const S,ValueType : String) : Extended;
204+ begin
205+ if not TryStrToFloat(S,Result) then begin
206+ Result := 0;
207+ SendError(ValueType + '(' + S + ')は数ではありません');
208+ end;
209+ end;
210+ function IsSpace: Boolean;
211+ begin
212+ if Parameter[PropPos] <= ' ' then Result := True
213+ else if Copy(Parameter,PropPos,2) = '　' then Result := True
214+ else Result := False;
215+ end;
216+ function ExcludeKakko(const S,Starter,Ender : String):String;
217+ begin
218+ Result := ExcludeFirstStr(S,Starter);
219+ Result := ExcludeLastStr(Result,Ender);
220+ end;
221+
222+ function IsEnderCopy(const Starter,Ender : String) : String;
223+ begin
224+ Result := '';
225+ if EndsStr(Ender,Parameter) then begin
226+ PropPos := AnsiPosBackward(Starter,Parameter);
227+ Dec(PropPos);
228+ if ByteType(Parameter,PropPos) = mbTrailByte then
229+ Dec(PropPos);
230+ if IsSpace then begin
231+ SubS := Copy(Parameter,PropPos,MaxInt);
232+ System.Delete(Parameter,PropPos,Length(SubS));
233+ SubS := TrimJP(SubS);
234+ Result := ExcludeKakko(SubS,Starter,Ender);
235+ end;
236+ end;
237+ end;
238+begin
239+ ValueLeft := Val;
240+ Result := True;
241+
242+ while ValueLeft <> '' do begin
243+ Parameter := TrimJP(ExtractWordDem(Valueleft));
244+ if Parameter = '' then Continue;
245+
246+ if InStr('=解説',Parameter) then begin {解説}
247+ DestItemName := ExtractWordDem(Parameter,'=解説');
248+ Parameter := TrimLeftJP(Parameter);
249+ if StartsStr('"',Parameter) then begin
250+ System.Delete(Parameter,1,1);
251+ Parameter := ExtractWordDem(Parameter,'"');
252+ end;
253+
254+ for ReadList_CNT := GetCount - 1 downto 0 do begin
255+ S := TrimJP(FItems[ReadList_CNT].OmissionName);
256+ S := ExtractSpacesDem(S);
257+ if S = '' then S := FItems[ReadList_CNT].OmissionName;
258+
259+ if (S = DestItemName) OR (FItems[ReadList_CNT].OmissionName = DestItemName) then begin
260+ FItems[ReadList_CNT].Explanation := Parameter;
261+ Parameter := '';
262+ break;
263+ end;
264+ end;
265+ if Parameter <> '' then begin
266+ UA := Self.Add;
267+ UA.Name := DestItemName;
268+ UA.OmissionName := '解説 ' + Parameter;
269+ end;
270+ Continue;
271+ end else begin
272+ UA := Self.Add;
273+
274+ UA.RuleofShow := IsEnderCopy('(',')');
275+ UA.RuleofUse := IsEnderCopy('<','>');
276+
277+ if InStr('=',Parameter) then begin
278+ DestItemName := ExtractWordDem(Parameter,'=');
279+ UA.OmissionName := Parameter;
280+ Parameter := DestItemName;
281+ end else UA.OmissionName := '';
282+
283+ if InText('Lv',Parameter) then begin
284+ SubS := Copy(Parameter,1,AnsiPosBackward('Lv',Parameter,True) - 1);
285+ System.Delete(Parameter,1,Length(SubS) + 2);
286+ StrChange(SubS,Parameter);
287+
288+ UA.LevelAliable := True;
289+ UA.Level := StrtoFloat(SubS,'ユニット能力のレベル');
290+ end else UA.LevelAliable := False;
291+
292+ if UA.OmissionName = '' then begin
293+ UA.Name := ExtractSpacesDem(Parameter);
294+ UA.OmissionName := Parameter;
295+ end else UA.Name := Parameter;
296+ end;
297+ end;
298+end;
299+
300+end.
--- MLNox/CItem.pas (nonexistent)
+++ MLNox/CItem.pas (revision 4)
@@ -0,0 +1,389 @@
1+unit CItem;
2+
3+interface
4+
5+uses
6+ Classes,SysUtils,StringUnitLight,NCommon,CEquips,
7+ CUnitAbility,NCommonSRC,CSeek3List;
8+
9+type
10+ TSRCItem = Class(TSRCData)
11+ private
12+ FName , FOmissionName , FSyllabary : String;
13+ FItemClass,FEquipPlace : String;
14+
15+ FComment : TStringList;
16+
17+ FMoveBonus : ShortInt;
18+
19+ FUnitAbility : TSRCUnitAbilityList;
20+
21+ FMaxHPBonus,FMaxMPBonus : Integer;
22+ FDefenceBonus,FSpeedBonus : Integer;
23+
24+ FWeapon : TSRCEquipList;
25+ FAbility : TSRCAbilityList;
26+
27+ procedure SetWeapon(val:TSRCEquipList);
28+ procedure SetAbility(val:TSRCAbilityList);
29+ procedure SetUnitAbility(val:TSRCUnitAbilityList);
30+ procedure SetComment(val:TStringList);
31+ protected
32+ procedure AssignTo(Dest:TPersistent);override;
33+ public
34+ procedure WriteData(Dest:TStrings);override;
35+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
36+
37+ Constructor Create;override;
38+ Destructor Destroy;override;
39+ published
40+ property Name : String read FName write FName;
41+ property OmissionName : String read FOmissionName write FOmissionName;
42+ property Syllabary : String read FSyllabary write FSyllabary;
43+ property ItemClass : String read FItemClass write FItemClass;
44+ property EquipPlace : String read FEquipPlace write FEquipPlace;
45+
46+ property MoveBonus : ShortInt read FMoveBonus write FMoveBonus;
47+
48+ property MaxHPBonus : Integer read FMaxHPBonus write FMaxHPBonus;
49+ property MaxMPBonus : Integer read FMaxMPBonus write FMaxMPBonus;
50+ property DefenceBonus : Integer read FDefenceBonus write FDefenceBonus;
51+ property SpeedBonus : Integer read FSpeedBonus write FSpeedBonus;
52+
53+ property Weapon : TSRCEquipList read FWeapon write SetWeapon;
54+ property Ability : TSRCAbilityList read FAbility write SetAbility;
55+ property UnitAbility : TSRCUnitAbilityList read FUnitAbility write SetUnitAbility;
56+ property Comment : TStringList read FComment write SetComment;
57+ End;
58+
59+ TSRCItemList = Class(TSRCDataList)
60+ private
61+ function GetItems(ID:Integer):TSRCItem;
62+ procedure SetItems(ID:Integer;val:TSRCItem);
63+ protected
64+ function AddID(const ID:Integer):TSRCData;override;
65+ public
66+ function Add(out ID : integer):TSRCItem;overload;
67+ function Add:TSRCItem;overload;
68+ property Items[ID:Integer]:TSRCItem read GetItems write SetItems;default;
69+ published
70+
71+ End;
72+
73+implementation
74+
75+{TSRCUnit Func.}
76+
77+Constructor TSRCItem.Create;
78+begin
79+ inherited;
80+ FUnitAbility := TSRCUnitAbilityList.Create;
81+ FWeapon := TSRCEquipList.Create;
82+ FAbility := TSRCAbilityList.Create;
83+ FComment := TStringList.Create;
84+ { 初期値宣言 }
85+
86+ FName := '新規アイテム';
87+
88+ FItemClass := '汎用';
89+ FEquipPlace := 'アイテム';
90+end;
91+
92+Destructor TSRCItem.Destroy;
93+begin
94+ FUnitAbility.Free;
95+ FWeapon.Free;
96+ FAbility.Free;
97+ FComment.Free;
98+ inherited;
99+end;
100+
101+procedure TSRCItem.SetWeapon(val: TSRCEquipList);
102+begin
103+ FWeapon.Assign(val);
104+end;
105+
106+procedure TSRCItem.SetAbility(val: TSRCAbilityList);
107+begin
108+ FAbility.Assign(val);
109+end;
110+
111+procedure TSRCItem.SetUnitAbility(val: TSRCUnitAbilityList);
112+begin
113+ FUnitAbility.Assign(val);
114+end;
115+
116+procedure TSRCItem.SetComment(val: TStringList);
117+begin
118+ FComment.Assign(val);
119+end;
120+
121+procedure TSRCItem.AssignTo(Dest: TPersistent);
122+begin
123+ if Dest is TSRCItem then begin
124+ TSRCItem(Dest).Name := FName;
125+ TSRCItem(Dest).OmissionName := FOmissionName;
126+ TSRCItem(Dest).Syllabary := FSyllabary;
127+ TSRCItem(Dest).ItemClass := FItemClass;
128+ TSRCItem(Dest).EquipPlace := FEquipPlace;
129+
130+ TSRCItem(Dest).MoveBonus := FMoveBonus;
131+
132+ TSRCItem(Dest).UnitAbility := FUnitAbility;
133+
134+ TSRCItem(Dest).MaxHPBonus := FMaxHPBonus;
135+ TSRCItem(Dest).MaxMPBonus := FMaxMPBonus;
136+ TSRCItem(Dest).DefenceBonus := FDefenceBonus;
137+ TSRCItem(Dest).SpeedBonus := FSpeedBonus;
138+
139+ TSRCItem(Dest).Weapon := FWeapon;
140+ TSRCItem(Dest).Ability := FAbility;
141+
142+ TSRCItem(Dest).Comment := FComment;
143+ end else inherited;
144+end;
145+
146+procedure TSRCItem.WriteData(Dest:TStrings);
147+var
148+ S : String;
149+ List_CNT : Integer;
150+begin
151+ if FName = '' then Dest.Add('名無しのアイテム')
152+ else Dest.Add(FName);
153+
154+ S := FOmissionName + ',';
155+ if FSyllabary <> '' then
156+ S := S + FSyllabary + ',';
157+
158+ S := S + FItemClass + ',' + FEquipPlace;
159+
160+ Dest.Add(S);
161+
162+ if FUnitAbility.Count = 0 then
163+ Dest.Add('特殊能力なし')
164+ else begin
165+ Dest.Add('特殊能力');
166+ for List_CNT := 0 to FUnitAbility.Count - 1 do begin
167+ Dest.Add(FUnitAbility[List_CNT].GetString);
168+ end;
169+ end;
170+
171+ S := inttostr(FMaxHPBonus) + ',' +
172+ inttoStr(FMaxMPBonus) + ',' +
173+ InttoStr(FDefenceBonus) + ',' +
174+ InttoStr(FSpeedBonus) + ',' + InttoStr(FMoveBonus);
175+
176+ Dest.Add(S);
177+
178+ for List_CNT := 0 to FWeapon.Count - 1 do
179+ Dest.Add(FWeapon[List_CNT].GetString);
180+
181+ if FAbility.Count > 0 then begin
182+ Dest.Add('===');
183+
184+ for List_CNT := 0 to FAbility.Count - 1 do
185+ Dest.Add(FAbility[List_CNT].GetString);
186+ end;
187+ {Comment}
188+ for List_CNT := 0 to FComment.Count - 1 do begin
189+ if List_CNT < 2 then begin
190+ if FComment[List_CNT] <> '' then
191+ Dest.Add('*' + FComment[List_CNT]);
192+ end else begin
193+ if FComment[List_CNT] <> '' then
194+ Dest.Add('#' + FComment[List_CNT])
195+ else Dest.Add('');
196+ end;
197+ end;
198+
199+ Dest.Add('');
200+end;
201+
202+function TSRCItem.ReadData(Source:TStrings;Index:Integer;var Errors:String):Boolean;
203+var
204+ Str,SubStr : String;
205+ AItem :TSRCItem;
206+ List_CNT:Integer;
207+ procedure IncNum;
208+ var
209+ SS:String;
210+ begin
211+ inc(Index);
212+ while (Source.Count > Index) do begin
213+ SS := TrimJP(Source[Index]);
214+ if StartsStr('#',SS) then
215+ inc(Index) else break;
216+ end;
217+ end;
218+ procedure SendError(const Error:String);
219+ begin
220+ Result := False;
221+ if Errors <> '' then Errors := Errors + #13#10;
222+
223+ Errors := Errors + Error +'(' +
224+ inttostr(Index) + '行目)';
225+ end;
226+
227+ function StrToInt(const Val,SRCType:String):Integer;
228+ begin
229+ if not TryStrToInt(Val,Result) then begin
230+ Result := 0;
231+ SendError(SRCType + 'が数値ではありません。');
232+ end;
233+ end;
234+ function ReadLine:String;
235+ begin
236+ if Index >= Source.Count then begin
237+ SendError('項目が途切れています');
238+ Result := '';
239+ end else Result := Source[Index];
240+ end;
241+begin
242+ if Source.Count <= Index then Exit;
243+
244+ Str := TrimJP(ReadLine);
245+ while (Str = '') OR (StartsStr('#',Str)) do begin
246+ IncNum;
247+ if Source.Count <= Index then break;
248+ Str := TrimJP(ReadLine);
249+ end;
250+
251+ if Source.Count <= Index then Exit;
252+
253+ AItem := TSRCItem.Create;
254+ Result := True;
255+ try
256+ AItem.Name := TrimJP(ReadLine);
257+ incNum;
258+
259+ Str := ReadLine;
260+ incNum;
261+
262+ List_CNT := StrCount(',',Str,ifByte);
263+ AItem.OmissionName := TrimJP(ExtractWordDem(Str));
264+
265+ if List_CNT = 3 then begin
266+ AItem.Syllabary := TrimJP(ExtractWordDem(Str));
267+ end;
268+
269+ AItem.ItemClass := TrimJP(ExtractWordDem(Str));
270+ AItem.EquipPlace := TrimJP(ExtractWordDem(Str));
271+
272+ Str := TrimJP(ReadLine);
273+ incNum;
274+ if Str <> '特殊能力なし' then begin
275+ if Str = '特殊能力' then begin
276+ SubStr := TrimJP(ReadLine);
277+ while not TryStrToInt(ExtractWordDem(SubStr),List_CNT) do begin
278+ Str := Str + ',' + ReadLine;
279+ incNum;
280+ SubStr := TrimJP(ReadLine);
281+ end;
282+ end;
283+ ExtractWordDem(Str);
284+ if not AItem.UnitAbility.AddItem(Str,Errors) then
285+ SendError('上記のエラーが特殊能力で発生しました');
286+ end;
287+
288+ Str := ReadLine;
289+ incNum;
290+
291+ AItem.MaxHPBonus := strtoint(TrimJP(ExtractWordDem(Str)),'最大HP修正値');
292+ AItem.MaxMPBonus := strtoint(TrimJP(ExtractWordDem(Str)),'最大EN修正値');
293+ AItem.DefenceBonus := strtoint(TrimJP(ExtractWordDem(Str)),'装甲修正値');
294+ AItem.SpeedBonus := strtoint(TrimJP(ExtractWordDem(Str)),'運動性修正値');
295+ AItem.MoveBonus := strtoint(TrimJP(ExtractWordDem(Str)),'移動力修正値');
296+
297+ if Source.Count <= Index then Exit;
298+
299+ Str := TrimJP(ReadLine);
300+ if Str <> '' then begin
301+ While (Str <> '') and (Str <> '===')
302+ and (not StartsStr('*',Str))do begin
303+ if not AItem.Weapon.AddItem(Str,Errors) then
304+ SendError('以上のエラーが武器で発生しました');
305+ incNum;
306+
307+ if Source.Count <= Index then Break;
308+ Str := TrimJP(ReadLine);
309+ end;
310+
311+ if Source.Count <= Index then Exit;
312+
313+ if TrimJP(ReadLine) = '===' then begin
314+ incNum;
315+ Str := TrimJP(ReadLine);
316+ While (Str <> '') and (not StartsStr('*',Str))do begin
317+ if not AItem.Ability.AddItem(Str,Errors) then
318+ SendError('以上のエラーがアビリティで発生しました');
319+ incNum;
320+
321+ if Source.Count <= Index then Break;
322+ Str := TrimJP(ReadLine);
323+ end;
324+ end;
325+ end;
326+ {Comment}
327+ if Source.Count <= Index then Exit;
328+
329+ Str := TrimJP(ReadLine);
330+ while (Str = '') OR (StartsText('#',Str)) do begin
331+ incNum;
332+ if Source.Count <= Index then break;
333+ Str := TrimJP(ReadLine);
334+ end;
335+
336+ if Source.Count <= Index then Exit;
337+
338+ Str := TrimJP(ReadLine);
339+ while StartsText('*',Str) OR (Str = '') OR StartsText('#',Str) do begin
340+ if Str = '' then begin
341+ AItem.Comment.Add('');
342+ end else begin
343+ AItem.Comment.Add(Copy(Str,2,MaxInt));
344+ end;
345+ inc(Index);
346+ if Source.Count <= Index then break;
347+ Str := TrimJP(ReadLine);
348+ end;
349+
350+ while AItem.Comment.Count > 0 do
351+ if AItem.Comment[AItem.Comment.Count - 1] = '' then
352+ AItem.Comment.Delete(AItem.Comment.Count - 1) else break;
353+
354+ finally
355+ if Result then
356+ Assign(AItem);
357+ AItem.Free;
358+ end;
359+end;
360+
361+{TSRCItemList Func.}
362+
363+procedure TSRCItemList.SetItems(ID: Integer; val: TSRCItem);
364+begin
365+ inherited SetItems(ID,val);
366+end;
367+
368+function TSRCItemList.GetItems(ID: Integer):TSRCItem;
369+begin
370+ Result := TSRCItem(inherited GetItems(ID));
371+end;
372+
373+function TSRCItemList.AddID(const ID: Integer):TSRCData;
374+begin
375+ FItems[ID] := TSRCItem.Create;
376+ Result := FItems[ID];
377+end;
378+
379+function TSRCItemList.Add(out ID: Integer):TSRCItem;
380+begin
381+ Result := TSRCItem(Inherited Add(ID));
382+end;
383+
384+function TSRCItemList.Add:TSRCItem;
385+begin
386+ Result := TSRCItem(Inherited Add);
387+end;
388+
389+end.
--- MLNox/FPrint.pas (nonexistent)
+++ MLNox/FPrint.pas (revision 4)
@@ -0,0 +1,136 @@
1+unit FPrint;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, StdCtrls, ClipBrd, CNox, CNoxPrintEvent;
8+
9+type
10+ TPrintForm = class(TForm)
11+ Label1: TLabel;
12+ ComboBox1: TComboBox;
13+ Memo1: TMemo;
14+ Button1: TButton;
15+ Button2: TButton;
16+ Button3: TButton;
17+ procedure ComboBox1Change(Sender: TObject);
18+ procedure Button2Click(Sender: TObject);
19+ procedure Memo1Change(Sender: TObject);
20+ procedure Button1Click(Sender: TObject);
21+ procedure Button3Click(Sender: TObject);
22+ private
23+ { Private 宣言 }
24+ FData : TNoxCreateCommandList;
25+ FEditFlag,FEditedFlag : Boolean;
26+ FChangeSceneID : String;
27+ FList : TStrObjectList;
28+
29+ procedure SetData(const Value: TNoxCreateCommandList);
30+ public
31+ { Public 宣言 }
32+ property Data : TNoxCreateCommandList read FData write SetData;
33+ function Execute : Boolean;
34+ end;
35+
36+var
37+ PrintForm: TPrintForm;
38+
39+implementation
40+
41+{$R *.dfm}
42+
43+procedure TPrintForm.SetData(const Value: TNoxCreateCommandList);
44+var SL : TStringList;
45+begin
46+ if not Assigned(FList) then FList := TStrObjectList.Create;
47+ FData := Value;
48+ SL := TStringList.Create;
49+ FData.GetIDList(SL);
50+ SL.Insert(0,'全て表示');
51+ ComboBox1.Items.Assign(SL);
52+ SL.Free;
53+ ComboBox1.ItemIndex := 0;
54+ ComboBox1Change(Self);
55+end;
56+
57+function TPrintForm.Execute: Boolean;
58+begin
59+ if not Assigned(FList) then FList := TStrObjectList.Create;
60+ FEditedFlag := False;
61+ FEditFlag := False;
62+ Result := ShowModal = MrOk;
63+ FreeAndNIL(FList);
64+end;
65+
66+procedure TPrintForm.Memo1Change(Sender: TObject);
67+begin
68+ if not Memo1.ReadOnly then FEditFlag := True;
69+end;
70+
71+procedure TPrintForm.Button1Click(Sender: TObject);
72+begin
73+ ComboBox1Change(Sender);
74+ if FEditedFlag then Self.ModalResult := MrOk else Self.ModalResult := mrCancel;
75+end;
76+
77+procedure TPrintForm.Button2Click(Sender: TObject);
78+begin
79+ Clipboard.AsText := Memo1.Text;
80+end;
81+
82+procedure TPrintForm.Button3Click(Sender: TObject);
83+begin
84+ FEditFlag := False;
85+ ComboBox1Change(Sender);
86+end;
87+
88+procedure TPrintForm.ComboBox1Change(Sender: TObject);
89+var
90+ LC: Integer;
91+ NU : TNoxCreateCommand;
92+ S : String;
93+begin
94+ Memo1.Lines.BeginUpdate;
95+ if FEditFlag then begin
96+ for LC := FData.Count - 1 downto 0 do
97+ if FChangeSceneID = FData[LC].SceneID then FData.Delete(LC);
98+ NU := TNoxCreateCommand.Create;
99+
100+ for LC := 0 to Memo1.Lines.Count - 1 do begin
101+ S := '';
102+ if NU.SetFromStrings(Memo1.Lines,LC,S) then begin
103+ NU.SceneID := FChangeSceneID;
104+ FData.Add.Assign(NU);
105+ end;
106+ end;
107+ NU.Free;
108+ FEditedFlag := True;
109+ end;
110+
111+ Memo1.Lines.Clear;
112+
113+ if ComboBox1.ItemIndex = 0 then begin
114+ for LC := 0 to FData.Count - 1 do FList.Add(FData[LC]);
115+ FList.Sort;
116+
117+ for LC := 0 to FList.Count - 1 do begin
118+ if (LC = 0) or (TStrObject(FList[LC]).ID <> TStrObject(FList[LC - 1]).ID) then
119+ Memo1.Lines.Add('#' + TStrObject(FList[LC]).ID);
120+
121+ Memo1.Lines.Add(TStrObject(FList[LC]).Value);
122+ end;
123+ FList.Clear;
124+ end else begin
125+ for LC := 0 to FData.Count - 1 do begin
126+ if (ComboBox1.Text = FData[LC].SceneID) then
127+ FData[LC].GetDatatoStrings(Memo1.Lines);
128+ end;
129+ end;
130+ Memo1.Lines.EndUpdate;
131+ Memo1.ReadOnly := ComboBox1.ItemIndex = 0;
132+ FChangeSceneID := ComboBox1.Text;
133+ FEditFlag := False;
134+end;
135+
136+end.
--- MLNox/CDialog.pas (nonexistent)
+++ MLNox/CDialog.pas (revision 4)
@@ -0,0 +1,365 @@
1+unit CDialog;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,CSeek3List;
6+type
7+ TSRCDialogMessage = Class(TPersistent)
8+ private
9+ FCharactor : String;
10+ FMessages : String;
11+ public
12+ procedure Assign(Source:TPersistent);override;
13+ function GetData : String;
14+ procedure SetData(Val: String);
15+ published
16+ property Charactor : String read FCharactor write FCharactor;
17+ property Messages : String read FMessages write FMessages;
18+ End;
19+
20+ TSRCDialog = Class(TSRCDataArray)
21+ private
22+ FSituation : String;
23+
24+ function GetItems(ID:Integer):TSRCDialogMessage;
25+ procedure SetItems(ID:Integer;val:TSRCDialogMessage);
26+ protected
27+ procedure AssignCommonData(Dest:TPersistent);override;
28+ function AddID(const ID:Integer):TPersistent;override;
29+ public
30+ function Add:TSRCDialogMessage;
31+ procedure Insert(ID:Integer;val:TSRCDialogMessage);
32+
33+ procedure WriteData(Dest:TStrings);override;
34+ function ReadData(Source:TStrings;
35+ Index:Integer;var Errors : String):Boolean;override;
36+
37+ property Items[ID:Integer]:TSRCDialogMessage read GetItems write SetItems;default;
38+ published
39+ property Situation : String read FSituation write FSituation;
40+ End;
41+
42+ TSRCDialogs = Class(TSRCDataArray)
43+ private
44+ FPilotList : String;
45+
46+ function GetItems(ID:Integer):TSRCDialog;
47+ procedure SetItems(ID:Integer;val:TSRCDialog);
48+ protected
49+ procedure AssignCommonData(Dest:TPersistent);override;
50+ function AddID(const ID:Integer):TPersistent;override;
51+ public
52+ function Add:TSRCDialog;
53+ procedure Insert(ID:Integer;val:TSRCDialog);
54+ procedure WriteData(Dest:TStrings);override;
55+ function ReadData(Source:TStrings;
56+ Index:Integer;var Errors : String):Boolean;override;
57+
58+ property Items[ID:Integer] : TSRCDialog read GetItems write SetItems;default;
59+ published
60+ property PilotList : String read FPilotList write FPilotList;
61+ End;
62+
63+ TSRCDialogList = Class(TSRCDataList)
64+ private
65+ procedure SetItems(ID:Integer;val:TSRCDialogs);
66+ function GetItems(ID:Integer):TSRCDialogs;
67+ protected
68+ function AddID(const ID:Integer):TSRCData;override;
69+ public
70+ property Items[ID:Integer] : TSRCDialogs read GetItems write SetItems;default;
71+
72+ function Add(out ID : integer):TSRCDialogs;overload;
73+ function Add:TSRCDialogs;overload;
74+ published
75+ End;
76+
77+implementation
78+
79+{TSRCDialogMessage func.}
80+
81+procedure TSRCDialogMessage.Assign(Source: TPersistent);
82+begin
83+ if Source is TSRCDialogMessage then begin
84+ FCharactor := TSRCDialogMessage(Source).Charactor;
85+ FMessages := TSRCDialogMessage(Source).Messages;
86+ end else inherited;
87+end;
88+
89+function TSRCDialogMessage.GetData:String;
90+begin
91+ Result := FCharactor + ',' + FMessages;
92+end;
93+
94+procedure TSRCDialogMessage.SetData(val:String);
95+begin
96+ FCharactor := ExtractWordDem(val);
97+ FMessages := val;
98+end;
99+
100+{TSRCDialog Func.}
101+
102+procedure TSRCDialog.AssignCommonData(Dest: TPersistent);
103+begin
104+ if Dest is TSRCDialog then begin
105+ TSRCDialog(Dest).Situation := FSituation;
106+ end else Inherited;
107+end;
108+
109+function TSRCDialog.GetItems(ID: Integer): TSRCDialogMessage;
110+begin
111+ Result := TSRCDialogMessage(Inherited GetItems(ID));
112+end;
113+
114+procedure TSRCDialog.SetItems(ID: Integer; val: TSRCDialogMessage);
115+begin
116+ Inherited SetItems(ID,val);
117+end;
118+
119+function TSRCDialog.AddID(const ID: Integer):TPersistent;
120+begin
121+ FItems[ID] := TSRCDialogMessage.Create;
122+ Result := FItems[ID];
123+end;
124+
125+function TSRCDialog.Add;
126+begin
127+ Result := TSRCDialogMessage(Inherited Add);
128+end;
129+
130+procedure TSRCDialog.Insert(ID: Integer; val: TSRCDialogMessage);
131+begin
132+ Inherited Insert(ID,Val);
133+end;
134+
135+procedure TSRCDialog.WriteData(Dest:TStrings);
136+var
137+ List_CNT : Integer;
138+begin
139+ Dest.Add(FSituation);
140+ for List_CNT := 0 to Count - 1 do begin
141+ Dest.Add(Items[List_CNT].GetData);
142+ end;
143+end;
144+
145+function TSRCDialog.ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;
146+var
147+ ADialog : TSRCDialog;
148+ Str : String;
149+ procedure IncNum;
150+ var
151+ SS:String;
152+ begin
153+ inc(Index);
154+ while (Source.Count > Index) do begin
155+ SS := TrimJP(Source[Index]);
156+ if StartsStr('#',SS) then
157+ inc(Index) else break;
158+ end;
159+ end;
160+ procedure SendError(const Error:String);
161+ begin
162+ Result := False;
163+ if Errors <> '' then Errors := Errors + #13#10;
164+
165+ Errors := Errors + '○' + Error +'(' +
166+ inttostr(Index) + '行目)';
167+ end;
168+ function ReadLine:String;
169+ begin
170+ if Index >= Source.Count then begin
171+ SendError('項目が途切れています');
172+ Result := '';
173+ end else Result := Source[Index];
174+ end;
175+begin
176+ Result := True;
177+ if Source.Count <= Index then Exit;
178+
179+ Str := TrimJP(ReadLine);
180+ while (Str = '') OR (StartsText('#',Str)) do begin
181+ IncNum;
182+ if Source.Count <= Index then break;
183+ Str := TrimJP(ReadLine);
184+ end;
185+
186+ if Source.Count <= Index then Exit;
187+
188+ ADialog := TSRCDialog.Create;
189+ try
190+ Str := TrimJP(ReadLine);
191+ IncNum;
192+ if inStr(',',Str) then
193+ SendError('指定項目はシチュエーションではありません');
194+
195+ FSituation := Str;
196+ Str := ReadLine;
197+ while StrCount(',',Str) > 0 do begin
198+ ADialog.Add.SetData(Str);
199+ IncNum;
200+ if Source.Count <= Index then Break;
201+ Str := ReadLine;
202+ end;
203+
204+ if Result then
205+ Assign(ADialog);
206+ ADialog.Free;
207+ except
208+ ADialog.Free;
209+ end;
210+end;
211+
212+{TSRCDialogs Func.}
213+
214+function TSRCDialogs.GetItems(ID: Integer):TSRCDialog;
215+begin
216+ Result := TSRCDialog(inherited GetItems(ID));
217+end;
218+
219+procedure TSRCDialogs.SetItems(ID: Integer; val: TSRCDialog);
220+begin
221+ inherited SetItems(ID,val);
222+end;
223+
224+procedure TSRCDialogs.AssignCommonData(Dest: TPersistent);
225+begin
226+ if Dest is TSRCDialogs then begin
227+ TSRCDialogs(Dest).PilotList := FPilotList;
228+ end else inherited;
229+end;
230+
231+function TSRCDialogs.AddID(const ID: Integer):TPersistent;
232+begin
233+ FItems[ID] := TSRCDialog.Create;
234+ Result := FItems[ID];
235+end;
236+
237+function TSRCDialogs.Add;
238+begin
239+ Result := TSRCDialog(inherited Add);
240+end;
241+
242+procedure TSRCDialogs.Insert(ID: Integer; val: TSRCDialog);
243+begin
244+ inherited Insert(ID,Val);
245+end;
246+
247+procedure TSRCDialogs.WriteData(Dest:TStrings);
248+var
249+ List_CNT : Integer;
250+begin
251+ Dest.Add(FPilotList);
252+ for List_CNT := 0 to Count - 1 do begin
253+ GetItems(List_CNT).WriteData(Dest);
254+ end;
255+ Dest.Add('');
256+end;
257+
258+function TSRCDialogs.ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;
259+var
260+ ADialogs : TSRCDialogs;
261+ ADialog : TSRCDialog;
262+ AMessage : TSRCDialogMessage;
263+ Str : String;
264+ procedure IncNum;
265+ var
266+ SS:String;
267+ begin
268+ inc(Index);
269+ while (Source.Count > Index) do begin
270+ SS := TrimJP(Source[Index]);
271+ if StartsStr('#',SS) then
272+ inc(Index) else break;
273+ end;
274+ end;
275+ procedure SendError(const Error:String);
276+ begin
277+ Result := False;
278+ if Errors <> '' then Errors := Errors + #13#10;
279+
280+ Errors := Errors + Error +'(' +
281+ inttostr(Index) + '行目)';
282+ end;
283+ function ReadLine:String;
284+ begin
285+ if Index >= Source.Count then begin
286+ SendError('項目が途切れています');
287+ Result := '';
288+ end else Result := Source[Index];
289+ end;
290+begin
291+ Result := True;
292+ if Source.Count <= Index then Exit;
293+
294+ Str := TrimJP(ReadLine);
295+ while (Str = '') OR (StartsStr('#',Str)) do begin
296+ IncNum;
297+ if Source.Count <= Index then break;
298+
299+ Str := TrimJP(ReadLine);
300+ end;
301+
302+ if Source.Count <= Index then Exit;
303+
304+ ADialogs := TSRCDialogs.Create;
305+ ADialog := NIL;
306+
307+ try
308+ ADialogs.PilotList := TrimJP(ReadLine);
309+ incNum;
310+
311+ while (Source.Count > Index) do begin
312+ Str := TrimJP(ReadLine);
313+ if Str = '' then break;
314+
315+ if inStr(',',Str) then begin
316+ if not Assigned(ADialog) then begin
317+ SendError('シチュエーション無くメッセージを指定しました');
318+ incNum;
319+ Continue;
320+ end;
321+ AMessage := ADialog.Add;
322+ AMessage.SetData(Str);
323+ end else begin
324+ ADialog := ADialogs.Add;
325+ ADialog.Situation := Trim(Str);
326+ end;
327+ incNum;
328+ end;
329+
330+ finally
331+ if Result then Assign(ADialogs);
332+ ADialogs.Free;
333+ end;
334+
335+end;
336+
337+{TSRCDialogList Func.}
338+
339+function TSRCDialogList.GetItems(ID: Integer):TSRCDialogs;
340+begin
341+ Result := TSRCDialogs(Inherited GetItems(ID));
342+end;
343+
344+procedure TSRCDialogList.SetItems(ID: Integer; val: TSRCDialogs);
345+begin
346+ inherited SetItems(ID,Val)
347+end;
348+
349+function TSRCDialogList.AddID(const ID: Integer):TSRCData;
350+begin
351+ FItems[ID] := TSRCDialogs.Create;
352+ Result := FItems[ID];
353+end;
354+
355+function TSRCDialogList.Add(out ID: Integer):TSRCDialogs;
356+begin
357+ Result := TSRCDialogs(Inherited Add(ID));
358+end;
359+
360+function TSRCDialogList.Add : TSRCDialogs;
361+begin
362+ Result := TSRCDialogs(Inherited Add);
363+end;
364+
365+end.
--- MLNox/MClip.pas (nonexistent)
+++ MLNox/MClip.pas (revision 4)
@@ -0,0 +1,243 @@
1+unit MClip;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ ABitmap, CMap, ExtCtrls, ABitmapFilters32, MMapEdit, ClipBrd, Math;
8+
9+type
10+ TMapClipModule = class(TDataModule)
11+ private
12+ { Private 宣言 }
13+ FClip,FMapPB : TPaintBox;
14+ FScrollBox : TScrollBox;
15+
16+ FClipBrd : TSRCMapBuffer;
17+ FClipBMP : TABitmap;
18+ FClipVisible : TABitmap;
19+
20+ FPasteDest,FPasteMouse : TPoint;
21+ FZoomPixel : Byte;
22+ FMap : TSRCMapData;
23+ FUseMMX, FShowGrid : Boolean;
24+ FReloadDrawMode : TnotifyEvent;
25+
26+ procedure SetClip(val:TPaintBox);
27+ procedure ClipPBMouseDown(Sender: TObject;
28+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
29+
30+ procedure ClipUpdate;
31+ procedure ClipMove(X,Y:Integer);
32+
33+ procedure ClipPBPaint(Sender: TObject);
34+ procedure ClipPBMouseMove(Sender: TObject; Shift: TShiftState;
35+ X, Y: Integer);
36+ procedure ClipPBMouseUp(Sender: TObject; Button: TMouseButton;
37+ Shift: TShiftState; X, Y: Integer);
38+ procedure SetZoomPixel(const Value: Byte);
39+
40+ public
41+ { Public 宣言 }
42+ property ClipPaintBox : TPaintBox read FClip write SetClip;
43+ property MapPaintBox : TPaintBox read FMapPB write FMapPB;
44+ property MapData : TSRCMapData read FMap write FMap;
45+
46+ property ScrollBox : TScrollBox read FScrollBox write FScrollBox;
47+ property ZoomPixel : Byte read FZoomPixel write SetZoomPixel;
48+ property ReloadDrawMode : TNotifyEvent read FReloadDrawMode write FReloadDrawMode;
49+ procedure HideClipBoard;
50+ procedure ClipEnter;
51+ procedure PasteProc;
52+ end;
53+
54+var
55+ MapClipModule: TMapClipModule;
56+
57+implementation
58+
59+uses MMap;
60+
61+{$R *.dfm}
62+
63+procedure TMapClipModule.SetClip(val: TPaintBox);
64+begin
65+ FClip := Val;
66+ FClip.OnMouseDown := ClipPBMouseDown;
67+ FClip.OnPaint := ClipPBPaint;
68+ FClip.OnMouseMove := ClipPBMouseMove;
69+ FClip.OnMouseUp := ClipPBMouseUp;
70+end;
71+
72+procedure TMapClipModule.SetZoomPixel(const Value: Byte);
73+var X,Y : Integer;
74+begin
75+ if FClip.Visible then begin
76+
77+ X := (FScrollBox.HorzScrollBar.Position + FClip.Left) div ZoomPixel;
78+ Y := (FScrollBox.VertScrollBar.Position + FClip.Top) div ZoomPixel;
79+ FZoomPixel := Value;
80+ ClipMove(X,Y);
81+ end;
82+ FZoomPixel := Value;
83+end;
84+
85+procedure TMapClipModule.ClipUpdate;
86+var
87+ ParVal : Integer;
88+begin
89+ if not Assigned(FClipBrd) then Exit;
90+
91+ FClipVisible.SetSize(FClipBrd.Width * ZoomPixel,FClipBrd.Height * ZoomPixel);
92+
93+ if FClipVisible.Width > 0 then begin
94+ if FUseMMX then
95+ Stretch_ZoomIn_BiLinearMMX32(0,0,FClipBMP.Width,FClipBMP.Height,
96+ 0,0,FClipVisible.Width,FClipVisible.Height,FClipBMP,FClipVisible)
97+ else
98+ Stretch_ZoomIn_Saikin32(0,0,FClipBMP.Width,FClipBMP.Height,
99+ 0,0,FClipVisible.Width,FClipVisible.Height,FClipBMP,FClipVisible);
100+
101+ if FShowGrid then begin
102+ for ParVal:= 1 to FClipBrd.Width do begin
103+ FClipVisible.Canvas.MoveTo(ParVal * ZoomPixel - 1,0);
104+ FClipVisible.Canvas.LineTo(ParVal * ZoomPixel - 1,FClipVisible.Height);
105+ end;
106+ for ParVal:= 1 to FClipBrd.Height do begin
107+ FClipVisible.Canvas.MoveTo(0,ParVal * ZoomPixel - 1);
108+ FClipVisible.Canvas.LineTo(FClipVisible.Width,ParVal * ZoomPixel - 1);
109+ end;
110+ end;
111+ end;
112+end;
113+
114+procedure TMapClipModule.ClipMove(X,Y:Integer);
115+var
116+ I : Integer;
117+begin
118+ if X > FMap.Width then X := FMap.Width - 1;
119+ if Y > FMap.Height then Y := FMap.Height - 1;
120+
121+ I := X + FClipBrd.Width - FMap.Width;
122+ if I > 0 then {Iは接続が切れるチップの数}
123+ FClip.Width := (FClipBrd.Width - I) * ZoomPixel
124+ else FClip.Width := FClipBrd.Width * ZoomPixel;
125+
126+ I := Y + FClipBrd.Height - FMap.Height;
127+ if I > 0 then FClip.Height := (FClipBrd.Height - I) * ZoomPixel
128+ else FClip.Height := FClipBrd.Height * ZoomPixel;
129+
130+ FClip.Left := X * ZoomPixel - FScrollBox.HorzScrollBar.Position;
131+ FClip.Top := Y * ZoomPixel - FScrollBox.VertScrollBar.Position;
132+end;
133+
134+procedure TMapClipModule.ClipPBPaint(Sender: TObject);
135+ function Max(const i1,i2:Integer):Integer;
136+ begin
137+ if i1 > i2 then Result := i1 else Result := i2;
138+ end;
139+ function GetMustStart(const Pt,Sp:Integer):Integer;
140+ begin
141+ if - Pt > Sp then
142+ Result := Max(0,- pt + Sp)
143+ else Result := 0;
144+ end;
145+begin
146+ BitBlt(FClip.Canvas.Handle,0,0,FClip.Width,FClip.Height,
147+ FClipVisible.Canvas.Handle,0,0,SRCCopy);
148+
149+ FClip.Canvas.Rectangle(GetMustStart(FClip.Left,FScrollBox.HorzScrollBar.Position),
150+ GetMustStart(FClip.Top,FScrollBox.VertScrollBar.Position),FClip.Width,FClip.Height);
151+end;
152+
153+procedure TMapClipModule.ClipPBMouseDown(Sender: TObject;
154+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
155+begin
156+ if Button = mbLeft then begin
157+ GetCursorPos(FPasteMouse);
158+ FPasteMouse := FMapPB.ScreenToClient(FPasteMouse);
159+ FPasteMouse.X := FPasteMouse.X + FScrollBox.HorzScrollBar.Position;
160+ FPasteMouse.Y := FPasteMouse.Y + FScrollBox.VertScrollBar.Position;
161+ end;
162+end;
163+
164+procedure TMapClipModule.ClipPBMouseMove(Sender: TObject; Shift: TShiftState;
165+ X, Y: Integer);
166+var P : TPoint;
167+begin
168+ if ssLeft in Shift then begin
169+ //with TMapEditPage(TabControl1.Tabs.Objects[TabControl1.TabIndex]) do begin
170+ GetCursorPos(P);
171+ P := FMapPB.ScreenToClient(P);
172+ P.X := P.X + FScrollBox.HorzScrollBar.Position;
173+ P.Y := P.Y + FScrollBox.VertScrollBar.Position;
174+ P.X := (P.X - FPasteMouse.X) div ZoomPixel;
175+ P.Y := (P.Y - FPasteMouse.Y) div ZoomPixel;
176+
177+ ClipMove(FPasteDest.X + P.X,FPasteDest.Y + P.Y);
178+ //end;
179+ end;
180+end;
181+
182+procedure TMapClipModule.ClipPBMouseUp(Sender: TObject; Button: TMouseButton;
183+ Shift: TShiftState; X, Y: Integer);
184+begin
185+ if Button = mbLeft then begin
186+ FPasteDest.X := (FScrollBox.HorzScrollBar.Position + FClip.Left) div ZoomPixel;
187+ FPasteDest.Y := (FScrollBox.VertScrollBar.Position + FClip.Top) div ZoomPixel;
188+ end else if Button = mbRight then begin
189+ HideClipBoard;
190+ end;
191+end;
192+
193+procedure TMapClipModule.ClipEnter;
194+begin
195+ if not Assigned(FClipBrd) then Exit;
196+ if not FClip.Visible then Exit;
197+ MapEditModule.PasteClip(FPasteDest.X,FPasteDest.Y,FClipBrd);
198+ HideClipBoard;
199+end;
200+
201+procedure TMapClipModule.HideClipBoard;
202+begin
203+ FClip.Hide;
204+ FClipBrd.Free;
205+ FClipBrd := NIL; //今のところ必要
206+ FClipBMP.Free;
207+ FClipBMP := NIL;
208+
209+ if Assigned(FReloadDrawMode) then FReloadDrawMode(Self);
210+end;
211+
212+procedure TMapClipModule.PasteProc;
213+var X_CNT,Y_CNT : Integer;
214+begin
215+ if not Assigned(FClipBrd) then FClipBrd := TSRCMapBuffer.Create;
216+ if FClipBrd.SetText(Clipboard.AsText) then begin
217+ //Clip Bitmap Update;
218+ FClipBMP := TABitmap.Create;
219+ FClipVisible := TABitmap.Create;
220+ FClipBMP.SetSize(32 * FClipBrd.Width,32 * FClipBrd.Height);
221+ for Y_CNT := 0 to FClipBrd.Height - 1 do
222+ for X_CNT := 0 to FClipBrd.Width - 1 do
223+ BitBlt(FClipBMP.Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
224+ MapModule.Chips.GetCanvas(FClipBrd[X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
225+
226+ ClipUpdate;
227+ FClip.Width := FClipVisible.Width;
228+ FClip.Height := FClipVisible.Height;
229+ ClipMove(Ceil(FScrollBox.HorzScrollBar.Position / ZoomPixel),
230+ Ceil(FScrollBox.VertScrollBar.Position / ZoomPixel));
231+ FPasteDest.X := (FScrollBox.HorzScrollBar.Position + FClip.Left) div ZoomPixel;
232+ FPasteDest.Y := (FScrollBox.VertScrollBar.Position + FClip.Top) div ZoomPixel;
233+
234+ FClip.Visible := True;
235+ MapEditModule.DrawMode := mdNone;
236+ end else begin
237+ FClipBrd.Free;
238+ FClipBrd := NIL;
239+ end;
240+end;
241+
242+end.
243+
--- MLNox/CMapUndo.pas (nonexistent)
+++ MLNox/CMapUndo.pas (revision 4)
@@ -0,0 +1,1143 @@
1+unit CMapUndo;
2+
3+interface
4+uses
5+ Classes,SysUtils,Windows,Graphics,CMap,ABitmap, ABitmapFilters32, CMapChip;
6+
7+type
8+
9+ TSRCMapUndo = Class(TPersistent)
10+ private
11+ FLayer : Integer;
12+ public
13+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);virtual;abstract;
14+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);virtual;abstract;
15+ published
16+ property Layer : Integer read FLayer write FLayer;
17+ end;
18+
19+ TSRCPenUndo = Class(TSRCMapUndo)
20+ private
21+ FChip : TSRCMapChip;
22+ FBeforePoints : Array of TPoint;
23+ FBeforeTiles : Array of TSRCMapChip;
24+ FCount : Integer;
25+ public
26+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
27+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
28+ procedure StartUndo(Map:TSRCMapData;const Layer : Integer;
29+ const Point:TPoint;const Chip:TSRCMapChip);
30+ procedure AddUndo(Map:TSRCMapData;const Point:TPoint);
31+ procedure FinishUndo;
32+ end;
33+
34+ TSRCRectUndo = Class(TSRCMapUndo)
35+ private
36+ FChip : TSRCMapChip;
37+ FLeftUp : TPoint;
38+ FBeforeRect : TSRCMapBuffer;
39+ public
40+ Destructor Destroy;override;
41+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
42+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
43+ procedure StartUndo(Map:TSRCMapData;const Layer : Integer;
44+ const Rect:TRect;const Chip:TSRCMapChip);
45+ end;
46+
47+ TSRCFillUndo = Class(TSRCMapUndo)
48+ private
49+ FFillPoint : TPoint;
50+ FBefore, FAfter : TSRCMapChip;
51+ FPoints : Array of TPoint;
52+ function CreateListProc(Map:TSRCMapLayer;const X,Y,Index:Integer):Integer;
53+ public
54+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
55+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
56+ procedure StartUndo(Map:TSRCMapData;const Layer : Integer;
57+ const Point:TPoint;const Chip:TSRCMapChip);
58+ end;
59+
60+ TSRCBiggerSetSizeUndo = Class(TSRCMapUndo)
61+ private
62+ FBeforeSize,FAfterSize:TPoint;
63+ FFillChip : TSRCMapChip;
64+ public
65+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
66+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
67+ procedure StartUndo(Map:TSRCMapData;const Width,Height:Integer;const Chip:TSRCMapChip);
68+ end;
69+
70+ TSRCOneSmallSetSizeUndo = Class(TSRCMapUndo)
71+ private
72+ FBeforeSize,FAfterSize : TPoint;
73+ FFillChip : TSRCMapChip;
74+ FCutedArea : Array of TSRCMapBuffer;
75+ public
76+ Destructor Destroy;override;
77+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
78+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
79+ procedure StartUndo(Map:TSRCMapData;const Width,Height:Integer;const Chip:TSRCMapChip);
80+ end;
81+
82+ TSRCSmallerSetSizeUndo = Class(TSRCMapUndo)
83+ private
84+ FRightCutted,FUnderCutted : Array of TSRCMapBuffer;
85+ public
86+ Destructor Destroy;override;
87+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
88+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
89+ procedure StartUndo(Map:TSRCMapData;const Width,Height:Integer);
90+ end;
91+
92+ {TSRCAreaPenUndo = Class(TSRCMapUndo)
93+
94+ end;}
95+
96+ TSRCAreaRectUndo = Class(TSRCMapUndo)
97+ private
98+ FPenRect : TSRCMapBuffer;
99+ FBackup : TSRCMapBuffer;
100+ FTopLeft : TPoint;
101+ public
102+ Destructor Destroy;override;
103+ procedure Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
104+ procedure Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);override;
105+ procedure StartUndo(Map:TSRCMapData;const Layer : Integer;
106+ const Rect:TRect;const Pen:TSRCMapBuffer);
107+ end;
108+
109+ TDeActiveLayerMode = (dlmHide,dlmDark,dlmShow);
110+
111+ TSRCMapUndoList = Class(TPersistent)
112+ private
113+ FMap : TSRCMapData;
114+ FLayerBitmap : Array of TABitmap;
115+ FMapShower : TDeActiveLayerMode;
116+ FActiveLayer : Integer;
117+ FMapChips : TSRCMapChipList;
118+ FUndos : Array of TSRCMapUndo;
119+ FMaximum : Integer;
120+ FPointer : Integer;
121+ FLastSaved : Integer;
122+ FOnChange, FOnSizeChange : TNotifyEvent;
123+ FMapBitmap : TABitmap;
124+ procedure Clear;
125+ function GetCount : Integer;
126+ procedure AppendUndo;
127+ function GetCanUndo:Boolean;
128+ function GetCanRedo:Boolean;
129+ function GetEdited:Boolean;
130+ procedure ReloadBitmap;
131+ procedure SetLayer(const Value: Integer);
132+ function GetActiveLayer: TSRCMapLayer;
133+ procedure RedrawMap;
134+ procedure SetMapShower(const Value: TDeActiveLayerMode);
135+ //function GetMapBitmap: TABitmap;
136+ public
137+ Constructor Create;
138+ Destructor Destroy;override;
139+ procedure StartPenDraw(const X,Y:Integer;Chip:TSRCMapChip);
140+ procedure AddPenDraw(const X,Y:Integer);
141+ procedure FinishPenDraw;
142+ procedure StartRectDraw(const Left,Top,Right,Bottom:Integer;Chip:TSRCMapChip);
143+ procedure StartFill(const X,Y:Integer;Chip:TSRCMapChip);
144+ procedure StartSetSize(const AWidth,AHeight:Integer;const Chip:TSRCMapChip);
145+ procedure StartTileRect(const Left,Top,Right,Bottom:Integer;Chips :TSRCMapBuffer);
146+
147+ procedure ClearMap;
148+ procedure NewMap(const Layers:Integer);
149+ procedure LoadMap(FileName:String);
150+ procedure SaveMap(FileName:String);
151+
152+ procedure Undo;
153+ procedure Redo;
154+ property CanUndo : Boolean read GetCanUndo;
155+ property CanRedo : Boolean read GetCanRedo;
156+ property Edited : Boolean read GetEdited;
157+ procedure AddLayer;
158+ published
159+ property Map : TSRCMapData read FMap;
160+ property Layer : Integer read FActiveLayer write SetLayer;
161+ property ActiveLayer : TSRCMapLayer read GetActiveLayer;
162+ property Bitmap : TABitmap read FMapBitmap;
163+ property Chips : TSRCMapChipList read FMapChips write FMapChips;
164+ property Maximum : Integer read FMaximum write FMaximum;
165+ property Pointer : Integer read FPointer;
166+ property Count : Integer read GetCount;
167+ property OnChange : TNotifyEvent read FOnChange write FOnChange;
168+ property OnSizeChange : TNotifyEvent read FOnSizeChange write FOnSizeChange;
169+ property MapShower : TDeActiveLayerMode read FMapShower write SetMapShower;
170+ end;
171+
172+const
173+ NullColor : TColor = ClWhite;
174+
175+implementation
176+
177+{Tester}
178+{
179+function TSRCMapUndoList.GetMapBitmap: TABitmap;
180+begin
181+ if (FlayerBitmap = NIL) or (FlayerBitmap[FActivelayer] = NIL) then
182+ Result := FMapBitmap
183+ else Result := FlayerBitmap[FActivelayer];
184+ //Result := FMapBitmap;
185+end;}
186+
187+{TSRCPenUndo Funx.}
188+function HSRect(const X,Y,W,H:Integer): TRect;
189+begin
190+ Result := Rect(X,Y,X + W, Y + H);
191+end;
192+
193+procedure TSRCPenUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
194+var
195+ List_CNT : Integer;
196+begin
197+ if Assigned(FBeforePoints) then begin
198+ for List_CNT := 0 to Length(FBeforePoints) - 1 do begin
199+ with FBeforePoints[List_CNT] do begin
200+ Map[Layer][X,Y] := FBeforeTiles[List_CNT];
201+ if not eqTile(FBeforeTiles[List_CNT],NullTile) then
202+ BitBlt(BMP[Layer].Canvas.Handle,X * 32,Y * 32,32,32,
203+ Chips.GetCanvas(FBeforeTiles[List_CNT]).Handle,0,0,SRCCopy)
204+ else begin
205+ BMP[Layer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32));
206+ end;
207+ end;
208+ end;
209+ end;
210+end;
211+
212+procedure TSRCPenUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
213+var
214+ List_CNT : Integer;
215+ DC : HDC;
216+begin
217+ if Assigned(FBeforePoints) then begin
218+ if not EqTile(FChip,NullTile) then
219+ DC := Chips.GetCanvas(FChip).Handle;
220+ for List_CNT := 0 to Length(FBeforePoints) - 1 do begin
221+ with FBeforePoints[List_CNT] do begin
222+ Map[Layer][X,Y] := FChip;
223+ if not EqTile(FChip,NullTile) then
224+ BitBlt(BMP[Layer].Canvas.Handle,X * 32,Y * 32,
225+ 32,32,DC,0,0,SRCCopy)
226+ else begin
227+ BMP[Layer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32));
228+ end;
229+ end;
230+ end;
231+ end;
232+end;
233+
234+procedure TSRCPenUndo.StartUndo(Map:TSRCMapData;const Layer : Integer;
235+ const Point:TPoint;const Chip:TSRCMapChip);
236+begin
237+ SetLength(FBeforePoints,10);
238+ SetLength(FBeforeTiles,10);
239+ Self.Layer := Layer;
240+ FCount := 1;
241+ FBeforePoints[0] := Point;
242+ FBeforeTiles[0] := Map[Layer][Point.X,Point.Y];
243+ FChip := Chip;
244+ Map[Layer][Point.X,Point.Y] := Chip;
245+end;
246+
247+procedure TSRCPenUndo.AddUndo(Map:TSRCMapData;const Point:TPoint);
248+begin
249+ if FCount >= Length(FBeforePoints) then begin
250+ SetLength(FBeforePoints,FCount +10);
251+ SetLength(FBeforeTiles,FCount + 10);
252+ end;
253+
254+ FBeforePoints[FCount] := Point;
255+ FBeforeTiles[FCount] := Map[Layer][Point.X,Point.Y];
256+ Map[Layer][Point.X,Point.Y] := FChip;
257+ inc(FCount);
258+end;
259+
260+procedure TSRCPenUndo.FinishUndo;
261+begin
262+ SetLength(FBeforePoints,FCount);
263+ SetLength(FBeforeTiles,FCount);
264+end;
265+
266+{TSRCRectUndo Funx.}
267+
268+Destructor TSRCRectUndo.Destroy;
269+begin
270+ FBeforeRect.Free;
271+ inherited;
272+end;
273+
274+procedure TSRCRectUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
275+var
276+ X_CNT,Y_CNT : Integer;
277+begin
278+ FBeforeRect.PasteToMap(Map[Layer],FLeftUp.X,FLeftUp.Y);
279+
280+ for Y_CNT := 0 to FBeforeRect.Height - 1 do begin
281+ if FLeftUp.Y + Y_CNT >= Map.Height then break;
282+ for X_CNT := 0 to FBeforeRect.Width - 1 do begin
283+ if FLeftUp.X + X_CNT >= Map.Width then Continue;
284+
285+ if EqTile(FBeforeRect[X_CNT,Y_CNT],NullTile) then begin
286+ BMP[Layer].Canvas.FillRect(HSRect((FLeftUp.X + X_CNT) * 32,
287+ (FLeftUp.Y + Y_CNT) * 32,32,32));
288+ end else begin
289+ BitBlt(BMP[Layer].Canvas.Handle,(FLeftUp.X + X_CNT) * 32,
290+ (FLeftUp.Y + Y_CNT) * 32,32,32,
291+ Chips.GetCanvas(FBeforeRect[X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
292+ end;
293+ end;
294+ end;
295+end;
296+
297+procedure TSRCRectUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
298+var
299+ DC:HDC;
300+ X_CNT,Y_CNT : Integer;
301+begin
302+ if not EqTile(FChip,NullTile) then DC := Chips.GetCanvas(FChip).Handle;
303+
304+ for Y_CNT := 0 to FBeforeRect.Height - 1 do begin
305+ if FLeftUp.Y + Y_CNT >= Map.Height then break;
306+ for X_CNT := 0 to FBeforeRect.Width - 1 do begin
307+ if FLeftUp.X + X_CNT >= Map.Width then Continue;
308+
309+ if EqTile(FChip,NullTile) then begin
310+ BMP[Layer].Canvas.FillRect(HSRect((FLeftUp.X + X_CNT) * 32,
311+ (FLeftUp.Y + Y_CNT) * 32,32,32));
312+ end else begin
313+ Map[Layer][FLeftUp.X + X_CNT,FLeftUp.Y + Y_CNT] := FChip;
314+ BitBlt(BMP[Layer].Canvas.Handle,(FLeftUp.X + X_CNT) * 32,
315+ (FLeftUp.Y + Y_CNT) * 32,32,32,DC,0,0,SRCCopy);
316+ end;
317+ end;
318+ end;
319+end;
320+
321+procedure TSRCRectUndo.StartUndo(Map:TSRCMapData;const Layer : Integer;
322+ const Rect:TRect;const Chip:TSRCMapChip);
323+begin
324+ FChip := Chip;
325+ FLeftUp := Point(Rect.Left,Rect.Top);
326+ Self.Layer := Layer;
327+ FBeforeRect := TSRCMapBuffer.Create;
328+ FBeforeRect.CopyFromMap(Map[Layer],Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
329+end;
330+
331+{TSRCFillUndo Funx.}
332+
333+procedure TSRCFillUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
334+var
335+ List_CNT : Integer;
336+ DC : HDC;
337+begin
338+ if not EqTile(FBefore,NullTile) then begin
339+ DC := Chips.GetCanvas(FBefore).Handle;
340+ if Assigned(FPoints) then begin
341+ for List_CNT := 0 to Length(FPoints) - 1 do begin
342+ with FPoints[List_CNT] do begin
343+ Map[Layer][X,Y] := FBefore;
344+
345+ BitBlt(BMP[Layer].Canvas.Handle,X * 32,Y * 32,32,32,DC,0,0,SRCCopy);
346+ end;
347+ end;
348+ end;
349+ end else begin
350+ if Assigned(FPoints) then begin
351+ for List_CNT := 0 to Length(FPoints) - 1 do begin
352+ with FPoints[List_CNT] do begin
353+ Map[Layer][X,Y] := NullTile;
354+ BMP[Layer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32));
355+ end;
356+ end;
357+ end;
358+ end;
359+end;
360+
361+procedure TSRCFillUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
362+var
363+ List_CNT : Integer;
364+ DC : HDC;
365+begin
366+ if not EqTile(FAfter,NullTile) then begin
367+ DC := Chips.GetCanvas(FAfter).Handle;
368+ if Assigned(FPoints) then begin
369+ for List_CNT := 0 to Length(FPoints) - 1 do begin
370+ with FPoints[List_CNT] do begin
371+ Map[Layer][X,Y] := FAfter;
372+
373+ BitBlt(BMP[Layer].Canvas.Handle,X * 32,Y * 32,32,32,DC,0,0,SRCCopy);
374+ end;
375+ end;
376+ end;
377+ end else begin
378+ if Assigned(FPoints) then begin
379+ for List_CNT := 0 to Length(FPoints) - 1 do begin
380+ with FPoints[List_CNT] do begin
381+ Map[Layer][X,Y] := NullTile;
382+ BMP[Layer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32));
383+ end;
384+ end;
385+ end;
386+ end;
387+end;
388+
389+procedure TSRCFillUndo.StartUndo(Map:TSRCMapData;const Layer : Integer;
390+ const Point:TPoint;const Chip:TSRCMapChip);
391+begin
392+ Self.Layer := Layer;
393+ FFillPoint := Point;
394+ FBefore := Map[Layer][Point.X,Point.Y];
395+ FAfter := Chip;
396+ SetLength(FPoints,10);
397+ SetLength(FPoints,CreateListProc(Map[Layer],Point.X,Point.Y,0));
398+end;
399+
400+function TSRCFillUndo.CreateListProc(Map:TSRCMapLayer;const X,Y,Index:Integer):Integer;
401+var
402+ I : Integer;
403+ function EqualCell(X,Y:Integer):Boolean;
404+ begin
405+ if (X >= 0) and (Y >= 0) and (X < Map.Width) and
406+ (Y < Map.Height) then begin
407+ Result := (Map[X,Y].Janre = FBefore.Janre) and
408+ (Map[X,Y].ID = FBefore.ID);
409+ end else
410+ Result := False;
411+ end;
412+begin
413+ if Length(FPoints) = Index then
414+ SetLength(FPoints,Index + 10);
415+
416+ I := Index + 1;
417+ FPoints[Index] := Point(X,Y);
418+ Map[X,Y] := FAfter;
419+
420+ if EqualCell(X - 1,Y) then
421+ I := CreateListProc(Map,X - 1,Y,I);
422+ if EqualCell(X + 1,Y) then
423+ I := CreateListProc(Map,X + 1,Y,I);
424+ if EqualCell(X,Y - 1) then
425+ I := CreateListProc(Map,X,Y - 1,I);
426+ if EqualCell(X,Y + 1) then
427+ I := CreateListProc(Map,X,Y + 1,I);
428+
429+ Result := I;
430+end;
431+
432+{TSRCBiggerSetSizeUndo Funx.}
433+
434+procedure TSRCBiggerSetSizeUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
435+var LC: Integer;
436+begin
437+ Map.SetSize(FBeforeSize.X,FBeforeSize.Y);
438+ for LC := 0 to Map.Count - 1 do
439+ BMP[LC].SetSize(FBeforeSize.X * 32,FBeforeSize.Y * 32);
440+end;
441+
442+procedure TSRCBiggerSetSizeUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
443+var
444+ X_CNT,Y_CNT, Z_CNT : Integer;
445+ DC : HDC;
446+ Chip : TSRCMapChip;
447+begin
448+ DC := Chips.GetCanvas(FFillChip).Handle;
449+ Map.SetSize(FAfterSize.X,FAfterSize.Y);
450+
451+ Chip := FFillChip;
452+
453+ for Z_CNT := 0 to Map.Count - 1 do begin
454+ BMP[Z_CNT].SetSize(FAfterSize.X * 32,FAfterSize.Y * 32);
455+
456+ if Z_CNT = 1 then begin
457+ Chip := NullTile;
458+ end;
459+
460+ for Y_CNT := 0 to FBeforeSize.Y - 1 do begin
461+ for X_CNT := FBeforeSize.X to FAfterSize.X - 1 do begin
462+ Map[Z_CNT][X_CNT,Y_CNT] := Chip;
463+ if Z_CNT = 0 then
464+ BitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,
465+ Y_CNT * 32,32,32,DC,0,0,SRCCopy);
466+ end;
467+ end;
468+ for Y_CNT := FBeforeSize.Y to FAfterSize.Y - 1 do begin
469+ for X_CNT := 0 to FAfterSize.X - 1 do begin
470+ Map[Z_CNT][X_CNT,Y_CNT] := Chip;
471+ if Z_CNT = 0 then
472+ BitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,
473+ Y_CNT * 32,32,32,DC,0,0,SRCCopy);
474+ end;
475+ end;
476+ end;
477+end;
478+
479+procedure TSRCBiggerSetSizeUndo.StartUndo(Map:TSRCMapData;const Width,Height:Integer;const Chip:TSRCMapChip);
480+begin
481+ FBeforeSize := Point(Map.Width,Map.Height);
482+ FAfterSize := Point(Width,Height);
483+ FFillChip := Chip;
484+end;
485+
486+{TSRCOneSmallSetSizeUndo Funx.}
487+Destructor TSRCOneSmallSetSizeUndo.Destroy;
488+var LC : Integer;
489+begin
490+ if Assigned(FCutedArea) then
491+ for LC := 0 to Length(FCutedArea) - 1 do FCutedArea[LC].Free;
492+ SetLength(FCutedArea,0);
493+ inherited;
494+end;
495+
496+procedure TSRCOneSmallSetSizeUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
497+var
498+ X_CNT,Y_CNT:Integer;
499+ Z_CNT: Integer;
500+begin
501+ Map.SetSize(FBeforeSize.X,FBeforeSize.Y);
502+ for Z_CNT := 0 to Map.Count - 1 do
503+ BMP[Z_CNT].SetSize(FBeforeSize.X * 32,FBeforeSize.Y * 32);
504+
505+ if FBeforeSize.X > FAfterSize.X then begin
506+ for Z_CNT := 0 to Map.Count - 1 do begin
507+ FCutedArea[Z_CNT].PasteToMap(Map[Z_CNT],FAfterSize.X,0);
508+ for Y_CNT := 0 to FBeforeSize.Y - 1 do begin
509+ for X_CNT := FAfterSize.X to FBeforeSize.X - 1 do begin
510+ bitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
511+ Chips.GetCanvas(Map[Z_CNT][X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
512+ end;
513+ end;
514+ end;
515+ end else begin
516+ for Z_CNT := 0 to Map.Count - 1 do begin
517+ FCutedArea[Z_CNT].PasteToMap(Map[Z_CNT],0,FAfterSize.Y);
518+ for Y_CNT := FAfterSize.Y to FBeforeSize.Y - 1 do begin
519+ for X_CNT := 0 to FBeforeSize.X - 1 do begin
520+ bitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
521+ Chips.GetCanvas(Map[Z_CNT][X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
522+ end;
523+ end;
524+ end;
525+ end;
526+end;
527+
528+procedure TSRCOneSmallSetSizeUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
529+var
530+ DC : HDC;
531+ Z_CNT: Integer;
532+ KillChip : TSRCMapChip;
533+ procedure AppendBottom(const Layer:Integer;const Chip:TSRCMapChip);
534+ var
535+ X_CNT,Y_CNT:Integer;
536+ begin
537+ for Y_CNT := FBeforeSize.Y to FAfterSize.Y - 1 do begin
538+ for X_CNT := 0 to FAfterSize.X - 1 do begin
539+ Map[Layer][X_CNT,Y_CNT] := Chip;
540+ if Layer = 0 then
541+ bitBlt(BMP[Layer].Canvas.Handle,X_CNT * 32,
542+ Y_CNT * 32,32,32,DC,0,0,SRCCopy);
543+ end;
544+ end;
545+ end;
546+ procedure AppendRight(const Layer:Integer;const Chip:TSRCMapChip);
547+ var
548+ X_CNT,Y_CNT:Integer;
549+ begin
550+ for Y_CNT := 0 to FAfterSize.Y - 1 do begin
551+ for X_CNT := FBeforeSize.X to FAfterSize.X - 1 do begin
552+ Map[Layer][X_CNT,Y_CNT] := FFillChip;
553+ if Layer = 0 then
554+ bitBlt(BMP[Layer].Canvas.Handle,X_CNT * 32,
555+ Y_CNT * 32,32,32,DC,0,0,SRCCopy);
556+ end;
557+ end;
558+ end;
559+begin
560+ KillChip.ID := 10000;
561+ KillChip.Janre := 10000;
562+ DC := Chips.GetCanvas(FFillChip).Handle;
563+ Map.SetSize(FAfterSize.X,FAfterSize.Y);
564+ for Z_CNT := 0 to Map.Count - 1 do
565+ BMP[Z_CNT].SetSize(FAfterSize.X * 32,FAfterSize.Y * 32);
566+
567+ if FBeforeSize.X > FAfterSize.X then begin
568+ AppendBottom(0,FFillChip);
569+ for Z_CNT := 1 to Map.Count - 1 do AppendBottom(Z_CNT,KillChip);
570+ end else begin
571+ AppendRight(0,FFillChip);
572+ for Z_CNT := 1 to Map.Count - 1 do AppendRight(Z_CNT,KillChip);
573+ end;
574+end;
575+
576+procedure TSRCOneSmallSetSizeUndo.StartUndo(Map:TSRCMapData;const Width,Height:Integer;const Chip:TSRCMapChip);
577+var
578+ LC: Integer;
579+begin
580+ FBeforeSize := Point(Map.Width,Map.Height);
581+ FAfterSize := Point(Width,Height);
582+ FFillChip := Chip;
583+ SetLength(FCutedArea,Map.Count);
584+ for LC := 0 to Map.Count - 1 do FCutedArea[LC] := TSRCMapBuffer.Create;
585+ if Width < Map.Width then begin
586+ for LC := 0 to Map.Count - 1 do
587+ FCutedArea[LC].CopyFromMap(Map[LC],Width,0,Map.Width,Map.Height);
588+ end else begin
589+ for LC := 0 to Map.Count - 1 do
590+ FCutedArea[LC].CopyFromMap(Map[LC],0,Height,Map.Width,Map.Height);
591+ end;
592+end;
593+
594+{TSRCSmallerSetSizeUndo Funx.}
595+
596+Destructor TSRCSmallerSetSizeUndo.Destroy;
597+var LC : Integer;
598+begin
599+ if Assigned(FRightCutted) then
600+ for LC := 0 to Length(FRightCutted) - 1 do begin
601+ FRightCutted[LC].Free;
602+ FUnderCutted[LC].Free;
603+ end;
604+ SetLength(FRightCutted,0);
605+ SetLength(FUnderCutted,0);
606+ Inherited;
607+end;
608+
609+procedure TSRCSmallerSetSizeUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
610+var
611+ W, H, X_CNT, Y_CNT, Z_CNT : Integer;
612+begin
613+ if not Assigned(FRightCutted) then Exit;
614+ W := Map.Width;
615+ H := Map.Height;
616+ Map.SetSize(W + FRightCutted[0].Width,H + FUnderCutted[0].Height);
617+
618+ for Z_CNT := 0 to Map.Count - 1 do begin
619+ BMP[Z_CNT].SetSize(Map.Width * 32,Map.Height * 32);
620+ FRightCutted[Z_CNT].PasteToMap(Map[Z_CNT],W,0);
621+ FUnderCutted[Z_CNT].PasteToMap(Map[Z_CNT],0,H);
622+
623+ for Y_CNT := 0 to H - 1 do begin
624+ for X_CNT := W to Map.Width - 1 do begin
625+ BitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
626+ Chips.GetCanvas(Map[Z_CNT][X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
627+ end;
628+ end;
629+ for Y_CNT := H to Map.Height - 1 do begin
630+ for X_CNT := 0 to Map.Width - 1 do begin
631+ BitBlt(BMP[Z_CNT].Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
632+ Chips.GetCanvas(Map[Z_CNT][X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
633+ end;
634+ end;
635+ end;
636+end;
637+
638+procedure TSRCSmallerSetSizeUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
639+var
640+ Z_CNT: Integer;
641+begin
642+ Map.SetSize(Map.Width - FRightCutted[0].Width,
643+ Map.Height - FUnderCutted[0].Height);
644+ for Z_CNT := 0 to Map.Count - 1 do begin
645+ BMP[Z_CNT].SetSize(Map.Width * 32,Map.Height * 32);
646+ end;
647+end;
648+
649+procedure TSRCSmallerSetSizeUndo.StartUndo(Map:TSRCMapData;const Width,Height:Integer);
650+var
651+ Z_CNT: Integer;
652+begin
653+ SetLength(FRightCutted,Map.Count);
654+ SetLength(FUnderCutted,Map.Count);
655+ for Z_CNT := 0 to Map.Count - 1 do begin
656+ FRightCutted[Z_CNT] := TSRCMapBuffer.Create;
657+ FUnderCutted[Z_CNT] := TSRCMapBuffer.Create;
658+
659+ FRightCutted[Z_CNT].CopyFromMap(Map[Z_CNT],Width,0,Map.Width,Height);
660+ FUnderCutted[Z_CNT].CopyFromMap(Map[Z_CNT],0,Height,Map.Width,Map.Height);
661+ end;
662+end;
663+
664+{TSRCAreaRectUndo Funx.}
665+Destructor TSRCAreaRectUndo.Destroy;
666+begin
667+ FPenRect.Free;
668+ FBackup.Free;
669+ inherited;
670+end;
671+
672+procedure TSRCAreaRectUndo.Undo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
673+var
674+ X_CNT,Y_CNT : Integer;
675+ XStart,YStart : Integer;
676+ function Max(const i1,i2:Integer):Integer;
677+ begin
678+ if i1 > i2 then Result := i1 else Result := i2;
679+ end;
680+begin
681+ XStart := Max(0,FTopLeft.X);
682+ YStart := Max(0,FTopLeft.Y);
683+ FBackup.PasteToMap(Map[Layer],XStart,YStart);
684+
685+ for Y_CNT := YStart to YStart + FBackUp.Height - 1 do begin
686+ if (Y_CNT < 0) or (Y_CNT >= Map.Height) then Continue;
687+ for X_CNT := XStart to XStart + FBackUp.Width - 1 do begin
688+ if (X_CNT < 0) or (X_CNT >= Map.Width) then Continue;
689+ BitBlt(BMP[Layer].Canvas.Handle,X_CNT * 32,Y_CNT * 32,32,32,
690+ Chips.GetCanvas(Map[Layer][X_CNT,Y_CNT]).Handle,0,0,SRCCopy);
691+ end;
692+ end;
693+end;
694+
695+procedure TSRCAreaRectUndo.Redo(Map : TSRCMapData;BMP : Array of TABitmap;Chips :TSRCMapChipList);
696+var
697+ X_CNT,Y_CNT : Integer;
698+ X_Now,Y_Now:Integer;
699+ XAdd,YAdd : Integer;
700+ function Max(const i1,i2:Integer):Integer;
701+ begin
702+ if i1 > i2 then Result := i1 else Result := i2;
703+ end;
704+begin
705+ if FTopLeft.Y < 0 then YAdd := - FTopLeft.Y else YAdd := 0;
706+ if FTopLeft.X < 0 then XAdd := - FTopLeft.X else XAdd := 0;
707+
708+ for Y_CNT := 0 to FBackUp.Height - 1 do begin
709+ Y_Now := Max(Y_CNT,Y_CNT + FTopLeft.Y);
710+
711+ if Y_Now >= Map.Height then Continue;
712+ for X_CNT := 0 to FBackUp.Width - 1 do begin
713+ X_Now := Max(X_CNT,X_CNT + FTopLeft.X);
714+ if X_Now >= Map.Width then Continue;
715+
716+ Map[Layer][X_Now,Y_Now] := FPenRect[(X_CNT + XAdd) mod FPenRect.Width,(YAdd + Y_CNT) mod FPenRect.Height];
717+ BitBlt(BMP[Layer].Canvas.Handle,X_Now * 32,Y_Now * 32,32,32,
718+ Chips.GetCanvas(Map[Layer][X_Now,Y_Now]).Handle,0,0,SRCCopy);
719+ end;
720+ end;
721+end;
722+
723+procedure TSRCAreaRectUndo.StartUndo(Map:TSRCMapData;const Layer : Integer;
724+ const Rect:TRect;const Pen:TSRCMapBuffer);
725+ function Max(const i1,i2:Integer):Integer;
726+ begin
727+ if i1 > i2 then Result := i1 else Result := i2;
728+ end;
729+ function Min(const i1,i2:Integer):Integer;
730+ begin
731+ if i1 > i2 then Result := i2 else Result := i1;
732+ end;
733+begin
734+ Self.Layer := Layer;
735+ FPenRect := TSRCMapBuffer.Create;
736+ FPenRect.Assign(Pen);
737+ FBackup := TSRCMapBuffer.Create;
738+ FBackUp.CopyFromMap(Map[Layer],Max(Rect.Left,0),Max(Rect.Top,0),
739+ Min(Rect.Right,Map.Width),Min(Rect.Bottom,Map.Height));
740+ FTopLeft := Point(Rect.Left,Rect.Top);
741+end;
742+
743+{TSRCMapUndoList Funx.}
744+
745+Constructor TSRCMapUndoList.Create;
746+begin
747+ inherited;
748+ FMap := TSRCMapData.Create;
749+ FMapBitmap := TABitmap.Create;
750+end;
751+
752+Destructor TSRCMapUndoList.Destroy;
753+begin
754+ Clear;
755+ FMap.Free;
756+ FMapBitmap.Free;
757+ Inherited;
758+end;
759+
760+function TSRCMapUndoList.GetCount;
761+begin
762+ if Assigned(FUndos) then Result := Length(FUndos)
763+ else Result := 0;
764+end;
765+
766+procedure TSRCMapUndoList.Clear;
767+var
768+ List_CNT : Integer;
769+begin
770+ for List_CNT := 0 to GetCount - 1 do
771+ FUndos[List_CNT].Free;
772+
773+ SetLength(FUndos,0);
774+ FPointer := 0;
775+ FLastSaved := 0;
776+end;
777+
778+procedure TSRCMapUndoList.NewMap(const Layers: Integer);
779+var
780+ LC: Integer;
781+begin
782+ ClearMap;
783+ for LC := 0 to Layers - 1 do FMap.Add;
784+ SetLength(FLayerBitmap,Layers);
785+ FMap.SetSize(20,15);
786+ for LC := 1 to Layers - 1 do
787+ FMap[LC].FillIn(NullTile);
788+
789+ RedrawMap;
790+ FActiveLayer := 0;
791+ ReloadBitmap;
792+end;
793+
794+procedure TSRCMapUndoList.RedrawMap;
795+var
796+ X_CNT, Y_CNT, Z_CNT : Integer;
797+ Can : TCanvas;
798+begin
799+ FMapBitmap.Width := 32 * FMap.Width;
800+ FMapBitmap.Height := 32 * FMap.Height;
801+ for Z_CNT := 0 to FMap.Count - 1 do begin
802+ if not Assigned(FLayerBitmap[Z_CNT]) then begin
803+ FLayerBitmap[Z_CNT] := TABitmap.Create;
804+ FLayerBitmap[Z_CNT].Canvas.Brush.Color := NullColor;
805+ end;
806+ FLayerBitmap[Z_CNT].SetSize(32 * FMap[Z_CNT].Width,32 * FMap[Z_CNT].Height);
807+ for Y_CNT := 0 to FMap.Height - 1 do begin
808+ for X_CNT := 0 to FMap.Width - 1 do begin
809+ //with Map[x_CNT,Y_CNT] do
810+ //BMP := FChips.GetBitmap(Janre,ID);
811+ Can := FMapChips.GetCanvas(FMap[Z_CNT][X_CNT,Y_CNT]);
812+
813+ if Assigned(Can) then begin
814+ {FMapBitmap.Canvas.CopyRect(WRect(X_CNT * 32,Y_CNT * 32,32,32),
815+ Can,WRect(0,0,32,32));}
816+ BitBlt(FLayerBitmap[Z_CNT].Canvas.Handle,X_CNT * 32,Y_CNT * 32,
817+ 32,32,CAN.Handle,0,0,SRCCopy);
818+ end;
819+ end;
820+ end;
821+ end;
822+end;
823+
824+procedure TSRCMapUndoList.ClearMap;
825+var LC: Integer;
826+begin
827+ Clear;
828+ if Assigned(FLayerBitmap) then
829+ for LC := 0 to Length(FLayerBitmap) - 1 do FLayerBitmap[LC].Free;
830+ SetLength(FLayerBitmap,0);
831+ FMapBitmap.Zero;
832+ FMap.Clear;
833+end;
834+
835+procedure TSRCMapUndoList.LoadMap(FileName:String);
836+var
837+ LC: Integer;
838+begin
839+ ClearMap;
840+ FMap.LoadFromFile(FileName);
841+ if FActiveLayer >= FMap.Count then begin
842+ for LC := FMap.Count to FActiveLayer do begin
843+ FMap.Add.FillIn(NullTile);
844+ end;
845+ end;
846+ FMapChips.ClearBitmaps;
847+ SetLength(FLayerBitmap,FMap.Count);
848+ RedrawMap;
849+ ReloadBitmap;
850+
851+ if Assigned(OnSizeChange) then OnSizeChange(Self);
852+ if Assigned(FOnChange) then FOnChange(Self);
853+end;
854+
855+procedure TSRCMapUndoList.SaveMap(FileName:String);
856+ function IsLayerBrink(Layer : TSRCMapLayer) : Boolean;
857+ var
858+ X, Y: Integer;
859+ begin
860+ Result := True;
861+ for X := 0 to Layer.Width - 1 do
862+ for Y := 0 to Layer.Height - 1 do
863+ if not EqTile(Layer[X,Y],NullTile) then begin
864+ Result := False;
865+ Exit;
866+ end;
867+ end;
868+begin
869+ FLastSaved := FPointer;
870+ while FMap.Count > 1 do begin
871+ if IsLayerBrink(FMap[FMap.Count - 1]) then begin
872+ FMap.Delete(FMap.Count - 1);
873+ end else break;
874+ end;
875+ FMap.SaveToFile(FileName);
876+end;
877+
878+procedure TSRCMapUndoList.SetLayer(const Value: Integer);
879+begin
880+ FActiveLayer := Value;
881+ ReloadBitmap;
882+end;
883+
884+procedure TSRCMapUndoList.SetMapShower(const Value: TDeActiveLayerMode);
885+begin
886+ FMapShower := Value;
887+ ReloadBitmap;
888+end;
889+
890+procedure TSRCMapUndoList.AppendUndo;
891+var
892+ List_CNT,DeleteNum : Integer;
893+begin
894+ if (FMaximum > 0) and (FPointer >= FMaximum) then begin
895+ DeleteNum := FPointer - FMaximum;
896+ for List_CNT := 0 to DeleteNum do begin
897+ FUndos[List_CNT].Free;
898+ end;
899+ for List_CNT := 0 to FMaximum - 1 do
900+ FUndos[List_CNT] := FUndos[List_CNT + DeleteNum + 1];
901+ SetLength(FUndos,FMaximum);
902+ Dec(FPointer);
903+ if FLastSaved > - 1 then Dec(FLastSaved,DeleteNum + 1);
904+ Exit;
905+ end;
906+
907+ if Pointer < GetCount then begin
908+ if FLastSaved > Pointer then
909+ FLastSaved := - 1;
910+ for List_CNT := Pointer to GetCount - 1 do
911+ FUndos[List_CNT].Free;
912+
913+ SetLength(FUndos,Pointer + 1);
914+ end else begin
915+ SetLength(FUndos,Pointer + 1);
916+ end;
917+end;
918+
919+function TSRCMapUndoList.GetCanUndo:Boolean;
920+begin
921+ Result := FPointer > 0;
922+end;
923+
924+function TSRCMapUndoList.GetActiveLayer: TSRCMapLayer;
925+begin
926+ Result := FMap[FActiveLayer];
927+end;
928+
929+function TSRCMapUndoList.GetCanRedo:Boolean;
930+begin
931+ Result := GetCount > FPointer;
932+end;
933+
934+function TSRCMapUndoList.GetEdited:Boolean;
935+begin
936+ Result := FPointer <> FLastSaved;
937+end;
938+
939+function GetOnSizeChange(Sender : TSRCMapUndo):Boolean;
940+begin
941+ Result := (Sender is TSRCBiggerSetSizeUndo) or
942+ (Sender is TSRCOneSmallSetSizeUndo) or (Sender is TSRCSmallerSetSizeUndo);
943+end;
944+
945+procedure TSRCMapUndoList.Undo;
946+begin
947+ if not CanUndo then Exit;
948+ Dec(FPointer);
949+ while FUndos[FPointer].Layer >= FMap.Count do begin
950+ AddLayer;{レイヤーが後天的な要因で削除された時それを復帰する}
951+ end;
952+
953+ FUndos[FPointer].Undo(FMap,FLayerBitmap,FMapChips);
954+ if GetOnSizeChange(FUndos[FPointer]) then begin
955+ FMapBitmap.SetSize(FLayerBitmap[0].Width,FLayerBitmap[0].Height);
956+ ReloadBitmap;
957+ if Assigned(OnSizeChange) then OnSizeChange(Self);
958+ end else ReloadBitmap;
959+ if Assigned(FOnChange) then FOnChange(Self);
960+end;
961+
962+procedure TSRCMapUndoList.Redo;
963+begin
964+ if not CanRedo then Exit;
965+ while FUndos[FPointer].Layer >= FMap.Count do begin
966+ AddLayer;
967+ end;
968+
969+ FUndos[FPointer].Redo(FMap,FLayerBitmap,FMapChips);
970+ if GetOnSizeChange(FUndos[FPointer]) then begin
971+ FMapBitmap.SetSize(FLayerBitmap[0].Width,FLayerBitmap[0].Height);
972+ ReloadBitmap;
973+ if Assigned(OnSizeChange) then OnSizeChange(Self);
974+ end else ReloadBitmap;
975+ Inc(FPointer);
976+ if Assigned(FOnChange) then FOnChange(Self);
977+end;
978+
979+procedure TSRCMapUndoList.ReloadBitmap;
980+var
981+ LC: Integer;
982+begin
983+ FMapBitmap.FillBMP(255,255,255);
984+ Case FMapShower of
985+ dlmHide : begin
986+ BitBlt(FMapBitmap.Canvas.Handle,0,0,FMapBitmap.Width,FMapBitmap.Height,
987+ FLayerBitmap[FActiveLayer].Canvas.Handle,0,0,SRCCOPY);
988+ end;
989+ dlmShow : begin
990+ for LC := 0 to FMap.Count - 1 do begin
991+ FLayerBitmap[LC].ColorKey(0,0,FMapBitmap.Width,FMapBitmap.Height,
992+ 0,0,FMapBitmap,clWhite);
993+ end;
994+ end;
995+ dlmDark : begin
996+ for LC := 0 to FMap.Count - 1 do begin
997+ if LC < FActiveLayer then begin
998+ FLayerBitmap[LC].ColorKey(0,0,FMapBitmap.Width,FMapBitmap.Height,
999+ 0,0,FMapBitmap,clWhite);
1000+ end else if LC > FActiveLayer then begin
1001+ FLayerBitmap[LC].ColorKeyAlphaMMX(0,0,FMapBitmap.Width,FMapBitmap.Height,
1002+ 0,0,FMapBitmap,clWhite,128);
1003+ end else begin
1004+ FMapBitmap.RectAngleAlphaMMX(0,0,Bitmap.Width,Bitmap.Height,clBlack,128);
1005+ FLayerBitmap[LC].ColorKey(0,0,Bitmap.Width,Bitmap.Height,0,0,FMapBitmap,clWhite);
1006+ end;
1007+ end;
1008+ end;
1009+ end;
1010+end;
1011+
1012+procedure TSRCMapUndoList.AddLayer;
1013+var Chip : TSRCMapChip;
1014+begin
1015+ Chip.Janre := 10000;
1016+ Chip.ID := 10000;
1017+ FMap.Add.FillIn(Chip);
1018+ SetLength(FLayerBitmap,Length(FLayerBitmap) + 1);
1019+ FLayerBitmap[Length(FLayerBitmap) - 1] := TABitmap.Create;
1020+ FLayerBitmap[Length(FLayerBitmap) - 1].SetSize(
1021+ FLayerBitmap[0].Width,FLayerBitmap[0].Height);
1022+ FLayerBitmap[Length(FLayerBitmap) - 1].Canvas.Brush.Color := NullColor;
1023+end;
1024+
1025+procedure TSRCMapUndoList.StartPenDraw(const X,Y:Integer;Chip:TSRCMapChip);
1026+begin
1027+ AppendUndo;
1028+ FPointer := GetCount - 1;
1029+ FUndos[FPointer] := TSRCPenundo.Create;
1030+ TSRCPenUndo(FUndos[FPointer]).StartUndo(FMap,FActiveLayer,Point(X,Y),Chip);
1031+ if EqTile(Chip,NullTile) then
1032+ FLayerBitmap[FActiveLayer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32))
1033+ else
1034+ BitBlt(FLayerBitmap[FActiveLayer].Canvas.Handle,X * 32, Y * 32,32,32,
1035+ FMapChips.GetCanvas(Chip).Handle,0,0,SRCCopy);
1036+ inc(FPointer);
1037+ ReloadBitmap;
1038+ if Assigned(FOnChange) then FOnChange(Self);
1039+end;
1040+
1041+procedure TSRCMapUndoList.AddPenDraw(const X,Y:Integer);
1042+var
1043+ CNT : Integer;
1044+begin
1045+ CNT := GetCount - 1;
1046+ TSRCPenUndo(FUndos[CNT]).AddUndo(FMap,Point(X,Y));
1047+ if EqTile(TSRCPenUndo(FUndos[CNT]).FChip,NullTile) then
1048+ FLayerBitmap[FActiveLayer].Canvas.FillRect(HSRect(X * 32,Y * 32,32,32))
1049+ else
1050+ BitBlt(FLayerBitmap[FActiveLayer].Canvas.Handle,X * 32, Y * 32,32,32,
1051+ FMapChips.GetCanvas(TSRCPenUndo(FUndos[CNT]).FChip).Handle,0,0,SRCCopy);
1052+ ReloadBitmap;
1053+ if Assigned(FOnChange) then FOnChange(Self);
1054+end;
1055+
1056+procedure TSRCMapUndoList.FinishPenDraw;
1057+begin
1058+ TSRCPenUndo(FUndos[GetCount - 1]).FinishUndo;
1059+ if Assigned(FOnChange) then FOnChange(Self);
1060+end;
1061+
1062+procedure TSRCMapUndoList.StartRectDraw(const Left,Top,Right,Bottom:Integer;Chip:TSRCMapChip);
1063+begin
1064+ AppendUndo;
1065+ FPointer := GetCount - 1;
1066+ FUndos[FPointer] := TSRCRectUndo.Create;
1067+ TSRCRectUndo(FUndos[FPointer]).StartUndo(FMap,FActiveLayer,
1068+ Rect(Left,Top,Right,Bottom),Chip);
1069+ FUndos[FPointer].Redo(FMap,FLayerBitmap,FMapChips);
1070+ ReloadBitmap;
1071+ inc(FPointer);
1072+ if Assigned(FOnChange) then FOnChange(Self);
1073+end;
1074+
1075+procedure TSRCMapUndoList.StartFill(const X,Y:Integer;Chip:TSRCMapChip);
1076+begin
1077+ if (FMap[FActiveLayer][X,Y].Janre = Chip.Janre) and
1078+ (FMap[FActiveLayer][X,Y].ID = Chip.ID) then Exit;
1079+
1080+ AppendUndo;
1081+ FPointer := GetCount - 1;
1082+ FUndos[FPointer] := TSRCFillUndo.Create;
1083+ TSRCFillUndo(FUndos[FPointer]).StartUndo(FMap,FActiveLayer,Point(X,Y),Chip);
1084+ FUndos[FPointer].Redo(FMap,FLayerBitmap,FMapChips);
1085+
1086+ inc(FPointer);
1087+ ReloadBitmap;
1088+ if Assigned(FOnChange) then FOnChange(Self);
1089+end;
1090+
1091+procedure TSRCMapUndoList.StartSetSize(const AWidth,AHeight:Integer;const Chip:TSRCMapChip);
1092+var
1093+ B : Byte;
1094+begin
1095+ if (FMap.Width = AWidth) and (FMap.Height = AHeight) then Exit;
1096+ AppendUndo;
1097+ FPointer := GetCount - 1;
1098+
1099+ B := 0;
1100+ if FMap.Width > AWidth then inc(B);
1101+ if FMap.Height > AHeight then inc(B);
1102+
1103+ Case B of
1104+ 0 : begin
1105+ FUndos[FPointer] := TSRCBiggerSetSizeUndo.Create;
1106+ TSRCBiggerSetSizeUndo(FUndos[FPointer]).StartUndo(FMap,AWidth,AHeight,Chip);
1107+ end;
1108+ 1 : begin
1109+ FUndos[FPointer] := TSRCOneSmallSetSizeUndo.Create;
1110+ TSRCOneSmallSetSizeUndo(FUndos[FPointer]).StartUndo(FMap,AWidth,AHeight,Chip);
1111+ end;
1112+ 2 : begin
1113+ FUndos[FPointer] := TSRCSmallerSetSizeUndo.Create;
1114+ TSRCSmallerSetSizeUndo(FUndos[FPointer]).StartUndo(FMap,AWidth,AHeight);
1115+ end;
1116+ end;
1117+ FUndos[FPointer].Redo(FMap,FLayerBitmap,FMapChips);
1118+ inc(FPointer);
1119+
1120+ FMapBitmap.SetSize(AWidth * 32, AHeight * 32);
1121+
1122+ ReloadBitmap;
1123+ if Assigned(FOnSizeChange) then FOnSizeChange(Self);
1124+ if Assigned(FOnChange) then FOnChange(Self);
1125+end;
1126+
1127+procedure TSRCMapUndoList.StartTileRect(const Left,Top,Right,Bottom:Integer;Chips :TSRCMapBuffer);
1128+begin
1129+ AppendUndo;
1130+ FPointer := GetCount - 1;
1131+ FUndos[FPointer] := TSRCAreaRectundo.Create;
1132+ TSRCAreaRectUndo(FUndos[FPointer]).StartUndo(FMap,FActiveLayer,
1133+ Rect(Left,Top,Right,Bottom),Chips);
1134+
1135+ FUndos[FPointer].Redo(FMap,FLayerBitmap,FMapChips);
1136+
1137+ inc(FPointer);
1138+ ReloadBitmap;
1139+ if Assigned(FOnChange) then FOnChange(Self);
1140+end;
1141+
1142+
1143+end.
--- MLNox/CPilotAbility.pas (nonexistent)
+++ MLNox/CPilotAbility.pas (revision 4)
@@ -0,0 +1,392 @@
1+unit CPilotAbility;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon;
6+type
7+ TSRCPilotAbilityLevel = class(TPersistent)
8+ private
9+ FAbilityLevel:Double;
10+ FPilotLevel:Integer;
11+ public
12+ procedure Assign(Source:TPersistent);override;
13+ Constructor Create(const AbilityLevel:Double);
14+ published
15+ property AbilityLevel:Double read FAbilityLevel write FAbilityLevel;
16+ property PilotLevel :Integer read FPilotLevel write FPilotLevel;
17+ end;
18+
19+ TSRCPilotAbility = Class(TPersistent)
20+ private
21+ FCaption : String;
22+ FOmissionName :String;
23+ FExplanation:String;
24+ FLevelUpData : Array of TSRCPilotAbilityLevel;
25+ FIsAbilityLevelNotify : Boolean;
26+
27+ function GetLevelCount:Integer;
28+
29+ function GetLevels(ID:Integer):TSRCPilotAbilityLevel;
30+ procedure SetLevels(ID:Integer;val:TSRCPilotAbilityLevel);
31+ public
32+ property Levels[ID:Integer]:TSRCPilotAbilityLevel read GetLevels write SetLevels;default;
33+ function AddLevel(AbilityLevel:Double):TSRCPilotAbilityLevel;
34+ procedure DeleteLevel(ID:Integer);
35+ procedure ClearLevels;
36+
37+ procedure Assign(Source:TPersistent);override;
38+ function GetMessage:String;
39+
40+ published
41+ property Caption : String read FCaption write FCaption;
42+ property OmissionName : String read FOmissionName write FOmissionName;
43+ property Explanation : String read FExplanation write FExplanation;
44+ property LevelCount : Integer read GetLevelCount;
45+ property AbilityLevelNotify : Boolean read FIsAbilityLevelNotify write FIsAbilityLevelNotify;
46+ end;
47+
48+ TSRCPilotAbilityList = Class(TPersistent)
49+ private
50+ FAbilities:Array of TSRCPilotAbility;
51+
52+ function GetAbility(ID:Integer):TSRCPilotAbility;
53+ procedure SetAbility(ID:Integer;val:TSRCPilotAbility);
54+ function GetCount:Integer;
55+ public
56+ function Add():TSRCPilotAbility;
57+ function AddFromMessages(Messages:TStringList;var Errors:String):Boolean;
58+ function AddFromMessage(MSG:String;var Errors:String):Boolean;
59+ procedure Delete(ID:Integer);
60+ procedure Clear;
61+ procedure Insert(ID:Integer;val:TSRCPilotAbility);
62+ procedure Assign(Source:TPersistent);override;
63+ property Ability[ID:Integer] : TSRCPilotAbility read GetAbility write SetAbility;default;
64+ published
65+ property Count : Integer read GetCount;
66+ End;
67+
68+implementation
69+{TSRCPilotAbilityLevel Func.}
70+
71+Constructor TSRCPilotAbilityLevel.Create(const AbilityLevel:Double);
72+begin
73+ inherited Create();
74+ FAbilityLevel :=AbilityLevel;
75+end;
76+
77+procedure TSRCPilotAbilityLevel.Assign(Source: TPersistent);
78+begin
79+ if Source is TSRCPilotAbilityLevel then begin
80+ FAbilityLevel := TSRCPilotAbilityLevel(Source).AbilityLevel;
81+ FPilotLevel := TSRCPilotAbilityLevel(Source).PilotLevel;
82+ end else inherited;
83+end;
84+
85+
86+
87+{TSRCPilotAbility Func.}
88+
89+function TSRCPilotAbility.GetLevelCount:Integer;
90+begin
91+ if Assigned(FLevelUpData) then
92+ Result := Length(FLevelUpData)
93+ else
94+ Result := 0;
95+end;
96+
97+procedure TSRCPilotAbility.SetLevels(ID: Integer; val: TSRCPilotAbilityLevel);
98+begin
99+ FLevelUpData[ID].Assign(val);
100+end;
101+
102+function TSRCPilotAbility.GetLevels(ID: Integer):TSRCPilotAbilityLevel;
103+begin
104+ Result := FLevelUpData[ID];
105+end;
106+
107+function TSRCPilotAbility.AddLevel(AbilityLevel: Double):TSRCPilotAbilityLevel;
108+var
109+ ID_CNT,InsertID: Integer;
110+begin
111+ InsertID := GetLevelCount;
112+ for ID_CNT := 0 to GetLevelCount - 1 do begin
113+ if FLevelUpData[ID_CNT].AbilityLevel > AbilityLevel then begin
114+ InsertID := ID_CNT;
115+ break;
116+ end;
117+ end;
118+
119+ SetLength(FLevelUpData,GetLevelCount + 1 );
120+
121+ for ID_CNT := GetLevelCount - 1 downto InsertID + 1 do
122+ FLevelUpData[ID_CNT] := FLevelUpData[ID_CNT - 1];
123+
124+ FLevelUpData[InsertID] := TSRCPilotAbilityLevel.Create(AbilityLevel);
125+ Result := FLevelUpData[InsertID];
126+end;
127+
128+procedure TSRCPilotAbility.DeleteLevel(ID: Integer);
129+var
130+ ID_CNT:Integer;
131+begin
132+ FLevelUpData[ID].Free;
133+
134+ for ID_CNT := ID to GetLevelCount - 2 do
135+ FLevelUpData[ID_CNT] := FLevelUpData[ID_CNT + 1];
136+
137+ SetLength(FLevelUpData,GetLevelCount - 1);
138+end;
139+
140+procedure TSRCPilotAbility.ClearLevels;
141+var
142+ ID_CNT: Integer;
143+begin
144+ for ID_CNT := 0 to GetLevelCount - 1 do
145+ FLevelUpData[ID_CNT].Free;
146+
147+ SetLength(FLevelUpData,0);
148+end;
149+
150+procedure TSRCPilotAbility.Assign(Source: TPersistent);
151+var
152+ LevelUp_CNT: Integer;
153+begin
154+ if Source is TSRCPilotAbility then begin
155+ FCaption := TSRCPilotAbility(Source).Caption;
156+ FOmissionName :=TSRCPilotAbility(Source).OmissionName;
157+ FExplanation := TSRCPilotAbility(Source).Explanation;
158+ FIsAbilityLevelNotify := TSRCPilotAbility(Source).AbilityLevelNotify;
159+
160+ for LevelUp_CNT := 0 to LevelCount - 1 do
161+ FLevelUpData[LevelUp_CNT].Free;
162+
163+ SetLength(FLevelUpData,TSRCPilotAbility(Source).LevelCount);
164+
165+ for LevelUp_CNT := 0 to LevelCount - 1 do begin
166+ FLevelUpData[LevelUp_CNT]:=TSRCPilotAbilityLevel.Create(0);
167+ FLevelUpdata[LevelUp_CNT].Assign(TSRCPilotAbility(Source).Levels[LevelUp_CNT]);
168+ end;
169+
170+ end else inherited;
171+end;
172+
173+function TSRCPilotAbility.GetMessage;
174+var
175+ Str :String;
176+ L_CNT: Integer;
177+begin
178+ Str := FCaption;
179+ if FIsAbilityLevelNotify or (LevelCount > 1) then
180+ Str := Str + 'Lv' + Floattostr(FLevelUpdata[0].AbilityLevel);
181+ if FOmissionName <> '' then
182+ Str := Str + '=' + FOmissionName;
183+
184+ Str := Str + ',' + inttostr(FLevelUpdata[0].PilotLevel);
185+
186+ for L_CNT := 1 to LevelCount - 1 do begin
187+ Str := Str + ',Lv'+Floattostr(FLevelUpdata[L_CNT].AbilityLevel)+','+
188+ inttostr(FLevelUpdata[L_CNT].PilotLevel);
189+ end;
190+
191+ if FExplanation <> '' then begin
192+ Str :=Str + #13#10;
193+ if InStr(',',FExplanation) then
194+ Str :=Str + FOmissionName+'=解説 "'+ FExplanation + '",'
195+ else
196+ Str :=Str + FOmissionName+'=解説 '+ FExplanation + ',';
197+
198+ Str := Str + inttostr(FLevelUpdata[0].PilotLevel);
199+ end;
200+
201+ Result := Str;
202+end;
203+
204+{TSRCPilotAbilityList Func.}
205+
206+function TSRCPilotAbilityList.GetCount;
207+begin
208+ if Assigned(FAbilities) then
209+ Result := Length(FAbilities)
210+ else
211+ Result := 0;
212+end;
213+
214+procedure TSRCPilotAbilityList.SetAbility(ID: Integer; val: TSRCPilotAbility);
215+begin
216+ FAbilities[ID].Assign(val);
217+end;
218+
219+function TSRCPilotAbilityList.GetAbility(ID: Integer): TSRCPilotAbility;
220+begin
221+ Result := FAbilities[ID];
222+end;
223+
224+function TSRCPilotAbilityList.Add;
225+begin
226+ SetLength(FAbilities,GetCount + 1);
227+ FAbilities[GetCount - 1] := TSRCPilotAbility.Create;
228+ Result := FAbilities[GetCount - 1];
229+end;
230+
231+procedure TSRCPilotAbilityList.Delete(ID: Integer);
232+var
233+ Ability_CNT: Integer;
234+begin
235+ FAbilities[ID].Free;
236+
237+ for Ability_CNT := ID to GetCount - 2 do
238+ FAbilities[Ability_CNT] := FAbilities[Ability_CNT + 1];
239+
240+ SetLength(FAbilities,GetCount - 1);
241+end;
242+
243+procedure TSRCPilotAbilityList.Insert(ID: Integer; val: TSRCPilotAbility);
244+var
245+ List_CNT: Integer;
246+begin
247+ SetLength(FAbilities,GetCount + 1);
248+ for List_CNT := GetCount - 1 downto ID + 1 do
249+ FAbilities[List_CNT] := FAbilities[List_CNT - 1];
250+
251+ FAbilities[ID] := TSRCPilotAbility.Create;
252+ FAbilities[ID].Assign(val);
253+end;
254+
255+procedure TSRCPilotAbilityList.Assign(Source: TPersistent);
256+var
257+ List_CNT: Integer;
258+begin
259+ if Source is TSRCPilotAbilityList then begin
260+
261+ for List_CNT := 0 to GetCount - 1 do
262+ FAbilities[List_CNT].Free;
263+
264+ SetLength(FAbilities,TSRCPilotAbilityList(Source).Count);
265+
266+ for List_CNT := 0 to GetCount - 1 do begin
267+ FAbilities[List_CNT]:= TSRCPilotAbility.Create;
268+ FAbilities[List_CNT].Assign(TSRCPilotAbilityList(Source).Ability[List_CNT]);
269+ end;
270+ end;
271+end;
272+
273+procedure TSRCPilotAbilityList.Clear;
274+var
275+ List_CNT:Integer;
276+begin
277+ for List_CNT := 0 to GetCount - 1 do
278+ FAbilities[List_CNT].Free;
279+ SetLength(FAbilities,0);
280+end;
281+
282+function TSRCPilotAbilityList.AddFromMessage(MSG:String;var Errors:String):Boolean;
283+var
284+ NowAbility : TSRCPilotAbility;
285+ SubStr,SubStr2 : String;
286+ LevelData : TSRCPilotAbilityLevel;
287+ Ability_CNT : Integer;
288+
289+ procedure SendError(const Error:String);
290+ begin
291+ Result := False;
292+ if Errors <> '' then Errors := Errors + #13#10;
293+
294+ Errors := Errors + '○' + Error;
295+ end;
296+
297+ function StrToInt(const Val,SRCType:String):Integer;
298+ begin
299+ if not TryStrToInt(Val,Result) then begin
300+ Result := 0;
301+ SendError(SRCType + 'が数値ではありません。');
302+ end;
303+ end;
304+ function StrToFloat(const Val,SRCType:String):Double;
305+ begin
306+ if not TryStrToFloat(Val,Result) then begin
307+ Result := 0;
308+ SendError(SRCType + 'が数値ではありません。');
309+ end;
310+ end;
311+begin
312+ Result := True;
313+ if Self.GetCount > 0 then
314+ NowAbility := GetAbility(GetCount - 1)
315+ else NowAbility := NIL;
316+
317+ if StartsStr('#',MSG) then Exit;
318+
319+ while MSG <> '' do begin
320+ SubStr := TrimJP(ExtractWordDem(MSG));
321+ if SubStr = '' then Continue;
322+ if StartsText('Lv',SubStr) then begin {レベルアップパラメータ}
323+ if NowAbility = NIL then begin
324+ SendError('レベルを指定する対象である能力がありません')
325+ end else begin
326+ LevelData := NowAbility.AddLevel(StrToFloat(Copy(
327+ SubStr,3,MaxInt),'レベル'));
328+ LevelData.PilotLevel := StrToInt(TrimJP(ExtractWordDem(MSG)),
329+ 'パイロットレベル');
330+ NowAbility.AbilityLevelNotify := True;
331+ end;
332+ end else if InStr('=解説',SubStr) then begin {解説}
333+ SubStr2 := ExtractWordDem(SubStr,'=解説');
334+ SubStr := TrimJP(SubStr);
335+ if StartsStr('"',SubStr) then begin
336+ SubStr := SubStr +','+ ExtractWordDem(MSG,'"');
337+
338+ System.Delete(SubStr,1,1);
339+ System.Delete(SubStr,Length(SubStr),1);
340+ ExtractWordDem(MSG);
341+ end;
342+
343+ for Ability_CNT := GetCount - 1 downto 0 do begin
344+ if FAbilities[Ability_CNT].OmissionName = SubStr2 then
345+ FAbilities[Ability_CNT].Explanation := SubStr;
346+ end;
347+
348+ ExtractWordDem(MSG);
349+ end else begin {通常}
350+ NowAbility := Self.Add;
351+ if InStr('=',SubStr) then begin
352+ SubStr2 := ExtractWordDem(SubStr,'=');
353+ NowAbility.OmissionName := SubStr;
354+ SubStr := SubStr2;
355+ end;
356+
357+ if inText('Lv',SubStr) then begin
358+ LevelData := NowAbility.AddLevel(StrToFloat(Copy(SubStr,
359+ AnsiPosForward('Lv',SubStr,True)+ 2,MaxInt),'レベル'));
360+ SubStr := Copy(SubStr,0,AnsiPosForward('Lv',SubStr,True) - 1);
361+ NowAbility.AbilityLevelNotify := True;
362+ end else
363+ LevelData := NowAbility.AddLevel(- 1);
364+
365+ NowAbility.Caption := SubStr;
366+
367+ {ただの文字列でも正確に貼り付けられるようにした拡張}
368+ if MSG <> '' then begin
369+ SubStr := TrimJP(ExtractWordDem(MSG));
370+ if TryStrtoint(SubStr,Ability_CNT) then begin
371+ LevelData.PilotLevel := Ability_CNT;
372+ end else begin
373+ LevelData.PilotLevel := 1;
374+ MSG := SubStr + ',' + MSG;
375+ end;
376+ end else
377+ LevelData.PilotLevel := 1;
378+ end;
379+ end;
380+end;
381+
382+function TSRCPilotAbilityList.AddFromMessages(Messages: TStringList;var Errors:String):Boolean;
383+var
384+ List_CNT : Integer;
385+begin
386+ Result := True;
387+ for List_CNT := 0 to Messages.Count - 1 do begin
388+ if not AddFromMessage(Messages[List_CNT],Errors) then
389+ Result := False;
390+ end;
391+end;
392+end.
--- MLNox/CSeek3List.pas (nonexistent)
+++ MLNox/CSeek3List.pas (revision 4)
@@ -0,0 +1,525 @@
1+unit CSeek3List;
2+{SRC Seek3のリスト管理クラス}
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon,NCommonSRC,RTLConsts;
6+
7+type
8+ TSRCData = Class(TPersistent)
9+ private
10+
11+ protected
12+ procedure AssignTo(Dest:TPersistent);override;
13+ public
14+ Constructor Create;virtual;
15+ function GetData : String;
16+ procedure WriteData(Dest:TStrings);virtual;abstract;
17+ function ReadData(Source:TStrings;
18+ Index:Integer;var Errors : String):Boolean;virtual;abstract;
19+ published
20+
21+ End;
22+
23+ TSRCErrorData = Class(TSRCData)
24+ private
25+ FLines : TStringList;
26+ protected
27+ function GetName : String;
28+
29+ public
30+ Constructor Create;override;
31+ Destructor Destroy;override;
32+ procedure WriteData(Dest:TStrings);override;
33+ function ReadData(Source:TStrings;
34+ Index:Integer;var Errors : String):Boolean;override;
35+ published
36+
37+ End;
38+
39+ TSRCDataArray = Class(TSRCData)
40+ private
41+ FCount : Integer;
42+
43+ function GetCapacity:Integer;
44+ procedure SetCapacity(const val:Integer);
45+ protected
46+ FItems : Array of TPersistent;
47+
48+ function GetItems(ID:Integer):TPersistent;
49+ procedure SetItems(ID:Integer;val:TPersistent);
50+
51+ procedure AssignTo(Dest:TPersistent);override;
52+ procedure AssignCommonData(Dest:TPersistent);virtual;
53+
54+ function AddID(const ID:Integer):TPersistent;virtual;abstract;
55+ public
56+ Destructor Destroy;override;
57+ property Items[ID:Integer]:TPersistent read GetItems write SetItems;default;
58+
59+ function Add:TPersistent;
60+ procedure Delete(ID:Integer);
61+ procedure Insert(ID:Integer;val:TPersistent);
62+ procedure Clear;
63+
64+ published
65+ property Count : Integer read FCount;
66+ property Capacity: Integer read GetCapacity write SetCapacity;
67+ End;
68+
69+ TSRCDataList = Class(TPersistent)
70+ private
71+ function GetCount:Integer;
72+ protected
73+ FItems:Array of TSRCData;
74+ function AddID(const ID:Integer):TSRCData;virtual;abstract;
75+
76+ procedure SetItems(ID:Integer;const val:TSRCData);
77+ function GetItems(ID:Integer):TSRCData;
78+ procedure SetErrors(ID:Integer;const val:TSRCErrorData);
79+ function GetErrors(ID:Integer):TSRCErrorData;
80+ procedure AssignTo(Dest:TPersistent);override;
81+ public
82+ procedure LoadFromFile(const FileName:String);
83+ procedure SaveToFile(const FileName:String);
84+
85+ function Add(out ID : integer):TSRCData;overload;
86+ function Add():TSRCData;overload;
87+
88+ Destructor Destroy;override;
89+ procedure Clear;
90+ procedure Delete(ID:Integer);
91+ function IsError(const ID:Integer;out Error:TSRCErrorData):Boolean;
92+ property Items[ID:Integer]:TSRCData read GetItems write SetItems;default;
93+ published
94+ property Count:Integer read GetCount;
95+ end;
96+
97+ TSRCErrorList = Class(TSRCDataList)
98+ private
99+ procedure SetItems(ID:Integer;const val:TSRCErrorData);
100+ function GetItems(ID:Integer):TSRCErrorData;
101+
102+ protected
103+ function AddID(const ID:Integer):TSRCData;override;
104+ public
105+ function Add(out ID : integer):TSRCErrorData;overload;
106+ function Add():TSRCErrorData;overload;
107+
108+ property Items[ID:Integer]:TSRCErrorData read GetItems write SetItems;default;
109+ published
110+ End;
111+implementation
112+
113+{TSRCData Funx.}
114+
115+Constructor TSRCData.Create;
116+begin
117+ inherited;
118+end;
119+
120+procedure TSRCData.AssignTo(Dest: TPersistent);
121+var
122+ SL : TStringList;
123+ S : String;
124+begin
125+ if Dest is TSRCErrorData then begin
126+ SL := TStringList.Create;
127+ Self.WriteData(SL);
128+ TSRCErrorData(Dest).ReadData(SL,0,S);
129+ SL.Free;
130+ end else inherited;
131+end;
132+
133+function TSRCData.GetData;
134+var
135+ SR:TStringList;
136+begin
137+ SR := TStringList.Create;
138+ WriteData(SR);
139+ Result := SR.Text;
140+ SR.Free;
141+end;
142+
143+{TSRCDataArray Funx.}
144+
145+Destructor TSRCDataArray.Destroy;
146+begin
147+ Clear;
148+ inherited;
149+end;
150+
151+
152+procedure TSRCDataArray.AssignCommonData(Dest: TPersistent);
153+var
154+ SourceName: string;
155+begin
156+ if Dest <> nil then
157+ SourceName := Dest.ClassName else
158+ SourceName := 'nil';
159+ raise EConvertError.CreateResFmt(@SAssignError, [ClassName, SourceName]);
160+end;
161+
162+procedure TSRCDataArray.AssignTo(Dest: TPersistent);
163+var
164+ List_CNT: Integer;
165+begin
166+ if Dest is TSRCDataArray then begin
167+ TSRCDataArray(Dest).Clear;
168+
169+ TSRCDataArray(Dest).Capacity := GetCapacity;
170+ AssignCommonData(Dest);
171+
172+ for List_CNT := 0 to FCount - 1 do begin
173+ TSRCDataArray(Dest).Add.Assign(FItems[List_CNT]);
174+ end;
175+ end else inherited;
176+end;
177+
178+function TSRCDataArray.GetItems(ID: Integer):TPersistent;
179+begin
180+ Result := FItems[ID];
181+end;
182+
183+procedure TSRCDataArray.SetItems(ID: Integer; val: TPersistent);
184+begin
185+ FItems[ID].Assign(val);
186+end;
187+
188+function TSRCDataArray.GetCapacity;
189+begin
190+ if Assigned(FItems) then Result := Length(FItems)
191+ else Result := 0;
192+end;
193+
194+procedure TSRCDataArray.SetCapacity(const val: Integer);
195+var
196+ LC: Integer;
197+begin
198+ if Val < GetCapacity then begin
199+ for LC := Val to FCount - 1 do FItems[LC].Free;
200+ SetLength(FItems,val);
201+ FCount := Val;
202+ end else SetLength(FItems,val);
203+end;
204+
205+function TSRCDataArray.Add;
206+begin
207+ if FCount = GetCapacity then SetCapacity(GetListGrow(Capacity));
208+
209+ Result := AddID(FCount);
210+ inc(FCount);
211+end;
212+
213+procedure TSRCDataArray.Delete(ID: Integer);
214+var
215+ List_CNT: Integer;
216+begin
217+ FItems[ID].Free;
218+
219+ for List_CNT := ID to FCount - 2 do
220+ FItems[List_CNT] := FItems[List_CNT + 1];
221+
222+ Dec(FCount);
223+end;
224+
225+procedure TSRCDataArray.Insert(ID: Integer; val: TPersistent);
226+var
227+ List_CNT: Integer;
228+begin
229+ if FCount = GetCapacity then SetCapacity(GetListGrow(Capacity));
230+
231+ for List_CNT := FCount downto ID + 1 do
232+ FItems[List_CNT] := FItems[List_CNT - 1];
233+
234+ AddID(ID).Assign(val);
235+
236+ Inc(FCount);
237+end;
238+
239+procedure TSRCDataArray.Clear;
240+var LC : Integer;
241+begin
242+ for LC := 0 to FCount - 1 do
243+ FItems[LC].Free;
244+
245+ SetLength(FItems,0);
246+ FCount := 0;
247+end;
248+
249+{TSRCDataList Funx.}
250+Destructor TSRCDataList.Destroy;
251+begin
252+ Clear;
253+ inherited;
254+end;
255+
256+function TSRCDataList.GetCount:Integer;
257+begin
258+ Result := 0;
259+ if Assigned(FItems) then begin
260+ Result :=Length(FItems);
261+ end;
262+end;
263+
264+procedure TSRCDataList.AssignTo(Dest: TPersistent);
265+var
266+ LC : Integer;
267+begin
268+ if Dest is TSRCDataList then begin
269+ TSRCDataList(Dest).Clear;
270+ SetLength(TSRCDataList(Dest).FItems,GetCount);
271+ for LC := 0 to GetCount - 1 do begin
272+ if not Assigned(FItems[LC]) then Continue;
273+ if FItems[LC] is TSRCErrorData then begin
274+ TSRCDataList(Dest).FItems[LC] := TSRCErrorData.Create;
275+ TSRCDataList(Dest).SetErrors(LC,TSRCErrorData(FItems[LC]));
276+ end else begin
277+ TSRCDataList(Dest).AddID(LC).Assign(FItems[LC]);
278+ end;
279+ end;
280+ end;
281+end;
282+
283+procedure TSRCDataList.SetItems(ID: Integer; const val: TSRCData);
284+begin
285+ if FItems[ID] is TSRCErrorData then begin
286+ FItems[ID].Free;
287+ AddID(ID);
288+ end;
289+ FItems[ID].Assign(val);
290+end;
291+
292+function TSRCDataList.GetItems(ID: Integer) :TSRCData;
293+begin
294+ if FItems[ID] is TSRCErrorData then Result := NIL else Result := FItems[ID];
295+end;
296+
297+procedure TSRCDataList.SetErrors(ID: Integer; const val: TSRCErrorData);
298+begin
299+ if not (FItems[ID] is TSRCErrorData) then begin
300+ FItems[ID].Free;
301+ FItems[ID] := TSRCErrorData.Create;
302+ end;
303+ FItems[ID].Assign(val);
304+end;
305+
306+function TSRCDataList.GetErrors(ID: Integer) :TSRCErrorData;
307+begin
308+ if FItems[ID] is TSRCErrorData then
309+ Result := TSRCErrorData(FItems[ID])
310+ else Result := NIL;
311+end;
312+
313+function TSRCDataList.IsError(const ID: Integer; out Error: TSRCErrorData):Boolean;
314+begin
315+ Result := FItems[ID] is TSRCErrorData;
316+ if Result then Error := TSRCErrorData(FItems[ID]);
317+end;
318+
319+function TSRCDataList.Add(out ID: Integer):TSRCData;
320+var
321+ List_CNT: Integer;
322+begin
323+ ID := - 1;
324+
325+ for List_CNT := 0 to GetCount - 1 do begin
326+ if not Assigned(FItems[List_CNT]) then begin
327+ ID := List_CNT;
328+ break;
329+ end;
330+ end;
331+
332+ if ID = - 1 then begin
333+ SetLength(FItems,GetCount + 1);
334+ ID := GetCount - 1;
335+ end;
336+
337+ Result := AddID(ID);
338+end;
339+
340+function TSRCDataList.Add():TSRCData;
341+var
342+ ID:Integer;
343+begin
344+ Result := Add(ID);
345+end;
346+
347+procedure TSRCDataList.Delete(ID: Integer);
348+begin
349+ FItems[ID].Free;
350+ FItems[ID] := NIL;
351+end;
352+
353+procedure TSRCDataList.Clear;
354+var
355+ Pilot_CNT: Integer;
356+begin
357+ for Pilot_CNT := 0 to Count - 1 do
358+ FItems[Pilot_CNT].Free;
359+
360+ SetLength(FItems,0);
361+end;
362+
363+procedure TSRCDataList.LoadFromFile(const FileName: string);
364+var
365+ FStrings:TStringList;
366+ Errors,S : String;
367+ Line_CNT,ID:Integer;
368+ Data : TSRCData;
369+begin
370+ FStrings := TStringList.Create;
371+ Clear;
372+ try
373+ FStrings.LoadFromFile(FileName);
374+ {作品別ヘッダは通常ここで読む}
375+ Line_CNT := 0;
376+ Errors := '';
377+
378+ ConvertOptimumData(FStrings);
379+ while FStrings.Count > Line_CNT do begin
380+ Data := Self.Add(ID);
381+ if not Data.ReadData(FStrings,Line_CNT,Errors) then begin
382+ FItems[ID].Free;
383+ FItems[ID] := TSRCErrorData.Create;
384+ FItems[ID].ReadData(FStrings,Line_CNT,Errors);
385+ end;
386+
387+ {項目の最初に移動}
388+ while Line_CNT < FStrings.Count do begin
389+ S:= TrimJP(FStrings[Line_CNT]);
390+ if not ((S = '') or StartsStr('#',S)) then
391+ break;
392+ inc(Line_CNT);
393+ end;
394+
395+ {項目の最後に移動}
396+ while Line_CNT < FStrings.Count do begin
397+ S := TrimJP(FStrings[Line_CNT]);
398+ if S = '' then break;
399+ inc(Line_CNT);
400+ end;
401+
402+ {次の項目の最初に移動}
403+ while Line_CNT < FStrings.Count do begin
404+ S:= TrimJP(FStrings[Line_CNT]);
405+ if not ((S = '') or StartsStr('#',S)) then
406+ break;
407+ inc(Line_CNT);
408+ end;
409+ end;
410+ finally
411+ FStrings.Free;
412+ end;
413+end;
414+
415+procedure TSRCDataList.SaveToFile(const FileName:String);
416+var
417+ FStrings : TStringList;
418+ List_CNT : Integer;
419+begin
420+ FStrings := TStringList.Create;
421+ for List_CNT := 0 to GetCount - 1 do begin
422+ if FItems[List_CNT] = NIL then Continue;
423+ FItems[List_CNT].WriteData(FStrings);
424+ end;
425+ FStrings.SaveToFile(FileName);
426+ FStrings.Free;
427+end;
428+
429+{TSRCErrorData Funx.}
430+
431+Constructor TSRCErrorData.Create;
432+begin
433+ inherited;
434+ FLines := TStringList.Create;
435+end;
436+
437+Destructor TSRCErrorData.Destroy;
438+begin
439+ FLines.Free;
440+ inherited;
441+end;
442+
443+procedure TSRCErrorData.WriteData(Dest: TStrings);
444+begin
445+ Dest.AddStrings(FLines);
446+ Dest.Add('');
447+end;
448+
449+function TSRCErrorData.ReadData(Source: TStrings; Index: Integer; var Errors: string):Boolean;
450+var
451+ LC: Integer;
452+ S : String;
453+begin
454+ LC := Index;
455+ FLines.Clear;
456+ Result := True;
457+
458+ while LC < Source.Count do begin
459+ S:= TrimJP(Source[LC]);
460+ if not ((S = '') or StartsStr('#',S)) then break
461+ else FLines.Add(Source[LC]);
462+ inc(LC);
463+ end;
464+
465+ while LC < Source.Count do begin
466+ S := Source[LC];
467+ if TrimJP(S) = '' then break else FLines.Add(S);
468+ inc(LC);
469+ end;
470+
471+ while LC < Source.Count do begin
472+ S:= TrimJP(Source[LC]);
473+ if not ((S = '') or StartsStr('#',S)) then break
474+ else if StartsStr('#SRCSeek2H ',S) then break
475+ else FLines.Add(Source[LC]);
476+ inc(LC);
477+ end;
478+
479+ for LC := Source.Count - 1 downto 0 do begin
480+ if TrimJP(Source[LC]) = '' then Source.Delete(LC) else break;
481+ end;
482+end;
483+
484+function TSRCErrorData.GetName;
485+var
486+ LC: Integer;
487+begin
488+ for LC := 0 to FLines.Count - 1 do begin
489+ Result := TrimJP(FLines[LC]);
490+ if ((Result = '') or StartsStr('#',Result)) then Continue;
491+ Exit;
492+ end;
493+ Result := '';
494+end;
495+
496+{TSRCErrorList Funx.}
497+
498+function TSRCErrorList.GetItems(ID: Integer):TSRCErrorData;
499+begin
500+ Result := TSRCErrorData(FItems[ID]);
501+end;
502+
503+procedure TSRCErrorList.SetItems(ID: Integer; const val: TSRCErrorData);
504+begin
505+ FItems[ID].Assign(val);
506+end;
507+
508+function TSRCErrorList.AddID(const ID: Integer):TSRCData;
509+begin
510+ FItems[ID] := TSRCErrorData.Create;
511+ Result := FItems[ID];
512+end;
513+
514+function TSRCErrorList.Add(out ID: Integer):TSRCErrorData;
515+begin
516+ Result := TSRCErrorData(inherited Add(ID));
517+end;
518+
519+function TSRCErrorList.Add:TSRCErrorData;
520+begin
521+ Result := TSRCErrorData(inherited Add);
522+end;
523+
524+end.
525+
--- MLNox/MLNox.bdsproj (nonexistent)
+++ MLNox/MLNox.bdsproj (revision 4)
@@ -0,0 +1,193 @@
1+<?xml version="1.0" encoding="utf-8"?>
2+<BorlandProject>
3+ <PersonalityInfo>
4+ <Option>
5+ <Option Name="Personality">Delphi.Personality</Option>
6+ <Option Name="ProjectType"></Option>
7+ <Option Name="Version">1.0</Option>
8+ <Option Name="GUID">{E2D8F169-6123-4FF3-ADC4-EA503F1C2CFE}</Option>
9+ </Option>
10+ </PersonalityInfo>
11+ <Delphi.Personality>
12+ <Source>
13+ <Source Name="MainSource">MLNox.dpr</Source>
14+ </Source>
15+ <FileVersion>
16+ <FileVersion Name="Version">7.0</FileVersion>
17+ </FileVersion>
18+ <Compiler>
19+ <Compiler Name="A">8</Compiler>
20+ <Compiler Name="B">0</Compiler>
21+ <Compiler Name="C">1</Compiler>
22+ <Compiler Name="D">1</Compiler>
23+ <Compiler Name="E">0</Compiler>
24+ <Compiler Name="F">0</Compiler>
25+ <Compiler Name="G">1</Compiler>
26+ <Compiler Name="H">1</Compiler>
27+ <Compiler Name="I">1</Compiler>
28+ <Compiler Name="J">0</Compiler>
29+ <Compiler Name="K">0</Compiler>
30+ <Compiler Name="L">1</Compiler>
31+ <Compiler Name="M">0</Compiler>
32+ <Compiler Name="N">1</Compiler>
33+ <Compiler Name="O">1</Compiler>
34+ <Compiler Name="P">1</Compiler>
35+ <Compiler Name="Q">0</Compiler>
36+ <Compiler Name="R">0</Compiler>
37+ <Compiler Name="S">0</Compiler>
38+ <Compiler Name="T">0</Compiler>
39+ <Compiler Name="U">0</Compiler>
40+ <Compiler Name="V">1</Compiler>
41+ <Compiler Name="W">0</Compiler>
42+ <Compiler Name="X">1</Compiler>
43+ <Compiler Name="Y">1</Compiler>
44+ <Compiler Name="Z">1</Compiler>
45+ <Compiler Name="ShowHints">True</Compiler>
46+ <Compiler Name="ShowWarnings">True</Compiler>
47+ <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
48+ <Compiler Name="NamespacePrefix"></Compiler>
49+ <Compiler Name="GenerateDocumentation">False</Compiler>
50+ <Compiler Name="DefaultNamespace"></Compiler>
51+ <Compiler Name="SymbolDeprecated">True</Compiler>
52+ <Compiler Name="SymbolLibrary">True</Compiler>
53+ <Compiler Name="SymbolPlatform">True</Compiler>
54+ <Compiler Name="SymbolExperimental">True</Compiler>
55+ <Compiler Name="UnitLibrary">True</Compiler>
56+ <Compiler Name="UnitPlatform">True</Compiler>
57+ <Compiler Name="UnitDeprecated">True</Compiler>
58+ <Compiler Name="UnitExperimental">True</Compiler>
59+ <Compiler Name="HResultCompat">True</Compiler>
60+ <Compiler Name="HidingMember">True</Compiler>
61+ <Compiler Name="HiddenVirtual">True</Compiler>
62+ <Compiler Name="Garbage">True</Compiler>
63+ <Compiler Name="BoundsError">True</Compiler>
64+ <Compiler Name="ZeroNilCompat">True</Compiler>
65+ <Compiler Name="StringConstTruncated">True</Compiler>
66+ <Compiler Name="ForLoopVarVarPar">True</Compiler>
67+ <Compiler Name="TypedConstVarPar">True</Compiler>
68+ <Compiler Name="AsgToTypedConst">True</Compiler>
69+ <Compiler Name="CaseLabelRange">True</Compiler>
70+ <Compiler Name="ForVariable">True</Compiler>
71+ <Compiler Name="ConstructingAbstract">True</Compiler>
72+ <Compiler Name="ComparisonFalse">True</Compiler>
73+ <Compiler Name="ComparisonTrue">True</Compiler>
74+ <Compiler Name="ComparingSignedUnsigned">True</Compiler>
75+ <Compiler Name="CombiningSignedUnsigned">True</Compiler>
76+ <Compiler Name="UnsupportedConstruct">True</Compiler>
77+ <Compiler Name="FileOpen">True</Compiler>
78+ <Compiler Name="FileOpenUnitSrc">True</Compiler>
79+ <Compiler Name="BadGlobalSymbol">True</Compiler>
80+ <Compiler Name="DuplicateConstructorDestructor">True</Compiler>
81+ <Compiler Name="InvalidDirective">True</Compiler>
82+ <Compiler Name="PackageNoLink">True</Compiler>
83+ <Compiler Name="PackageThreadVar">True</Compiler>
84+ <Compiler Name="ImplicitImport">True</Compiler>
85+ <Compiler Name="HPPEMITIgnored">True</Compiler>
86+ <Compiler Name="NoRetVal">True</Compiler>
87+ <Compiler Name="UseBeforeDef">True</Compiler>
88+ <Compiler Name="ForLoopVarUndef">True</Compiler>
89+ <Compiler Name="UnitNameMismatch">True</Compiler>
90+ <Compiler Name="NoCFGFileFound">True</Compiler>
91+ <Compiler Name="ImplicitVariants">True</Compiler>
92+ <Compiler Name="UnicodeToLocale">True</Compiler>
93+ <Compiler Name="LocaleToUnicode">True</Compiler>
94+ <Compiler Name="ImagebaseMultiple">True</Compiler>
95+ <Compiler Name="SuspiciousTypecast">True</Compiler>
96+ <Compiler Name="PrivatePropAccessor">True</Compiler>
97+ <Compiler Name="UnsafeType">False</Compiler>
98+ <Compiler Name="UnsafeCode">False</Compiler>
99+ <Compiler Name="UnsafeCast">False</Compiler>
100+ <Compiler Name="OptionTruncated">True</Compiler>
101+ <Compiler Name="WideCharReduced">True</Compiler>
102+ <Compiler Name="DuplicatesIgnored">True</Compiler>
103+ <Compiler Name="UnitInitSeq">True</Compiler>
104+ <Compiler Name="LocalPInvoke">True</Compiler>
105+ <Compiler Name="MessageDirective">True</Compiler>
106+ <Compiler Name="CodePage"></Compiler>
107+ </Compiler>
108+ <Linker>
109+ <Linker Name="MapFile">0</Linker>
110+ <Linker Name="OutputObjs">0</Linker>
111+ <Linker Name="GenerateHpps">False</Linker>
112+ <Linker Name="ConsoleApp">1</Linker>
113+ <Linker Name="DebugInfo">False</Linker>
114+ <Linker Name="RemoteSymbols">False</Linker>
115+ <Linker Name="GenerateDRC">False</Linker>
116+ <Linker Name="MinStackSize">16384</Linker>
117+ <Linker Name="MaxStackSize">1048576</Linker>
118+ <Linker Name="ImageBase">4194304</Linker>
119+ <Linker Name="ExeDescription"></Linker>
120+ </Linker>
121+ <Directories>
122+ <Directories Name="OutputDir"></Directories>
123+ <Directories Name="UnitOutputDir">D:\Borland\BDS\Uniits</Directories>
124+ <Directories Name="PackageDLLOutputDir"></Directories>
125+ <Directories Name="PackageDCPOutputDir"></Directories>
126+ <Directories Name="SearchPath"></Directories>
127+ <Directories Name="Packages">rtl;vcl;vclx;dbrtl;vcldb;xmlrtl;vclactnband;inet;vclie;inetdbbde;inetdbxpress;VclSmp;IndyCore;IndySystem;IndyProtocols;UserPack</Directories>
128+ <Directories Name="Conditionals"></Directories>
129+ <Directories Name="DebugSourceDirs"></Directories>
130+ <Directories Name="UsePackages">False</Directories>
131+ </Directories>
132+ <Parameters>
133+ <Parameters Name="RunParams"></Parameters>
134+ <Parameters Name="HostApplication"></Parameters>
135+ <Parameters Name="Launcher"></Parameters>
136+ <Parameters Name="UseLauncher">False</Parameters>
137+ <Parameters Name="DebugCWD"></Parameters>
138+ <Parameters Name="Debug Symbols Search Path"></Parameters>
139+ <Parameters Name="LoadAllSymbols">True</Parameters>
140+ <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
141+ </Parameters>
142+ <Language>
143+ <Language Name="ActiveLang"></Language>
144+ <Language Name="ProjectLang">$00000000</Language>
145+ <Language Name="RootDir"></Language>
146+ </Language>
147+ <VersionInfo>
148+ <VersionInfo Name="IncludeVerInfo">False</VersionInfo>
149+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
150+ <VersionInfo Name="MajorVer">1</VersionInfo>
151+ <VersionInfo Name="MinorVer">0</VersionInfo>
152+ <VersionInfo Name="Release">0</VersionInfo>
153+ <VersionInfo Name="Build">0</VersionInfo>
154+ <VersionInfo Name="Debug">False</VersionInfo>
155+ <VersionInfo Name="PreRelease">False</VersionInfo>
156+ <VersionInfo Name="Special">False</VersionInfo>
157+ <VersionInfo Name="Private">False</VersionInfo>
158+ <VersionInfo Name="DLL">False</VersionInfo>
159+ <VersionInfo Name="Locale">1041</VersionInfo>
160+ <VersionInfo Name="CodePage">932</VersionInfo>
161+ </VersionInfo>
162+ <VersionInfoKeys>
163+ <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
164+ <VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
165+ <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
166+ <VersionInfoKeys Name="InternalName"></VersionInfoKeys>
167+ <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
168+ <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
169+ <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
170+ <VersionInfoKeys Name="ProductName"></VersionInfoKeys>
171+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
172+ <VersionInfoKeys Name="Comments"></VersionInfoKeys>
173+ </VersionInfoKeys> <Excluded_Packages>
174+ <Excluded_Packages Name="D:\Borland\BDS\Bin\dcldbx100.bpl">Borland dbExpress Components</Excluded_Packages>
175+ <Excluded_Packages Name="D:\Borland\BDS\Bin\dcldb100.bpl">Borland Database Components</Excluded_Packages>
176+ <Excluded_Packages Name="d:\borland\bds\Bin\bcbie100.bpl">Borland C++Builder Internet Explorer 5 Components Package</Excluded_Packages>
177+ <Excluded_Packages Name="d:\borland\bds\Bin\dclmid100.bpl">Borland MyBase DataAccess Components</Excluded_Packages>
178+ <Excluded_Packages Name="D:\Borland\BDS\Bin\dclbde100.bpl">Borland BDE DB Components</Excluded_Packages>
179+ <Excluded_Packages Name="d:\borland\bds\bin\dclado100.bpl">Borland ADO DB Components</Excluded_Packages>
180+ <Excluded_Packages Name="d:\borland\bds\Bin\dclib100.bpl">Borland InterBase Express Components</Excluded_Packages>
181+ <Excluded_Packages Name="d:\borland\bds\Bin\dclIntraweb_80_100.bpl">Intraweb 8.0 Design Package for Borland Development Studio 2006</Excluded_Packages>
182+ <Excluded_Packages Name="d:\borland\bds\Bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
183+ <Excluded_Packages Name="d:\borland\bds\Bin\dclsoap100.bpl">Borland SOAP Components</Excluded_Packages>
184+ <Excluded_Packages Name="d:\borland\bds\Bin\dcltee100.bpl">TeeChart Components</Excluded_Packages>
185+ <Excluded_Packages Name="d:\borland\bds\Bin\dcldbxcds100.bpl">Borland SimpleDataset Component (DBX)</Excluded_Packages>
186+ <Excluded_Packages Name="d:\borland\bds\Bin\dclie100.bpl">Internet Explorer Components</Excluded_Packages>
187+ <Excluded_Packages Name="d:\borland\bds\Bin\dclsmpedit100.bpl">Borland Editor Script Enhancements</Excluded_Packages>
188+ <Excluded_Packages Name="d:\borland\bds\Bin\dclemacsedit100.bpl">Borland Editor Emacs Enhancements</Excluded_Packages>
189+ <Excluded_Packages Name="d:\borland\bds\Bin\dclmlwiz100.bpl">Borland Markup Language Wizards</Excluded_Packages>
190+ <Excluded_Packages Name="d:\borland\bds\Bin\applet100.bpl">Borland Control Panel Applet Package</Excluded_Packages>
191+ </Excluded_Packages>
192+ </Delphi.Personality>
193+</BorlandProject>
--- MLNox/CMapChipList.pas (nonexistent)
+++ MLNox/CMapChipList.pas (revision 4)
@@ -0,0 +1,457 @@
1+unit CMapChipList;
2+
3+interface
4+uses
5+ SysUtils,Classes,StringUnitLight,NCommon;
6+type
7+ TSRCMapChipList = Class(TPersistent)
8+ private
9+ FIDs : Array of SmallInt;
10+ FCount : Integer;
11+ procedure SetIDs(ID:Integer;const val:SmallInt);
12+ function GetIDs(ID:Integer):SmallInt;
13+ function GetMaximum:SmallInt;
14+ function GetCapacity:Integer;
15+ procedure SetCapacity(const val:Integer);
16+ function GetType6(const ID: Integer): SmallInt;
17+ public
18+ Destructor Destroy;override;
19+ procedure Assign(Source:TPersistent);override;
20+
21+ procedure Add(ID:SmallInt);
22+ procedure Clear;
23+
24+ property IDs[ID:Integer]:SmallInt read GetIDs write SetIDs;default;
25+ property Type6[const ID : Integer]:SmallInt read GetType6;
26+ property Maximum : SmallInt read GetMaximum;
27+ property Count : Integer read FCount;
28+ end;
29+
30+ TSRCMapChipLocalList = Class(TPersistent)
31+ private
32+ FIDs : Array of SmallInt;
33+ FCount : Integer;
34+ procedure SetIDs(ID:Integer;const val:SmallInt);
35+ function GetIDs(ID:Integer):SmallInt;
36+ function GetCapacity:Integer;
37+ procedure SetCapacity(const val:Integer);
38+ protected
39+ procedure AssignTo(Dest:TPersistent);override;
40+ public
41+ Destructor Destroy;override;
42+
43+ procedure Add(ID:SmallInt);
44+ procedure Clear;
45+
46+ property IDs[ID:Integer]:SmallInt read GetIDs write SetIDs;default;
47+ property Count : Integer read FCount;
48+ end;
49+
50+ TSRCLandData = Class(TPersistent)
51+ private
52+ FNumeric, FPosition, FLocal : TSRCMapChipList;
53+ FCustom : TSRCMapChipLocalList;
54+ FCaption,FFileName : String;
55+ FID : Integer;
56+ FVisible : Boolean;
57+ protected
58+ procedure AssignTo(Dest:TPersistent);override;
59+ public
60+ Destructor Destroy;override;
61+ procedure MakeList(SRCDir,GameDir:String);
62+ procedure ClearList;
63+ //function IsLocal(ID:SmallInt):Boolean;
64+ published
65+ property Numeric : TSRCMapChipList read FNumeric;
66+ property Position: TSRCMapChipList read FPosition;
67+ property Local : TSRCMapChipList read FLocal;
68+ property Custom : TSRCMapChipLocalList read FCustom;
69+
70+ property Caption : String read FCaption write FCaption;
71+ property FileName : String read FFileName write FFileName;
72+ property ID : Integer read FID write FID;
73+ property Visible : Boolean read FVisible write FVisible;
74+ end;
75+
76+ TSRCLandDataList = Class(TPersistent)
77+ private
78+ FLands : Array of TSRCLandData;
79+
80+ function GetLands(const ID : Integer):TSRCLandData;
81+ procedure SetLands(const ID : Integer;val:TSRCLandData);
82+
83+ function GetCount : integer;
84+ public
85+ Destructor Destroy;override;
86+ procedure Clear;
87+ property Lands[const ID : Integer]:TSRCLandData read GetLands write SetLands;
88+ property Count : Integer read GetCount;
89+ published
90+ end;
91+implementation
92+
93+destructor TSRCMapChipList.Destroy;
94+begin
95+ Clear;
96+ inherited;
97+end;
98+
99+procedure TSRCMapChipList.Assign(Source:TPersistent);
100+var
101+ ID_CNT : Integer;
102+begin
103+ if Source is TSRCMapChipList then begin
104+ FCount := TSRCMapChipList(Source).Count;
105+ SetLength(FIDs,FCount);
106+
107+ for ID_CNT := 0 to FCount - 1 do
108+ FIDs[ID_CNT] := TSRCMapChipList(Source)[ID_CNT];
109+ end;
110+end;
111+
112+function TSRCMapChipList.GetCapacity:Integer;
113+begin
114+ if Assigned(FIDs) then
115+ Result := Length(FIDs) else Result := 0;
116+end;
117+
118+procedure TSRCMapChipList.SetCapacity(const val:Integer);
119+begin
120+ if val >= FCount then
121+ SetLength(FIDs,val);
122+end;
123+
124+function TSRCMapChipList.GetIDs(ID:Integer):SmallInt;
125+begin
126+ if (ID < FCount) and (ID >= 0) then
127+ Result := FIDs[ID] else Result := 10000;
128+end;
129+
130+procedure TSRCMapChipList.SetIDs(ID:Integer;const val:SmallInt);
131+begin
132+ FIDs[ID] := val;
133+end;
134+
135+function TSRCMapChipList.GetMaximum:SmallInt;
136+begin
137+ if FCount = 0 then Result := - 32767
138+ else Result := FIDs[FCount - 1];
139+end;
140+
141+function TSRCMapChipList.GetType6(const ID: Integer): SmallInt;
142+var
143+ RealID,SectionID : Integer;
144+begin
145+ RealID := ID div 48;{セクション}
146+ SectionID := ID - (RealID * 48);
147+ if ID mod 6 >= 3 then begin {右半分}
148+ {RealIDx48+24 ＋セクションID}
149+ RealID := RealID * 48 + 24 + (SectionID mod 6 - 3) + (SectionID div 6 * 3);
150+ end else begin {左半分}
151+ RealID := RealID * 48 + (SectionID mod 6) + (SectionID div 6 * 3);
152+ end;
153+ if RealID >= FCount then Result := 10000 else Result := Self[RealID];
154+end;
155+
156+procedure TSRCMapChipList.Add(ID:SmallInt);
157+var
158+ ID_CNT,InsertID : Integer;
159+begin
160+ if GetMaximum = ID then Exit;
161+
162+ if ID >= 0 then begin
163+ if GetMaximum > ID then begin
164+ for ID_CNT := 0 to FCount - 1 do begin
165+ if FIDs[ID_CNT] >= ID then begin
166+ if FIDs[ID_CNT] = ID then break;
167+
168+ if GetCapacity = FCount then
169+ SetCapacity(FCount + 10);
170+
171+ for InsertID := FCount downto ID_CNT + 1 do
172+ FIDs[InsertID] := FIDs[InsertID - 1];
173+
174+ FIDs[ID_CNT] := ID;
175+ inc(FCount);
176+
177+ break;
178+ end;
179+ end;
180+ end else begin
181+ if GetCapacity = FCount then
182+ SetCapacity(FCount + 10);
183+ FIDs[FCount] := ID;
184+ inc(FCount);
185+ end;
186+ end else begin
187+ if GetMaximum >= 0 then begin
188+ for ID_CNT := 0 to FCount - 1 do begin
189+ if FIDs[ID_CNT] >= 0 then begin
190+ if GetCapacity = FCount then
191+ SetCapacity(FCount + 10);
192+
193+ for InsertID := FCount downto ID_CNT + 1 do
194+ FIDs[InsertID] := FIDs[InsertID - 1];
195+
196+ FIDs[ID_CNT] := ID;
197+ inc(FCount);
198+
199+ break;
200+ end else if FIDs[ID_CNT] <= ID then begin
201+ if FIDs[ID_CNT] = ID then break;
202+
203+ if GetCapacity = FCount then
204+ SetCapacity(FCount + 10);
205+
206+ for InsertID := FCount downto ID_CNT + 1 do
207+ FIDs[InsertID] := FIDs[InsertID - 1];
208+
209+ FIDs[ID_CNT] := ID;
210+ inc(FCount);
211+
212+ break;
213+ end;
214+ end;
215+ end else begin
216+ if (GetMaximum < ID) and (GetMaximum <> - 32767) then begin
217+ for ID_CNT := 0 to FCount - 1 do begin
218+ if FIDs[ID_CNT] <= ID then begin
219+ if FIDs[ID_CNT] = ID then break;
220+
221+ if GetCapacity = FCount then
222+ SetCapacity(FCount + 10);
223+
224+ for InsertID := FCount downto ID_CNT + 1 do
225+ FIDs[InsertID] := FIDs[InsertID - 1];
226+
227+ FIDs[ID_CNT] := ID;
228+ inc(FCount);
229+
230+ break;
231+ end;
232+ end;
233+ end else begin
234+ if GetCapacity = FCount then
235+ SetCapacity(FCount + 10);
236+ FIDs[FCount] := ID;
237+ inc(FCount);
238+ end;
239+ end;
240+ end;
241+end;
242+
243+procedure TSRCMapChipList.Clear;
244+begin
245+ FCount := 0;
246+ SetLength(FIDs,0);
247+end;
248+
249+{TSRCLandData Funx.}
250+
251+Destructor TSRClandData.Destroy;
252+begin
253+ FLocal.Free;
254+ FNumeric.Free;
255+ FPosition.Free;
256+end;
257+
258+procedure TSRCLandData.AssignTo(Dest:TPersistent);
259+begin
260+ if Dest is TSRCLandData then begin
261+ if FLocal = NIL then TSRCLandData(Dest).ClearList
262+ else begin
263+ TSRCLandData(Dest).FileName := '';
264+ TSRCLandData(Dest).MakeList('','');
265+ TSRCLandData(Dest).FLocal.Assign(FLocal);
266+ TSRCLandData(Dest).FNumeric.Assign(FNumeric);
267+ TSRCLandData(Dest).FPosition.Assign(FPosition);
268+ TSRCLandData(Dest).FCustom.Assign(FCustom);
269+ end;
270+
271+ TSRCLandData(Dest).Caption := FCaption;
272+ TSRCLandData(Dest).FileName := FFileName;
273+ TSRCLandData(Dest).ID := FID;
274+ TSRCLandData(Dest).Visible := FVisible;
275+ end;
276+end;
277+
278+procedure TSRCLandData.MakeList(SRCDir,GameDir : String);
279+ procedure SetID(Dest : TSRCMapChipList;const Dir : String;const isLocal : Boolean = False);
280+ var
281+ S : String;
282+ MapChipID : Integer;
283+ SR : TSearchRec;
284+ begin
285+ if FindFirst(Dir + FileName + '*.bmp',faAnyFile,SR) = 0 then begin
286+ repeat
287+ S := ChangeFileExt(SR.Name,'');
288+ Delete(S,1,Length(FileName));
289+ if TryStrToInt(S,MapChipID) then begin
290+ //if {isLocal XOR} (MapChipID >= 0) then
291+ Dest.Add(MapChipID);
292+ end;
293+ until FindNext(sr) <> 0;
294+ end;
295+ FindClose(sr);
296+ end;
297+ procedure OpenSelectConfig(Dest : TSRCMapChipLocalList;const FN : String);
298+ var
299+ St : TStringList;
300+ LC: Integer;
301+ MapChipID : Integer;
302+ S,SubS : String;
303+ begin
304+ St := TStringList.Create;
305+ St.LoadFromFile(FN);
306+ Dest.Clear;
307+ for LC := 0 to St.Count - 1 do begin
308+ if StartsStr('#',St[LC]) then Continue;
309+ S := TrimJP(St[LC]);
310+ while S <> '' do begin
311+ SubS := TrimJP(ExtractWordDem(S));
312+ if TryStrToInt(SubS,MapChipID) then begin
313+ Dest.Add(MapChipID);
314+ end;
315+ end;
316+ end;
317+ end;
318+begin
319+ if not Assigned(FLocal) then begin
320+ FLocal := TSRCMapChipList.Create;
321+ FNumeric := TSRCMapChipList.Create;
322+ FPosition := TSRCMapChipList.Create;
323+ FCustom := TSRCMapChipLocalList.Create;
324+ end;
325+ if FileName = '' then Exit;
326+
327+ SRCDir := IncludeTrailingPathDelimiter(SRCDir) + 'Bitmap\Map\';
328+ GameDir := IncludeTrailingPathDelimiter(GameDir) + 'Bitmap\Map\';
329+
330+ if DirectoryExists(SRCDir + FileName + '\') then
331+ SetID(FNumeric,SRCDir + FileName + '\');
332+ if DirectoryExists(SRCDir) then
333+ SetID(FNumeric,SRCDir);
334+
335+ if FileExists(SRCDir + FileName + '\SelectConfig.txt') then
336+ OpenSelectConfig(FCustom,SRCDir + FileName + '\SelectConfig.txt');
337+
338+ {FPositonは別のクラスで似た処理を行う}
339+
340+ if DirectoryExists(GameDir + FileName + '\') then
341+ SetID(FLocal,GameDir + FileName + '\',True)
342+ else if DirectoryExists(GameDir) then
343+ SetID(FLocal,GameDir,True)
344+ else FLocal.Clear;
345+end;
346+
347+procedure TSRCLandData.ClearList;
348+begin
349+ FLocal.Free;
350+ FNumeric.Free;
351+ FPosition.Free;
352+ FCustom.Free;
353+ FLocal := NIL;
354+ FPosition := NIL;
355+ FNumeric := NIL;
356+ FCustom := NIL;
357+end;
358+
359+{function TSRCLandData.IsLocal(ID:SmallInt):Boolean;
360+var List_CNT : Integer;
361+begin
362+ Result := False;
363+ for List_CNT := 0 to FLocal.Count - 1 do begin
364+ if FLocal[List_CNT] = ID then begin
365+ Result := True;
366+ break;
367+ end;
368+ end;
369+end;
370+}
371+{TSRCLandDataList Funx.}
372+
373+Destructor TSRCLandDataList.Destroy;
374+begin
375+ Clear;
376+ inherited;
377+end;
378+
379+function TSRCLandDataList.GetLands(const ID : Integer):TSRCLandData;
380+begin
381+ Result := FLands[ID];
382+end;
383+
384+procedure TSRCLandDataList.SetLands(const ID:Integer;val:TSRCLandData);
385+begin
386+ FLands[ID].Assign(val);
387+end;
388+
389+function TSRCLandDataList.GetCount;
390+begin
391+ if Assigned(FLands) then
392+ Result := Length(FLands) else Result := 0;
393+end;
394+
395+procedure TSRCLandDataList.Clear;
396+var
397+ Land_CNT : Integer;
398+begin
399+ for Land_CNT := 0 to GetCount - 1 do
400+ FLands[Land_CNT].Free;
401+ SetLength(FLands,0);
402+end;
403+
404+{ TSRCMapChipLocalList }
405+
406+procedure TSRCMapChipLocalList.Add(ID: SmallInt);
407+begin
408+ if GetCapacity = Count then
409+ SetCapacity(GetCapacity + 10);
410+ FIDs[Count] := ID;
411+ Inc(FCount);
412+end;
413+
414+procedure TSRCMapChipLocalList.AssignTo(Dest : TPersistent);
415+var LC : Integer;
416+begin
417+ if Dest is TSRCMapChipLocalList then begin
418+ TSRCMapChipLocalList(Dest).Clear;
419+ TSRCMapChipLocalList(Dest).SetCapacity(FCount);
420+ for LC := 0 to FCount - 1 do
421+ TSRCMapChipLocalList(Dest).Add(FIDs[LC]);
422+ end else inherited;
423+end;
424+
425+procedure TSRCMapChipLocalList.Clear;
426+begin
427+ SetCapacity(0);
428+ FCount := 0;
429+end;
430+
431+destructor TSRCMapChipLocalList.Destroy;
432+begin
433+ Clear;
434+ inherited;
435+end;
436+
437+function TSRCMapChipLocalList.GetCapacity: Integer;
438+begin
439+ if FIDs = NIL then Result := 0 else Result := Length(FIDs);
440+end;
441+
442+function TSRCMapChipLocalList.GetIDs(ID: Integer): SmallInt;
443+begin
444+ Result := FIDs[ID];
445+end;
446+
447+procedure TSRCMapChipLocalList.SetCapacity(const val: Integer);
448+begin
449+ SetLength(FIDs,Val);
450+end;
451+
452+procedure TSRCMapChipLocalList.SetIDs(ID: Integer; const val: SmallInt);
453+begin
454+ FIDs[ID] := Val;
455+end;
456+
457+end.
--- MLNox/CMap.pas (nonexistent)
+++ MLNox/CMap.pas (revision 4)
@@ -0,0 +1,355 @@
1+unit CMap;
2+
3+interface
4+uses
5+ Classes, SysUtils,NCommon, CSeek3List;
6+type
7+ TSRCMapChip = record
8+ Janre,ID : Integer;
9+ End;
10+
11+ TSRCMapLayer = Class(TSRCData)
12+ private
13+ FMapChips : Array of Array of TSRCMapChip;
14+ procedure SetMapChip(x,y:Integer;const val:TSRCMapChip);
15+ function GetMapChip(x,y:Integer):TSRCMapChip;
16+
17+ function GetHeight: integer;
18+ function GetWidth: Integer;
19+ procedure SetHeight(const Value: integer);
20+ procedure SetWidth(const Value: Integer);
21+ protected
22+ procedure AssignTo(Dest:TPersistent);override;
23+
24+ public
25+ procedure CopyFromMap(Layer : TSRCMapLayer;const X,Y,R,B : Integer);
26+ procedure PasteToMap(Layer : TSRCMapLayer;const X,Y : Integer);
27+ property Chips[X,Y:Integer]:TSRCMapChip read GetMapChip write SetMapChip;default;
28+
29+ {LoadFromFile / SaveToFileの代わりメソッド}
30+ procedure WriteData(Dest:TStrings);override;
31+ function ReadData(Source:TStrings;
32+ Index:Integer;var Errors : String):Boolean;override;
33+
34+ function SetText(val : String):Boolean;
35+ {
36+ //procedure LoadFromStream(Stream:TStream);override;
37+ //procedure SaveToStream(Stream:TStream);override;
38+ }
39+ procedure SetSize(const AX,AY:Integer);
40+ procedure FillIn(const Chip:TSRCMapChip);
41+ published
42+ property Width : Integer read GetWidth write SetWidth;
43+ property Height : integer read GetHeight write SetHeight;
44+ End;
45+
46+ TSRCMapBuffer = TSRCMapLayer;
47+
48+ TSRCMapData = Class(TSRCDataArray)
49+ private
50+ FVersion : Integer;
51+ FOldver : Boolean;
52+ procedure SetItems(ID:Integer;const val:TSRCMapLayer);
53+ function GetItems(ID:Integer):TSRCMapLayer;
54+
55+ procedure SetHeight(const val:Integer);
56+ function GetHeight:Integer;
57+ procedure SetWidth(const val:Integer);
58+ function GetWidth:Integer;
59+ protected
60+ procedure AssignCommonData(Dest:TPersistent);override;
61+ function AddID(const ID:Integer):TPersistent;override;
62+ public
63+ function Add:TSRCMapLayer;
64+ procedure Insert(ID:Integer;val:TSRCMapLayer);
65+ property Items[ID:Integer]:TSRCMapLayer read GetItems write SetItems;default;
66+
67+ procedure SetSize(const AX,AY:Integer);
68+
69+ property Width : Integer read GetWidth write SetWidth;
70+ property Height: Integer read GetHeight write SetHeight;
71+ property OldVersion : Boolean read FOldver write FOldver;
72+ property Version : Integer read FVersion write FVersion;
73+
74+ procedure LoadFromFile(const FileName : String);
75+ procedure SaveToFile(const FileName : String);
76+ End;
77+
78+ function EqTile(const Tile1,Tile2 : TSRCMapChip):Boolean;
79+const
80+ NullTile : TSRCMapChip = (Janre : 10000;ID : 10000);
81+
82+implementation
83+
84+{Base Tile}
85+
86+function EqTile(const Tile1,Tile2 : TSRCMapChip):Boolean;
87+begin
88+ Result := (Tile1.Janre = Tile2.Janre) and (Tile1.ID = Tile2.ID);
89+end;
90+
91+{TSRCMapLayer Funx.}
92+
93+procedure TSRCMapLayer.SetMapChip(x: Integer; y: Integer; const val: TSRCMapChip);
94+begin
95+ FMapChips[x,y] := val;
96+end;
97+
98+function TSRCMapLayer.GetMapChip(x: Integer;y: Integer):TSRCMapChip;
99+begin
100+ Result := FMapChips[x,y];
101+end;
102+
103+procedure TSRCMapLayer.SetSize(const AX,AY:Integer);
104+begin
105+ SetLength(FMapChips,AX,AY);
106+end;
107+
108+function TSRCMapLayer.SetText(val: String): Boolean;
109+var
110+ X,Y : Integer;
111+label
112+ Halt;
113+ function TrimVal(const Dem : String;Out Res:Integer): Boolean;
114+ begin
115+ Result := TryStrToInt(ExtractWordDem(Val,Dem),Res);
116+ end;
117+begin
118+ if Not TrimVal(',',X) then goto Halt;
119+ if Not TrimVal(#13#10,Y) then goto Halt;
120+
121+ SetSize(X,Y);
122+
123+ for X := 0 to width - 1 do begin
124+ for Y := 0 to Height - 1 do begin
125+ if Not TrimVal(',',FMapChips[X,Y].Janre) then goto Halt;
126+ if Not TrimVal(#13#10,FMapChips[X,Y].ID) then goto Halt;
127+ end;
128+ end;
129+
130+ Result := True;
131+ Exit;
132+ Halt:
133+ Result := False;
134+end;
135+
136+procedure TSRCMapLayer.SetWidth(const value: Integer);
137+begin
138+ SetSize(value,Height);
139+end;
140+
141+function TSRCMapLayer.GetWidth;
142+begin
143+ Result := Length(FMapChips);
144+end;
145+
146+function TSRCMapLayer.ReadData(Source:TStrings;
147+ Index:Integer;var Errors : String):Boolean;
148+var
149+ S : String;
150+ Y_CNT,X_CNT:Integer;
151+begin
152+ Result := True;
153+
154+ for X_CNT := 0 to width - 1 do begin
155+ for Y_CNT := 0 to Height - 1 do begin
156+ S := Source[Index];
157+ inc(Index);
158+
159+ FMapChips[X_CNT,Y_CNT].Janre := strtoint(Trim(ExtractWordDem(S)));
160+ FMapChips[X_CNT,Y_CNT].ID := strtoint(Trim(S));
161+ end;
162+ end;
163+end;
164+
165+procedure TSRCMapLayer.WriteData(Dest: TStrings);
166+var
167+ Y_CNT,X_CNT:Integer;
168+begin
169+ for X_CNT := 0 to width - 1 do begin
170+ for Y_CNT := 0 to Height - 1 do begin
171+ Dest.Add(inttostr(FMapChips[X_CNT,Y_CNT].Janre) +','+
172+ inttostr(FMapChips[X_CNT,Y_CNT].ID));
173+ end;
174+ end;
175+end;
176+
177+procedure TSRCMapLayer.SetHeight(const value: Integer);
178+begin
179+ SetSize(Width,value);
180+end;
181+
182+function TSRCMapLayer.GetHeight;
183+begin
184+ if (FMapChips = NIL) or (FMapChips[0] = NIL) then Result := 0
185+ else Result := Length(FMapChips[0]);
186+end;
187+
188+procedure TSRCMapLayer.PasteToMap(Layer: TSRCMapLayer; const X, Y: Integer);
189+var
190+ X_CNT, Y_CNT : Integer;
191+begin
192+ for Y_CNT := 0 to GetHeight - 1 do begin
193+ for X_CNT := 0 to GetWidth - 1 do begin
194+ Layer[X_CNT + X,Y_CNT + Y] := FMapChips[X_CNT,Y_CNT];
195+ end;
196+ end;
197+end;
198+
199+procedure TSRCMapLayer.CopyFromMap(Layer: TSRCMapLayer; const X, Y, R,
200+ B: Integer);
201+var
202+ X_CNT, Y_CNT : Integer;
203+begin
204+ SetSize(R - X,B - Y);
205+
206+ for Y_CNT := 0 to GetHeight - 1 do begin
207+ for X_CNT := 0 to GetWidth - 1 do begin
208+ FMapChips[X_CNT,Y_CNT] := Layer[X_CNT + X,Y_CNT + Y];
209+ end;
210+ end;
211+end;
212+
213+procedure TSRCMapLayer.FillIn(const Chip: TSRCMapChip);
214+var
215+ X_CNT: Integer;
216+ Y_CNT: Integer;
217+begin
218+ for X_CNT := 0 to Width - 1 do
219+ for Y_CNT := 0 to Height - 1 do
220+ FMapChips[X_CNT,Y_CNT] := Chip;
221+end;
222+
223+procedure TSRCMapLayer.AssignTo(Dest:TPersistent);
224+var
225+ Y_CNT: Integer;
226+ X_CNT: Integer;
227+begin
228+ if Dest Is TSRCMapLayer then begin
229+ TSRCMapLayer(Dest).SetSize(Width,Height);
230+ for Y_CNT := 0 to GetHeight - 1 do
231+ for X_CNT := 0 to GetWidth - 1 do
232+ TSRCMapLayer(Dest)[X_CNT,Y_CNT] := FMapChips[X_CNT,Y_CNT];
233+ end;
234+end;
235+
236+{TSRCMapData Funx.}
237+
238+function TSRCMapData.GetHeight: Integer;
239+begin
240+ if Count = 0 then Result := 0 else Result := GetItems(0).Height;
241+end;
242+
243+function TSRCMapData.GetItems(ID: Integer):TSRCMapLayer;
244+begin
245+ Result := TSRCMapLayer(inherited Items[ID]);
246+end;
247+
248+function TSRCMapData.GetWidth: Integer;
249+begin
250+ if Count = 0 then Result := 0 else Result := GetItems(0).Width;
251+end;
252+
253+procedure TSRCMapData.SaveToFile(const FileName: String);
254+var
255+ Dest : TStringList;
256+ Layer : Integer;
257+begin
258+ Dest := TStringList.Create;
259+ Dest.Add('"MapData"');
260+ if FOldver then Dest.Add('"Reserved"')
261+ else if Count = 1 then Dest.Add('20100') //SRCSeek Map Editer ver.
262+ else Dest.Add('20300');
263+
264+ Dest.Add(inttostr(Width) + ',' + inttostr(Height));
265+ Layer := 0;
266+ repeat
267+ GetItems(Layer).WriteData(Dest);
268+ Dest.Add('"Layer"');
269+ inc(Layer);
270+ until (Layer >= Count);
271+ Dest.Delete(Dest.Count - 1);
272+ Dest.SaveToFile(FileName);
273+end;
274+
275+procedure TSRCMapData.SetHeight(const val: Integer);
276+begin
277+ SetSize(Width,Val);
278+end;
279+
280+procedure TSRCMapData.SetItems(ID: Integer; const val: TSRCMapLayer);
281+begin
282+ inherited Items[ID] := val;
283+end;
284+
285+procedure TSRCMapData.SetSize(const AX, AY: Integer);
286+var
287+ LC: Integer;
288+begin
289+ for LC := 0 to Count - 1 do GetItems(LC).SetSize(AX,AY);
290+end;
291+
292+procedure TSRCMapData.SetWidth(const val: Integer);
293+begin
294+ SetSize(Val,Height);
295+end;
296+
297+procedure TSRCMapData.AssignCommonData(Dest: TPersistent);
298+begin
299+ TSRCMapData(Dest).Version := FVersion;
300+ TSRCMapData(Dest).OldVersion := FOldver;
301+end;
302+
303+function TSRCMapData.AddID(const ID: Integer):TPersistent;
304+begin
305+ FItems[ID] := TSRCMapLayer.Create;
306+ Result := FItems[ID];
307+end;
308+
309+function TSRCMapData.Add;
310+begin
311+ Result := TSRCMapLayer(inherited Add);
312+ with Result do SetSize(Self.Width,Self.Height);
313+end;
314+
315+procedure TSRCMapData.Insert(ID: Integer; val: TSRCMapLayer);
316+begin
317+ inherited insert(id,val);
318+end;
319+
320+procedure TSRCMapData.LoadFromFile(const FileName: String);
321+var
322+ MapData : TStringList;
323+ S : String;
324+ W : Integer;
325+begin
326+ MapData := TStringList.Create;
327+ Self.Clear;
328+ Self.Add;
329+ try
330+ MapData.LoadFromFile(FileName);
331+ if MapData[0] <> '"MapData"' then Exit;//Not map Data
332+ MapData.Delete(0);
333+
334+ FOldver := MapData[0] = '"Reserved"';
335+ {SRCSeek MapEditer では 20101を出力}
336+ MapData.Delete(0);
337+ S := MapData[0];
338+ W := strtoint(Trim(ExtractWordDem(S)));
339+ MapData.Delete(0);
340+ SetSize(W,strtoint(Trim(S)));
341+
342+ W := 0;
343+ while (W <> - 1) and (W < MapData.Count - 1) do begin
344+ if not Self.Add.ReadData(MapData,W,S) then Exit;
345+ Inc(w,Self.Width * Self.Height);
346+ if W >= MapData.Count then break;
347+ if MapData[W] = '"Layer"' then Inc(W);
348+ end;
349+ finally
350+ Self.Delete(0);
351+ MapData.Free;
352+ end;
353+end;
354+
355+end.
--- MLNox/CUnit.pas (nonexistent)
+++ MLNox/CUnit.pas (revision 4)
@@ -0,0 +1,517 @@
1+unit CUnit;
2+
3+interface
4+uses
5+ Classes,SysUtils,StringUnitLight,NCommon, CEquips, CUnitAbility,
6+ NCommonSRC,CSeek3List;
7+type
8+ TSRCUnit = Class(TSRCData)
9+ private
10+ FName , FOmissionName , FSyllabary : String;
11+ FUnitClass : String;
12+ FPilotNum : Byte;
13+ FPilotChange : Boolean;
14+ FMaximumItems: Byte;
15+
16+ FAirAdjustment,FLandAdjustment,FWaterAdjustment : Boolean;
17+ FEarthAdjustment,FSpaceAdjustment : Boolean;
18+
19+ FMove : Byte;
20+ FSize : Byte;
21+
22+ FRepairExpense : Integer;
23+ FExp : SmallInt;
24+
25+ FUnitAbility : TSRCUnitAbilityList;
26+
27+ FMaxHP,FMaxMP : Integer;
28+ FDefence,FSpeed : Integer;
29+
30+ FAirMove,FLandMove,FWaterMove,FSpaceMove:Byte;
31+
32+ FUnitGraphic : String;
33+
34+ FWeapon : TSRCEquipList;
35+ FAbility : TSRCAbilityList;
36+
37+ FComment : TStringList;
38+
39+ procedure SetWeapon(val:TSRCEquipList);
40+ procedure SetAbility(val:TSRCAbilityList);
41+ procedure SetUnitAbility(val:TSRCUnitAbilityList);
42+ procedure SetComment(val:TStringList);
43+ protected
44+
45+ procedure AssignTo(Dest:TPersistent);override;
46+ public
47+ Constructor Create;override;
48+ Destructor Destroy;override;
49+ procedure WriteData(Dest:TStrings);override;
50+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
51+
52+ published
53+ property Name : String read FName write FName;
54+ property OmissionName : String read FOmissionName write FOmissionName;
55+ property Syllabary : String read FSyllabary write FSyllabary;
56+ property UnitClass : String read FUnitClass write FUnitClass;
57+ property PilotNum : Byte read FPilotNum write FPilotNum;
58+ property PilotChange : Boolean read FPilotChange write FPilotChange;
59+ property MaximumItems : Byte read FMaximumItems write FMaximumItems;
60+
61+ property AirAdjustment : Boolean read FAirAdjustment write FAirAdjustment;
62+ property LandAdjustment : Boolean read FLandAdjustment write FLandAdjustment;
63+ property WaterAdjustment : Boolean read FWaterAdjustment write FWaterAdjustment;
64+ property EarthAdjustment : Boolean read FEarthAdjustment write FEarthAdjustment;
65+ property SpaceAdjustment : Boolean read FSpaceAdjustment write FSpaceAdjustment;
66+
67+ property Move : Byte read FMove write FMove;
68+ property Size : Byte read FSize write FSize;
69+
70+ property RepairExpense : Integer read FRepairExpense write FRepairExpense;
71+ property Exp : SmallInt read FExp write FExp;
72+
73+ property MaxHP : Integer read FMaxHP write FMaxHP;
74+ property MaxMP : Integer read FMaxMP write FMaxMP;
75+ property Defence : Integer read FDefence write FDefence;
76+ property Speed : Integer read FSpeed write FSpeed;
77+
78+ property AirMove : Byte read FAirMove write FAirMove;
79+ property LandMove : Byte read FLandMove write FLandMove;
80+ property WaterMove : Byte read FWaterMove write FWaterMove;
81+ property SpaceMove : Byte read FSpaceMove write FSpaceMove;
82+
83+ property UnitGraphic : String read FUnitGraphic write FUnitGraphic;
84+ property Weapon : TSRCEquipList read FWeapon write SetWeapon;
85+ property Ability : TSRCAbilityList read FAbility write SetAbility;
86+ property UnitAbility : TSRCUnitAbilityList read FUnitAbility write SetUnitAbility;
87+ property Comment : TStringList read FComment write SetComment;
88+ End;
89+
90+ TSRCUnitList = Class(TSRCDataList)
91+ private
92+ function GetItems(ID:Integer):TSRCUnit;
93+ procedure SetItems(ID:Integer;val:TSRCUnit);
94+ protected
95+ function AddID(const ID:Integer):TSRCData;override;
96+ public
97+ property Items[ID:Integer]:TSRCUnit read GetItems write SetItems;default;
98+
99+ function Add(out ID : integer):TSRCUnit;overload;
100+ function Add:TSRCUnit;overload;
101+ published
102+
103+ End;
104+
105+implementation
106+
107+{TSRCUnit Func.}
108+
109+Constructor TSRCUnit.Create;
110+begin
111+ FUnitAbility := TSRCUnitAbilityList.Create;
112+ FWeapon := TSRCEquipList.Create;
113+ FAbility := TSRCAbilityList.Create;
114+
115+ FComment := TStringList.Create;
116+ { 初期値宣言 }
117+
118+ FName := '新規ユニット';
119+
120+ FAirMove := 2;
121+ FLandMove := 1;
122+ FWaterMove := 2;
123+ FSpaceMove := 2;
124+
125+ FSize := 3;
126+ FUnitGraphic := '-.bmp';
127+ FPilotNum := 1;
128+
129+ FMaxHP := 1000;
130+ FMaxMP := 100;
131+
132+ FLandAdjustment := True;
133+ FDefence := 1000;
134+ FSpeed := 60;
135+ FExp := 70;
136+ FRepairExpense := 1000;
137+ FMove := 4;
138+end;
139+
140+Destructor TSRCUnit.Destroy;
141+begin
142+ FUnitAbility.Free;
143+ FWeapon.Free;
144+ FAbility.Free;
145+
146+ FComment.Free;
147+end;
148+
149+procedure TSRCUnit.SetWeapon(val: TSRCEquipList);
150+begin
151+ FWeapon.Assign(val);
152+end;
153+
154+procedure TSRCUnit.SetAbility(val: TSRCAbilityList);
155+begin
156+ FAbility.Assign(val);
157+end;
158+
159+procedure TSRCUnit.SetUnitAbility(val: TSRCUnitAbilityList);
160+begin
161+ FUnitAbility.Assign(val);
162+end;
163+
164+procedure TSRCUnit.SetComment(val: TStringList);
165+begin
166+ FComment.Assign(val);
167+end;
168+
169+procedure TSRCUnit.AssignTo(Dest: TPersistent);
170+begin
171+ if Dest is TSRCUnit then begin
172+ TSRCUnit(Dest).Name := FName;
173+ TSRCUnit(Dest).OmissionName := FOmissionName;
174+ TSRCUnit(Dest).Syllabary := FSyllabary;
175+ TSRCUnit(Dest).UnitClass := FUnitClass;
176+ TSRCUnit(Dest).PilotNum := FPilotNum;
177+ TSRCUnit(Dest).PilotChange := FPilotChange;
178+ TSRCUnit(Dest).MaximumItems := FMaximumItems;
179+
180+ TSRCUnit(Dest).AirAdjustment := FAirAdjustment;
181+ TSRCUnit(Dest).LandAdjustment := FLandAdjustment;
182+ TSRCUnit(Dest).WaterAdjustment := FWaterAdjustment;
183+ TSRCUnit(Dest).EarthAdjustment := FEarthAdjustment;
184+ TSRCUnit(Dest).SpaceAdjustment := FSpaceAdjustment;
185+
186+ TSRCUnit(Dest).Move := FMove;
187+ TSRCUnit(Dest).Size := FSize;
188+
189+ TSRCUnit(Dest).RepairExpense := FRepairExpense;
190+ TSRCUnit(Dest).Exp := FExp;
191+
192+ TSRCUnit(Dest).UnitAbility := FUnitAbility;
193+
194+ TSRCUnit(Dest).MaxHP := FMaxHP;
195+ TSRCUnit(Dest).MaxMP := FMaxMP;
196+ TSRCUnit(Dest).Defence := FDefence;
197+ TSRCUnit(Dest).Speed := FSpeed;
198+
199+ TSRCUnit(Dest).AirMove := FAirMove;
200+ TSRCUnit(Dest).LandMove := FLandMove;
201+ TSRCUnit(Dest).WaterMove := FWaterMove;
202+ TSRCUnit(Dest).SpaceMove := FSpaceMove;
203+
204+ TSRCUnit(Dest).UnitGraphic :=FUnitGraphic ;
205+
206+ TSRCUnit(Dest).Weapon := FWeapon;
207+ TSRCUnit(Dest).Ability := FAbility;
208+
209+ TSRCUnit(Dest).Comment := FComment;
210+ end;
211+end;
212+
213+procedure TSRCUnit.WriteData(Dest:TStrings);
214+var
215+ S : String;
216+ List_CNT : Integer;
217+
218+begin
219+ if FName = '' then Dest.Add('名無しのユニット')
220+ else Dest.Add(FName);
221+
222+ S := FOmissionName + ',';
223+
224+ if FSyllabary <> '' then
225+ S := S + FSyllabary + ',';
226+
227+ S := S + FUnitClass + ',';
228+ if FPilotChange then
229+ S := S + '(' + inttostr(FPilotNum) + ')'
230+ else
231+ S := S + inttostr(FPilotNum);
232+
233+ S := S + ',' + inttostr(FMaximumItems);
234+
235+ Dest.Add(S);
236+
237+ S := '';
238+ if FAirAdjustment then S := S + '空';
239+ if FLandAdjustment then S := S + '陸';
240+ if FWaterAdjustment then S := S + '水';
241+ if FEarthAdjustment then S := S + '地中';
242+ if FSpaceAdjustment then S := S + '宇宙';
243+
244+ S := S + ',' +inttostr(FMove) + ',';
245+
246+ Case FSize of
247+ 0:S := S + 'XL';
248+ 1:S := S + 'LL';
249+ 2:S := S + 'L';
250+ 4:S := S + 'S';
251+ 5:S := S + 'SS';
252+ else S := S + 'M';
253+ End;
254+
255+ S := S + ',' + inttostr(FRepairExpense) +
256+ ',' + inttostr(FExp);
257+
258+ Dest.Add(S);
259+
260+
261+ if FUnitAbility.Count = 0 then
262+ Dest.Add('特殊能力なし')
263+ else begin
264+ Dest.Add('特殊能力');
265+ for List_CNT := 0 to FUnitAbility.Count - 1 do begin
266+ Dest.Add(FUnitAbility[List_CNT].GetString);
267+ end;
268+ end;
269+
270+ S := InttoStr(FMaxHP) + ',' + InttoStr(FMaxMP) + ',' +
271+ InttoStr(FDefence) + ',' + InttoStr(FSpeed);
272+ Dest.Add(S);
273+
274+
275+ S := RankToChar(FAirMove) + RankToChar(FLandMove) +
276+ RankToChar(FWaterMove) + RankToChar(FSpaceMove) +
277+ ',' + FUnitGraphic;
278+
279+ Dest.Add(S);
280+
281+ for List_CNT := 0 to FWeapon.Count - 1 do
282+ Dest.Add(FWeapon[List_CNT].GetString);
283+
284+ if FAbility.Count > 0 then begin
285+ Dest.Add('===');
286+
287+ for List_CNT := 0 to FAbility.Count - 1 do
288+ Dest.Add(FAbility[List_CNT].GetString);
289+ end;
290+ {Comment}
291+
292+ Dest.Add('');
293+
294+ if FComment.Count > 0 then begin
295+ for List_CNT := 0 to FComment.Count - 1 do
296+ Dest.Add('#'+FComment[List_CNT]);
297+
298+ Dest.Add('');
299+ end;
300+end;
301+
302+function TSRCUnit.ReadData(Source:TStrings;Index:Integer;var Errors:String):Boolean;
303+var
304+ Str,SubStr : String;
305+ AUnit :TSRCUnit;
306+
307+ List_CNT:Integer;
308+
309+ procedure IncNum;
310+ var
311+ SS:String;
312+ begin
313+ inc(Index);
314+ while (Source.Count > Index) do begin
315+ SS := TrimJP(Source[Index]);
316+ if StartsStr('#',SS) then
317+ inc(Index) else break;
318+ end;
319+ end;
320+
321+ procedure SendError(const Error:String);
322+ begin
323+ Result := False;
324+ if Errors <> '' then Errors := Errors + #13#10;
325+
326+ Errors := Errors + Error +'(' +
327+ inttostr(Index) + '行目)';
328+ end;
329+
330+ function StrToInt(const Val,SRCType:String):Integer;
331+ begin
332+ if not TryStrToInt(Val,Result) then begin
333+ Result := 0;
334+ SendError(SRCType + 'が数値ではありません。');
335+ end;
336+ end;
337+ function ReadLine:String;
338+ begin
339+ if Index >= Source.Count then begin
340+ SendError('項目が途切れています');
341+ Result := '';
342+ end else Result := Source[Index];
343+ end;
344+begin
345+ Result := True;
346+ Str := TrimJP(ReadLine);
347+ while (Str = '') or (StartsStr('#',Str)) do begin
348+ incNum;
349+ if Index >= Source.Count then break;
350+ Str := TrimJP(ReadLine);
351+ end;
352+
353+ if Index >= Source.Count then Exit;
354+
355+ AUnit := TSRCUnit.Create;
356+
357+ try
358+ AUnit.Name := TrimJP(ReadLine);
359+ IncNum;
360+
361+ Str := ReadLine;
362+ incNum;
363+ List_CNT := StrCount(',',Str,ifByte);
364+ AUnit.OmissionName := TrimJP(ExtractWordDem(Str));
365+
366+ if List_CNT = 4 then begin
367+ AUnit.Syllabary := TrimJP(ExtractWordDem(Str));
368+ end;
369+ AUnit.UnitClass := TrimJP(ExtractWordDem(Str));
370+
371+ SubStr := TrimJP(ExtractWordDem(Str));
372+ if StartsStr('(',SubStr) and EndsStr(')',SubStr) then begin
373+ AUnit.PilotChange := True;
374+ Delete(SubStr,1,1);
375+ Delete(SubStr,Length(SubStr),1);
376+ end;
377+ AUnit.PilotNum := StrToInt(SubStr,'パイロット数');
378+
379+ AUnit.MaximumItems := StrToInt(TrimJP(ExtractWordDem(Str)),'最大アイテム数');
380+
381+ Str := ReadLine;
382+ IncNum;
383+ SubStr := TrimJP(ExtractWordDem(Str));
384+ AUnit.AirAdjustment := inStr('空',SubStr);
385+ AUnit.LandAdjustment := inStr('陸',SubStr);
386+ AUnit.WaterAdjustment := inStr('水',SubStr);
387+ AUnit.EarthAdjustment := inStr('地中',SubStr);
388+ AUnit.SpaceAdjustment := inStr('宇宙',SubStr);
389+
390+ AUnit.Move := strtoint(ExtractWordDem(Str),'移動力');
391+
392+ SubStr := TrimJP(ExtractWordDem(Str));
393+ AUnit.Size := 2;
394+ if SubStr = 'XL' then AUnit.Size := 0;
395+ if SubStr = 'LL' then AUnit.Size := 1;
396+ if SubStr = 'L' then AUnit.Size := 2;
397+ if SubStr = 'M' then AUnit.Size := 3;
398+ if SubStr = 'S' then AUnit.Size := 4;
399+ if SubStr = 'SS' then AUnit.Size := 5;
400+
401+ AUnit.RepairExpense := strtoint(TrimJP(ExtractWordDem(Str)),'修理費');
402+ AUnit.Exp := strtoint(TrimJP(ExtractWordDem(Str)),'経験値');
403+
404+ Str := TrimJP(ReadLine);
405+ incNum;
406+
407+ if Str = '特殊能力なし' then
408+ else begin
409+ if Str = '特殊能力' then begin
410+ Str := '';
411+ SubStr := TrimJP(ReadLine);
412+ while not TryStrToInt(ExtractWordDem(SubStr),List_CNT) do begin
413+ Str := Str + ',' + ReadLine;
414+ incNum;
415+ SubStr := TrimJP(ReadLine);
416+ end;
417+ end;
418+
419+ ExtractWordDem(Str);
420+ if not AUnit.UnitAbility.AddItem(Str,Errors) then
421+ SendError('以上のエラーがユニット用特殊能力で発生しました');
422+ end;
423+ Str := ReadLine;
424+ incNum;
425+
426+ AUnit.MaxHP := strtoint(TrimJP(ExtractWordDem(Str)),'最大HP');
427+ AUnit.MaxMP := strtoint(TrimJP(ExtractWordDem(Str)),'最大EN');
428+ AUnit.Defence := strtoint(TrimJP(ExtractWordDem(Str)),'装甲');
429+ AUnit.Speed := strtoint(TrimJP(ExtractWordDem(Str)),'運動性');
430+
431+ Str := ReadLine;
432+ incNum;
433+ SubStr := Trim(ExtractWordDem(Str));
434+ if Length(SubStr) = 4 then begin
435+ AUnit.AirMove := CharToRank(SubStr[1]);
436+ AUnit.LandMove := CharToRank(SubStr[2]);
437+ AUnit.WaterMove := CharToRank(SubStr[3]);
438+ AUnit.SpaceMove := CharToRank(SubStr[4]);
439+ end else
440+ SendError('地形適応の文字数が間違っています');
441+
442+ AUnit.UnitGraphic := TrimJP(ExtractWordDem(Str));
443+
444+ if Index >= Source.Count then Exit;
445+ if ReadLine <> '' then begin
446+ Str := TrimJP(ReadLine);
447+ While (Str <> '') and (Str <> '===') do begin
448+ if not AUnit.Weapon.AddItem(Str,Errors) then
449+ SendError('武器で以上のエラーが発生しました');
450+ IncNum;
451+ if Index >= Source.Count then Break;
452+ Str := TrimJP(ReadLine);
453+ end;
454+
455+ if Index >= Source.Count then Exit;
456+
457+ if TrimJP(ReadLine) = '===' then begin
458+ IncNum;
459+ Str := TrimJP(ReadLine);
460+ While (Str <> '') and (not StartsStr('#',Str)) do begin
461+ if not AUnit.Ability.AddItem(Str,Errors) then
462+ SendError('アビリティで以上のエラーが発生しました');
463+ incNum;
464+
465+ if Index >= Source.Count then Break;
466+ Str := TrimJP(ReadLine);
467+ end;
468+ end;
469+ end;
470+ {Comment}
471+
472+ if Index >= Source.Count then Exit;
473+
474+ while TrimJP(ReadLine) = '' do begin
475+ Inc(Index);
476+ if Index >= Source.Count then break;
477+ end;
478+
479+ ReadComment(AUnit.Comment,Source,Index);
480+
481+ finally
482+ if Result then Self.Assign(AUnit);
483+
484+ AUnit.Free;
485+ end;
486+end;
487+
488+{TSRCUnitList Func.}
489+
490+procedure TSRCUnitList.SetItems(ID: Integer; val: TSRCUnit);
491+begin
492+ Inherited SetItems(ID,Val);
493+end;
494+
495+function TSRCUnitList.GetItems(ID: Integer):TSRCUnit;
496+begin
497+ Result := TSRCUnit(Inherited GetItems(ID));
498+end;
499+
500+function TSRCUnitList.AddID(const ID: Integer):TSRCData;
501+begin
502+ FItems[ID] := TSRCUnit.Create;
503+ Result := FItems[ID];
504+end;
505+
506+function TSRCUnitList.Add(out ID: Integer):TSRCUnit;
507+begin
508+ Result := TSRCUnit(Inherited Add(ID));
509+end;
510+
511+function TSRCUnitList.Add:TSRCUnit;
512+begin
513+ Result := TSRCUnit(Inherited Add);
514+end;
515+
516+end.
517+
--- MLNox/CMapChip.pas (nonexistent)
+++ MLNox/CMapChip.pas (revision 4)
@@ -0,0 +1,244 @@
1+unit CMapChip;
2+
3+interface
4+uses
5+ SysUtils,Classes,CTerrain,CMapChipBMP,CMapChipList,
6+ Graphics,CMap;
7+type
8+ TSRCMapChipList = Class(TPersistent)
9+ private
10+ FLands : Array of TSRCLandData;
11+ FBitmaps : Array of TSRCLandBitmaps;
12+ FGameDir : String;
13+ FSRCDir : String;
14+ FMaxJanreBitmaps : Word;
15+ function GetLands(const ID : Integer):TSRCLandData;
16+ procedure SetLands(const ID : Integer;val:TSRCLandData);
17+ function GetCount : integer;
18+ public
19+ Destructor Destroy;override;
20+ procedure Clear;
21+ procedure ClearBitmaps;
22+ procedure LoadTerrains;
23+ procedure MakeList;{only for Map Editor}
24+ property Lands[const ID : Integer]:TSRCLandData read GetLands write SetLands;default;
25+ property Count : Integer read GetCount;
26+
27+ function GetBitmap(const Janre,Chip:Integer):TBitmap;
28+ function GetBitmapfromID(const ID,Chip:Integer):TBitmap;
29+ function GetCanvas(Chip:TSRCMapChip):TCanvas;
30+ published
31+ property GameDir : String read FGameDir write FGameDir;
32+ property SRCDir : String read FSRCDir write FSRCDir;
33+ property MaxJanreBitmaps : Word read FMaxJanreBitmaps write FMaxJanreBitmaps;
34+ end;
35+implementation
36+
37+{TSRCLandDataList Funx.}
38+
39+Destructor TSRCMapChipList.Destroy;
40+begin
41+ Clear;
42+ inherited;
43+end;
44+
45+function TSRCMapChipList.GetLands(const ID : Integer):TSRCLandData;
46+begin
47+ Result := FLands[ID];
48+end;
49+
50+procedure TSRCMapChipList.SetLands(const ID:Integer;val:TSRCLandData);
51+begin
52+ FLands[ID].Assign(val);
53+end;
54+
55+function TSRCMapChipList.GetCount;
56+begin
57+ if Assigned(FLands) then
58+ Result := Length(FLands) else Result := 0;
59+end;
60+
61+procedure TSRCMapChipList.Clear;
62+var
63+ Land_CNT : Integer;
64+begin
65+ for Land_CNT := 0 to GetCount - 1 do begin
66+ FLands[Land_CNT].Free;
67+ FBitmaps[Land_CNT].Free;
68+ end;
69+ SetLength(FLands,0);
70+ SetLength(FBitmaps,0);
71+end;
72+
73+procedure TSRCMapChipList.LoadTerrains;
74+var
75+ Terrains : TSRCTerrainList;
76+ Land : TSRCLandData;
77+ Ter_CNT,FCount : Integer;
78+ function AddLandData(ID:Integer):TSRCLandData;
79+ var Land_CNT : Integer;
80+ begin
81+ for Land_CNT := 0 to FCount - 1 do begin
82+ if FLands[Land_CNT].ID = ID then begin
83+ Result := FLands[Land_CNT];
84+ Exit;
85+ end;
86+ end;
87+ if FCount = GetCount then
88+ SetLength(FLands,FCount + 10);
89+ FLands[FCount] := TSRCLandData.Create;
90+ Result := FLands[FCount];
91+ inc(FCount);
92+ end;
93+begin
94+ if FSRCDir = '' then Exit;
95+ //if FGameDir = '' then Exit;
96+ if not FileExists(FSRCDir + 'Data\System\Terrain.txt') then Exit;
97+ Clear;
98+ FCount := 0;
99+
100+ Terrains := TSRCTerrainList.Create;
101+ Terrains.LoadFromFile(FSRCDir + 'Data\System\Terrain.txt');
102+
103+ for Ter_CNT := 0 to Terrains.Count - 1 do begin
104+ Land := AddLandData(Terrains[Ter_CNT].ID);
105+ Land.Caption := Terrains[Ter_CNT].Name;
106+ Land.FileName := Terrains[Ter_CNT].FileName;
107+ Land.ID := Terrains[Ter_CNT].ID;
108+ Land.Visible := Terrains[Ter_CNT].LandEffect.IndexOf('エディタ非表示') < 0;
109+ end;
110+
111+ if FGameDir <> '' then begin
112+ if FileExists(FGameDir + 'Data\System\Terrain.txt') then begin
113+ Terrains.LoadFromFile(FGameDir + 'Data\System\Terrain.txt');
114+
115+ for Ter_CNT := 0 to Terrains.Count - 1 do begin
116+ Land := AddLandData(Terrains[Ter_CNT].ID);
117+ Land.Caption := Terrains[Ter_CNT].Name;
118+ Land.FileName := Terrains[Ter_CNT].FileName;
119+ Land.ID := Terrains[Ter_CNT].ID;
120+ Land.Visible := Terrains[Ter_CNT].LandEffect.IndexOf('エディタ非表示') < 0;
121+ end;
122+ end;
123+ end;
124+
125+ Terrains.Free;
126+ SetLength(FLands,FCount);
127+ SetLength(FBitmaps,FCount);
128+ for Ter_CNT := 0 to FCount - 1 do
129+ FBitmaps[Ter_CNT] := TSRCLandBitmaps.Create;
130+end;
131+
132+procedure TSRCMapChipList.MakeList;
133+var
134+ Ter_CNT : Integer;
135+begin
136+ for Ter_CNT := 0 to GetCount - 1 do begin
137+ FLands[Ter_CNT].MakeList(FSRCDir,FGameDir);
138+ if (FLands[Ter_CNT].Numeric.Count = 0) and
139+ (FLands[Ter_CNT].Local.Count = 0) then
140+ FLands[Ter_CNT].Visible := False;
141+ end;
142+end;
143+
144+function TSRCMapChipList.GetBitmapfromID(const ID,Chip:Integer):TBitmap;
145+var
146+ GameMapBace,SRCMapBace,FN,CID :String;
147+begin
148+ Result := FBitmaps[ID][Chip];
149+ if Result <> NIL then Exit;
150+
151+ {存在しなかったのでロードします}
152+ if (FMaxJanreBitmaps > 0) and (FBitmaps[ID].Count > FMaxJanreBitmaps) then
153+ FBitmaps[ID].Clear;
154+
155+ FN := FLands[ID].FileName;
156+
157+ CID := IntTostr(abs(Chip));
158+ if CID = '10000' then begin
159+ Result := NIL;
160+ Exit;
161+ end;
162+
163+ while Length(CID) < 4 do CID := '0' + CID;
164+ if Chip < 0 then CID := '-' + CID;
165+
166+ GameMapBace := FGameDir + 'Bitmap\Map\' + FN;
167+ SRCMapBace := FSRCDir + 'Bitmap\Map\' + FN;
168+
169+ if FileExists(GameMapBace + '\' + FN + CID +'.bmp') then
170+ FN := GameMapBace + '\' + FN + CID + '.bmp'
171+ else if FileExists(GameMapBace + CID +'.bmp') then
172+ FN := GameMapBace + CID + '.bmp'
173+ else if FileExists(GameMapBace + inttostr(Chip) +'.bmp') then
174+ FN := GameMapBace + inttostr(Chip) + '.bmp'
175+ else if FileExists(SRCMapBace + '\' + FN + CID +'.bmp') then
176+ FN := SRCMapBace + '\' + FN + CID + '.bmp'
177+ else if FileExists(SRCMapBace + CID +'.bmp') then
178+ FN := SRCMapBace + CID + '. bmp'
179+ else if FileExists(SRCMapBace + inttostr(Chip) +'.bmp') then
180+ FN := SRCMapBace + inttostr(Chip) + '.bmp'
181+ else begin
182+ Result := NIL;
183+ //Assert(False,'Result NIL!');
184+ Exit;
185+ end;
186+ {
187+ LB := FBitmaps[ID].Add;
188+ LB.LoadBitmap(FN);
189+ }
190+
191+ Result := FBitmaps[ID].LoadBitmapFromFile(Chip,FN);
192+end;
193+
194+function TSRCMapChipList.GetBitmap(const Janre,Chip:Integer):TBitmap;
195+var
196+ Ter_CNT : Integer;
197+ LandID : Integer;
198+ //LB : TSRCLandBitmap;
199+begin
200+ LandID := - 1;
201+ Result := NIL;
202+ if (Janre = 10000) or (Chip = 10000) then Exit;
203+
204+ for Ter_CNT := 0 to GetCount - 1 do begin
205+ if FLands[Ter_CNT].ID = Janre then begin
206+ LandID := Ter_CNT;
207+ break;
208+ end;
209+ end;
210+ if (LandID = - 1) then begin
211+ if Result = NIL then Assert(False,'Result=NIL!');
212+ Exit;
213+ end;
214+
215+ {for Ter_CNT := 0 to FBitmaps[LandID].Count - 1 do begin
216+ if FBitmaps[LandID][Ter_CNT].ID = Chip then begin
217+ Result := FBitmaps[LandID][Ter_CNT].Bitmap;
218+ break;
219+ end;
220+ end;
221+ if Result <> NIL then Exit;
222+ }
223+
224+ Result := GetBitmapFromID(LandID,Chip);
225+end;
226+
227+function TSRCMapChipList.GetCanvas(Chip:TSRCMapChip):TCanvas;
228+var
229+ BMP : TBitmap;
230+begin
231+ Result := NIL;
232+ BMP := Self.GetBitmap(Chip.Janre,Chip.ID);
233+ if Assigned(BMP) then Result := BMP.Canvas;
234+end;
235+
236+procedure TSRCMapChipList.ClearBitmaps;
237+var
238+ BMP_CNT : Integer;
239+begin
240+ for BMP_CNT := 0 to GetCount - 1 do
241+ FBitmaps[BMP_CNT].Clear;
242+end;
243+
244+end.
--- MLNox/CNoxPrintEvent.pas (nonexistent)
+++ MLNox/CNoxPrintEvent.pas (revision 4)
@@ -0,0 +1,306 @@
1+unit CNoxPrintEvent;
2+
3+interface
4+uses
5+ SysUtils,Classes,StringUnitLight,NCommon,CMap,CNox, MMap;
6+
7+type
8+ TStrObject = Class(TObject)
9+ //別にTPersistentにする必要はない
10+ public
11+ ID : String;
12+ Index : Integer;
13+ Value : String;
14+ End;
15+
16+ TStrObjectList = Class(TList)
17+ private
18+ function Get(const Index: Integer): TStrObject;
19+ procedure Put(const Index: Integer; const Value: TStrObject);
20+ public
21+ destructor Destroy;override;
22+ procedure Clear;override;
23+ procedure Delete(Index: Integer);
24+ function Add(const Data:TNoxCreateCommand):Integer;
25+ property Items[const Index:Integer]:TStrObject read Get write Put;default;
26+ procedure Sort;
27+ published
28+ End;
29+
30+ {How to Use TNoxEventPrinter...
31+ FMapFileにマップファイル名を入力し、
32+ FMapDataにそのマップデータを叩き込みます。
33+ このとき、Noxの仕様から同時読込には対応しません。
34+
35+ それが入力されたら、FNoxCommandsにデータを挿入します。
36+ イベントからデータをロードしてください。
37+ FCommandsの中身は、ストリームを読み出すごとにリセットされます。
38+
39+ メソッドはセーブ時、以前の設定を自動で消去します。
40+ イベントデータは最後の行に自動で挿入されます。
41+ どこに入れても無駄です。位置なんて保存してくれません。
42+ }
43+
44+ TNoxEventPrinter = Class(TObject)
45+ private
46+ FMapFile : String;
47+ FMapData : TSRCMapData;
48+ FCommands : TNoxCreateCommandList;
49+ FLayerSaved: Boolean;
50+ procedure writeMapFile(const Value: String);
51+ public
52+ Destructor Destroy;override;
53+ procedure LoadFromFile(const FileName : String);
54+ procedure SaveToFile(const FileName : String);
55+ procedure LoadFromStream(Stream:TStrings);
56+ procedure SaveToStream(Stream:TStrings);
57+ published
58+ property MapFile : String read FMapFile write writeMapFile;
59+ property MapData : TSRCMapData read FMapData write FMapData;
60+ property Commands : TNoxCreateCommandList write FCommands;
61+ property MapLayerSaved : Boolean read FLayerSaved;
62+ End;
63+
64+implementation
65+
66+function SortStrObj(Item1,Item2:Pointer):Integer;
67+begin
68+ Result := CompareStr(TStrObject(Item1).ID,TStrObject(Item2).ID);
69+ if Result = 0 then Result := TStrObject(Item1).Index - TStrObject(Item2).Index;
70+end;
71+
72+{ TStrObjectList }
73+
74+destructor TStrObjectList.Destroy;
75+begin
76+ Clear;
77+ inherited;
78+end;
79+
80+function TStrObjectList.Get(const Index: Integer): TStrObject;
81+begin
82+ Result := TStrObject(Inherited Get(Index));
83+end;
84+
85+procedure TStrObjectList.Put(const Index: Integer; const Value: TStrObject);
86+begin
87+ Inherited Items[Index] := Value;
88+end;
89+
90+procedure TStrObjectList.Sort;
91+begin
92+ Inherited Sort(SortStrObj);
93+end;
94+
95+function TStrObjectList.Add(const Data: TNoxCreateCommand): Integer;
96+begin
97+ Result := Inherited Add(TStrObject.Create);
98+ TStrObject(Get(Result)).ID := Data.SceneID;
99+ TStrObject(Get(Result)).Index := Result;
100+ TStrObject(Get(Result)).Value := Data.GetData;
101+end;
102+
103+procedure TStrObjectList.Clear;
104+var LC: Integer;
105+begin
106+ for LC := 0 to Count - 1 do Items[LC].Free;
107+ inherited;
108+end;
109+
110+procedure TStrObjectList.Delete(Index: Integer);
111+begin
112+ Items[Index].Free;
113+ inherited Delete(Index);
114+end;
115+
116+{ TNoxEventPrinter }
117+
118+destructor TNoxEventPrinter.Destroy;
119+begin
120+ inherited;
121+end;
122+
123+procedure TNoxEventPrinter.writeMapFile(const Value: String);
124+begin
125+ FMapFile := ChangeFileExt(ExtractFileName(Value),'');
126+end;
127+
128+procedure TNoxEventPrinter.LoadFromFile(const FileName: String);
129+var SL : TStringList;
130+begin
131+ SL := TStringList.Create;
132+ try
133+ SL.LoadFromFile(FileName);
134+ LoadFromStream(SL);
135+ finally
136+ SL.Free;
137+ end;
138+end;
139+
140+procedure TNoxEventPrinter.LoadFromStream(Stream: TStrings);
141+var
142+ SL : TStringList;
143+ LC,DC: Integer;
144+ S,SceneID : String;
145+ NU : TNoxCreateCommand;
146+begin
147+ SL := TStringList.Create;
148+ NU := TNoxCreateCommand.Create;
149+ FCommands.Clear;
150+ try
151+ LC := 0;
152+ while LC < Stream.Count do begin
153+ if not StartsText('登場[' + MapFile + ',',TrimJP(Stream[LC])) then begin
154+ inc(LC);
155+ Continue;
156+ end;
157+ S := TrimJP(Stream[LC]);
158+ Delete(S,Length(S) - 1,2);
159+ Delete(S,1,Length('登場[' + MapFile + ','));
160+ {S is SceneID}
161+ SL.Clear;
162+ SceneID := S;
163+ inc(LC);
164+ while LC < Stream.Count do begin
165+ if SameText('return',Stream[LC]) then break;
166+ SL.Add(Stream[LC]);
167+ inc(LC);
168+ end;
169+
170+ for DC := 0 to SL.Count - 1 do begin
171+ S := '';
172+ if NU.SetFromStrings(SL,DC,S) then begin
173+ NU.SceneID := SceneID;
174+ FCommands.Add.Assign(NU);
175+ end;
176+ end;
177+ end;
178+
179+ finally
180+ SL.Free;
181+ NU.Free;
182+ end;
183+end;
184+
185+procedure TNoxEventPrinter.SaveToFile(const FileName: String);
186+var SL : TStringList;
187+begin
188+ SL := TStringList.Create;
189+ try
190+ if FileExists(FileName) then SL.LoadFromFile(FileName);
191+ SaveToStream(SL);
192+ SL.SaveToFile(FileName);
193+ finally
194+ SL.Free;
195+ end;
196+end;
197+
198+procedure TNoxEventPrinter.SaveToStream(Stream: TStrings);
199+var
200+ LC: Integer;
201+ SceneID : String;
202+ SL : TStrObjectList;
203+ Y_CNT,X_CNT: Integer;
204+ Strs : TStringList;
205+ function GetPlace(const Brinch : String = ' ') : String;
206+ begin
207+ Result := inttostr(X_CNT + 1) + Brinch + inttostr(Y_CNT + 1);
208+ end;
209+ function PrintPaintPicture(const Picture:String):String;
210+ begin
211+ Result := 'PaintPicture ' + Picture + ' ' + inttostr(32 * X_CNT) + ' ' +
212+ inttostr(32 * Y_CNT) + ' 32 32 背景';
213+ end;
214+begin
215+ LC := 0;
216+ FLayerSaved := False;
217+ {Eracer}
218+ while LC < Stream.Count do begin
219+ SceneID := TrimJP(Stream[LC]);
220+ if not StartsText('登場[' + MapFile + ',',SceneID) and
221+ (MapFile + '_上部レイヤ描画実行:' <> SceneID) then begin
222+ inc(LC);
223+ Continue;
224+ end;
225+ if (StartsText('登場[' + MapFile + ',',SceneID) and (FCommands = NIL)) or
226+ ((MapFile + '_上部レイヤ描画実行:' = SceneID) and (FMapData = NIL)) then begin
227+ Inc(LC);
228+ Continue;
229+ end;
230+
231+ while LC < Stream.Count do begin
232+ if SameText('return',Stream[LC]) then break;
233+ Stream.Delete(LC);
234+ end;
235+ Stream.Delete(LC);
236+ if (Stream.Count > LC) and (Stream[LC] = '') then Stream.Delete(LC);
237+ end;
238+
239+ {Unit Maker}
240+ if Assigned(FCommands) then begin
241+ SL := TStrObjectList.Create;
242+ for LC := 0 to FCommands.Count - 1 do SL.Add(FCommands[LC]);
243+ SL.Sort;
244+
245+ if SL.Count > 0 then begin
246+ if (Stream.Count > 0) and (Stream[Stream.Count - 1] <> '') then
247+ Stream.Add('');
248+ SceneID := SL[0].ID;
249+ Stream.Add('登場[' + MapFile + ',' + SL[0].ID + ']:');
250+ for LC := 0 to SL.Count - 1 do begin
251+ if SceneID <> SL[LC].ID then begin
252+ Stream.Add('Return');
253+ Stream.Add('');
254+ Stream.Add('登場[' + MapFile + ',' + SL[LC].ID + ']:');
255+ SceneID := SL[LC].ID;
256+ end;
257+ Stream.Add(SL[LC].Value);
258+ end;
259+ Stream.Add('Return');
260+ end;
261+ SL.Free;
262+ end;
263+ {Ground Maker}
264+ if Assigned(FMapData) and (FMapData.Count > 1) then begin
265+ if MapModule.SRCDir = '' then Exit;
266+ LC := 0;
267+ Strs := TStringList.Create;
268+ if (Stream.Count > 0) and (Stream[Stream.Count - 1] <> '') then
269+ Stream.Add('');
270+
271+ for Y_CNT := 0 to FMapData[1].Height - 1 do begin
272+ for X_CNT := 0 to FMapData[1].Width - 1 do begin
273+ if EqTile(FMapData[1][X_CNT,Y_CNT],NullTile) then Continue;
274+ if LC = 0 then begin
275+ {First}
276+ Stream.Add(MapFile + '_上部レイヤ描画実行:');
277+ Stream.Add('If Args(1) <> "再開" Then');
278+
279+ Inc(LC);
280+ end;
281+
282+ Stream.Add('_LayerBackUp[' + MapFile + ',' + GetPlace(',') + '] = ' +
283+ 'Info(マップ,' + GetPlace(',') + ',ビットマップ名)');
284+
285+ Strs.Add('ChangeTerrain ' + GetPlace + ' ' +
286+ MapModule.GetChipJanreName(FMapData[1].Chips[X_CNT,Y_CNT].Janre) + ' '
287+ + inttostr(FMapData[1].Chips[X_CNT,Y_CNT].ID));
288+ Strs.Add(PrintPaintPicture('_LayerBackUp[' + MapFile + ',' +
289+ GetPlace(',') + ']'));
290+ Strs.Add(PrintPaintPicture(MapModule.GetMapBMPName(FMapData[1].Chips[X_CNT,Y_CNT])));
291+ end;
292+ end;
293+ if LC > 0 then begin
294+ Stream.Add('EndIf');
295+ Stream.AddStrings(Strs);
296+ Stream.Add('# 他のイベントで中途半端に描画されないように' +
297+ 'この時点でRedrawする');
298+ Stream.Add('Redraw');
299+ Stream.Add('Return');
300+ FLayerSaved := True;
301+ end else FLayerSaved := False;
302+ Strs.Free;
303+ end else FLayerSaved := False;
304+end;
305+
306+end.
--- MLNox/MMap.pas (nonexistent)
+++ MLNox/MMap.pas (revision 4)
@@ -0,0 +1,486 @@
1+unit MMap;
2+
3+
4+interface
5+
6+uses
7+ SysUtils, Classes,CMapChip, CMap,Windows,Graphics,CNox,CUnit,ABitmap,CMapUndo;
8+
9+type
10+ TMapListDrawType = (mldtCllasic,mldtNumeric,mldtCustom);
11+
12+ TMapModule = class(TDataModule)
13+ procedure DataModuleCreate(Sender: TObject);
14+ procedure DataModuleDestroy(Sender: TObject);
15+ private
16+ { Private 宣言 }
17+ FGameDir,FSRCDir : String;
18+ FChips : TSRCMapChipList;
19+ FUnitBackGround : TBitmap;
20+ procedure SetUpChips;
21+
22+ function GetJanreID(Index:Integer):Integer;
23+ function GetMJB : Word;
24+ procedure SetMJB(const val:Word);
25+ public
26+ { Public 宣言 }
27+ procedure SetGameDir(val:String);
28+ procedure SetSRCDir(val:String);
29+ procedure ClearBitmaps;
30+ property Chips : TSRCMapChipList read FChips;
31+ property GameDir : String read FGameDir write SetGameDir;
32+ property SRCDir : String read FSRCDir write SetSRCDir;
33+
34+ procedure GetMapList(Strings:TStrings);
35+ function JanreToIndex(const Janre : Integer): Integer;
36+ procedure MakeMapList(Index:Integer;Draw : TMapListDrawType;Bitmap:TBitmap);
37+ function GetMapChipIndex(DrawType : TMapListDrawType;const JanreIndex,ChipIndex:Integer):TSRCMapChip;
38+ function GetMapBMPName(const Chip:TSRCMapChip):String;
39+ function GetChipJanreName(const Index:Integer):String;
40+
41+ procedure CopyToCanvas(Canvas:TCanvas;const X,Y,Janre,Chip:Integer);
42+ property MaxJanreBitmaps : Word read GetMJB write SetMJB;
43+
44+ procedure PutUnit(Items:TNoxCreateCommandList;ID:Integer;Bitmap:TBitmap);overload;
45+ procedure PutUnit(Item:TNoxCreateCommand;Bitmap:TBitmap);overload;
46+ procedure PutTile(Map:TSRCMapData;Bitmap:TBitmap;const X,Y:Integer);
47+ procedure PutAllUnit(Units : TNoxCreateCommandList;Bitmap : TBitmap;
48+ const PutID: String);
49+ end;
50+
51+var
52+ MapModule: TMapModule;
53+
54+implementation
55+
56+{$R *.dfm}
57+{$R 'NoxForm.res' 'NoxForm.rc'}
58+
59+procedure TMapModule.DataModuleCreate(Sender: TObject);
60+begin
61+ FChips := TSRCMapChipList.Create;
62+
63+ FUnitBackGround := TBitmap.Create;
64+ FUnitBackGround.LoadFromResourceName(hInstance,'NoxIcon');
65+end;
66+
67+procedure TMapModule.DataModuleDestroy(Sender: TObject);
68+begin
69+ FChips.Free;
70+ FUnitBackGround.Free;
71+end;
72+
73+procedure TMapModule.SetGameDir(val:String);
74+begin
75+ val := IncludeTrailingPathDelimiter(val);
76+
77+ if DirectoryExists(val + 'Data\') then begin
78+ FGameDir := val;
79+ SetupChips;
80+ end else if (Val = '\') then begin
81+ FGameDir := '';
82+ FChips.GameDir := FGameDir;
83+ //SetupChips;
84+ end;
85+end;
86+
87+procedure TMapModule.SetSRCDir(val:String);
88+begin
89+ val := IncludeTrailingPathDelimiter(val);
90+
91+ if FileExists(val + 'SRC.exe') then begin
92+ FSRCDir := val;
93+ SetupChips;
94+ end;
95+end;
96+
97+procedure TMapModule.SetupChips;
98+begin
99+ if (FSRCDir <> '') {and (FGameDir <> '')} then begin
100+ FChips.GameDir := FGameDir;
101+ FChips.SRCDir := FSRCDir;
102+ FChips.LoadTerrains;
103+ end;
104+end;
105+
106+function TMapModule.GetMJB:Word;
107+begin
108+ Result := FChips.MaxJanreBitmaps;
109+end;
110+
111+procedure TMapModule.SetMJB(const val:Word);
112+begin
113+ FChips.MaxJanreBitmaps := val;
114+end;
115+
116+procedure TMapModule.ClearBitmaps;
117+begin
118+ FChips.ClearBitmaps;
119+end;
120+
121+procedure TMapModule.GetMapList(Strings:TStrings);
122+var
123+ List_CNT : Integer;
124+begin
125+ FChips.MakeList;
126+ Strings.Clear;
127+ for List_CNT := 0 to FChips.Count - 1 do begin
128+ if FChips.Lands[List_CNT].Visible then
129+ Strings.Add(FChips.Lands[List_CNT].Caption);
130+ end;
131+end;
132+
133+function TMapModule.JanreToIndex(const Janre: Integer): Integer;
134+var
135+ LC, Res: Integer;
136+begin
137+ Res := 0;
138+ for LC := 0 to FChips.Count - 1 do begin
139+ if not FChips.Lands[LC].Visible then Inc(Res)
140+ else if FChips.Lands[LC].ID = Janre then begin
141+ Result := LC - Res;
142+ Exit;
143+ end;
144+ end;
145+ Result := - 1;
146+end;
147+
148+function TMapModule.GetJanreID(Index:Integer):Integer;
149+var
150+ List_CNT:Integer;
151+begin
152+ Result := - 1;
153+ for List_CNT := 0 to FChips.Count - 1 do begin
154+ if FChips.Lands[List_CNT].Visible then begin
155+ if Index > 0 then Dec(Index) else begin
156+ Result := List_CNT;
157+ break;
158+ end;
159+ end;
160+ end;
161+end;
162+
163+function TMapModule.GetChipJanreName(const Index: Integer): String;
164+var
165+ LC: Integer;
166+begin
167+ for LC := 0 to FChips.Count - 1 do
168+ if FChips.Lands[LC].ID = Index then begin
169+ Result := FChips.Lands[LC].Caption;
170+ Exit;
171+ end;
172+ Result := '';
173+end;
174+
175+procedure TMapModule.MakeMapList(index:Integer;Draw:TMapListDrawType;Bitmap:TBitmap);
176+var
177+ List_CNT,ChipID,Local,Numeric : Integer;
178+ LeftBase,TopBase : Integer;
179+begin
180+ ChipID := Self.GetJanreID(Index);
181+ if ChipID = - 1 then begin
182+ Bitmap.Width := 0;
183+ Bitmap.Height := 0;
184+ Exit;
185+ end;
186+ Case Draw of
187+ mldtCllasic : begin
188+ Bitmap.Width := 96;
189+ Numeric := FChips[ChipID].Numeric.Count;
190+ Local := FChips[ChipID].Local.Count;
191+ List_CNT := (Numeric + Local) div 3;
192+ if (Numeric + Local) mod 3 > 0 then inc(List_CNT);
193+ Bitmap.Height := List_CNT * 32;
194+ Bitmap.Canvas.Brush.Color := clBtnFace;
195+ Bitmap.Canvas.Rectangle(-1,Bitmap.Height - 33,97,Bitmap.Height + 1);
196+
197+ for List_CNT := 0 to Numeric - 1 do begin
198+ BitBlt(Bitmap.Canvas.Handle,(List_CNT mod 3) shl 5,
199+ (List_CNT div 3) * 32,32,32,
200+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Numeric[List_CNT]).Canvas.Handle,0,0,SRCCopy);
201+ end;
202+
203+ for List_CNT := 0 to Local - 1 do begin
204+ BitBlt(Bitmap.Canvas.Handle,((Numeric + List_CNT) mod 3) shl 5,
205+ ((Numeric + List_CNT) div 3) * 32,32,32,
206+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Local[List_CNT]).Canvas.Handle,0,0,SRCCopy);
207+ end;
208+ end;
209+ mldtNumeric : begin
210+ Bitmap.Width := 192;
211+ Numeric := FChips[ChipID].Numeric.Count;
212+ Local := FChips[ChipID].Local.Count;
213+ List_CNT := (Numeric + Local) div 3;
214+ if (Numeric + Local) mod 3 > 0 then Inc(List_CNT);
215+
216+ {列数。８列ごとにスペースを切り替える。
217+ そのため、and 8 がTrueならスペースは右に余る計算になる}
218+
219+ if List_CNT and 8 > 0 then
220+ Bitmap.Height := ((List_CNT shr 4) + 1) shl 5
221+ else begin
222+ Bitmap.Height := ((List_CNT shr 1 and $FFFFFFF8) + (List_CNT and 7)) shl 5;
223+ end;
224+
225+ Bitmap.Canvas.Brush.Color := clBtnFace;
226+ Bitmap.Canvas.Rectangle(-1,-1,193,Bitmap.Height + 1);
227+
228+ //24個チップを描くごとにベースを切り替える
229+ LeftBase := 0;
230+ TopBase := 0;
231+ for List_CNT := 0 to Numeric - 1 do begin
232+ BitBlt(Bitmap.Canvas.Handle,LeftBase + (List_CNT mod 3) shl 5,
233+ TopBase + ((List_CNT div 3) and 7) shl 5,32,32,
234+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Numeric[List_CNT]).Canvas.Handle,0,0,SRCCopy);
235+
236+ if List_CNT mod 24 = 23 then begin
237+ if LeftBase > 0 then begin
238+ LeftBase := 0;
239+ Inc(TopBase, 32 * 8);
240+ end else LeftBase := 96;
241+ end;
242+ end;
243+
244+ for List_CNT := 0 to Local - 1 do begin
245+ BitBlt(Bitmap.Canvas.Handle,LeftBase + ((Numeric + List_CNT) mod 3) shl 5,
246+ TopBase + (((Numeric + List_CNT) div 3) and 7) shl 5,32,32,
247+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Local[List_CNT]).Canvas.Handle,0,0,SRCCopy);
248+
249+ if List_CNT div 24 = 23 then begin
250+ if LeftBase > 0 then begin
251+ LeftBase := 0;
252+ Inc(TopBase, 32 * 8);
253+ end else LeftBase := 96;
254+ end;
255+ end;
256+ end;
257+ mldtCustom : begin
258+ Bitmap.Width := 192;
259+ Numeric := FChips[ChipID].Custom.Count;
260+ Local := FChips[ChipID].Local.Count;
261+
262+ List_CNT := (Local div 3);
263+ if (Numeric + Local) mod 3 > 0 then Inc(List_CNT);
264+
265+ if List_CNT and 8 > 0 then
266+ Bitmap.Height := (Numeric div 6 + ((List_CNT shr 4) + 1)) shl 5
267+ else begin
268+ Bitmap.Height := (Numeric div 6 + (List_CNT shr 1 and $FFFFFFF8) +
269+ (List_CNT and 7)) shl 5;
270+ end;
271+
272+ Bitmap.Canvas.Brush.Color := clBtnFace;
273+ Bitmap.Canvas.Rectangle(-1,-1,193,Bitmap.Height + 1);
274+
275+ for List_CNT := 0 to Numeric - 1 do begin
276+ if FChips[ChipID].Custom[List_CNT] = 10000 then Continue;
277+
278+ BitBlt(Bitmap.Canvas.Handle,(List_CNT mod 6) * 32,
279+ (List_CNT div 6) * 32,32,32,
280+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Custom[List_CNT]).Canvas.Handle,0,0,SRCCopy);
281+ end;
282+ LeftBase := 0;
283+ TopBase := (Numeric div 6) * 32;
284+ for List_CNT := 0 to Local - 1 do begin
285+ BitBlt(Bitmap.Canvas.Handle,LeftBase + (List_CNT mod 3) * 32,
286+ TopBase + (List_CNT div 3) * 32,32,32,
287+ FChips.GetBitmapFromID(ChipID,FChips[ChipID].Local[List_CNT]).Canvas.Handle,0,0,SRCCopy);
288+
289+ if (Numeric + List_CNT) div 39 = 38 then begin
290+ if LeftBase > 0 then begin
291+ LeftBase := 0;
292+ Inc(TopBase, 32 * 13);
293+ end else LeftBase := 96;
294+ end;
295+ end;
296+ end;
297+ End;
298+end;
299+
300+function TMapModule.GetMapChipIndex(DrawType : TMapListDrawType;const JanreIndex,ChipIndex:Integer):TSRCMapChip;
301+var
302+ JanreID : Integer;
303+ MC : TSRCMapChip;
304+begin
305+ JanreID := GetJanreID(JanreIndex);
306+ MC.Janre := FChips[JanreID].ID;
307+ Case DrawType of
308+ mldtCllasic : begin
309+ if FChips[JanreID].Numeric.Count > ChipIndex then
310+ MC.ID := FChips[JanreID].Numeric[ChipIndex]
311+ else begin
312+ if FChips[JanreID].Numeric.Count + FChips[JanreID].Local.Count > ChipIndex then begin
313+ MC.ID := FChips[JanreID].Local[ChipIndex - FChips[JanreID].Numeric.Count];
314+ end else MC.ID := -32768;
315+ end;
316+ end;
317+ mldtNumeric : begin
318+ if FChips[JanreID].Numeric.Type6[ChipIndex] <> 10000 then
319+ MC.ID := FChips[JanreID].Numeric.Type6[ChipIndex]
320+ else if FChips[JanreID].Local.Type6[ChipIndex - FChips[JanreID].Numeric.Count] <> 10000 then begin
321+ MC.ID := FChips[JanreID].Local.Type6[ChipIndex - FChips[JanreID].Numeric.Count];
322+ end else MC.ID := -32768;
323+ end;
324+ mldtCustom : begin
325+ if FChips[JanreID].Custom.Count > ChipIndex then
326+ MC.ID := FChips[JanreID].Custom[ChipIndex]
327+ else begin
328+ if FChips[JanreID].Custom.Count + FChips[JanreID].Local.Count >= ChipIndex then begin
329+ MC.ID := FChips[JanreID].Custom[ChipIndex - FChips[JanreID].Custom.Count];
330+ end else MC.ID := -32768;
331+ end;
332+ end;
333+ End;
334+ Result := mc;
335+end;
336+
337+function TMapModule.GetMapBMPName(const Chip:TSRCMapChip):String;
338+var
339+ List_CNT : Integer;
340+ S : String;
341+begin
342+ Result := '';
343+ for List_CNT := 0 to FChips.Count - 1 do begin
344+ if FChips.Lands[List_CNT].ID = Chip.Janre then begin
345+ Result := FChips.Lands[List_CNT].FileName;
346+ break;
347+ end;
348+ end;
349+
350+ if Result <> '' then begin
351+ if Chip.ID < 0 then begin
352+ S := Inttostr( - Chip.ID);
353+ while Length(S) < 4 do S := '0' + S;
354+ Result := Result + '-' + S + '.bmp';
355+ end else begin
356+ S := Inttostr(Chip.ID);
357+ while Length(S) < 4 do S := '0' + S;
358+ Result := Result + S + '.bmp';
359+ end;
360+ end;
361+end;
362+
363+procedure TMapModule.CopyToCanvas(Canvas : TCanvas;const X,Y,Janre,Chip:Integer);
364+var
365+ BMP : TBitmap;
366+begin
367+ if (FSRCDir = '') then Exit;
368+
369+ BMP := FChips.GetBitmap(Janre,Chip);
370+ if Assigned(BMP) then
371+ BitBlt(Canvas.Handle,X,Y,32,32,BMP.Canvas.Handle,0,0,SRCCopy);
372+end;
373+
374+procedure TMapModule.PutUnit(Items:TNoxCreateCommandList;ID:Integer;Bitmap:TBitmap);
375+begin
376+ PutUnit(Items[ID],Bitmap);
377+end;
378+
379+procedure TMapModule.PutUnit(Item:TNoxCreateCommand;Bitmap:TBitmap);
380+var
381+ BMP : TABitmap;
382+ S : String;
383+
384+ function HSRect(const x,y,w,h:Integer):TRect;
385+ begin
386+ Result := Rect(x,y,x+w,y+h);
387+ end;
388+
389+ function FindUnitGraphic : String;
390+ var
391+ UnitList : TSRCUnitList;
392+ List_CNT : Integer;
393+ SR : TSearchRec;
394+ begin
395+ UnitList := TSRCUnitList.Create;
396+ Result := '';
397+ try
398+ if FindFirst(FGameDir +'\Data\*.*',faDirectory, sr) = 0 then begin
399+ repeat
400+ if ((sr.Attr and faDirectory) <> 0 ) and ( Sr.Name <>'..' ) then begin
401+ if FileExists(FGameDir +'\Data\'+ SR.Name +'\Unit.txt') then begin
402+ UnitList.LoadFromFile(FGameDir +'\Data\'+ SR.Name +'\Unit.txt');
403+
404+ for List_CNT := 0 to UnitList.Count - 1 do begin
405+ if UnitList[List_CNT].Name = Item.UnitName then begin
406+ Result := UnitList[List_CNT].UnitGraphic;
407+ Exit;
408+ end;
409+ end;
410+ end;
411+ if FileExists(FGameDir +'\Data\'+ SR.Name +'\Robot.txt') then begin
412+ UnitList.LoadFromFile(FGameDir +'\Data\'+ SR.Name +'\Robot.txt');
413+
414+ for List_CNT := 0 to UnitList.Count - 1 do begin
415+ if UnitList[List_CNT].Name = Item.UnitName then begin
416+ Result := UnitList[List_CNT].UnitGraphic;
417+ Exit;
418+ end;
419+ end;
420+ end;
421+ end;
422+ until FindNext(sr) <> 0;
423+ end;
424+ finally
425+ UnitList.Free;
426+ SysUtils.FindClose(SR);
427+ end;
428+ end;
429+begin
430+ with Item Do begin
431+ Bitmap.Canvas.CopyRect(HSRect(X * 32,Y * 32,32,32),FUnitBackGround.Canvas,
432+ HSRect(Ord(Camp) * 32,0,32,32));
433+
434+ S := FindUnitGraphic;
435+ if (S <> '') and FileExists(FGameDir + '\Bitmap\Unit\' + S) then begin
436+ BMP := TABitmap.Create;
437+ BMP.LoadFromFile(FGameDir + '\Bitmap\Unit\' + S);
438+ BMP.ColorKey(x*32,y*32,32,32,0,0,Bitmap,clWhite);
439+ BMP.Free;
440+ end;
441+ end;
442+end;
443+
444+procedure TMapModule.PutTile(Map:TSRCMapData;Bitmap:TBitmap;const X,Y:Integer);
445+var
446+ Can : TCanvas;
447+ LC: Integer;
448+ BMP : TABitmap;
449+ function HSRect(const x,y,w,h:Integer):TRect;
450+ begin
451+ Result := Rect(x,y,x+w,y+h);
452+ end;
453+begin
454+ Can := FChips.GetCanvas(Map[0][X,Y]);
455+ if Assigned(Can) then
456+ Bitmap.Canvas.CopyRect(HSRect(X * 32,Y * 32,32,32),Can,Rect(0,0,32,32));
457+ for LC := 1 to Map.Count - 1 do begin
458+ BMP := TABitmap(FChips.GetBitmap(Map[LC][X,Y].Janre,Map[LC][X,Y].ID));
459+ if Assigned(BMP) then begin
460+ BMP.Do32;
461+ BMP.ColorKey(x * 32,y * 32,32,32,0,0,Bitmap,clWhite);
462+ end;
463+ end;
464+end;
465+
466+procedure TMapModule.PutAllUnit(Units : TNoxCreateCommandList;
467+Bitmap : TBitmap;const PutID: String);
468+var
469+ List_CNT : Integer;
470+begin
471+ if not Assigned(Units) then Exit;
472+ if Not Assigned(Bitmap) then Exit;
473+
474+ if PutID = '' then begin
475+ for List_CNT := Units.Count - 1 downto 0 do begin
476+ PutUnit(Units[List_CNT],Bitmap);
477+ end;
478+ end else begin
479+ for List_CNT := Units.Count - 1 downto 0 do begin
480+ if Units[List_CNT].SceneID = PutID then
481+ PutUnit(Units[List_CNT],Bitmap);
482+ end;
483+ end;
484+end;
485+
486+end.
--- MLNox/CPilot.pas (nonexistent)
+++ MLNox/CPilot.pas (revision 4)
@@ -0,0 +1,618 @@
1+unit CPilot;
2+
3+interface
4+uses
5+ Classes,NCommon,SysUtils,CEquips,CPilotAbility,
6+ CSpecialPower, CUnitAbility,StringUnitLight,NCommonSRC,CSeek3List;
7+type
8+
9+ TSRCCharactorSex = (SCSMale,SCSFeMale,SCSNoSex);
10+
11+ TSRCPilot = Class(TSRCData)
12+ private
13+ FName,FOmissionName,FSyllabary:String;
14+ FSex : TSRCCharactorSex;
15+ FUnitType : String;
16+ FAirMove,FLandMove,FWaterMove,FSpaceMove:Byte;
17+ FExp:Integer;
18+ FPilotAbility:TSRCPilotAbilityList;
19+
20+ FSword,FArrow,FHit,FEvasion,FCapability,FReaction:word;
21+ {後にString型に変更かも}
22+ FCharacter:Byte;
23+ FSpecialPowers:TSRCPilotSpecialPowerList;
24+
25+ FPilotGraphic,FTurnMusic:String;
26+
27+ FEquips: TSRCEquipList;
28+ FAbilities : TSRCAbilityList;
29+ FUnitAbilities:TSRCUnitAbilityList;
30+
31+ FComment : TStringList;
32+
33+ procedure SetRealName(val:String);
34+ procedure SetOmissionName(val:String);
35+ procedure SetPilotAbility(val:TSRCPilotAbilityList);
36+ procedure SetSpecialPowers(val:TSRCPilotSpecialPowerList);
37+ procedure SetEquips(val:TSRCEquipList);
38+ procedure SetAbilities(val:TSRCAbilityList);
39+ procedure SetUnitAbilities(val:TSRCUnitAbilityList);
40+ procedure SetComment(val:TStringList);
41+ procedure SetLandData(const val:String);
42+ function GetLandData:String;
43+ protected
44+ procedure AssignTo(Dest:TPersistent);override;
45+ public
46+ Destructor Destroy;override;
47+ Constructor Create;override;
48+
49+ procedure WriteData(Dest:TStrings);override;
50+ function ReadData(Source:TStrings;Index:Integer;var Errors : String):Boolean;override;
51+
52+ published
53+ property Name:String read FName write SetRealName;
54+ property OmissionName:String read FOmissionName write SetOmissionName;
55+ property Syllabary:String read FSyllabary write FSyllabary;
56+ property PilotAbility:TSRCPilotAbilityList read FPilotAbility write SetPilotAbility;
57+ property SpecialPowers: TSRCPilotSpecialPowerList read FSpecialPowers write SetSpecialPowers;
58+
59+ property Sex : TSRCCharactorSex read FSex write FSex;
60+ property UnitType:String read FUnitType write FUnitType;
61+
62+ property AirMove:Byte read FAirMove write FAirMove;
63+ property LandMove:Byte read FLandMove write FLandMove;
64+ property WaterMove:Byte read FWaterMove write FWaterMove;
65+ property SpaceMove:Byte read FSpaceMove write FSpaceMove;
66+ property TerrainMove : String read GetLandData write SetLandData;
67+
68+ property Exp:Integer read FExp write FExp;
69+
70+ property Sword:Word read FSword write FSword;
71+ property Arrow:Word read FArrow write FArrow;
72+ property Hit:Word read FHit write FHit;
73+ property Evasion:Word read FEvasion write FEvasion;
74+ property Capability:Word read FCapability write FCapability;
75+ property Reaction:Word read FReaction write FReaction;
76+
77+ property Charactor : Byte read FCharacter write FCharacter;
78+
79+ property PilotGraphic : String read FPilotGraphic write FPilotGraphic;
80+ property TurnMusic : String read FTurnMusic write FTurnMusic;
81+
82+ property Equips : TSRCEquipList read FEquips write SetEquips;
83+ property Abilities : TSRCAbilityList read FAbilities write SetAbilities;
84+ property UnitAbilities: TSRCUnitAbilityList read FUnitAbilities write SetUnitAbilities;
85+ property Comment : TStringList read FComment write SetComment;
86+ End;
87+
88+ TSRCPilotList = Class(TSRCDataList)
89+ private
90+ procedure SetItems(ID:Integer;val:TSRCPilot);
91+ function GetItems(ID:Integer):TSRCPilot;
92+ protected
93+ function AddID(const ID:Integer):TSRCData;override;
94+ public
95+ function Add(out ID : integer):TSRCPilot;overload;
96+ function Add():TSRCPilot;overload;
97+
98+ property Items[ID:Integer]:TSRCPilot read GetItems write SetItems;default;
99+ published
100+ end;
101+
102+implementation
103+
104+Destructor TSRCPilot.Destroy;
105+begin
106+ FPilotAbility.Free;
107+ FSpecialPowers.Free;
108+ FEquips.Free;
109+ FAbilities.Free;
110+ FUnitAbilities.Free;
111+ FComment.Free;
112+ inherited;
113+end;
114+
115+Constructor TSRCPilot.Create;
116+begin
117+ FPilotAbility := TSRCPilotAbilityList.Create;
118+ FSpecialPowers := TSRCPilotSpecialPowerList.Create;
119+ FEquips := TSRCEquipList.Create;
120+ FAbilities := TSRCAbilityList.Create;
121+ FUnitAbilities := TSRCUnitAbilityList.Create;
122+ FComment := TStringList.Create;
123+
124+ FAirMove := 1;
125+ FLandMove := 1;
126+ FWaterMove := 1;
127+ FSpaceMove := 1;
128+
129+ FPilotGraphic := '-.bmp';
130+ FTurnMusic := '-.mid';
131+ FCharacter := 2;
132+ FName := '新規パイロット';
133+
134+ FSword := 100;
135+ FArrow := 100;
136+ FHit := 100;
137+ FEvasion := 100;
138+ FCapability := 100;
139+ FReaction := 100;
140+end;
141+
142+procedure TSRCPilot.AssignTo(Dest: TPersistent);
143+begin
144+ if Dest is TSRCPilot then begin
145+ TSRCPilot(Dest).Name := FName;
146+ TSRCPilot(Dest).OmissionName := FOmissionName;
147+ TSRCPilot(Dest).Syllabary := FSyllabary;
148+ TSRCPilot(Dest).Sex := FSex;
149+ TSRCPilot(Dest).UnitType := FUnitType;
150+ TSRCPilot(Dest).AirMove := FAirMove;
151+ TSRCPilot(Dest).LandMove := FLandMove;
152+ TSRCPilot(Dest).WaterMove := FWaterMove;
153+ TSRCPilot(Dest).SpaceMove := FSpaceMove;
154+ TSRCPilot(Dest).Exp := FExp;
155+ TSRCPilot(Dest).PilotAbility := FPilotAbility;
156+
157+ TSRCPilot(Dest).Sword := FSword;
158+ TSRCPilot(Dest).Arrow := FArrow;
159+ TSRCPilot(Dest).Hit := FHit;
160+ TSRCPilot(Dest).Evasion := FEvasion;
161+ TSRCPilot(Dest).Capability := FCapability;
162+ TSRCPilot(Dest).Reaction := FReaction;
163+ TSRCPilot(Dest).Charactor := FCharacter;
164+ TSRCPilot(Dest).SpecialPowers := FSpecialPowers;
165+
166+ TSRCPilot(Dest).PilotGraphic := FPilotGraphic;
167+ TSRCPilot(Dest).TurnMusic := FTurnMusic;
168+
169+ TSRCPilot(Dest).Equips := FEquips;
170+ TSRCPilot(Dest).Abilities := FAbilities;
171+ TSRCPilot(Dest).UnitAbilities := FUnitAbilities;
172+ TSRCPilot(Dest).Comment := FComment;
173+ end;
174+end;
175+
176+procedure TSRCPilot.SetPilotAbility(val: TSRCPilotAbilityList);
177+begin
178+ FPilotAbility.Assign(val);
179+end;
180+
181+procedure TSRCPilot.SetSpecialPowers(val: TSRCPilotSpecialPowerList);
182+begin
183+ FSpecialPowers.Assign(val);
184+end;
185+
186+procedure TSRCPilot.SetUnitAbilities(val: TSRCUnitAbilityList);
187+begin
188+ FUnitAbilities.Assign(val);
189+end;
190+
191+procedure TSRCPilot.SetComment(val: TStringList);
192+begin
193+ FComment.Assign(val);
194+end;
195+
196+procedure TSRCPilot.SetEquips(val: TSRCEquipList);
197+begin
198+ FEquips.Assign(val);
199+end;
200+
201+procedure TSRCPilot.SetAbilities(val: TSRCAbilityList);
202+begin
203+ FAbilities.Assign(val);
204+end;
205+
206+procedure TSRCPilot.SetRealName(val:String);
207+var
208+ STA,STB : TStringDynArray;
209+begin
210+ FName := val;
211+ SetLength(STA,3);
212+ SetLength(STB,3);
213+ STA[0] := '';
214+ STA[1] := '';
215+ STA[2] := '';
216+
217+ STB[0] := ' ';
218+ STB[1] := '"';
219+ STB[2] := ',';
220+
221+ StringsReplace(FName,STB,STA,False);
222+end;
223+
224+procedure TSRCPilot.SetOmissionName(val: string);
225+begin
226+ FOmissionName := val;
227+end;
228+
229+procedure TSRCPilot.SetLandData(const val:String);
230+begin
231+ StringToRanks(Val,FAirMove,FLandMove,FWaterMove,FSpaceMove);
232+end;
233+
234+function TSRCPilot.GetLandData:String;
235+begin
236+ Result := RanksToString(FAirMove,FLandMove,FWaterMove,FSpaceMove);
237+end;
238+
239+procedure TSRCPilot.WriteData(Dest:TStrings);
240+var
241+ Str : String;
242+ Ref_CNT:Integer;
243+ procedure WriteUnitAbility;
244+ var LC : Integer;
245+ begin
246+ Dest.Add('===');
247+ for LC := 0 to FUnitAbilities.Count - 1 do
248+ Dest.Add(FUnitAbilities[LC].GetString);
249+ end;
250+ procedure WriteAbility;
251+ var LC : Integer;
252+ begin
253+ Dest.Add('===');
254+ for LC := 0 to FAbilities.Count - 1 do
255+ Dest.Add(FAbilities[LC].GetString);
256+ end;
257+ procedure WriteWeapon;
258+ var LC : Integer;
259+ begin
260+ Dest.Add('===');
261+ for LC := 0 to FEquips.Count - 1 do
262+ Dest.Add(FEquips[LC].GetString);
263+ end;
264+begin
265+ if FName = '' then Dest.Add('名無しのパイロット') else Dest.Add(FName);
266+
267+ Str := FOmissionName + ',' ;
268+ if FSyllabary <> '' then Str := Str+ FSyllabary + ',';
269+
270+ Case FSex of
271+ SCSMale :Str := Str + '男性,';
272+ SCSFeMale :Str := Str + '女性,';
273+ SCSNoSex :Str := Str + '-,';
274+ End;
275+
276+ Str := Str + FUnitType + ',' + GetLandData + ',' + inttostr(FExp);
277+
278+ Dest.Add(Str);
279+
280+ if FPilotAbility.Count > 0 then begin
281+ Dest.Add('特殊能力');
282+
283+ With FPilotAbility do begin
284+ for Ref_CNT := 0 to Count - 1 do begin
285+ Dest.Add(Ability[Ref_CNT].GetMessage);
286+ end;
287+ end;
288+ end else Dest.Add('特殊能力なし');
289+
290+ Str := inttostr(FSword) + ',' + inttostr(FArrow) + ',';
291+ Str := Str + inttostr(FHit) + ',' + inttostr(FEvasion) + ',';
292+ Str := Str + inttostr(FCapability) + ',' + inttostr(FReaction) + ',';
293+
294+ Case FCharacter of
295+ 0: Str := Str + '機械';
296+ 1: Str := Str + '弱気';
297+ 3: Str := Str + '強気';
298+ 4: Str := Str + '超強気';
299+ else Str := Str + '普通';
300+ End;
301+
302+ Dest.Add(str);
303+
304+ if FSpecialPowers.Count > 0 then begin
305+ Str := 'ＳＰ,' + inttostr(FSpecialPowers.MaxSP);
306+ for Ref_CNT := 0 to FSpecialPowers.Count - 1 do begin
307+
308+ Str := Str + ',' + FSpecialPowers[Ref_CNT].Caption;
309+ if FSpecialPowers[Ref_CNT].Cost > 0 then
310+ Str := Str + '=' + inttostr(FSpecialPowers[Ref_CNT].Cost);
311+
312+ Str := Str + ',' + inttostr(FSpecialPowers[Ref_CNT].PilotLevel)
313+ end;
314+ end else begin
315+ Str := 'ＳＰなし';
316+ end;
317+
318+ Dest.Add(str);
319+
320+ Dest.Add(FPilotGraphic + ',' + FTurnMusic);
321+
322+ if FAbilities.Count > 0 then begin
323+ WriteUnitAbility;
324+ WriteWeapon;
325+ WriteAbility;
326+ end else if FEquips.Count > 0 then begin
327+ WriteUnitAbility;
328+ WriteWeapon;
329+ end else if FUnitAbilities.Count > 0 then begin
330+ WriteUnitAbility;
331+ end;
332+
333+ Dest.Add('');
334+
335+ WriteComment(Dest,FComment);
336+ Dest.Add('');
337+end;
338+
339+function TSRCPilot.ReadData(Source:TStrings;Index:Integer;var Errors:String):Boolean;
340+var
341+ APilot:TSRCPilot;
342+ SPD : TSRCPilotSpecialPower;
343+ Str,SubStr : String;
344+ Int : Integer;
345+
346+ procedure SendError(const Error:String);
347+ begin
348+ Result := False;
349+ if Errors <> '' then Errors := Errors + #13#10;
350+
351+ Errors := Errors + Error +'(' +
352+ inttostr(Index) + '行目)';
353+ end;
354+
355+ function ReadLine:String;
356+ begin
357+ if Index >= Source.Count then begin
358+ SendError('項目が途切れています');
359+ Result := '';
360+ end else Result := Source[Index];
361+ end;
362+
363+ procedure IncNum;
364+ var
365+ SS:String;
366+ begin
367+ inc(Index);
368+ while (Source.Count > Index) do begin
369+ SS := TrimJP(Source[Index]);
370+ if StartsStr('#',SS) then
371+ inc(Index) else break;
372+ end;
373+ end;
374+
375+ function CheckStrToIntError(const Val,SRCType:String):Integer;
376+ begin
377+ if not TryStrToInt(Val,Result) then begin
378+ Result := 0;
379+ SendError(SRCType + '(' + Val + ')が数値ではありません。');
380+ end;
381+ end;
382+ function GetStrDem:String;
383+ begin
384+ Result := TrimJP(ExtractWordDem(Str));
385+ end;
386+begin
387+ Result := True;
388+ Errors := '';
389+
390+ if Source.Count <= Index then Exit;
391+
392+ Str := TrimJP(ReadLine);
393+ while (Str = '') OR (StartsStr('#',Str)) do begin
394+ IncNum;
395+ if Source.Count <= Index then break;
396+ Str := TrimJP(ReadLine);
397+ end;
398+
399+ if Source.Count <= Index then Exit;
400+ APilot := TSRCPilot.Create;{設定バックアップ用}
401+ try
402+ APilot.Name := TrimJP(ReadLine);
403+ IncNum;
404+
405+ {愛称, 読み仮名, 性別, ユニットタイプ, 地形適応, 経験値 以上の処理}
406+ Str := ReadLine;
407+ incNum;
408+
409+ Int := StrCount(',',Str,ifByte) + 1;
410+ if (Int < 4) OR (Int > 6) then begin
411+ SendError('愛称などのデータが欠けているか多すぎます');
412+ end;
413+ APilot.OmissionName := GetStrDem;
414+ APilot.FSex := SCSNoSex;
415+
416+ if Int = 6 then begin{省略なし}
417+ APilot.FSyllabary := GetStrDem;
418+ SubStr := GetStrDem;
419+ APilot.Sex := SCSNoSex;
420+ if SubStr = '男性' then APilot.FSex := SCSMale;
421+ if SubStr = '女性' then APilot.FSex := SCSFeMale;
422+
423+ end else if Int = 5 then begin {1個省略}
424+ SubStr := GetStrDem;
425+ if SubStr = '男性' then begin
426+ APilot.Sex := SCSMale;
427+ APilot.Syllabary :='';
428+ end else if SubStr = '女性' then begin
429+ APilot.Sex := SCSFeMale;
430+ APilot.Syllabary :='';
431+ end else if SubStr = '-' then begin
432+ APilot.Sex := SCSNoSex;
433+ APilot.Syllabary := '';
434+ end else begin
435+ APilot.Syllabary := SubStr;
436+ APilot.Sex := SCSNoSex;
437+ end;
438+ end else begin
439+ APilot.Syllabary := '';
440+ APilot.Sex := SCSNoSex;
441+ end;
442+
443+ APilot.UnitType := GetStrDem;
444+
445+ SubStr := GetStrDem;
446+ if Length(SubStr) <> 4 then begin
447+ SendError('地形適応の値 ('+SubStr+') が異常です。');
448+ end else APilot.SetLandData(SubStr);
449+ APilot.Exp := CheckStrToIntError(GetStrDem,'経験値');
450+
451+ {特殊能力の処理}
452+
453+ APilot.PilotAbility.Clear;
454+
455+ if TrimJP(ReadLine) = '特殊能力なし' then
456+ IncNum
457+ else if Trim(ReadLine) = '特殊能力' then begin
458+ {新形式}
459+ IncNum;
460+ SubStr := Source[index + 1];
461+ SubStr := TrimJP(ExtractWordDem(SubStr));
462+ While not ((SubStr = 'ＳＰ') or (SubStr = '精神') or
463+ (SubStr = 'ＳＰなし') or (SubStr = '精神なし')) do begin
464+ Str := ReadLine;
465+ if not APilot.PilotAbility.AddFromMessage(Str,Errors) then
466+ SendError('パイロット用特殊能力の読み込み中に以上のエラーが発生しました');
467+ incNum;
468+ SubStr := Source[index + 1];
469+ SubStr := TrimJP(ExtractWordDem(SubStr));
470+ end;
471+ end else begin
472+ {旧形式}
473+ Str := TrimJP(ReadLine);
474+ ExtractWordDem(Str);
475+
476+ if not APilot.PilotAbility.AddFromMessage(Str,Errors) then
477+ SendError('パイロット用特殊能力の読み込み中に以上のエラーが発生しました');
478+ incNum;
479+ end;
480+
481+ {格闘攻撃力, 射撃攻撃力, 命中, 回避, 技量, 反応, 性格}
482+ Str := ReadLine;
483+ incNum;
484+
485+ APilot.Sword := CheckStrToIntError(GetStrDem,'格闘攻撃力');
486+ APilot.FArrow := CheckStrToIntError(GetStrDem,'射撃攻撃力');
487+ APilot.FHit := CheckStrToIntError(GetStrDem,'命中');
488+ APilot.FEvasion := CheckStrToIntError(GetStrDem,'回避');
489+ APilot.FCapability := CheckStrToIntError(GetStrDem,'技量');
490+ APilot.FReaction := CheckStrToIntError(GetStrDem,'反応');
491+
492+ SubStr := GetStrDem;
493+ if SubStr = '機械' then APilot.FCharacter := 0
494+ else if SubStr = '弱気' then APilot.FCharacter := 1
495+ else if SubStr = '強気' then APilot.FCharacter := 3
496+ else if SubStr = '超強気' then APilot.FCharacter := 4
497+ else APilot.FCharacter := 2;
498+
499+ APilot.FSpecialPowers.Clear;
500+
501+ Str := TrimJP(ReadLine);
502+ incnum;
503+ SubStr := GetStrDem;
504+
505+ if (SubStr = 'ＳＰ') OR (SubStr = '精神') then begin
506+ APilot.FSpecialPowers.MaxSP := CheckStrToIntError(GetStrDem,'最大SP');
507+ Str := ReplaceStr(Str,'，',',');
508+ while Str <> '' do begin
509+ SubStr := GetStrDem;
510+ SPD := APilot.SpecialPowers.Add;
511+
512+ SPD.Caption := ExtractWordDem(SubStr,'=');
513+ if SubStr <> '' then begin
514+ SPD.Cost := CheckStrToIntError(SubStr,'SP使用コスト');
515+ end else SPD.Cost := - 1;
516+ SPD.PilotLevel := CheckStrToIntError(GetStrDem,'パイロットレベル');
517+ end;
518+ end;
519+
520+ Str := ReadLine;
521+ incnum;
522+
523+ APilot.FPilotGraphic := GetStrDem;
524+ APilot.FTurnMusic := GetStrDem;
525+
526+ if Source.Count <= Index then Exit;
527+
528+ if TrimJP(ReadLine) = '===' then begin;
529+ {Unit付加特殊能力}
530+ incNum;
531+ Str := TrimJP(ReadLine);
532+ while (Str <> '') and (Str <> '===') do begin
533+ if not APilot.UnitAbilities.AddItem(Str,Errors) then
534+ SendError('ユニットアビリティで以上のエラーが発生しました');
535+ IncNum;
536+
537+ if Source.Count >= Index then break;
538+ Str := TrimJP(ReadLine);
539+ end;
540+ end;
541+
542+ if Source.Count <= Index then Exit;
543+
544+ if TrimJP(ReadLine) = '===' then begin
545+ {Unit付加武器}
546+ incNum;
547+ Str := TrimJP(ReadLine);
548+ while (Str <> '') and (Str <> '===') do begin
549+ if not APilot.FEquips.AddItem(Str,Errors) then
550+ SendError('以上のエラーが武器中に存在します');
551+ incNum;
552+
553+ if Source.Count >= Index then break;
554+ Str := TrimJP(ReadLine);
555+ end;
556+ end;
557+
558+ if Source.Count <= Index then Exit;
559+
560+ if TrimJP(ReadLine) = '===' then begin
561+ {Unit付加アビリティ}
562+ IncNum;
563+ Str := TrimJP(ReadLine);
564+ while (Str <> '') do begin
565+ if not APilot.Abilities.AddItem(Str,Errors) then
566+ SendError('以上のエラーがアビリティで発生しました');
567+ IncNum;
568+
569+ if Source.Count >= Index then break;
570+ Str := TrimJP(ReadLine);
571+ end;
572+ end;
573+
574+ if Source.Count <= Index then Exit;
575+
576+ while TrimJP(ReadLine) = '' do begin
577+ inc(Index);
578+ if Source.Count <= Index then break;
579+ end;
580+
581+ ReadComment(APilot.Comment,Source,Index);
582+
583+ finally {今回の場合例外を返す可能性はゼロ}
584+ if Result then Assign(APilot);
585+
586+ APilot.Free;
587+ end;
588+end;
589+
590+{TSRCPilotList Funx.}
591+
592+procedure TSRCPilotList.SetItems(ID: Integer; val: TSRCPilot);
593+begin
594+ inherited SetItems(ID,Val);
595+end;
596+
597+function TSRCPilotList.GetItems(ID: Integer) :TSRCPilot;
598+begin
599+ Result := TSRCPilot(inherited GetItems(ID));
600+end;
601+
602+function TSRCPilotList.AddID(const ID: Integer):TSRCData;
603+begin
604+ FItems[ID] := TSRCPilot.Create;
605+ Result := FItems[ID];
606+end;
607+
608+function TSRCPilotList.Add(out ID: Integer):TSRCPilot;
609+begin
610+ Result := TSRCPilot(inherited Add(ID));
611+end;
612+
613+function TSRCPilotList.Add():TSRCPilot;
614+begin
615+ Result := TSRCPilot(inherited Add);
616+end;
617+
618+end.
--- MLNox/FSRCDir.pas (nonexistent)
+++ MLNox/FSRCDir.pas (revision 4)
@@ -0,0 +1,94 @@
1+unit FSRCDir;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, StdCtrls, ELIEDIT;
8+
9+type
10+ TSRCDirForm = class(TForm)
11+ Label1: TLabel;
12+ Label2: TLabel;
13+ Label3: TLabel;
14+ Label4: TLabel;
15+ EE1: TEllipsisEdit;
16+ Button1: TButton;
17+ Label5: TLabel;
18+ OpenDialog1: TOpenDialog;
19+ procedure EE1Change(Sender: TObject);
20+ procedure EE1EllipsisClick(Sender: TObject);
21+ private
22+ { Private 宣言 }
23+ FAppName : String;
24+ FIsExecute : Boolean;
25+ procedure SetAppName(const val : String);
26+ function GetSRCDir : String;
27+ procedure SetSRCDir(const val:String);
28+ public
29+ { Public 宣言 }
30+ property AppMame : String read FAppName write SetAppName;
31+ property IsExecute : Boolean read FIsExecute write FIsExecute;
32+ function Execute : Boolean;
33+ property SRCDir : String read GetSRCDir write SetSRCDir;
34+ end;
35+var
36+ SRCDirForm: TSRCDirForm;
37+
38+implementation
39+
40+{$R *.dfm}
41+
42+procedure TSRCDirForm.SetAppName(const val:String);
43+begin
44+ FAppName := Val;
45+ Label2.Caption := FAppName + 'はSRC.exeの存在する'+
46+ 'パスがないと動きません。(SRCBeta.exeではダメです)';
47+end;
48+
49+function TSRCDirForm.GetSRCDir:String;
50+begin
51+ Result := IncludeTrailingPathDelimiter(EE1.Text);
52+end;
53+
54+procedure TSRCDirForm.SetSRCDir(const val:String);
55+begin
56+ EE1.Text := val;
57+end;
58+
59+procedure TSRCDirForm.EE1Change(Sender: TObject);
60+begin
61+ if FileExists(IncludeTrailingPathDelimiter(EE1.Text) + 'SRC.exe') then begin
62+ if FIsExecute then
63+ Button1.Caption := '起動'
64+ else Button1.Caption := 'OK';
65+
66+ Button1.ModalResult := MrOk;
67+ Button1.Default := True;
68+ Button1.Cancel := False;
69+ end else begin
70+ if FIsExecute then
71+ Button1.Caption := '起動せず終了'
72+ else Button1.Caption := 'キャンセル';
73+
74+ Button1.ModalResult := MrCancel;
75+ Button1.Default := False;
76+ Button1.Cancel := True;
77+ end;
78+end;
79+
80+function TSRCDirForm.Execute:Boolean;
81+begin
82+ EE1Change(Self);
83+ Result := ShowModal = MrOk;
84+ if (not Result) and FIsExecute then Application.Terminate;
85+
86+end;
87+
88+procedure TSRCDirForm.EE1EllipsisClick(Sender: TObject);
89+begin
90+ if OpenDialog1.Execute then
91+ EE1.Text := ExtractFilePath(OpenDialog1.FileName);
92+end;
93+
94+end.
Show on old repository browser