Загрузка форматов JPG и GIF на поверхность DirectDraw

Этот мини-учебник я собирался написать давно, да все как-то руки не доходили. Вобщем как бы то ни было, вот он: То, что вы все так долго просили!

Если вы читали мой учебник "Основы DirectDraw на Visual Basic", то вы должны помнить большую функцию CreateDDSFromFile, которая создавала нам поверхность из файла .bmp
Недостатком этой функции было то, что она не способна загружать файлы форматов .jpg и .gif, так вот, я решил исправить это упущение и привожу здесь текст улучшенной функции, которая умеет делать это:

Public Function CreateSurfaceFromFile(DirectDraw As DirectDraw7, ByVal FileName As String, SurfaceDesc As DDSURFACEDESC2) As DirectDrawSurface7

Функция будет требовать указать ей объект DirectDraw, имя файла, а так же описательную структуру создаваемой поверхности

Dim Picture As StdPicture 'Здесь будет временно храниться загруженная картинка
Dim Width As Long 'Вспомогательные переменные
Dim Height As Long
Dim Surface As DirectDrawSurface7 'Временная поверхность
Dim hdcPicture As Long ' Контекст устройства картинки
Dim hdcSurface As Long ' Контекст устройства поверхности
' Сперва загружаем картинку
Set Picture = LoadPicture(FileName)
' Конвертация из vbHimetric в vbPixels
Width = CLng((Picture.Width * 0.001) * 567 / Screen.TwipsPerPixelX)
Height = CLng((Picture.Height * 0.001) * 567 / Screen.TwipsPerPixelY)
' Обновляем описание поверхности
With SurfaceDesc
If .lFlags = 0 Then .lFlags = DDSD_CAPS
.lFlags = .lFlags Or DDSD_WIDTH Or DDSD_HEIGHT
If .ddsCaps.lCaps = 0 Then .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
If .lWidth = 0 Then .lWidth = Width
If .lHeight = 0 Then .lHeight = Height
End With
' Теперь создаем временную поверхность
Set Surface = DirectDraw.CreateSurface(SurfaceDesc)
' Создаем контекст картинки
hdcPicture = CreateCompatibleDC(0)
' Выбираем картинку в памяти
SelectObject hdcPicture, Picture.Handle
' Создаем контекст поверхности
hdcSurface = Surface.GetDC
' Копируем картинку из памяти на поверхность DirectDraw
StretchBlt hdcSurface, 0, 0, SurfaceDesc.lWidth, SurfaceDesc.lHeight, hdcPicture, 0, 0, Width, Height, SRCCOPY
' Освобождаем контекст поверхности
Surface.ReleaseDC hdcSurface
' Освобождаем контекст картинки и выгружаем ее из памяти
DeleteDC hdcPicture
Set Picture = Nothing
Set CreateSurfaceFromFile = Surface 'Возвращаем новую поверхность
Set Surface = Nothing
End Function

Ну вот, теперь если вы вставите эту функцию на место ее предшественницы, вы получите возможность оперировать вышеуказанными типами файлов. Так же потребуются минимальные переделки в вызове этой функции.

Чтобы вы легче могли понять вcе это дело, вот вам пример:
gifjpg.zip

Приятного программирования, Anti