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);
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;
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;
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;
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;
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;
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
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.
07.05.2014, 13:05
Непонятная ошибка
Линейный вид
