为什么移动图像会闪烁？

[hotxu]

我用DirectDraw在屏幕上移动一幅图像，移动方式如下：
目前的效果，画面有时有一顿一顿的感觉，偶尔有闪烁。

1、DirectDraw初始化
{*******************************************************************************
初始化DirectDraw
*******************************************************************************}
function TFrmNotePlay.InitDirectDraw : Boolean;
var
ddsd : TDDSurfaceDesc2;
ddscaps : TDDSCaps2;
hRet : HRESULT;
AGUID :PGUID;
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;

[HsWong]

设置Form的双缓冲会不会好点
DoubleBuffered:=true;

[hotxu]

设过了，没有用。

[SonicX]

我觉得Timer1计时器的问题，Timer1是很不稳定的
建议你直接用API建立窗口自己建立消息循环
例如
var
..
..
aMsg :TMsg;
begin
...
//建立窗口略
...

//建立消息循环
if SUCCEEDED(InitDraw(hWnd)) then begin //初始化Draw过程
ShowWindow( hWnd, SW_SHOWDEFAULT ); //显示更新窗口
UpdateWindow( hWnd );

//进入消息循环
Fillchar(aMSG, sizeof(aMSG), 0);
while not (aMsg.message = WM_QUIT) do
if PeekMessage( aMsg, 0, 0, 0, PM_REMOVE ) then begin //有系统消息则处理
TranslateMessage ( aMsg ) ;
DispatchMessage ( aMsg ) ;
end else
Render; //没有消息则不断触发类似你的timer1过程
end;

Cleanup; //退出程序的清理过程


end

[noelse520]

DoubleBuffered:=true;

[constantine]

h_DC是什么谁？要打开hdc对应的对象的DoubleBuffered才有用。不是直接DoubleBuffered:=true;

[SonicX]

楼主明明是在说DirectDraw，DirectDraw完全是显卡内存操作关DoubleBuffere鸟事

[billwillman]

我已经回答了这问题，没有人听

[celftj]

VC用内存DC能缓解这个现象,不知在Delphi中怎么用

[ahjoe]

有清除就有闪烁

[IDWB]

使用DirectDraw的双缓冲方式或者可以参考一下转抄内容

如果要快速移动的话，只要改变sleep中的参数，而且还没有闪烁感。
unit TcarUnit;

interface
uses
Windows,SysUtils,Classes,Graphics,dialogs,Controls,Forms,Extctrls;


Type
TCar=class(TBitmap)
private
FPos:TPoint;
FPortTime:integer;
Findex:integer;
//procedure cartimertimer(sender:Tobject);
published
property index:integer read findex write findex;
property Pos:Tpoint read Fpos write Fpos;
property PortTime:integer read FportTime write FPortTime;
Public
constructor Create;override;
Destructor Destroy;override;
procedure MoveTo( Form1:TForm;x,y:integer);
procedure SetPosition(Form1:Tform;x,y:integer);
end;
implementation
constructor TCar.Create ;
begin
inherited create;
pos:=point(10,100);
height:=20;
width:=20;
porttime:=100;

end;
destructor Tcar.Destroy ;
begin
inherited destroy;
end;
procedure TCar.MoveTo( Form1:Tform;x,y:integer);
var


m,n,i,dest:integer;
begin
dest:=trunc(sqrt(sqr(x-pos.x)+sqr(y-pos.y)));
sleep(20);
form1.canvas.draw(pos.x,pos.y,self);

for i:=1 to dest do
begin

m:=trunc(pos.x+i*(x-pos.x)/dest);
n:= trunc(pos.y+i*(y-pos.y)/dest);
sleep(5);
form1.canvas.draw(m,n,self);

form1.Canvas.Pen.Color :=form1.Color ;
with form1.canvas do
begin
if(pos.y<y)and(pos.x=x) then
begin
moveto(m,n-1);
lineto(m+width,n-1);
end;
if(pos.y>y)and(pos.x=x) then
begin
moveto(m,n+height+1);
lineto(m+width,n+height+1);
end;
if(pos.x<x)and (pos.y=y)then
begin
moveto(m-1,n);
lineto(m-1,n+height+1);
end;
if(pos.x>x)and(pos.y=y)then
begin
moveto(m+width,n);
lineto(m+width,n+height+1);
end;
if(pos.x>x)and(pos.y>y) then
begin
moveto(m,n+height);
lineto(m+width,n+height);
lineto(m+width,n);
end;
if(pos.x<x)and(pos.y<y) then
begin
moveto(m-1,n+height-1);
lineto(m-1,n-1);
lineto(m+width,n-1);
end;
if(pos.x<x)and(pos.y>y) then
begin
moveto(m,n);
lineto(m,n+height);
lineto(m+width,n+height);
end;
if(pos.x>x)and(pos.y<y) then
begin
moveto(m,n);
lineto(m+width,n);
lineto(m+width,n+height);
end;
end;

end;
form1.canvas.CopyMode :=cmsrccopy;
pos:=point(x,y);
end;
Procedure TCar.SetPosition (Form1:TForm;x,y:integer);
begin
form1.canvas.Brush.Color :=form1.color;
Form1.canvas.fillrec(rect(pos.x,pos.y,pos.x+width,pos.y+height));
pos:=point(x,y);
form1.canvas.draw(x,y,self);
end;



end.

[zsloyes]

函数开头中加一句试试
DoubleBuffered:=true;

[Jethill]

既然要对图像进行刷新，肯定要有点闪烁，如果在当前的代码下想不闪，可能性不大。

[mainvhaide]

窗口只要有变化Windows就默认重新绘制窗口，自然有闪烁。

[数字蛋糕]

试试看手动拦截窗口的WM_ERASEBKGND消息。

[Anders000]

LZ用了DDraw，DoubleBuffered:=true;应该没用的把