delphi DirectX简单应用

uses DirectSound,Direct3D9,D3DX9;

//DirectX截屏函数

procedure CaptureScreen(Const FileName: string);
var
BitsPerPixel: Byte;
pD3D: IDirect3D9;
pSurface: IDirect3DSurface9;
g_pD3DDevice: IDirect3DDevice9;
D3DPP: TD3DPresentParameters;
ARect: TRect;
LockedRect: TD3DLockedRect;
BMP: TBitmap;
i, p: Integer;
begin
BitsPerPixel := GetDeviceCaps(GetDC(0), BITSPIXEL);
FillChar(d3dpp, SizeOf(d3dpp), 0);
D3DPP.Windowed := True;
D3DPP.Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;
D3DPP.SwapEffect := D3DSWAPEFFECT_DISCARD;
D3DPP.BackBufferWidth := Screen.Width;
D3DPP.BackBufferHeight := Screen.Height;
D3DPP.BackBufferFormat := D3DFMT_X8R8G8B8;
pD3D := Direct3DCreate9(D3D_SDK_VERSION);
pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, GetDesktopWindow,
D3DCREATE_SOFTWARE_VERTEXPROCESSING, @D3DPP, g_pD3DDevice);
g_pD3DDevice.CreateOffscreenPlainSurface(Screen.Width, Screen.Height, D3DFMT_A8R8G8B8, D3DPOOL_SCRATCH, pSurface, nil);
g_pD3DDevice.GetFrontBufferData(0, pSurface);
// use D3D to save surface. Notes: D3DX%ab.dll is required!
// D3DXSaveSurfaceToFile('Desktop.bmp', D3DXIFF_BMP, pSurface, nil, nil);
// use Bitmap to save surface
ARect := Screen.DesktopRect;
pSurface.LockRect(LockedRect, @ARect, D3DLOCK_NO_DIRTY_UPDATE or D3DLOCK_NOSYSLOCK or D3DLOCK_READONLY);
BMP := TBitmap.Create;
BMP.Width := Screen.Width;
BMP.Height := Screen.Height;
case BitsPerPixel of
8: BMP.PixelFormat := pf8bit;
16: BMP.PixelFormat := pf16bit;
24: BMP.PixelFormat := pf24bit;
32: BMP.PixelFormat := pf32bit;
end;
p := Cardinal(LockedRect.pBits);
for i := 0 to Screen.Height - 1 do
begin
CopyMemory(BMP.ScanLine[i], Ptr(p), Screen.Width * BitsPerPixel div 8);
p := p + LockedRect.Pitch;
end;
BMP.SaveToFile(FileName);
BMP.Free;
pSurface.UnlockRect;
end;

//DirectSound检测音频设备函数


function DsEnumProc(lpGuid: PGUID; lpcstrDescription, lpcstrModule: PAnsiChar;lpContext: Pointer): BOOL;stdcall;
var
tempGuid: PGUID;
begin
Result := True;
if lpGuid <> nil then
begin
tempGuid := GetMemory(SizeOf(TGUID));
if tempGuid = nil then
begin
Result := true;
exit;
end;
CopyMemory(tempGuid,lpGuid,SizeOf(TGuid));

//这里的lpContext就是咱在DirectSoundEnumerate函数中传递的Combobox，所以直接转化就好了
TComboBox(lpContext).Items.AddObject(string(lpcstrDescription),TObject(tempGuid));
//不要主声音驱动程序
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DirectSoundEnumerate(DsEnumProc,self.ComboBox1);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CaptureScreen('c:\aa.bmp');
end;