How change icon in exe

Windows specific questions.
Post Reply
aurelVZAB
Posts: 598
Joined: Jul 02, 2008 14:55
Location: [url]https://aurelsoft.ucoz.com[/url]
Contact:

How change icon in exe

Post by aurelVZAB »

I found small program written in Purebasic which change icon of exe in explorer view

Is there any similar program written in Free basic ?

tnx
dodicat
Posts: 7523
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How change icon in exe

Post by dodicat »

It is easy to add an icon to an fb .exe if this is what you mean
Example
Myicon.rc

Code: Select all

101          ICON                    "py.ico" 
example
colourpicker.bas (suggest)

Code: Select all

  
#include "windows.bi"
#cmdline "myicon.rc"
Dim Shared As integer xres,yres
'=============================
function HTML(v as ulong) as string
    dim as string hx=hex(v)
    hx=string(6-len(hx),"0")+hx
    swap hx[0],hx[4]
    swap hx[1],hx[5]
return hx
end function
Sub MoveScreenByMouse(mx As Long=0,my As Long=0,mb As Long=0)
    getmouse mx,my,,mb
    Static As Long lastmx,lastmy,lastx,lasty
    If lastx=mx andalso lasty=my Then Exit Sub Else lastx=Mx:lasty=my
    Dim As integer x,y: Screencontrol 0, x, y
    If mb=1 Then Screencontrol 100, x-(lastmx-mx),y-(lastmy-my):Exit Sub
    lastmx=mx:lastmy=my
End Sub
#macro closebox(colour)
#define incircle(cx,cy,radius,x,y) ((cx)-(x))*((cx)-(x)) +((cy)-(y))*((cy)-(y))<= (radius)*(radius)
Scope
    var mx=0,my=0,mb=0,wx=0
    Screeninfo wx
    Line(wx-16,0)-(wx,16),(colour),bf
    Draw String(wx-12,2),"X",rgb(255,255,255)
    Getmouse mx,my,,mb
    If incircle(wx-8,8,8,mx,my) And mb=1 Then Exit do
End Scope
#endmacro
'=======================================
Dim As Any Ptr MyScreen = GetDC(0)
Dim As Ulong v

Screenres 200,200,32,,&h20 or &h40 or &h08
Dim HandleGraphicsWindow As HWND
Screencontrol(2 , Cast(Integer, HandleGraphicsWindow)) 'get handle of graphics window

Windowtitle "Colour finder"
Screeninfo xres,yres 
width xres\8,yres\16
freeconsole
Dim As Ubyte r,g,b
Color ,RGB (236,233,216)
Dim As point m
dim as string key,s="  " +chr(13)+chr(10),msg 
dim as long counter
dim as integer x,y
redim as ulong c(0)
Do
    MoveScreenByMouse
SetForegroundWindow(HandleGraphicsWindow)  'graphics window gets foreground
SetFocus(HandleGraphicsWindow) 
    key=inkey
    if key=" "  then 
        counter+=1
        redim preserve c(1 to counter)
        MessageBeep(0)
var bb=string(3-len(str(b)),"0")+str(b),rr=string(3-len(str(r)),"0")+str(r),gg=string(3-len(str(g)),"0")+str(g)
var sp=string(6-len(hex(v))," ")
        s+= "RGB (" & bb &"," & gg &"," & rr &")"+ "   HEX &h"+hex(v)+sp+"   HTML #"+HTML(v) +chr(13)+chr(10)
        c(counter)=rgb(bb,gg,rr)
    end if
    GetCursorPos @m
    screencontrol 0,x,y
if m.x>x and m.x<x+xres and m.y>y and m.y<y+yres then msg="<space> to save a colour" else msg="" 
    Screenlock
    Cls
    Locate 1,1
    Color 0
    print "X,Y   ";str(m.x);",";str(m.y)
    Print "Red   ";b
    Print "Green ";g
    Print "Blue  ";r
    print
    locate 10,1
    print "HEX   &h";hex(v,6)
    draw string(0,180),msg,rgb(0,0,0)
    print "HTML   #";HTML(v)
    Line(100-30,100-30)-(100+30,100+30),Rgb(b,g,r),bf
    Line(100-30,100-30)-(100+30,100+30),Rgb(0,0,0),b
    v=GetPixel(MyScreen,m.x,m.y)
    r= Cptr(Ubyte Ptr,@v)[2] 'Or just use the standard r,g,b extract method
    g= Cptr(Ubyte Ptr,@v)[1] 'but this method is a tad faster
    b= Cptr(Ubyte Ptr,@v)[0]
     closebox(rgb(200,0,0))
    Screenunlock
    Sleep 1,1
