//////////////////////////////////////////////////////////////////////////////////
// Project Name:   [ CDX Class Library - CDX.lib ]
// Source File:    [ CDXScreen Implementation ]
// Author:         [ Danny Farley - danny@jags.co.uk ]
// Contributions:  [ Chris Barnes, Paul Lord ]
// Revision:       [ 1.4 ]
/////////////////////////////////////////////////////////////////////////////////

unit CDXScreenX;

interface

uses
  Windows, DirectDraw, Classes, DDUtil, graphics;

type
//////////////////////////////////////////////////////////////////////////////////
// CDXScreen Class
//////////////////////////////////////////////////////////////////////////////////
  LPPALETTEENTRY = Array [1..256]of TPaletteEntry;
  LPDIRECTDRAW = IDirectDraw;
  LPDIRECTDRAWPALETTE = IDirectDrawPalette;
  LPDIRECTDRAWSURFACE = IDirectDrawSurface7;
  LPDIRECTDRAWCLIPPER = IDirectDrawClipper;
  DDSURFACEDESC = TDDSurfaceDesc;
  DDSCAPS = TDDSCaps;
  DDBLTFX = TDDBltFx;
  DDCOLORKEY = TDDColorKey;

  CDXSurface = class;

  CDXScreen = class
  public
        constructor CreateCDXScreen;
        constructor CreateCDXScreenCustomBPP(const Window : HWND; const Width, Height, BPP : DWORD);
        constructor CreateCDXScreenDefaultBPP(const Window : HWND; const Width, Height : Integer);
        destructor DestroyCDXScreen;

        function CreateFullScreen(const Window : HWND; const Width, Height, BPP : DWORD) : BOOL;
        function CreateWindowed(const Window : HWND; const Width, Height : Integer) : BOOL;
        procedure LoadBitmap(const szFilename : PChar);
        procedure LoadPalette(const szFilename : PChar);
        procedure Fill(FillColor : DWORD);
        procedure Restore;
        function Flip : HRESULT;

        procedure SetColor(col, r, g, b : Integer);
        procedure GetColor(col : Integer; var r, g, b : Integer);
        procedure SetPalette(Start, Count : Integer; lpPE : LPPALETTEENTRY);
        procedure GetPalette(Start, Count : Integer; lpPE : LPPALETTEENTRY);
        procedure FillPalette(r, g, b : Integer);
        procedure GreyScale;
        procedure FadeIn(const Delay : Integer; const lpPE : LPPALETTEENTRY);
        procedure FadeOut(const Delay : Integer);
        procedure FadeTo(const r, g, b, Delay : Integer);

        function GetWidth : Integer; { return m_dwPixelWidth; }
        function GetHeight : Integer; { return m_dwPixelHeight; }
        function GetBPP : DWORD; { return m_BPP; }
        function GetDD : IDIRECTDRAW7; { return m_lpDD; }
        function GetAppFrontBuffer : CDXSurface; { return m_lpDDSFront; }
        function GetAppBackBuffer : CDXSurface; { return m_lpDDSBack; }
        function GetAppPalette : LPDIRECTDRAWPALETTE; { return m_lpDDPalette; }

  public
        m_lpDD : IDIRECTDRAW7;
        m_lpDDSFront : CDXSurface;
        m_lpDDSBack : CDXSurface;
        m_ZBuffer : IDIRECTDRAWSURFACE7;
        m_lpDDPalette : LPDIRECTDRAWPALETTE;
        m_lpClipper : LPDIRECTDRAWCLIPPER;

        m_dwPixelWidth : DWORD;
        m_dwPixelHeight : DWORD;
        m_BPP : DWORD;
        m_hWnd : HWND;
        m_bActive : BOOL;
        m_bFullScreen : BOOL;
  end;

