'----------------- problem zone ---------------------------- //
pWindow = AfxCWindowPtr(hwnd)
if pWindow then
pWindow->MoveWindow hListView, 5, 5, pWindow->ClientWidth - 10, pWindow->ClientHeight - 10, TRUE
end if
'----------------- problem zone ---------------------------- //
QuotePS where U can find Infos about Control wrapper functions for Afx?
' open + save dialog, afx demo test, frank bruebach, 18-03-2024
'
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "win/shobjidl.bi"
USING Afx
CONST IDC_OFD = 1001
CONST IDC_SFD = 1002
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION AfxIFileSaveDialog (BYVAL hwndOwner AS HWND, BYVAL pwszFileName AS WSTRING PTR, _
BYVAL pwszDefExt AS WSTRING PTR, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH) AS WSTRING PTR
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' // Initialize the COM library
CoInitialize(NULL)
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "File Open+SaveDialog example", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", , IDC_SFD, "File &Save Dialog", 350, 250, 110, 23)
pWindow.AddControl("Button", , IDC_OFD, "File &Open Dialog", 150, 250, 110, 23)
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
END FUNCTION
' ========================================================================================
'FUNCTION AfxOpenFileDialog ( _
'BYVAL hwndOwner AS HWND, _
'BYREF wszTitle AS WSTRING, _
'BYREF wszFile AS WSTRING, _
'BYREF wszInitialDir AS WSTRING, _
'BYREF wszFilter AS WSTRING, _
'BYREF wszDefExt AS WSTRING, _
'BYVAL pdwFlags AS DWORD PTR = NULL, _
'BYVAL pdwBufLen AS DWORD PTR = NULL ) AS CWSTR
FUNCTION AfxIFileOpenDialog (BYVAL hwndOwner AS HWND, BYVAL pwszFileName AS WSTRING PTR, _
BYVAL pwszDefExt AS WSTRING PTR, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH) AS WSTRING PTR
' // Create an instance of the IFileSaveDialog interface
DIM hr AS LONG
DIM psfd AS IFileOpenDialog PTR
hr = CoCreateInstance(@CLSID_FileOpenDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @psfd)
IF psfd = NULL THEN RETURN NULL
' // Set the file types
DIM rgFileTypes(1 TO 3) AS COMDLG_FILTERSPEC
rgFileTypes(1).pszName = @WSTR("FB code files")
rgFileTypes(2).pszName = @WSTR("Text files")
rgFileTypes(3).pszName = @WSTR("All files")
rgFileTypes(1).pszSpec = @WSTR("*.bas;*.inc;*.bi")
rgFileTypes(2).pszSpec = @WSTR("*.txt")
rgFileTypes(3).pszSpec = @WSTR("*.*")
psfd->lpVtbl->SetFileTypes(psfd, 3, @rgFileTypes(1))
' // Set the title of the dialog
hr = psfd->lpVtbl->SetTitle(psfd, "File Open Dialog")
' // Set the file name
hr = psfd->lpVtbl->SetFileName(psfd, pwszFileName)
' // Set the extension
hr = psfd->lpVtbl->SetDefaultExtension(psfd, pwszDefExt)
' // Display the dialog
hr = psfd->lpVtbl->Show(psfd, hwndOwner)
DIM pFolder AS IShellItem PTR
dim as CWSTR wszFolder = "C:\myfolder\test" ' <-- obviously change this to a valid folder
SHCreateItemFromParsingName (wszFolder, NULL, @IID_IShellItem, @pFolder)
IF pFolder THEN
psfd->lpVtbl->SetDefaultFolder(psfd, pFolder)
pFolder->lpVtbl->Release(pFolder)
END IF
' // Get the result
DIM pItem AS IShellItem PTR
DIM pwszName AS WSTRING PTR
IF SUCCEEDED(hr) THEN
hr = psfd->lpVtbl->GetResult(psfd, @pItem)
IF SUCCEEDED(hr) THEN
hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
FUNCTION = pwszName
END IF
END IF
' // Display the dialog
hr = psfd->lpVtbl->Show(psfd, hwndOwner)
' // Cleanup
IF pItem THEN pItem->lpVtbl->Release(pItem)
IF psfd THEN psfd->lpVtbl->Release(psfd)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_SFD
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
' // Display the Save File Dialog
DIM pwszName AS WSTRING PTR = AfxIFileSaveDialog(hwnd, "test", "bas")
' // Display the selected name
IF pwszName THEN
MessageBoxW(hwnd, *pwszName, "IFileSaveDialog", MB_OK)
CoTaskMemFree(pwszName)
END IF
EXIT FUNCTION
END IF
'------------------------------------------------------------------ //
CASE IDC_OFD
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
' // Display the Open File Dialog
'------------------ problem zone ---------------------------------- //
DIM pwszName AS WSTRING PTR = AfxIFileOpenDialog(hwnd, "test", "bas")
' // Display the selected name
IF pwszName THEN
MessageBoxW(hwnd, *pwszName, "IFileOpenDialog", MB_OK)
CoTaskMemFree(pwszName)
END IF
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Displays the File Save Dialog
' The returned pointer must be freed with CoTaskMemFree
' ========================================================================================
FUNCTION AfxIFileSaveDialog (BYVAL hwndOwner AS HWND, BYVAL pwszFileName AS WSTRING PTR, _
BYVAL pwszDefExt AS WSTRING PTR, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH) AS WSTRING PTR
' // Create an instance of the IFileSaveDialog interface
DIM hr AS LONG
DIM psfd AS IFileSaveDialog PTR
hr = CoCreateInstance(@CLSID_FileSaveDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileSaveDialog, @psfd)
IF psfd = NULL THEN RETURN NULL
' // Set the file types
DIM rgFileTypes(1 TO 3) AS COMDLG_FILTERSPEC
rgFileTypes(1).pszName = @WSTR("FB code files")
rgFileTypes(2).pszName = @WSTR("Text files")
rgFileTypes(3).pszName = @WSTR("All files")
rgFileTypes(1).pszSpec = @WSTR("*.bas;*.inc;*.bi")
rgFileTypes(2).pszSpec = @WSTR("*.txt")
rgFileTypes(3).pszSpec = @WSTR("*.*")
psfd->lpVtbl->SetFileTypes(psfd, 3, @rgFileTypes(1))
' // Set the title of the dialog
hr = psfd->lpVtbl->SetTitle(psfd, "File Save Dialog")
' // Set the file name
hr = psfd->lpVtbl->SetFileName(psfd, pwszFileName)
' // Set the extension
hr = psfd->lpVtbl->SetDefaultExtension(psfd, pwszDefExt)
' // Display the dialog
hr = psfd->lpVtbl->Show(psfd, hwndOwner)
DIM pFolder AS IShellItem PTR
dim as CWSTR wszFolder = "C:\myfolder\test" ' <-- obviously change this to a valid folder
SHCreateItemFromParsingName (wszFolder, NULL, @IID_IShellItem, @pFolder)
IF pFolder THEN
psfd->lpVtbl->SetDefaultFolder(psfd, pFolder)
pFolder->lpVtbl->Release(pFolder)
END IF
' // Get the result
DIM pItem AS IShellItem PTR
DIM pwszName AS WSTRING PTR
IF SUCCEEDED(hr) THEN
hr = psfd->lpVtbl->GetResult(psfd, @pItem)
IF SUCCEEDED(hr) THEN
hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
FUNCTION = pwszName
END IF
END IF
' // Display the dialog
hr = psfd->lpVtbl->Show(psfd, hwndOwner)
' // Cleanup
IF pItem THEN pItem->lpVtbl->Release(pItem)
IF psfd THEN psfd->lpVtbl->Release(psfd)
END FUNCTION
' ========================================================================================
[,/Code]
' freebasic cWindow listview demo test
'
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiPlus.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
USING Afx
' // Menu identifiers
ENUM
IDM_UNDO = 5000 ' Undo
IDM_REDO ' Redo
IDM_HOME ' Home
IDM_SAVE ' Save
IDM_EXIT ' Exit
END ENUM
' Constants for controls
ENUM
IDC_LISTVIEW = 1000
END ENUM
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(""), NULL, COMMAND(), 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
' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM pNmh AS NMHDR PTR ' // Pointer to a NMHDR structure
DIM pLvNm AS NMLISTVIEW PTR ' // Pointer to a NMLISTVIEW structure
DIM pLvCd AS NMLVCUSTOMDRAW PTR ' // Pointer to a NMLVCUSTOMDRAW structure
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
CASE IDM_UNDO
MessageBox hwnd, "Undo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_REDO
MessageBox hwnd, "Redo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_HOME
MessageBox hwnd, "Home option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_SAVE
MessageBox hwnd, "Save option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_EXIT
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END SELECT
END IF
CASE WM_SIZE
' // Resize the ListView control and its header
IF wParam <> SIZE_MINIMIZED THEN
DIM hListView AS HWND, pWindow AS CWindow PTR
pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
hListView = GetDlgItem(hwnd, IDC_LISTVIEW)
'----------------- problem zone ---------------------------- //
' pWindow->MoveWindow hListView, 5, 5, pWindow->ClientWidth - 10, pWindow->ClientHeight - 10, TRUE
'----------------- problem zone ---------------------------- //
END IF
CASE WM_DESTROY
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' Initialize common controls
InitCommonControls()
DIM pWindow AS CWindow
pWindow.Create(NULL, " Demo ListView WinFBE", @WndProc)
pWindow.ClassStyle = CS_DBLCLKS ' // Change the window style to avoid flicker
pWindow.SetClientSize(565, 420)
pWindow.Center
' // Add a button -> but I needed here some Radiobuttons too ;)
pWindow.AddControl("Button", , IDCANCEL, "&Close", 280, 280, 75, 23)
' // Adds a listview
DIM hListView AS HWND
hListView = pWindow.AddControl("ListView", pWindow.hWindow, IDC_LISTVIEW, "") ' correct ?
' // Add some extended styles
DIM dwExStyle AS DWORD
dwExStyle = ListView_GetExtendedListViewStyle(hListView)
dwExStyle = dwExStyle OR LVS_EX_FULLROWSELECT OR LVS_EX_GRIDLINES
ListView_SetExtendedListViewStyle(hListView, dwExStyle)
' // Add the header's column names
DIM i AS LONG, lvc AS LVCOLUMNW, wszText AS WSTRING * 260
lvc.mask = LVCF_FMT OR LVCF_WIDTH OR LVCF_TEXT OR LVCF_SUBITEM
FOR i = 0 TO 4
wszText = "Column " & STR(i)
lvc.pszText = @wszText
lvc.cx = pWindow.ScaleX(110)
lvc.iSubItem = i
SendMessageW(hListView, LVM_INSERTCOLUMNW, i, CAST(LPARAM, @lvc))
NEXT
' // Populate the ListView with some data
DIM x AS LONG
DIM lvi AS LVITEMW
lvi.mask = LVIF_TEXT
FOR i = 0 to 29
lvi.iItem = i
lvi.iSubItem = 0
wszText = "Column 0 Row" + STR(i)
lvi.pszText = @wszText
ListView_InsertItem(hListView, @lvi)
FOR x = 1 TO 4
lvi.iSubItem = x
wszText = "Column " & STR(x) & " Row" + STR(i)
lvi.pszText = @wszText
SendMessageW hListView, LVM_SETITEMTEXTW, i, CAST(LPARAM, @lvi)
NEXT
NEXT
' // Select the fist item
ListView_SetItemState(hListView, 0, LVIS_FOCUSED OR LVIS_SELECTED, &H000F)
' // Set the focus in the ListView
SetFocus hListView
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
QuoteI fixed your code. Hopefully it is easy to understand.
'
' mini calculator GUI by frank bruebach, 20:06 MEZ PM, 16.03.2024
' freebasic
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiPlus.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
USING Afx
' // Menu identifiers
ENUM
IDM_UNDO = 5000 ' Undo
IDM_REDO ' Redo
IDM_HOME ' Home
IDM_SAVE ' Save
IDM_EXIT ' Exit
END ENUM
' Constants for controls
ENUM
IDC_NUM1 = 1000
IDC_NUM2
IDC_RESULT
IDC_ADD
IDC_SUBTRACT
IDC_MULTIPLY
IDC_DIVIDE
IDC_CALCULATE
END ENUM
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), 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
' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU
DIM hMenu AS HMENU
DIM hPopUpMenu AS HMENU
hMenu = CreateMenu
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+U"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_REDO, "&Redo" & CHR(9) & "Ctrl+R"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_HOME, "&Home" & CHR(9) & "Ctrl+H"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
FUNCTION = hMenu
END FUNCTION
' =================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "mini Calculator GUI", @WndProc)
pWindow.SetClientSize(400, 350)
pWindow.Center
' // Add a button -> but I needed here some Radiobuttons too ;)
pWindow.AddControl("Button", , IDCANCEL, "&Close", 280, 280, 75, 23)
pWindow.AddControl("Edit",, IDC_NUM1, "", 50, 50, 75, 23)
pWindow.AddControl("Edit",, IDC_NUM2, "", 200, 50, 75, 23)
pWindow.AddControl("RADIOBUTTON",, IDC_ADD, "+", 50, 100, 30, 23, WS_GROUP)
pWindow.AddControl("RADIOBUTTON",, IDC_SUBTRACT, "-", 100, 100, 30, 23)
pWindow.AddControl("RADIOBUTTON",, IDC_MULTIPLY, "*", 150, 100, 30, 23)
pWindow.AddControl("RADIOBUTTON",, IDC_DIVIDE, "/", 200, 100, 30, 23)
pWindow.AddControl("BUTTON",, IDC_CALCULATE, "=", 250, 100, 75, 23)
pWindow.AddControl("Edit",, IDC_RESULT, "", 50, 150, 75, 23)
'
' ------------------ problem zone ----------------------------- //
' Set default operation to addition
' SendDlgItemMessage(hWnd, IDC_ADD, BM_SETCHECK, BST_CHECKED, 0)
CheckRadioButton(pWindow.hWindow, IDC_ADD, IDC_DIVIDE, IDC_ADD)
' ------------------ problem zone ----------------------------- //
' // Create the menu
DIM hMenu AS HMENU = BuildMenu
SetMenu pWindow.hWindow, hMenu
' // Add icons to the items of the File menu
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 0)
AfxAddIconToMenuItem(hSubMenu, 0, TRUE, AfxGdipIconFromRes(hInstance, "IDI_ARROW_LEFT_32"))
AfxAddIconToMenuItem(hSubMenu, 1, TRUE, AfxGdipIconFromRes(hInstance, "IDI_ARROW_RIGHT_32"))
AfxAddIconToMenuItem(hSubMenu, 2, TRUE, AfxGdipIconFromRes(hInstance, "IDI_HOME_32"))
AfxAddIconToMenuItem(hSubMenu, 3, TRUE, AfxGdipIconFromRes(hInstance, "IDI_SAVE_32"))
SetFocus GetDlgItem(pWindow.hWindow, IDC_NUM1)
' // Dispatch Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
CASE IDC_CALCULATE
dim as double num1 = val(AfxGetWindowText(GetDlgItem(hwnd, IDC_NUM1)))
dim as double num2 = val(AfxGetWindowText(GetDlgItem(hwnd, IDC_NUM2)))
Dim as double result
' Perform calculation based on selected operation
if Button_GetCheck(GetDlgItem(hwnd,IDC_ADD)) = BST_CHECKED then
result = num1 + num2
end if
if Button_GetCheck(GetDlgItem(hwnd,IDC_SUBTRACT)) = BST_CHECKED then
result = num1 - num2
end if
if Button_GetCheck(GetDlgItem(hwnd,IDC_MULTIPLY)) = BST_CHECKED then
result = num1 * num2
end if
if Button_GetCheck(GetDlgItem(hwnd,IDC_DIVIDE)) = BST_CHECKED then
If num2 <> 0 Then
result = num1 / num2
Else
Print "Cannot divide by zero!", , "Error"
Exit Function
End If
end if
AfxSetWindowText(GetDlgItem(hwnd, IDC_RESULT), str(result))
CASE IDM_UNDO
MessageBox hwnd, "Undo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_REDO
MessageBox hwnd, "Redo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_HOME
MessageBox hwnd, "Home option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_SAVE
MessageBox hwnd, "Save option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_EXIT
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END SELECT
END IF
CASE WM_DESTROY
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
QuoteBtw: its possible to Change the font Size of the WinFBE Editor?
'
' mini calculator GUI by frank bruebach, 20:06 MEZ PM, 16.03.2024
' freebasic
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiPlus.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
USING Afx
' // Menu identifiers
ENUM
IDM_UNDO = 1001 ' Undo
IDM_REDO ' Redo
IDM_HOME ' Home
IDM_SAVE ' Save
IDM_EXIT ' Exit
END ENUM
' Constants for controls
Const IDC_NUM1 = 1001
Const IDC_NUM2 = 1002
Const IDC_RESULT = 1003
Const IDC_ADD = 2001
Const IDC_SUBTRACT = 2002
Const IDC_MULTIPLY = 2003
Const IDC_DIVIDE = 2004
Const IDC_CALCULATE = 2005
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), 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
' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU
DIM hMenu AS HMENU
DIM hPopUpMenu AS HMENU
hMenu = CreateMenu
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+U"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_REDO, "&Redo" & CHR(9) & "Ctrl+R"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_HOME, "&Home" & CHR(9) & "Ctrl+H"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
FUNCTION = hMenu
END FUNCTION
' =================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "mini Calculator GUI", @WndProc)
pWindow.SetClientSize(400, 350)
pWindow.Center
' // Add a button -> but I needed here some Radiobuttons too ;)
pWindow.AddControl("Button", , IDCANCEL, "&Close", 280, 280, 75, 23)
pWindow.AddControl("Edit",, IDC_NUM1, "&edit", 50, 50, 75, 23)
pWindow.AddControl("Edit",, IDC_NUM2, "&edit", 200, 50, 75, 23)
pWindow.AddControl("Button",, IDC_ADD, "+", 50, 100, 75, 23) 'WS_CHILD Or WS_VISIBLE Or BS_AUTORADIOBUTTON ?
pWindow.AddControl("Button",, IDC_SUBTRACT, "-", 100, 100, 75, 23) 'WS_CHILD Or WS_VISIBLE Or BS_AUTORADIOBUTTON ?
pWindow.AddControl("Button",, IDC_MULTIPLY, "*", 150, 100, 75, 23) 'WS_CHILD Or WS_VISIBLE Or BS_AUTORADIOBUTTON ?
pWindow.AddControl("Button",, IDC_DIVIDE, "/", 200, 100, 75, 23) 'WS_CHILD Or WS_VISIBLE Or BS_AUTORADIOBUTTON ?
pWindow.AddControl("Button",, IDC_CALCULATE, "=", 250, 100, 75, 23) 'WS_CHILD Or WS_VISIBLE Or BS_AUTORADIOBUTTON ?
pWindow.AddControl("Edit",, IDC_RESULT, " ", 50, 150, 75, 23)
'
' ------------------ problem zone ----------------------------- //
' Set default operation to addition
' SendDlgItemMessage(hWnd, IDC_ADD, BM_SETCHECK, BST_CHECKED, 0)
' ------------------ problem zone ----------------------------- //
' // Create the menu
DIM hMenu AS HMENU = BuildMenu
SetMenu pWindow.hWindow, hMenu
' // Add icons to the items of the File menu
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 0)
AfxAddIconToMenuItem(hSubMenu, 0, TRUE, AfxGdipIconFromRes(hInstance, "IDI_ARROW_LEFT_32"))
AfxAddIconToMenuItem(hSubMenu, 1, TRUE, AfxGdipIconFromRes(hInstance, "IDI_ARROW_RIGHT_32"))
AfxAddIconToMenuItem(hSubMenu, 2, TRUE, AfxGdipIconFromRes(hInstance, "IDI_HOME_32"))
AfxAddIconToMenuItem(hSubMenu, 3, TRUE, AfxGdipIconFromRes(hInstance, "IDI_SAVE_32"))
' // Dispatch Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
dim operation As String
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
'---------------------------------------------- //
Case IDC_ADD
operation = "+"
Case IDC_SUBTRACT
operation = "-"
Case IDC_MULTIPLY
operation = "*"
Case IDC_DIVIDE
operation = "/"
Case IDC_CALCULATE
Dim num1 As Double
Dim num2 As Double
Dim result As Double
dim as string snum1=space(21)
dim as string snum2=space(21)
dim as string sresult=space(21)
'----------- problem zone ------------------------- //
' GetDlgItemText(hWnd, IDC_NUM1, strptr(snum1), 20)
' GetDlgItemText(hWnd, IDC_NUM2, strptr(snum2), 20)
'----------- problem zone ------------------------- //
num1= val(snum1)
num2= val(snum2)
' Perform calculation based on selected operation
Select Case operation
Case "+"
result = num1 + num2
Case "-"
result = num1 - num2
Case "*"
result = num1 * num2
Case "/"
If num2 <> 0 Then
result = num1 / num2
Else
Print "Cannot divide by zero!", , "Error"
Exit Function
End If
case Else
''default addition otherwise result = zero good!
result = num1 + num2
End Select
sresult=str(result) ' good
' Display result
'----------- problem zone ------------------------- //
' SetDlgItemText(hWnd, IDC_RESULT, Strptr(sresult))
End Select
'---------------------------------------------- //
CASE IDM_UNDO
MessageBox hwnd, "Undo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_REDO
MessageBox hwnd, "Redo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_HOME
MessageBox hwnd, "Home option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_SAVE
MessageBox hwnd, "Save option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_EXIT
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
CASE WM_DESTROY
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ends
Quote from: José Roca on March 14, 2024, 02:40:12 PMIt should be WSTRING * instead of STRING *Thank-you. Ok, I conclude that our string*n endeavour will not adversely affect WinFBE (WinFBX).
Quote from: philbar on March 14, 2024, 03:23:16 AMIncidentally, I've been following the discussion of this on the FB forum.ah nice!, excellent to hear. Our goal is to keep the development discussions out in the open as much as possible and let everyone know what is going on even if at times it is full of a bunch of technical details.
CASE WM_KEYDOWN
' // Process keystrokes
' shows all keyboard codes :-)
wkeystate = wParam AND &HFF ' Extract the key code
print "1) Last key pressed: 0x"; HEX(wkeystate)
'convert the keycode to ASCII
dim keyAscii as integer = Asc(chr(wkeystate))
'convert ascii to hex value
dim keyhex as string = Hex$(keyAscii)
'print hex value
print "2) last character hex value: 0x";keyHex
case WM_CHAR
dim uniCodeChar as integer
unicodechar = wParam
dim keyhex as string = hex$(unicodechar)
print "3) Unicode: Last character hex value: 0x";keyhex