 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Löwenherz
Anmeldungsdatum: 25.08.2008
Beiträge: 73
Wohnort: auf einer sonnigen Insel :)
|
 Verfasst am: 16.01.2024, 13:07 Titel: Tabcontrol color question |
 |
|
Hallo zusammen habe schon lange nichts mehr mit freebasic programmiert..
Datenverlust kaputte Festplatte und viele Dateien in den letzten Jahren verloren 
Hab eine Übung gebaut ua mit Lothar Schirms Beispiel...
Möchte eine Tabcontrol erstellen mit einem farbigen Windows Fenster oder child Windows
Hier mein Beispiel
| Code: |
'===============================================================================
' 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
|
Vielleicht kann jemand den Code checken danke im voraus
_________________
Das Leben ist wie eine Pralinenschachtel, man weiß nie, was dort drinnen für tolle wie böse Überraschungen stecken |
|
| Nach oben |
|
 |
Lothar Schirm
Anmeldungsdatum: 24.04.2006
Beiträge: 65
Wohnort: Bayern
|
| Verfasst am: 17.01.2024, 11:48 Titel: |
|
|
| function AddTabItem sollte vielleicht eine Sub sein? Ich bekomme beim Kompilieren die Warnung "unbenannt.bas(202) warning 13(1): Function result was not explicitly set". Ansonsten habe ich dir mal einen Link gepostet, siehe https://www.freebasic.net/forum/viewtopic.php?t=32539. |
|
| Nach oben |
|
|
Löwenherz
Anmeldungsdatum: 25.08.2008
Beiträge: 73
Wohnort: auf einer sonnigen Insel :)
|
| Verfasst am: 18.01.2024, 10:03 Titel: |
|
|
Danke Lothar auch für den Link schaue ich mir noch an 
Die Hilfe Datei bzw Befehlsreferenz von freebasic ist die wirklich so alt, 2014?
Gruss aus Nordhessen
Loewenherz
_________________
Das Leben ist wie eine Pralinenschachtel, man weiß nie, was dort drinnen für tolle wie böse Überraschungen stecken |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4648
Wohnort: ~/
|
| Verfasst am: 18.01.2024, 14:18 Titel: |
|
|
| Zitat: | | Die Hilfe Datei bzw Befehlsreferenz von freebasic ist die wirklich so alt, 2014? |
Eine ganze Reihe an Referenzbeiträgen wurden im Laufe der letzten Jahre bearbeitet (manchmal sehr kleine, manchmal umfangreichere Änderungen) und ein paar Artikel habe ich auch neu angelegt (neue Schlüsselwörter in den neueren Compiler-Versionen). Trotzdem befindet sich die Referenz nicht wirklich auf den neusten Stand, weil mir für einen kompetenten Eintrag das nötige Wissen fehlt und ich wohl inzwischen der einzige bin, der überhaupt noch gelegentlich an der Referenz arbeitet.
Die Offline-Ausgabe im CHM-Format ist dagegen leider deutlich veraltet.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
Löwenherz
Anmeldungsdatum: 25.08.2008
Beiträge: 73
Wohnort: auf einer sonnigen Insel :)
|
| Verfasst am: 20.01.2024, 05:15 Titel: |
|
|
Danke nemored kann ich mir gut vorstellen was das für eine Arbeit ist
Hier nun mein neues Code Beispiel um die Farbe der Tabcontrol zu ändern
Hab das Beispiel von Lothar fortgesetzt aber im WM_Notify Bereich gibt's eine Error Meldung ... Evtl liege ich auch falsch mit meinem Ansatz hab ein altes Powerbasic Beispiel gefunden deswegen WM_Notify
| Code: |
'===============================================================================
' 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
DIM SHARED tx AS zstring PTR
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
DIM AS LONG mySci
DIM AS LONG hbrush
DIM htab AS LONG 'hwnd
'DIM hBrush AS HBRUSH
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 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")
' 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 ) '"EDIT"
'Edit2=Scintilla Sci Edit
Edit2 = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", "place a text here ", _
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)
DIM htab AS LONG ' ?
' Dim rsult As Const long
CASE WM_NOTIFY
DIM lpnm AS NMHDR PTR
lpnm = lParam
'error next line
IF lpnm->htab(rsult) = 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
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))
FUNCTION=1
END FUNCTION
|
Lionheart
_________________
Das Leben ist wie eine Pralinenschachtel, man weiß nie, was dort drinnen für tolle wie böse Überraschungen stecken
Zuletzt bearbeitet von Löwenherz am 20.01.2024, 05:30, insgesamt 2-mal bearbeitet |
|
| Nach oben |
|
|
Löwenherz
Anmeldungsdatum: 25.08.2008
Beiträge: 73
Wohnort: auf einer sonnigen Insel :)
|
| Verfasst am: 20.01.2024, 05:19 Titel: |
|
|
Test wie kann ich diese Post wieder löschen?
_________________
Das Leben ist wie eine Pralinenschachtel, man weiß nie, was dort drinnen für tolle wie böse Überraschungen stecken |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
