FreeImage
FreeImage является проектом библиотеки с открытым исходным кодом для
разработчиков, которые хотели бы поддерживать популярные графические форматы
изображений PNG, BMP, JPEG, TIFF и другие для мультимедийных приложений.
FreeImage проста в использовании, быстра, имеет многопоточные режимы,
совместима со всеми 32-битными версиями Windows, Linux и Mac OS X
Вебсайт: http://freeimage.sourceforge.net/
Поддерживаемые платформы: Win32, Linux
Заголовки: FreeImage.bi
Версия заголовков: 3.15.1
Примеры: в examples/files/FreeImage
Вот пример использования FreeImage в FreeBASIC. При использовании ОС Windows вам потребуется FreeImage.dll которую можно скачать с сайта FreeImage.
Вебсайт: http://freeimage.sourceforge.net/
Поддерживаемые платформы: Win32, Linux
Заголовки: FreeImage.bi
Версия заголовков: 3.15.1
Примеры: в examples/files/FreeImage
Пример
Вот пример использования FreeImage в FreeBASIC. При использовании ОС Windows вам потребуется FreeImage.dll которую можно скачать с сайта FreeImage.
'' Пример кода для загрузки всех распространенных типов
изображений, используя FreeImage.
'' Пример загружает изображение, переданное как аргумент командной строки.
'' Функция FI_Load возвращает пустой указатель (0), если была ошибка во время
'' загрузки. В противном случае возвращает 32-bit PUT совместимый буфер.
#include "FreeImage.bi"
#include "crt.bi"
#include "fbgfx.bi"
Function FI_Load(filename As String) As Any Ptr
If Len(filename) = 0 Then
Return NULL
End If
'' Узнаем формат изображения
Dim As FREE_IMAGE_FORMAT form = FreeImage_GetFileType(StrPtr(filename), 0)
If form = FIF_UNKNOWN Then
form = FreeImage_GetFIFFromFilename(StrPtr(filename))
End If
'' Выход, если неизвестный формат
If form = FIF_UNKNOWN Then
Return NULL
End If
'' Всегда загружайте jpeg правильно
Dim As UInteger flags = 0
If form = FIF_JPEG Then
flags = JPEG_ACCURATE
End If
'' Загружаем изображение в память
Dim As FIBITMAP Ptr image = FreeImage_Load(form, StrPtr(filename), flags)
If image = NULL Then
'' FreeImage ошибка чтения в изображении
Return NULL
End If
'' Поворот изображения, чтобы оно соответствовало FB системе координат
FreeImage_FlipVertical(image)
'' Преобразование до 32 бит на пиксель
Dim As FIBITMAP Ptr image32 = FreeImage_ConvertTo32Bits(image)
'' Получаем размер этого изображения
Dim As UInteger w = FreeImage_GetWidth(image)
Dim As UInteger h = FreeImage_GetHeight(image)
'' Создание FB изображения того же размера
Dim As fb.Image Ptr sprite = ImageCreate(w, h)
Dim As Byte Ptr target = CPtr(Byte Ptr, sprite + 1)
Dim As Integer target_pitch = sprite->pitch
Dim As Any Ptr source = FreeImage_GetBits(image32)
Dim As Integer source_pitch = FreeImage_GetPitch(image32)
'' И Копируем пиксели, ряд за рядом
For y As Integer = 0 To (h - 1)
memcpy(target + (y * target_pitch), _
source + (y * source_pitch), _
w * 4)
Next
FreeImage_Unload(image32)
FreeImage_Unload(image)
Return sprite
End Function
ScreenRes 640, 480, 32
Dim As String filename = Command(1)
Dim As Any Ptr image = FI_Load(filename)
If image <> 0 Then
Put (0, 0), image
Else
Print "Problem while loading file : " & filename
End If
Sleep
'' Пример загружает изображение, переданное как аргумент командной строки.
'' Функция FI_Load возвращает пустой указатель (0), если была ошибка во время
'' загрузки. В противном случае возвращает 32-bit PUT совместимый буфер.
#include "FreeImage.bi"
#include "crt.bi"
#include "fbgfx.bi"
Function FI_Load(filename As String) As Any Ptr
If Len(filename) = 0 Then
Return NULL
End If
'' Узнаем формат изображения
Dim As FREE_IMAGE_FORMAT form = FreeImage_GetFileType(StrPtr(filename), 0)
If form = FIF_UNKNOWN Then
form = FreeImage_GetFIFFromFilename(StrPtr(filename))
End If
'' Выход, если неизвестный формат
If form = FIF_UNKNOWN Then
Return NULL
End If
'' Всегда загружайте jpeg правильно
Dim As UInteger flags = 0
If form = FIF_JPEG Then
flags = JPEG_ACCURATE
End If
'' Загружаем изображение в память
Dim As FIBITMAP Ptr image = FreeImage_Load(form, StrPtr(filename), flags)
If image = NULL Then
'' FreeImage ошибка чтения в изображении
Return NULL
End If
'' Поворот изображения, чтобы оно соответствовало FB системе координат
FreeImage_FlipVertical(image)
'' Преобразование до 32 бит на пиксель
Dim As FIBITMAP Ptr image32 = FreeImage_ConvertTo32Bits(image)
'' Получаем размер этого изображения
Dim As UInteger w = FreeImage_GetWidth(image)
Dim As UInteger h = FreeImage_GetHeight(image)
'' Создание FB изображения того же размера
Dim As fb.Image Ptr sprite = ImageCreate(w, h)
Dim As Byte Ptr target = CPtr(Byte Ptr, sprite + 1)
Dim As Integer target_pitch = sprite->pitch
Dim As Any Ptr source = FreeImage_GetBits(image32)
Dim As Integer source_pitch = FreeImage_GetPitch(image32)
'' И Копируем пиксели, ряд за рядом
For y As Integer = 0 To (h - 1)
memcpy(target + (y * target_pitch), _
source + (y * source_pitch), _
w * 4)
Next
FreeImage_Unload(image32)
FreeImage_Unload(image)
Return sprite
End Function
ScreenRes 640, 480, 32
Dim As String filename = Command(1)
Dim As Any Ptr image = FI_Load(filename)
If image <> 0 Then
Put (0, 0), image
Else
Print "Problem while loading file : " & filename
End If
Sleep