Tabcontrol color winmain

[Löwenherz]

Hello all I am looking for a freebasic example with tabcontrol and Change the color Background
In winmain wndproc style

I have lost all examples on my old Notebook some years ago and would Like to Program again with freebasic ... Existing example can Help or a Link thx

Regards lionheart

[Löwenherz]

Hello again Here I Made a First example with tabcontrol and used an example from Lothar Schirm AS basis

I am Not Sure If declare functions are OK and the addtabitem function but I could Compile it

Code: Select all

 
 
'===============================================================================
' WinAPI_GUI.bas
' Windows API GUI
' Vorlage mit Menue, Textbox, Editor, Buttons, Listbox
' Erstellt am 20.02.2021
' Letzte Bearbeitung am 09.01.2022
'===============================================================================

#INCLUDE ONCE "windows.bi"
#Include "/win/commctrl.bi"

DIM SHARED AS HMENU hMenu, hDatei, hHilfe
DIM SHARED AS HWND Edit1, Edit2, List1, Button1, Button2,hTab
Dim As HWND hWnd, ID_TABCTRL, EDIT, BTN_ADD, BTN_DEL, BTN_DELALL, LPARAM, LPTCITM   ' Window variable and objects variables
Dim As Integer Count
Dim As ZString*1024 days
Dim As String text2
Declare Function AddTabItem(ByVal htab As hwnd, ByVal Days As String) As Long  

FUNCTION WndProc(BYVAL hWnd AS HWND, BYVAL Msg AS UINT, BYVAL wParam AS WPARAM, _
                 BYVAL lParam AS LPARAM ) AS LRESULT

  DIM AS HFONT Font
  DIM AS INTEGER i
  DIM AS ZSTRING*1024 text

    FUNCTION = 0

    SELECT CASE Msg

        CASE WM_CREATE

            'Menü:
            hMenu = CreateMenu()
            hDatei = CreateMenu()
            hHilfe = CreateMenu()
            InsertMenu(hMenu, 0, MF_POPUP, CINT(hDatei), "Datei")
            InsertMenu(hMenu, 0, MF_POPUP, CINT(hHilfe), "Hilfe")
            AppendMenu(hDatei, 0, 1, "Neu" )
            AppendMenu(hDatei, 0, 2, "Oeffnen" )
            AppendMenu(hDatei, 0, 3, "Speichern" )
            AppendMenu(hDatei, 0, 4, "Beenden" )
            AppendMenu(hHilfe, 0, 5, "?")
            SetMenu(hwnd, hMenu)

            'Controls:
        VAR hStatic1 = CreateWindowEx(0, "STATIC", "Geben Sie hier einen Text ein:", _
                WS_VISIBLE OR WS_CHILD, _
                20, 40, 200, 20, hWnd, 0, 0, 0)
                ' Create tab
            hTab = CreateWindowEX( 0, WC_TABCONTROL , "", WS_CHILD Or WS_CLIPSIBLINGS Or WS_VISIBLE, 10, 10, 330 ,150, hWnd, 0, 0, 0 )

    ' Add tab items for each day of the week
    AddTabItem(hTab, "Monday")
    AddTabItem(hTab, "Tuesday")
    AddTabItem(hTab, "Wednesday")
    AddTabItem(hTab, "Thursday")
    AddTabItem(hTab, "Friday")
    AddTabItem(hTab, "Saturday")
    
    ' Add more days as needed

            Edit1 = CreateWindowEx(WS_EX_CLIENTEDGE, "EDIT", "nice day...", WS_BORDER OR WS_VISIBLE OR WS_CHILD OR ES_AUTOHSCROLL, _
                20, 50, 200, 20, hTab, 0, 0, 0 ) 'hWnd
            Button1 = CreateWindowEx(0, "BUTTON", "Kopieren", WS_VISIBLE OR WS_CHILD, _
                60, 90, 100, 20, hWnd, 0, 0, 0 )
            Edit2 = CreateWindowEx(WS_EX_CLIENTEDGE, "EDIT", "Bitte Text eingeben!", _
                WS_BORDER OR WS_VISIBLE OR WS_CHILD OR WS_HSCROLL OR WS_VSCROLL OR ES_MULTILINE, _
                20, 120, 300, 200, hWnd, 0, 0, 0 )
            Button2 = CreateWindowEx(0, "BUTTON", "Kopieren", WS_VISIBLE OR WS_CHILD, _
                340, 200, 100, 20, hWnd, 0, 0, 0 )
            List1 = CreateWindowEx(WS_EX_CLIENTEDGE, "LISTBOX", "", _
                WS_BORDER OR WS_VISIBLE OR WS_CHILD OR WS_VSCROLL OR LBS_NOTIFY, _
                20, 350, 200, 200, hWnd, 0, 0, 0 )

            'Schriftart fuer den Editor:
            Font = CreateFont(0, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET, FALSE, FALSE, _
        DEFAULT_QUALITY, DEFAULT_PITCH OR FF_ROMAN, "Courier New")
            SendMessage(Edit2, WM_SETFONT, CAST(WPARAM, Font), True)
            SetWindowText(Edit2, "Bitte hier einen Text schreiben!")

            'Listbox befuellen:
            FOR i = 0 TO 20
                text = "Eintrag Nr. " + STR(i)
                SendMessage(List1, LB_ADDSTRING, 0, CAST(LPARAM, STRPTR(text)))
            NEXT

        CASE WM_COMMAND

            SELECT CASE LOWORD(wParam)
                'Menü:
                CASE 1
                    MessageBox(0, "Neue Datei ...", "Datei", 0)
                CASE 2
                    MessageBox(0, "Oeffnen ...", "Datei", 0)
                CASE 3
                    MessageBox(0, "Speichern ...", "Datei", 0)
                CASE 4
                    SendMessage(hWnd, WM_CLOSE, 0, 0)
                CASE 5
                    MessageBox(0, "Ich kann Ihnen leider nicht helfen!", "Hilfe", 0)
            END SELECT

            SELECT CASE HIWORD(wParam)

                CASE BN_CLICKED
                    SELECT CASE lParam
                        CASE Button1
                            'Text aus Edit1 auf die Konsole kopieren:
                            GetWindowText(Edit1, text, SIZEOF(text))
                            PRINT text
                        CASE Button2
                            'Text aus Edit2 auf die Konsole kopieren:
                            GetWindowText(Edit2, text, SIZEOF(text))
                            PRINT text
                    END SELECT

                CASE LBN_SELCHANGE
                    IF lParam = List1 THEN
                        'Gewählten Index mit Text auf Konsole ausgeben
                        i = SendMessage(List1, LB_GETCURSEL, 0, 0)
                        SendMessage(List1, LB_GETTEXT, i, CAST(LPARAM, STRPTR(text)))
                        PRINT i; SPACE(1); text
                    END IF

            END SELECT

        CASE WM_PAINT

        CASE WM_SIZE

        CASE WM_KEYDOWN
            'Beenden mit ESC-Taste:
            IF(LOBYTE(wParam) = 27) THEN PostMessage(hWnd, WM_CLOSE, 0, 0)

        CASE WM_DESTROY
            PostQuitMessage(0)
            EXIT FUNCTION

    END SELECT

    RETURN DefWindowProc(hWnd, Msg, wParam, lParam)

