unit1.~pas

类似超级玛丽模型之二(DELPHIX)

Procedure TMainForm.calcbmask(imageno: integer);
Var p, xx, yy       : integer;
  d                 : ^hubba;
Begin
  For p := 0 To dximagelist1.Items[imageno].PatternCount - 1 Do
  Begin
    For yy := 0 To 31 Do
    Begin
      d := DXImageList1.Items[imageno].Picture.Bitmap.ScanLine[yy + (p Shr 4) Shl 5];
      For xx := 0 To 31 Do
        If (d[(xx + (p Mod 16) Shl 5) * 3 + 2] = 255) And (d[(xx + (p Mod 16) Shl 5) * 3 + 1] = 0) And (d[(xx + (p Mod 16) Shl 5) * 3] = 0) Or
        (d[(xx + (p Mod 16) Shl 5) * 3 + 2] = 0) And (d[(xx + (p Mod 16) Shl 5) * 3 + 1] = 0) And (d[(xx + (p Mod 16) Shl 5) * 3] = 255) Then
        Begin
          bmask[p, xx, yy] := true;
        End Else bmask[p, xx, yy] := false;
    End;
  End;
End;

Procedure FixImg16(imgno: integer);
Var xx, yy, r, g, b : integer;
  d                 : ^hubba;

Begin
//exit;
  mainform.dximagelist1.Items[imgno].picture.Bitmap.PixelFormat := pf24bit;
  For yy := 0 To mainform.dximagelist1.Items[imgno].picture.bitmap.height - 1 Do
  Begin
    d := mainform.DXImageList1.Items[imgno].Picture.Bitmap.ScanLine[yy];
    For xx := 0 To mainform.dximagelist1.Items[imgno].picture.bitmap.width - 1 Do
    Begin
      b := d[xx * 3 + 0];
      g := d[xx * 3 + 1];
      r := d[xx * 3 + 2];
//  if r shr 3 shl 3 <> r then
      If (r + g Shl 8 + b Shl 16 <> clred) Then
      Begin
        r := round((r - 8 + random(16)) / 8) Shl 3;
        g := round((g - 4 + random(8)) / 4) Shl 2;
        b := round((b - 8 + random(16)) / 8) Shl 3;
        If b > 255 Then b := 255;
        If r > 255 Then r := 255;
        If g > 255 Then g := 255;
        If r < 0 Then r := 0;
        If g < 0 Then g := 0;
        If b < 0 Then b := 0;
      End;                              {}
      d[xx * 3 + 0] := b;               //5
      d[xx * 3 + 1] := g;               //6
      d[xx * 3 + 2] := r;               //5
    End;
  End;
End;


Procedure FixImg8(imgno: integer);
Var xx, yy, r, g, b : integer;
  d                 : ^hubba;

Begin
  mainform.dximagelist1.Items[imgno].picture.Bitmap.PixelFormat := pf24bit;
  For yy := 0 To mainform.dximagelist1.Items[imgno].picture.bitmap.height - 1 Do
  Begin
    d := mainform.DXImageList1.Items[imgno].Picture.Bitmap.ScanLine[yy];
    For xx := 0 To mainform.dximagelist1.Items[imgno].picture.bitmap.width - 1 Do
    Begin
      r := d[xx * 3 + 2];
      g := d[xx * 3 + 1];
      b := d[xx * 3 + 0];
      If (r <> 0) And (r <> 255) Then
      Begin
        r := round((r - 32 + random(64)) / 32) Shl 5;
        If r >= 255 Then r := 254;
      End;

      If (g <> 0) And (g <> 255) Then
        g := round((g - 32 + random(64)) / 32) Shl 5;

      If (b <> 0) And (b <> 255) Then
        b := round((b - 64 + random(128)) / 64) Shl 6;

      If b > 255 Then b := 255;
      If r > 255 Then r := 255;
      If g > 255 Then g := 255;
      If r < 0 Then r := 0;
      If g < 0 Then g := 0;
      If b < 0 Then b := 0;

      d[xx * 3 + 2] := r;               //3
      d[xx * 3 + 1] := g;               //3
      d[xx * 3 + 0] := b;               //2
    End;
  End;