CDXSurface = class
  constructor Create;
  procedure CreateCDXSurfaceCustom(const Screen : CDXScreen; const Width, Height : Integer);
  procedure CreateCDXSurfaceFromFile(const Screen : CDXScreen; const szFilename : PChar);
  destructor Destroy; override;

  procedure SetDest(t, l, b, r : Integer);
  procedure SetSrc(t, l, b, r : Integer);
  procedure ColorKey(col : Integer);
  procedure Restore;

  procedure ChangeFont(FontName : PChar; const Width, Height : Integer; const Attributes : Integer);// :=  FW_NORMAL
  procedure SetFont;
  procedure Lock;
  procedure UnLock;
  procedure GetDC;
  procedure ReleaseDC;
  procedure TextXY(const X, Y : Integer; const Col : COLORREF; const Text : PChar);
  procedure PutPixel(const X, Y, Col : Integer);
  function GetPixel(const X, Y : Integer) : Integer;
  procedure Rect(X1, Y1, X2, Y2, Col : Integer);
  procedure FillRect(X1, Y1, X2, Y2, Col : Integer);
  procedure Line(X1, Y1, X2, Y2, Col : Integer);
  procedure VLine(Y1, Y2, X, Col : Integer);
  procedure HLine(X1, X2, Y, Col : Integer);
  procedure Circle(X, Y, Radius, Col : Integer);

  function Draw(lpDDS : CDXSurface) : HRESULT;
  function DrawFast(const X, Y : Integer;lpDDS : CDXSurface) : HRESULT;
  function DrawTrans(X, Y : Integer;lpDDS : CDXSurface) : HRESULT;
  function DrawClipped(X, Y : Integer;lpDDS : CDXSurface) : HRESULT;
  function DrawWindowed(lpDDS : CDXSurface) : HRESULT;
  function DrawScaled(X, Y : Integer;Factor : Real;lpDDS : CDXSurface) : HRESULT;
  procedure DrawRotated(X, Y : Integer;Angle : double;lpDDS : CDXSurface);
  procedure DrawHFlip(X, Y : Integer;lpDDS : CDXSurface);
  procedure DrawVFlip(X, Y : Integer;lpDDS : CDXSurface);

public
  m_PixelWidth : Integer;
  m_PixelHeight : Integer;
  m_pFilename : PChar;

  m_DC : HDC;
  m_ColorKey : Integer;
  SrcRect : TRect;
  DestRect : TRect;
  m_Font : HFONT;
  m_DDSD : TDDSURFACEDESC2;
  m_lpDDS : IDIRECTDRAWSURFACE7;
  GScreen : CDXScreen;
end;

implementation

function DEG2RAD (x : double) : double;
begin
  DEG2RAD := (x * PI / 180);
end;

procedure DDError (Hret : HRESULT; const Window : HWND);
begin
  MessageBox(Window, PChar(DDErrorString(HRet)), PChar('Error!'), MB_APPLMODAL+MB_ICONERROR+MB_OK);
  DestroyWindow(Window);
  Halt(255);
end;

procedure Release(x : IUnknown);
begin
  if x<>nil then begin
     x._Release;
     x := nil;
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen constructor
//////////////////////////////////////////////////////////////////////////////////
constructor CDXScreen.CreateCDXScreen;
begin
  m_lpDD := nil;
  m_lpDDPalette := nil;
  m_ZBuffer := nil;
  m_lpClipper := nil;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen constructor
//////////////////////////////////////////////////////////////////////////////////
constructor CDXScreen.CreateCDXScreenCustomBPP(const Window : HWND; const Width, Height, BPP : DWORD);
begin
  CreateFullScreen(Window,  Width,  Height,  BPP);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen destructor
//////////////////////////////////////////////////////////////////////////////////
destructor CDXScreen.DestroyCDXScreen;
begin
  m_lpDD.RestoreDisplayMode;
  m_lpDD.FlipToGDISurface;
  m_lpDD.SetCooperativeLevel(m_hWnd, DDSCL_NORMAL);
  Release(m_ZBuffer);
  Release(m_lpClipper);
  Release(m_lpDDPalette);
  Release(m_lpDD);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen CreateWindowed
//////////////////////////////////////////////////////////////////////////////////
function CDXScreen.CreateWindowed(const Window : HWND; const Width, Height : Integer) : BOOL;
var
  rval : HRESULT ;
  ddsd : TDDSURFACEDESC2;
  DC : HDC ;
begin
  m_lpDD := nil;
  m_bFullScreen := False;
  m_lpDDPalette := nil;
  m_dwPixelWidth := Width;
  m_dwPixelHeight := Height;
  m_hWnd := Window;

  DC := GetDC(Window);
  m_BPP := GetDeviceCaps(DC,  PLANES) * GetDeviceCaps(DC,  BITSPIXEL);
  ReleaseDC(Window, DC);

  rval :=  DirectDrawCreateEx (nil,  m_lpDD,  IDirectDraw7,  nil);

  if rval<>DD_OK then DDError(rval,  Window);

  rval := m_lpDD.SetCooperativeLevel(Window, DDSCL_NORMAL);
  if rval<>DD_OK then DDError(rval, Window);

  ZeroMemory(@ddsd, SizeOf(ddsd));
  ddsd.dwSize := SizeOf(ddsd);
  ddsd.dwFlags := DDSD_CAPS;
  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;

  m_lpDDSFront := CDXSurface.Create;
  m_lpDDSBack := CDXSurface.Create;

  rval := m_lpDD.CreateSurface(ddsd,  m_lpDDSFront.m_lpDDS,  nil);
  if rval<>DD_OK then DDError(rval, Window);

  ddsd.dwFlags := DDSD_CAPS+DDSD_WIDTH+DDSD_HEIGHT;
  ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
  ddsd.dwWidth := Width;
  ddsd.dwHeight := Height;

  rval := m_lpDD.CreateSurface(ddsd, m_lpDDSBack.m_lpDDS, nil);
  if rval<>DD_OK then DDError(rval, Window);

  // Create the window clipper
  rval := m_lpDD.CreateClipper(0,  m_lpClipper,  nil);
  if rval<>DD_OK then DDError(rval, Window);

  rval := m_lpClipper.SetHWnd(0,  Window);
  if rval<>DD_OK then DDError(rval, Window);

  rval := m_lpDDSFront.m_lpDDS.SetClipper(m_lpClipper);
  if rval<>DD_OK then DDError(rval, Window);
  CreateWindowed := True;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen constructor
