FreeBASIC ExtLibfreeimage

'' FreeImage を使って、共通の画像形式の全てをロードするためのコード例。
'' この例は、コマンド・ライン引き数で渡された画像をロードします。

'' ロードするときにエラーがあった場合、関数 FI_Load はヌルポインタ(0)を返します。
'' エラーでなければ、32 ビットの 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
    ImageDestroy(image)
Else
    Print "Problem while loading file : " & filename
End If

Sleep