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:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:

unit Bild;

interface

uses
Windows, Messages, SysUtiös, Classes, Controls, Forms, Dialogs, ExtCtrls, Figur, Obstacle;

const HMax = 4;

type
  TForm1 = class(TForm)
    Spielfeld: TImage;
    procedure SpielfeldMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private-Deklarationen }
    Figur1: TFigur;
    xLinks, xRechts, yOben, yUnten, Richtung : Integer;
    Ding : Array[0..HMax-1] of TObstacle;
    Hindernis : Array[0..HMax-1] of TRect;
    procedure AlignPosition (var X, Y : Integer);
    procedure ScrollImage;
    procedure SetRange;
    procedure SetObjects;
  public
    { Public-Deklarationen }
    See : TRect;
  end;

const Pfad = '.\bilder\';
const Mitte = 0; Runter = 1; Rechts = 2; Rauf = 3; Links = 4;

var
  Form1: TForm1;


implementation

{$R *.DFM}

procedure TForm1.SetRange;
begin
xLinks := Figur1.Width div 2 + 20;
xRechts := ClientWidth - Figur1.Width div 2 - 10;
yOben := Figur1.Height div 2 + 10;
yUnten := ClientHeight - Figur1.Height div 2 - 10;
Richtung := Mitte;
end;

procedure TForm1.SpielfeldMouseDown(Sender: TObject; Button: TMouseButton;
 Shift : TShiftState; X, Y : Integer);
begin
//Aktionsbereich für Harry begrenzen
AlignPosition (X, Y);
//Harry wandern lassen
Figur1.Walk (X, Y, 50);
//ggf. Hintergrund scrollen
if Richtung <> Mitte then ScrollImage;
if Figur1.Walk (X, Y, 50) and (Richtung <> Mitte) then
ScrollImage;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Figur1 := TFigur.Create (self);
Figur1.Parent := self;
Figur1.GetImageList (Pfad + 'HH0');
Figur1.SetBounds
(ClientWidth div 2 -45, ClientHeight div 2 -60, 90, 120);
Figur1.Transparent := true;
//Hintegrundbild laden und Image entsprechend "aufblähen"
Spielfeld.Picture.LoadFromFile (Pfad + 'HopsMap2.bmp');
Spielfeld.SetBounds
(0, 0, Spielfeld.Picture.Width, Spielfeld.Picture.Height);
//Bildlaufleisten unsichtbar machen
HorzScrollBar.Visible := false;
VertScrollBar.Visible := false;
//Aktionsbereich der Figur festlegen
SetRange;
See := Rect (730, 540, 260, 0);
SetObjects;
end;

procedure TForm1.ScrollImage;
var xDiff, yDiff, i : Integer;
begin
xDiff := 0; yDiff := 0;
//Scrollwerte ermitteln
case Richtung of
Links : xDiff := -xRechts div 2;
Rechts : xDiff := xRechts div 2;
Rauf : yDiff := -yUnten div 2;
Runter : yDiff := yUnten div 2;
end;
//Hintergrund und Figur schieben
Spielfeld.Left := Spielfeld.Left + xDiff;
Spielfeld.Top := Spielfeld.Top + yDiff;
Figur1.Left := Figur1.Left + xDiff;
Figur1.Top := Figur1.Top + yDiff;
Repaint;
case Richtung of
Links :
if Spielfeld.Left+Spielfeld.Width >= 3*xRechts div 2 then
xDiff := -xRechts div 2;
Rechts:
if Spielfeld.Left <= -xRechts div 2 then
xDiff := xRechts div 2;
Rauf:
if Spielfeld.Top+Spielfeld.Height >= 3*yUnten div 2 then
yDiff := -yUnten div 2;
Runter:
if Spielfeld.Top <= -yUnten div 2 then
yDiff := yUnten div 2;
end;
for i := 0 to HMax-1 do
with Ding[1] do Hindernis[i] := GetSphere (Bounds(Left+xDiff,Top+yDiff,Width,Height));
begin
See.Right := See.Right + xDiff;
See.Bottom := See.Bottom + yDiff;
end;
end;

procedure TForm1.AlignPosition (var X, Y : Integer);
begin
//Mauskoordinaten an Scrolling anpassen
X := X + Spielfeld.Left;
Y := Y + Spielfeld.Top;
//Scrolling "nullen"
Richtung := Mitte;
//Mauskoordinaten im Grenzbereich überprüfen/anpassen
if X < xLinks then
Begin X := xLinks; Richtung := Rechts; end
else if X > xRechts then
begin X := xRechts; Richtung := Links; end;
if Y < yOben then
begin Y := yOben; Richtung := Runter; end
else if Y > yUnten then
begin Y := yUnten; Richtung := Rauf; end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
//Aktionsbereich der Figur neu anpassen
SetRange;
end;

