GetProcAddress using ordinal...

[airr]

Refactored things, using an include file now to provide the darkmode stuff and HANDLE_MSG.

See attached file for source.

AIR.

[airr]

Worked on Statusbar this evening.  Still need to work out how to make the size grip transparent, and how to address Statusbar parts/sections.

Code Select Expand

GUI "DarkMode_Demo"

$BCX_RESOURCE
1 24 "dark.exe.manifest"
$BCX_RESOURCE

CONST DWMWA_USE_IMMERSIVE_DARK_MODE = 20

ENUM
   Default = 0
   AllowDark
   ForceDark
   ForceLight
   eMax
END ENUM

ENUM
    mnuNew = 9000
    mnuOpen
    mnuSave
    mnuCut
    mnuCopy
    mnuPaste
    mnuUNDO
    mnuREDO
    mnuSELECTALL
    mnuAbout
    mnuEXIT
END ENUM

DIM Form1    AS CONTROL
DIM Stat1    AS CONTROL
DIM Button1  AS CONTROL
DIM Combo1   AS CONTROL
DIM Edit1    AS CONTROL
DIM Label1   AS CONTROL


DIM MainMenu AS HMENU
DIM FileMenu AS HMENU


SUB FORMLOAD
    Form1 = BCX_FORM("Dark Mode Sample",0, 0, 315, 260)

    AddMenu(Form1)

    Stat1 = BCX_STATUS("", Form1, 6000)
    Button1 = BCX_BUTTON("Button 1", Form1, 102,  100,  5,  40,  12)
   
    Combo1 = BCX_COMBOBOX("BLAH",Form1, 103, 5,5,90,60)
    Edit1 = BCX_INPUT("Text Input", Form1, 104, 5, 20, 90, 10)
    Label1 = BCX_LABEL("This is a Label",Form1,105,5,35,90,10)

    IF InitDarkMode(Form1) THEN SetDarkMode(Form1)
   
    SendMessage(Combo1, CB_ADDSTRING, 0, TEXT("Item One"))     
    SendMessage(Combo1, CB_ADDSTRING, 0, TEXT("Item Two"))   
    SendMessage(Combo1, CB_SETCURSEL, 1, 0)

    ' SET STATUSBAR TEXT
    SetStatusText(Stat1, "This is a Status Bar")

    CENTER(Form1)
    SHOW(Form1)
END SUB


BEGIN EVENTS

    SELECT CASE CBMSG

        CASE WM_SIZE
            SendMessage(Stat1, WM_SIZE, 0, 0)

        '***************************** D A R K  M O D E ******************************
        CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR
        '*****************************************************************************
            SetBkColor((HDC)wParam, darkBkColor)
            SetTextColor((HDC)wParam, darkTextColor)
            FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)


        CASE WM_MEASUREITEM:

            DIM AS LPMEASUREITEMSTRUCT itemStruct = (LPMEASUREITEMSTRUCT)lParam;
            DIM AS LPSTR str = (LPSTR)(itemStruct->itemData)
            DIM AS SIZE strSize
            DIM AS HDC hDC = GetDC(hWnd)         
            GetTextExtentPoint32(hDC, str, LEN(str), &strSize)
            itemStruct->itemWidth = strSize.cx
            itemStruct->itemHeight = 30
            ReleaseDC(hWnd, hDC)

            FUNCTION =  TRUE

        CASE WM_DRAWITEM:
            DIM AS LPDRAWITEMSTRUCT itemStruct = (LPDRAWITEMSTRUCT)lParam;
            DIM AS HDC hDC = itemStruct->hDC

            ' SET COLOR SCHEME FOR OWNER-DRAWN OBJECTS
            SetTextColor(hDC, darkTextColor)
            SetBkMode(hDC, TRANSPARENT)

            ' MENUBAR
            IF itemStruct->CtlType = ODT_MENU THEN
                DrawText(hDC, (LPSTR)(itemStruct->itemData), -1, &(itemStruct->rcItem), DT_SINGLELINE | DT_VCENTER | DT_CENTER)
                FUNCTION = TRUE
            END IF

            ' STATUSBAR
            IF itemStruct->CtlID == 6000 THEN
                itemStruct->rcItem.left+=6 'PADDING FOR LEFT OF RECT
                DrawText(hDC, (LPSTR)(itemStruct->itemData), -1, &itemStruct->rcItem, DT_VCENTER | DT_SINGLELINE)
                FUNCTION = TRUE
            END IF
        '***************************** D A R K  M O D E ******************************
    END SELECT
END EVENTS

'================= D A R K  M O D E ===================


FUNCTION InitDarkMode(hWnd AS HWND)
    #include <uxtheme.h>
    #include <dwmapi.h>
    $PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
    $PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

    $TYPEDEF INT (WINAPI *TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI *TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI *TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI *TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI *TRefreshImmersiveColorPolicyState)()

    GLOBAL AS COLORREF darkBkColor = 0x383838
    GLOBAL AS COLORREF darkTextColor = 0xFFFFFF

    GLOBAL ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
    GLOBAL AllowDarkModeForWindow           AS TAllowDarkModeForWindow
    GLOBAL SetPreferredAppMode              AS TSetPreferredAppMode
    GLOBAL FlushMenuThemes                  AS TFlushMenuThemes
    GLOBAL RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState
    GLOBAL FHandle AS HMODULE

    FHandle = LOAD_DLL("uxtheme.dll")
    IF FHandle THEN
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    END IF

    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd, TRUE)
    SetPreferredAppMode(2)

    RefreshImmersiveColorPolicyState()
    FlushMenuThemes()
    SetWindowTheme(hWnd, UCODE$("Dark_Explorer"), NULL)
    SetPreferredAppMode(2)
    BCX_SET_FORM_COLOR(hWnd, darkBkColor)
    ' I know this is a weak validation but it's something
    IF FHandle THEN FUNCTION = TRUE ELSE FUNCTION = FALSE
END FUNCTION



SUB SetDarkMode(obj AS HWND)
    DIM ClassName$ * BCXSTRSIZE
    DIM ThemeClass$
    DIM child AS HWND

    child = GetWindow(obj, GW_CHILD)   ' begin enumeration
    DO WHILE child <> NULL
        GetClassName(child, ClassName$, BCXSTRSIZE)
        ' MSGBOX(ClassName)
        SELECT CASE TRIM$(ClassName$)

            CASE "SysListView32"
            DIM AS HWND hHeader = ListView_GetHeader(child)
            ThemeClass$ = "Explorer"
            SetWindowTheme(hHeader, UCODE$("Dark_Explorer"), NULL)
            AllowDarkModeForWindow(hHeader, TRUE)
            ListView_SetTextColor(child, darkTextColor)
            ListView_SetBkColor(child, darkBkColor)
            ListView_SetExtendedListViewStyle(child, LVS_EX_TRANSPARENTBKGND)

            CASE "ComboBox"
            ThemeClass$ = "CFD"

            ' IN ORDER TO BE ABLE TO ALTER THE STATUSBAR COLORS
            ' WE FIRST NEED TO DISABLE THEMING FOR THE STATUSBAR
            CASE STATUSCLASSNAME
                ThemeClass$ = ""
                SetWindowTheme(child, UCODE$(ThemeClass$),  UCODE$(""))
                SendMessage(child, SB_SETBKCOLOR, 0, darkBkColor)
                child = GetWindow(child, GW_HWNDNEXT)
                ITERATE

            CASE ELSE
            ThemeClass$ = "Explorer"
        END SELECT

        SetWindowTheme(child, UCODE$(ThemeClass$),  NULL)
        AllowDarkModeForWindow(child, TRUE)
        SendMessage(child, WM_THEMECHANGED, 0, 0)
        child = GetWindow(child, GW_HWNDNEXT)
    LOOP
END SUB


SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB

' FUNCTION TO SET THE MENUBAR BACKGROUND COLOR
SUB SetMenuBarColor(menu AS HMENU, color AS COLORREF)
    DIM AS MENUINFO mi
    mi.cbSize = sizeof(MENUINFO)
    GetMenuInfo(menu, &mi)
    mi.fMask = MIM_BACKGROUND
    mi.hbrBack = CreateSolidBrush(color)
    SetMenuInfo(menu, &mi)
END SUB

' FUNCTION TO SET STATUSBAR TEXT SPECIFYING
' THAT THE TEXT IS SET USING SBT_OWNERDRAW
' TO ENABLE THE DARK COLOR SCHEME
SUB SetStatusText(stat as HWND, text$)
    SendMessage(stat, SB_SETTEXT, SBT_OWNERDRAW, text$)
END SUB

'================= D A R K  M O D E ===================


SUB AddMenu(parent as HWND)
    MainMenu = CreateMenu()
   
    SetMenuBarColor(MainMenu, darkBkColor)
    FileMenu = CreateMenu()

    InsertMenu(MainMenu,  0, MF_OWNERDRAW | MF_POPUP, FileMenu, "&File")
    AppendMenu(FileMenu, MF_STRING, mnuNew, E"New\tCtrl-N")
    AppendMenu(FileMenu, MF_STRING, mnuOpen, E"Open\tCtrl-O")
    AppendMenu(FileMenu, MF_STRING, mnuSave, E"Save\tCtrl-S")
    AppendMenu(FileMenu, MF_SEPARATOR, 0, NULL)
    AppendMenu(FileMenu, MF_STRING, mnuEXIT, E"Exit\tAlt-F4")


    SetMenu(parent, MainMenu)
END SUB



[djsb]

 

[MrBcx]

AIR - You have the magic touch!

I tried doing that but I kept over-thinking it.  I'm a late devotee to
dark mode but aging eyes made me appreciate DM more than ever.

Thanks again for another reusable gem.

[airr]

I also tried various approaches to getting the menubar to go 'dark', with no success.

Decided to just do an owner-drawn menu instead:

Code Select Expand

' *****************************************************
' Program Name: Amort.Bas  by MrBcx
' Modified to demonstrate new DARK MODE capability
' STATUS: >> DARK MODE partially working
' Dark Mode mods by Armando Rivera & MrBcx
' *****************************************************

'================= D A R K  M O D E ===================
' MrBcx moved the Dark Mode Support to FUNCTION InitDarkMode
'================= D A R K  M O D E ===================

GUI "Amort"
CONST ID_LV = 1001   ' Added for LV sort support
GLOBAL SortOrder     ' Added for LV sort support

