Показать сообщение отдельно
  #1  
Старый 07.05.2014, 13:05
Аватар для hsMapk
hsMapk hsMapk вне форума
Новичок
 
Регистрация: 17.04.2014
Сообщения: 60
Версия Delphi: Delphi 7
Репутация: 5
По умолчанию Непонятная ошибка

EXE запускается ,но по нажатию на кнопку запустить в проекте пишет эту ошибку:



вот собственно код:
Код:
unit tools;

interface

uses Windows, Classes, Controls, DXDraws, DXClass, DXInput, DirectX, sysutils,
     people, global_var;

function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect; x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean;
function getfeld(mx,my: integer): TPoint;
function makecoord(x: TPoint): TPoint;
procedure drawmap;
procedure drawfeld(x,y: integer);
procedure calcscene;

implementation

uses main, control;


function getfeld(mx,my: integer): TPoint;
var x,y: integer;
    mouserect: TRect;
    picX, bildy: integer;
begin
  x := (mx+posx) div feldbreite;
  y := (my+posy) div feldhoehe;

  result.x := x;
  result.y := y*2;

  picX := mx + posx - x * feldbreite;
  bildy := my + posy - y * feldhoehe;
  mouserect := rect(mx, my, mx+1, my+1);
  //Oben links
  if rectinrect(mouserect, rect(x*feldbreite-posx,  y*feldhoehe-posy,  x*feldbreite+feldbreite div 2-posx,  y*feldhoehe+feldhoehe div 2-posy)) then
    if surf1.Pixels[picX, bildy] = 0 then
    begin result.x:=x-1; result.y:=y*2-1; end;
  //Oben rechts
  if rectinrect(mouserect, rect(x*feldbreite+feldbreite div 2-posx,  y*feldhoehe-posy,  x*feldbreite+feldbreite-posx,  y*feldhoehe+feldhoehe div 2-posy)) then
    if surf1.Pixels[picX, bildy] = 0 then
    begin result.x:=x; result.y:=y*2-1; end;
  //Unten links
  if rectinrect(mouserect, rect(x*feldbreite-posx,  y*feldhoehe+feldhoehe div 2-posy,  x*feldbreite+feldbreite div 2-posx,  y*feldhoehe+feldhoehe-posy)) then
    if surf1.Pixels[picX, bildy] = 0 then
    begin result.x:=x-1; result.y:=y*2+1; end;
  //Unten rechts
  if rectinrect(mouserect, rect(x*feldbreite+feldbreite div 2-posx,  y*feldhoehe+feldhoehe div 2-posy,  x*feldbreite+feldbreite-posx,  y*feldhoehe+feldhoehe-posy)) then
    if surf1.Pixels[picX, bildy] = 0 then
    begin result.x:=x;   result.y:=y*2+1; end;
end;


function makecoord(x: TPoint): TPoint;
begin
  result.x := x.x * feldbreite + (x.y mod 2) * feldhoehe - posx;
  result.y := x.y * feldhoehe div 2 - posy;
end;

procedure drawmap;
var x,y: integer;
begin
  with form1 do
  begin
    drawcount := 0;
    fillchar(drawlist, sizeof(drawlist), 0);

    posx := round(mensch[1].cx) - 320;
    posy := round(mensch[1].cy) - 240;

    if posx < feldbreite then posx := feldbreite;
    if posx + dxdraw1.width > mapwidth*feldbreite then posx := mapwidth*feldbreite - dxdraw1.width;
    if posy < feldhoehe then posy := feldhoehe;
    if posy + dxdraw1.height > mapheight*feldhoehe div 2 then posy := mapheight*feldhoehe div 2 - dxdraw1.height;

    //Untergrund zeichnen
    for y := posy div feldhoehe*2-1 to posy div feldhoehe*2+35 do
      for x := posx div feldbreite-1 to posx div feldbreite+12 do
        dxdraw1.surface.draw(makecoord(point(x,y)).x, makecoord(point(x,y)).y, terrainbilder[karte[x,y].image].ClientRect, terrainbilder[karte[x,y].image],true);

    for y := posy div feldhoehe*2-1 to posy div feldhoehe*2+42 do
      for x := posx div feldbreite-1 to posx div feldbreite+12 do
        if y <= mapheight then
        begin
          drawfeld(x,y);
          if (karte[x-1,y].menschen_kennung > 0) and (x > 0) then drawfeld(x-1,y);
        end;
  end;
end;


procedure drawfeld(x,y: integer);
var h, index: integer;
    p, p2: TPoint;
