PureBasic Forums - English

Posted: **Fri Nov 24, 2023 11:37 pm**

wiki
solution by @srod
solution by @idle

EnableExplicit

UsePNGImageEncoder()

#Image = 0
Global tmp$
Global XXX = 16
Global YYY = 16

Procedure SaveICO(Path$)
	Protected *Buffer
	#File = 0
	If CreateFile(#File, Path$)
		WriteUnicodeCharacter(#File, 0)
		WriteUnicodeCharacter(#File, 1)
		WriteUnicodeCharacter(#File, 1)
		WriteByte(#File , XXX)
		WriteByte(#File , YYY)
		WriteByte(#File , 0)
		WriteByte(#File , 0)
		WriteUnicodeCharacter(#File, 0)
		WriteUnicodeCharacter(#File, 32)
		WriteLong(#File, XXX * YYY)
		WriteLong(#File, 16)
		*Buffer = EncodeImage(#Image, #PB_ImagePlugin_PNG, 10, 32)
		WriteData(#File, *Buffer, MemorySize(*Buffer))
		CloseFile(#File)
	EndIf
EndProcedure


tmp$ = SaveFileRequester("Select file to save", GetCurrentDirectory(), "*.ico|*.ico", 0)
If Asc(tmp$)
	If CreateImage(#Image, XXX, YYY, 32)
		If StartDrawing(ImageOutput(#Image))
			Box(0, 0, XXX, YYY, $00FF00) ; Green
			StopDrawing()
			If Right(tmp$, 4) <> ".ico"
				tmp$ + ".ico"
			EndIf
			SaveICO(tmp$)
		EndIf
	EndIf
EndIf

Edit: solution added by @idle. See the link at the beginning of the post

Posted: **Sat Nov 25, 2023 12:58 am**

You seem to have serious problems understanding the board structure here.
Some of your applications are in General Discussion, why? (=> "Applications - Feedback and Discussion"?)
Some of your codes are in General Discussion, why? (=> "Tricks 'n' Tips"?)
Now you are adding a thread to coding questions, but answering it yourself in the first post? (=> "Tricks 'n' Tips"?)

Don't get me wrong, some of your provided stuff is pretty cool, but in the end no one will find it, because most of them are just misplaced.

Posted: **Sat Nov 25, 2023 1:33 am**

Now you are adding a thread to coding questions, but answering it yourself in the first post?

I think you can guess. I post a question that I previously tested in my program for an hour, or maybe more, using different methods. I understand that I can’t do it and the search doesn’t give results, so I ask a question. But at the same time, why do you think that I should stop? I change the search methods, use the Google query "ico site:purebasic.fr/english" and look through 5 pages of results and finally I found the function. Of course, I try to save you from useless work by posting useful results. This function had just worked for me and I wanted to post the code using this function, but something broke again. Initially, I changed 24 to 32 and the function began to work. And now I'm reviewing the code in which I changed almost nothing and trying to understand why it doesn't work.

The function uses an icon descriptor, and I give it an image descriptor. So I haven't gotten the perfect answer yet and am tweaking the image to make it look like an icon handle.

Some of your applications are in General Discussion, why? (=> "Applications - Feedback and Discussion"?)
Some of your codes are in General Discussion, why? (=> "Tricks 'n' Tips"?)

What year is the message from? Previously, I posted it in the discussion section, but I was advised to post it in the applications section, since I am giving a ready-made application. On the other hand, the source code is not posted in the applications section, but only the executable file. In this case, my source code is more suitable for the “Tricks 'n' Tips” section. Attention, question, if you have a logic for where to put it, then just express it, but don’t make me guess your thoughts, I acted based on my understanding.

By the way, the "Tricks 'n' Tips" section is a bit of an unusual name to put the functionality in the section, perhaps this is a translation problem into Russian.

This code does not allow you to create an icon from an image

Code: Select all

If Not GetIconInfo_(hIcon, iconinfo)
	Debug 1
	ProcedureReturn 0
EndIf ; Not a valid icon handle.

Posted: **Mon Nov 27, 2023 5:12 pm**

But your code is wrong und buggy.

The offset is not 16, it is $16
Your size of the data is wrong.
You allocate memory but don't free it.
You use a fixed number as file but you can not be sure that an ohter code use already the same.

A corrected version:

Code: Select all

; https://www.purebasic.fr/english/viewtopic.php?t=82936
; https://en.wikipedia.org/wiki/ICO_(file_format)

EnableExplicit

UsePNGImageEncoder()




Procedure.i SaveICO(Filename$, Image.i)
  
  Protected Result.i, File.i, *Buffer
  
  
  If IsImage(Image)
    File = CreateFile(#PB_Any, Filename$)
    If File
      ; Header
      WriteUnicodeCharacter(File, 0)  ; Reserved. Must always be 0.
      WriteUnicodeCharacter(File, 1)  ; Specifies image type: 1 for icon (.ICO) image, 2 for cursor (.CUR) image. Other values are invalid.
      WriteUnicodeCharacter(File, 1)  ; Specifies number of images in the file.
      
      ; Directory
      WriteByte(File , ImageWidth(Image))   ; Width
      WriteByte(File , ImageHeight(Image))  ; Height
      WriteByte(File , 0)                   ; Specifies number of colors in the color palette. Should be 0 if the image does not use a color palette.
      WriteByte(File , 0)                   ; Reserved, should be 0
      WriteUnicodeCharacter(File, 0)        ; Specifies color planes. Should be 0 or 1
      WriteUnicodeCharacter(File, 32)       ; Specifies bits per pixel.
      
      *Buffer = EncodeImage(Image, #PB_ImagePlugin_PNG, 9, 32)
      If *Buffer
        
        WriteLong(File, MemorySize(*Buffer))      ; Size of the bitmap data in bytes.
        WriteLong(File, Lof(File) + SizeOf(Long)) ; Offset in the file.
        
        If WriteData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
          Result = #True
        EndIf
        FreeMemory(*Buffer)
      EndIf
      CloseFile(File)
      If Not Result
        DeleteFile(Filename$)
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn Result
  
EndProcedure



#Image = 0
Define tmp$
Define XXX.i = 16
Define YYY.i = 16

tmp$ = SaveFileRequester("Select file to save", GetCurrentDirectory(), "*.ico|*.ico", 0)
If tmp$
  If Right(tmp$, 4) <> ".ico"
    tmp$ + ".ico"
  EndIf
  
  If CreateImage(#Image, XXX, YYY, 32, #PB_Image_Transparent)
    If StartDrawing(ImageOutput(#Image))
      DrawingMode(#PB_2DDrawing_AllChannels )
      Circle(XXX / 2, YYY / 2, XXX / 3 , RGBA(0,255,0,255))
      StopDrawing()
      
      SaveICO(tmp$, #Image)
    EndIf
  EndIf
EndIf

Posted: **Mon Nov 27, 2023 5:23 pm**

I would suggest to use structs.
Some old code with structs but limited functionality: http://forums.purebasic.com/german/view ... 2d#p350902

Posted: **Wed Nov 29, 2023 12:02 am**

AZJIO wrote: Sat Nov 25, 2023 1:33 am Attention, question, if you have a logic for where to put it, then just express it, but don’t make me guess your thoughts, I acted based on my understanding.

Guess my thoughts?
I think I made pretty clear where all those threads should go to from my point of view (did you see those remarks in parentheses?)
Anyway, I don't care, I'm not a moderator, it was advice, nothing more.
Take it or leave it!

And a rhetorical question from my side, if you don't mind:
If everyone but you seems to know exactly where to place their topics, who has to "express" himself then?

Posted: **Wed Nov 29, 2023 1:51 am**

HeX0R
Can make a separate topic for communication where to place the code?

Posted: **Wed Nov 29, 2023 4:55 am**

make an png ico pack with sizes 16 to 256

Code: Select all

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

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[5] 
EndStructure 

Structure bufs
  *buffer[5] 
EndStructure   

UsePNGImageEncoder()
UsePNGImageDecoder()

Procedure CreateIconFile(file.s,image) 
  
  Protected ico.ICONData 
  Protected sz = 16  
  Protected buf.bufs 
  Protected timg,fn, offset,a,b 
  
  offset = SizeOf(ICONData)   
  ico\header\num=5 
  ico\header\type=1 
  offset = SizeOf(ICONData)   
  
  If file <> ""  
    fn = CreateFile(#PB_Any,file)
    If fn 
      Repeat    
        timg = CopyImage(image,#PB_Any) 
        If timg 
          If ResizeImage(timg,sz,sz,#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 
        ico\icons[a]\height = sz 
        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 
        sz << 1 
      Until a = 5
      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 = 5
      CloseFile(fn) 
    EndIf  
    ProcedureReturn 1 
  EndIf 
  
EndProcedure 

Global image,file$ 

image = CreateImage(#PB_Any,512,512,32) 
StartDrawing(ImageOutput(image)) 
DrawingMode(#PB_2DDrawing_AllChannels )
Circle(512 / 2, 512 / 2, 512 / 3 , RGBA(0,255,0,255))
StopDrawing()

file$ = "e:\test.ico" 

CreateIconFile(file$,image)

Posted: **Wed Nov 29, 2023 6:05 am**

The criticism could have been handled better, or privately. He is not as bad as others who spam multiple forums with advertisements for their products.

He is a user who is very enthusiastic about PB, is willing to share what he learns, is willing to learn in general and has released some really nice little programs. He is not somebody who needs to be jumped on.

If you do NOT like somebody's posts, the forum has a wonderful ignore feature, put the person on your "foe" list and you will never see their posts again.

Keep in mind much gets lost in translation. RELAX! We are supposed to be on the same team here.

Posted: **Wed Nov 29, 2023 6:43 am**

I agree Kuron but this isn't the place to discuss it. So I will answer the question which nobody has actually done it yet.

And here's is a partial solution to create a png icon pack from a square image.

Code: Select all

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

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[5] 
EndStructure 

Structure bufs
  *buffer[5] 
EndStructure   

UsePNGImageEncoder()
UsePNGImageDecoder()

Procedure CreateIconFile(file.s,image) 
  
  Protected ico.ICONData 
  Protected sz = 16  
  Protected buf.bufs 
  Protected timg,fn, offset,a,b 
  
  offset = SizeOf(ICONData)   
  ico\header\num=5 
  ico\header\type=1 
  offset = SizeOf(ICONData)   
  
  If file <> ""  
    fn = CreateFile(#PB_Any,file)
    If fn 
      Repeat    
        timg = CopyImage(image,#PB_Any) 
        If timg 
          If ResizeImage(timg,sz,sz,#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 
        ico\icons[a]\height = sz 
        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 
        sz << 1 
      Until a = 5
      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 = 5
      CloseFile(fn) 
    EndIf  
    ProcedureReturn 1 
  EndIf 
  
EndProcedure 

Global image,file$ 

image = CreateImage(#PB_Any,512,512,32) 
StartDrawing(ImageOutput(image)) 
DrawingMode(#PB_2DDrawing_AllChannels )
Circle(512 / 2, 512 / 2, 512 / 3 , RGBA(0,255,0,255))
StopDrawing()

file$ = "d:\test.ico" 

CreateIconFile(file$,image)

Posted: **Thu Nov 30, 2023 7:48 am**

Normally, icons with a size< 256/256 should not be compressed (Microsoft's compressed icon format is png).
see here

https://www.axialis.com/tutorials/windo ... s.html#t2

If I remember what I did with my PureIconManager utility, to recreate an icon by decompressing it, you need to extract the image and create the image mask, recalculate the sizes and modify the size and offset in the header.

I tested a lot of decompressed icons with different software (Axialis etc.) but for each software the mask was different during decompression, so I thought about and adopted a way of creating the mask.

PureBasic Forums - English

how to save ico file?

how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?

Re: how to save ico file?