SUB FORMLOAD
    GLOBAL Form1   AS CONTROL
    GLOBAL Input1  AS CONTROL
    GLOBAL Input2  AS CONTROL
    GLOBAL Input3  AS CONTROL
    GLOBAL Label1  AS CONTROL
    GLOBAL Label2  AS CONTROL
    GLOBAL Label3  AS CONTROL
    GLOBAL Label4  AS CONTROL
    GLOBAL Label5  AS CONTROL
    GLOBAL Label6  AS CONTROL
    GLOBAL Button1 AS CONTROL
    GLOBAL LView1  AS CONTROL
    '******************************************************************************
    Form1   = BCX_FORM     ("Amortization by MrBCX", 0, 0, 165, 230)
    Input1  = BCX_INPUT    (   "350,000"    , Form1, 0, 105, 5, 46, 14)
    Input2  = BCX_INPUT    (   "6.50"       , Form1, 0, 105, 20, 46, 14)
    Input3  = BCX_INPUT    (     "30"       , Form1, 0, 105, 35, 46, 14)
    BCX_LABEL              ("Loan Amount"   , Form1, 0, 10, 7, 45, 11)
    BCX_LABEL              ("Interest Rate" , Form1, 0, 10, 22, 45, 11)
    BCX_LABEL              ("No. of Years"  , Form1, 0, 10, 37, 45, 11)
    Label1  = BCX_LABEL    (  "Principal"   , Form1, 0, 10, 52, 40, 14)
    Label2  = BCX_LABEL    (  "Interest"    , Form1, 0, 10, 65, 40, 14)
    Label3  = BCX_LABEL    (  "Payment"     , Form1, 0, 10, 78, 40, 14)
    Label4  = BCX_LABEL    (     ""         , Form1, 0, 60, 52, 40, 14)
    Label5  = BCX_LABEL    (     ""         , Form1, 0, 60, 65, 40, 14)
    Label6  = BCX_LABEL    (     ""         , Form1, 0, 60, 78, 40, 14)
    Button1 = BCX_BUTTON   (   "Calc"       , Form1, 101, 105, 52, 45, 14)
    LView1  = BCX_LISTVIEW (     ""         , Form1, ID_LV, 5, 95, 150, 123)
    '******************************************************************************



    '========================================================================
    '   Menus don't do anything - they're for developing DARK MODE
    '========================================================================
    GLOBAL MainMenu AS HMENU
    GLOBAL FileMenu AS HMENU

    MainMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE
    FileMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE

    '========================================================================
    '                     Build the File Menu First
    '========================================================================
    AppendMenu(FileMenu, MF_STRING   , 111, "&Open")
    AppendMenu(FileMenu, MF_STRING   , 222, "&Close")
    AppendMenu(FileMenu, MF_STRING   , 333, "&Save")
    AppendMenu(FileMenu, MF_STRING   , 444, "Save&As")
    AppendMenu(FileMenu, MF_SEPARATOR, 0, "")
    AppendMenu(FileMenu, MF_STRING   , 555, "E&xit")
    '========================================================================
    '                        Build the Main Menu Next
    '========================================================================
    AppendMenu ( MainMenu , MF_OWNERDRAW | MF_POPUP , 666, "Edit")
    AppendMenu ( MainMenu , MF_OWNERDRAW | MF_POPUP , 777, "Options")
    '========================================================================
    '                  Attach the File menu to the main menu
    '========================================================================
    InsertMenu (MainMenu, 666 , MF_OWNERDRAW | MF_POPUP , FileMenu , "File")
    '========================================================================
    SetMenuBarColor(MainMenu, darkBkColor)
    SetMenu(Form1, MainMenu)              ' Activate the menu

    '================= D A R K  M O D E ===================

    if InitDarkMode(Form1) then SetDarkMode(Form1)

    '================= D A R K  M O D E ===================


    BCX_SET_FORM_COLOR(Form1, darkBkColor)
    MODSTYLE(Form1, 0, WS_SIZEBOX | WS_MAXIMIZEBOX) ' Remove size and max boxes

    Set_ColumnText (LView1, 0, "Payment")
    Set_ColumnText (LView1, 1, "Interest")
    Set_ColumnText (LView1, 2, "Principal")
    Set_ColumnText (LView1, 3, "Balance")

    CENTER Form1
    SHOW   Form1
END SUB



BEGIN EVENTS
    SELECT CASE CBMSG
        '*****************************************************************************
        CASE WM_COMMAND
        '*****************************************************************************
        IF CBCTL = 555 THEN PostQuitMessage(0)

        IF CBCTL = 101 THEN     ' CALC Button Clicked
            FillListView()
            SortOrder = 3
            SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
            UpdatelParam (LView1)
            EXIT FUNCTION
        END IF

        '*****************************************************************************
        CASE WM_NOTIFY      ' Are we talking to the ListView control?
        '*****************************************************************************
        DIM plParam AS LPNMHDR
        DIM lvParam AS LPNM_LISTVIEW

        plParam = (LPNMHDR)lParam

        IF plParam->idFrom = ID_LV THEN                 ' Yes -- Our Listview has focus
            IF plParam->code = LVN_COLUMNCLICK THEN     ' User clicked column header -- wants to sort
                lvParam = (LPNM_LISTVIEW)lParam

                SELECT CASE lvParam->iSubItem           ' Which column was clicked?
                    CASE 1
                    IF SortOrder = 0 OR SortOrder = 4 THEN SortOrder = 3 ELSE SortOrder = 4

                    CASE 2
                    IF SortOrder = 0 OR SortOrder = 6 THEN SortOrder = 5 ELSE SortOrder = 6

                    CASE 3
                    IF SortOrder = 0 OR SortOrder = 8 THEN SortOrder = 7 ELSE SortOrder = 8

                    CASE 4
                    IF SortOrder = 0 OR SortOrder = 10 THEN SortOrder = 9 ELSE SortOrder = 10

                    CASE ELSE
                    IF SortOrder = 0 OR SortOrder = 2 THEN SortOrder = 1 ELSE SortOrder = 2
                END SELECT

                SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
                UpdatelParam (LView1)
            END IF
        END IF

        '***************************** D A R K  M O D E ******************************
        CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR
        '*****************************************************************************
        SetBkColor((HDC)wParam, darkBkColor)
        SetTextColor((HDC)wParam, darkTextColor)
        FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)
        '***************************** D A R K  M O D E ******************************

        CASE WM_CLOSE
        CALL DarkModeFreeLibrary

        CASE WM_MEASUREITEM:

            DIM AS LPMEASUREITEMSTRUCT itemStruct = (LPMEASUREITEMSTRUCT)lParam;
            DIM AS LPSTR str = (LPSTR)(itemStruct->itemData)
            DIM AS SIZE strSize
            DIM AS HDC hDC = GetDC(hWnd)         
            GetTextExtentPoint32(hDC, str, lstrlen(str), &strSize)
            itemStruct->itemWidth = strSize.cx
            itemStruct->itemHeight = 30
            ReleaseDC(hWnd, hDC)

            FUNCTION =  TRUE

        CASE WM_DRAWITEM:
            DIM AS LPDRAWITEMSTRUCT itemStruct = (LPDRAWITEMSTRUCT)lParam;
            DIM AS HDC hDC = itemStruct->hDC
            SetTextColor(hDC, darkTextColor)
            SetBkMode(hDC, TRANSPARENT)

            DrawText(hDC, (LPSTR)(itemStruct->itemData), -1, &(itemStruct->rcItem), DT_SINGLELINE | DT_VCENTER | DT_CENTER)

            FUNCTION = TRUE
    END SELECT
END EVENTS




SUB FillListView
    '=============================
    DIM  Amount       AS DOUBLE
    DIM  Interest     AS DOUBLE
    DIM  Years        AS DOUBLE
    DIM  Paymnt       AS DOUBLE
    DIM  Int_Payment  AS DOUBLE
    DIM  Prin_Payment AS DOUBLE
    DIM  Mon_Payment  AS DOUBLE
    DIM  SumPrinc     AS DOUBLE
    DIM  SumInt       AS DOUBLE
    DIM  z            AS LONG
    '=============================
    Amount   = VAL(RETAIN$(BCX_GET_TEXT$(Input1), ".0123456789"))
    Interest = VAL(BCX_GET_TEXT$(Input2))
    Years    = VAL(BCX_GET_TEXT$(Input3))
    Paymnt   = PMT(Interest, Years*12, Amount, 0)

    Mon_Payment = Paymnt

    BCX_LV_Reset (LView1, 4, Years * 12)

    Set_ColumnText(LView1, 0, "Payment  ")
    Set_ColumnText(LView1, 1, "Interest ")
    Set_ColumnText(LView1, 2, "Principal")
    Set_ColumnText(LView1, 3, "Balance  ")

    FOR z = 1 TO Years * 12
        Int_Payment = INTEREST_PAYMENT(Interest, Amount)
        Prin_Payment = Paymnt - Int_Payment
        SumPrinc = SumPrinc + Prin_Payment
        SumInt   = SumInt   + Int_Payment
        ListView_SetItemText (LView1, z-1, 0, STR$(z))
        ListView_SetItemText (LView1, z-1, 1, USING$("###.##", Int_Payment))
        ListView_SetItemText (LView1, z-1, 2, USING$("###.##", Prin_Payment))
        Amount = Amount - Prin_Payment
        ListView_SetItemText (LView1, z-1, 3, USING$("###.##", Amount))
    NEXT

    ListView_SetItemText (LView1, z, 3, " ")  ' add a line at the bottom

    FOR z = 0 TO 3
        SendMessage (LView1, LVM_SETCOLUMNWIDTH, z, LVSCW_AUTOSIZE_USEHEADER)
    NEXT

    BCX_LV_Justify (LView1, 0, HDF_CENTER)
    BCX_LV_Justify (LView1, 1, HDF_RIGHT)
    BCX_LV_Justify (LView1, 2, HDF_RIGHT)
    BCX_LV_Justify (LView1, 3, HDF_RIGHT)

    BCX_SET_TEXT (Label4, USING$("###.##", SumPrinc))
    BCX_SET_TEXT (Label5, USING$("###.##", SumInt))
    BCX_SET_TEXT (Label6, USING$("###.##", Mon_Payment))
END SUB



FUNCTION INTEREST_PAYMENT (i AS DOUBLE, Balance AS DOUBLE) AS DOUBLE
    FUNCTION = (i/12/100) * Balance
END FUNCTION




FUNCTION PMT (i AS DOUBLE, np AS DOUBLE, pv AS DOUBLE, fv AS DOUBLE) AS DOUBLE
    DIM RAW q1 AS DOUBLE
    DIM RAW ir AS DOUBLE
    ir = i/12/100
    q1 = POW (1 + ir, np)
    FUNCTION = ((ir * (fv + q1 * pv))/(-1 + q1))
END FUNCTION




SUB Set_ColumnText (hWnd AS HWND, Column, Text$)
    LOCAL lvc AS LV_COLUMN
    lvc.mask = LVCF_TEXT
    lvc.pszText = Text$
    SendMessage (hWnd, LVM_SETCOLUMN, Column, &lvc)
    SendMessage (LView1, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER)
END SUB




SUB BCX_LV_Reset (LView AS HWND, Columns, Rows)
    LOCAL lvItem AS LV_ITEM
    ListView_DeleteAllItems (LView)
    REPEAT Rows
        lvItem.mask      =  LVIF_TEXT
        lvItem.pszText   =  " "
        lvItem.iSubItem  =  0
        ListView_InsertItem(LView, &lvItem)
    END REPEAT
END SUB




SUB BCX_LV_Justify (LV AS HWND, Column, JustifyType)
    LOCAL hHeader AS ULONGLONG
    LOCAL hdi AS HD_ITEM
    '*******************************************
    '  CONST HDF_LEFT      = 0    'JustifyType
    '  CONST HDF_RIGHT     = 1    'JustifyType
    '  CONST HDF_CENTER    = 2    'JustifyType
    '*******************************************
    hHeader     = SendMessage(LV, LVM_FIRST+31, 0, 0)
    hdi.mask    = HDI_FORMAT
    hdi.pszText = " "
    hdi.fmt     = HDF_STRING OR JustifyType
    SendMessage ((HWND)hHeader, HDM_SETITEM, Column, &hdi)
END SUB




'********************************* ListView Sort Support  *************************************



FUNCTION CompareFunc (lParam1 AS LPARAM, lParam2 AS LPARAM, SortType AS LPARAM) AS LRESULT CALLBACK

    STATIC buffer$
    STATIC buffer1$
    STATIC lvi AS LVITEM

    lvi.mask       = LVIF_TEXT
    lvi.pszText    = buffer$
    lvi.cchTextMax = 2047

    SELECT CASE SortType
        CASE 3, 4
        lvi.iSubItem = 1

        CASE 5, 6
        lvi.iSubItem = 2

        CASE 7, 8
        lvi.iSubItem = 3

        CASE 9, 10
        lvi.iSubItem = 4

        CASE ELSE
        lvi.iSubItem = 0
    END SELECT

    SendMessage (LView1, LVM_GETITEMTEXT, lParam1, &lvi)    ' Fetch 1st of two items being compared
    buffer1$ = buffer$                                      ' save it
    SendMessage (LView1, LVM_GETITEMTEXT, lParam2, &lvi)    ' Fetch 2nd of two items being compared

    '**************************************
    ' Here, we sort each column as NUMBERS
    '**************************************

    REMOVE "," FROM TRIM$ (buffer$)    ' numbers cannot have spaces or comma's
    REMOVE "," FROM TRIM$ (buffer1$)   ' numbers cannot have spaces or comma's

    IF IMOD(SortType, 2) THEN         ' Determine ASCENDING or DESCENDING order
        FUNCTION = VAL(buffer1$) > VAL(buffer$)
    ELSE
        FUNCTION = VAL(buffer$) > VAL(buffer1$)
    END IF

END FUNCTION



SUB UpdatelParam(hCtrl AS HWND)
    STATIC lvi AS LVITEM
    STATIC cnt

    cnt = ListView_GetItemCount(hCtrl)
    lvi.mask     = LVIF_PARAM
    lvi.iSubItem = 0
    lvi.iItem    = 0

    WHILE cnt > 0
        lvi.lParam = lvi.iItem
        SendMessage(hCtrl, LVM_SETITEM, 0, &lvi)
        INCR lvi.iItem
        DECR cnt
    WEND
END SUB



'================= D A R K  M O D E ===================


FUNCTION InitDarkMode(hWnd AS HWND)
    #include <dwmapi.h>
    $PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
    $PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

    $TYPEDEF INT (WINAPI *TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI *TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI *TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI *TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI *TRefreshImmersiveColorPolicyState)()

    GLOBAL AS COLORREF darkBkColor = 0x383838
    GLOBAL AS COLORREF darkTextColor = 0xFFFFFF

    GLOBAL ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
    GLOBAL AllowDarkModeForWindow           AS TAllowDarkModeForWindow
    GLOBAL SetPreferredAppMode              AS TSetPreferredAppMode
    GLOBAL FlushMenuThemes                  AS TFlushMenuThemes
    GLOBAL RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState
    GLOBAL FHandle AS HMODULE

    FHandle = LOAD_DLL("uxtheme.dll")
    IF FHandle THEN
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    END IF

    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd, TRUE)
    SetPreferredAppMode(2)

    ' Enable dark mode for form
    SetWindowTheme(hWnd, UCODE$("Explorer"), NULL)

    RefreshImmersiveColorPolicyState()
    ' I know this is a weak validation but it's something
    IF FHandle THEN FUNCTION = TRUE ELSE FUNCTION = FALSE
END FUNCTION



SUB SetDarkMode(obj AS HWND)
    DIM ClassName$ * BCXSTRSIZE
    DIM ThemeClass$
    DIM child AS HWND

    child = GetWindow(obj, GW_CHILD)   ' begin enumeration
    DO WHILE child <> NULL
        GetClassName(child, ClassName$, BCXSTRSIZE)
        SELECT CASE TRIM$(ClassName$)

            CASE "SysListView32"
            DIM AS HWND hHeader = ListView_GetHeader(child)
            ThemeClass$ = "Explorer"
            SetWindowTheme(hHeader, UCODE$("Explorer"), NULL)
            AllowDarkModeForWindow(hHeader, TRUE)
            ListView_SetTextColor(child, darkTextColor)
            ListView_SetBkColor(child, darkBkColor)
            ListView_SetExtendedListViewStyle(child, LVS_EX_TRANSPARENTBKGND)

            CASE "ComboBox"
            ThemeClass$ = "CFD"

            CASE ELSE
            ThemeClass$ = "Explorer"
        END SELECT

        SetWindowTheme(child, UCODE$(ThemeClass$), NULL)
        AllowDarkModeForWindow(child, TRUE)
        SendMessage(child, WM_THEMECHANGED, 0, 0)
        child = GetWindow(child, GW_HWNDNEXT)
    LOOP
END SUB

SUB SetMenuBarColor(menu AS HMENU, color AS COLORREF)
    DIM AS MENUINFO mi
    mi.cbSize = sizeof(MENUINFO)
    GetMenuInfo(menu, &mi)
    mi.fMask = MIM_BACKGROUND
    mi.hbrBack = CreateSolidBrush(color)
    SetMenuInfo(menu, &mi)
END SUB

SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB
'================= D A R K  M O D E ===================


AIR.

[MrBcx]

I discovered why earlier experiments compiling our dark mode code to 32-bit would crash.  It's
because the ordinal prototypes need to be declared with the WINAPI macro, which is an alias for
_stdcall.  All 64-bit Windows apps use _stdcall but not-so with 32-bit.  32-bit calls need to be explicitly
declared _stdcall, otherwise most compilers will default to _cdecl.  Getting that wrong in an executable
file is the quickest way for an app to enter Never-Never-Land.

Below are the updated declarations.  I also edited my earlier postings to reflect this.
I've tested the 32-bit and 64-bit exe's compiled with Pelles and MSVC.  It's all good now!

Code Select Expand


    $TYPEDEF INT (WINAPI*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI*TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI*TRefreshImmersiveColorPolicyState)()


[MrBcx]

I thought I'd share another Dark Mode experience based on the code that I uploaded earlier today.

I created the following BED snippet, to make using the dark mode code even easier.

Code Select Expand



' This Dark Mode Library only works with Pelles and MSVC
' and must only be compiled into 64-bit applications.

' Add to FORMLOAD ( or Winmain ) before calling Center or Show:
'
' REMEMBER to change Form1 to whatever your main form is named.

'================= D A R K  M O D E ===================

if InitDarkMode (Form1) then SetDarkMode (Form1)

  BCX_SET_FORM_COLOR (Form1, darkBkColor)

'================= D A R K  M O D E ===================


'ADD the following to the EVENTS LOOP:

'***************************** D A R K  M O D E ******************************
CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR
'*****************************************************************************
SetBkColor((HDC)wParam, darkBkColor)
SetTextColor((HDC)wParam, darkTextColor)
FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)
'***************************** D A R K  M O D E ******************************



' ADD the rest to the end of your program ( or create an .inc or .bi file out of it ):

'================= D A R K  M O D E ===================

FUNCTION InitDarkMode(hWnd AS HWND)
    #include <dwmapi.h>
    $PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
    $PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

    $TYPEDEF INT (*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (*TFlushMenuThemes)()
    $TYPEDEF INT (*TRefreshImmersiveColorPolicyState)()

    GLOBAL AS COLORREF darkBkColor = 0x383838
    GLOBAL AS COLORREF darkTextColor = 0xFFFFFF

    GLOBAL ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
    GLOBAL AllowDarkModeForWindow           AS TAllowDarkModeForWindow
    GLOBAL SetPreferredAppMode              AS TSetPreferredAppMode
    GLOBAL FlushMenuThemes                  AS TFlushMenuThemes
    GLOBAL RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState
    GLOBAL FHandle AS HMODULE

    FHandle = LOAD_DLL("uxtheme.dll")
    IF FHandle THEN
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    END IF

    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd, TRUE)
    SetPreferredAppMode(2)

    ' Enable dark mode for form
    SetWindowTheme(hWnd, UCODE$("Explorer"), NULL)

    RefreshImmersiveColorPolicyState()
    ' I know this is a weak validation but it's something
    IF FHandle THEN FUNCTION = TRUE ELSE FUNCTION = FALSE
END FUNCTION



SUB SetDarkMode(obj AS HWND)
    DIM ClassName$ * BCXSTRSIZE
    DIM ThemeClass$
    DIM child AS HWND

    child = GetWindow(obj, GW_CHILD)   ' begin enumeration
    DO WHILE child <> NULL
        GetClassName(child, ClassName$, BCXSTRSIZE)
        SELECT CASE TRIM$(ClassName$)

            CASE "SysListView32"
            DIM AS HWND hHeader = ListView_GetHeader(child)
            ThemeClass$ = "Explorer"
            SetWindowTheme(hHeader, UCODE$("Explorer"), NULL)
            AllowDarkModeForWindow(hHeader, TRUE)
            ListView_SetTextColor(child, darkTextColor)
            ListView_SetBkColor(child, darkBkColor)
            ListView_SetExtendedListViewStyle (child, LVS_EX_TRANSPARENTBKGND)

            CASE "ComboBox"
            ThemeClass$ = "CFD"

            CASE ELSE
            ThemeClass$ = "Explorer"
        END SELECT

        SetWindowTheme(child, UCODE$(ThemeClass$), NULL)
        AllowDarkModeForWindow(child, TRUE)
        SendMessage(child, WM_THEMECHANGED, 0, 0)
        child = GetWindow(child, GW_HWNDNEXT)
    LOOP
END SUB


SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB
'================= D A R K  M O D E ===================


I simply followed those three steps and added them to a 2002 GUI_DEMO called Line Chart
that some of the old timers will remember.  I'm attaching a screen shot for your viewing enjoyment that
shows that demo in dark mode.

[MrBcx]

Here's another update. 

I converted SUB InitDarkMode(hwnd) to FUNCTION InitDarkMode(hwnd).
It returns TRUE if uxtheme.dll was sucessfully loaded, FALSE if not.  It's a start  :=)

Next, I added a child window enumeration loop to SUB SetDarkMode, to reduce coding
and simplify things.  Now SUB SetDarkMode only gets called one time per BCX_FORM.

So instead of this:

   '================= D A R K  M O D E ===================
    InitDarkMode(Form1)

    SetDarkMode(Input1)
    SetDarkMode(Input2)
    SetDarkMode(Input3)
    SetDarkMode(Button1)
    SetDarkMode(LView1)
    '================= D A R K  M O D E ===================

we now do this:

    '================= D A R K  M O D E ===================

    IF InitDarkMode(Form1) then SetDarkMode(Form1)

    '================= D A R K  M O D E ===================


Here is the updated code and sample:

Code Select Expand


' *****************************************************
' Program Name: Amort.Bas  by MrBcx
' Modified to demonstrate new DARK MODE capability
' STATUS: >> DARK MODE partially working
' Dark Mode mods by Armando Rivera & MrBcx
' *****************************************************

'================= D A R K  M O D E ===================
' MrBcx moved the Dark Mode Support to FUNCTION InitDarkMode
'================= D A R K  M O D E ===================

GUI "Amort"
CONST ID_LV = 1001   ' Added for LV sort support
GLOBAL SortOrder     ' Added for LV sort support

SUB FORMLOAD
    GLOBAL Form1   AS CONTROL
    GLOBAL Input1  AS CONTROL
    GLOBAL Input2  AS CONTROL
    GLOBAL Input3  AS CONTROL
    GLOBAL Label1  AS CONTROL
    GLOBAL Label2  AS CONTROL
    GLOBAL Label3  AS CONTROL
    GLOBAL Label4  AS CONTROL
    GLOBAL Label5  AS CONTROL
    GLOBAL Label6  AS CONTROL
    GLOBAL Button1 AS CONTROL
    GLOBAL LView1  AS CONTROL
    '******************************************************************************
    Form1   = BCX_FORM     ("Amortization by MrBCX", 0, 0, 165, 230)
    Input1  = BCX_INPUT    (   "350,000"    , Form1, 0, 105, 5, 46, 14)
    Input2  = BCX_INPUT    (   "6.50"       , Form1, 0, 105, 20, 46, 14)
    Input3  = BCX_INPUT    (     "30"       , Form1, 0, 105, 35, 46, 14)
    BCX_LABEL              ("Loan Amount"   , Form1, 0, 10, 7, 45, 11)
    BCX_LABEL              ("Interest Rate" , Form1, 0, 10, 22, 45, 11)
    BCX_LABEL              ("No. of Years"  , Form1, 0, 10, 37, 45, 11)
    Label1  = BCX_LABEL    (  "Principal"   , Form1, 0, 10, 52, 40, 14)
    Label2  = BCX_LABEL    (  "Interest"    , Form1, 0, 10, 65, 40, 14)
    Label3  = BCX_LABEL    (  "Payment"     , Form1, 0, 10, 78, 40, 14)
    Label4  = BCX_LABEL    (     ""         , Form1, 0, 60, 52, 40, 14)
    Label5  = BCX_LABEL    (     ""         , Form1, 0, 60, 65, 40, 14)
    Label6  = BCX_LABEL    (     ""         , Form1, 0, 60, 78, 40, 14)
    Button1 = BCX_BUTTON   (   "Calc"       , Form1, 101, 105, 52, 45, 14)
    LView1  = BCX_LISTVIEW (     ""         , Form1, ID_LV, 5, 95, 150, 123)
    '******************************************************************************



    '========================================================================
    '   Menus don't do anything - they're for developing DARK MODE
    '========================================================================
    GLOBAL MainMenu AS HMENU
    GLOBAL FileMenu AS HMENU

    MainMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE
    FileMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE

    '========================================================================
    '                     Build the File Menu First
    '========================================================================
    AppendMenu(FileMenu, MF_STRING   , 111, "&Open")
    AppendMenu(FileMenu, MF_STRING   , 222, "&Close")
    AppendMenu(FileMenu, MF_STRING   , 333, "&Save")
    AppendMenu(FileMenu, MF_STRING   , 444, "Save&As")
    AppendMenu(FileMenu, MF_SEPARATOR, 0, "")
    AppendMenu(FileMenu, MF_STRING   , 555, "E&xit")
    '========================================================================
    '                        Build the Main Menu Next
    '========================================================================
    AppendMenu ( MainMenu , MF_STRING , 666, "Edit")
    AppendMenu ( MainMenu , MF_STRING , 777, "Options")
    '========================================================================
    '                  Attach the File menu to the main menu
    '========================================================================
    InsertMenu (MainMenu, 666 , MF_POPUP , FileMenu , "File")
    '========================================================================
    SetMenu(Form1, MainMenu)              ' Activate the menu

    '================= D A R K  M O D E ===================

    if InitDarkMode(Form1) then SetDarkMode(Form1)

    '================= D A R K  M O D E ===================


    BCX_SET_FORM_COLOR(Form1, darkBkColor)
    MODSTYLE(Form1, 0, WS_SIZEBOX | WS_MAXIMIZEBOX) ' Remove size and max boxes

    Set_ColumnText (LView1, 0, "Payment")
    Set_ColumnText (LView1, 1, "Interest")
    Set_ColumnText (LView1, 2, "Principal")
    Set_ColumnText (LView1, 3, "Balance")

    CENTER Form1
    SHOW   Form1
END SUB



BEGIN EVENTS
    SELECT CASE CBMSG
        '*****************************************************************************
        CASE WM_COMMAND
        '*****************************************************************************
        IF CBCTL = 555 THEN PostQuitMessage(0)

        IF CBCTL = 101 THEN     ' CALC Button Clicked
            FillListView()
            SortOrder = 3
            SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
            UpdatelParam (LView1)
            EXIT FUNCTION
        END IF

        '*****************************************************************************
        CASE WM_NOTIFY      ' Are we talking to the ListView control?
        '*****************************************************************************
        DIM plParam AS LPNMHDR
        DIM lvParam AS LPNM_LISTVIEW

        plParam = (LPNMHDR)lParam

        IF plParam->idFrom = ID_LV THEN                 ' Yes -- Our Listview has focus
            IF plParam->code = LVN_COLUMNCLICK THEN     ' User clicked column header -- wants to sort
                lvParam = (LPNM_LISTVIEW)lParam

                SELECT CASE lvParam->iSubItem           ' Which column was clicked?
                    CASE 1
                    IF SortOrder = 0 OR SortOrder = 4 THEN SortOrder = 3 ELSE SortOrder = 4

                    CASE 2
                    IF SortOrder = 0 OR SortOrder = 6 THEN SortOrder = 5 ELSE SortOrder = 6

                    CASE 3
                    IF SortOrder = 0 OR SortOrder = 8 THEN SortOrder = 7 ELSE SortOrder = 8

                    CASE 4
                    IF SortOrder = 0 OR SortOrder = 10 THEN SortOrder = 9 ELSE SortOrder = 10

                    CASE ELSE
                    IF SortOrder = 0 OR SortOrder = 2 THEN SortOrder = 1 ELSE SortOrder = 2
                END SELECT

                SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
                UpdatelParam (LView1)
            END IF
        END IF

        '***************************** D A R K  M O D E ******************************
        CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR
        '*****************************************************************************
        SetBkColor((HDC)wParam, darkBkColor)
        SetTextColor((HDC)wParam, darkTextColor)
        FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)
        '***************************** D A R K  M O D E ******************************

        CASE WM_CLOSE
        CALL DarkModeFreeLibrary

    END SELECT
END EVENTS




SUB FillListView
    '=============================
    DIM  Amount       AS DOUBLE
    DIM  Interest     AS DOUBLE
    DIM  Years        AS DOUBLE
    DIM  Paymnt       AS DOUBLE
    DIM  Int_Payment  AS DOUBLE
    DIM  Prin_Payment AS DOUBLE
    DIM  Mon_Payment  AS DOUBLE
    DIM  SumPrinc     AS DOUBLE
    DIM  SumInt       AS DOUBLE
    DIM  z            AS LONG
    '=============================
    Amount   = VAL(RETAIN$(BCX_GET_TEXT$(Input1), ".0123456789"))
    Interest = VAL(BCX_GET_TEXT$(Input2))
    Years    = VAL(BCX_GET_TEXT$(Input3))
    Paymnt   = PMT(Interest, Years*12, Amount, 0)

    Mon_Payment = Paymnt

    BCX_LV_Reset (LView1, 4, Years * 12)

    Set_ColumnText(LView1, 0, "Payment  ")
    Set_ColumnText(LView1, 1, "Interest ")
    Set_ColumnText(LView1, 2, "Principal")
    Set_ColumnText(LView1, 3, "Balance  ")

    FOR z = 1 TO Years * 12
        Int_Payment = INTEREST_PAYMENT(Interest, Amount)
        Prin_Payment = Paymnt - Int_Payment
        SumPrinc = SumPrinc + Prin_Payment
        SumInt   = SumInt   + Int_Payment
        ListView_SetItemText (LView1, z-1, 0, STR$(z))
        ListView_SetItemText (LView1, z-1, 1, USING$("###.##", Int_Payment))
        ListView_SetItemText (LView1, z-1, 2, USING$("###.##", Prin_Payment))
        Amount = Amount - Prin_Payment
        ListView_SetItemText (LView1, z-1, 3, USING$("###.##", Amount))
    NEXT

    ListView_SetItemText (LView1, z, 3, " ")  ' add a line at the bottom

    FOR z = 0 TO 3
        SendMessage (LView1, LVM_SETCOLUMNWIDTH, z, LVSCW_AUTOSIZE_USEHEADER)
    NEXT

    BCX_LV_Justify (LView1, 0, HDF_CENTER)
    BCX_LV_Justify (LView1, 1, HDF_RIGHT)
    BCX_LV_Justify (LView1, 2, HDF_RIGHT)
    BCX_LV_Justify (LView1, 3, HDF_RIGHT)

    BCX_SET_TEXT (Label4, USING$("###.##", SumPrinc))
    BCX_SET_TEXT (Label5, USING$("###.##", SumInt))
    BCX_SET_TEXT (Label6, USING$("###.##", Mon_Payment))
END SUB



FUNCTION INTEREST_PAYMENT (i AS DOUBLE, Balance AS DOUBLE) AS DOUBLE
    FUNCTION = (i/12/100) * Balance
END FUNCTION




FUNCTION PMT (i AS DOUBLE, np AS DOUBLE, pv AS DOUBLE, fv AS DOUBLE) AS DOUBLE
    DIM RAW q1 AS DOUBLE
    DIM RAW ir AS DOUBLE
    ir = i/12/100
    q1 = POW (1 + ir, np)
    FUNCTION = ((ir * (fv + q1 * pv))/(-1 + q1))
END FUNCTION




SUB Set_ColumnText (hWnd AS HWND, Column, Text$)
    LOCAL lvc AS LV_COLUMN
    lvc.mask = LVCF_TEXT
    lvc.pszText = Text$
    SendMessage (hWnd, LVM_SETCOLUMN, Column, &lvc)
    SendMessage (LView1, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER)
END SUB




SUB BCX_LV_Reset (LView AS HWND, Columns, Rows)
    LOCAL lvItem AS LV_ITEM
    ListView_DeleteAllItems (LView)
    REPEAT Rows
        lvItem.mask      =  LVIF_TEXT
        lvItem.pszText   =  " "
        lvItem.iSubItem  =  0
        ListView_InsertItem(LView, &lvItem)
    END REPEAT
END SUB




