关于对directx中抓图的代码。谁能提供？或者将我此贴的bcb代码转为delphi的(100分)

我对这方面简直是无从下手，你做出来一点点？
一点点贴出来给我看看也好啊

转换成 Delphi 倒是不难，如下：
function TakeScreenShot(device: IDirect3DDevice8; file_name: string; screenx, screeny: integer):Boolean;
var
FrontBuf:IDirect3DSurface8;
hr:HRESULT;
begin
Result:= False;
device.CreateImageSurface(screenx, screeny, D3DFMT_A8R8G8B8, frontbuf);
if device.GetFrontBuffer(frontbuf)<> D3D_OK then
begin
　　 MessageBox(0, '不能建立 D3D 前台缓冲区','ERROR', MB_OK);
exit;
end;
hr:=D3DXSaveSurfaceToFile(PChar(file_name), 0, frontbuf, nil, nil);
if hr=D3D_OK then
Result:= True; // 不需要象 C++ 那样手工释放对象
end;

问题是 D3DXSaveSurfaceToFile 没有被 jedi 收录在 JeDi_DirectX_8 头文件中。
需要自己转换，要转换出来本来也不是太难：
function D3DXSaveSurfaceToFile(DestFileChar;
DestFormat:Integer; // D3DXIMAGE_FILEFORMAT
SrcSurface:IDirect3DSurface8;
SrcPalette:^TPaletteEntry;
SrcRect:^TRect):HResult;stdcall;
问题是我不知道这个函数在 Microsoft DirectX Lib 的哪个 Dll 中：
function D3DXSaveSurfaceToFileA; external '???????.dll' name 'D3DXLoadSurfaceFromFileA';
如果这个函数是通过 DirectXFileCreate 来获得的话，还要载入 D3DXOF.dll 库。
试着查查最新的 DirectX_8 的头文件，不知道有没有把这个函数加进入。

--------------------------------------------
附 D3DXIMAGE_FILEFORMAT 的说明：
D3DXIFF_BMP = 0,
D3DXIFF_JPG = 1,
D3DXIFF_TGA = 2,
D3DXIFF_PNG = 3,
D3DXIFF_DDS = 4,
D3DXIFF_PPM = 5,
D3DXIFF_DIB = 6,
D3DXIFF_FORCE_DWORD = 0x7fffffff

我觉得在DelphiX中的DirectDraw环境下处理截图用 surface.assignto( dxdib.dib) 和 dxdib.dib.savetofile就很方便。
现在有许多人在D3D下编程，dxdraw在3D模式下，也许处理方法不一样吧。还望指教。

另，有不少道友说DelphiX的作者以后不出了，譬如对DirectX8的封装，是否真的？哪里下载？

gz

关注？还关注个鸟，贴主都不知道死哪里去了，还关注？！

呵呵可是我还关注着啊 一年了

FDGDFG

D3DXSaveSurfaceToFile 在 JEDI DirectX81 中已经支持。特别是 Clootie DirectX 版本。
要就近下载，可以看下面地址。有了这些，加上上面楼上各位的回复，应该可以结贴了吧。
http://www.xxtax.gov.cn/delphi/bbsxp/showtopic.asp?id=17&amp;forumid=1&amp;page=5

这个问题很难吗？
我测试过不难啊，不用DX也可以,这是我测试在游戏中显示文字的程序，顺便加了一个截图
我的代码：
unit1:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,SyncObjs;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure MsgHotKey(Var msg:Tmessage);message WM_HOTKEY;
public
{ Public declarations }
m_stop:TEvent;
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}
procedure TForm1.MsgHotKey(Var msg:Tmessage);
begin
if msg.wParam=1001 then Button1Click(Button1);
if msg.wParam=1002 then Button2Click(Button2);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
te:ShowTEXTToWin;
begin
te:=ShowTEXTToWin.Create(m_stop);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
m_stop.SetEvent();
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
m_stop:=TEvent.Create(NIL,TRUE,FALSE,'Stop Show TEXT');
RegisterHotKey(self.Handle,1001,MOD_ALT,VK_F1);
RegisterHotKey(self.Handle,1002,MOD_ALT,VK_F2);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnregisterHotKey(self.Handle,1001);
UnregisterHotKey(self.Handle,1002);
end;