//////////////////////////////////////////////////////////////////////////////////
constructor CDXScreen.CreateCDXScreenDefaultBPP(const Window : HWND; const Width, Height : Integer);
begin
  CreateWindowed(Window,  Width,  Height);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen CreateFullScreen
//////////////////////////////////////////////////////////////////////////////////
function CDXScreen.CreateFullScreen(const Window : HWND; const Width, Height, BPP : DWORD) : BOOL;
var
  rval : HRESULT;
  dwFlags : DWORD;
  ddsd : TDDSURFACEDESC2;
  ddscap : TDDSCAPS2;
begin
  m_lpDD := nil;
  m_bFullScreen := True;
  m_lpDDPalette := nil;
  m_dwPixelWidth := Width;
  m_dwPixelHeight := Height;
  m_BPP := BPP;
  m_hWnd := Window;

  dwFlags := DDSCL_EXCLUSIVE+DDSCL_FULLSCREEN+DDSCL_ALLOWREBOOT+DDSCL_ALLOWMODEX;

  rval := DirectDrawCreateEx (nil,  m_lpDD,  IDirectDraw7,  nil);
  if rval<>DD_OK then DDError(rval, Window);

  rval := m_lpDD.SetCooperativeLevel(Window, dwFlags);
  if rval<>DD_OK then DDError(rval, Window);

  rval := m_lpDD.SetDisplayMode(m_dwPixelWidth, m_dwPixelHeight, m_BPP, 0, 0);
  if rval<>DD_OK then DDError(rval, Window);

  ZeroMemory(@ddsd, SizeOf(ddsd));
  ddsd.dwSize := SizeOf(ddsd);
  ddsd.dwFlags := DDSD_CAPS+DDSD_BACKBUFFERCOUNT;
  ddsd.ddsCaps.dwCaps :=  DDSCAPS_PRIMARYSURFACE+DDSCAPS_FLIP+DDSCAPS_COMPLEX;

  ddsd.dwBackBufferCount := 1;

  m_lpDDSFront := CDXSurface.Create;
  m_lpDDSBack := CDXSurface.Create;

  rval := m_lpDD.CreateSurface(ddsd, m_lpDDSFront.m_lpDDS, nil);
  if rval<>DD_OK then DDError(rval, Window);

  ZeroMemory(@ddscap, SizeOf(ddscap));
  ddscap.dwCaps := DDSCAPS_BACKBUFFER;

  rval := m_lpDDSFront.m_lpDDS.GetAttachedSurface(ddscap, m_lpDDSBack.m_lpDDS);
  if rval<>DD_OK then DDError(rval, Window);
  CreateFullScreen := True;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen Flip - swaps the front and back buffers
//////////////////////////////////////////////////////////////////////////////////
function CDXScreen.Flip : HRESULT;
var
  rval : HRESULT;
  Wnd : TRect;
  pt : TPoint;
begin
  if m_bFullScreen then begin
     rval := m_lpDDSFront.m_lpDDS.Flip(nil, DDFLIP_WAIT);
     if rval = DDERR_SURFACELOST then Restore;
     end
     else begin
     GetClientRect(m_hWnd, Wnd);
     pt.x := 0;
     pt.y := 0;
     ClientToScreen(m_hWnd, pt);
     OffsetRect(Wnd,  pt.x,  pt.y);

     rval := m_lpDDSFront.m_lpDDS.Blt(@Wnd, m_lpDDSBack.m_lpDDS, nil, DDBLT_WAIT, nil);
     if rval = DDERR_SURFACELOST then Restore;
     end;

  Flip := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen Fill - fills the bsck buffer with a colour
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.Fill(FillColor : DWORD);
var
  ddBltF : DDBLTFX;
