1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:

unit spiel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DIB, jpeg, DXDraws, DXClass, DXSprite, DXInput, DXSounds, math,
  ExtCtrls, StdCtrls, JclSysUtils;

type
  TForm1 = class(TForm)
    DXSpriteEngine1: TDXSpriteEngine;
    DXTimer1: TDXTimer;
    BodenTex: TDXImageList;
    DXInput1: TDXInput;
    DXImageList1: TDXImageList;
    dx: TDXDraw;
    procedure dxInitialize(Sender: TObject);
    procedure dxFinalize(Sender: TObject);
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    procedure FormCreate(Sender: TObject);
    procedure dxClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TPlayer = class(TImageSpriteex)
  public
    procedure DoMove(MoveCount: Integer); override;

  end;

var
  Form1: TForm1;
  Player: TPlayer;
//karte größe, anzahl
  map: array[0..100, 0..100] of integer;
  mapx,mapy, plusx, plusy: integer;
  mapsizex: integer = 64;//größe der fragmente
  mapsizey: integer = 64;
  mapanzahlx: integer = 100 - 1;// minus 1 weil die maps mit 0 statt 1 anfangen
  mapanzahly: integer = 100 - 1;
//scrollvariablen
  //scroll, scrollende: boolean;

//Bewegung
  ziel_x, ziel_y, pos_x, pos_y: integer;
  amziel: boolean;

//RichtungsCheck Prozedur
  CheckOben, CheckRechts, CheckUnten, CheckLinks: Boolean;

//WegFind Prozedur
  WegFindHg: Array[0..1000, 0..1000] of Array[1..10] of integer;
  {
  Belegung des Arrays:
  WegFind[x,y][1] =
  WegFind[x,y][2] =
  WegFind[x,y][3] = 1 (frei), 0 (blockiert)
  WegFind[x,y][4] = 1 (frei), 0 (temporär blockiert)
  }
  //Distanzen für Wegfind
  DistOben, DistRechts, DistUnten, DistLinks: Integer;
  MoveOben, MoveRechts, MoveUnten, MoveLinks: Boolean;

  //i, i2: Integer;
  test: Integer;
  Dist_X, Dist_Y: Integer;
//für die Bewegung
  //Richtung: Array[1..4] of Integer;
  Richtung: Integer;
implementation

{$R *.dfm}

procedure TPlayer.DoMove(MoveCount: Integer);
begin
    if Richtung = 1 then
      Y := Y - 1;

    if Richtung = 2 then
      X := X + 1;

    if Richtung = 3 then
      Y := Y + 1;

    if Richtung = 4 then
      X := X - 1;

    Richtung := 0;

end;

//Funktion um die Distanz zwischen den Einzelnen Arrays rauszufinden
function WegDistanz(PosX, PosY, ZielX, ZielY: integer): Integer;
begin
    dist_x := abs(wegfindhg[ZielX, ZielY][1] - wegfindhg[PosX, PosY][1]);
    dist_y := abs(wegfindhg[ZielX, ZielY][2] - wegfindhg[PosX, PosY][2]);
    result := dist_X + dist_Y;
end;

//Prozedur um zu checken in welche Richtung die Figur kann
procedure RichtungCheck;
begin
  if wegfindhg[Pos_X, Pos_Y - 1][3] = 1 then
    if wegfindhg[Pos_X, Pos_Y - 1][4] = 1 then
      CheckOben := true
    else
      CheckOben := false
  else
    CheckOben := false;

  if wegfindhg[Pos_X + 1, Pos_Y][3] = 1 then
    if wegfindhg[Pos_X + 1, Pos_Y][4] = 1 then
        CheckRechts := true
    else
      CheckRechts := false
  else
    CheckRechts := false;

  if wegfindhg[Pos_X, Pos_Y + 1][3] = 1 then
    if wegfindhg[Pos_X, Pos_Y + 1][4] = 1 then
        CheckUnten := true
    else
      CheckUnten := false
  else
    CheckUnten := false;

  if wegfindhg[Pos_X - 1, Pos_Y][3] = 1 then
    if wegfindhg[Pos_X - 1, Pos_Y][4] = 1 then
        CheckLinks := true
    else
      CheckLinks := false
  else
    CheckLinks := false;

