//***************************************************************************************** // 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 Integer iRgb Returns Integer External_functionEx ImageList_Create "ImageList_Create" COMCTL32.DLL ; Integer iCx Integer iCy Integer iFlags Integer cInitial Integer iGrow returns Integer External_FunctionEx ImageList_AddMasked "ImageList_AddMasked" ComCtl32.dll ; Handle hImageList Handle hBitmap Integer iRgb Returns Integer External_FunctionEx ImageList_Create "ImageList_Create" ComCtl32.dll ; Integer cx Integer cy Integer dwFlags Integer icInitial Integer iGrowBy Returns Handle External_FunctionEx ImageList_Destroy "ImageList_Destroy" ComCtl32.dll ; Integer hImageList Returns Integer External_FunctionEx ImageList_GetImageCount "ImageList_GetImageCount" ComCtl32.dll ; Integer hImageList Returns Integer External_FunctionEx ImageList_Remove "ImageList_Remove" ComCtl32.dll ; Integer hImageList Integer iIndex Returns Integer External_FunctionEx ImageList_RemoveAll "ImageList_RemoveAll" ComCtl32.dll ; Integer hImageList Returns Integer External_functionEx ILLoadImage "LoadImageA" user32.dll ; Handle hInst String sPic Integer iTyp Integer iX Integer iY Integer iFlag returns Integer #IFDEF GET_MKLoadImage #ELSE External_functionEx LoadImage "LoadImageA" user32.dll Handle hInst Pointer pPic Integer iTyp Integer iX Integer iY Integer iFlag returns Integer Function MKLoadImage Global String sBMPe Integer iX Integer iY returns Handle String sBMP Pointer pBMP Integer iIconStyle Handle hwnd move sBMPe to sBMP GetAddress of sBMP to pBMP 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,pBMP,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 Integer 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 Integer hImageList 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 Integer hImageList 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 Integer hImageList bRemoved get phImageList to hImageList if hImageList move (ImageList_Remove(hImageList, iIndex)) to bRemoved End_Procedure Procedure RemoveAllImages Integer hImageList 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 Local_Buffer sX pX 4 Local_Buffer sY pY 4 get Window_Handle to hwnd if hwnd Begin move (APIImageList_GetIconSize(hwnd,pX,pY)) 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