Choose-Icon-Dialog

Franky · Post by **Franky** » Mon Dec 06, 2004 7:09 pm

Code updated For 5.20+

Hi all

Based on this article about the fileformat .ico
http://www.whisqu.se/per/docs/graphics52.htm
I wrote this little sourcecode.
Icon files can contain more than one icon, so, if you want to work on an icon in this file, you can choose it by this dialog:

Code: Select all

Structure IconData
  width.b
  height.b
  colors.b
  reserve.b
  planes.w
  bitcount.w
  imgsize.l
  pos.l
EndStructure


Procedure PreOpenIcon(testname.s);Opens a dialog to choose an icon of an iconfile which contains more than 1 Icon
  Protected preiconquit,preiconevent,preiconreturn
  If ReadFile(1,testname)
    ReadLong(1);two unimportant words
    iconnumber=ReadWord(1)
    If iconnumber>1
      Dim Icons.IconData(iconnumber-1)
      ReadData(1,Icons(0),SizeOf(IconData)*iconnumber)
      Workdirek.s=PathRequester("ArbeitsPfad aussuchen","");Someway unimportant, after loading icons, the files are all deleted
      
      Dim imgpos.l(iconnumber-1)
      For a=1 To iconnumber
        imgpos(a-1)=AllocateMemory(Icons(a-1)\imgsize+22)
        
        PokeW(imgpos(a-1),0)
        PokeW(imgpos(a-1)+2,1)
        PokeW(imgpos(a-1)+4,1)
        CopyMemory(Icons(a-1),imgpos(a-1)+6,SizeOf(IconData))
        PokeL(imgpos(a-1)+18,6+SizeOf(IconData))
        FileSeek(1,Icons(a-1)\pos)
        PokeL(imgpos(a-1)+22,40)
        ReadData(1,imgpos(a-1)+22,Icons(a-1)\imgsize)
        CreateFile(2,Workdirek+"/holdico"+Str(a)+".ico")
        WriteData(2,imgpos(a-1),Icons(a-1)\imgsize+22)
        CloseFile(2)
      Next
      preiconquit=0
      OpenWindow(1,400,100,300,100+iconnumber*100,"Icons",#PB_Window_SystemMenu)
      
      TextGadget(#PB_Any,0,0,300,100,"Das Icon enthÃ¤lt mehrere Icons, die Verschiedene GrÃ¶ÃŸen haben."+Chr(13)+"Welches Icon wollen sie bearbeiten?")
      For a=1 To iconnumber
        ButtonGadget(a,10,a*100,80,20,"Bearbeiten")
        TextGadget(#PB_Any,100,a*100,100,40,"Format:"+Chr(13)+"Breite/HÃ¶he: "+Str(Icons(a-1)\width))
        ImageGadget(#PB_Any,200,a*100,Icons(a-1)\width,Icons(a-1)\height,ImageID(LoadImage(#PB_Any,Workdirek+"/holdico"+Str(a)+".ico")))
        DeleteFile(Workdirek+"/holdico"+Str(a)+".ico")
      Next
      Repeat
        preiconevent=WaitWindowEvent()
        If preiconevent=#PB_Event_Gadget
          preiconquit=1
          preiconreturn=EventGadget()
        ElseIf preiconevent=#WM_CLOSE
          preiconquit=1
          preiconreturn=-1
        EndIf
      Until preiconquit=1
      CloseWindow(1)
      CloseFile(1)
    EndIf
    Dim imgpos.l(0)
    Dim Icons.IconData(0)
  Else
    preiconreturn=1
  EndIf
  ProcedureReturn preiconreturn
EndProcedure

Debug PreOpenIcon(OpenFileRequester("Icon aussuchen","","Icons|*.ico*",0))

Thanks for any feedback, bugreport or advice, how to change the code so that it donÂ´t has to save the code to display the icon