end;


procedure WegFind;
begin
    pos_x := round(player.x) div 50;
    pos_y := round(player.y) div 50;

    if CheckOben = true then
        DistOben := WegDistanz(pos_X, pos_Y - 1, ziel_X, ziel_Y);

    if CheckRechts = true then
        DistRechts := WegDistanz(pos_X + 1, pos_Y, ziel_X, ziel_Y);

    if CheckUnten = true then
        DistUnten := WegDistanz(pos_X, pos_Y + 1, ziel_X, ziel_Y);

    if CheckLinks = true then
        DistLinks := WegDistanz(pos_X - 1, pos_Y, ziel_X, ziel_Y);


    if DistOben <= DistRechts then
        if DistOben <= DistUnten then
            if DistOben <= DistLinks then
                Richtung := 1;

    if DistRechts <= DistUnten then
        if DistRechts <= DistLinks then
            if DistRechts <= DistOben then
                Richtung := 2;

    if DistUnten <= DistLinks then
        if DistUnten <= DistOben then
            if DistUnten <= DistRechts then
                Richtung := 3;

    if DistLinks <= DistOben then
        if DistLinks <= DistRechts then
            if DistLinks <= DistUnten then
                Richtung := 4;

end;


procedure TForm1.dxInitialize(Sender: TObject);
begin
//spieler reinsetzen
  Player := TPlayer.Create(DXSpriteEngine1.Engine);
  Player.Image := DXImageList1.Items[0];
  Player.X := 100;
  Player.Y := 200;
  Player.Z := -10;
  player.Angle := 0;
  Player.Width := Player.Image.Width;
  Player.Height := Player.Image.Height;

  DXTimer1.Enabled := True;

end;

procedure TForm1.dxFinalize(Sender: TObject);
begin
DXTimer1.Enabled := False;

end;

procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
begin
//steuerung bzw scroll
  if Pos_X = Ziel_X then
    if Pos_Y = Ziel_Y then
      amziel := true
    else
    begin
      amziel := false;
      RichtungCheck;
      WegFind;
    end
    else
    begin
      amziel := false;
      RichtungCheck;
      WegFind;
    end;

test := WegDistanz(Pos_X, Pos_Y, Ziel_X, Ziel_Y);

//directx malen etc.
 DX.Surface.Fill(0);

 BodenTex.Items[0].draw(dx.surface,0,0,0);

 DXInput1.Update;
 DXSpriteEngine1.Move(1);
 DXSpriteEngine1.Dead;
 DXSpriteEngine1.Draw;

  with DX.Surface.Canvas do
  begin
    Release; {    }
  end;
  DX.Flip;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    randomize();
// Zufällige texturverteilung in der map
    for mapx := 0 to mapanzahlx do
        for mapy := 0 to mapanzahly do
            map[mapx,mapy] := 0;//random(2);

    for mapx := 0 to 1000 do
        for mapy := 0 to 1000 do
        begin
            wegfindhg[mapx, mapy][1] := mapx;
            wegfindhg[mapx, mapy][2] := mapy;
            wegfindhg[mapx, mapY][1] := mapx;
            wegfindhg[mapX, mapY][2] := mapy;
            //alle maps frei machen
            WegFindHg[mapx, mapy][3] := 1;
            WegFindHg[mapx, mapy][4] := 1;
        end;

//das blaue kästchen wird massiv gemacht
    for mapx := 5 to 11 do
        for mapy := 4 to 8 do
        wegFindHg[mapx, mapy][3] := 0;
end;


procedure TForm1.dxClick(Sender: TObject);
begin
  ziel_x := mouse.CursorPos.X div 50;
  ziel_y := mouse.CursorPos.Y div 50;
  amziel := false;
end;

end.