Advertisement
Guest User

Untitled

a guest
Mar 24th, 2019
124
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2.  
  3. '' Code example for loading all common image types using FreeImage.
  4. '' The example loads an image passed as a command line argument.
  5.  
  6. '' The function FI_Load returns a null pointer (0) if there was an error during
  7. '' loading.  Otherwise it returns a 32-bit PUT compatible buffer.
  8.  
  9. #include "FreeImage.bi"
  10. #include "crt.bi"
  11. #include "fbgfx.bi"
  12.  
  13. Function dither ( ByVal src As UInteger, ByVal dst As UInteger, ByVal parameter As Any Ptr ) As UInteger
  14.    
  15.     ''either returns the source pixel or the destination pixel, depending on the outcome of rnd
  16.    
  17.  
  18.    
  19.     Dim threshold As Single = 0.1
  20.     If parameter <> 0 Then threshold = *CPtr(Single Ptr, parameter)
  21.    
  22.     If Rnd() < threshold Then
  23.         Return rgb(255,255,0)
  24.     Else
  25.         Return src
  26.     End If
  27.    
  28. End Function
  29.  
  30.  
  31. Function FI_Load(filename As String) As Any Ptr
  32.     If Len(filename) = 0 Then
  33.         Return NULL
  34.     End If
  35.  
  36.     '' Find out the image format
  37.     Dim As FREE_IMAGE_FORMAT form = FreeImage_GetFileType(StrPtr(filename), 0)
  38.     If form = FIF_UNKNOWN Then
  39.         form = FreeImage_GetFIFFromFilename(StrPtr(filename))
  40.     End If
  41.  
  42.     '' Exit if unknown
  43.     If form = FIF_UNKNOWN Then
  44.         Return NULL
  45.     End If
  46.  
  47.     '' Always load jpegs accurately
  48.     Dim As UInteger flags = 0
  49.     If form = FIF_JPEG Then
  50.         flags = JPEG_ACCURATE
  51.     End If
  52.  
  53.     '' Load the image into memory
  54.     Dim As FIBITMAP Ptr image = FreeImage_Load(form, StrPtr(filename), flags)
  55.     If image = NULL Then
  56.         '' FreeImage failed to read in the image
  57.         Return NULL
  58.     End If
  59.  
  60.     '' Flip the image so it matches FB's coordinate system
  61.     FreeImage_FlipVertical(image)
  62.  
  63.     '' Convert to 32 bits per pixel
  64.     Dim As FIBITMAP Ptr image32 = FreeImage_ConvertTo32Bits(image)
  65.  
  66.     '' Get the image's size
  67.     Dim As UInteger w = FreeImage_GetWidth(image)
  68.     Dim As UInteger h = FreeImage_GetHeight(image)
  69.  
  70.     '' Create an FB image of the same size
  71.     Dim As fb.Image Ptr sprite = ImageCreate(w, h)
  72.  
  73.     Dim As Byte Ptr target = CPtr(Byte Ptr, sprite + 1)
  74.     Dim As Integer target_pitch = sprite->pitch
  75.  
  76.     Dim As Any Ptr source = FreeImage_GetBits(image32)
  77.     Dim As Integer source_pitch = FreeImage_GetPitch(image32)
  78.  
  79.     '' And copy over the pixels, row by row
  80.     For y As Integer = 0 To (h - 1)
  81.         memcpy(target + (y * target_pitch), _
  82.                source + (y * source_pitch), _
  83.                w * 4)
  84.     Next
  85.  
  86.     FreeImage_Unload(image32)
  87.     FreeImage_Unload(image)
  88.  
  89.     Return sprite
  90. End Function
  91.  
  92. ScreenRes 640, 480, 32
  93.  
  94. Dim As String filename = Command(1)
  95.  
  96. line(0, 0) - (100, 100), rgb(200, 200, 200), bf
  97.  
  98. Dim As Any Ptr image = FI_Load("D:\Development\Aseprite\PinkCube/PinkCube.png")
  99. If image <> 0 Then
  100.     printf(!"start\n")
  101.     Put (0, 0), image, custom, @dither
  102.     printf(!"end\n")
  103. Else
  104.     Print "Problem while loading file : " & filename
  105. End If
  106.  
  107. Sleep
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement