Sub Item_FontSelectCombo.Destroy() ID = "" : Title = "" DestroyWindow(whwnd) iCount = 0 : iState = 0 wSizeMode = 0 : hSizeMode = 0 iWidth = 0 : iHeight = 0 End Sub ''Callback Function EnumFontFamiliesExProc(byval lpelfe as ENUMLOGFONTEX ptr, byval lpntme as NEWTEXTMETRICEX ptr, byval FontType as Integer, byval lParam as LPARAM) as Integer If (FontType and TRUETYPE_FONTTYPE)=TRUETYPE_FONTTYPE andalso bit(lpntme->ntmTm.ntmFlags,6) Then 'Print "Typ : TrueType-Font"; If lpelfe->elfLogFont.lfFaceName[0]<>64 Then AddFontSelectCombo(Cast(Item,lParam), lpelfe->elfLogFont.lfFaceName) End If return 1 End Function Function CreateFontSelectCombo(byref ItemHandle as Item, byval px as Integer, byval py as Integer, byval iWidth as Integer = 0, byval iHeight as Integer = 0) as Item Dim as UInteger ExStyle = WS_EX_CLIENTEDGE Dim as UInteger Style = WS_CHILD OR WS_VSCROLL OR CBS_AUTOHSCROLL OR CBS_DROPDOWNLIST OR CBS_HASSTRINGS OR WS_TABSTOP OR WS_CLIPSIBLINGS OR CBS_NOINTEGRALHEIGHT OR CBS_OWNERDRAWVARIABLE If (ItemHandle = 0) Then return NULL Dim as RECT prect Dim as HWND phwnd Dim as Integer rx, ry If (ItemHandle -> ID = WindowID) Then phwnd = ItemHandle -> whwnd rx = px : ry = py ElseIf (ItemHandle -> ID = GroupBoxID) Then phwnd = GetParent(ItemHandle -> whwnd) GetClientRect(ItemHandle -> whwnd, @prect) MapWindowPoints(ItemHandle -> whwnd, phwnd, Cast(LPPOINT, @prect),2) rx = prect.left + px : ry = prect.top + py Else LOGSTRING(Time & " | ERROR | Parent is not an valid Item.") Return NULL End If Dim as Item_FontSelectCombo ptr newFontSelectCombo = new Item_FontSelectCombo newFontSelectCombo -> whwnd = CreateWindowEx(ExStyle, "COMBOBOX", NULL, Style, rx, ry, iWidth, iHeight, phwnd, NULL, Globals.hInstance, newFontSelectCombo) If (newFontSelectCombo -> whwnd = 0) Then Delete newFontSelectCombo LOGSTRING(Time & " | ERROR | Failed to create " & FontSelectComboID) MessageBox(NULL,"Failed to create " & FontSelectComboID, "Error", NULL) Return NULL End If SetWindowLongPtr(newFontSelectCombo -> whwnd, GWLP_USERDATA, Cast(LONG_PTR, newFontSelectCombo)) newFontSelectCombo -> ID = FontSelectComboID newFontSelectCombo -> Title = str(newFontSelectCombo -> whwnd) newFontSelectCombo -> wSizeMode = IIF(iWidth,0,1) newFontSelectCombo -> hSizeMode = IIF(iHeight,0,1) newFontSelectCombo -> iWidth = iWidth newFontSelectCombo -> iHeight = iHeight newFontSelectCombo -> iState = 0 '- Enum/Add List Dim as HDC hDC = GetDC(NULL) Dim as LOGFONT lf lf.lfCharSet = ANSI_CHARSET'DEFAULT_CHARSET EnumFontFamiliesEx( hDC, @lf, cast(any ptr,@EnumFontFamiliesExProc), Cast(LPARAM,newFontSelectCombo), NULL ) ReleaseDC(NULL, hDC) '- LOGSTRING(Time & " | INFO | " & FontSelectComboID & " " & newFontSelectCombo -> Title & " created on " & ItemHandle -> ID & " " & ItemHandle -> Title & ".") Globals.ItemList.AddItem(newFontSelectCombo) return newFontSelectCombo End Function Function AddFontSelectCombo(byref ItemHandle as Item, byval FontName as String) as Integer If (ItemHandle = 0) orelse (ItemHandle -> ID <> FontSelectComboID) Then return -1 Dim as Item_FontSelectCombo ptr FontComboItem = Cast(Item_FontSelectCombo ptr, ItemHandle) Dim as Integer expand, iWidth, iHeight, ListHeight Dim as RECT wRECT, cRECT Dim as HDC dDC = GetDC(NULL) Dim as HDC fDC = CreateCompatibleDC(dDC) Dim as LOGFONT lf Dim as HFONT fnt Dim as SIZE fSize Dim as String SubItemID lf.lfFaceName = FontName fnt = CreateFontIndirect(@lf) SelectObject(fDC,fnt) GetTextExtentPoint32(fDC,FontName,len(FontName),@fSize) DeleteObject(fnt) DeleteDC(fDC) ReleaseDC(NULL,dDC) expand = GetSystemMetrics(SM_CXVSCROLL)*1.25 expand += GetSystemMetrics(SM_CXEDGE)*4 iWidth = fSize.CX + expand iHeight = IIF(fSize.CY>255,255,fSize.CY) If FontComboItem -> wSizeMode andalso iWidth > FontComboItem -> iWidth Then FontComboItem -> iWidth = iWidth If FontComboItem -> hSizeMode andalso iHeight > FontComboItem -> iHeight Then FontComboItem -> iHeight = iHeight GetClientRect(GetParent(FontComboItem -> whwnd), @wRECT) GetClientRect(FontComboItem -> whwnd, @cRECT) ListHeight = (wRECT.bottom - wRECT.top) MapWindowPoints(ItemHandle -> whwnd, GetParent(ItemHandle -> whwnd), Cast(LPPOINT, @wRECT),2) ListHeight = ListHeight - (cRECT.bottom-cRECT.top) If ((FontComboItem -> iCount+3) * FontComboItem -> iHeight) < ListHeight Then ListHeight = ((FontComboItem -> iCount+3) * FontComboItem -> iHeight) FontComboItem -> iCount += 1 SubItemID = FontName SendMessage(FontComboItem -> whwnd, CB_ADDSTRING, NULL, cast(LPARAM,strptr(SubItemID))) If SendMessage(FontComboItem -> whwnd, CB_GETCURSEL, NULL, NULL) = -1 Then SendMessage(FontComboItem -> whwnd, CB_SETCURSEL, Cast(WPARAM, 0), NULL) MapWindowPoints(FontComboItem -> whwnd, GetParent(FontComboItem -> whwnd), Cast(LPPOINT,@cRECT),2) MoveWindow(FontComboItem -> whwnd, cRECT.left, cRECT.top, FontComboItem -> iWidth, ListHeight, TRUE) SendMessage(FontComboItem -> whwnd, CB_SETITEMHEIGHT, -1, FontComboItem -> iHeight) SendMessage(FontComboItem -> whwnd, CB_SETITEMHEIGHT, FontComboItem -> iCount - 1, iHeight) If FontComboItem -> iState = FALSE Then ShowWindow(FontComboItem -> whwnd, SW_SHOW) FontComboItem -> iState = TRUE End If End Function