Tabcontrol color winmain
Tabcontrol color winmain
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
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
Re: Tabcontrol color winmain
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
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
-
- Posts: 441
- Joined: Sep 28, 2013 15:08
- Location: Germany
Re: Tabcontrol color winmain
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.
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.
Re: Tabcontrol color winmain
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 wrote: ↑Jan 15, 2024 21:36 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
Re: Tabcontrol color winmain
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
lionheart
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
Last edited by Löwenherz on Jan 19, 2024 19:07, edited 1 time in total.
Re: Tabcontrol color winmain
@lothar Schirm thank you for the Infos
Re: Tabcontrol color winmain
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
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
Re: Tabcontrol color winmain
This is what I did so far:
I don't know if this is the proper way to do it.
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
-
- Posts: 56
- Joined: Dec 11, 2016 17:22
Re: Tabcontrol color winmain
I see your'e going well, I got an example written in Oxygen BASIC if interested, maybe it can help a little...
Color TabControl
Color TabControl
Re: Tabcontrol color winmain
Thank you Pierre for the detailed example.
I will take a closer look when I am healthy again.
I will take a closer look when I am healthy again.
Re: Tabcontrol color winmain
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