Develop and Download Open Source Software

soi-man

Browse Subversion Repository

/[soi-man]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by yamat0jp, Mon Oct 5 12:52:47 2015 UTC revision 2 by yamat0jp, Mon Oct 5 22:59:32 2015 UTC
# Line 15  type Line 15  type
15      Index: integer;      Index: integer;
16      Dir: TDir;      Dir: TDir;
17      X, Y: integer;      X, Y: integer;
18      procedure Walk(out p, q: integer); virtual;      AX, AY: integer;
19        procedure Walk(var p, q: integer); virtual;
20      procedure Wall; virtual;      procedure Wall; virtual;
21        procedure Clear; virtual;
22    end;    end;
23    
24    TEnemy = class(TChar)    TEnemy = class(TChar)
25    public    public
26      Count: integer;      Count: integer;
27      Max: integer;      Max: integer;
28        Visible: Boolean;
29      constructor Create;      constructor Create;
30      procedure Walk(out p, q: integer); override;      procedure Walk(var p, q: integer); override;
31      procedure Wall; override;      procedure Wall; override;
32        procedure Clear; override;
33        procedure RunAway(out p, q: integer);
34    end;    end;
35    
36    TWorry = class(TEnemy)    TWorry = class(TEnemy)
37    public    public
38      constructor Create;      constructor Create;
     procedure Wall; override;  
39    end;    end;
40    
41    TGhost = class(TEnemy)    TGhost = class(TEnemy)
42    public    public
43      Man: TChar;      constructor Create;
44      constructor Create(c: TChar);      procedure Wall(p, q: integer); overload;
     procedure Wall; override;  
45    end;    end;
46    
47    TMap = class(TObject)    TMap = class(TObject)
# Line 51  type Line 54  type
54      function GetStrings(X, Y: integer): integer;      function GetStrings(X, Y: integer): integer;
55      procedure SetStrings(X, Y: integer; const Value: integer);      procedure SetStrings(X, Y: integer; const Value: integer);
56    public    public
     constructor Create;  
