Delphi 10.4中BitBlt与垂直同步同步解决屏幕撕裂求助

1. 启用窗体双缓冲+离屏绘制 #

VCL的双缓冲能减少直接绘制到屏幕的次数，配合离屏Bitmap先完成所有绘制再一次性输出，是解决撕裂的基础：

• 主窗体的DoubleBuffered属性设为True
• 创建离屏TBitmap作为缓冲，先把5张BMP全部绘制到该缓冲，再用一次BitBlt输出到窗体画布

示例代码：

var
  OffscreenBmp: TBitmap;
begin
  OffscreenBmp := TBitmap.Create;
  try
    OffscreenBmp.SetSize(ClientWidth, ClientHeight);
    // 依次将5张BMP绘制到离屏缓冲
    BitBlt(OffscreenBmp.Canvas.Handle, 0, 0, 300, 900, Bmp1.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(OffscreenBmp.Canvas.Handle, 300, 0, 300, 900, Bmp2.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(OffscreenBmp.Canvas.Handle, 600, 0, 300, 900, Bmp3.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(OffscreenBmp.Canvas.Handle, 900, 0, 300, 900, Bmp4.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(OffscreenBmp.Canvas.Handle, 1200, 0, 300, 900, Bmp5.Canvas.Handle, 0, 0, SRCCOPY);
    // 一次性输出到窗体
    BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, OffscreenBmp.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    OffscreenBmp.Free;
  end;
end;

2. 正确调用垂直同步等待 #

之前的WaitForVerticalBlank可能因调用时机或API使用方式错误失效，推荐用Direct3D的垂直同步机制，确保绘制动作严格对齐显示器刷新：

示例代码（动态调用Direct3D实现垂直同步）：

type
  TDirect3DCreate9 = function(SDKVersion: Integer): IDirect3D9; stdcall;
var
  D3D: IDirect3D9;
  D3Dpp: D3DPRESENT_PARAMETERS;
  Device: IDirect3DDevice9;
begin
  var hD3D := LoadLibrary('d3d9.dll');
  if hD3D <> 0 then
  begin
    var CreateFunc := TDirect3DCreate9(GetProcAddress(hD3D, 'Direct3DCreate9'));
    if Assigned(CreateFunc) then
    begin
      D3D := CreateFunc(D3D_SDK_VERSION);
      if Assigned(D3D) then
      begin
        ZeroMemory(@D3Dpp, SizeOf(D3Dpp));
        D3Dpp.Windowed := True;
        D3Dpp.SwapEffect := D3DSWAPEFFECT_DISCARD;
        D3Dpp.hDeviceWindow := Handle;
        // 创建带垂直同步的设备
        if Succeeded(D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle,
          D3DCREATE_HARDWARE_VERTEXPROCESSING, @D3Dpp, Device)) then
        begin
          // 等待垂直同步完成，放在绘制逻辑之后
          Device.Present(nil, nil, 0, nil);
        end;
      end;
    end;
    FreeLibrary(hD3D);
  end;
end;

将这段代码放在每次绘制完成后调用，确保输出动作与显示器刷新同步。

3. 优化绘制参数与环境 #

• 确保所有源BMP的像素格式与窗体画布一致（比如统一用32位RGB），避免BitBlt时的格式转换延迟
• 临时禁用窗体Aero特效排查：SetWindowLongPtr(Handle, GWL_EXSTYLE, GetWindowLongPtr(Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED);，若有效再考虑长期适配

4. 高精度定时器控制帧率 #

放弃普通TTimer，用QueryPerformanceCounter实现精准的60FPS循环，避免定时器误差导致绘制时机错位：

var
  LastTick: Int64;
  TickFreq: Int64;
begin
  QueryPerformanceFrequency(TickFreq);
  QueryPerformanceCounter(LastTick);
  while True do
  begin
    var CurrentTick: Int64;
    QueryPerformanceCounter(CurrentTick);
    // 确保每帧间隔稳定在~16.67ms
    while (CurrentTick - LastTick) < (TickFreq div 60) do
    begin
      Sleep(1);
      QueryPerformanceCounter(CurrentTick);
    end;
    LastTick := CurrentTick;
    // 执行绘制逻辑
    DrawAllBitmaps;
    // 等待垂直同步
    WaitForVSync; // 这里调用前面实现的Direct3D等待逻辑
  end;
end;

内容的提问来源于stack exchange，提问作者brane