End;


Procedure flipimg(from, fto: integer);
Var p, xx, yy       : integer;
  d, d2             : ^hubba;
Begin
  mainform.dximagelist1.Items[fto].picture.Bitmap.PixelFormat := pf32bit;
  mainform.dximagelist1.Items[from].picture.Bitmap.PixelFormat := pf32bit;

  mainform.DXImageList1.Items[fto].Picture.Bitmap.Width :=
    mainform.DXImageList1.Items[from].Picture.Bitmap.Width;

  mainform.DXImageList1.Items[fto].Picture.Bitmap.Height :=
    mainform.DXImageList1.Items[from].Picture.Bitmap.Height;

  For p := 0 To mainform.dximagelist1.Items[from].PatternCount - 1 Do
  Begin
    For yy := 0 To 31 Do
    Begin
      d := mainform.DXImageList1.Items[from].Picture.Bitmap.ScanLine[yy + (p Shr 4) Shl 5];
      d2 := mainform.DXImageList1.Items[fto].Picture.Bitmap.ScanLine[yy + (p Shr 4) Shl 5];
      For xx := 0 To 31 Do
      Begin
        If xx > 31 Then break;
        d2[(xx + (p Mod 16) Shl 5) * 4 + 0] := d[(31 - xx + (p Mod 16) Shl 5) * 4 + 0]; //r
        d2[(xx + (p Mod 16) Shl 5) * 4 + 1] := d[(31 - xx + (p Mod 16) Shl 5) * 4 + 1]; //g
        d2[(xx + (p Mod 16) Shl 5) * 4 + 2] := d[(31 - xx + (p Mod 16) Shl 5) * 4 + 2]; //b
      End;
    End;
  End;

  mainform.dximagelist1.Items[fto].picture.Bitmap.PixelFormat := pf24bit;
  mainform.dximagelist1.Items[from].picture.Bitmap.PixelFormat := pf24bit;
End;

Function isbonus(sxx, syy: integer): integer; // return obj handle
Var i               : integeR;
Begin
  For i := 0 To length(game.objs) - 1 Do
//i:=1;
    With game.objs[i] Do
      If typo = 78 Then
      Begin
        If (sxx >= xx - 16) And (sxx <= xx + 16) And
          (syy >= yy - 16) And (syy <= yy + 16) Then
        Begin
          game.score := game.score + (typo - 77) * 100;
          result := i;
          With game.gamma Do
          Begin
            r := 1.1;
            g := 1.1;
            b := 1.1;
          End;
          exit;
        End;
      End;
  result := -1;
End;

Function isdoor(sxx, syy: integer): integer; // return obj handle
Var i               : integeR;
Begin
  For i := 0 To length(game.objs) - 1 Do
//i:=1;
    With game.objs[i] Do
      If typo = 50 Then
      Begin
        If (sxx >= xx - 16) And (sxx <= xx + 16) And
          (syy >= yy - 16) And (syy <= yy + 16) Then
        Begin
          result := i;
          exit;
        End;
      End;
  result := -1;
End;






Function IsBlock(xx, yy: integer): integer;
Var dx, dy          : integer;
  gl                : integer;
Begin
  If xx < 0 Then Begin;
    result := 1;
    exit;
  End;
  If xx > game.level.info.width Shl 5 - 1 Then Begin;
    result := 1;
    exit;
  End;
  If yy > game.level.info.height Shl 5 - 1 Then Begin;
    result := -1;
    exit;
  End;
  If yy < -28 Then Begin;
    result := 1;
    exit;
  End;
  If yy < 0 Then Begin;
    result := -1;
    exit;
  End;

  dx := xx - ((xx Shr 5) Shl 5);
  dy := yy - ((yy Shr 5) Shl 5);

