unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Direct3D9, D3DX9;

const
VERTEX_FVF = D3DFVF_XYZ or D3DFVF_DIFFUSE;

type
TVertex = packed record
x, y, z: Single;
color: DWORD;
end;

PVertices = ^TVertices;
TVertices = array[0..2] of TVertex;

TMainForm = class(TForm)
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
FDirect3D: IDirect3D9;
FD3DDevice: IDirect3DDevice9;
FVertexBuf: IDirect3DVertexBuffer9;
FKeyDown: Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AppIdle(Sender: TObject; var Done: Boolean);
procedure GetScreen;
end;

var
MainForm: TMainForm;

implementation

{$R *.dfm}

{ TMainForm }

constructor TMainForm.Create(AOwner: TComponent);
var
pa: TD3DPresentParameters;
matProj, matView: TD3DXMatrix;
eye, at, up: TD3DVector;
vertices: PVertices;
begin
inherited;
FDirect3D := Direct3DCreate9(D3D_SDK_VERSION);
if not Assigned(FDirect3D) then
begin
Application.MessageBox('Create Direct3D Failure', 'Error', MB_OK or MB_ICONERROR);
Application.Terminate;
end;

ZeroMemory(@pa, SizeOf(pa));
pa.SwapEffect := D3DSWAPEFFECT_FLIP;
pa.hDeviceWindow := Handle;
pa.Windowed := True;
pa.EnableAutoDepthStencil := True;
pa.AutoDepthStencilFormat := D3DFMT_D16;
pa.Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;

FDirect3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle, D3DCREATE_SOFTWARE_VERTEXPROCESSING,
@pa, FD3DDevice);

if not Assigned(FD3DDevice) then
begin
Application.MessageBox('Create Direct3DDevice Failure', 'Error', MB_OK or MB_ICONERROR);
Application.Terminate;
end;

FD3DDevice.CreateVertexBuffer(SizeOf(TVertex) * 3, 0, VERTEX_FVF, D3DPOOL_DEFAULT, FVertexBuf, nil);
if not Assigned(FVertexBuf) then
begin
Application.MessageBox('Create Vertex Buffer Failure', 'Error', MB_OK or MB_ICONERROR);
Application.Terminate;
end;

D3DXMatrixPerspectiveFovRH(matProj, PI / 2, ClientWidth / ClientHeight, 1, 1000);
eye := D3DXVector3(0, 0, 5);
at := D3DXVector3(0, 0, 0);
up := D3DXVector3(0, 1, 0);
D3DXMatrixLookAtRH(matView, eye, at, up);
FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
FD3DDevice.SetTransform(D3DTS_VIEW, matView);
FD3DDevice.SetRenderState(D3DRS_LIGHTING, iFalse);
FD3DDevice.SetRenderState(D3DRS_CULLMODE, D3DCULL_CW);

FVertexBuf.Lock(0, 0, Pointer(vertices), 0);
vertices[0].x := -1; vertices[0].y := -1; vertices[0].z := 0; vertices[0].color := $FFFF0000;
vertices[1].x := 1; vertices[1].y := -1; vertices[1].z := 0; vertices[1].color := $FF00FF00;
vertices[2].x := 0; vertices[2].y := 1; vertices[2].z := 0; vertices[2].color := $FF0000FF;
FVertexBuf.Unlock;

Application.OnIdle := AppIdle;
end;

destructor TMainForm.Destroy;
begin
FVertexBuf := nil;
FD3DDevice := nil;
FDirect3D := nil;
inherited;
end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FKeyDown := True;
end;

procedure TMainForm.AppIdle(Sender: TObject; var Done: Boolean);
var
matWorld: TD3DMatrix;
begin
D3DXMatrixIdentity(matWorld);
FD3DDevice.SetTransform(D3DTS_WORLD, matWorld);

FD3DDevice.Clear(0, nil, D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER, $FF000000, 1, 0);
if Succeeded(FD3DDevice.BeginScene) then
begin
FD3DDevice.SetFVF(VERTEX_FVF);
FD3DDevice.SetStreamSource(0, FVertexBuf, 0, SizeOf(TVertex));
FD3DDevice.DrawPrimitive(D3DPT_TRIANGLELIST, 0, 1);
FD3DDevice.EndScene;
FD3DDevice.SetStreamSource(0, nil, 0, 0);
FD3DDevice.Present(nil, nil, Handle, nil);
end;

if FKeyDown then
begin
GetScreen;
FKeyDown := False;
end;

Done := False;
end;

procedure TMainForm.GetScreen;
type
TColor4 = packed record
b, g, r, a: Byte;
end;
PColor4Array = ^TColor4Array;
TColor4Array = array[0..0] of TColor4;

TColor3 = packed record
b, g, r: Byte;
end;
PColor3Array = ^TColor3Array;
TColor3Array = array[0..0] of TColor3;

var
i, j: Integer;
bf: IDirect3DSurface9;
r: TRect;
lr: TD3DLockedRect;
bmp: TBitmap;
src: PColor4Array;
dest: PColor3Array;
begin
r := Rect(0, 0, ClientWidth, ClientHeight);
FD3DDevice.GetBackBuffer(0, 0, D3DBACKBUFFER_TYPE_MONO, bf);
bf.LockRect(lr, nil, D3DLOCK_READONLY);
bmp := TBitmap.Create;
bmp.Width := ClientWidth;
bmp.Height := ClientHeight;
bmp.PixelFormat := pf24Bit;
for i := 0 to ClientHeight - 1 do
begin
src := lr.pBits;
dest := bmp.ScanLine[i];
for j := 0 to ClientWidth - 1 do
begin
dest[j].b := src[j].b;
dest[j].g := src[j].g;
dest[j].r := src[j].r;
end;
lr.pBits := Pointer(Integer(lr.pBits) + lr.Pitch);
end;
bf.UnlockRect;
bf := nil;
bmp.SaveToFile(ExtractFilePath(Application.ExeName) + 'Screen.bmp');
bmp.Free;
end;

end.