grafixdx.pas

传奇源代码的delphi版本

    32: FBitDepth:=bd32;
  end;
end;


{ LOAD A JPG IMAGE TO THE SURFACE }
procedure TGrafixSurface.LoadFromJpeg(Filename: string; ResizeFromFile: boolean);
var
  MyBmp: TBitmap;
  MyJpeg: TJpegImage;
begin
  MyBmp:=TBitmap.Create;
  MyJpeg:=TJpegImage.Create;
  MyJpeg.LoadFromFile(Filename);
  MyJpeg.DIBNeeded;
  MyBmp.Assign(MyJpeg); // Copy the Jpeg Image to Bmp

  // Resize surface to the original file width/height
  if ResizeFromFile then
  begin
    FWidth:=MyBmp.Width;
    FHeight:=MyBmp.Height;
    SetSize(FWidth, FHeight);
  end;

  // Store the rect of the surface
  FRect:=rect(0,0,FWidth,FHeight);
  FSurface.Canvas.StretchDraw(FRect, MyBmp); // Stretch image to size of surface
  FSurface.Canvas.Release; // This is so vital otherwise it'll crash

  MyJpeg.Free;
  MyBmp.Free;
end;

{ COPY FROM ANOTHER SURFACE }
procedure TGrafixSurface.CopyFromSurface(var SrcSurface: TDirectDrawSurface);
begin
  Assign(TGrafixSurface(SrcSurface));
end;

procedure TGrafixSurface.DrawToDXDraw(xp, yp: integer; aTransparent: boolean);
begin
  // Draw the GrafixSurface to DXDraw surface
  FSurface.TransparentColor:=FTransColor;
  FDXDraw.Surface.Draw(xp, yp, rect(0,0,FWidth, FHeight), FSurface, aTransparent);
end;

{ *********** THE PIXEL FORMAT ROUTINES ************ }

function TGrafixSurface.RGBToBGR(Color: cardinal): cardinal;
begin
  result:=(LoByte(LoWord(Color)) shr 3 shl 11) or   // Red
          (HiByte((Color)) shr 2 shl 5) or    // Green
          (LoByte(HiWord(Color)) shr 3);           // Blue
end;

procedure TGrafixSurface.GetRGB(Color: cardinal; var R, G, B: Byte);
begin
  R:=Color;
  G:=Color shr 8;
  B:=Color shr 16;
end;


{ *********** THE GFX ROUTINES ************ }

{ LOCK THE SURFACE }
function TGrafixSurface.Lock: Boolean;
begin
  Result:=True;
  FSurfaceDesc.dwSize:=SizeOf( TDDSurfaceDesc2 );
  FLockRect:=Rect(0,0,FSurfaceDesc.dwWidth,FSurfaceDesc.dwHeight);

{ The following 2 lines were the cause of a really annoying/hard to track bug }
//  FWidth:=FSurfaceDesc.dwWidth;
//  FHeight:=FSurfaceDesc.dwHeight;

  if FSurface.ISurface4.Lock( @FLockRect, FSurfaceDesc, DDLOCK_SURFACEMEMORYPTR+DDLOCK_WAIT, 0 )<>DD_OK then Result:=False;
  SurfaceDesc:=FSurfaceDesc;
end;

{ UNLOCK SURFACE }
procedure TGrafixSurface.Unlock;
begin
  FSurface.ISurface4.Unlock( @FLockRect );
end;


{ WRITE A PIXEL ON SURFACE }
procedure TGrafixSurface.PutPixel( X, Y: Integer; Color: cardinal);
var
   xp, yp: Integer;
   r,g,b: byte;
begin
  GetRGB(Color,r,g,b);

  if (x<0) or (x>FWidth-1) or (y<0) or (y>FHeight-1) then
    Exit
  else
    case FBitDepth of
      bd8:
        PByte(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y+X)^:=Color;
      bd16:
       begin
         Color:=RGBToBGR(rgb(r,g,b));
         PWord(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y + (X shl 1))^ :=
           Color;
{               (LoByte(LoWord(Color)) shr 3 shl 11) or   // Red
               (HiByte((Color)) shr 2 shl 5) or    // Green
               (LoByte(HiWord(Color)) shr 3);            // Blue
}       end;
    end;
end;


// NOW WORKS!!!   - 11.Feb.2000  THANKS TO THE DIBULTRA AUTHOR :)
{ GET PIXEL COLOUR FROM SURFACE }
function TGrafixSurface.GetPixel(x, y: Integer) : cardinal;
var
  res: cardinal;
