// True Color Image List
//
// This package enhance standard VDF Image list class to allow
// use more colored icons in.
//
// Author: Sergey V. Natarov
Use cImageList.pkg

#IFNDEF Get_LoadIcon
External_Function LoadIcon "LoadIconA" User32.DLL Pointer hInstance String lpszIconName Returns Integer
#ENDIF


Class cWinImageList Is a cImageList
    Procedure Construct_Object
        Forward Send Construct_Object
        Property Integer piImageListType     public ILC_COLORDDB
        Property Boolean pbSupportOemImages  public True
    End_Procedure
    Procedure DoCreate
       Integer cx cy dwFlags icInitial iGrowBy iColor

       Get piImageHeight To cy
       Get piImageWidth  To cx
       Get piMaxImages   To iGrowBy
       Get piImageListType To iColor

       Move (iColor+ILC_MASK) To dwFlags

       Set phImageList To (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy))
    End_Procedure // DoCreate
    
    // Why redefine when you can inherit?
    //Function xxxAddTransparentImage String sImage Integer iTransparentColor Returns Integer
    //    Handle hBitmap
    //    Integer iVoid iImage
    //
    //    Move -1 To iImage // assume inability to add
    //
    //    Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_BITMAP, 0, 0, 0)) To hBitmap
    //    If (hBitmap =0) Begin // the bitmap was not in the EXE resource
    //        Get_File_Path sImage To sImage // find path in DFPATH, if appropriate
    //        If (sImage <>"") Begin // The image was found!
    //            Move (LoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) To hBitmap
    //        End
    //    End
    //
    //    If hBitmap Begin
    //        Move (ImageList_AddMasked(phImageList(self), hBitmap, iTransparentColor)) To iImage
    //        Move (DeleteObject(hBitmap)) To iVoid
    //    End
    //
    //    Function_Return iImage
    //End_Function
    
    //
    // Returns 0 if the argument isn't an OEM image, or
    // the OEM number if it is.
    Function IsOemImage String sImage Returns Integer
      Integer iVoid
      Integer iOemImage
      String  sUpImage
      Move (Uppercase(sImage)) To sUpImage
      Move 0 To iOemImage
      If ( (Pos(".BMP",sUpImage)=0) and (Pos(".RLE",sUpImage)=0) ) Begin
        Send Ignore_Error of Error_Object_Id 54
        Move (cast(sImage,Integer)) To iOemImage
        Send Trap_Error of Error_Object_Id 54
      End
      Function_Return iOemImage
    End_Function // IsOemImage
    
    Function AddTransparentImage String sImage Integer iTransparentColor Returns Integer
      Integer iImage                        
      Integer iOemImage    
      Integer iVoid 
      String  sOEM
      Handle  hBitmap 
      Handle  lpszImage
      
      Move -1 To iImage        
      Get IsOemImage sImage To iOemImage
      If ((pbSupportOemImages(Self)) and (iOemImage<>0)) Begin
        //Move (LoadImage(0, iOemImage, IMAGE_BITMAP, 0, 0, 0)) To hBitmap
        Move ("#"+trim(iOemImage)+character(0)) To sOEM
        Move (AddressOf(sOEM)) To lpszImage 
        Move (LoadIcon(0, lpszImage )) To hBitmap
        If hBitmap Begin
          Move (ImageList_AddMasked(phImageList(self), hBitmap, iTransparentColor)) To iImage
          Move (DeleteObject(hBitmap)) To iVoid
        End
      End
      Else Begin
        Forward Get AddTransparentImage sImage iTransparentColor To iImage
      End
      Function_Return iImage
    End_Function // AddTransparentImage
End_Class