SUB BCX_LV_Justify (LV AS HWND, Column, JustifyType)
    LOCAL hHeader AS ULONGLONG
    LOCAL hdi AS HD_ITEM
    '*******************************************
    '  CONST HDF_LEFT      = 0    'JustifyType
    '  CONST HDF_RIGHT     = 1    'JustifyType
    '  CONST HDF_CENTER    = 2    'JustifyType
    '*******************************************
    hHeader     = SendMessage(LV, LVM_FIRST+31, 0, 0)
    hdi.mask    = HDI_FORMAT
    hdi.pszText = " "
    hdi.fmt     = HDF_STRING OR JustifyType
    SendMessage ((HWND)hHeader, HDM_SETITEM, Column, &hdi)
END SUB




'********************************* ListView Sort Support  *************************************



FUNCTION CompareFunc (lParam1 AS LPARAM, lParam2 AS LPARAM, SortType AS LPARAM) AS LRESULT CALLBACK

    STATIC buffer$
    STATIC buffer1$
    STATIC lvi AS LVITEM

    lvi.mask       = LVIF_TEXT
    lvi.pszText    = buffer$
    lvi.cchTextMax = 2047

    SELECT CASE SortType
        CASE 3, 4
        lvi.iSubItem = 1

        CASE 5, 6
        lvi.iSubItem = 2

        CASE 7, 8
        lvi.iSubItem = 3

        CASE 9, 10
        lvi.iSubItem = 4

        CASE ELSE
        lvi.iSubItem = 0
    END SELECT

    SendMessage (LView1, LVM_GETITEMTEXT, lParam1, &lvi)    ' Fetch 1st of two items being compared
    buffer1$ = buffer$                                      ' save it
    SendMessage (LView1, LVM_GETITEMTEXT, lParam2, &lvi)    ' Fetch 2nd of two items being compared

    '**************************************
    ' Here, we sort each column as NUMBERS
    '**************************************

    REMOVE "," FROM TRIM$ (buffer$)    ' numbers cannot have spaces or comma's
    REMOVE "," FROM TRIM$ (buffer1$)   ' numbers cannot have spaces or comma's

    IF IMOD(SortType, 2) THEN         ' Determine ASCENDING or DESCENDING order
        FUNCTION = VAL(buffer1$) > VAL(buffer$)
    ELSE
        FUNCTION = VAL(buffer$) > VAL(buffer1$)
    END IF

END FUNCTION



SUB UpdatelParam(hCtrl AS HWND)
    STATIC lvi AS LVITEM
    STATIC cnt

    cnt = ListView_GetItemCount(hCtrl)
    lvi.mask     = LVIF_PARAM
    lvi.iSubItem = 0
    lvi.iItem    = 0

    WHILE cnt > 0
        lvi.lParam = lvi.iItem
        SendMessage(hCtrl, LVM_SETITEM, 0, &lvi)
        INCR lvi.iItem
        DECR cnt
    WEND
END SUB



'================= D A R K  M O D E ===================


FUNCTION InitDarkMode(hWnd AS HWND)
    #include <dwmapi.h>
    $PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
    $PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

    $TYPEDEF INT (WINAPI*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI*TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI*TRefreshImmersiveColorPolicyState)()

    GLOBAL AS COLORREF darkBkColor = 0x383838
    GLOBAL AS COLORREF darkTextColor = 0xFFFFFF

    GLOBAL ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
    GLOBAL AllowDarkModeForWindow           AS TAllowDarkModeForWindow
    GLOBAL SetPreferredAppMode              AS TSetPreferredAppMode
    GLOBAL FlushMenuThemes                  AS TFlushMenuThemes
    GLOBAL RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState
    GLOBAL FHandle AS HMODULE

    FHandle = LOAD_DLL("uxtheme.dll")
    IF FHandle THEN
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    END IF

    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd, TRUE)
    SetPreferredAppMode(2)

    ' Enable dark mode for form
    SetWindowTheme(hWnd, UCODE$("Explorer"), NULL)

    RefreshImmersiveColorPolicyState()
    ' I know this is a weak validation but it's something
    IF FHandle THEN FUNCTION = TRUE ELSE FUNCTION = FALSE
END FUNCTION



SUB SetDarkMode(obj AS HWND)
    DIM ClassName$ * BCXSTRSIZE
    DIM ThemeClass$
    DIM child AS HWND

    child = GetWindow(obj, GW_CHILD)   ' begin enumeration
    DO WHILE child <> NULL
        GetClassName(child, ClassName$, BCXSTRSIZE)
        SELECT CASE TRIM$(ClassName$)

            CASE "SysListView32"
            DIM AS HWND hHeader = ListView_GetHeader(child)
            ThemeClass$ = "Explorer"
            SetWindowTheme(hHeader, UCODE$("Explorer"), NULL)
            AllowDarkModeForWindow(hHeader, TRUE)
            ListView_SetTextColor(child, darkTextColor)
            ListView_SetBkColor(child, darkBkColor)
            ListView_SetExtendedListViewStyle (child, LVS_EX_TRANSPARENTBKGND)

            CASE "ComboBox"
            ThemeClass$ = "CFD"

            CASE ELSE
            ThemeClass$ = "Explorer"
        END SELECT

        SetWindowTheme(child, UCODE$(ThemeClass$), NULL)
        AllowDarkModeForWindow(child, TRUE)
        SendMessage(child, WM_THEMECHANGED, 0, 0)
        child = GetWindow(child, GW_HWNDNEXT)
    LOOP
END SUB


SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB
'================= D A R K  M O D E ===================




[airr]

Cool, MrB.

AIR.

[MrBcx]

Armando,

Here's an updated Dark Mode Amort.bas that I've added menus to.
The menus don't do anything except serve to show progress on dark mode experiments.
Coloring the Main Menu still eludes me.  I've tried a dozen different things to no avail.
The File Menu colorizes, so that's good news.  File | Exit will exit the program
but all other menu entries are intentionally cosmetic.

I've moved -most- DARK MODE setup to SUB InitDarkMode(), to make using this in other
programs a lot easier to understand.

Code Select Expand


' *****************************************************
' Program Name: Amort.Bas  by MrBcx
' Modified to demonstrate new DARK MODE capability
' STATUS: >> DARK MODE partially working
' Dark Mode mods by Armando Rivera & MrBcx
' *****************************************************

'================= D A R K  M O D E ===================
' MrBcx moved the Dark Mode Support to SUB InitDarkMode
'================= D A R K  M O D E ===================

GUI "Amort"
CONST ID_LV = 1001   ' Added for LV sort support
GLOBAL SortOrder     ' Added for LV sort support

SUB FORMLOAD
    GLOBAL Form1   AS CONTROL
    GLOBAL Input1  AS CONTROL
    GLOBAL Input2  AS CONTROL
    GLOBAL Input3  AS CONTROL
    GLOBAL Label1  AS CONTROL
    GLOBAL Label2  AS CONTROL
    GLOBAL Label3  AS CONTROL
    GLOBAL Label4  AS CONTROL
    GLOBAL Label5  AS CONTROL
    GLOBAL Label6  AS CONTROL
    GLOBAL Button1 AS CONTROL
    GLOBAL LView1  AS CONTROL
    '******************************************************************************
    Form1   = BCX_FORM     ("Amortization by MrBCX", 0, 0, 165, 230)
    Input1  = BCX_INPUT    (   "350,000"    , Form1, 0, 105, 5, 46, 14)
    Input2  = BCX_INPUT    (   "6.50"       , Form1, 0, 105, 20, 46, 14)
    Input3  = BCX_INPUT    (     "30"       , Form1, 0, 105, 35, 46, 14)
    BCX_LABEL              ("Loan Amount"   , Form1, 0, 10, 7, 45, 11)
    BCX_LABEL              ("Interest Rate" , Form1, 0, 10, 22, 45, 11)
    BCX_LABEL              ("No. of Years"  , Form1, 0, 10, 37, 45, 11)
    Label1  = BCX_LABEL    (  "Principal"   , Form1, 0, 10, 52, 40, 14)
    Label2  = BCX_LABEL    (  "Interest"    , Form1, 0, 10, 65, 40, 14)
    Label3  = BCX_LABEL    (  "Payment"     , Form1, 0, 10, 78, 40, 14)
    Label4  = BCX_LABEL    (     ""         , Form1, 0, 60, 52, 40, 14)
    Label5  = BCX_LABEL    (     ""         , Form1, 0, 60, 65, 40, 14)
    Label6  = BCX_LABEL    (     ""         , Form1, 0, 60, 78, 40, 14)
    Button1 = BCX_BUTTON   (   "Calc"       , Form1, 101, 105, 52, 45, 14)
    LView1  = BCX_LISTVIEW (     ""         , Form1, ID_LV, 5, 95, 150, 123)
    '******************************************************************************



    '========================================================================
    '   Menus don't do anything - they're for developing DARK MODE
    '========================================================================
    GLOBAL MainMenu AS HMENU
    GLOBAL FileMenu AS HMENU

    MainMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE
    FileMenu   =  CreateMenu()   ' CreateMenu returns a MENU HANDLE
    '========================================================================
    '                     Build the File Menu First
    '========================================================================
    AppendMenu(FileMenu, MF_STRING   , 111, "&Open")
    AppendMenu(FileMenu, MF_STRING   , 222, "&Close")
    AppendMenu(FileMenu, MF_STRING   , 333, "&Save")
    AppendMenu(FileMenu, MF_STRING   , 444, "Save&As")
    AppendMenu(FileMenu, MF_SEPARATOR, 0, "")
    AppendMenu(FileMenu, MF_STRING   , 555, "E&xit")
    '========================================================================
    '                        Build the Main Menu Next
    '========================================================================
    AppendMenu ( MainMenu , MF_STRING , 666, "Edit")
    AppendMenu ( MainMenu , MF_STRING , 777, "Options")
    '========================================================================
    '                  Attach the File menu to the main menu
    '========================================================================
    InsertMenu (MainMenu, 666 , MF_POPUP , FileMenu , "File")
    '========================================================================
    SetMenu(Form1, MainMenu)              ' Activate the menu




    '================= D A R K  M O D E ===================
    InitDarkMode(Form1)
    SetDarkMode(Input1)
    SetDarkMode(Input2)
    SetDarkMode(Input3)
    SetDarkMode(Button1)
    SetDarkMode(LView1)

    BCX_SET_FORM_COLOR(Form1, darkBkColor)
    '================= D A R K  M O D E ===================

    MODSTYLE(Form1, 0, WS_SIZEBOX | WS_MAXIMIZEBOX) ' Remove size and max boxes

    Set_ColumnText (LView1, 0, "Payment")
    Set_ColumnText (LView1, 1, "Interest")
    Set_ColumnText (LView1, 2, "Principal")
    Set_ColumnText (LView1, 3, "Balance")

    CENTER Form1
    SHOW   Form1
END SUB