begin
  ZeroMemory(@ddBltF, SizeOf(ddBltF));
  ddBltF.dwSize := SizeOf(DDBLTFX);
  ddBltF.dwFillColor := FillColor;
  m_lpDDSBack.m_lpDDS.Blt(nil, nil, nil, DDBLT_WAIT+DDBLT_COLORFILL, @ddBltF);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen LoadBitmap - loads a bitmap straight onto the back buffer
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.LoadBitmap(const szFilename : PChar);
begin
  DDReLoadBitmap(m_lpDDSBack.m_lpDDS,  szFilename);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen LoadPalette - loads a palette from a bitmap file
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.LoadPalette(const szFilename : PChar);
begin
  m_lpDDPalette := DDLoadPalette(m_lpDD, szFilename);
  m_lpDDSFront.m_lpDDS.SetPalette(m_lpDDPalette);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen Restore - restores the front buffer if it is lost
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.Restore;
begin
  if (m_lpDDSFront.m_lpDDS <> nil) and (m_lpDDSFront.m_lpDDS.IsLost <> DD_OK) then
      m_lpDDSFront.m_lpDDS._Restore;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen SetRGB - sets the r, g, b value of a single color
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.SetColor(col, r, g, b : Integer);
var
  pe : TPALETTEENTRY;
begin
  m_lpDDPalette.GetEntries(0, col, 1, @pe);
  pe.peRed :=  r;
  pe.peGreen := g;
  pe.peBlue := b;
  m_lpDDPalette.SetEntries(0, col, 1, @pe);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen GetRGB - returns the r, g, b values of a single color
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.GetColor(col : Integer;var r, g, b : Integer);
var
  pe : TPALETTEENTRY;
begin
  m_lpDDPalette.GetEntries(0, col, 1, @pe);
  r := pe.peRed;
  g := pe.peGreen;
  b := pe.peBlue;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen SetPalette - sets the palette
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.SetPalette(Start, Count : Integer;lpPE : LPPALETTEENTRY);
begin
  m_lpDDPalette.SetEntries(0, Start, Count, @lpPE);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen GetPalette - returns the palette
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.GetPalette(Start, Count : Integer;lpPE : LPPALETTEENTRY);
begin
  m_lpDDPalette.GetEntries(0, Start, Count, @lpPE);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen FillPalette - sets the whole palette to one color
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.FillPalette(r, g, b : Integer);
var
  pe : array [1..256] of TPALETTEENTRY;
  i : Integer;
begin
  m_lpDDPalette.GetEntries(0,  0,  256,  @pe);

  for i := 1 to 256 do begin
 	pe[i].peRed := r;
  	pe[i].peGreen := g;
  	pe[i].peBlue := b;
  end;
  m_lpDDPalette.SetEntries(0,  0,  256,  @pe);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen GrayScale - converts the palette to monochrome
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.GreyScale;
var
  pe : array [1..256] of TPALETTEENTRY;
  total, grey : Integer;
  i : Integer;
begin
  m_lpDDPalette.GetEntries(0, 0, 256, @pe);

  for i := 1 to 256 do begin
  	total := pe[i].peRed+pe[i].peGreen+pe[i].peBlue;
  	grey := trunc(total/3);
  	pe[i].peRed := grey;
  	pe[i].peGreen := grey;
  	pe[i].peBlue := grey;
  end;
  m_lpDDPalette.SetEntries(0, 0, 256, @pe);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen FadeIn - smoothly fades to the specified palette
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.FadeIn(const Delay : Integer; const lpPE : LPPALETTEENTRY);
var
  pe : array [1..256] of TPALETTEENTRY;
  i, j : Integer;
  d : LongInt;
begin
  m_lpDDPalette.GetEntries(0,  0,  256, @pe);

  for j := 1 to 84 do begin
      for i := 1 to 256 do begin
	  // Red
	  if pe[i].peRed>(lpPE[i].peRed+5) then pe[i].peRed := pe[i].peRed-3
	  else if pe[i].peRed<(lpPE[i].peRed-5) then pe[i].peRed := pe[i].peRed+3
	  else pe[i].peRed :=  lpPE[i].peRed;

	  // Green
	  if pe[i].peGreen>(lpPE[i].peGreen+5) then pe[i].peGreen := pe[i].peGreen-3
	  else if pe[i].peGreen<(lpPE[i].peGreen-5) then pe[i].peGreen := pe[i].peGreen+3
	  else pe[i].peGreen := lpPE[i].peGreen;

	  // Blue
	  if pe[i].peBlue>(lpPE[i].peBlue+5) then pe[i].peBlue := pe[i].peBlue-3
	  else if pe[i].peBlue<(lpPE[i].peBlue-5) then  pe[i].peBlue := pe[i].peBlue+3
	  else pe[i].peBlue := lpPE[i].peBlue;

	  // Add a delay here for slower fades
	  for d :=  0 to delay*100-1 do
          begin
          end;
	end;
	m_lpDDPalette.SetEntries(0, 0, 256, @pe);
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen FadeOut - fades to black,  about 0-10 for the delay is usual
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.FadeOut(const Delay : Integer);
var
  pe : array [1..256] of TPALETTEENTRY;
  i, j : Integer;
  d : LongInt;