begin
   Result := 0;

   case FBitDepth of
     bd8:
       result:=PByte(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y+X)^;
     bd16:
      begin
       Result:=PWord(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y + (X shl 1))^;
       res:=((Result and $001F) shl 19) + ((Result and $07E0) shl 5) + (Result and $F800) shr 8;
       result:=res;
      end;
   end;
end;


{ DRAW A NORMAL LINE }
procedure TGrafixSurface.Line(X1, Y1, X2, Y2: Integer; Color: cardinal);
var
  i, deltax, deltay, numpixels,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
begin
  { Calculate deltax and deltay for initialisation }
  deltax := abs(x2 - x1);
  deltay := abs(y2 - y1);

  { Initialise all vars based on which is the independent variable }
  if deltax>=deltay then
  begin
    { x is independent variable }
    numpixels:=deltax+1;
    d:=(2*deltay)-deltax;

    dinc1:=deltay shl 1;
    dinc2:=(deltay-deltax) shl 1;
    xinc1:=1;
    xinc2:=1;
    yinc1:=0;
    yinc2:=1;
  end
  else
  begin
    { y is independent variable }
    numpixels:=deltay+1;
    d:=(2*deltax)-deltay;
    dinc1:=deltax shl 1;
    dinc2:=(deltax-deltay) shl 1;
    xinc1:=0;
    xinc2:=1;
    yinc1:=1;
    yinc2:=1;
  end;
  { Make sure x and y move in the right directions }
  if x1>x2 then
  begin
    xinc1:=-xinc1;
    xinc2:=-xinc2;
  end;
  if y1>y2 then
  begin
    yinc1:=-yinc1;
    yinc2:=-yinc2;
  end;
  x:=x1;
  y:=y1;


     { Draw the pixels }
  for i:=1 to numpixels do
  begin
    if (x>0) and (x<FWidth) and (y>0) and (y<FHeight-1) then
      FPixelProc( x,y, Color );
    if d<0 then
    begin
      d:=d+dinc1;
      x:=x+xinc1;
      y:=y+yinc1;
    end
    else
    begin
      d:=d+dinc2;
      x:=x+xinc2;
      y:=y+yinc2;
    end;
  end;
end;

procedure TGrafixSurface.VLine(x,y1,y2: integer; Color: cardinal);
var
  y:integer;
  SurfPtr: ^word;
  SurfPtrColor: cardinal;
  r,g,b: byte;
begin
  if y1<0 then y1:=0;
  if y2>=FHeight then y2:=FHeight-1;

//  for y:=y1 to y2 do  VoxSurface.PutPixel( x,y,rgb(Pal[c].peRed,Pal[c].peGreen,Pal[c].peBlue));
  // The following is 2x faster than the above line of code
  GetRGB(Color, r,g,b);
  SurfPtrColor:=RGBToBGR(rgb(r,g,b));
  for y:=y1 to y2 do
  begin
    SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*y+(x shl 1));
    SurfPtr^:=SurfPtrColor;
  end;
end;


{ MUST BE WITHIN A LOCK/UNLOCK AS YOU WOULD USE SETPIXEL }
procedure TGrafixSurface.LinePolar(x, y: integer; angle, length: extended; Color: cardinal);
var
  xp, yp: integer;
begin
  xp:=round(sin(angle*pi/180)*length)+x;
  yp:=round(cos(angle*pi/180)*length)+y;
  Line(x, y, xp, yp, Color);
end;


{ MUST BE WITHIN A LOCK/UNLOCK AS YOU WOULD USE SETPIXEL }
// I know that the blending of the colours are wrong for the copper bar but
// they'll soon be fixed!!
procedure TGrafixSurface.CopperBar( y, cbHeight: integer; TopColor, MiddleColor,
                                    BottomColor: cardinal);
var
  ColorTop, ColorMid, ColorBot: TRGBQuad;
  rStep, gStep, bStep: integer;
  r,g,b: byte;
  MidPos: integer;
  ctr: integer;
  SurfPtr: ^word;  // This is the pointer to the surface
  SurfPtrColor: cardinal; // The color to plot
  ctrx: integer;
