Documentation composant par D.Glodt (c)2000-2001 Appendix A: QICON

QICON Composant

QICON est un composant non visuel permettant l'extraction d'icones de fichiers executable,dll,icl,ico.


QICON Proprietés
Champs Type L/E Defaut
Ico STRING LE
Nom du fichier icone incluant le chemin, les types de fichiers sont *.ico,*.exe,*.dll,*.icl. Une chaine vide supprime l'icone actuel en mémoire. 
Count INTEGER L
Nombre d'icones dans le fichier. 
Handle LONG L
Handle de l'icone. 
Index INTEGER LE 0
Index icone,permet la selection d'icone dans un fichier possedant plusieurs icones. 

QICON Methodes
Methode Type Description Parametres

QICON Evenements
Evenement Type Déclenchement Parametres

QICON Exemples

$TYPECHECK ON
$Option ICON "IconLib.ico"
$Include "Rapidq.inc"
$Include "Object\QICON.inc"
$Include "Object\QEXCANVAS.inc"
$INCLUDE "Object\QCOLORDIALOG.INC"


declare Sub open
declare Sub draw
declare sub ChangeDirectory
declare sub ShowFiles
declare sub ShowIco
declare sub ShowIcl
declare sub ShowDll
declare sub ShowExe
declare sub showColor
declare sub SaveBitmap
declare sub SelectIco(button as long,x as long,y as long,shift as long)

const Offset=38
dim bitmap as QBITMAP
bitmap.PixelFormat=pf8bit
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="Fichier bitmap|*.bmp"
SaveDialog.Caption= "Sauver bitmap"
dim popup as QPOPUPMENU
dim pop1 as QMENUITEM
pop1.caption="&Sauver bitmap"
pop1.OnClick=SaveBitmap
popup.addItems(pop1)
popup.autoPopup=true

CREATE Form AS QFORM
    Caption = "Icon viewer"
    Width = 640
    Height = 500
    BorderStyle=bsSingle
    DelBorderIcons 2
    Center
    CREATE Menu as QMAINMENU
      CREATE Menu1 as QMENUITEM
        caption="&Fichier"
        CREATE item11 as QMENUITEM
          caption="&Sauver bitmap"
          OnClick=SaveBitmap
        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
      END CREATE
    END CREATE
    CREATE DirTree AS QDirTree
      InitialDir = CURDIR$
      Width =300
      Height =280
      OnChange=ChangeDirectory
    END CREATE
    CREATE EXEList AS QFileListBox
      ShowIcons = True
      Mask = "*.dll;*.exe;*.icl;*.ico"
      Left =305
      Height =280
      Width = 325
      OnClick=Open
    END CREATE
    CREATE box as QSCROLLBOX
      left=0
      width=form.clientwidth
      height=150
      top=form.clientHeight-box.height-20
      CREATE image as QEXCANVAS
        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
       AddPanels "Nombre d'icons:","selection:"
       Panel(0).width=200
    END CREATE
END CREATE

'Insert your initialization code here

Form.ShowModal

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

Sub Draw()
  dim i as integer
  dim col as integer
  dim x as integer
  dim y as integer
  
  x=0
  y=0
  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,Icon.handle)
      x=x+Offset
    next i
  else
    image.height=box.height-4
    image.DrawIco(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
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 ShowColor
  Dial.full=true
  if Dial.Execute(form) then
    ImageColor=Dial.RgbColor
    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
      rect.left=left
      rect.top=top
      rect.right=left+32
      rect.bottom=top+32
    end if 
    left=left+Offset
  next i
End function

Sub SelectIco(button as long,x as long,y as long,shift as long)
  infos.panel(1).caption="Selection:icon"+str$(Selection(x,y))
End Sub

Sub SaveBitmap
  If SaveDialog.Execute Then
    dest.left=0
    dest.top=0
    dest.right=32
    dest.bottom=32
    bitmap.fillrect(0,0,32,32,&HFFFFFF)
    Bitmap.copyRect(Dest,image,rect)
    Bitmap.saveToFile(SaveDialog.FileName)
  end if
End Sub