begin
  m_lpDDPalette.GetEntries(0,  0,  256, @pe);

  for j := 1 to 84 do begin
 	for i := 1 to 256 do begin
  		// Red
  		if pe[i].peRed>5 then pe[i].peRed := pe[i].peRed-3
  		else pe[i].peRed :=  0;

  		// Green
  		if pe[i].peGreen>5 then pe[i].peGreen := pe[i].peGreen-3
  		else pe[i].peGreen := 0;

  		// Blue
  		if pe[i].peBlue>5 then pe[i].peBlue := pe[i].peBlue-3
  		else pe[i].peBlue := 0;

  		// Add a delay here for slower fades
  		for d :=  0 to delay*100-1 do
                  begin
                  end;
  	end;
  	m_lpDDPalette.SetEntries(0, 0, 256, @pe);
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXScreen FadeTo - fades to a specified color
//////////////////////////////////////////////////////////////////////////////////
procedure CDXScreen.FadeTo(const r, g, b, Delay : Integer);
var
  pe : array [1..256] of TPALETTEENTRY;
  i, j : Integer;
  d : LongInt;
begin
  m_lpDDPalette.GetEntries(0,  0,  256, @pe);

  for j := 1 to 84 do begin
  	for i := 1 to 256 do begin
  		// Red
  		if pe[i].peRed>(r+5) then pe[i].peRed := pe[i].peRed-3
  		else if pe[i].peRed<(r-5) then pe[i].peRed := pe[i].peRed+3
  		else pe[i].peRed := r;

  		// Green
  		if pe[i].peGreen>(g+5) then pe[i].peGreen := pe[i].peGreen-3
  		else if pe[i].peGreen < (g-5) then pe[i].peGreen := pe[i].peGreen+3
  		else pe[i].peGreen := g;

  		// Blue
  		if pe[i].peBlue>(b+5) then pe[i].peBlue := pe[i].peBlue-3
  		else if pe[i].peBlue<(b-5) then pe[i].peBlue := pe[i].peBlue+3
  		else pe[i].peBlue := b;

  		for d :=  0 to delay*100-1 do begin
                end;
  	end;
  	m_lpDDPalette.SetEntries(0, 0, 256, @pe);
  end;
end;

function CDXScreen.GetWidth : Integer; { return m_dwPixelWidth; }
begin
  GetWidth := m_dwPixelWidth;
end;

function CDXScreen.GetHeight : Integer; { return m_dwPixelHeight; }
begin
  GetHeight := m_dwPixelHeight;
end;

function CDXScreen.GetBPP : DWORD; { return m_BPP; }
begin
  GetBPP := m_BPP;
end;

function CDXScreen.GetDD : IDIRECTDRAW7; { return m_lpDD; }
begin
  GetDD := m_lpDD;
end;

function CDXScreen.GetAppFrontBuffer : CDXSurface; { return m_lpDDSFront; }
begin
  GetAppFrontBuffer := m_lpDDSFront;
end;

function CDXScreen.GetAppBackBuffer : CDXSurface; { return m_lpDDSBack; }
begin
  GetAppBackBuffer := m_lpDDSBack;
end;

function CDXScreen.GetAppPalette : LPDIRECTDRAWPALETTE; { return m_lpDDPalette; }
begin
  GetAppPalette := m_lpDDPalette;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface GetDC
//////////////////////////////////////////////////////////////////////////////////

procedure CDXSurface.GetDC;
begin
  m_lpDDS.GetDC(m_DC);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface ReleaseDC
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.ReleaseDC;
begin
  m_lpDDS.ReleaseDC(m_DC);
end;


//////////////////////////////////////////////////////////////////////////////////
// CDXSurface constructor
//////////////////////////////////////////////////////////////////////////////////
constructor CDXSurface.Create;
begin
  m_lpDDS := nil;
  m_DC := 0;
  m_Font := 0;
  GScreen := nil;

  m_ColorKey := -1;
  DestRect.Top := 0;
  DestRect.Left := 0;
  DestRect.Bottom := 0;
  DestRect.Right := 0;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface constructor
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.CreateCDXSurfaceCustom(const Screen : CDXScreen; const Width, Height : Integer);
var
  rval : HRESULT;