//if mainform.DXImageList1.Item[1].patterns.pixe
  gl := game.level.l[GameLayer][xx Shr 5, yy Shr 5];


  If gl < 0 Then
  Begin
    result := gl;
  End Else If bmask[gl, dx, dy] Then result := -1 Else result := gl;
End;

Var lo              : integer;

Function isobj(cx, cy: single; discard: integer): integer;
Var i               : integer;
Begin
  result := -1;
  For i := 0 To length(game.objs) - 1 Do
    If (i <> discard) Then
      With game.objs[i] Do
        If typo > 0 Then
          If (cx >= xx) And (cx <= xx + 31) And
            (cy >= yy) And (cy <= yy + 31) Then
          Begin
            result := i;
            lo := i;
            break;
          End;
End;

Procedure TMainForm.killenemy(objnr: integer);
Begin
  With game.objs[objnr] Do
  Begin
    game.score := game.score + (typo - 100) * 200;
    dec(energy);
    stall := 10;
    If energy = 0 Then
    Begin
      stall := 255;
      pic := 8 + (typo - 100 + 7) * 16;
      typo := 99;
      pushable := false;
      pusher := false;
      tag := 'D谼';
      invince := 255;
    End;
    playsoundfx(xx + 16, yy + 16, 4);
    With game.gamma Do
    Begin
      r := 1;
      g := 1.5;
      b := 1;
    End;
  End;
End;

Procedure tmainform.killjoffa(objnr, enemynr: integer);
Begin
  With game.objs[objnr] Do
  Begin
    If pic = 7 Then
    Begin
      killenemy(enemynr);
      crashx := false;
      game.objs[enemynr].ay := -12;
      game.objs[enemynr].oy := game.objs[enemynr].yy;
      game.objs[enemynr].vx := vx * 2;
      exit;
    End;
    If tag = '' Then
    Begin
      PlaySoundFX(xx, yy, 7);
      typo := 99;
    End Else
    Begin
      PlaySoundFX(xx, yy, 7);
      tag := '';
    End;
    pic := 8;
    stall := 255;
    ay := -8;
    oy := yy;
    With game.gamma Do
    Begin
      r := 2;
      g := 0.5;
      b := 0.5;
    End;
  End;
End;


Function tmainform.pushobjsx(cx, cy, dx: single; discard, level: integer): boolean;
Var i               : integer;
Begin
  result := false;
  For i := 0 To length(game.objs) - 1 Do
    If (i <> discard) Then
      With game.objs[i] Do
        If typo > 0 Then
          If (cx >= xx) And (cx <= xx + 32) And
            (cy >= yy) And (cy <= yy + 31) Then
          Begin
            If (game.objs[discard].stall = 0) Then
              If (typo >= 100) And (game.objs[discard].typo = 1) Then
              Begin
                killjoffa(discard, i);
//          result:=true;
                exit;
              End;
            If yy < game.objs[discard].yy - 26 Then
              If stall = 0 Then
                If (typo = 1) And (game.objs[discard].typo >= 100) Then
                Begin
                  killjoffa(i, discard);
//          result:=true;
                  exit;
                End;
            If (typo >= 100) And (game.objs[discard].typo = 30) Then
            Begin
              tag := 'MOS';
              game.objs[discard].typo := 0;
              ax := ax + game.objs[discard].vx;
              ay := -2;
              oy := yy;
              playsoundfx(xx + 16, yy + 16, 4);
              With game.gamma Do
              Begin
                r := 1;
                g := 1.5;
                b := 1;
              End;
              exit;
            End;

            If (game.objs[discard].pusher) And (pusher) And
              (pushable) And (game.objs[discard].pushable) Then result := true;

            If (pusher) And (game.objs[discard].pushable) Then result := true;
            If (game.objs[discard].pusher) And (pushable) Then
              If crashx Then
              Begin
                crashx := false;
                moveobject(i, dx, 0, level + 1);
