Code:
program overlay;
{$mode objfpc}{$H+}
uses
Classes, SysUtils,
Windows, DirectDraw;
{ Global Variables }
var
{ DirectX variables }
g_lpdd: IDirectDraw7 = nil;
g_lpddsPrimary: IDirectDrawSurface7 = nil;
g_lpddsOverlay: IDirectDrawSurface7 = nil;
g_lpClipper: IDirectDrawClipper = nil;
mTimerID: THandle = 0;
DebugLoc, DebugInfo: Cardinal;
ddrval: HRESULT;
{*******************************************************************
* InitOverlays ()
*******************************************************************}
function InitOverlays: Boolean;
var
ddsd, ddsdOverlay: DDSURFACEDESC2;
capsDrv: TDDCaps;
pixelFormat: DDPIXELFORMAT;
begin
Result := False;
DebugInfo := 0;
DebugLoc := 0;
{ Init DirectDraw }
ddrval := DirectDrawCreateEx(nil, g_lpdd, IID_IDirectDraw7, nil);
if ddrval <> DD_OK then
begin
DebugLoc := $1;
Exit;
end;
{ For NORMAL cooperative level we no longer need to provide an HWND }
ddrval := g_lpdd.SetCooperativeLevel(0, DDSCL_NORMAL);
if ddrval <> DD_OK then
begin
DebugLoc := $2;
Exit;
end;
if g_lpdd = nil then
begin
DebugLoc := $3;
Exit;
end;
{ Create the primary surface }
FillChar(ddsd, sizeof(ddsd), #0);
ddsd.dwSize := sizeof(ddsd);
ddsd.dwFlags := DDSD_CAPS;
ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
ddrval := g_lpdd.CreateSurface(ddsd, g_lpddsPrimary, nil);
if ddrval <> DD_OK then
begin
DebugLoc := $4;
Exit;
end;
{ Get driver capabilities to determine Overlay support }
FillChar(capsDrv, sizeof(capsDrv), #0);
capsDrv.dwSize := sizeof(capsDrv);
ddrval := g_lpdd.GetCaps(@capsDrv, nil);
if ddrval <> DD_OK then
begin
DebugLoc := $5;
Exit;
end;
{ Does the driver support overlays in the current mode?
(Currently the DirectDraw emulation layer does not support overlays.
Overlay related APIs will fail without hardware support) }
if (capsDrv.dwCaps and DDCAPS_OVERLAY) = 0 then
begin
DebugLoc := $B;
Exit;
end;
{ Setup the overlay surface }
{ Init Direct3D }
FillChar(ddsdOverlay, sizeof(ddsdOverlay), #0);
ddsdOverlay.dwSize := sizeof(ddsdOverlay);
ddsdOverlay.dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH or DDSD_PIXELFORMAT;
ddsdOverlay.dwBackBufferCount := 0;
ddsdOverlay.dwWidth := 800;
ddsdOverlay.dwHeight := 720;
ddsdOverlay.ddsCaps.dwCaps := DDSCAPS_OVERLAY or DDSCAPS_VIDEOMEMORY;
pixelFormat.dwSize := SizeOf(pixelFormat);
PixelFormat.dwFlags := DDPF_FOURCC;
PixelFormat.dwFourCC := DWORD(Byte('U') or (Byte('Y') shl 8) or (Byte('V') shl 16) or (Byte('Y') shl 24));
PixelFormat.dwYUVBitCount := 16;
{ pixelFormat.dwFlags := DDPF_RGBTOYUV;
pixelFormat.dwFourCC := 0; }
{ pixelFormat.dwRGBBitCount := 16;
pixelFormat.dwRBitMask := $7C00;
pixelFormat.dwGBitMask := $03E0;
pixelFormat.dwBBitMask := $001F; }
{ pixelFormat.dwRgbBitCount := 16;
pixelFormat.dwRBitMask := $F800;
pixelFormat.dwGBitMask := $07E0;
pixelFormat.dwBBitMask := $001F; }
{ pixelFormat.dwRGBBitCount := 32;
pixelFormat.dwRBitMask := $000000FF;
pixelFormat.dwGBitMask := $0000FF00;
pixelFormat.dwBBitMask := $00FF0000; }
// TODO: should match the screen output color depth
//DDPIXELFORMAT pixelFormat =
// {sizeof(DDPIXELFORMAT), DDPF_RGB, 0, 32, 0x00FF0000, 0x0000FF00, 0x000000FF, 0};
ddsdOverlay.ddpfPixelFormat := pixelFormat;
ddrval := g_lpdd.CreateSurface(ddsdOverlay, g_lpddsOverlay, nil);
if ddrval <> DD_OK then
begin
DebugLoc := $C;
DebugInfo := ddrval;
Exit;
end;
if (g_lpddsOverlay = nil) then
begin
DebugLoc := $D;
Exit;
end;
{ Create a clipper for our window }
ddrval := g_lpdd.CreateClipper(0, g_lpClipper, nil);
if ddrval <> DD_OK then
begin
DebugLoc := $E;
Exit;
end;
// ddrval = IDirectDrawClipper_SetHWnd(lpClipper, 0, hwnd);
Result := True;
end;
function WndProc(ahWnd: HWND; amessage: UINT; awParam: WPARAM; alParam: LPARAM): LResult; stdcall;
var
wmId, wmEvent: Integer;
ps: PAINTSTRUCT;
MyDC: HDC;
ptClient: POINT;
rectBlt: RECT;
addbfx: DDBltFX;
begin
Result := 0;
case amessage of
WM_PAINT:
begin
{ Attach the clipper to the primary surface for this operation }
// ddrval := g_lpddsPrimary.SetClipper(g_lpClipper);
MyDC := BeginPaint(ahWnd, @ps);
{ Fill the client area with colour key }
ptClient.x := ps.rcPaint.left;
ptClient.y := ps.rcPaint.top;
ClientToScreen(GetDesktopWindow, @ptClient);
rectBlt.left := ptClient.x;
rectBlt.top := ptClient.y;
ptClient.x := ps.rcPaint.right;
ptClient.y := ps.rcPaint.bottom;
ClientToScreen(GetDesktopWindow, @ptClient);
rectBlt.right := ptClient.x;
rectBlt.bottom := ptClient.y;
addbfx.dwSize := sizeof(DDBLTFX);
addbfx.dwFillColor := 0;
g_lpddsPrimary.Blt(
@rectBlt, nil, @rectBlt, DDBLT_COLORFILL or DDBLT_WAIT, @addbfx);
EndPaint(ahWnd, @ps);
// ddrval := g_lpddsPrimary.SetClipper(nil);
end;
WM_DESTROY:
PostQuitMessage(0);
else
Result := DefWindowProc(ahWnd, amessage, awParam, alParam);
end;
end;
procedure CreateMainWindow;
var
wcex: WNDCLASSEX;
ahwnd: HWND;
begin
FillChar(wcex, sizeof(wcex), #0);
wcex.cbSize := sizeof(WNDCLASSEX);
wcex.style := CS_HREDRAW or CS_VREDRAW;
wcex.lpfnWndProc := @WndProc;
wcex.cbClsExtra := 0;
wcex.cbWndExtra := 0;
wcex.hInstance := hInstance;
// wcex.hIcon := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_OVERLAY));
wcex.hCursor := LoadCursor(0, IDC_ARROW);
wcex.hbrBackground := (COLOR_WINDOW+1);
wcex.lpszClassName := 'OVERLAYS';
// wcex.hIconSm := LoadIcon(wcex.hInstance, MAKEINTRESOURCE(IDI_SMALL));
RegisterClassEx(@wcex);
ahWnd := CreateWindow('OVERLAYS', 'Titulo', WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, CW_USEDEFAULT, 100, 100, 0, 0, hInstance, nil);
ShowWindow(ahWnd, SW_SHOWNORMAL);
UpdateWindow(ahWnd);
end;
procedure ShowError;
begin
Windows.MessageBox(0, PChar('Loc: ' + IntToHex(DebugLoc, 8) + ' Info: ' + IntToHex(DebugInfo, 8)), 'Titulo', MB_ICONEXCLAMATION + MB_OK);
end;
var
Msg: TMsg;
begin
if not InitOverlays() then ShowError;
CreateMainWindow();
while Windows.GetMessage(@Msg, 0, 0, 0) do
begin
Windows.TranslateMessage(@msg);
Windows.DispatchMessage(@msg);
end;
end.
Reply With Quote
Bookmarks