- Код: Выделить всё
Public Function CreateDDSFromFile(ByVal FileName As String, Optional TransColor As Long = 0) _
As DirectDrawSurface7
Dim DDS As DirectDrawSurface7
Dim ddsd As DDSURFACEDESC2
Dim StorePic As StdPicture
Dim Bmp As BITMAP
Dim hDCPicture As Long, hDCSurface As Long
Dim DDCK As DDCOLORKEY
Set StorePic = LoadPicture(FileName)
GetObject StorePic.Handle, Len(Bmp), Bmp
hDCPicture = CreateCompatibleDC(ByVal 0&)
SelectObject hDCPicture, StorePic.Handle
ddsd.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsd.lWidth = Bmp.bmWidth
ddsd.lHeight = Bmp.bmHeight
Set DDS = DD.CreateSurface(ddsd)
DDCK.low = TransColor: DDCK.high = DDCK.low
DDS.SetColorKey DDCKEY_SRCBLT, DDCK
DDS.restore
hDCSurface = DDS.GetDC
StretchBlt hDCSurface, 0, 0, Bmp.bmWidth, Bmp.bmHeight, hDCPicture, 0, 0, Bmp.bmWidth, _
Bmp.bmHeight, SRCCOPY
DDS.ReleaseDC hDCSurface
DeleteDC hDCPicture
Set CreateDDSFromFile = DDS
Set DDS = Nothing
End Function
А он грузить .PNG отказывается...
