2003-12-31 15:43

     $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"
     $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 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


     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.1"

     CREATE Form AS QFormEx
      CAPTION=AppTitle
      Width=640
      Height=500
      Center
      DeskBar=true
      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
        CREATE item7 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")
       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)
       ColumnCaption(1)="Nom"
       ColumnCaption(2)="Taille"
       ColumnCaption(3)="Type"
       ColumnCaption(4)="Modifié"
       Mask = "*.dll;*.exe;*.icl;*.ico"
       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

     Form.SHOWMODAL

     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
     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 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

2003-12-31 15:43