pixelcore.pas

传奇源代码的delphi版本

unit PixelCore;

{* PixelCore, fast routines for pixel manipulation. *}

{ by Henri Hakl,  aka A-Lore        e-mail: [e-mail]
  adaptation of work done by CreepingGhost, JerK, and Michael Wilson }

{
  Includes procedures and functions to:
    - lock and unlock a surface
    - set pixels
    - get pixels
    - line drawing  (no clipping)
    - generalized PutPixel, GetPixel and Line routines

  this unit utilizes fast assembler routines and datastructures that support
  the creation of fast pixel based graphic effects.
}

{
  Disclaimer:
    - these functions and procedures have only been tested in Delphi 4 -
      to speed up assembler procedure calls, a number of shortcuts have been
      implemented, these may not be compatible with other versions of Delphi
    - procedures and functions for BitDepth 24 have not been tested, though I
      sincerely hope they function as they are supposed to
    - I don't take any responsibility for problems of any sort caused by the
      code in PixelCore. In turn you may use it as free source. Recognition of
      my work would be appreciated though.
}

interface

uses
   Windows, Classes,
{$IfDef StandardDX}
   DirectDraw;
{$Else}
   DirectX;
{$EndIf}

var
   TheSurfaceDesc : TDDSurfaceDesc2;
   LockRect       : TRect;

   pPutPixel : pointer;
   pGetPixel : pointer;
   pLine     : pointer;

function  DXSurfaceLock(Surface : IDirectDrawSurface4; BitsPixel : word) : boolean;
procedure DXSurfaceUnlock(Surface : IDirectDrawSurface4);

procedure SetToBitDepth(BitsPixel : word);

procedure PutPixel(x,y,color : integer);
function  GetPixel(x,y : integer) : integer;
procedure Line(x1,y1,x2,y2,color : integer);

procedure PutPixel8(x,y,color : integer);
procedure PutPixel16(x,y,color : integer);
procedure PutPixel24(x,y,color : integer);
procedure PutPixel32(x,y,color : integer);

function  GetPixel8(x,y : integer) : integer;
function  GetPixel16(x,y : integer) : integer;
function  GetPixel24(x,y : integer) : integer;
function  GetPixel32(x,y : integer) : integer;

procedure Line8(x1,y1,x2,y2,color : integer);
procedure Line16(x1,y1,x2,y2,color : integer);
procedure Line24(x1,y1,x2,y2,color : integer);
procedure Line32(x1,y1,x2,y2,color : integer);

implementation

function DXSurfaceLock(Surface : IDirectDrawSurface4; BitsPixel : word) : boolean;
begin
   Result:=True;
   TheSurfaceDesc.dwSize:=SizeOf(TDDSurfaceDesc);
   if Surface.Lock(nil,TheSurfaceDesc,DDLOCK_SURFACEMEMORYPTR+DDLOCK_WAIT,0)<>DD_OK then Result:=False;
   SetToBitDepth(BitsPixel);
end;

procedure SetToBitDepth(BitsPixel : word);
begin
   case BitsPixel of
      8 : begin pPutPixel:=@PutPixel8;  pGetPixel:=@GetPixel8;  pLine:=@Line8;  end;
     16 : begin pPutPixel:=@PutPixel16; pGetPixel:=@GetPixel16; pLine:=@Line16; end;
     24 : begin pPutPixel:=@PutPixel24; pGetPixel:=@GetPixel24; pLine:=@Line24; end;
     32 : begin pPutPixel:=@PutPixel32; pGetPixel:=@GetPixel32; pLine:=@Line32; end;
   end;
end;

procedure DXSurfaceUnlock(Surface : IDirectDrawSurface4);
begin
   Surface.Unlock(TheSurfaceDesc.lpSurface);
end;

procedure PutPixel(x,y,color : integer);
asm
   call pPutPixel
end;

function  GetPixel(x,y : integer) : integer;
asm
   call pGetPixel
end;

procedure Line(x1,y1,x2,y2,color : integer);
begin
   asm
      mov eax,[y2]                       // must maintain y2 and color across
      push eax                           // CALL operation; x1, y1 and x2 are 
      mov eax,[color]                    // present in eax, edx and ecx
      push eax
      mov eax,[x1]                       // restore x1 to eax
      call pLine                         // call Line procedure
   end;
end;

procedure PutPixel8(x,y,color : integer);
{ on entry:  x = eax,   y = edx,   color = ecx }
asm
   push esi                              // must maintain esi

   mov esi,TheSurfaceDesc.lpSurface      // set to surface
   add esi,eax                           // add x
   mov eax,[TheSurfaceDesc.lpitch]       // eax = pitch
   mul edx                               // eax = pitch * y
   add esi,eax                           // esi = pixel offset

   mov ds:[esi],cl                       // set pixel (lo byte of ecx)

   pop esi                               // restore esi
   ret                                   // return
end;

procedure PutPixel16(x,y,color : integer);
{ on entry:  x = eax,   y = edx,   color = ecx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   shl eax,1
   add esi,eax                           // description similar to PutPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov ds:[esi],cx

   pop esi
   ret
end;

procedure PutPixel24(x,y,color : integer);
{ on entry:  x = eax,   y = edx,   color = ecx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   imul eax,3
   add esi,eax                           // description similar to PutPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov eax,ds:[esi]       // the idea is to get the current pixel
   and eax,$ff000000      // and the top 8 bits of next pixel (red component)
   or  ecx,eax            // then bitwise OR that component to the current color
   mov ds:[esi+1],ecx     // to ensure the prior bitmap isn't incorrectly manipulated
                          // can't test if it works... so hope and pray
   pop esi
   ret
end;

procedure PutPixel32(x,y,color : integer);
{ on entry:  x = eax,   y = edx,   color = ecx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   shl eax,2
   add esi,eax                           // description similar to PutPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov ds:[esi],ecx

   pop esi
   ret
end;

function  GetPixel8(x,y : integer) : integer;
{ on entry:  x = eax,   y = edx }
asm
   push esi                              // myst maintain esi

   mov esi,TheSurfaceDesc.lpSurface      // set to surface
   add esi,eax                           // add x
   mov eax,[TheSurfaceDesc.lpitch]       // eax = pitch
   mul edx                               // eax = pitch * y
   add esi,eax                           // esi = pixel offset

   mov eax,ds:[esi]                      // eax = color
   and eax,$ff                           // map into 8bit

   pop esi                               // restore esi
   ret                                   // return
end;

function  GetPixel16(x,y : integer) : integer;
{ on entry:  x = eax,   y = edx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   shl eax,1
   add esi,eax                           // description similar to GetPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov eax,ds:[esi]
   and eax,$ffff                         // map into 16bit

   pop esi
   ret
end;

function  GetPixel24(x,y : integer) : integer;
{ on entry:  x = eax,   y = edx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   imul eax,3
   add esi,ebx                           // description similar to GetPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov eax,ds:[esi]
   and eax,$ffffff                       // map into 24bit

   pop esi
   ret
end;

function  GetPixel32(x,y : integer) : integer;
{ on entry:  x = eax,   y = edx }
asm
   push esi

   mov esi,TheSurfaceDesc.lpSurface
   shl eax,2
   add esi,eax                           // description similar to GetPixel8
   mov eax,[TheSurfaceDesc.lpitch]
   mul edx
   add esi,eax

   mov eax,ds:[esi]

   pop esi
   ret
end;

procedure Line8(x1,y1,x2,y2,color : integer);
{ no clipping is performed }
begin
   asm
      push ebx
      push ebp
      push edi
      push esi