adkscreens.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit ADKScreens;

{
 projet ADK-ISO (c)2002-2003 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/
}

{$define secure}

interface

uses
 Windows,Classes,SysUtils,Graphics,
 MiniDX,DXError,ADKDepth;

type
 TADKScreen=class
 private
  fWidth,fHeight,fDepth:integer;
  fBPP,RedMask,GreenMask,BlueMask:integer;
  fHalfMask:cardinal;
  fMemory:pointer;
  fPitch:integer;
  procedure PixelFormat(aBPP,aRed,aGreen,aBlue,aHalf:integer);
  function GetPixel(x,y:integer):pointer;
 public
  procedure SetSize(Width,Height,Depth:integer); virtual;
  procedure Trame(Left,Top,width,height:integer); virtual;
  procedure DrawHint(x,y,color:integer; Text:string);
  procedure DrawLines(Rect:TRect; Lines:TStrings);
  procedure PutPixel(x,y,c:integer);
  procedure PutAlpha(x,y,c:integer);

  function Clear(Color:integer):boolean; virtual; abstract;
  function Lock:boolean; virtual;
  procedure UnLock; virtual;
  function GetDC:HDC; virtual; abstract;
  procedure ReleaseDC; virtual; abstract;
  procedure Flip; virtual; abstract;

  property Pixels[x,y:integer]:pointer read GetPixel;
  property Pitch:integer read fPitch;
  property Width:integer read fWidth;
  property Height:integer read fHeight;
  property Depth:integer read fDepth;
  property BPP:integer read fBPP;
  property HalfMask:cardinal read fHalfMask;
 end;

 TADKScreenDX=class(TADKScreen)
 private
  fHWnd:HWnd;
  fDC:HDC;
  fFull:boolean;
  DDraw:IDirectDraw2;
  DPrim:IDirectDrawSurface;
  DBack:IDirectDrawSurface;
//  procedure CheckDD(Err:integer; Msg:string);
  procedure CreatePrimary;
  function RestoreBackBuffer:boolean;
 protected
  procedure NeedDirectDraw; virtual;
  procedure CreateBackBuffer; virtual;
 public
  constructor Create(Handle:HWnd; FullScreen:boolean=false);
  destructor Destroy; override;
  procedure SetSize(Width,Height,Depth:integer); override;
  function Lock:boolean; override;
  procedure UnLock; override;
  function Clear(Color:integer):boolean; override;
  procedure Trame(Left,Top,width,height:integer); override;
  function GetDC:HDC; override;
  procedure ReleaseDC; override;
  procedure Flip; override;
 end;

 TADKScreen3D=class(TADKScreenDX)
 private
  D3D  :IDirect3D2;
  DDev :IDirect3DDevice2;
 protected
  procedure NeedDirectDraw; override;
  procedure CreateBackBuffer; override;
 public
  procedure Trame(Left,Top,width,height:integer); override;
  procedure DrawPoly(const Points:array of TD3DTLVertex);
 end;

 TADKScreenGDI=class(TADKScreen)
 private
  fCanvas:TCanvas;
  fBitmap:TBitmap;
  fRect:TRect;
 public
  constructor Create(Handle:HWnd);
  destructor Destroy; override;
  procedure SetSize(Width,Height,Depth:integer); override;
  function Clear(Color:integer):boolean; override;
  function GetDC:HDC; override;
  procedure ReleaseDC; override;
  procedure Flip; override;
 end;

var
 ADKScreen:TADKScreen;

function WindowDepth:integer;

implementation

//uses ADKRender, ADKData, ADKObjects, ADKMaps;

function WindowDepth:integer;
var
 dc:HDC;
begin
 dc:=GetDC(0);
 Result:=GetDeviceCaps(DC,BITSPIXEL);
 ReleaseDC(0,DC);
end;

//----------------------------------------------------------------------------//

procedure TADKScreen.Trame(Left,Top,width,height:integer);
var
 py:pchar;
 px:pointer;
 x,y:integer;
begin
{$ifdef secure}
 ReleaseDC;
 Lock;
{$endif}
 if Left<0 then Left:=0;
 if Top<0 then Top:=0;
 if Left+Width>Self.Width then Width:=Self.Width-Left;
 if Top+Height>Self.Height then Height:=Self.Height-Top;
 py:=Pixels[Left,Top];//@dib[Pitch*Top+ADKScreen.BPP*Left];
 for y:=0 to height-1 do begin
  px:=pointer(py);
  if odd(y+Top+Left) then inc(cardinal(px),BPP);
  if BPP=BPP32 then begin
   for x:=0 to (width div 2)-1 do begin
    TPixel32(px^):=0;
    inc(cardinal(px),2*BPP);
   end;
  end else begin
   for x:=0 to (width div 2)-1 do begin
    TPixel16(px^):=0;
    inc(cardinal(px),2*BPP);
   end;
  end;
  inc(py,Pitch);
 end;
end;

procedure TADKScreen.SetSize(Width,Height,Depth:integer);
begin
 fWidth:=Width;    //HalfWidth:=fWidth shr 1;
 fHeight:=Height;  //HalfHeight:=fHeight shr 1;
 fDepth:=Depth;
 case fDepth of
  15: PixelFormat(2,   $7C00,  $03E0,  $001F,   $7BDE);
  16: PixelFormat(2,   $F800,  $07E0,  $001F,   $F7DE);
  32: PixelFormat(4, $FF0000,$00FF00,$0000FF, $FEFEFE);
  else raise Exception.Create('Format graphique non support