' Rapid-Q by William Yu (c)1999-2000                                             .
' ================================================================================
' Upload_il_tuo_script_su_Rapidq.it

' 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
============= ====================================== ================ ==========
                                                     Save to icon
                                                     format
                                                     FileName is the
                                                     file
                                                     name,PixelFormat
SaveToFile    Sub(FileName$,pixelFormat%,mask%)      can be pf4bit(16 3
                                                     colors) or
                                                     pf8bit(256
                                                     colors , mask is
                                                     transparence
                                                     (true or false)
SaveBmpToFile Sub                                    Save a bitmap to 4
              (QBitmap,FileName$,pixelFormat%,mask%) icon format.
QICON Events
Event               Type                Occurs when...      Params
=================== =================== =================== ====================
QICON Examples
' Copy and paste into your program
$TYPECHECK ON
$Option ICON "IconLib.ico"
$Include "Rapidq.inc"
$Include "Object\QICON.inc"
$Include "Object\QCanvasEx.inc"
$INCLUDE "Object\QCOLORDIALOG.INC"
$INCLUDE "Object\QDrawFocus.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 SaveAs
declare sub MenuMask
declare sub SelectIco(button as long,x as long,y as long,shift as long)

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

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 sous..."
          OnClick=SaveAs
        END CREATE
        CREATE item12 as QMENUITEM
          caption="&Mode transparent"
          checked=true
          OnClick=MenuMask
        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 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

'Insert your initialization code here

Form.ShowModal

Sub Open
  icon.filename=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
  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
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.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 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



' ===============================================================================
'                      2003 Holyguard.net - 2007_Abruzzoweb