END FUNCTION


FUNCTION WinMain(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, BYVAL iCmdShow AS INTEGER) AS INTEGER

    DIM Msg AS MSG
    DIM wcls AS WNDCLASS
    DIM hWnd AS HWND

    FUNCTION = 0

    WITH wcls
        .style         = CS_HREDRAW OR CS_VREDRAW
        .lpfnWndProc   = @WndProc
        .cbClsExtra    = 0
        .cbWndExtra    = 0
        .hInstance     = hInstance
        .hIcon         = LoadIcon(0, IDI_APPLICATION )
        .hCursor       = LoadCursor(0, IDC_ARROW )
        .hbrBackground = CAST(HBRUSH,COLOR_WINDOW)
        .lpszMenuName  = 0
        .lpszClassName = @"MainWindow"
    END WITH

    IF(RegisterClass( @wcls) = FALSE ) THEN
         MessageBox(0, "Failed to register wcls", "Error", MB_ICONERROR )
         EXIT FUNCTION
    END IF

    'Fenster:
    hWnd = CreateWindowEx(0, @"MainWindow", "Windows GUI", WS_OVERLAPPEDWINDOW OR WS_VISIBLE, _
        CW_USEDEFAULT, CW_USEDEFAULT, 500, 650, 0, 0, hInstance, 0 )

    ShowWindow(hWnd, iCmdShow)
    UpdateWindow(hWnd)

    WHILE( GetMessage(@Msg, 0, 0, 0 ) <> FALSE )
        TranslateMessage(@Msg )
        DispatchMessage(@Msg )
    WEND

    RETURN Msg.wParam

END FUNCTION

WinMain(GetModuleHandle(0), 0, COMMAND(), SW_NORMAL)

End

function AddTabItem(ByVal hTab AS HWND, ByVal Days AS String) As long
    DIM tci AS TCITEM
    tci.mask = TCIF_TEXT
    tci.pszText = StrPtr(Days)
    TabCtrl_InsertItem(htab, days, @tci)
    
    SendMessage(hTab, TCM_INSERTITEM, 0, CAST(LPARAM, @tci))
END Function

 

