Home

Add

Edit

Without Linenumbers

Code in Textfield

Download

  1. '##############################################################################################################
    
  2. #INCLUDE Once "FreeImage.bi"
    
  3. #INCLUDE Once "fbgfx.bi"
    
  4. #INCLUDE Once "crt/string.bi"
    
  5. 
    
  6. 
    
  7. 
    
  8. '##############################################################################################################
    
  9. Type X_Image_Type
    
  10.     V_Width     As Uinteger
    
  11.     V_Height    As Uinteger
    
  12.     V_BPP       As Uinteger
    
  13.     V_Pitch     As Uinteger
    
  14.     V_Data      As Uinteger Ptr
    
  15. End Type
    
  16. 
    
  17. 
    
  18. 
    
  19. '##############################################################################################################
    
  20. Function X_ImageCreate(Byref V_Width As Uinteger, Byref V_Height As Uinteger, Byref V_BPP As Uinteger = 32, V_AllocMem As Any Ptr = 0) As X_Image_Type Ptr
    
  21. If (V_Width <= 0) Or (V_Height <= 0) Or (Fix(V_BPP / 8)) <= 0 Then Return 0
    
  22. Dim TImg As X_Image_Type
    
  23. With TImg
    
  24.     .V_Width    = V_Width
    
  25.     .V_Height   = V_Height
    
  26.     .V_BPP      = V_BPP
    
  27.     .V_Pitch    = .V_Width * .V_Height * 4
    
  28.     If V_AllocMem = 0 Then
    
  29.         .V_Data = Callocate(V_Width * V_Height * Fix(.V_BPP / 8))
    
  30.     Else: .V_Data = V_AllocMem
    
  31.     End If
    
  32. End With
    
  33. Dim TImgPtr As X_Image_Type Ptr = Callocate(Sizeof(X_Image_Type))
    
  34. *TImgPtr = TImg
    
  35. Return TImgPtr
    
  36. End Function
    
  37. 
    
  38. 
    
  39. 
    
  40. '##############################################################################################################
    
  41. Sub X_ImageDestroy(Byref V_Image As X_Image_Type Ptr)
    
  42. If V_Image = 0 Then Exit Sub
    
  43. If V_Image->V_Data <> 0 Then Deallocate(V_Image->V_Data)
    
  44. Deallocate(V_Image)
    
  45. V_Image = 0
    
  46. End Sub
    
  47. 
    
  48. 
    
  49. 
    
  50. '##############################################################################################################
    
  51. Function PILOX_CreateFBImageFromFile(Byref V_Path As String) As X_Image_Type Ptr
    
  52. Dim FIF As FREE_IMAGE_FORMAT
    
  53. Dim dib As FIBITMAP Ptr
    
  54. Dim dib32 As FIBITMAP Ptr
    
  55. Dim DIBWidth As Uinteger
    
  56. Dim DIBHeight As Uinteger
    
  57. Dim flags As Uinteger
    
  58. Dim Sprite As X_Image_Type Ptr
    
  59. Dim Bits As Any Ptr
    
  60. FIF = FreeImage_GetFileType(Strptr(V_Path), 0)
    
  61. If FIF = FIF_UNKNOWN Then FIF = FreeImage_GetFIFFromFilename(Strptr(V_Path))
    
  62. If FIF = FIF_UNKNOWN Then Return NULL
    
  63. If FIF = FIF_JPEG Then flags = JPEG_ACCURATE
    
  64. dib = FreeImage_Load(FIF, Strptr(V_Path), flags)
    
  65. If dib = 0 Then Return NULL
    
  66. DIBWidth = FreeImage_GetWidth(dib)
    
  67. DIBHeight = FreeImage_GetHeight(dib)
    
  68. FreeImage_FlipVertical Dib
    
  69. Dib32 = FreeImage_ConvertTo32Bits(Dib)
    
  70. Sprite = X_ImageCreate(DIBWidth, DIBHeight, 32)
    
  71. Bits = FreeImage_GetBits(Dib32)
    
  72. #IF Defined(__FB_WIN32__)
    
  73.     movememory Cast(Ubyte Ptr, Sprite->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  74. #ELSEIF Defined(__FB_LINUX__)
    
  75.     memcpy Cast(Ubyte Ptr, Sprite->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  76. #ENDIF
    
  77. FreeImage_Unload dib
    
  78. FreeImage_Unload dib32
    
  79. Return Sprite
    
  80. End Function
    
  81. 
    
  82. 
    
  83. 
    
  84. '##############################################################################################################
    
  85. Function PILOX_CreateFileFromFBImage(Byref V_Path As String, Byref V_Image As X_Image_Type Ptr) As Integer
    
  86. Dim FIF As FREE_IMAGE_FORMAT
    
  87. Dim dib32 As FIBITMAP Ptr
    
  88. Dim flags As Uinteger
    
  89. Dim Bits As Any Ptr
    
  90. Dim XPos As Uinteger = Instrrev(V_Path, ".")
    
  91. If XPos <= 0 Then Return -1
    
  92. Select Case Lcase(Mid(V_Path, XPos + 1))
    
  93.     Case "bmp"  : FIF = FIF_BMP
    
  94.     Case "jpg"  : FIF = FIF_JPEG    : flags = JPEG_QUALITYGOOD
    
  95.     Case "png"  : FIF = FIF_PNG     : flags = PNG_DEFAULT
    
  96.     Case Else: Return -1
    
  97. End Select
    
  98. With *V_Image
    
  99.     dib32 = FreeImage_Allocate(.V_Width, .V_Height, .V_BPP)
    
  100.     Bits = FreeImage_GetBits(Dib32)
    
  101.     #IF Defined(__FB_WIN32__)
    
  102.         movememory Bits, Cast(Ubyte Ptr, V_Image->V_Data), .V_Width * .V_Height * 4
    
  103.     #ELSEIF Defined(__FB_LINUX__)
    
  104.         memcpy Bits, Cast(Ubyte Ptr, V_Image->V_Data), .V_Width * .V_Height * 4
    
  105.     #ENDIF
    
  106. End With
    
  107. FreeImage_Save(FIF, dib32, V_Path, flags)
    
  108. FreeImage_Unload dib32
    
  109. Return 1
    
  110. End Function
    
  111. 
    
  112. 
    
  113. 
    
  114. '##############################################################################################################
    
  115. Dim TempImg As X_Image_Type Ptr
    
  116. TempImg = PILOX_CreateFBImageFromFile("test.bmp")
    
  117. PILOX_CreateFileFromFBImage("test_out.bmp", TempImg)
    
  118. End 0
    
  119. 
    
  120.