Documentation component by D.Glodt (c)2000-2004	Appendix A: QICON

QICON Component

QICON is a component no visible with icons extraction from exe,dll,icl,ico files or associated files and save file to icon format.

QICON Properties

Field Type R/W Default

FileName STRING RW

Name of icon file including the path, the files type are *.ico,*.exe,*.dll,*.icl or
other files associated to an exé.a empty string delete the current icon in mémory.

Count INTEGER R

Number of icons in the file.

Handle LONG R

Icon handle.

Index INTEGER RW 0

Icon index ,for selection of icon from file if it has many icons.

Associated BOOLEAN RW FALSE

Icon associated to a exe file if the value is true.

QICON Methods

Method Type Description Params

SaveToFile Sub(FileName$,pixelFormat%,mask%) Save to icon format
FileName is the file name,PixelFormat can be pf4bit(16 colors) or
pf8bit(256 colors , mask is transparence(true or false) 3

SaveBmpToFile Sub(QBitmap,FileName$,pixelFormat%,mask%) Save a bitmap to icon format. 4

ConvertAsCursor Sub(FileName$,XHotSpot?,YHotSpot?) Convert icon filename$ as cursor, parameters XHotSpot and YHotSpot are cursor coordinates 3

QICON Events

Event Type Occurs when... Params

QICON Examples

$TYPECHECK ON
$Option ICON "IconLib.ico"
$Include "Rapidq.inc"
$Include "QFuncLib.inc"
$Include "Object\QICON.inc"
$Include "Object\QCanvasEx.inc"
$INCLUDE "Object\QCOLORDIALOG.INC"
$INCLUDE "Object\QDrawFocus.INC"
$INCLUDE "Object\QFileListView.inc"
$INCLUDE "Object\QFormEx.inc"
$include "Object\QAbout.inc"

$Resource CODE as "IconLib.ico"
$Resource ICO_DEFAUT as "defaut.ico"
$Resource ICO_EXE as "exe.ico"
$Resource ICO_DLL as "dll.ico"
$Resource ICO_IMG as "img.ico"

$Resource ICO_SMALL_DEFAUT as "SmallDefaut.ico"
$Resource ICO_SMALL_EXE as "SmallExe.ico"
$Resource ICO_SMALL_DLL as "SmallDll.ico"
$Resource ICO_SMALL_IMG as "SmallImg.ico"


declare Sub open(file as string)
declare Sub draw
declare sub ChangeDirectory
declare sub ShowFiles
declare sub ShowIco
declare sub ShowIcl
declare sub ShowDll
declare sub ShowExe
declare sub ShowCur
declare sub showColor
declare sub SaveAs
declare sub MenuMask
declare sub SelectIco(button as long,x as long,y as long,shift as long)
declare Sub ShowList(sender as QMenuItem)
declare sub ResizeImage
declare sub OnAbout
declare sub DrawCursor
declare sub GridCursor
declare sub InfoGrid(x as short,y as short)
declare sub CloseGrid(Button as short,x as short,y as short)
declare sub OpenGrid
declare sub CheckIco

const Offset=38
dim bitmap as QBITMAP
bitmap.PixelFormat=pf24bit
bitmap.width=32
bitmap.height=32
dim rect as QRECT
dim dest as QRECT
dim icon as Qicon
dim Dial as QColorDialog
dim ImageColor as long
ImageColor=&HFFFFFF
Dim SaveDialog as QSaveDialog
SaveDialog.Filter="icones 16 couleurs(*.ico)|*.ico|icones 256 couleurs(*.ico)|*.ico|bitmap 24 bits(*.bmp)|*.bmp|"
SaveDialog.Caption= "Sauver sous"
dim popup as QPOPUPMENU
dim pop1 as QMENUITEM
pop1.caption="&Sauver sous..."
pop1.OnClick=SaveAs
popup.addItems(pop1)
popup.autoPopup=true
dim IconSelect as integer
dim focus as QDrawFocus
    focus.noresize=true
    focus.showcursor=false
dim about as QAbout
const AppTitle="Icon viewer"
const AppVersion="1.2"

CREATE Form AS QFormEx
    Caption=AppTitle
    Width=640
    Height=500
    Center
    DeskBar=true
    CREATE Menu as QMAINMENU
      CREATE Menu1 as QMENUITEM
        caption="&Fichier"
        OnClick=CheckIco
        CREATE item11 as QMENUITEM
          caption="&Sauver sous..."
          OnClick=SaveAs
        END CREATE
        CREATE item12 as QMENUITEM
          caption="&Mode transparent"
          checked=true
          OnClick=MenuMask
        END CREATE
        CREATE item13 as QMENUITEM
          caption="-"
        END CREATE
        CREATE item14 as QMENUITEM
          caption="&Conversion curseur"
          OnClick=OpenGrid
        END CREATE
      END CREATE
      CREATE Menu2 as QMENUITEM
        caption="&Affichage"
        CREATE item1 as QMENUITEM
          caption="&Couleur de fond"
          OnClick=ShowColor
        END CREATE
        CREATE item2 as QMENUITEM
          caption="-"
        END CREATE
        CREATE item3 as QMENUITEM
          caption="&Fichiers ico"
          checked=true
          OnClick=ShowIco
        END CREATE
        CREATE item4 as QMENUITEM
          caption="&Fichiers icl"
          checked=true
          OnClick=ShowIcl
        END CREATE
        CREATE item5 as QMENUITEM
          caption="&Fichiers dll"
          checked=true
          OnClick=ShowDll
        END CREATE
        CREATE item6 as QMENUITEM
          caption="&Fichiers exe"
          checked=true
          OnClick=ShowExe
        END CREATE
        CREATE item7 as QMENUITEM
          caption="&Fichiers cur"
          checked=true
          OnClick=ShowCur
        END CREATE
        CREATE item8 as QMENUITEM
          caption="-"
        END CREATE
        CREATE item21 as QMENUITEM
          caption="&Grandes icones"
          Tag=1
          OnClick=ShowList
        END CREATE
        CREATE item22 as QMENUITEM
          caption="&Petites icones"
          Tag=2
          OnClick=ShowList
        END CREATE
        CREATE item23 as QMENUITEM
          caption="&Liste"
          Tag=3
          OnClick=ShowList
        END CREATE
        CREATE item24 as QMENUITEM
          caption="&Détails"
          Tag=4
          checked=true
          OnClick=ShowList
        END CREATE
      END CREATE
      CREATE Menu3 as QMENUITEM
        caption="&?"
        CREATE item31 as QMENUITEM
          caption="&A Propos..."
          OnClick=OnAbout
        END CREATE
      END CREATE
    END CREATE
    CREATE Splitter1 AS QSPLITTER
      Align=alLeft
      width=5
    END CREATE
    CREATE DirTree AS QDirTree
      Align=alLeft
      InitialDir = CURDIR$
      Width =300
      OnChange=ChangeDirectory
    END CREATE
    CREATE EXEList AS QFileListView
      Align=alClient
      Width = 325
      ViewStyle=vsReport
      ExtensionsList.AddItems ("exe","dll","icl","ico","cur","ani")
      SmallImageList.AddIcoHandle(ICO_SMALL_DEFAUT)
      LargeImageList.AddIcoHandle(ICO_DEFAUT)
      SmallImageList.AddIcoHandle(ICO_SMALL_EXE)
      LargeImageList.AddIcoHandle(ICO_EXE)
      SmallImageList.AddIcoHandle(ICO_SMALL_DLL)
      LargeImageList.AddIcoHandle(ICO_DLL)
      SmallImageList.AddIcoHandle(ICO_SMALL_IMG)
      LargeImageList.AddIcoHandle(ICO_IMG)
      SmallImageList.AddIcoHandle(ICO_SMALL_IMG)
      LargeImageList.AddIcoHandle(ICO_IMG)
      SmallImageList.AddIcoHandle(ICO_SMALL_IMG)
      LargeImageList.AddIcoHandle(ICO_IMG)
      SmallImageList.AddIcoHandle(ICO_SMALL_IMG)
      LargeImageList.AddIcoHandle(ICO_IMG)
      ColumnCaption(1)="Nom"
      ColumnCaption(2)="Taille"
      ColumnCaption(3)="Type"
      ColumnCaption(4)="Modifié"
      Mask = "*.dll;*.exe;*.icl;*.ico;*.cur;*.ani"
      OnFileChange=Open
    END CREATE
    CREATE Splitter2 AS QSPLITTER
      Align=alBottom
      cursor=crVSplit
      width=5
    END CREATE
    CREATE box as QSCROLLBOX
      Align=alBottom
      height=150
      OnResize=ResizeImage
      CREATE image as QCanvasEx
        top=0
        left=0
        width=box.width-4
        height=box.height-4
        fillrect(0,0,image.width,image.height,&HFFFFFF)
        PopupMenu=Popup
        OnPaint=Draw
        OnMouseDown=SelectIco
      END CREATE
    END CREATE
    CREATE Infos AS QSTATUSBAR
       SizeGrip=false
       AddPanels "Nombre d'icons:","selection:"
       Panel(0).width=200
    END CREATE
END CREATE

'======================================================== 
' boite dialogue coordonnées x,y curseur 
'======================================================== 
CREATE Form2 as QFORM
  width=300
  height=340
  caption="Coordonnées curseur"
  center
  borderstyle=4
  CREATE SpotInfo as QLABEL
    top=10
    left=15
    autosize=true
    caption="X:"+space$(3)+"Y:"
    transparent=true
  END CREATE
  CREATE BoxIco AS QSCROLLBOX
    top=40
    left=15
    width=260
    height=260
    CREATE ImgIco AS QCANVASEX
      left=0
      top=0
      width=256
      height=256
      OnPaint=DrawCursor
      OnMouseMove=InfoGrid
      OnMouseDown=CloseGrid
    END CREATE
  END CREATE
END CREATE

Form.ShowModal

sub OpenGrid
  Dim msgButton as integer
  
  msgButton=MessageBox("Convertir "+GetFileName(icon.filename)+" en curseur?",application.title,36)
  if msgButton=mrYes then form2.show
end sub

sub CheckIco
  if instr(lcase$(icon.filename),".ico")>0 then
    item14.enabled=true
  else
    item14.enabled=false
  end if
end sub

sub DrawCursor
  ImgIco.fillrect(0,0,256,256,&hffffff)
  ImgIco.DrawIco(0,0,256,256,Icon.handle)
  GridCursor
end sub

'============================ 
' Affichage grille zoom 
'============================ 
Sub GridCursor
  dim ptHorz as integer
  dim ptVert as integer
  dim i as integer
    
  ptHorz=0
  ptVert=0
  ImgIco.pensize=1
  for i=1 to int(ImgIco.height/8)
    ptHorz=ptHorz+8
    ImgIco.line(0,ptHorz,ImgIco.width,ptHorz,&h0)
  next i 
  for i=1 to int(ImgIco.width/8)
    ptVert=ptVert+8
    ImgIco.line(ptVert,0,ptVert,ImgIco.height,&h0)
  next i 
End Sub

Sub InfoGrid(x as short,y as short)
  SpotInfo.caption="X:"+str$(int(x/8)+1)+" Y:"+str$(int(y/8)+1)
End Sub

Sub CloseGrid(Button as short,x as short,y as short)
  Form2.close
  icon.ConvertAsCursor(icon.filename,(x/8)+1,(y/8)+1)
  icon.filename=FullPathNoExt(icon.filename)+".cur"
  EXEList.Refresh
End Sub

Sub Open(file as string)
  icon.filename=file
  image.repaint
  infos.panel(0).caption="Nombre d'icons:"+str$(icon.count)
  infos.panel(1).caption="Selection:"
End Sub

Sub ResizeImage
 image.width=box.width-4
End Sub

Sub Draw()
  dim i as integer
  dim col as integer
  dim x as integer
  dim y as integer
  
  x=0
  y=0
  focus.remove(image.handle)
  image.fillrect(0,0,image.width,image.height,ImageColor)
  if icon.count>1 then
    if icon.count*Offset>(image.width-Offset) then
      col=icon.count/((image.width-Offset)/Offset)
      if box.height<(Offset*col+Offset) then
        image.height=Offset*col+Offset
      else
        image.height=box.height-4
      end if
    else
      image.height=box.height-4
    end if
    for i=0 to icon.count
      if x+Offset>image.width then
        x=0
        y=y+Offset
      end if
      icon.index=i
      image.DrawIco(x,y,0,0,Icon.handle)
      x=x+Offset
    next i
  else
    image.height=box.height-4
    image.DrawIco(0,0,0,0,Icon.handle)
  end if
End Sub

SUB ChangeDirectory
  EXEList.Directory =DirTree.Directory
END SUB

Sub ShowFiles
  EXElist.Mask=""
  if item3.checked then
    if EXElist.Mask="" then 
      EXElist.Mask=EXElist.Mask+"*.ico"
    else
      EXElist.Mask=EXElist.Mask+";*.ico"
    end if
  end if
  if item4.checked then
    if EXElist.Mask="" then 
      EXElist.Mask=EXElist.Mask+"*.icl"
    else
      EXElist.Mask=EXElist.Mask+";*.icl"
    end if
  end if
  if item5.checked then
    if EXElist.Mask="" then 
      EXElist.Mask=EXElist.Mask+"*.dll"
    else
      EXElist.Mask=EXElist.Mask+";*.dll"
    end if
  end if
  if item6.checked then
    if EXElist.Mask="" then 
      EXElist.Mask=EXElist.Mask+"*.exe"
    else
      EXElist.Mask=EXElist.Mask+";*.exe"
    end if
  end if
  if item7.checked then
    if EXElist.Mask="" then 
      EXElist.Mask=EXElist.Mask+"*.cur;*.ani"
    else
      EXElist.Mask=EXElist.Mask+";*.cur;*.ani"
    end if
  end if
End Sub

Sub ShowIco
  if item3.checked then
    item3.checked=false
  else
    item3.checked=true
  end if
  ShowFiles
End Sub

Sub ShowIcl
  if item4.checked then
    item4.checked=false
  else
    item4.checked=true
  end if
  ShowFiles
End Sub

Sub ShowDll
  if item5.checked then
    item5.checked=false
  else
    item5.checked=true
  end if
  ShowFiles
End Sub

Sub ShowExe
  if item6.checked then
    item6.checked=false
  else
    item6.checked=true
  end if
  ShowFiles
End Sub

Sub ShowCur
  if item7.checked then
    item7.checked=false
  else
    item7.checked=true
  end if
  ShowFiles
End Sub

Sub ShowColor
  Dial.style=cdNormal 
  if Dial.Execute then
    ImageColor=Dial.Color
    image.repaint
  end if
End Sub

Function Selection(x as long,y as long)as integer
  dim left as integer
  dim top as integer
  dim i as integer
  
  
  left=0
  top=0
  for i=1 to icon.count
    if left+Offset>image.width then
      left=0
      top=top+Offset
    end if
    if x>left and x<(left+32) and y>top and y<(top+32) then
      Selection=i
      IconSelect=i-1
      rect.left=left
      rect.top=top
      rect.right=left+32
      rect.bottom=top+32
      focus.start(image.handle,left-1,top-1)
      focus.draw(image.handle,left+34,top+34,true)
    end if 
    left=left+Offset
  next i
End function

Sub SelectIco(button as long,x as long,y as long,shift as long)
  if Selection(x,y)=0 then focus.remove(image.handle) 
  infos.panel(1).caption="Selection:icon"+str$(Selection(x,y))
End Sub

Sub MenuMask
  if item12.checked then
    item12.checked=false
  else
    item12.checked=true
  end if
End Sub

Sub ShowList(sender as QmenuItem)
  item21.checked=false
  item22.checked=false
  item23.checked=false
  item24.checked=false
  sender.checked=true
  Select Case sender.tag
  Case 1
    ExeList.ViewStyle=vsIcon
  Case 2
    ExeList.ViewStyle=vsSmallIcon
  Case 3
    ExeList.ViewStyle=vsList
  Case 4
    ExeList.ViewStyle=vsReport
  End Select
End Sub

Sub SaveAs  
  If SaveDialog.Execute Then
    Select case SaveDialog.FilterIndex
    case 1
      icon.index=IconSelect
      if instr(lcase$(SaveDialog.filename),".ico")=0 then
        icon.saveToFile(SaveDialog.filename+".ico",pf4bit,item12.checked)
      else
        icon.saveToFile(SaveDialog.filename,pf4bit,item12.checked)
      end if
    case 2
      icon.index=IconSelect
      if instr(lcase$(SaveDialog.filename),".ico")=0 then
        icon.saveToFile(SaveDialog.filename+".ico",pf8bit,item12.checked)
      else
        icon.saveToFile(SaveDialog.filename,pf8bit,item12.checked)
      end if
    case 3
      dest.left=0
      dest.top=0
      dest.right=32
      dest.bottom=32
      bitmap.fillrect(0,0,32,32,&HFFFFFF)
      Bitmap.copyRect(Dest,image,rect)
      if instr(lcase$(SaveDialog.filename),".bmp")=0 then
        Bitmap.saveToFile(SaveDialog.FileName+".bmp")
      else
        Bitmap.saveToFile(SaveDialog.FileName)
      end if
    end Select
  end if
End Sub

Sub OnAbout
  about.AppName=AppTitle
  about.AppVersion=AppVersion
  about.Caption="A propos"
  about.text="Auteur:Glodt dominique"+chr$(13)+"License libre"
  about.image.icohandle=Code
  about.EmailFont.color=&hff0000
  about.email="dominique.glodt@libertysurf.fr"
  about.show
End Sub

Field	Type	R/W	Default

FileName	STRING	RW
	Name of icon file including the path, the files type are .ico,.exe,.dll,.icl or other files associated to an exé.a empty string delete the current icon in mémory.
Count	INTEGER	R
	Number of icons in the file.
Handle	LONG	R
	Icon handle.
Index	INTEGER	RW	0
	Icon index ,for selection of icon from file if it has many icons.
Associated	BOOLEAN	RW	FALSE
	Icon associated to a exe file if the value is true.

Method	Type	Description	Params

SaveToFile	Sub(FileName$,pixelFormat%,mask%)	Save to icon format FileName is the file name,PixelFormat can be pf4bit(16 colors) or pf8bit(256 colors , mask is transparence(true or false)	3
SaveBmpToFile	Sub(QBitmap,FileName$,pixelFormat%,mask%)	Save a bitmap to icon format.	4
ConvertAsCursor	Sub(FileName$,XHotSpot?,YHotSpot?)	Convert icon filename$ as cursor, parameters XHotSpot and YHotSpot are cursor coordinates	3