为什么移动图像会闪烁？ ( 积分: 200 )

我用DirectDraw在屏幕上移动一幅图像。目前的效果，画面有时有一顿一顿的感觉，偶尔有闪烁。
相关代码如下，请大家帮我看看。
1、DirectDraw初始化
{*******************************************************************************
初始化DirectDraw
*******************************************************************************}
function TFrmNotePlay.InitDirectDraw : Boolean;
var
ddsd : TDDSurfaceDesc2;
ddscaps : TDDSCaps2;
hRet : HRESULT;
AGUID GUID;
begin
Result := False;
cur_SD:=curDisplaySettingParam.ydsu;
if not isWindows then begin
ChangeAdapter(curDisplaySettingParam.AdapterIndex+1);
curDisplaySettingParam.ScreenBitDepth:=8;
new(AGUID);
AGUID:=@curDisplaySettingParam.AdapterGUID;
// Create the main DirectDraw object
hRet := DirectDrawCreateEx(AGUID, FDD, IDirectDraw7, nil);
end
else
hRet := DirectDrawCreateEx(nil, FDD, IDirectDraw7, nil);
if hRet <> DD_OK then begin
ErrorOut(hRet, 'DirectDrawCreateEx');
Exit;
end;

//Setting the cooperate level
if isWindows then
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_NORMAL)
else
hRet := FDD.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or
DDSCL_EXCLUSIVE or DDSCL_ALLOWREBOOT);
if hRet <> DD_OK then begin
ErrorOut(hRet, 'SetCooperativeLevel');
Exit;
end;

// Setting the display mode
if not isWindows then begin
//全屏模式支持
hRet := FDD.SetDisplayMode(
curDisplaySettingParam.ScreenWidth,
curDisplaySettingParam.ScreenHeight,
curDisplaySettingParam.ScreenBitDepth, 0, 0);
if hRet <> DD_OK then begin
ErrorOut(hRet, 'SetDisplayMode');
Exit;
end;
end;

// Create the primary surface
FillChar(ddsd, SizeOf(ddsd), 0);
ddsd.dwSize := SizeOf(ddsd);
if isWindows then begin
ddsd.dwFlags := DDSD_CAPS ;
ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE ;
end
else begin
ddsd.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
ddsd.dwBackBufferCount := 1;
end;
hRet := FDD.CreateSurface(ddsd, FDDSPrimary, nil);
if hRet <> DD_OK then begin
ErrorOut(hRet, 'CreateSurface');
Exit;
end;

// Create the Backbuffer
if isWindows then begin
FillChar(ddsd, SizeOf(ddsd), 0);
ddsd.dwSize := SizeOf(ddsd);
ddsd.dwFlags:=DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
ddsd.ddsCaps.dwCaps:=DDSCAPS_OFFSCREENPLAIN or DDSCAPS_VIDEOMEMORY;
ddsd.dwWidth:=curDisplaySettingParam.ScreenWidth;
ddsd.dwHeight:=curDisplaySettingParam.ScreenHeight;
hRet := FDD.CreateSurface(ddsd, FDDSBack, nil);

end
else begin
FillChar(ddscaps, SizeOf(ddscaps), 0);
ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
hRet := FDDSPrimary.GetAttachedSurface(ddscaps, FDDSBack);
end;
if hRet <> DD_OK then begin
ErrorOut(hRet, 'Create the Backbuffer');
Exit;
end;

