- Welcome to PlanetSquires Forums.
PlanetSquires Forums
"It’s not a bug; it’s an undocumented feature" - Anonymous
Recent posts
#71
General Board / Re: question about compiling e...
Last post by Paul Squires - September 14, 2025, 12:04:08 AMI went into your profile and changed the time zone to be "Central European Time (CEST/CST) UTC+2:00"
Hopefully this change allows you to view the forum posts based on your time zone.
Hopefully this change allows you to view the forum posts based on your time zone.
#72
José Roca Software / Re: Docking Windows example?
Last post by José Roca - September 13, 2025, 10:11:21 PMI also have fixed the repainting problems of the original SDK code.
Code Select
' docking window
' freebasic
#Include "windows.bi"
#Include "AfxNova/CWindow.inc"
Dim Shared hDock As HWND
Dim Shared hClient As HWND
Dim Shared isDragging As BOOL = FALSE
Dim Shared dragOffsetX As Integer, dragOffsetY As Integer
Const DOCK_WIDTH = 240
Const DOCK_HEIGHT = 160
Enum DockPos
DOCK_NONE
DOCK_LEFT
DOCK_RIGHT
DOCK_TOP
DOCK_BOTTOM
DOCK_FLOAT
End Enum
Dim Shared dockState As DockPos = DOCK_LEFT
Function WndProc(BYVAL hWnd As HWND, BYVAL msg As UINT, BYVAL wParam As WPARAM, BYVAL lParam As LPARAM) As LRESULT
Select Case msg
Case WM_CREATE
AfxEnableDarkModeForWindow(hwnd)
' Dockbares Panel
DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
IF pWindow THEN
hDock = pWindow->AddControl("Static", hWnd, 1001, "Dock Panel move me", _
20, 20, DOCK_WIDTH, DOCK_HEIGHT, WS_CHILD Or WS_VISIBLE Or SS_CENTER, WS_EX_CLIENTEDGE)
' Client Area als Control
hClient = pWindow->AddControl("Static", hWnd, 0, "Client Area", _
220, 20, 260, DOCK_HEIGHT, WS_CHILD Or WS_VISIBLE Or SS_CENTER, WS_EX_CLIENTEDGE)
END IF
Return 0
' // Sent when the user selects a command item from a menu, when a control sends a
' // notification message to its parent window, or when an accelerator keystroke is translated.
CASE WM_COMMAND
SELECT CASE CBCTL(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF CBCTLMSG(wParam, lParam) = BN_CLICKED THEN SendMessageW(hwnd, WM_CLOSE, 0, 0)
END SELECT
RETURN 0
Case WM_SIZE
Dim cx As Integer = LoWord(lParam)
Dim cy As Integer = HiWord(lParam)
Select Case dockState
Case DOCK_LEFT
MoveWindow(hDock, 0, 0, DOCK_WIDTH, cy, TRUE)
MoveWindow(hClient, DOCK_WIDTH, 0, cx-DOCK_WIDTH, cy, TRUE)
InvalidateRect(hDock, NULL, TRUE)
UpdateWindow(hDock)
InvalidateRect(hClient, NULL, TRUE)
UpdateWindow(hClient)
Case DOCK_RIGHT
MoveWindow(hDock, cx-DOCK_WIDTH, 0, DOCK_WIDTH, cy, TRUE)
MoveWindow(hClient, 0, 0, cx-DOCK_WIDTH, cy, TRUE)
InvalidateRect(hDock, NULL, TRUE)
UpdateWindow(hDock)
InvalidateRect(hClient, NULL, TRUE)
UpdateWindow(hClient)
Case DOCK_TOP
MoveWindow(hDock, 0, 0, cx, DOCK_HEIGHT, TRUE)
MoveWindow(hClient, 0, DOCK_HEIGHT, cx, cy-DOCK_HEIGHT, TRUE)
InvalidateRect(hDock, NULL, TRUE)
UpdateWindow(hDock)
InvalidateRect(hClient, NULL, TRUE)
UpdateWindow(hClient)
Case DOCK_BOTTOM
Dim clientHeight As Integer = cy - DOCK_HEIGHT
If clientHeight < 0 Then clientHeight = 0 ' Prevent negative height
MoveWindow(hDock, 0, clientHeight, cx, DOCK_HEIGHT, TRUE)
MoveWindow(hClient, 0, 0, cx, clientHeight, TRUE)
InvalidateRect(hDock, NULL, TRUE)
UpdateWindow(hDock)
InvalidateRect(hClient, NULL, TRUE)
UpdateWindow(hClient)
'Case DOCK_FLOAT
' ' bleibt an aktueller Position
' MoveWindow(hClient, 0, 0, cx, cy, TRUE)
End Select
Return 0
Case WM_LBUTTONDOWN
Dim pt As POINT
pt.x = LoWord(lParam)
pt.y = HiWord(lParam)
Dim rc As RECT
GetWindowRect(hDock, @rc)
ScreenToClient(hWnd, Cast(LPPOINT, @rc.Left))
ScreenToClient(hWnd, Cast(LPPOINT, @rc.Right))
If PtInRect(@rc, pt) Then
isDragging = TRUE
SetCapture(hWnd)
dragOffsetX = pt.x - rc.Left
dragOffsetY = pt.y - rc.Top
EndIf
Return 0
Case WM_MOUSEMOVE
' If isDragging Then
' Dim pt As POINT
' pt.x = LoWord(lParam)
' pt.y = HiWord(lParam)
' ' Panel folgt Maus
' MoveWindow(hDock, pt.x - dragOffsetX, pt.y - dragOffsetY, 120, 80, TRUE)
' EndIf
' Return 0
If isDragging Then
Dim pt As POINT
pt.x = LoWord(lParam)
pt.y = HiWord(lParam)
Dim rcDock As RECT
GetWindowRect(hDock, @rcDock)
ScreenToClient(hWnd, Cast(LPPOINT, @rcDock.Left))
ScreenToClient(hWnd, Cast(LPPOINT, @rcDock.Right))
Dim dockWidth As Integer = rcDock.Right - rcDock.Left
Dim dockHeight As Integer = rcDock.Bottom - rcDock.Top
MoveWindow(hDock, pt.x - dragOffsetX, pt.y - dragOffsetY, dockWidth, dockHeight, TRUE)
InvalidateRect(hDock, NULL, TRUE)
UpdateWindow(hDock)
EndIf
Return 0
Case WM_LBUTTONUP
If isDragging Then
ReleaseCapture()
isDragging = FALSE
' Dock-Bereich ermitteln
Dim As Integer cx,cy
Dim rc As RECT
GetClientRect(hWnd, @rc)
cx = rc.Right
cy = rc.Bottom
Dim dockRc As RECT
GetWindowRect(hDock, @dockRc)
ScreenToClient(hWnd, Cast(LPPOINT, @dockRc.Left))
ScreenToClient(hWnd, Cast(LPPOINT, @dockRc.Right))
' If dockRc.Left < 50 Then
' dockState = DOCK_LEFT
' ElseIf dockRc.Right > cx - AfxScaleX(50) Then
' dockState = DOCK_RIGHT
' ElseIf dockRc.Top < AfxScaleX(50) Then
' dockState = DOCK_TOP
' ElseIf dockRc.Bottom > cy - AfxScaleY(50) Then
' dockState = DOCK_BOTTOM
' Else
' dockState = DOCK_FLOAT
' EndIf
Dim edgeThresholdX As LONG = cx \ 10 ' 10% of width
Dim edgeThresholdY As LONG = cy \ 10 ' 10% of height
If dockRc.Left < edgeThresholdX Then
dockState = DOCK_LEFT
ElseIf dockRc.Right > cx - edgeThresholdX Then
dockState = DOCK_RIGHT
ElseIf dockRc.Top < edgeThresholdY Then
dockState = DOCK_TOP
ElseIf dockRc.Bottom > cy - edgeThresholdY Then
dockState = DOCK_BOTTOM
Else
dockState = DOCK_FLOAT
End If
' neu zeichnen
SendMessage(hWnd, WM_SIZE, 0, cy Shl 16 Or cx)
EndIf
Return 0
Case WM_DESTROY
PostQuitMessage(0)
Return 0
End Select
Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function
Function WinMain(BYVAL hInstance As HINSTANCE, BYVAL hPrevInstance As HINSTANCE, BYREF szCmdLine As String, BYVAL nCmdShow As Integer) As Integer
Dim wc As WNDCLASS
Dim msg As MSG
Dim hWnd As HWND
' // Set process DPI aware
SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE)
' // Enable visual styles without including a manifest file
AfxEnableVisualStyles
' wc.style = CS_HREDRAW Or CS_VREDRAW
' wc.lpfnWndProc = @WndProc
' wc.cbClsExtra = 0
' wc.cbWndExtra = 0
' wc.hInstance = hInstance
' wc.hIcon = LoadIcon(NULL, IDI_APPLICATION)
' wc.hCursor = LoadCursor(NULL, IDC_ARROW)
' wc.hbrBackground = GetStockObject(WHITE_BRUSH)
' wc.lpszMenuName = NULL
' wc.lpszClassName = @"DockTest"
' If RegisterClass(@wc) = FALSE Then Return 0
' hWnd = CreateWindowEx(0, "DockTest", "Docking Drag Example", WS_OVERLAPPEDWINDOW, _
' CW_USEDEFAULT, CW_USEDEFAULT, 700, 500, _
' NULL, NULL, hInstance, NULL)
' // Creates the main window
DIM pWindow AS CWindow = "DockTest"
hwnd = pWindow.Create(NULL, "Docking Drag Example", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, 700, 500)
pWindow.SetBackColor(RGB_GOLD)
pWindow.Center
' ShowWindow(hWnd, nCmdShow)
' UpdateWindow(hWnd)
' While GetMessage(@msg, NULL, 0, 0) <> FALSE
' TranslateMessage(@msg)
' DispatchMessage(@msg)
' Wend
' Return msg.wParam
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
End Function
End WinMain(GetModuleHandle(NULL), NULL, Command(), SW_NORMAL)
'ends
#73
José Roca Software / Re: Docking Windows example?
Last post by Frank Bruebach - September 13, 2025, 04:37:48 PMhello jose, perhaps you can check my afxnova..docking window test example.
something is wrong or missing. cannot see the panel how I wished.
it's not possible to add controls in wndproc() below wm_create part?
code example isnt perfect, I know..
regards, frank
something is wrong or missing. cannot see the panel how I wished.
it's not possible to add controls in wndproc() below wm_create part?
code example isnt perfect, I know..
regards, frank
Code Select
' docking window test with tiko & afxnova
'
#define UNICODE
#INCLUDE ONCE "AfxNova/CWindow.inc"
USING AfxNova
DECLARE FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END wWinMain(GetModuleHandleW(NULL), NULL, wCommand(), SW_NORMAL)
' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
CONST IDC_DOCK1 = 1003
CONST IDC_DOCK2 = 1004
' ========================================================================================
' Docking Support (Globals)
' ========================================================================================
Enum DockPos
DOCK_LEFT
DOCK_RIGHT
DOCK_TOP
DOCK_BOTTOM
DOCK_FLOAT
End Enum
Dim Shared dockState As DockPos = DOCK_LEFT
Dim Shared hDock As HWND
Dim Shared hClient As HWND
Dim Shared isDragging As Boolean
Dim Shared dragOffsetX As Integer, dragOffsetY As Integer
Const DOCK_WIDTH = 240
Const DOCK_HEIGHT = 160
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE)
' // Enable visual styles without including a manifest file
AfxEnableVisualStyles
' // Creates the main window
DIM pWindow AS CWindow = "MyClassName" ' Use the name you wish
DIM hWin AS HWND = pWindow.Create(NULL, "CWindow - Docking Drag Example", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(500, 320)
' // Centers the window
pWindow.Center
' // Set the main window background color
pWindow.SetBackColor(RGB_GOLD)
' Add a dockable Panel as Control
DIM hDock AS HWND = pWindow.AddControl("Static", hWin, IDC_DOCK1, "Dock Panel move me", _
20, 20, DOCK_WIDTH, DOCK_HEIGHT)
' Client Area als Control
hClient = pWindow.AddControl("Static", hWin, IDC_DOCK2, "Client Area", _
150, 20, 200, 200)
' // Anchor the controls
pWindow.AnchorControl(hWin, IDC_DOCK1, AFX_ANCHOR_WIDTH)
pWindow.AnchorControl(hWin, IDC_DOCK2, AFX_ANCHOR_HEIGHT_WIDTH)
' Add a dockable Panel as Control ends
' // Adds a button
pWindow.AddControl("Button", hWin, IDCANCEL, "&Close", 305, 270, 75, 30)
' // Anchors the button to the bottom and the right side of the main window
pWindow.AnchorControl(IDCANCEL, AFX_ANCHOR_BOTTOM_RIGHT)
' // Set the focus In the edit control
SetFocus hDock '
' // Displays the window and dispatches the Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure (adapted for Docking + AfxNova)
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM pWindow AS CWindow = "MyClassName"
SELECT CASE uMsg
CASE WM_CREATE
' Dockbares Panel als Control, this control below doesn't work why not?
DIM hDock AS HWND = pWindow.AddControl("Static", hwnd, IDC_DOCK1, "Dock Panel move me", _
20, 20, DOCK_WIDTH, DOCK_HEIGHT)
' Client Area als Control
hClient = pWindow.AddControl("Static", hwnd, IDC_DOCK2, "Client Area", _
150, 20, 200, 200)
'RETURN 0
CASE WM_SIZE
Dim cx As Integer = LoWord(lParam)
Dim cy As Integer = HiWord(lParam)
SELECT CASE dockState
CASE DOCK_LEFT
MoveWindow(hDock, 0, 0, DOCK_WIDTH, cy, TRUE)
MoveWindow(hClient, DOCK_WIDTH, 0, cx-DOCK_WIDTH, cy, TRUE)
CASE DOCK_RIGHT
MoveWindow(hDock, cx-DOCK_WIDTH, 0, DOCK_WIDTH, cy, TRUE)
MoveWindow(hClient, 0, 0, cx-DOCK_WIDTH, cy, TRUE)
CASE DOCK_TOP
MoveWindow(hDock, 0, 0, cx, DOCK_HEIGHT, TRUE)
MoveWindow(hClient, 0, DOCK_HEIGHT, cx, cy-DOCK_HEIGHT, TRUE)
CASE DOCK_BOTTOM
MoveWindow(hDock, 0, cy-DOCK_HEIGHT, cx, DOCK_HEIGHT, TRUE)
MoveWindow(hClient, 0, 0, cx, cy-DOCK_HEIGHT, TRUE)
CASE DOCK_FLOAT
' bleibt frei beweglich
END SELECT
RETURN 0
CASE WM_LBUTTONDOWN
Dim pt As POINT
pt.x = LoWord(lParam)
pt.y = HiWord(lParam)
Dim rc As RECT
GetWindowRect(hDock, @rc)
ScreenToClient(hwnd, Cast(LPPOINT, @rc.Left))
ScreenToClient(hwnd, Cast(LPPOINT, @rc.Right))
IF PtInRect(@rc, pt) THEN
isDragging = TRUE
SetCapture(hwnd)
dragOffsetX = pt.x - rc.Left
dragOffsetY = pt.y - rc.Top
END IF
RETURN 0
CASE WM_MOUSEMOVE
IF isDragging THEN
Dim pt As POINT
pt.x = LoWord(lParam)
pt.y = HiWord(lParam)
MoveWindow(hDock, pt.x - dragOffsetX, pt.y - dragOffsetY, DOCK_WIDTH, DOCK_HEIGHT, TRUE)
END IF
RETURN 0
CASE WM_LBUTTONUP
IF isDragging THEN
ReleaseCapture()
isDragging = FALSE
Dim rcWin As RECT
GetClientRect(hwnd, @rcWin)
Dim as integer cx = rcWin.Right
Dim as integer cy = rcWin.Bottom
Dim dockRc As RECT
GetWindowRect(hDock, @dockRc)
ScreenToClient(hwnd, Cast(LPPOINT, @dockRc.Left))
ScreenToClient(hwnd, Cast(LPPOINT, @dockRc.Right))
IF dockRc.Left < 50 THEN
dockState = DOCK_LEFT
ELSEIF dockRc.Right > cx-50 THEN
dockState = DOCK_RIGHT
ELSEIF dockRc.Top < 50 THEN
dockState = DOCK_TOP
ELSEIF dockRc.Bottom > cy-50 THEN
dockState = DOCK_BOTTOM
ELSE
dockState = DOCK_FLOAT
END IF
' neu layouten
SendMessage(hwnd, WM_SIZE, 0, cy Shl 16 Or cx)
END IF
RETURN 0
CASE WM_DESTROY
PostQuitMessage(0)
RETURN 0
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
#74
General Board / Re: Testing the 'bad subscript...
Last post by José Roca - September 13, 2025, 04:05:23 AMHere is the boot again.
#75
General Board / Re: question about compiling e...
Last post by José Roca - September 12, 2025, 11:19:48 PMThat option is not available in myprofile.
#76
General Board / Re: question about compiling e...
Last post by Paul Squires - September 12, 2025, 07:03:47 PMQuote from: José Roca on September 12, 2025, 02:15:51 PMBTW How can I change the time zone in this forum? It is showing me the time with 6 hours and a half of difference. I don't find an option in my profile.I think this may be the location within your profile:
#77
General Board / Re: question about compiling e...
Last post by José Roca - September 12, 2025, 02:15:51 PMBTW How can I change the time zone in this forum? It is showing me the time with 6 hours and a half of difference. I don't find an option in my profile.
#78
General Board / Re: question about compiling e...
Last post by José Roca - September 12, 2025, 02:12:06 PMProbably. Anyway it has been useful to uncover a bug in the commctrl.bi header and to have a new template for the collection.
I have reported the bug in the FreeBasic's GitHub repository:
https://github.com/freebasic/fbc/issues/455
I have reported the bug in the FreeBasic's GitHub repository:
https://github.com/freebasic/fbc/issues/455
#79
José Roca Software / Re: Edit autoselect problem......
Last post by José Roca - September 12, 2025, 02:01:17 PMYes, the code must be:
New template: https://github.com/JoseRoca/AfxNova/blob/main/SDK%20Templates/CW_Edit_Autoselect.bas
Thanks for reporting it and sorry for the inconvenience.
Code Select
' // Sent when the user selects a command item from a menu, when a control sends a
' // notification message to its parent window, or when an accelerator keystroke is translated.
CASE WM_COMMAND
SELECT CASE CBCTL(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF CBCTLMSG(wParam, lParam) = BN_CLICKED THEN SendMessageW(hwnd, WM_CLOSE, 0, 0)
CASE IDC_EDIT1
IF CBCTLMSG(wParam, lParam) = EN_SETFOCUS THEN
' Note: To deselect, use EM_SETSEL, -1, 0
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT1), 0, -1)
END IF
CASE IDC_EDIT2
IF CBCTLMSG(wParam, lParam) = EN_SETFOCUS THEN
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT2), 0, -1)
END IF
END SELECT
RETURN 0
New template: https://github.com/JoseRoca/AfxNova/blob/main/SDK%20Templates/CW_Edit_Autoselect.bas
Thanks for reporting it and sorry for the inconvenience.
#80
José Roca Software / Edit autoselect problem... may...
Last post by docroger - September 12, 2025, 11:02:40 AMHello José,
Me again... Sorry.
In the cw_edit_autoselect.bas there is no autoselect, maybe the code is faulty :
I change the code with :
Seems to work with edit2, but not with edit1.
Maybe its not possible with single line edit...
Maybe iam wrong.
Me again... Sorry.
In the cw_edit_autoselect.bas there is no autoselect, maybe the code is faulty :
Code Select
CASE EN_SETFOCUS
SELECT CASE CBCTL(wParam, lParam)
' Note: To deselect, use EM_SETSEL, -1, 0
CASE IDC_EDIT1
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT1), 0, -1)
CASE IDC_EDIT2
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT2), 0, -1)
END SELECT
I change the code with :
Code Select
case idc_edit2
if cbctlmsg(wparam,lparam)=en_setfocus then
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT2), 0, -1)
end if
case idc_edit1
if cbctlmsg(wparam,lparam)=en_setfocus then
'sendmessage(GetDlgItem(hWnd, IDC_EDIT1),em_setsel,0,-1)
Edit_SetSel(GetDlgItem(hWnd, IDC_EDIT1), 0, -1)
end if
Seems to work with edit2, but not with edit1.
Maybe its not possible with single line edit...
Maybe iam wrong.