BEGIN EVENTS
    SELECT CASE CBMSG
        '*****************************************************************************
        CASE WM_COMMAND
        '*****************************************************************************
        IF CBCTL = 555 THEN PostQuitMessage(0)

        IF CBCTL = 101 THEN     ' CALC Button Clicked
            FillListView()
            SortOrder = 3
            SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
            UpdatelParam (LView1)
            EXIT FUNCTION
        END IF

        '*****************************************************************************
        CASE WM_NOTIFY      ' Are we talking to the ListView control?
        '*****************************************************************************
        DIM plParam AS LPNMHDR
        DIM lvParam AS LPNM_LISTVIEW

        plParam = (LPNMHDR)lParam

        IF plParam->idFrom = ID_LV THEN                 ' Yes -- Our Listview has focus
            IF plParam->code = LVN_COLUMNCLICK THEN     ' User clicked column header -- wants to sort
                lvParam = (LPNM_LISTVIEW)lParam

                SELECT CASE lvParam->iSubItem           ' Which column was clicked?
                    CASE 1
                    IF SortOrder = 0 OR SortOrder = 4 THEN SortOrder = 3 ELSE SortOrder = 4

                    CASE 2
                    IF SortOrder = 0 OR SortOrder = 6 THEN SortOrder = 5 ELSE SortOrder = 6

                    CASE 3
                    IF SortOrder = 0 OR SortOrder = 8 THEN SortOrder = 7 ELSE SortOrder = 8

                    CASE 4
                    IF SortOrder = 0 OR SortOrder = 10 THEN SortOrder = 9 ELSE SortOrder = 10

                    CASE ELSE
                    IF SortOrder = 0 OR SortOrder = 2 THEN SortOrder = 1 ELSE SortOrder = 2
                END SELECT

                SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
                UpdatelParam (LView1)
            END IF
        END IF

        '***************************** D A R K  M O D E ******************************
        CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR
        '*****************************************************************************
        SetBkColor((HDC)wParam, darkBkColor)
        SetTextColor((HDC)wParam, darkTextColor)
        FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)
        '***************************** D A R K  M O D E ******************************

        CASE WM_CLOSE
        CALL DarkModeFreeLibrary
    END SELECT
END EVENTS




SUB FillListView
    '=============================
    DIM  Amount       AS DOUBLE
    DIM  Interest     AS DOUBLE
    DIM  Years        AS DOUBLE
    DIM  Paymnt       AS DOUBLE
    DIM  Int_Payment  AS DOUBLE
    DIM  Prin_Payment AS DOUBLE
    DIM  Mon_Payment  AS DOUBLE
    DIM  SumPrinc     AS DOUBLE
    DIM  SumInt       AS DOUBLE
    DIM  z            AS LONG
    '=============================
    Amount   = VAL(RETAIN$(BCX_GET_TEXT$(Input1), ".0123456789"))
    Interest = VAL(BCX_GET_TEXT$(Input2))
    Years    = VAL(BCX_GET_TEXT$(Input3))
    Paymnt   = PMT(Interest, Years*12, Amount, 0)

    Mon_Payment = Paymnt

    BCX_LV_Reset (LView1, 4, Years * 12)

    Set_ColumnText(LView1, 0, "Payment  ")
    Set_ColumnText(LView1, 1, "Interest ")
    Set_ColumnText(LView1, 2, "Principal")
    Set_ColumnText(LView1, 3, "Balance  ")

    FOR z = 1 TO Years * 12
        Int_Payment = INTEREST_PAYMENT(Interest, Amount)
        Prin_Payment = Paymnt - Int_Payment
        SumPrinc = SumPrinc + Prin_Payment
        SumInt   = SumInt   + Int_Payment
        ListView_SetItemText (LView1, z-1, 0, STR$(z))
        ListView_SetItemText (LView1, z-1, 1, USING$("###.##", Int_Payment))
        ListView_SetItemText (LView1, z-1, 2, USING$("###.##", Prin_Payment))
        Amount = Amount - Prin_Payment
        ListView_SetItemText (LView1, z-1, 3, USING$("###.##", Amount))
    NEXT

    ListView_SetItemText (LView1, z, 3, " ")  ' add a line at the bottom

    FOR z = 0 TO 3
        SendMessage (LView1, LVM_SETCOLUMNWIDTH, z, LVSCW_AUTOSIZE_USEHEADER)
    NEXT

    BCX_LV_Justify (LView1, 0, HDF_CENTER)
    BCX_LV_Justify (LView1, 1, HDF_RIGHT)
    BCX_LV_Justify (LView1, 2, HDF_RIGHT)
    BCX_LV_Justify (LView1, 3, HDF_RIGHT)

    BCX_SET_TEXT (Label4, USING$("###.##", SumPrinc))
    BCX_SET_TEXT (Label5, USING$("###.##", SumInt))
    BCX_SET_TEXT (Label6, USING$("###.##", Mon_Payment))
END SUB



FUNCTION INTEREST_PAYMENT (i AS DOUBLE, Balance AS DOUBLE) AS DOUBLE
    FUNCTION = (i/12/100) * Balance
END FUNCTION




FUNCTION PMT (i AS DOUBLE, np AS DOUBLE, pv AS DOUBLE, fv AS DOUBLE) AS DOUBLE
    DIM RAW q1 AS DOUBLE
    DIM RAW ir AS DOUBLE
    ir = i/12/100
    q1 = POW (1 + ir, np)
    FUNCTION = ((ir * (fv + q1 * pv))/(-1 + q1))
END FUNCTION




SUB Set_ColumnText (hWnd AS HWND, Column, Text$)
    LOCAL lvc AS LV_COLUMN
    lvc.mask = LVCF_TEXT
    lvc.pszText = Text$
    SendMessage (hWnd, LVM_SETCOLUMN, Column, &lvc)
    SendMessage (LView1, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER)
END SUB




SUB BCX_LV_Reset (LView AS HWND, Columns, Rows)
    LOCAL lvItem AS LV_ITEM
    ListView_DeleteAllItems (LView)
    REPEAT Rows
        lvItem.mask      =  LVIF_TEXT
        lvItem.pszText   =  " "
        lvItem.iSubItem  =  0
        ListView_InsertItem(LView, &lvItem)
    END REPEAT
END SUB




SUB BCX_LV_Justify (LV AS HWND, Column, JustifyType)
    LOCAL hHeader AS ULONGLONG
    LOCAL hdi AS HD_ITEM
    '*******************************************
    '  CONST HDF_LEFT      = 0    'JustifyType
    '  CONST HDF_RIGHT     = 1    'JustifyType
    '  CONST HDF_CENTER    = 2    'JustifyType
    '*******************************************
    hHeader     = SendMessage(LV, LVM_FIRST+31, 0, 0)
    hdi.mask    = HDI_FORMAT
    hdi.pszText = " "
    hdi.fmt     = HDF_STRING OR JustifyType
    SendMessage ((HWND)hHeader, HDM_SETITEM, Column, &hdi)
END SUB




'********************************* ListView Sort Support  *************************************



FUNCTION CompareFunc (lParam1 AS LPARAM, lParam2 AS LPARAM, SortType AS LPARAM) AS LRESULT CALLBACK

    STATIC buffer$
    STATIC buffer1$
    STATIC lvi AS LVITEM

    lvi.mask       = LVIF_TEXT
    lvi.pszText    = buffer$
    lvi.cchTextMax = 2047

    SELECT CASE SortType
        CASE 3, 4
        lvi.iSubItem = 1

        CASE 5, 6
        lvi.iSubItem = 2

        CASE 7, 8
        lvi.iSubItem = 3

        CASE 9, 10
        lvi.iSubItem = 4

        CASE ELSE
        lvi.iSubItem = 0
    END SELECT

    SendMessage (LView1, LVM_GETITEMTEXT, lParam1, &lvi)    ' Fetch 1st of two items being compared
    buffer1$ = buffer$                                      ' save it
    SendMessage (LView1, LVM_GETITEMTEXT, lParam2, &lvi)    ' Fetch 2nd of two items being compared

    '**************************************
    ' Here, we sort each column as NUMBERS
    '**************************************

    REMOVE "," FROM TRIM$ (buffer$)    ' numbers cannot have spaces or comma's
    REMOVE "," FROM TRIM$ (buffer1$)   ' numbers cannot have spaces or comma's

    IF IMOD(SortType, 2) THEN         ' Determine ASCENDING or DESCENDING order
        FUNCTION = VAL(buffer1$) > VAL(buffer$)
    ELSE
        FUNCTION = VAL(buffer$) > VAL(buffer1$)
    END IF

END FUNCTION



SUB UpdatelParam(hCtrl AS HWND)
    STATIC lvi AS LVITEM
    STATIC cnt

    cnt = ListView_GetItemCount(hCtrl)
    lvi.mask     = LVIF_PARAM
    lvi.iSubItem = 0
    lvi.iItem    = 0

    WHILE cnt > 0
        lvi.lParam = lvi.iItem
        SendMessage(hCtrl, LVM_SETITEM, 0, &lvi)
        INCR lvi.iItem
        DECR cnt
    WEND
END SUB



'================= D A R K  M O D E ===================


SUB InitDarkMode(hWnd AS HWND)
    #include <dwmapi.h>
    $PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
    $PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

    $TYPEDEF INT (WINAPI*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI*TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI*TRefreshImmersiveColorPolicyState)()

    GLOBAL AS COLORREF darkBkColor = 0x383838
    GLOBAL AS COLORREF darkTextColor = 0xFFFFFF

    GLOBAL ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
    GLOBAL AllowDarkModeForWindow           AS TAllowDarkModeForWindow
    GLOBAL SetPreferredAppMode              AS TSetPreferredAppMode
    GLOBAL FlushMenuThemes                  AS TFlushMenuThemes
    GLOBAL RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState
    GLOBAL FHandle AS HMODULE

    FHandle = LOAD_DLL("uxtheme.dll")
    IF FHandle THEN
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    END IF

    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd, TRUE)
    SetPreferredAppMode(2)

    ' Enable dark mode for form
    SetWindowTheme(hWnd, UCODE$("Explorer"), NULL)

    RefreshImmersiveColorPolicyState()
END SUB



SUB SetDarkMode(obj AS HWND)
    DIM ClassName$*BCXSTRSIZE
    DIM ThemeClass$

    GetClassName(obj, ClassName, BCXSTRSIZE)

    SELECT CASE TRIM$(ClassName$)
        CASE "SysListView32"
        DIM AS HWND hHeader = ListView_GetHeader(obj)
        ThemeClass$ = "Explorer"
        SetWindowTheme(hHeader, UCODE$("Explorer"), NULL)
        AllowDarkModeForWindow(hHeader, TRUE)
        ListView_SetTextColor(obj, darkTextColor)
        ListView_SetBkColor(obj, darkBkColor)
        ListView_SetExtendedListViewStyle (obj, LVS_EX_TRANSPARENTBKGND)

        CASE "ComboBox"
        ThemeClass$ = "CFD"
        CASE ELSE
        ThemeClass$ = "Explorer"
    END SELECT

    SetWindowTheme(obj, UCODE$(ThemeClass$), NULL);
    AllowDarkModeForWindow(obj, TRUE);
    SendMessage(obj, WM_THEMECHANGED, 0, 0);
END SUB


SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB
'================= D A R K  M O D E ===================



