PureBoard

Code: Alles auswählen

EnableExplicit

DeclareModule ICOMO
  
  Structure ICOMO_STRUCT
    images.i
    image.i[0]
  EndStructure
  
  Declare.i Create(*Buffer,File.s = #Null$)
  Declare.i Release(*Icomo.ICOMO_STRUCT)
  
EndDeclareModule

Module ICOMO
  
  EnableExplicit
  
  UsePNGImageDecoder()
  
  Structure ICON_DIRECTORY_STRUCT
    width.a
    height.a
    colors.a
    reserved.a
    color_planes.u
    bits_per_pixel.u
    size.l
    offset.l
  EndStructure
  
  Structure ICON_STRUCT
    reserved.u
    type.u
    images.u
    directory.ICON_DIRECTORY_STRUCT[0]
  EndStructure
  
  Procedure.i Create(*Buffer,File.s = #Null$)
    Protected *icon.ICON_STRUCT
    Protected handle.i
    Protected length.i
    Protected index.i
    Protected *icomo.ICOMO_STRUCT
    Protected *bitmap.BITMAPFILEHEADER
    Protected *bitmap_info.BITMAPINFOHEADER
    Protected bm.BITMAP
    Protected dummy.i
    If *Buffer
      *icon = *Buffer
    ElseIf File
      handle = ReadFile(#PB_Any,File)
      If handle
        length = Lof(handle)
        If length > 6
          *icon = AllocateMemory(length)
          If *icon
            If Not ReadData(handle,*icon,length) = length
              FreeMemory(*icon)
              *icon = #Null
            EndIf
          EndIf
        EndIf
        CloseFile(handle)
      EndIf
    EndIf
    If *icon
      If *icon\reserved = #Null And *icon\type = 1 And *icon\images > 0
        *icomo = AllocateMemory((*icon\images * SizeOf(Integer)) + SizeOf(Integer))
        If *icomo
          *icomo\images = *icon\images
          handle = *icon\images - 1
          For index = 0 To handle
            If PeekQ(*icon + *icon\directory[index]\offset) = $A1A0A0D474E5089
              *icomo\image[index] = CatchImage(#PB_Any,*icon + *icon\directory[index]\offset)
            Else
              *bitmap_info = *icon + *icon\directory[index]\offset
              If *bitmap_info\biCompression = #BI_RGB
                If *bitmap_info\biBitCount = 32 Or *bitmap_info\biBitCount = 24
                  dummy = CreateImage(#PB_Any,*icon\directory[index]\width,*icon\directory[index]\height,*bitmap_info\biBitCount)
                  If dummy
                    If GetObject_(ImageID(dummy),SizeOf(BITMAP),@bm)
                      CopyMemory(*bitmap_info + *bitmap_info\biSize,bm\bmBits,bm\bmHeight * bm\bmWidthBytes)
                      *icomo\image[index] = dummy 
                    Else
                      FreeImage(dummy)
                    EndIf
                  EndIf
                EndIf
              EndIf
            EndIf
          Next
          length = 0
          For index = 0 To handle
            If *icomo\image[index]
              length + 1
            EndIf
          Next
          If *icomo\images = length And length
            FreeMemory(*icon)
            ProcedureReturn *icomo
          EndIf
          For index = 0 To handle
            If *icomo\image[index]
              FreeImage(*icomo\image[index])
            EndIf
          Next
          FreeMemory(*icomo)
        EndIf
      EndIf
      FreeMemory(*icon)
    EndIf
    ProcedureReturn #Null
  EndProcedure
  
  Procedure.i Release(*Icomo.ICOMO_STRUCT)
    Protected index.i
    For index = 0 To *Icomo\images - 1
      If *Icomo\image[index]
        FreeImage(*Icomo\image[index])
      EndIf
    Next
    FreeMemory(*Icomo)
    ProcedureReturn #Null
  EndProcedure
  
EndModule

UsePNGImageEncoder()

Procedure.i Main()
  Protected *icomo.ICOMO::ICOMO_STRUCT
  Protected index.i
  *icomo = ICOMO::Create(#Null,"OneDrive.ico")
  If *icomo
    Debug 123
    Debug *icomo\images
    For index = 0 To *icomo\images - 1
      Debug "image " + Str(index)
      Debug "width = " + Str(ImageWidth(*icomo\image[index]))
      Debug "height = " + Str(ImageHeight(*icomo\image[index]))
      SaveImage(*icomo\image[index],Str(index) + "_test.png",#PB_ImagePlugin_PNG)
    Next
    ICOMO::Release(*icomo)
  EndIf
EndProcedure

Main()

End