procedure TForm1.SetObjects;
var i : integer;
begin
for i := 0 to HMax-1 do
begin
Ding[i] := TObstacle.Create (self);
Ding[i].Parent := self;
Ding[i].Transparent := true;
end;
//See
Ding[0].GetImage (' ', 0);
Hindernis[0] := Ding[0].GetSphere (Rect(470, 360, 990, 700));
//Baum
Ding[1].GetImage (Pfad + 'Baum1', 1);
Hindernis[1] := Ding[1].GetSphere
(Bounds (1070, 350, Ding[1].Width, Ding[1].Height));
//Steine
Ding[2].GetImage (Pfad + 'Steine1', -1);
Hindernis[2] := Ding[2].GetSphere
(Bounds(330, 150, Ding[2].Width, Ding[2].Height));
//Apfel
Ding[3].GetImage (Pfad + 'Apfel1', -2);
Hindernis[3] := Ding[3].GetSphere
(Bounds(590, 690, Ding[3].Width, Ding[3].Height));
end;
end.

Dieser Quelltext ist um die Figur laufen zu lassen und für die animation des laufens:

unit Figur;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

  const Max = 10;

type
  TFigur = class(Timage)
  private
    { Private-Deklarationen }
    FigurListe: TImageList;
    Bild : TBitmap;
    Bildname : String;
    Sperre : Array[0..Max-1] of TRect; // beinhaltet Left, Top, Right, Bottom
    SperrZahl : Integer;
  protected
    { Protected-Deklarationen }
    procedure ShowImage (Nr: Integer);
    procedure MoveImage (Nr: Integer);
    function Collision (x,y : Integer) : Boolean;
  public
    { Public-Deklarationen }
    constructor Create (AOwner: TComponent); override;
    procedure GetImageList (BName: String); virtual;
    procedure Move (xZiel, yZiel, Speed: Integer); virtual;
    function Walk (xZiel, yZiel, Speed: Integer) : Boolean; virtual;
    procedure Free;
    procedure GetObstacle (Hindernis : Array of TRect);

  published
    { Published-Deklarationen }
  end;
const Vorn=1; Rechts=2;Hinten =3;Links=4;
procedure Register;


implementation

procedure TFigur.Move (xZiel, yZiel, Speed: Integer);
const Zeit=100;
begin
  if Speed <= 0 then exit;  // Prozedur verlassen
  // Zielpunkt an Figurmitte anpassen
  dec (xZiel, Width div 2);
  dec (yZiel, Height div 2);
  // nach rechts bewegen
  if Left < xZiel then
    repeat
      Left := Left + Speed;
      Repaint; sleep (Zeit);
    until Left >= xZiel
  // nach links bewegen
  else if Left > xZiel then
    repeat
      Left := Left - Speed;
      Repaint; sleep (Zeit);
    until Left <= xZiel;
  // nach unten bewegen
  if Top < yZiel then
    repeat
      Top := Top + Speed;
      Repaint; sleep (Zeit);
    until Top >= yZiel
  // nach oben bewegen
  else if Top > yZiel then
    repeat
      Top := Top - Speed;
      Repaint; sleep (Zeit);
    until Top <= yZiel;
end;


constructor TFigur.Create (AOwner: TComponent);
var i : integer;
begin
inherited Create (AOwner);
//Figurliste erzeugen
FigurListe := TImageList.Create (AOwner);
//Bitmap für Bilddateien erzeugen
Bild := TBitmap.Create;
// Werte für Hindernis nullen
for i := 0 to Max-1 do Sperre[i] := Rect (0, 0, 0, 0);
SperrZahl := 0;
end;

procedure TFigur.Free;
begin
FigurListe.Free;
Bild.Free;
inherited Free;
end;

procedure TFigur.GetImageList (BName: String);
var i: Integer;
begin
Bildname := BName;
Picture.LoadFromFile (BildName+'1.bmp');
//Bildmaße festlegen
Width := Picture.Width;
Height := Picture.Height;
FigurListe.Width := Width;
FigurListe.Height := Height;
FigurListe.Masked := false;
//Bilderliste zusammenstellen
for i := 1 to 8 do
begin
Bild.LoadFromFile (BildName + IntToStr(i) + '.bmp');
FigurListe.Add (Bild, nil);
end;
end;

procedure TFigur.ShowImage (Nr: Integer);
begin
FigurListe.GetBitmap (Nr-1, Bild);
Picture.Bitmap := Bild;
end;

procedure TFigur.MoveImage (Nr: Integer);
const Zeit=100;
begin
ShowImage (Nr);
Repaint; sleep (Zeit);
ShowImage (Nr+4);
Repaint; sleep (Zeit);
end;