begin
  ZeroMemory(@m_DDSD, SizeOf(m_DDSD));
  m_DDSD.dwSize := SizeOf(m_DDSD);
  m_DDSD.dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
  m_DDSD.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
  m_DDSD.dwWidth := Width;
  m_DDSD.dwHeight := Height;

  rval := Screen.m_lpDD.CreateSurface(m_DDSD, m_lpDDS, nil);
  if rval <> DD_OK then DDError(rval, Screen.m_hWnd);

  m_DC := 0;
  m_Font := 0;
  m_pFilename := '';
  GScreen := Screen;
  m_ColorKey := -1;

  DestRect.Top := 0;
  DestRect.Left := 0;
  DestRect.Bottom := m_PixelHeight;
  DestRect.Right := m_PixelWidth;

  SrcRect.Top := 0;
  SrcRect.Left := 0;
  SrcRect.Bottom := m_PixelHeight;
  SrcRect.Right := m_PixelWidth;
  GetDC;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface constructor
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.CreateCDXSurfaceFromFile(const Screen : CDXScreen; const szFilename : PChar);
var
  wrkBitMap : TBitmap;
begin
  wrkBitMap := TBitmap.Create;
  wrkBitMap.LoadFromFile (szFilename);
  m_PixelWidth := wrkBitMap.Width;
  m_PixelHeight := wrkBitMap.Height;
  wrkBitMap.Free;
  m_lpDDS := DDLoadBitmap(Screen.m_lpDD, szFilename, m_PixelWidth, m_PixelHeight);
  m_DC := 0;
  m_Font := 0;
  m_pFilename := szFilename;
  GScreen := Screen;
  m_ColorKey := -1;

  DestRect.Top := 0;
  DestRect.Left := 0;
  DestRect.Bottom := m_PixelHeight;
  DestRect.Right :=  m_PixelWidth;

  SrcRect.Top := 0;
  SrcRect.Left := 0;
  SrcRect.Bottom := m_PixelHeight;
  SrcRect.Right := m_PixelWidth;

  ZeroMemory(@m_DDSD, SizeOf(m_DDSD));
  with m_DDSD do begin
       dwSize := SizeOf(m_DDSD);
       dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
       ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
       dwWidth := m_PixelWidth;
       dwHeight := m_PixelHeight;
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface destructor
//////////////////////////////////////////////////////////////////////////////////
destructor CDXSurface.Destroy;
begin
  Release(m_lpDDS);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Draw
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.Draw(lpDDS : CDXSurface) : HRESULT;
var
  rval : HRESULT;
begin
  rval := lpDDS.m_lpDDS.Blt(@DestRect, m_lpDDS, @SrcRect, DDBLT_WAIT, nil);
  if rval = DDERR_SURFACELOST then Restore;
  Draw := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawFast
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.DrawFast(const X, Y : Integer; lpDDS : CDXSurface) : HRESULT;
var
  rval : HRESULT;
