Есть рабочий код из Desktop Duplication API. Он переводит ID3D11Texture2D в TBitmap:
function TDesktopDuplicationWrapper.DrawFrame(var Bitmap: TBitmap): Boolean;
var
Desc: TD3D11_TEXTURE2D_DESC;
Temp: ID3D11Texture2D;
Resource: TD3D11_MAPPED_SUBRESOURCE;
i: Integer;
p: PByte;
begin
Result := True;
FTexture.GetDesc(Desc);
if Bitmap = nil then
Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf32Bit;
Bitmap.SetSize(Desc.Width, Desc.Height);
Desc.BindFlags := 0;
Desc.CPUAccessFlags := Ord(D3D11_CPU_ACCESS_READ) or Ord(D3D11_CPU_ACCESS_WRITE);
Desc.Usage := D3D11_USAGE_STAGING;
Desc.MiscFlags := 0;
// READ/WRITE texture
FError := FDevice.CreateTexture2D(@Desc, nil, Temp);
if Failed(FError) then
begin
FTexture := nil;
FDuplicate.ReleaseFrame;
Result := False;
Exit;
end;
// copy original to the RW texture
FContext.CopyResource(Temp, FTexture);
// get texture bits
FContext.Map(Temp, 0, D3D11_MAP_READ_WRITE, 0, Resource);
p := Resource.pData;
// copy pixels - we assume a 32bits bitmap !
for i := 0 to Desc.Height - 1 do
begin
Move(p^, Bitmap.ScanLine[i]^, 4 * Desc.Width);
Inc(p, 4 * Desc.Width);
end;
FTexture := nil;
FDuplicate.ReleaseFrame;
end;
Мне нужно переделать так, чтобы писалось не в TBitmap, а в DIBSection (а именно в pBits), созданную таким путем:
procedure CreateBitmapData;
begin
sWidth := GetSystemMetrics(SM_CXSCREEN);
sHeight := GetSystemMetrics(SM_CYSCREEN);
hDeskWin := GetDesktopWindow;
hScrDC := GetDC(hDeskWin);
with bitmap_info.bmiHeader do
begin
biSize := sizeof(BITMAPINFOHEADER);
biWidth := sWidth;
//Use negative height to scan top-down.
biHeight := -sHeight;
biPlanes := 1;
biBitCount := GetDeviceCaps(hScrDC, BITSPIXEL);
biCompression := BI_RGB;
end;
pBits := nil;
hBmp := CreateDIBSection(hScrDC, bitmap_info, DIB_RGB_COLORS, pBits, 0, 0);
// hBmp := CreateCompatibleBitmap(hScrDC, sWidth, sHeight);
hMemDC := CreateCompatibleDC(hScrDC);
end;
Как это реализовать напрямую, без TBitmap -> BitBlt?