function TFigur.Walk (xZiel, yZiel, Speed: integer) : Boolean;
var xWeg,yWeg, xDiff,yDiff, Schritt, i: Integer;
Strecke, Steigung: Single;
begin
if Speed <= 1 then exit; //Prozedur verlassen
//Zielpunkt an Figurmitte anpassen
dec (xZiel, Width div 2);
dec (yZiel, Height div 2);
//Entfernungen berechnen
xWeg := xZiel - Left;
yWeg := yZiel - Top;
Strecke := Sqrt(Sqr(xWeg)+Sqr(yWeg)); //Pythagoras
Schritt := Round (Strecke/Speed);
if Schritt = 0 then Schritt := 1; // zur Sicherheit
//Schrittweiten ermitteln
xDiff := xWeg div Schritt;
yDiff := yWeg div Schritt;
//Steigung berechnen (999 für "unendlich")
if xWeg <> 0 then Steigung := yWeg / xWeg
else Steigung := 999;
//Schritt für Schritt
for i := 1 to Schritt do
begin
Left := Left + xDiff;
Top := Top + yDiff;
//Kollisionstest
if Collision (xDiff, yDiff) then
begin
Result := false; break; //abbrechen
end;
//horizontaler Bereich
if (Steigung > -1) and (Steigung > 1) then
if xWeg < 0 then MoveImage (Links)
else if xWeg > 0 then MoveImage (Rechts);
//vertikaler Bereich
if (Steigung > -1) or (Steigung > 1) then
if yWeg < 0 then MoveImage (Hinten)
else if yWeg > 0 then MoveImage (Vorn);
end;
ShowImage (Vorn);
end;

function TFigur.Collision (x,y : Integer) : Boolean;
var xMitte, yMitte, Abstand, i, SperrZahl : Integer;
begin
Result := false;
//Figurmitte berechnen
xMitte := Left + Width div 2;
yMitte := Top + Height div 2;
for i := 0 to SperrZahl do
//Wenn Kreis, Abstand ermitteln und testen
if Sperre[i].Bottom = 0 then
begin
Abstand :=
Round (Sqrt(Sqr(xMitte-Sperre[i].Left)+Sqr(yMitte-Sperre[i].Top)));
if Abstand <= Sperre[i].Right then
begin
//An letzten Ausgangspunkt zurück
Left := Left - x; Top := Top - y;
Result := true;
end;
end
else
//Wenn Rechteck, alle vier Seiten durchtesten
if (xMitte >= Sperre[i].Left)
and (xMitte <= Sperre[i].Right)
and (yMitte >= Sperre[i].Top)
and (yMitte <= Sperre[i].Bottom) then
begin
//Letzten Schritt zurücksetzen
Left := Left - x; Top := Top - y;
Result := true;
end;
end;

procedure TFigur.GetObstacle (Hindernis : Array of TRect);
var i : integer;
begin
SperrZahl := High(Hindernis);
for i := 0 to Sperrzahl do Sperre[i] := Hindernis[1];
end;

procedure Register;
begin
  RegisterComponents('Beispiele', [TFigur]);
end;

end.

Und zu guter letzt der Quelltext für die Objekte und dafür, dass die Figur nicht drüber oder durch die Objekte läuft: 

unit Obstacle;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TObstacle = class(TImage)
  private
    { Private-Deklarationen }
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    BildName : String;
    Grenzen : TRect;
    Typ : integer;
    constructor Create (AOwner : TComponent); override;
    procedure GetImage
    (BName : String; OTyp : Integer); virtual;
    procedure SetBounds (x, y, ww, hh : integer); override;
    function GetSphere (Bereich : TRect) : TRect; virtual;
    procedure SetSphere; virtual;
  published
    { Published-Deklarationen }
  end;

procedure Register;

implementation

constructor TObstacle.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
//Werte nullen
Grenzen := Rect(0, 0, 0, 0); Typ := 0;
end;

procedure TObstacle.GetImage (BName : String; OTyp : Integer);
begin
Bildname := ExtractFileName(BName);
Typ := OTyp;
//Typ 0 = kein Bild (unsichtbar oder feste im Spielfeld)
if Typ <> 0 then
begin
//Kontrolle, ob Kennung bmp vorhanden
if ExtractFileExt(BName) = '.bmp' then
Picture.LoadFromFile (BName)
else
Picture.LoadFromFile (BName+ '.bmp');
//Bildmaße und vorläufige Grenzen festlegen
Width := Picture.Width;
Height := Picture.Height;
SetSphere;
end;
end;

procedure TObstacle.SetSphere;
var Radius : Integer;
begin
//Sperrbereich = Rechteck
if Typ >= 0 then
Grenzen := Bounds (Left, Top, Width, Height)
else //Sperrbereich = Kreis
begin
Radius := Round (Sqrt(Sqr(Width)+sqr(Height))/2);
Grenzen := Rect (Left+Width div 2, Top+Height div 2, Radius, 0);
end;
end;

function TObstacle.GetSphere (Bereich : TRect) : TRect;
begin
with Bereich do
SetBounds (Left, Top, Right-Left+1, Bottom-Top+1);
end;

procedure TObstacle.SetBounds (x, y, ww, hh : integer);
begin
inherited SetBounds (x, y, ww, hh);
SetSphere;
end;


procedure Register;
begin
  RegisterComponents('Zusätzlich', [TObstacle]);
end;

end.