begin
  if m_ColorKey = -1
     then rval := lpDDS.m_lpDDS.BltFast(X, Y, m_lpDDS, @SrcRect, DDBLTFAST_WAIT)
     else rval := lpDDS.m_lpDDS.BltFast(X, Y, m_lpDDS, @SrcRect,
                  DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
  if rval = DDERR_SURFACELOST then Restore;
  DrawFast := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawTrans
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.DrawTrans(X, Y : Integer;lpDDS : CDXSurface) : HRESULT;
var
  rval : HRESULT;
begin
  rval := lpDDS.m_lpDDS.BltFast(X, Y, m_lpDDS, @SrcRect, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
  if rval = DDERR_SURFACELOST then Restore;
  DrawTrans := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// Clip - clips a destination rectange and modifys X, Y coords appropriatly
//////////////////////////////////////////////////////////////////////////////////
procedure Clip(var DestX, DestY : Integer;SrcRect, DestRect : TRect);
begin
  // If it's partly off the right side of the screen
  if(DestX+(SrcRect.Right-SrcRect.Left)>DestRect.Right) then
  SrcRect.Right := SrcRect.Right-DestX+(SrcRect.Right-SrcRect.Left)-DestRect.Right;

  // Partly off the left side of the screen
  if (DestX<DestRect.Left) then begin
      SrcRect.Left := SrcRect.Left+DestRect.Left-DestX;
      DestX := DestRect.Left;
  end;

  // Partly off the top of the screen
  if(DestY<DestRect.Top) then
  begin
  	SrcRect.Top := SrcRect.Top+DestRect.Top-DestY;
  	DestY := DestRect.Top;
  end;

  // If it's partly off the bottom side of the screen
  if(DestY+(SrcRect.Bottom-SrcRect.Top)>DestRect.Bottom) then
  SrcRect.Bottom := SrcRect.Bottom-((SrcRect.Bottom-SrcRect.Top)+DestY)-DestRect.Bottom;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawClipped
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.DrawClipped(X, Y : Integer;lpDDS : CDXSurface) : HRESULT;
var
  DRect, ModSrc : TRect;
  rval : HRESULT;
begin
  ModSrc :=  SrcRect;
  DRect.Top := 0;
  DRect.Left := 0;
  DRect.Right := GScreen.m_dwPixelWidth;
  DRect.Bottom := GScreen.m_dwPixelHeight;
  Clip(X, Y, ModSrc, DRect);
  rval := lpDDS.m_lpDDS.BltFast(X, Y, m_lpDDS, @ModSrc, DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
  if rval = DDERR_SURFACELOST then Restore;
  DrawClipped := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawWindowed
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.DrawWindowed(lpDDS : CDXSurface) : HRESULT;
var
  rval : HRESULT;
  Window : TRect;
begin
  GetClientRect(GScreen.m_hWnd, Window);
  ClientToScreen(GScreen.m_hWnd, Window.TopLeft);
  ClientToScreen(GScreen.m_hWnd, Window.BottomRight);

  rval := lpDDS.m_lpDDS.Blt(@Window, m_lpDDS, nil, DDBLT_WAIT, nil);
  if rval = DDERR_SURFACELOST then Restore;

  DrawWindowed := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawScaled
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.DrawScaled(X, Y : Integer;Factor : Real;lpDDS : CDXSurface) : HRESULT;
var
  rval : HRESULT;
begin
  DestRect.Top := Y;
  DestRect.Left := X;
  DestRect.Bottom := trunc((Y+m_PixelHeight)*Factor);
  DestRect.Right := trunc((X+m_PixelWidth)*Factor);

  rval := lpDDS.m_lpDDS.Blt(@DestRect, m_lpDDS, @SrcRect, DDBLT_WAIT or DDBLT_KEYSRC, nil);
  if rval = DDERR_SURFACELOST then Restore;

  DrawScaled := rval;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawRotated
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.DrawRotated(X, Y : Integer;Angle : double;lpDDS : CDXSurface);
begin
	// NOT IMPLEMENTED
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawHFlip
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.DrawHFlip(X, Y : Integer;lpDDS : CDXSurface);
var
  i, j, Pixel : Integer;
begin
  Lock;
  for j := 0 to (m_PixelHeight-1) do
 	for i := 0 to (m_PixelWidth-1) do begin
   	Pixel := GetPixel(i,  j);
   	if Pixel<>m_ColorKey then
   	lpDDS.PutPixel((X+m_PixelWidth)-i,  Y+j,  Pixel);
  end;
  Unlock;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface DrawVFlip
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.DrawVFlip(X, Y : Integer;lpDDS : CDXSurface);
var
  i, j, Pixel : Integer;
begin
  Lock;
  for j := 0 to (m_PixelHeight-1) do
      for i := 0 to (m_PixelWidth-1) do begin
			Pixel := GetPixel(i,  j);
			if Pixel<>m_ColorKey then
				lpDDS.PutPixel(X + i,  (Y + m_PixelHeight) - j,  Pixel);
		end;
  UnLock;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface SetDest
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.SetDest(t, l, b, r : Integer);
begin
  DestRect.Top := t;
  DestRect.Left := l;
  DestRect.Bottom := b;
  DestRect.Right := r;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface SetSrc
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.SetSrc(t, l, b, r : Integer);
begin
  SrcRect.Top := t;
  SrcRect.Left := l;
  SrcRect.Bottom := b;
  SrcRect.Right := r;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface ColorKey
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.ColorKey(col : Integer);
var
  ddck : DDCOLORKEY;
begin
  m_ColorKey := col;
  ddck.dwColorSpaceLowValue :=  col;
  ddck.dwColorSpaceHighValue :=  col;
  m_lpDDS.SetColorKey(DDCKEY_SRCBLT, @ddck);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Restore
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.Restore;
begin
  if (m_lpDDS <> nil) and (m_lpDDS.IsLost <> DD_OK) then begin
      m_lpDDS._Restore;
      DDReLoadBitmap(m_lpDDS, m_pFilename);
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Lock
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.Lock;
begin
  ZeroMemory(@m_DDSD,  SizeOf(m_DDSD));
  m_DDSD.dwSize := SizeOf(m_DDSD);
  m_lpDDS.Lock(nil, m_DDSD, DDLOCK_WAIT, 0);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface UnLock
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.UnLock;
begin
  m_lpDDS.Unlock(@m_DDSD);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface ChangeFont
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.ChangeFont(FontName : PChar; const Width, Height : Integer; const Attributes : Integer);
begin
  m_Font := CreateFont(Height, Width, 0, 0,
  Attributes, 0, 0, 0, OEM_CHARSET,
  OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
  DEFAULT_QUALITY, FIXED_PITCH+FF_MODERN, FontName);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface SelectFont
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.SetFont;
begin
  SelectObject(m_DC, m_Font);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface TextOut
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.TextXY(const X, Y : Integer; const Col : COLORREF; const Text : PChar);
begin
  GetDC;
  SelectObject(m_DC, m_Font);
  SetBkMode(m_DC, TRANSPARENT);
  SetTextColor(m_DC, col);
  TextOut(m_DC, x, y, Text, Length(Text));
  ReleaseDC;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface PutPixel
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.PutPixel(const X, Y, Col : Integer);
var
  Pixel : PBYTE;
begin
  Lock;
  Pixel := m_DDSD.lpSurface;
  Pixel := Pointer(Integer(Pixel)+Y*m_DDSD.lPitch+X);
  Pixel^ := Col;
  UnLock;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface GetPixel
//////////////////////////////////////////////////////////////////////////////////
function CDXSurface.GetPixel(const X, Y : Integer) : Integer;
var
  Pixel : PBYTE;
begin
  Lock;
  Pixel := m_DDSD.lpSurface;
  Pixel := Pointer(Integer(Pixel)+Y*m_DDSD.lPitch+X);
  GetPixel := Pixel^;
  UnLock;
end;

//////////////////////////////////////////////////////////////////////////////////
// Swap - swaps two Integers
//////////////////////////////////////////////////////////////////////////////////
procedure Swap(var a, b : Integer);
var
 Temp : Integer;
begin
 Temp := a;
 a := b;
 b := Temp;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Rect
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.Rect(X1, Y1, X2, Y2, Col : Integer);
var
  i : Integer;
begin
  if X1>X2 then Swap(X1, X2);
	for i := X1 to X2 do begin
		PutPixel(i, Y1, Col);
		PutPixel(i, Y2, Col);
        end;
  if Y1>Y2 then Swap(Y1, Y2);
	for i := Y1 to Y2 do begin
		PutPixel(X1, i, Col);
		PutPixel(X2, i, Col);
	end;

	PutPixel(X1, Y1, Col);
	PutPixel(X2, Y2, Col);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface HLine
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.HLine(X1, X2, Y, Col : Integer);
var
  i : Integer;
begin
  if X1>X2 then Swap(X1, X2);
  for i := X1 to X2 do
 	PutPixel(i, Y, Col);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface FillRect
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.FillRect(X1, Y1, X2, Y2, Col : Integer);
var
  u, i : Integer;
begin
  for I := Y1 to Y2 do
  for U := X1 to X2 do
  	PutPixel(U, I, Col);
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Line
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.Line(X1, Y1, X2, Y2, Col : Integer);
var
  xStep, yStep, X, Y : double;
  xLength, yLength, xCount, yCount : Integer;
begin
  xLength := abs(X2-X1);
  yLength := abs(Y2-Y1);

  if xLength=0 then VLine(Y1, Y2, X1, Col)
  else if yLength=0 then HLine(X1, X2, Y1, Col)

  else if xLength>yLength then begin
  	if X1>X2 then begin
           Swap(X1, X2);
  	   Swap(Y1, Y2);
  	end;

  	yStep := (Y2-Y1)/(X2-X1);
  	Y := Y1;

  	for xCount := X1 to X2 do begin
  	    PutPixel(xCount, trunc(Y), Col);
  	    Y := Y+yStep;
  	end;
  end
  else begin
  	if Y1>Y2 then begin
           Swap(X1, X2);
  	   Swap(Y1, Y2);
  	end;

  	xStep := (X2-X1)/(Y2-Y1);
  	X := X1;

  	for yCount := Y1 to Y2 do begin
            PutPixel(trunc(X), yCount, Col);
  	    X := X+xStep;
  	end;
  end;
end;

//////////////////////////////////////////////////////////////////////////////////
// CDXSurface VLine
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.VLine(Y1, Y2, X, Col : Integer);
var
  Bitmap : PBYTE;
  i : Integer;
begin
  Bitmap := m_DDSD.lpSurface;
  if Y1>Y2 then Swap(Y1, Y2);
  for i := Y1 to Y2 do begin
        Bitmap := Pointer(Integer(Bitmap)+i*m_DDSD.lPitch+X);
        Bitmap^ := Col;
  end;
end;


//////////////////////////////////////////////////////////////////////////////////
// CDXSurface Circle
//////////////////////////////////////////////////////////////////////////////////
procedure CDXSurface.Circle(X, Y, Radius, Col : Integer);
var
  Ang, iX, iY : Integer;
  Angle : single;
begin
  Angle := 0;
  for Ang := 0 to 360 do begin
      iX := X+Trunc(Radius*cos(Angle));
      iY := Y+Trunc(Radius*sin(Angle));
      PutPixel(iX, iY, Col);
      Angle := Angle+PI/180;
  end;
end;


end.