[Lothar Schirm]

Hi Löwenherz,
this is Vanya's homepage: https://users.freebasic-portal.de/freeb ... index.html. It is in Russian, but there is a button for translation into English. A fantastic collection of FB stuff and tutorials! Go to "Articles -> FreeBasic + API -> Child window - TAB". I am not familiar with Tab controls, but maybe Vanyas article may help you.

[UEZ]

Hello all I am looking for a freebasic example with tabcontrol and Change the color Background
In winmain wndproc style

I have lost all examples on my old Notebook some years ago and would Like to Program again with freebasic ... Existing example can Help or a Link thx

Regards lionheart

What do you mean with "Change the color Background" exactly? You mean the tab control color, background of the tab control or the GUI background color?

[Löwenherz]

Yes UEZ thanks for Feedback .. sorry I mean the tab Control how to Change the color If its possible ... I have placed a scintilla Control in the tabcontrol and want to Change the Grey color of the usual tab Control... Would Like to build an Editor step by step

I am Not Sure what's responsible for Tab Control color change

Code: Select all

 [
 
Below wndProc() function
...
WM_CREATE

WM_CTLCOLOR

WM_DRAWITEM

WM_PAINT

....

lionheart

[Löwenherz]

@lothar Schirm thank you for the Infos

[Löwenherz]

OK perhaps this way May be better choice for tabcontrol Background color to Change... Found in Powerbasic an old Code snippets dont know If thats correct

I have Got an Error in WM_Notify Part
Code snippets below

Code: Select all

' Create tab control
                hTab = CreateWindowEX( 0, WC_TABCONTROL , "", WS_CHILD Or WS_CLIPSIBLINGS Or WS_VISIBLE, 10, 10, 330 ,150, hWnd, 0, 0, 0 )

    ' Add tab items for each day of the week
    AddTabItem(hTab, "Monday")
    AddTabItem(hTab, "Tuesday")
    AddTabItem(hTab, "Wednesday")
    AddTabItem(hTab, "Thursday")
    AddTabItem(hTab, "Friday")
    AddTabItem(hTab, "Saturday")
    
 CASE WM_NOTIFY
            DIM lpnm AS NMHDR PTR
            lpnm = lParam
            'error next line  ' htab IS a problem
            'IF lpnm->htab = TCN_CUSTOMDRAW THEN
            '
                DIM lpNMTVCustomDraw AS NMTVCUSTOMDRAW PTR
                lpNMTVCustomDraw = lParam
                IF lpNMTVCustomDraw->nmcd.dwDrawStage = CDDS_PREPAINT THEN
                    FUNCTION = CDRF_NOTIFYITEMDRAW
                ELSEIF lpNMTVCustomDraw->nmcd.dwDrawStage = CDDS_ITEMPREPAINT THEN
                    lpNMTVCustomDraw->clrTextBk = RGB(255, 100, 100)
                    FUNCTION = CDRF_NEWFONT
                END IF
            'END IF        
   

[UEZ]

This is what I did so far:

Code: Select all

'Coded by UEZ build 2024-01-31 beta
#include "windows.bi"
#include  "win/commctrl.bi"

Dim szAppName As ZString * 30 => "FB GUI"
Dim As String sTitle = "Windows GUI TAB Demo by UEZ"
Dim Shared As ULong aTabColors()
Dim Shared As UShort iW, iH
Dim Shared As HWND hWND, hTab
iW = 600
iH = (iW * 9) Shr 4

Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
	Select Case uMsg
		Case WM_CLOSE
			PostQuitMessage(0)
			Return 0
        Case WM_CLOSE
            DestroyWindow(hWnd)
		Case WM_PAINT
			Dim As RECT tTabRect, tTabRect2
			GetWindowRect(hTab, @tTabRect2)
			SendMessage(hTab, TCM_GETITEMRECT, Cast(wParam, SendMessage(hTab, TCM_GETCURSEL, 0, 0)), Cast(lParam, @tTabRect))
						
			Dim As Point pt
            pt.x = tTabRect2.left
            pt.y = tTabRect2.top + tTabRect.bottom
            ScreenToClient(hWnd, @pt)
            
            tTabRect2.left = pt.x - 10
            tTabRect2.top = pt.y - 10
            tTabRect2.right = iW - 20
            tTabRect2.bottom = iH - 20
 			
 			Dim As HDC hDC = GetDC(hTab)
 			Dim As HBRUSH hBrush2 = CreateSolidBrush(aTabColors(SendMessage(hTab, TCM_GETCURSEL, Cast(wParam, 0), Cast(lParam, 0))))
			Dim As HGDIOBJ hBrushOld2 = SelectObject(hDC, hBrush2)
			FillRect(hDC, @tTabRect2, hBrush2)
			DrawFocusRect(hDC, @tTabRect2)
			SelectObject(hDC, hBrushOld2)
			DeleteObject(hBrush2)
			DeleteDC(hDC)
			Return 0
		Case WM_DRAWITEM
			Dim As DRAWITEMSTRUCT Ptr pDRAWITEMSTRUCT
			pDRAWITEMSTRUCT = Cast(DRAWITEMSTRUCT Ptr, lParam)
			If pDRAWITEMSTRUCT->CtlType <> ODT_TAB Then Return 0
			If pDRAWITEMSTRUCT->itemAction <> ODA_DRAWENTIRE Then Return 0
			SetBkMode(pDRAWITEMSTRUCT->hDC, TRANSPARENT)
			Dim As UByte iID = pDRAWITEMSTRUCT->itemID
			
			Dim As HBRUSH hBrush = CreateSolidBrush(aTabColors(iID))
			Dim As HGDIOBJ hBrushOld = SelectObject(pDRAWITEMSTRUCT->hDC, hBrush)
			Dim As RECT tTabRect
			
			SendMessage(hTab, TCM_GETITEMRECT, Cast(wParam, pDRAWITEMSTRUCT->itemID), Cast(lParam, @tTabRect))		
			FillRect(pDRAWITEMSTRUCT->hDC, @tTabRect, hBrush)
			
			pDRAWITEMSTRUCT->rcItem.left += 10
			pDRAWITEMSTRUCT->rcItem.top += 5
			DrawText(pDRAWITEMSTRUCT->hDC, Str("Tab" & pDRAWITEMSTRUCT->itemID + 1), Len(Str("Tab" & pDRAWITEMSTRUCT->itemID + 1)), @pDRAWITEMSTRUCT->rcItem, DT_LEFT)

			SelectObject(pDRAWITEMSTRUCT->hDC, hBrushOld)
			DeleteObject(hBrush)
			Return 0
	End Select
	Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Dim wc As WNDCLASSEX
Dim msg As MSG
Dim As Integer sW, sH
ScreenInfo(sW, sH)

With wc '...'
	.style         = CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc   = @WndProc
	.cbClsExtra    = NULL
	.cbWndExtra    = NULL
	.hInstance     = GetModuleHandle(NULL)
	.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
	.hCursor       = LoadCursor(NULL, IDC_ARROW)
	.hbrBackground = GetStockObject(DKGRAY_BRUSH)
	.lpszMenuName  = NULL
	.lpszClassName = @szAppName
	.cbSize        = SizeOf(WNDCLASSEX)
End With
 
RegisterClassEx(@wc)

hWND = CreateWindowEx(0, wc.lpszClassName, sTitle, _
					   WS_OVERLAPPEDWINDOW Or WS_VISIBLE Xor WS_MAXIMIZEBOX, _
					   (sW - iW) / 2, (sH - iH) / 2, _	'display GUI centered
					   iW, iH, _
					   NULL, NULL, wc.hInstance, NULL)

Dim As RECT rcClient
GetClientRect(hWND, @rcClient)

hTab = CreateWindow(WC_TABCONTROL, "", WS_CHILD Or WS_CLIPSIBLINGS Or WS_VISIBLE Or TCS_OWNERDRAWFIXED, 10, 10, rcClient.right - 20, rcClient.bottom - 20, hWND, NULL, wc.hInstance, NULL)


Dim As String sTabNames(0 To ...) = {"Tab1", "Tab2", "Tab3"}
ReDim aTabColors(0 To UBound(sTabNames))
aTabColors(0) = &h4040FF
aTabColors(1) = &h80FF80
aTabColors(2) = &hFFB0B0

Dim As TCITEM tTabAttributes
tTabAttributes.mask = TCIF_TEXT Or TCIF_IMAGE
tTabAttributes.iImage = -1

Dim As Long i
For i = 0 To UBound(sTabNames)
	tTabAttributes.pszText = StrPtr(sTabNames(i))
	TabCtrl_InsertItem(hTab, i, @tTabAttributes)
Next

SendMessage(hTab, TCM_SETCURSEL, 1, 0)

UpdateWindow(hWND)
 
While GetMessage(@msg, 0, 0, 0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
Wend

I don't know if this is the proper way to do it.

[Pierre Bellisle]

I see your'e going well, I got an example written in Oxygen BASIC if interested, maybe it can help a little...

Color TabControl

[UEZ]

Thank you Pierre for the detailed example.
I will take a closer look when I am healthy again.

[Löwenherz]

Many thanks UEZ thats looking indeed good .. exactly what I was looking for great! Good Job. I am Not working again for a Long Time with freebasic and must study a Lot of Things new but I Like freebasic .. get Well soon See you Löwenherz