//***************************************************************************************** // Copyright (c) 2000 Michael Kurz // All rights reserved. // If you want to use this source in your applications conatct: // // $FileName : cImageListEx.pkg // $ProjectName : Shared Classes // $Author : Michael Kurz // $Created : 03-13-2001 @ 19:00 // // Contents: // An extended ImageList which allows to add Images after the ImageList was created. // This is used e.g in the TreeView when the Bitmaps need to be dynamically created. // // $Rev History // //***************************************************************************************** Use VdfBase.pkg Use WinGDI.pkg // Standard WinGDI API calls and Constants Use mPointer.Pkg // Useful stuff to when using pointers and Types in DLL (API) Calls. Define IMAGE_BITMAP For 0 Define IMAGE_ICON For 1 Define IMAGE_CURSOR For 2 Define LR_LOADFROMFILE For |CI$0010 Define LR_CREATEDIBSECTION For |CI$2000 Define clDefault For |CI$FF000000 Define clNone For |CI$FFFFFFFF Define dsNormal For 0 Define dsFocus For 1 Define dsSelected For 2 Define dsTransparent For 3 Define itImage For 0 Define itMask For 1 External_FunctionEx ImageList_Add "ImageList_Add" COMCTL32.DLL ; Handle hImgLst Handle hBmp Handle hBmpMsk returns Integer External_FunctionEx ImageList_SetBkColor "ImageList_SetBkColor" ComCtl32.dll ; Handle hImageList DWord iRgb Returns DWord //External_functionEx ImageList_Create "ImageList_Create" COMCTL32.DLL ; // Integer iCx Integer iCy UInteger iFlags Integer cInitial Integer iGrow returns Handle External_FunctionEx ImageList_AddMasked "ImageList_AddMasked" ComCtl32.dll ; Handle hImageList Handle hBitmap DWord iRgb Returns Integer External_FunctionEx ImageList_Destroy "ImageList_Destroy" ComCtl32.dll ; Handle hImageList Returns Integer External_FunctionEx ImageList_GetImageCount "ImageList_GetImageCount" ComCtl32.dll ; Handle hImageList Returns Integer External_FunctionEx ImageList_Remove "ImageList_Remove" ComCtl32.dll ; Handle hImageList Integer iIndex Returns Integer External_FunctionEx ImageList_RemoveAll "ImageList_RemoveAll" ComCtl32.dll ; Handle hImageList Returns Integer #IF (!@ < 200) External_functionEx ILLoadImage "LoadImageA" user32.dll Handle hInst ; String sPic UInteger uTyp Integer iX Integer iY UInteger uFlag Returns Handle #ELSE External_functionEx ILLoadImage "LoadImageW" user32.dll Handle hInst ; WString sPic UInteger uTyp Integer iX Integer iY UInteger uFlag Returns Handle #ENDIF #IFDEF GET_MKLoadImage #ELSE #IF (!@ < 200) External_functionEx LoadImage "LoadImageA" user32.dll Handle hInst ; String sPic UInteger uTyp Integer iX Integer iY UInteger uFlag Returns Handle #ELSE External_functionEx LoadImage "LoadImageW" user32.dll Handle hInst ; WString sPic UInteger uTyp Integer iX Integer iY UInteger uFlag Returns Handle #ENDIF Function MKLoadImage Global String sBMPe Integer iX Integer iY returns Handle String sBMP Integer iIconStyle Handle hwnd move sBMPe to sBMP move IMAGE_BITMAP to iIconStyle // Std. if (Uppercase(Right(sBMP,3))) eq "ICO" move IMAGE_ICON to iIconStyle // Icon if (Uppercase(Right(sBMP,3))) eq "CUR" move IMAGE_CURSOR to iIconStyle // Cursor move (LoadImage(0,sBMP,iIconStyle,iX,iY,(LR_LOADFROMFILE + LR_CREATEDIBSECTION))) to hwnd Function_Return hwnd End_Function #ENDIF External_functionEx APIImageList_GetIconSize "ImageList_GetIconSize" COMCTL32.DLL ; Handle hImgLst Pointer piX Pointer piY Returns Integer // Extended ImageList allows to add Bitmaps after its creation. // And checks all added Bitmapt to prevent adding BMP's twice. Class cImageListEx is a DfObject Procedure Construct_Object Forward send Construct_Object Property Integer Private_piBackColor clNone // -1 Property Integer piMaxImages 0 Property Handle phImageList 0 Property Integer piImageWidth 16 Property Integer piImageHeight 16 Object oBmps is a set End_Object End_Procedure // For campatibility with the old Image_List class. Function Window_Handle Returns Integer Function_Return (phImageList(self)) End_Function Procedure set ImageList_Size Integer iImages set piMaxImages to iImages End_Procedure Procedure set Bitmap_Size Integer iY Integer iX set piImageHeight to iY set piImageWidth to iX End_Procedure Procedure ImageList_Create End_Procedure // Set and retrieve the BackColor. Procedure set piBackColor Integer iColor Handle hImageList Integer iVoid set Private_piBackColor to iColor get phImageList to hImageList if hImageList move (ImageList_SetBkColor(hImageList, iColor )) to iVoid End_Procedure Function piBackColor Returns Integer Function_Return (Private_piBackColor(self)) End_Function Procedure Destroy_Object Integer iVoid if (phImageList(self)) move (ImageList_Destroy(phImageList(self))) to iVoid Forward send Destroy_Object End_Procedure Function AddTransparentImage String sImage Integer iTransparentColor Returns Integer Handle hBitmap Integer iVoid iImage move -1 to iImage // assume inability to add Get_File_Path sImage to sImage // find path in DFPATH, if appropriate move (ILLoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) to hBitmap if hBitmap Begin move (ImageList_AddMasked(phImageList(self), hBitmap, iTransparentColor)) to iImage move (DeleteObject(hBitmap)) to iVoid End Function_Return iImage End_Function Function AddImage String sImage Returns Integer Handle hBitmap Integer iVoid iImage move -1 to iImage // assume inability to add Get_File_Path sImage to sImage // find path in DFPATH, if appropriate move (ILLoadImage(0, sImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) to hBitmap if hBitmap Begin move (ImageList_Add(phImageList(self), hBitmap,0)) to iImage move (DeleteObject(hBitmap)) to iVoid End Function_Return iImage End_Function Function ImageCount Returns Integer Handle hImageList Integer icImage move 0 to icImage get phImageList to hImageList if hImageList move (ImageList_GetImageCount(hImageList)) to icImage Function_Return icImage End_Function Procedure RemoveImage Integer iIndex Handle hImageList Integer bRemoved get phImageList to hImageList if hImageList move (ImageList_Remove(hImageList, iIndex)) to bRemoved End_Procedure Procedure RemoveAllImages Handle hImageList Integer bRemoved get phImageList to hImageList if hImageList move (ImageList_RemoveAll(hImageList)) to bRemoved End_Procedure // Creates the ImageList Procedure DoCreate Integer cx cy dwFlags icInitial iGrowBy get piImageHeight to cy get piImageWidth to cx get piMaxImages to iGrowBy if (piBackColor(Self)) eq clNone move (ILC_Color24) to dwFlags Else move (ILC_COLOR4 +ILC_MASK) to dwFlags set phImageList to (ImageList_Create(cx, cy, dwFlags, 0, iGrowBy)) End_Procedure // Returns the nr of the Bmp. Function BitmapNr String sBmp returns Integer Integer iC get Find_Element of (oBmps(Self)) sBmp to iC Function_Return iC End_Function Procedure RegisterBmp String sBmp Integer iC get BitMapNr sBmp to iC if iC lt 0 get Item_Count (oBmps(Self)) to iC set value of (oBmps(Self)) item iC to sBmp End_Procedure // Returns the Size of the ImageList Bmps. Function BitmapSize returns Integer Handle hwnd Integer iX iY iRet String sX String sY get Window_Handle to hwnd if hwnd Begin Move (Repeat(Character(0),4)) to sX Move (Repeat(Character(0),4)) to sY move (APIImageList_GetIconSize(hwnd,AddressOf(sX),AddressOf(sY))) to iRet if iRet ne 0 Begin move (BytesToDword(sX,1)) to iX move (BytesToDWord(sY,1)) to iY Function_Return (iX+(65536*iY)) End End Function_Return 0 End_Function Procedure ImageList_Add String sBmp Integer iC Forward send ImageList_Add sBmp End_Procedure Procedure ImageListEx_Add String sBmp Integer iTransParentColorE Integer iX iY iC iRet iTransParentColor Handle hwnd hBmp if Num_Arguments gt 1 move iTransParentColorE to iTransParentColor Else move -1 to iTransParentColor Get_File_Path sBmp to sBmp if sBmp eq "" Function_Return -1 get BitmapNr sBmp to iC if iC ge 0 Procedure_Return iC get Window_Handle to hwnd // is the ImageList Handle if hwnd Begin // Already created if iTransParentColor lt 0 move (AddImage(Self,sBmp)) to iRet Else move (AddTransparentImage(Self,sBmp,iTransParentColor)) to iRet if iRet ge 0 set value of (oBmps(Self)) item iRet to sBmp End Else send ImageList_Add sBmp // not created yet the BMP can added as usual. Procedure_Return (BitMapNr(Self,sBmp)) End_Procedure Procedure OnCreate End_Procedure Procedure End_Construct_Object Integer iVoid send DoCreate send OnCreate set piBackColor to (Private_piBackColor(self)) Forward send End_Construct_Object End_Procedure End_Class