57      procedure Clear;      procedure Clear;
58      property Strings[X, Y: integer]: integer read GetStrings      property Strings[X, Y: integer]: integer read GetStrings
59        write SetStrings; default;        write SetStrings; default;
# Line 67  type Line 69  type
69      procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;      procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
70        Shift: TShiftState);        Shift: TShiftState);
71    private    private
72        FAction: Boolean;
73        procedure SetAction(const Value: Boolean);
74      { private 宣言 }      { private 宣言 }
75    public    public
76      { public 宣言 }      { public 宣言 }
77      Map: TMap;      Map: TMap;
78      Char: TChar;      Char: TChar;
79      List: TList;      List: TList;
80        Count: integer;
81      procedure Start;      procedure Start;
82      procedure GameOver;      procedure GameOver;
83      procedure GameClear;      procedure GameClear;
84        property Action: Boolean read FAction write SetAction;
85    end;    end;
86    
87  var  var
# Line 99  type Line 105  type
105    
106  begin  begin
107    setint(0, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);    setint(0, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
108    setint(1, [1, 0, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);    setint(1, [1, 9, 0, 3, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 4, 0, 0, 0, 0, 1]);
109    setint(2, [1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1]);    setint(2, [1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1]);
110    setint(3, [1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1]);    setint(3, [1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1]);
111    setint(4, [1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1]);    setint(4, [1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1]);
112    setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1]);    setint(5, [1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 9, 1, 1, 0, 1, 0, 0, 0, 1, 1]);
113    setint(6, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1]);    setint(6, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1]);
114    setint(7, [1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1]);    setint(7, [1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1]);
115    setint(8, [1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);    setint(8, [1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1]);
# Line 115  begin Line 121  begin
121    setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);    setint(14, [1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
122    setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);    setint(15, [1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
123    setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);    setint(16, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
124    setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1]);    setint(17, [1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 1]);
125    setint(18, [1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]);    setint(18, [1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]);
126    setint(19, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);    setint(19, [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]);
127  end;  end;
128    
 constructor TMap.Create;  
 begin  
   Clear;  
 end;  
   
129  function TMap.GetStrings(X, Y: integer): integer;  function TMap.GetStrings(X, Y: integer): integer;
130  begin  begin
131    result := FStrings[X, Y];    result := FStrings[X, Y];
# Line 136  begin Line 137  begin
137  end;  end;
138    
139  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
140    var
141      i, j, k: integer;
142      s: TChar;
143  begin  begin
   Canvas.Fill.Color := TAlphaColors.Blue;  
144    Map := TMap.Create;    Map := TMap.Create;
145      Map.Clear;
146    ClientWidth := Map.Size * Map.Wid;    ClientWidth := Map.Size * Map.Wid;
147    ClientHeight := Map.Size * Map.Hei;    ClientHeight := Map.Size * Map.Hei;
148    List := TList.Create;    List := TList.Create;
149    Char := TChar.Create;    Char := TChar.Create;
150    List.Add(Char);    List.Add(Char);
151    List.Add(TWorry.Create);    List.Add(TWorry.Create);
152    List.Add(TGhost.Create(Char));    List.Add(TGhost.Create);
153      for i := 0 to Map.Wid - 1 do
154        for j := 0 to Map.Hei - 1 do
155        begin
156          k := Map[i, j];
157          if k in [2 .. 4] then
158          begin
159            s := List[k - 2];
160            s.AX := i;
161            s.AY := j;
162          end;
163        end;
164    Start;    Start;
165  end;  end;
166    
# Line 224  begin Line 239  begin
239    for i := 1 to 2 do    for i := 1 to 2 do
240    begin    begin
241      s := List[i];      s := List[i];
242      enemy(s.X, s.Y);      if (s as TEnemy).Visible = true then
243          enemy(s.X, s.Y);
244    end;    end;
245  end;  end;
246    
# Line 249  begin Line 265  begin
265    begin    begin
266      s := List[i];      s := List[i];
267      if (Char.X = s.X) and (Char.Y = s.Y) then      if (Char.X = s.X) and (Char.Y = s.Y) then
268      begin        if Action = true then
269        Start;          (s as TEnemy).Visible := false
270        break;        else
271      end;        begin
272            Start;
273            break;
274          end;
275    end;    end;
276  end;  end;
277    
278    procedure TForm1.SetAction(const Value: Boolean);
279    begin
280      if Value = true then
281      begin
282        Count := 100;
283        Canvas.Fill.Color := TAlphaColors.Blue;
284      end
285      else
286        Canvas.Fill.Color := TAlphaColors.Purple;
287      FAction := Value;
288    end;
289    
290  procedure TForm1.Start;  procedure TForm1.Start;
291  var  var
292    i: integer;    i: integer;
   j: integer;  
   k: integer;  
293    s: TChar;    s: TChar;
294  begin  begin
295      Action := false;
296    Map.Clear;    Map.Clear;
297    for i := 0 to Map.Wid - 1 do    for i := 0 to List.Count - 1 do
298      for j := 0 to Map.Hei - 1 do    begin
299      begin      s := List[i];
300        k := Map[i, j];      s.Clear;
301        if k in [2 .. 4] then      if s = Char then
302        begin        Map[s.X, s.Y] := 10
303          s := List[k - 2];      else
304          s.X := i;        Map[s.X, s.Y] := 0;
305          s.Y := j;    end;
         if k = 2 then  
           Map[i, j] := 10  
         else  
           Map[i, j] := 0;  
       end;  
     end;  
   Char.Dir := Stop;  
306  end;  end;
307    
308  procedure TForm1.Timer1Timer(Sender: TObject);  procedure TForm1.Timer1Timer(Sender: TObject);
# Line 287  var Line 310  var
310    i, p, q: integer;    i, p, q: integer;
311    s: TChar;    s: TChar;
312  begin  begin
313    for i := 0 to 2 do    for i := 0 to List.Count-1 do
314    begin    begin
315      s := List[i];      s := List[i];
316      s.Walk(p, q);      if (s = Char) or ((s as TEnemy).Visible = true) then
     if Map[p, q] in [0, 10] then  
317      begin      begin
       s.X := p;  
       s.Y := q;  
318        if s = Char then        if s = Char then
319            s.Walk(p, q)
320          else
321        begin        begin
322          Map[p, q] := 10;          if Action = false then
323          GameOver;          begin
324              p := Char.X;
325              q := Char.Y;
326              (s as TEnemy).RunAway(p, q);
327            end;
328            s.Walk(p, q);
329        end;        end;
330          if Map[p, q] in [0, 9, 10] then
331          begin
332            s.X := p;
333            s.Y := q;
334            if s = Char then
335            begin
336              if Map[p, q] = 9 then
337                Action := true;
338              Map[p, q] := 10;
339              GameOver;
340            end;
341          end
342          else
343            s.Wall;
344      end      end
345      else      else
346        s.Wall;        with s as TEnemy do
347            if Count = 0 then
348              Clear
349            else
350              dec(Count);
351      end;
352      if Action = true then
353      begin
354        if Count = 0 then
355          Action := false;
356        dec(Count);
357    end;    end;
358    GameOver;    GameOver;
359    PaintTo(Canvas);    PaintTo(Canvas);
# Line 311  end; Line 362  end;
362    
363  { TChar }  { TChar }
364    
365  procedure TChar.Walk(out p, q: integer);  procedure TChar.Clear;
366    begin
367      X := AX;
368      Y := AY;
369      Dir := Stop;
370    end;
371    
372    procedure TChar.Walk(var p, q: integer);
373  begin  begin
374    p := X;    p := X;
375    q := Y;    q := Y;
# Line 343  end; Line 401  end;
401    
402  { TEnemy }  { TEnemy }
403    
404    procedure TEnemy.Clear;
405    begin
406      inherited;
407      Visible := true;
408      Wall;
409    end;
410    
411  constructor TEnemy.Create;  constructor TEnemy.Create;
412  begin  begin
413    inherited;    inherited;
414    Randomize;    Randomize;
415    Count := Random(5);    Count := Random(5);
416      Visible := true;
417  end;  end;
418    
419  procedure TEnemy.Walk(out p, q: integer);  procedure TEnemy.RunAway(out p, q: integer);
420    begin
421      Randomize;
422      case Random(2) of
423        0:
424          if p < X then
425            p := X - 1
426          else if p > X then
427            p := X + 1;
428        1:
429          if q < Y then
430            q := Y - 1
431          else
432            q := Y + 1;
433      end;
434    end;
435    
436    procedure TEnemy.Walk(var p, q: integer);
437  begin  begin
438    inherited;    inherited;
439    dec(Count);    dec(Count);
# Line 363  end; Line 446  end;
446    
447  procedure TEnemy.Wall;  procedure TEnemy.Wall;
448  begin  begin
449  //  Count := Max;    Count := Max;
 end;  
   
 { TWorry }  
   
 constructor TWorry.Create;  
 begin  
   Max := 5;  
 end;  
   
 procedure TWorry.Wall;  
 begin  
   inherited;  
450    Randomize;    Randomize;
451    case Random(4) of    case Random(4) of
452      0:      0:
# Line 389  begin Line 460  begin
460    end;    end;
461  end;  end;
462    
463    { TWorry }
464    
465    constructor TWorry.Create;
466    begin
467      Max := 5;
468    end;
469    
470  { TGhost }  { TGhost }
471    
472  constructor TGhost.Create(c: TChar);  constructor TGhost.Create;
473  begin  begin
   Man := c;  
474    Max := 3;    Max := 3;
475  end;  end;
476    
477  procedure TGhost.Wall;  procedure TGhost.Wall(p, q: integer);
478  begin  begin
479    inherited;    inherited Wall;
480    Randomize;    Randomize;
481    case Random(2) of    case Random(2) of
482      0:      0:
483        if Man.X > X then        if p > X then
484          Dir := Right          Dir := Right
485        else if Man.X < X then        else if p < X then
486          Dir := TDir.Left;          Dir := TDir.Left;
487      1:      1:
488        if Man.Y > Y then        if q > Y then
489          Dir := Down          Dir := Down
490        else if Man.Y < Y then        else if q < Y then
491          Dir := Up;          Dir := Up;
492    end;    end;
493  end;  end;
Legend:
Removed from v.1  
changed lines
  Added in v.2
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help