if isWindows then begin
//设置覆盖区域
hRet :=FDD.CreateClipper(0,FDDSClipper,nil);
if hRet <> DD_OK then
begin
ErrorOut(hRet, 'Create the Clipper');
Exit;
end;
hRet :=FDDSClipper.SetHWnd(0,Handle);
if hRet <> DD_OK then
begin
ErrorOut(hRet, 'SetHWnd');
Exit;
end;
FDDSPrimary.SetClipper(FDDSClipper);
end;
Result := True;
Timer1.Enabled:=true;
end;
2、页面交换
{*******************************************************************************
FlipPages 页面交换
功能：
将后台处理好的画面显示到屏幕上
*******************************************************************************}
function TFrmNotePlay.FlipPages : Boolean;
var
hRet : HRESULT;
WinRect,sRect: TRect;
ddscaps : TDDSCaps2;
ddbltfx : TDDBltFx;
begin
FillChar(ddbltfx, SizeOf(ddbltfx), 0);
ddbltfx.dwSize := SizeOf(ddbltfx);
ddbltfx.dwDDFX :=DDBLTFX_NOTEARING;//DDBLTFX_MIRRORLEFTRIGHT;//
if not FActive then exit;
Result := False;
while True do begin
//等待垂直刷新信号
FDD.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN,0);
if not isWindows then begin
//全屏模式
hRet := FDDSPrimary.Flip(nil, 0);
end
else begin
//窗口模式
GetWindowRect(Handle,WinRect);
sRect.Left:=0;
sRect.Top:=0;
sRect.Right:=curDisplaySettingParam.ScreenWidth;
sRect.Bottom:=curDisplaySettingParam.ScreenHeight;
hRet := FDDSPrimary.Blt(@WinRect, FDDSBack, nil, DDBLT_WAIT or DDBLT_DDFX,@ddbltfx);
//hRet := FDDSPrimary.Blt(@WinRect, FDDSBack, nil, DDBLT_WAIT ,nil);
//FDDSPrimary.BltFast(0,0,FDDSBack,nil,DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
end;
if hRet = DD_OK then begin
Break;
end
// 找回丢失的页面
else if hRet = DDERR_SURFACELOST then begin
hRet := FDDSPrimary._Restore;
if hRet <> DD_OK then begin
Exit;
end;
end
// 异常
else if hRet <> DDERR_WASSTILLDRAWING then begin
Exit;
end;
end;
// OK
Result := True;
end;
3、处理后台页面
function TFrmNotePlay.UpdateFrame : Boolean;
var
h_DC : HDC;
ddbltfx : TDDBltFx;
size : TSize;
hRet : HRESULT;
demoStr:String;
DemoFontStr:String;
begin
if not FActive then exit;
// 清除后台屏幕图像
FillChar(ddbltfx, SizeOf(ddbltfx), 0);
ddbltfx.dwSize := SizeOf(ddbltfx);
ddbltfx.dwFillColor := 0;
hRet := FDDSBack.Blt(nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, @ddbltfx);
if hRet <> DD_OK then begin
result:=false;
Exit;
end;
// Draw
if FDDSBack.GetDC(h_DC) = DD_OK then begin
//刷新后台屏幕图像
MovePhoto(h_DC);
FDDSBack.ReleaseDC(h_DC);
end;
// OK:
Result := True;
end;
4、移动图像
procedure TFrmNotePlay.MovePhoto(h_DC : HDC);
begin
StretchBlt(
h_dc,
curDisplaySettingParam.p_l,
curDisplaySettingParam.p_t,
curDisplaySettingParam.DisplayWidth,
curDisplaySettingParam.DisplayHeight,
Bmp2.Canvas.Handle, 0, ss,
curDisplaySettingParam.DisplayWidth,
curDisplaySettingParam.DisplayHeight,
SRCCOPY)
end;
5、我用timer计时器定时刷新屏幕
procedure TFrmNotePlay.Timer1Timer(Sender: TObject);
var
TickCount,thisTickCount:Integer;
begin
if FActive then begin
if canMove then //判断当前画面是否需要移动
ScreenUpDate; //处理移动方式与距离
if UpdateFrame then begin //更新后台页面
if not FlipPages then begin //将后台页面拷贝到前台
Close;
end;
end
else begin
Close;
end;
end;

end;

用缓冲了吗?用缓冲了吗?

你说的缓冲是指什么？我用后台页面来切换的

画面的闪烁不太好描述，有时出现有时不出现。

DoubleBuffered = True

晕,你用Timer来交换页啊,哪能不闪??
用Application.OnIdle里交换页
记住:在里面要设置下刷新频率(自己写代码的方式),否则CPU使用率100%(只要系统空闲就会执行OnIdle)

定时器速度不够快,用 TimeSetEvent

对了,那些DoubleBuffered都不好使
你用的是DirectX

Timer最多也只能达到10ms的精度,比这再低的值也没有用(除非用其他类型定时器,如:多媒体定时器)
你看看Delphi的DirectX的例子,它都是用OnIdle里面写的

DoubleBuffered = True这样就好了,不用其他的应该就可以
缓冲设一下,屏幕就不会这样感到刷屏了

不是刷屏，而是图像运动的闪烁。我测试了一下，FPS能到60左右。闪烁是这样的，当下次移动图像的时间间隔越大，图像就越闪烁，到一定程度就一顿一顿了。是不是我移动图片的思路有问题。

DoubleBuffered = True，不行我试过了。我怀疑是移动图片的方式有问题。我不移动图片时。屏幕一点都不闪。也就是在时间循环中不执行以下语句：
if canMove then //判断当前画面是否需要移动
ScreenUpDate; //处理移动方式与距离

不过我建议你不要使用Timer控件

我没有用DirectX的控件，看了它的例子。效果还不如我的好。

这里的都是GS

用不用DirectX控件,不是主要问题,但关键是交换速度

非要全屏吗？如果不是的话，directx没有任何好处。

应该全用图象处理语句，不能用控件

delphi世界qq群：23981160，喜欢Delphi的都进来

为什么还要用DirectDraw那种过时的东西，为什么不用d3d.