FreeBASIC ImageInfo

' Sets the graphics method GDI
' 描画方法を GDI に設定
SetEnviron("fbgfx=GDI")

'' pixelptr(): imageinfo() を使って、画像のピクセルへのポインターを見つけます
'' エラーでは null を、境界外では x,y を返します
Function pixelptr(ByVal img As Any Ptr, ByVal x As Integer, ByVal y As Integer) As Any Ptr

    Dim As Long w, h, bypp, pitch
    Dim As Any Ptr pixdata
    Dim As Long result
   
    result = (imageinfo(img, w, h, bypp, pitch, pixdata) = 0)
   
    If result Then
        If x < 0 Or x >= w Then Return 0
        If y < 0 Or y >= h Then Return 0
        Return pixdata + y * pitch + x * bypp
    Else
        Return 0
    End If
   
End Function

'' 使用例:

'' 320*200 描画画面, 8 bits per pixel
ScreenRes 320, 200, 8

Dim As Any Ptr ip '' 画像ポインタ

Dim As Byte Ptr pp '' 画素ポインタ (use byte for 8 bits per pixel)

ip = ImageCreate(32, 32) '' 画像を生成 (32*32, 8 bits per pixel)

If ip <> 0 Then

    '' 画像の上にパターンを描く
    For y As Integer = 0 To 31

        For x As Integer = y - 5 To y + 5 Step 5

            '' x,y 位置のピクセルへのポインターを見つけます
            '' 注意: これはすべてのピクセルのために行うには非能率ですl!
            pp = pixelptr(ip, x, y)

            '' 成功なら、ピクセルで値をプロットします
            If (pp <> 0) Then *pp = 15

        Next x

    Next y

    '' 画像を置き、そのまわりの境界を描きます
    Put (10, 10), ip, PSet
    Line (9, 9)-Step(33, 33), 4, b

    '' メモリを回収するために画像を破壊します
    ImageDestroy ip

Else
    Print "Error creating image!"
End If

Sleep

' Sets the graphics method GDI
' 描画方法を GDI に設定
SetEnviron("fbgfx=GDI")

'' 32ビットの描画画面と、画像を作成します
ScreenRes 320, 200, 32

Dim image As Any Ptr = ImageCreate ( 64, 64 )

Dim pitch As Long
Dim pixels As Any Ptr

'' ピクセル・データで繰り返すことができる情報を取得します
If 0 <> imageinfo( image, ,,, pitch, pixels ) Then
    Print "unable to retrieve image information."
    Sleep
    End
end If

'' 直接画素メモリを操ることによって、画像に、模様をつけます
For y As Integer = 0 To 63
    Dim row As ulong Ptr = pixels + y * pitch

    For x As Integer = 0 To 63
        row[x] = RGB (x * 4, y * 4, (x Xor y) * 4)
    Next x
Next y

'' 画面に画像を描きます
Put (10, 10), image

ImageDestroy ( image )

Sleep