//        ax:=ax+dx;
                crashx := true;
              End Else
              Begin
                moveobject(i, dx, 0, level + 1);
//        ax:=ax+dx;
                If crashx Then crashx := true;
              End;
          End;
End;

Function tmainform.pushobjsy(cx, cy: single; Var dy: single; discard, level: integer): boolean;
Var i               : integer;
Begin
  result := false;
  For i := 0 To length(game.objs) - 1 Do
    If (i <> discard) Then
      With game.objs[i] Do
        If typo > 0 Then
          If (cx >= xx) And (cx <= xx + 32) And
            (cy >= yy) And (cy <= yy + 31) Then
          Begin
            If (typo = 40) And (dy < 0) Then // [?] boks
            Begin
              pic := pic + 1;
              inc(typo);
              stall := 0;
              result := true;
              playsoundfx(xx + 16, yy + 16, 2);

              If itag <> -1 Then
                With game.objs[CreateObjectOfBlock(itag, game.objs[i].xx, game.objs[i].yy - 32)] Do
                Begin
                  ay := -8;
                  oy := yy;
                  gravity := true;
                End
              Else
                With game.objs[gethandle] Do
                Begin
                  xx := game.objs[i].xx;
                  yy := game.objs[i].yy - 32;
                  ay := -8;
                  oy := yy;
                  pic := 2 * 16 + 15;
                  typo := 78;
                  If isblock(trunc(xx) + 16, trunc(yy) + 16) > 0 Then
                  Begin
                    blockcrash := true;
                    typo := 98;
                    PlaySoundFX(xx, yy, 3);
                    stall := 255;
                    invince := 255;
                    ay := -2;
                    oy := yy;
                  End;
                End;                    {}
              exit;
            End;                        {}

            If (istrampo) And (dy > 0) Then
            Begin
              stall := 0;
              game.objs[discard].ay := -16;
              dy := 0;
              game.objs[discard].oy := game.objs[discard].yy;
              playsoundfx(xx + 16, yy + 16, 1);
              exit;
            End;

            If (typo >= 100) And (game.objs[discard].typo < 100) Then
              If ((dy > 0) And (yy - 28 > game.objs[discard].yy)) Or (game.objs[discard].typo = 30) Then
              Begin
                game.objs[discard].ay := -8;
                game.objs[discard].oy := game.objs[discard].yy;
                dy := 0;
                killenemy(i);
                exit;
              End;

            If (game.objs[discard].pusher) And (pusher) And
              (pushable) And (game.objs[discard].pushable) Then result := true;

            If (pusher) And (game.objs[discard].pushable) Then
            Begin
              result := true;
              If (dy > 0) And (yy - 31 > game.objs[discard].yy) Then
              Begin
                game.objs[discard].ox := game.objs[discard].ox + vx;
                moveobject(discard, vx, 0, level + 1);
              End;
            End;
            If (game.objs[discard].pusher) And (pushable) Then
              If crashy Then
              Begin
                crashy := false;
                moveobject(i, 0, dy, level + 1);
                crashy := true;
//        ay:=ay+dy;
              End Else
              Begin
                moveobject(i, 0, dy, level + 1);
//        ay:=ay+dy;
                If crashy Then crashy := true;
              End;
          End;
End;




Procedure TMainForm.MoveObject(obj: integer; dvx, dvy: single; level: integer);
Var l               : integer;
  len, dx, dy       : single;

  Procedure movestep;
  Var i             : integer;
  Begin
    With game.objs[obj] Do
    Begin
      If (pusher) Or (pushable) Then
        For i := 0 To 1 Do
        Begin
          If Not crashx Then crashx := pushobjsx(xx + dx + 16, yy + i * 31, dx, obj, level + 1);
          If Not crashy Then crashy := pushobjsy(xx + 16, yy + dy + i * 31, dy, obj, level + 1);
        End;