Loop Until key=Chr(255,107) or key=chr(27)
 if s<>"  " +chr(13)+chr(10) then
screenres 800,700,32
width 800\8,700\16
windowtitle "Colours picked  (" & counter &" colours)."
print s
for z as long=1 to ubound(c)
    line(400,4+16*z)-(600,4+16*z+8),c(z),bf
    next z
var f=freefile
open "colours.txt" for output as #f
print #f,s
close #f
s=command(0)
dim as long i=instrrev(s,"\")
s=mid(s,1,i) + "colours.txt"
print "printed to ";s
print "Press a key to exit"
sleep
end if
  
Pick your own icon name, make sure it is in the same folder as the .bas file.

OR, from stuff written by srvaldez
viewtopic.php?p=249299&hilit=%2Ainject%2A#p249299
chicon.bas (compile to .exe)

Code: Select all


#include once "crt/long.bi"
#include once "crt/io.bi"
#include once "crt/stdio.bi"
#include once "crt/stdlib.bi"
#include once "windows.bi"
#include "file.bi"

type GROUPICON field = 2
   Reserved1 as WORD
   ResourceType as WORD
   ImageCount as WORD
   Width as BYTE
   Height as BYTE
   Colors as BYTE
   Reserved2 as BYTE
   Planes as WORD
   BitsPerPixel as WORD
   ImageSize as DWORD
   ResourceID as WORD
end type

 sub InjectMainIcon(byval Where as string , byval What as string)
  
   var hwhere= beginupdateresourceA(where,0)
   dim buffer as zstring ptr
   dim buffersize as clong
   dim hFile as any ptr
   hFile = fopen(What,"rt+")', O_RDONLY or O_BINARY) 'two Irishmen ??
   if hFile = (-1) then
      return
   end if
  
   
   fseek(hfile, 0, SEEK_END)' // seek to end of file
   buffersize = ftell(hfile)' // get current file pointer
   fseek(hfile, 0, SEEK_SET)'re set
   buffer = cptr(zstring ptr, malloc(buffersize))
    
   fread( buffer,buffersize,1,hfile)
   
   fclose(hFile)
   UpdateResource(hWhere, RT_ICON, MAKEINTRESOURCE(1), MAKELANGID(LANG_ENGLISH, SUBLANG_DEFAULT), buffer + 22, buffersize - 22)
   dim grData as GROUPICON
   grData.Reserved1 = 0
   grData.ResourceType = 1
   grData.ImageCount = 1
   grData.Width = 32
   grData.Height = 32
   grData.Colors = 0
   grData.Reserved2 = 0
   grData.Planes = 2
   grData.BitsPerPixel = 32
   grData.ImageSize = buffersize - 22
   grData.ResourceID = 1
   UpdateResource(hWhere, RT_GROUP_ICON, "MAINICON", MAKELANGID(LANG_ENGLISH, SUBLANG_DEFAULT), @grData, sizeof(GROUPICON))
    free (buffer)
   EndUpdateResource(hWhere, FALSE)
end sub


      printf("Usage: chicon [executable filename] [icon filename]")
    if fileexists(command(1))=0 then print "   " +command(1) + " not found":end
    if fileexists(command(2))=0 then print "   " + command(2) + " not found":end
   InjectMainIcon(command(1), command(2))


'InjectMainIcon("pool.exe","icon.ico")  'test OK
'sleep

   
then use shell
chicon file.exe file.ico
You need your own filenames of course.
aurelVZAB
Posts: 598
Joined: Jul 02, 2008 14:55
Location: [url]https://aurelsoft.ucoz.com[/url]
Contact:

Re: How change icon in exe

Post by aurelVZAB »

Thanks dodicat
i mean by UpdateResource
but first example is also very interesting too

i will try both
tnx!
aurelVZAB
Posts: 598
Joined: Jul 02, 2008 14:55
Location: [url]https://aurelsoft.ucoz.com[/url]
Contact:

Re: How change icon in exe

Post by aurelVZAB »

well i cannot confirm that this program work
simply i don't use shell....or cmd ...and Purebasic
example don't use cmd to change icon at all
if is not problem i can post pB code here ?
coderJeff
Site Admin
Posts: 3942
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: How change icon in exe

Post by coderJeff »

aurelVZAB wrote: Jul 05, 2022 8:41 if is not problem i can post pB code here ?
If the goal and result is to produce a working freebasic program to solve the problem, seems ok to me.
Post Reply