[MrBcx]

One more thing, changing the $PRAGMA statements thusly allows Pelles -and- MSVC to compile.

#include <dwmapi.h>
$PRAGMA comment(lib, "uxtheme.lib")   ' This format works with MSVC and Pelles C
$PRAGMA comment(lib, "Dwmapi.lib")    '                   Ditto

[MrBcx]

Really great progress Armando.

I discovered that if you add the following highlighted macro call, things
improve tremendously with the ListView appearance.

ListView_SetTextColor(obj, darkTextColor)
ListView_SetBkColor(obj, darkBkColor)
ListView_SetExtendedListViewStyle (obj, LVS_EX_TRANSPARENTBKGND)

See attached scrnshot

[airr]

Played a bit with this today:

Code Select Expand

' *****************************************************
' Program Name: Amort.Bas  by MrBcx
' Modified to test enabling DARK MODE
' STATUS: >> DARK MODE not working <<
' Additional testing/code by AIR
' STATUS: >> DARK MODE partially working
' See:  DarkModeLoadLibrary() & DarkModeFreeLibrary()
' at the bottom of this file.
' *****************************************************

'================= D A R K  M O D E ===================
$PRAGMA lib "uxtheme.lib"

    $TYPEDEF INT (WINAPI*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI*TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI*TRefreshImmersiveColorPolicyState)()

DIM RAW ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
DIM RAW AllowDarkModeForWindow           AS TAllowDarkModeForWindow
DIM RAW SetPreferredAppMode              AS TSetPreferredAppMode
DIM RAW FlushMenuThemes                  AS TFlushMenuThemes
DIM RAW RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState

GLOBAL FHandle AS HMODULE
GLOBAL FLoaded AS INT
#include <dwmapi.h>
$PRAGMA lib "Dwmapi.lib"
'================= D A R K  M O D E ===================

GUI "Amort"
CONST ID_LV = 1001   ' Added for LV sort support
GLOBAL SortOrder     ' Added for LV sort support


SUB FORMLOAD
GLOBAL AS COLORREF darkBkColor = 0x383838
GLOBAL AS COLORREF darkTextColor = 0xFFFFFF 

    FHandle = LOAD_DLL("uxtheme.dll")
    if FHandle then
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    end if

    GLOBAL Form1   AS CONTROL
    GLOBAL Input1  AS CONTROL
    GLOBAL Input2  AS CONTROL
    GLOBAL Input3  AS CONTROL
    GLOBAL Label1  AS CONTROL
    GLOBAL Label2  AS CONTROL
    GLOBAL Label3  AS CONTROL
    GLOBAL Label4  AS CONTROL
    GLOBAL Label5  AS CONTROL
    GLOBAL Label6  AS CONTROL
    GLOBAL Button1 AS CONTROL
    GLOBAL LView1  AS CONTROL
    '******************************************************************************
    Form1   = BCX_FORM     ("Amortization by MrBCX", 0, 0, 165, 230)
    Input1  = BCX_INPUT    (   "350,000"    , Form1, 0, 105, 5, 46, 14)
    Input2  = BCX_INPUT    (   "6.50"       , Form1, 0, 105, 20, 46, 14)
    Input3  = BCX_INPUT    (     "30"       , Form1, 0, 105, 35, 46, 14)
    BCX_LABEL              ("Loan Amount"   , Form1, 0, 10, 7, 45, 11)
    BCX_LABEL              ("Interest Rate" , Form1, 0, 10, 22, 45, 11)
    BCX_LABEL              ("No. of Years"  , Form1, 0, 10, 37, 45, 11)
    Label1  = BCX_LABEL    (  "Principal"   , Form1, 0, 10, 52, 40, 14)
    Label2  = BCX_LABEL    (  "Interest"    , Form1, 0, 10, 65, 40, 14)
    Label3  = BCX_LABEL    (  "Payment"     , Form1, 0, 10, 78, 40, 14)
    Label4  = BCX_LABEL    (     ""         , Form1, 0, 60, 52, 40, 14)
    Label5  = BCX_LABEL    (     ""         , Form1, 0, 60, 65, 40, 14)
    Label6  = BCX_LABEL    (     ""         , Form1, 0, 60, 78, 40, 14)
    Button1 = BCX_BUTTON   (   "Calc"       , Form1, 101, 105, 52, 45, 14)
    LView1  = BCX_LISTVIEW (     ""         , Form1, ID_LV, 5, 95, 150, 123)
    '******************************************************************************
    InitDarkMode(Form1)

    SetDarkMode(Input1)
    SetDarkMode(Input2)
    SetDarkMode(Input3)
    SetDarkMode(Button1)
    SetDarkMode(LView1)
    ' BCX_SET_LABEL_COLOR(Label1,RGB(255,255,255),RGB(46,46,46))
    MODSTYLE(Form1, 0, WS_SIZEBOX | WS_MAXIMIZEBOX) ' Remove size and max boxes
    BCX_SET_FORM_COLOR(Form1, darkBkColor)
    Set_ColumnText (LView1, 0, "Payment")
    Set_ColumnText (LView1, 1, "Interest")
    Set_ColumnText (LView1, 2, "Principal")
    Set_ColumnText (LView1, 3, "Balance")
    ' SetFocus(Input1)


    CENTER Form1
    SHOW   Form1

    '================= D A R K  M O D E ===================
    ' IF NOT FLoaded THEN
    '     FLoaded = DarkModeLoadLibrary(Form1)
    ' END IF
    '================= D A R K  M O D E ===================
END SUB



BEGIN EVENTS
    SELECT CASE CBMSG
        '*****************************************************************************
        CASE WM_COMMAND
        '*****************************************************************************
        IF CBCTL = 101 THEN     ' CALC Button Clicked
            FillListView()
            SortOrder = 3
            SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
            UpdatelParam (LView1)
            EXIT FUNCTION
        END IF

        '*****************************************************************************
        CASE WM_NOTIFY      ' Are we talking to the ListView control?
        '*****************************************************************************

        DIM plParam AS LPNMHDR
        DIM lvParam AS LPNM_LISTVIEW

        plParam = (LPNMHDR)lParam

        IF plParam->idFrom = ID_LV THEN                 ' Yes -- Our Listview has focus
            IF plParam->code = LVN_COLUMNCLICK THEN     ' User clicked column header -- wants to sort
                lvParam = (LPNM_LISTVIEW)lParam

                SELECT CASE lvParam->iSubItem           ' Which column was clicked?
                    CASE 1
                    IF SortOrder = 0 OR SortOrder = 4 THEN SortOrder = 3 ELSE SortOrder = 4

                    CASE 2
                    IF SortOrder = 0 OR SortOrder = 6 THEN SortOrder = 5 ELSE SortOrder = 6

                    CASE 3
                    IF SortOrder = 0 OR SortOrder = 8 THEN SortOrder = 7 ELSE SortOrder = 8

                    CASE 4
                    IF SortOrder = 0 OR SortOrder = 10 THEN SortOrder = 9 ELSE SortOrder = 10

                    CASE ELSE
                    IF SortOrder = 0 OR SortOrder = 2 THEN SortOrder = 1 ELSE SortOrder = 2
                END SELECT

                SendMessage (LView1, LVM_SORTITEMS, SortOrder, CompareFunc)    ' Call the sort routine
                UpdatelParam (LView1)
            END IF
        END IF

        CASE WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC, WM_CTLCOLORDLG, WM_CTLCOLORLISTBOX, WM_CTLCOLORSCROLLBAR                       
            SetBkColor((HDC)wParam,darkBkColor)
            SetTextColor((HDC)wParam, darkTextColor)
           
            FUNCTION = (LONGLONG)CreateSolidBrush(0x383838)

    END SELECT
END EVENTS




SUB FillListView
    '=============================
    DIM  Amount       AS DOUBLE
    DIM  Interest     AS DOUBLE
    DIM  Years        AS DOUBLE
    DIM  Paymnt       AS DOUBLE
    DIM  Int_Payment  AS DOUBLE
    DIM  Prin_Payment AS DOUBLE
    DIM  Mon_Payment  AS DOUBLE
    DIM  SumPrinc     AS DOUBLE
    DIM  SumInt       AS DOUBLE
    DIM  z            AS LONG
    '=============================
    Amount   = VAL(RETAIN$(BCX_GET_TEXT$(Input1), ".0123456789"))
    Interest = VAL(BCX_GET_TEXT$(Input2))
    Years    = VAL(BCX_GET_TEXT$(Input3))
    Paymnt   = PMT(Interest, Years*12, Amount, 0)

    Mon_Payment = Paymnt

    BCX_LV_Reset (LView1, 4, Years * 12)

    Set_ColumnText(LView1, 0, "Payment  ")
    Set_ColumnText(LView1, 1, "Interest ")
    Set_ColumnText(LView1, 2, "Principal")
    Set_ColumnText(LView1, 3, "Balance  ")

    FOR z = 1 TO Years * 12
        Int_Payment = INTEREST_PAYMENT(Interest, Amount)
        Prin_Payment = Paymnt - Int_Payment
        SumPrinc = SumPrinc + Prin_Payment
        SumInt   = SumInt   + Int_Payment
        ListView_SetItemText (LView1, z-1, 0, STR$(z))
        ListView_SetItemText (LView1, z-1, 1, USING$("###.##", Int_Payment))
        ListView_SetItemText (LView1, z-1, 2, USING$("###.##", Prin_Payment))
        Amount = Amount - Prin_Payment
        ListView_SetItemText (LView1, z-1, 3, USING$("###.##", Amount))
    NEXT

    ListView_SetItemText (LView1, z, 3, " ")  ' add a line at the bottom

    FOR z = 0 TO 3
        SendMessage (LView1, LVM_SETCOLUMNWIDTH, z, LVSCW_AUTOSIZE_USEHEADER)
    NEXT

    BCX_LV_Justify (LView1, 0, HDF_CENTER)
    BCX_LV_Justify (LView1, 1, HDF_RIGHT)
    BCX_LV_Justify (LView1, 2, HDF_RIGHT)
    BCX_LV_Justify (LView1, 3, HDF_RIGHT)

    BCX_SET_TEXT (Label4, USING$("###.##", SumPrinc))
    BCX_SET_TEXT (Label5, USING$("###.##", SumInt))
    BCX_SET_TEXT (Label6, USING$("###.##", Mon_Payment))
END SUB



FUNCTION INTEREST_PAYMENT (i AS DOUBLE, Balance AS DOUBLE) AS DOUBLE
    FUNCTION = (i/12/100) * Balance
END FUNCTION




FUNCTION PMT (i AS DOUBLE, np AS DOUBLE, pv AS DOUBLE, fv AS DOUBLE) AS DOUBLE
    DIM RAW q1 AS DOUBLE
    DIM RAW ir AS DOUBLE
    ir = i/12/100
    q1 = POW (1 + ir, np)
    FUNCTION = ((ir * (fv + q1 * pv))/(-1 + q1))
END FUNCTION




