Direct Draw Color Key 16bit - как сделать?

[Dagobert]

Пытаюсь на поверхности (DDSurface) сделать спрайт, но не могу задать прозрачный цвет. Точнее могу но в 256-цв и 24-бит. режиме, а в 16-бит. не получается. Подскажите, как это сделать.

Пытался переписать с C++

// функция для перевода значения цвета для поверхности pdds из RGB в DWORD
DWORD DirectDraw7_ConvertRGB (LPDIRECTDRAWSURFACE7 pdds, COLORREF rgb)
{
COLORREF rgbT;
HDC hdc;
DWORD dw = CLR_INVALID;
DDSURFACEDESC2 ddsd;
HRESULT hres;

if(pdds->GetDC (&hdc) == DD_OK)
{
rgbT = GetPixel(hdc, 0, 0);
SetPixel(hdc, 0, 0, rgb);
pdds->ReleaseDC(hdc);
};

ddsd.dwSize = sizeof(ddsd);
while((hres = pdds->Lock (NULL, &ddsd, 0, NULL)) == DDERR_WASSTILLDRAWING);

if(hres == DD_OK)
{
dw = *(DWORD *)ddsd.lpSurface;
if(ddsd.ddpfPixelFormat.dwRGBBitCount < 32)
dw &= (1 << ddsd.ddpfPixelFormat.dwRGBBitCount)-1;
pdds->Unlock (NULL);
};

if(pdds->GetDC (&hdc) == DD_OK)
{
SetPixel (hdc, 0, 0, rgbT);
pdds->ReleaseDC (hdc);
};

return dw;
};


Но переделать выделенный участок не могу, не знаю как.

[Dagobert]

Не сочтите за оффтопик. Но я сам отвечу на свой вопрос.
Нашёл англ. статью, на немецком хостинге.

вот кусок кода:

Public RedShiftLeft As Long
Public RedShiftRight As Long
Public GreenShiftLeft As Long
Public GreenShiftRight As Long
Public BlueShiftLeft As Long
Public BlueShiftRight As Long

Public Sub GetColorShiftValues(PrimarySurface As DirectDrawSurface7)
Dim PixelFormat As DDPIXELFORMAT
PrimarySurface.GetPixelFormat PixelFormat
MaskToShiftValues PixelFormat.lRBitMask, RedShiftRight, RedShiftLeft
MaskToShiftValues PixelFormat.lGBitMask, GreenShiftRight, GreenShiftLeft
MaskToShiftValues PixelFormat.lBBitMask, BlueShiftRight, BlueShiftLeft
End Sub

Public Sub MaskToShiftValues(ByVal Mask As Long, ShiftRight As Long, ShiftLeft As Long)
Dim ZeroBitCount As Long
Dim OneBitCount As Long

' Count zero bits
ZeroBitCount = 0
Do While (Mask And 1) = 0
ZeroBitCount = ZeroBitCount + 1
Mask = Mask \ 2 ' Shift right
Loop


' Count one bits
OneBitCount = 0
Do While (Mask And 1) = 1
OneBitCount = OneBitCount + 1
Mask = Mask \ 2 ' Shift right
Loop
' Shift right 8-OneBitCount bits
ShiftRight = 2 ^ (8 - OneBitCount)
' Shift left ZeroBitCount bits
ShiftLeft = 2 ^ ZeroBitCount
End Sub

Public Function DDRGB(Red As Long, Green As Long, Blue As Long) As Long
DDRGB = (Red \ RedShiftRight) * RedShiftLeft + _
(Green \ GreenShiftRight) * GreenShiftLeft + _
(Blue \ BlueShiftRight) * BlueShiftLeft
End Function

Public Sub GetRGBfromColor(ByVal Color As Long, ByRef Red As Long, ByRef Green As Long, ByRef Blue As Long)
Dim HexadecimalValue As String 'This will store the Hexadecimal Value as a string

'This line will convert a Long decimal to Hexadecimal
HexadecimalValue = Hex(Val(Color))

If Len(HexadecimalValue) < 6 Then
HexadecimalValue = String(6 - Len(HexadecimalValue), "0") + HexadecimalValue
End If
Blue = CLng("&H" + Mid(HexadecimalValue, 1, 2))
Green = CLng("&H" + Mid(HexadecimalValue, 3, 2))
Red = CLng("&H" + Mid(HexadecimalValue, 5, 2))
End Sub

Public Function DDColor(RGBColor As Long) As Long

Dim RedVal As Long
Dim GreenVal As Long
Dim BlueVal As Long
GetRGBfromColor RGBColor, RedVal, GreenVal, BlueVal
DDColor = DDRGB(RedVal, GreenVal, BlueVal)
End Function

Как переведу статью выложу на своём сайте.