PureBasic Forums - English

Code: Select all

;make a ico pack out of a image image should be square 32 bit depth 
;Idle ChrisR

EnableExplicit 

Structure ICONDIR
  res.u
  type.u
  num.u
EndStructure

Structure ICONDIRECTORYENTRY
  width.a
  height.a
  numcolors.a 
  res.a
  colorplanes.u 
  bitsperpixel.u 
  size.l 
  offset.l  
EndStructure 

Structure ICONData
  header.ICONDIR 
  icons.ICONDIRECTORYENTRY[15] 
EndStructure 

Structure bufs
  *buffer[15] 
EndStructure   

UsePNGImageEncoder()
UsePNGImageDecoder()

; https://learn.microsoft.com/en-us/windows/apps/design/style/iconography/app-icon-construction
; Apps should have, at the bare minimum: 16x16, 24x24, 32x32, 48x48, And 256x256. 
; This covers the most common icon sizes, And by providing a 256px icon, ensures Windows should only ever scale your icon down, never up.
Procedure CreateIconFile(file.s,image,xsize.s="16x24x32x48x256") 
  Protected ico.ICONData 
  Protected buf.bufs
  Protected timg,fn,offset,a,b,countsize=CountString(xsize,"x")+1
  If countsize > 15 : countsize=15 : EndIf
  
  Dim sz(countsize-1)
  Repeat
    sz(a) = Val(StringField(xsize, a+1, "x"))
    a+1 
  Until a = countsize
  
  offset = SizeOf(ICONData)   
  ico\header\num=countsize
  ico\header\type=1 
  offset = SizeOf(ICONData)
  
  If file <> ""  
    fn = CreateFile(#PB_Any,file)
    If fn
      a = 0
      Repeat    
        timg = CopyImage(image,#PB_Any) 
        If timg 
          If ResizeImage(timg,sz(a),sz(a),#PB_Image_Smooth) 
            buf\buffer[a] = EncodeImage(timg, #PB_ImagePlugin_PNG, 0, 32)
          EndIf 
        Else 
          For b = 0 To a
            If buf\buffer[a]
              FreeMemory(buf\buffer[a])
            EndIf   
          Next 
          CloseFile(fn)
          ProcedureReturn 0
        EndIf
        FreeImage(timg) 
        ico\icons[a]\width = sz(a) 
        ico\icons[a]\height = sz(a) 
        ico\icons[a]\colorplanes = 1 
        ico\icons[a]\bitsperpixel = 32
        ico\icons[a]\size = MemorySize(buf\buffer[a]) 
        ico\icons[a]\offset = offset 
        offset + ico\icons[a]\size     
        a+1 
      Until a = countsize
      
      a=0 
      WriteData(fn,@ico,SizeOf(ICONData))   
      Repeat 
        WriteData(fn,Buf\buffer[a],ico\icons[a]\size) 
        FreeMemory(Buf\buffer[a])
        a+1
      Until a = countsize
      
      CloseFile(fn)
      ProcedureReturn 1
    EndIf  
  EndIf 
  
EndProcedure 
 
Define file$, Tcolor.l

Procedure TransparentCallback(x, y, sourcecolor.l, targetcolor.l) 
  Shared Tcolor
  If Red(sourcecolor) = Red(Tcolor) And Green(sourcecolor) = Green(Tcolor) And Blue(sourcecolor) = Blue(Tcolor)
    targetcolor = RGBA(0,0,0,0)
  Else
    targetcolor = sourcecolor
  EndIf
  ProcedureReturn targetcolor  
EndProcedure

; Example1 OpenFileRequester png Image
; file$ = OpenFileRequester("Choose icon base image", GetUserDirectory(#PB_Directory_Pictures), "png Image (*.png)|*.png", 0)
; If file$
;   LoadImage(1,file$)
;   file$ = GetPathPart(file$) + GetFilePart(file$, #PB_FileSystem_NoExtension) + ".ico"
;   End CreateIconFile(file$,1)
; Else
;   End
; EndIf

; Example2 test Image
; If CreateImage(1,512,512,32,#PB_Image_Transparent) 
;   If StartVectorDrawing(ImageVectorOutput(1))
;     VectorSourceColor(RGBA(255, 0, 0, 255))
;     AddPathCircle(512 / 2, 512 / 2, 512 / 3 )
;     FillPath()
;     StopVectorDrawing()
;   EndIf
; EndIf
; file$ = "e:\test.ico"
; End CreateIconFile(file$,1)

; Example3 Transparent geebee2.bmp Image
If LoadImage(0, #PB_Compiler_Home + "examples\sources\data\geebee2.bmp")
  If  StartDrawing(ImageOutput(0))
    Tcolor = Point(0,0)
    StopDrawing()
    CreateImage(1,ImageWidth(0),ImageHeight(0),32,#PB_Image_Transparent)
    If StartDrawing(ImageOutput(1))
      DrawingMode(#PB_2DDrawing_CustomFilter)
      CustomFilterCallback(@TransparentCallback())
      DrawImage(ImageID(0),0,0)
      StopDrawing()
    EndIf
    FreeImage(0)
  EndIf
EndIf

file$ = "e:\geebee2.ico"
CreateIconFile(file$,1)

file$ = "e:\geebee2All.ico"
CreateIconFile(file$,1,"16x24x32x48x64x96x128x256")

Code: Select all

image = CreateImage(#PB_Any,512,512,32,#PB_Image_Transparent) 
StartVectorDrawing(ImageVectorOutput(image))
  VectorSourceColor(RGBA(255, 0, 0, 255))
  AddPathCircle(512 / 2, 512 / 2, 512 / 3 )
  FillPath()
StopVectorDrawing()