SUB Set_ColumnText (hWnd AS HWND, Column, Text$)
    LOCAL lvc AS LV_COLUMN
    lvc.mask = LVCF_TEXT
    lvc.pszText = Text$
    SendMessage (hWnd, LVM_SETCOLUMN, Column, &lvc)
    SendMessage (LView1, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER)
END SUB




SUB BCX_LV_Reset (LView AS HWND, Columns, Rows)
    LOCAL lvItem AS LV_ITEM
    ListView_DeleteAllItems (LView)
    REPEAT Rows
        lvItem.mask      =  LVIF_TEXT
        lvItem.pszText   =  " "
        lvItem.iSubItem  =  0
        ListView_InsertItem(LView, &lvItem)
    END REPEAT
END SUB




SUB BCX_LV_Justify (LV AS HWND, Column, JustifyType)
    LOCAL hHeader AS ULONGLONG
    LOCAL hdi AS HD_ITEM
    '*******************************************
    '  CONST HDF_LEFT      = 0    'JustifyType
    '  CONST HDF_RIGHT     = 1    'JustifyType
    '  CONST HDF_CENTER    = 2    'JustifyType
    '*******************************************
    hHeader     = SendMessage(LV, LVM_FIRST+31, 0, 0)
    hdi.mask    = HDI_FORMAT
    hdi.pszText = " "
    hdi.fmt     = HDF_STRING OR JustifyType
    SendMessage ((HWND)hHeader, HDM_SETITEM, Column, &hdi)
END SUB




'********************************* ListView Sort Support  *************************************



FUNCTION CompareFunc (lParam1 AS LPARAM, lParam2 AS LPARAM, SortType AS LPARAM) AS LRESULT CALLBACK

    STATIC buffer$
    STATIC buffer1$
    STATIC lvi AS LVITEM

    lvi.mask       = LVIF_TEXT
    lvi.pszText    = buffer$
    lvi.cchTextMax = 2047

    SELECT CASE SortType
        CASE 3, 4
        lvi.iSubItem = 1

        CASE 5, 6
        lvi.iSubItem = 2

        CASE 7, 8
        lvi.iSubItem = 3

        CASE 9, 10
        lvi.iSubItem = 4

        CASE ELSE
        lvi.iSubItem = 0
    END SELECT

    SendMessage (LView1, LVM_GETITEMTEXT, lParam1, &lvi)    ' Fetch 1st of two items being compared
    buffer1$ = buffer$                                      ' save it
    SendMessage (LView1, LVM_GETITEMTEXT, lParam2, &lvi)    ' Fetch 2nd of two items being compared

    '**************************************
    ' Here, we sort each column as NUMBERS
    '**************************************

    REMOVE "," FROM TRIM$ (buffer$)    ' numbers cannot have spaces or comma's
    REMOVE "," FROM TRIM$ (buffer1$)   ' numbers cannot have spaces or comma's

    IF IMOD(SortType, 2) THEN         ' Determine ASCENDING or DESCENDING order
        FUNCTION = VAL(buffer1$) > VAL(buffer$)
    ELSE
        FUNCTION = VAL(buffer$) > VAL(buffer1$)
    END IF

END FUNCTION



SUB UpdatelParam(hCtrl AS HWND)
    STATIC lvi AS LVITEM
    STATIC cnt

    cnt = ListView_GetItemCount(hCtrl)
    lvi.mask     = LVIF_PARAM
    lvi.iSubItem = 0
    lvi.iItem    = 0

    WHILE cnt > 0
        lvi.lParam = lvi.iItem
        SendMessage(hCtrl, LVM_SETITEM, 0, &lvi)
        INCR lvi.iItem
        DECR cnt
    WEND
END SUB



'================= D A R K  M O D E ===================


SUB InitDarkMode(hWnd as HWND)
    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, 20, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd,TRUE)
    SetPreferredAppMode(2)

    ' Enable dark mode for form
    SetWindowTheme(hWnd, UCODE$("Explorer"), NULL)

    RefreshImmersiveColorPolicyState()
END SUB

SUB DarkModeFreeLibrary
    IF FHandle THEN
        FreeLibrary(FHandle)
        FHandle = NULL
    END IF
END SUB


SUB SetDarkMode(obj as HWND)
    DIM ClassName$*BCXSTRSIZE
    DIM ThemeClass$

    GetClassName(obj, ClassName, BCXSTRSIZE)

    SELECT CASE TRIM$(ClassName$)
        CASE "SysListView32"
            DIM AS HWND hHeader = ListView_GetHeader(obj)
            ThemeClass$ = "Explorer"
            SetWindowTheme(hHeader, UCODE$("Explorer"), NULL)
            AllowDarkModeForWindow(hHeader, TRUE)
            ListView_SetTextColor(obj, darkTextColor)
            ListView_SetBkColor(obj, darkBkColor)
        CASE "ComboBox"
            ThemeClass$ = "CFD"
        CASE ELSE
            ThemeClass$ = "Explorer"
    END SELECT

    SetWindowTheme(obj, UCODE$(ThemeClass$), NULL);
    AllowDarkModeForWindow(obj, TRUE);
    SendMessage(obj, WM_THEMECHANGED, 0, 0);
END SUB
'================= D A R K  M O D E ===================


Some weirdness with the Listview, however.  When you hit the 'Calc' button, it almost seems like another object is being overlaid. 

But if you mouse over the Listview rows, the row will render correctly until you move off of the row.

AIR.

[MrBcx]

The 64-bit exe built from Pelles looks like your screenshots - Cool!

Out of curiosity, I compiled a 32-bit.  It built but does not run correctly.
That's for another day.  I'm gonna stick with 64-bit and see what I can learn
from your discoveries.  If I hit on anything new, I'll share.

[airr]

Been working on my own demo.  Menuitems, button, and Combo (but not the dropdown yet) seem to work.  Only tested with Pelles 64bit.

Code Select Expand

GUI "DarkMode_Demo"

#include <uxtheme.h>
#include <dwmapi.h>

$PRAGMA lib "uxtheme.lib"
$PRAGMA lib "Dwmapi.lib"

$BCX_RESOURCE
1 24 "dark.exe.manifest"
$BCX_RESOURCE

CONST DWMWA_USE_IMMERSIVE_DARK_MODE = 20

ENUM
   Default = 0
   AllowDark
   ForceDark
   ForceLight
   eMax
END ENUM

ENUM
    mnuNew = 9000
    mnuOpen
    mnuSave
    mnuCut
    mnuCopy
    mnuPaste
    mnuUNDO
    mnuREDO
    mnuSELECTALL
    mnuAbout
    mnuEXIT
END ENUM

    $TYPEDEF INT (WINAPI*TShouldAppsUseDarkMode)()
    $TYPEDEF INT (WINAPI*TAllowDarkModeForWindow)(HWND, INT)
    $TYPEDEF INT (WINAPI*TSetPreferredAppMode)(INT)
    $TYPEDEF INT (WINAPI*TFlushMenuThemes)()
    $TYPEDEF INT (WINAPI*TRefreshImmersiveColorPolicyState)()

DIM RAW ShouldAppsUseDarkMode            AS TShouldAppsUseDarkMode
DIM RAW AllowDarkModeForWindow           AS TAllowDarkModeForWindow
DIM RAW SetPreferredAppMode              AS TSetPreferredAppMode
DIM RAW FlushMenuThemes                  AS TFlushMenuThemes
DIM RAW RefreshImmersiveColorPolicyState AS TRefreshImmersiveColorPolicyState

DIM Form1    AS CONTROL
DIM Stat1    AS CONTROL
DIM Button1  AS CONTROL
DIM Combo1   AS CONTROL

DIM MainMenu AS HMENU
DIM FileMenu AS HMENU


SUB FORMLOAD
   

    GLOBAL FHandle AS HMODULE
    FHandle = LOAD_DLL("uxtheme.dll")
    if FHandle then
        RefreshImmersiveColorPolicyState = GetProcAddress(FHandle, MakeIntResource(104))
        ShouldAppsUseDarkMode            = GetProcAddress(FHandle, MakeIntResource(132))
        AllowDarkModeForWindow           = GetProcAddress(FHandle, MakeIntResource(133))
        SetPreferredAppMode              = GetProcAddress(FHandle, MakeIntResource(135))
        FlushMenuThemes                  = GetProcAddress(FHandle, MakeIntResource(136))
    end if

    Form1 = BCX_FORM("Dark Mode Sample")
    AddMenu(Form1)

    Stat1 = BCX_STATUS("Ready", Form1)
    Button1 = BCX_BUTTON("Button 1", Form1, 102,  100,  5,  40,  12, WS_CHILD OR WS_VISIBLE OR BS_FLAT OR WS_TABSTOP)
    Combo1 = BCX_COMBOBOX("BLAH",Form1, 103, 5,5,90,60)

    SendMessage(Combo1, CB_ADDSTRING, 0, TEXT("Item One"))     
    SendMessage(Combo1, CB_ADDSTRING, 0, TEXT("Item Two"))   
    SendMessage(Combo1, CB_SETCURSEL, 1, 0)

    InitDarkMode(Form1)
    SetDarkMode(Button1)
    SetDarkMode(Combo1)

    CENTER(Form1)
    SHOW(Form1)
END SUB


BEGIN EVENTS
    SELECT CASE CBMSG

        CASE WM_CREATE

    END SELECT
END EVENTS

SUB InitDarkMode(hWnd as HWND)
    DIM AS bool b = TRUE

    ' Enables dark mode for TitleBar
    DwmSetWindowAttribute(hWnd, DWMWA_USE_IMMERSIVE_DARK_MODE, &b, SIZEOF(BOOL))

    ' Enables dark mode for MenuItems
    AllowDarkModeForWindow(hWnd,TRUE)
    SetPreferredAppMode(ForceDark)
    RefreshImmersiveColorPolicyState()
END SUB

SUB SetDarkMode(obj as HWND)
    DIM ClassName$*BCXSTRSIZE
    DIM ThemeClass$

    GetClassName(obj, ClassName, BCXSTRSIZE)

    SELECT CASE TRIM$(ClassName$)
        CASE "ComboBox"
            ThemeClass$ = "CFD"
        CASE "Button"
            ThemeClass$ = "Explorer"
    END SELECT

    SetWindowTheme(obj, UCODE$(ThemeClass$), NULL);
    AllowDarkModeForWindow(obj, TRUE);
    SendMessage(obj, WM_THEMECHANGED, 0, 0);
END SUB

SUB AddMenu(parent as HWND)
    MainMenu = CreateMenu()
    FileMenu = CreateMenu()

    InsertMenu(MainMenu,  0, MF_POPUP, FileMenu, "&File")
    AppendMenu(FileMenu, MF_STRING, mnuNew, E"New\tCtrl-N")
    AppendMenu(FileMenu, MF_STRING, mnuOpen, E"Open\tCtrl-O")
    AppendMenu(FileMenu, MF_STRING, mnuSave, E"Save\tCtrl-S")
    AppendMenu(FileMenu, MF_SEPARATOR, 0, NULL)
    AppendMenu(FileMenu, MF_STRING, mnuEXIT, E"Exit\tAlt-F4")
    SetMenu(parent, MainMenu)
END SUB


AIR.