PureBasic Forums - English

Code: Select all

;- *** Image Objects ***

Structure ImageData
  handle.i
  id.i
  filename.s
EndStructure

Global NewMap ListImages.ImageData()

; ---------------------------------------------------------------------------------------

Procedure MyLoadImage(Image, Filename.s)
  
  Protected result, handle, id, key.s
  
  result = LoadImage(Image, Filename)
  If result = 0
    ProcedureReturn 0
  EndIf
  If Image = #PB_Any
    handle = ImageID(result)
    id = result
  Else
    handle = result
    id = Image
  EndIf
  
  key = Str(handle)
  AddMapElement(ListImages(), key)
  With ListImages()
    \handle = handle
    \id = id
    \filename = Filename
  EndWith
  
  ProcedureReturn result
  
EndProcedure

Macro LoadImage(Image, Filename)
  MyLoadImage(Image, Filename)
EndMacro

; ---------------------------------------------------------------------------------------

Procedure MyCatchImage(Image, *Memory, Size = 0)
  
  Protected result, handle, id, key.s
  
  result = CatchImage(Image, *Memory, Size)
  If result = 0
    ProcedureReturn 0
  EndIf
  If Image = #PB_Any
    handle = ImageID(result)
    id = result
  Else
    handle = result
    id = Image
  EndIf
  key = Str(handle)
  AddMapElement(ListImages(), key)
  With ListImages()
    \handle = handle
    \id = id
    \filename = ":memory:"
  EndWith
  
  ProcedureReturn result
  
EndProcedure

Macro CatchImage(Image, Memory, Size = 0)
  MyCatchImage(Image, Memory, Size)
EndMacro

; ---------------------------------------------------------------------------------------

Procedure MyFreeImage(Image)
  
  Protected key.s
  
  If IsImage(Image)
    key = Str(ImageID(Image))
    DeleteMapElement(ListImages(), key)
    FreeImage(Image)
  EndIf
  
EndProcedure

Macro FreeImage(Image)
  MyFreeImage(Image)
EndMacro

; ---------------------------------------------------------------------------------------

Procedure GetImageID(Handle)
  
  Protected result, key.s
  
  result = -1
  key = Str(Handle)
  If FindMapElement(ListImages(), key)
    result = ListImages()\id
  EndIf
  
  ProcedureReturn result
  
EndProcedure
 
; ---------------------------------------------------------------------------------------