end.

unit2:
unit Unit2;

interface

uses
Classes,Windows,SyncObjs,Graphics;

type
ShowTEXTToWin = class(TThread)
private
{ Private declarations }
FullscreenDC:HDC;
strText:String;
m_stop:TEvent;
procedure ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);
procedure ShowText();
protected
procedure Execute; override;
public
constructor Create(Astop:TEvent);
end;

implementation

procedure ShowTEXTToWin.ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
DestDC:=CreateCompatibleDC(FullscreenDC);
Bhandle:=CreateCompatibleBitmap(FullscreenDC,RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,FullscreenDC,LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToFile('c:/test.jpg');
Bitmap.Free; DeleteDC(DestDC);
ReleaseDC(Bhandle,FullscreenDC);
end;


{ ShowTEXTToWin }
procedure ShowTEXTToWin.ShowText();
begin
FullscreenDC:=GetDC(0);
Textout(FullscreenDC,1,1,Pchar(strText),Length(strText));
ScreenCap(0,0,640,480);
end;

constructor ShowTEXTToWin.Create(Astop:TEvent);
begin
strText:='这里在测试！！';
m_stop:=Astop;
FreeOnTerminate := TRUE;
inherited Create(False);
end;

procedure ShowTEXTToWin.Execute;
begin
{ Place thread code here }
while true do
begin
ShowText();
if wrSignaled=m_stop.WaitFor(20) then break;
end;
end;

end.

不用DX抓出来只有 256色啊, 上面的程序真的能支持真彩吗

xwing早就给我了一个DX截图的，可以用，不过我没研究了，真人要的话可以向xwing要

还是无人能接此老帖子

以前没有看到，试试吧：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2481887
好用，给淀粉欧：）

x谢谢TTT这是老帖子 ,我将你那帖的代码粘过来好让大家参考，实验成功马上结帖子
来自：tt.t, 时间：2004-3-5 9:43:06, ID：2485722
一年前写的东西了，赫赫，看来还有点价值。如果符合要求的话记得给分阿：）
程序如下：
(*********************DLL PART*********************)
library PTDLL;

uses
SysUtils, Classes, Windows, Messages, Graphics, DirectDraw;
//DirectDraw.pas需按照我在这篇（http://www.delphibbs.com/delphibbs/dispq.asp?lid=2135796）里的描述修改

{$R *.RES}

var
hNextHookProc: HHook;
procSaveExit: Pointer;
pDirectDrawCreate:function (lpGUID: PGUID;out lplpDD: IDirectDraw;pUnkOuter: IUnknown) : HResult; stdcall;

function HookProc(iCode: integer; wParam: Cardinal; lParam: Cardinal): LResult; stdcall;
var
iDDWORD; //指向前台程序建立的IDirectDrawInterface的指针
iPsWORD; //指向前台程序建立的PrimarySurface的指针
ddRtn:dword; //临时变量
FD:IDirectDraw; //为获得前台程序建立的IDirectDrawInterface而设
DC:HDC; //接收PrimarySurface.GetDC得到的DC
bm:tbitmap; //保存DC的图像道磁盘用
begin
Result:=0;
if iCode<0 then
begin
CallNextHookEx(hnexthookproc,iCode,wParam,lParam);
result:=0;
Exit;
end;
if ((lParam and $80000000)=0) and
(GetKeyState(VK_LWIN)<0) and (wParam=$6a) then //热键：左WIN + 数字键盘*
begin
ddRtn:=DWORD(GetModuleHandle('DDRAW.DLL'));
if ddRtn<>0 then //前台程序是否用了DirectDraw?
begin
pDirectDrawCreate:=GetProcAddress(ddRtn,'DirectDrawCreate');
if pDirectDrawCreate(nil,FD,nil)=DD_OK then
//如是，看看能否再建立一个
begin
try
iDD:=DWORD(Pointer(DWORD((@FD)^)+8)^); //得到前台程序建立的IDirectDrawInterface
iPs:=DWORD(Pointer(DWORD(Pointer(iDD+4)^)+44)^); //得到前台程序建立的PrimarySurface
//上面这些是我分析得到的结果，不能保证在将来一定能够继续使用，但直到DX8.1是没问题的估计同样适用DX9
except
FD:=nil;
exit;
end;
asm
lea edx,DC
push edx
mov eax,iPs
push eax
mov eax,[eax]
call [eax+$44] //调用PrimarySurface.Getdc，具体用法参照DDraw帮助
mov ddRtn,eax
end;
if ddRtn<>DD_OK then //得到PrimarySurface的DC？
begin
fd:=nil;
exit;
end;
bm:=tbitmap.Create;
try //成功得到PrimarySurface的DC
bm.Width:=GetDeviceCaps(DC,HORZRES); //获得屏幕宽高，对bm作相应设置
bm.Height:=GetDeviceCaps(DC,VERTRES);
SetBKColor(DC,RGB(0,0,255));
SetTextColor(DC,RGB(255,255,0));
TextOut(DC,0,0,PChar('Grabed !'),8); //用蓝底黄字在图像上写几个字
bitblt(bm.Canvas.Handle,0,0,bm.Width,bm.Height,DC,0,0,SRCCOPY);
//将PrimarySurface的图像拷贝到bm上
bm.SaveToFile('C:/1.bmp'); //存到C:/1.bmp
finally
asm
mov edx,DC
push edx
mov eax,iPs
push eax
mov eax,[eax]
call [eax+$68] //调用PrimarySurface.ReleaseDC，具体用法参照DDraw帮助
end; //必需的，如Release失败会导致前台程序失去响应，原因参照DDraw帮助
end;
bm.Free;
FD:=nil; //释放FD
end;
end;
Result:=1; //吃掉LWIN+NUMPAD*
end;
end;

function SetHook:bool;export;
begin
Result:=False;
if hNextHookProc<>0 then exit;
hNextHookProc := SetWindowsHookEx(WH_KEYBOARD,@HookProc,HInstance,0);
//设置键盘钩子以响应热键
Result := hNextHookProc <> 0;
end;

function EndHook:bool;export;
begin
if hNextHookProc <> 0 then
begin
UnhookWindowshookEx(hNextHookProc);
hNextHookProc := 0;
end;
Result := hNextHookProc = 0;
end;

procedure HotkeyHookExit;
begin
if hNextHookProc <> 0 then EndHook;
ExitProc := procSaveExit;
end;

exports
SetHook,
EndHook;

begin
hNextHookProc := 0;
procSaveExit := ExitProc;
ExitProc := @HotKeyHookExit;
end.
(*********************FORM PART*********************)
object Form1: TForm1
Left = 192
Top = 107
Width = 264
Height = 125
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 56
Top = 8
Width = 92
Height = 20
Caption = 'UNHOOKED'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Button1: TButton
Left = 32
Top = 40
Width = 153
Height = 25
Caption = 'HOOK!!'
TabOrder = 0
OnClick = Button1Click
end
end
(*******************PROJECT PART********************)
program ptest;

uses
Forms,
Windows,
test in 'test.pas' {Form1};

{$R *.RES}

begin
CreateMutex(Nil,false,'Grab_DX_SNaP!');
if GetLastError=ERROR_ALREADY_EXISTS then
begin
Application.MessageBox('Already Running!!','Error',MB_OK);
Halt(0);
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
(*******************test.pas PART********************)
unit test;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Exit_Message:Cardinal;

implementation

{$R *.DFM}
function SetHook:bool;external 'ptdll.dll';
function EndHook:bool;external 'ptdll.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
if button1.Caption='HOOK!!' then
begin
sethook;
button1.Caption:='UNHOOK';
Label1.Caption:='HOOKED!!';
end
else
begin
endhook;
button1.Caption:='HOOK!!';
Label1.Caption:='UNHOOKED!!';
end
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
endhook;
end;

end.