begin
  with form1 do
  begin
    if karte[x,y].haus_kennung > 0 then
    begin
      h := hausbilder[karte[x,y].haus_kennung].height;
      p := makecoord(point(x, y));
      p2 := point(makecoord(karte[x,y].haus_teil).x + posx, makecoord(karte[x,y].haus_teil).y + posy);
      dxdraw1.surface.Draw(p.x, p.y - h, rect(p2.x, p2.y - h, p2.x + 56, p2.y + 28), hausbilder[karte[x,y].haus_kennung], true);
    end;

    //Mensch
    if karte[x,y].menschen_kennung > 0 then
    begin
      if not (karte[x,y].menschen_kennung in [drawlist[1], drawlist[high(drawlist)]]) then
      begin
        inc(drawcount);
        drawlist[drawcount] := karte[x,y].menschen_kennung;
      end;  

      index := karte[x,y].menschen_kennung;
      dxdraw1.surface.Draw(mensch[index].pos.x, mensch[index].pos.y, menschenbilder[mensch[index].image].ClientRect,menschenbilder[mensch[index].image], true);
      if mensch[index].showanzeigen then
      begin
        case mensch[index].fade of
          300..550: dxdraw1.surface.drawalpha(rect(mensch[index].pos.x, mensch[index].pos.y - 4, mensch[index].pos.x + mensch[index].life, mensch[index].pos.y), rect(0,0,mensch[index].life,4), lebensanzeige, false, mensch[index].fade - 300);
          551..800: dxdraw1.surface.draw(mensch[index].pos.x, mensch[index].pos.y - 4, rect(0, 0, mensch[index].life, 4), lebensanzeige, false);
          801..1050: dxdraw1.surface.drawalpha(rect(mensch[index].pos.x, mensch[index].pos.y - 4, mensch[index].pos.x + mensch[index].life, mensch[index].pos.y), rect(0,0,mensch[index].life,4), lebensanzeige, false, 250 - (mensch[index].fade - 801));
        end;
      end;
    end;
  end;
end;


procedure calcscene;
var i: integer;
begin
  //Eigene Player und KI steuern
  for i := 1 to high(mensch) do
    mensch[i].calc;
end;


function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect;
  x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean;
  function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
  begin
    with DestRect do
    begin
      Left := Max(Left, DestRect2.Left);
      Right := Min(Right, DestRect2.Right);
      Top := Max(Top, DestRect2.Top);
      Bottom := Min(Bottom, DestRect2.Bottom);

      Result := (Left < Right) and (Top < Bottom);
    end;
  end;
type
  PRGB = ^TRGB;
  TRGB = packed record
    R, G, B: Byte;
  end;
var
  ddsd1, ddsd2: DDSURFACEDESC;
  r1, r2: TRect;
  tc1, tc2: DWORD;
  x, y, w, h: Integer;
  P1, P2: Pointer;
begin
  r1 := rect1;
  with rect2 do r2 := Bounds(x2-x1, y2-y1, Right-Left, Bottom-Top);

  Result := OverlapRect(r1, r2);

  if (suf1=nil) or (suf2=nil) then Exit;

  if DoPixelCheck and Result then
  begin
    with r1 do r1 := Bounds(Max(x2-x1, 0), Max(y2-y1, 0), Right-Left, Bottom-Top);
    with r2 do r2 := Bounds(Max(x1-x2, 0), Max(y1-y2, 0), Right-Left, Bottom-Top);

    ClipRect(r1, rect1);
    ClipRect(r2, rect2);

    w := Min(r1.Right-r1.Left, r2.Right-r2.Left);
    h := Min(r1.Bottom-r1.Top, r2.Bottom-r2.Top);

    ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
    ClipRect(r2, bounds(r2.Left, r2.Top, w, h));
                               
    ddsd1.dwSize := SizeOf(ddsd1);
    if suf1.Lock(r1, ddsd1) then
    begin
      try
        ddsd2.dwSize := SizeOf(ddsd2);
        if (suf1=suf2) or suf2.Lock(r2, ddsd2) then
        begin
          try
            if suf1=suf2 then ddsd2 := ddsd1;
            if ddsd1.ddpfPixelFormat.dwRGBBitCount<>ddsd2.ddpfPixelFormat.dwRGBBitCount then Exit;

            tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
            tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;

            case ddsd1.ddpfPixelFormat.dwRGBBitCount of
              8 : begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PByte(P1)^<>tc1) and (PByte(P2)^<>tc2) then Exit;
                        Inc(PByte(P1));
                        Inc(PByte(P2));
                      end;
                    end;
                  end;
              16: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PWord(P1)^<>tc1) and (PWord(P2)^<>tc2) then Exit;
                        Inc(PWord(P1));
                        Inc(PWord(P2));
                      end;
                    end;
                  end;
              24: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin        
                        with PRGB(P1)^ do if (R shl 16) or (G shl 8) or B<>tc1 then Exit;
                        with PRGB(P2)^ do if (R shl 16) or (G shl 8) or B<>tc2 then Exit;
                        Inc(PRGB(P1));
                        Inc(PRGB(P2));
                      end;
                    end;
                  end;
              32: begin
                    for y:=0 to h-1 do
                    begin
                      P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
                      P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
                      for x:=0 to w-1 do
                      begin
                        if (PDWORD(P1)^<>tc1) and (PDWORD(P2)^<>tc2) then Exit;
                        Inc(PDWORD(P1));
                        Inc(PDWORD(P2));
                      end;
                    end;
                  end;
            end;
          finally
            if suf1<>suf2 then suf2.UnLock;
          end;
        end;
      finally
        suf1.UnLock;
      end;
    end;

    Result := False;
  end;
end;

end.
Ответить с цитированием