File "Icon.inc"

Path: /ShuffleGUI/inc/Icon.inc
File size: 4.66 KB
MIME-type:
Charset: utf-8

'------------------------------------------------------------------------------
' This is the "Icon.inc" include file for PBWin9
' It contains routines to display icons in controls or dialog caption bar
' Prototypes:
'   DECLARE SUB DialogSetIconFile(BYVAL hDlg AS DWORD, BYVAL icoFile AS STRING)
'   DECLARE SUB ImgbuttonSetIconFile(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, _
'               BYVAL icoFile AS STRING, BYVAL icoW AS LONG, BYVAL icoH AS LONG
'   DECLARE SUB GraphicDrawIconDll(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, _
'               BYVAL dllName AS STRING, BYVAL dllCnt AS LONG, _
'               BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG)
'   DECLARE SUB GraphicDrawIconFile(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, BYVAL icoFile AS STRING, _
'               BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG)
'   DECLARE SUB ConvertIco(BYVAL imgFile AS STRING)
'   DECLARE FUNCTION SearchForIco(BYVAL fpath AS STRING) AS STRING
'------------------------------------------------------------------------------
'#INCLUDE ONCE "Win32Api.inc"
'#INCLUDE ONCE "RunCmd.inc"

'------------------------------------------------------------------------------
SUB DialogSetIconFile(BYVAL hDlg AS DWORD, BYVAL icoFile AS STRING)
    STATIC hIconBig   AS DWORD
    STATIC hIconSmall AS DWORD

    IF hIconBig THEN DestroyIcon(hIconBig)
    IF hIconSmall THEN DestroyIcon(hIconSmall)

    ExtractIconEx((icoFile), 0, BYVAL VARPTR(hIconBig), BYVAL VARPTR(hIconSmall), 1)

    SetClassLong(hDlg, %GCL_HICONSM, hIconSmall)
    SetClassLong(hDlg, %GCL_HICON, hIconBig)

    SendMessage(hDlg, %WM_SETICON, %ICON_SMALL, hIconSmall)
    SendMessage(hDlg, %WM_SETICON, %ICON_BIG, hIconBig)
END SUB
'------------------------------------------------------------------------------
SUB ImgbuttonSetIconFile(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, _
    BYVAL icoFile AS STRING, BYVAL icoW AS LONG, BYVAL icoH AS LONG)
    LOCAL hIcon AS DWORD

    hIcon = LoadImage(0, BYVAL STRPTR(icoFile), %IMAGE_ICON, icoW, icoH, %LR_LOADFROMFILE)
    SendMessage(GetDlgItem(hDlg,iCtl), %BM_SETIMAGE, %IMAGE_ICON, hIcon)
END SUB
'------------------------------------------------------------------------------
SUB GraphicDrawIconDll(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, _
    BYVAL dllName AS STRING, BYVAL dllCnt AS LONG, _
    BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG)
    LOCAL hLst AS DWORD
    LOCAL hIco AS DWORD

    IMAGELIST NEW ICON w, h, 32, 1 TO hLst
    hIco = EXTRACTICON(GetModuleHandle(""), (dllName), dllCnt)
    IMAGELIST ADD ICON hLst, hIco
    GRAPHIC ATTACH hDlg, iCtl
    GRAPHIC IMAGELIST (x,y), hLst, 1, 0, %ILD_TRANSPARENT
END SUB
'------------------------------------------------------------------------------
SUB GraphicDrawIconFile(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG, BYVAL icoFile AS STRING, _
    BYVAL x AS LONG, BYVAL y AS LONG, BYVAL w AS LONG, BYVAL h AS LONG)
    LOCAL hLst AS DWORD
    LOCAL hIco AS DWORD

    IMAGELIST NEW ICON w, h, 32, 1 TO hLst
    hIco = LOADIMAGE(0, icoFile+CHR$(0), %IMAGE_ICON, w, h, %LR_LOADFROMFILE)
    IMAGELIST ADD ICON hLst, hIco
    GRAPHIC ATTACH hDlg, iCtl : GRAPHIC CLEAR
    GRAPHIC IMAGELIST (x,y), hLst, 1, 0, %ILD_NORMAL
END SUB
'------------------------------------------------------------------------------
FUNCTION IsImageMagickInstalled() AS LONG
    LOCAL r AS STRING
    r = DUMP_CMD("magick convert -version")
    FUNCTION = INSTR(r, "ImageMagick")
END FUNCTION
'------------------------------------------------------------------------------
SUB ConvertIco(BYVAL imgFile AS STRING)
 LOCAL r AS STRING
 LOCAL i AS LONG

 IF ISFALSE IsImageMagickInstalled() THEN EXIT SUB

 ' Prepare command to convert to .ico
 r  = "magick convert " + $DQ + imgFile + $DQ
    r += " -define png:color-type=6 icon:auto-resize"
    r += "=16,24,32,48,64,72,96,128,256 "
 i = INSTR(-1, imgFile, ".")
 imgFile = LEFT$(imgFile, i) + "ico"
 r += $DQ + imgFile + $DQ

 ' Delete icon if it already exists
 IF EXISTS(imgFile) THEN KILL imgFile

 ' Create icon
 r = DUMP_CMD(r)
END SUB
'------------------------------------------------------------------------------
FUNCTION SearchForIco(BYVAL fpath AS STRING) AS STRING
 IF  EXISTS (fpath + ".ico") THEN
  FUNCTION = fpath + ".ico"
  EXIT FUNCTION
 END IF

 IF     EXISTS(fpath + ".jpg")  THEN
    ConvertIco(fpath + ".jpg")
 ELSEIF EXISTS(fpath + ".jpeg") THEN
    ConvertIco(fpath + ".jpeg")
 ELSEIF EXISTS(fpath + ".png")  THEN
    ConvertIco(fpath + ".png")
 ELSEIF EXISTS(fpath + ".bmp")  THEN
    ConvertIco(fpath + ".bmp")
 END IF

 IF EXISTS(fpath + ".ico") THEN FUNCTION = fpath + ".ico" ELSE FUNCTION = "!"
END FUNCTION
'------------------------------------------------------------------------------