begin
  MidPos:=cbHeight shr 1; // Get the centre of the copperbar

  // Extract the Red, Green and Blue values
  with ColorTop do
    GetRGB(TopColor, rgbRed, rgbGreen, rgbBlue);
  with ColorMid do
    GetRGB(MiddleColor, rgbRed, rgbGreen, rgbBlue);
  with ColorBot do
    GetRGB(BottomColor, rgbRed, rgbGreen, rgbBlue);

  { TOP TO MIDDLE }
  rStep:=(ColorMid.rgbRed-ColorTop.rgbRed) div MidPos;
  gStep:=(ColorMid.rgbGreen-ColorTop.rgbGreen) div MidPos;
  bStep:=(ColorMid.rgbBlue-ColorTop.rgbBlue) div MidPos;
  r:=ColorTop.rgbRed;
  g:=ColorTop.rgbGreen;
  b:=ColorTop.rgbBlue;
{  if ColorMid.rgbRed-ColorTop.rgbRed<0 then rStep:=-rStep;
  if ColorMid.rgbGreen-ColorTop.rgbGreen<0 then gStep:=-gStep;
  if ColorMid.rgbBlue-ColorTop.rgbBlue<0 then bStep:=-bStep;
}

  // Draw from Top to Middle
  for ctr:=y to y+MidPos do
    if (ctr<FHeight-1) and (ctr>=0) then
    begin
      // A HELLUVA LOT FASTER THAN DRAWING WITH THE LINE() PROC - 2x Faster than with Line()
      // 25.Mar.2000 - Now 4x Faster!!!!
      SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*ctr);
      SurfPtrColor:=rgbtobgr(rgb(r,g,b));
      // Draw the line across the screen
      for ctrx:=0 to FSurfaceDesc.lpitch div sizeof(word) do
      begin
        SurfPtr^:=SurfPtrColor;
        inc(SurfPtr);
      end;
//    Line(0, ctr, FWidth, ctr, rgb(r,g,b));
      r:=r+rStep;
      g:=g+gStep;
      b:=b+bStep;
    end;

  { MIDDLE TO BOTTOM }
  rStep:=(ColorBot.rgbRed-ColorMid.rgbRed) div MidPos;
  gStep:=(ColorBot.rgbGreen-ColorMid.rgbGreen) div MidPos;
  bStep:=(ColorBot.rgbBlue-ColorMid.rgbBlue) div MidPos;
  r:=ColorMid.rgbRed;
  g:=ColorMid.rgbGreen;
  b:=ColorMid.rgbBlue;
{  if ColorBot.rgbRed-ColorMid.rgbRed<0 then rStep:=-rStep;
  if ColorBot.rgbGreen-ColorMid.rgbGreen<0 then gStep:=-gStep;
  if ColorBot.rgbBlue-ColorMid.rgbBlue<0 then bStep:=-bStep;
}
  for ctr:=y+MidPos+1 to y+cbHeight do
    if (ctr<FHeight-1) and (ctr>=0) then
    begin
      // A HELLUVA LOT FASTER THAN DRAWING WITH THE LINE() PROC - 2x Faster than with Line()
      // 25.Mar.2000 - Now 4x Faster!!!!
      SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*ctr);
      SurfPtrColor:=rgbtobgr(rgb(r,g,b));
      for ctrx:=0 to FSurfaceDesc.lpitch div sizeof(word) do
      begin
        SurfPtr^:=SurfPtrColor;
        inc(SurfPtr);
      end;
//    Line(0, ctr, FWidth, ctr, rgb(r,g,b));
      r:=r+rStep;
      g:=g+gStep;
      b:=b+bStep;
    end;

  SurfPtr:=nil;
end;



function TGrafixSurface.PointInCircle(xp, yp: integer; xCircle, yCircle, Radius: extended): boolean;
begin
  Result:=false;
  Result:=sqr(xCircle-xp)+sqr(yCircle-yp)<sqr(Radius);
end;

procedure TGrafixSurface.FlipX;
begin
  FSurface.Draw(0, 0, rect(FWidth, 0, 0, FHeight), FSurface, false);
//  FSurface.Blt(rect(150,0,0,150), rect(0,0,FWidth,FHeight), DDBLTFX_MIRRORLEFTRIGHT, df, FSurface);
//  FSurface.StretchDraw( rect(0, 0, 150, 150), rect(FWidth, 0,0,FHeight), FSurface, true);
end;

procedure TGrafixSurface.FlipY;
begin
  FSurface.Draw(0, 0, rect(0, FHeight,FWidth,0), FSurface, false);
end;


function TGrafixSurface.GetCurrentSurface: TDirectDrawSurface;
begin
  result:=FSurface;
end;

procedure TGrafixSurface.SetCurrentSurface(aSurface: TDirectDrawSurface);
begin
  FSurface:=aSurface;
  FWidth:=aSurface.Width;
  FHeight:=aSurface.Height;
end;

procedure TGrafixSurface.SetPixelProc(NewPixelProc: TPixelProc);
begin
  FPixelProc:=NewPixelProc;
end;


end.