Recent posts

Welcome to PlanetSquires Forums.
Log in
Sign up

October 19, 2026, 12:20:28 PM

Main Menu

Home
Search

PlanetSquires Forums
► Recent posts

Recent posts

Pages1 2 3 ... 10

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by Frank Bruebach - October 06, 2026, 03:46:39 PM

Part two

Code Select


' part two starts
' ---------------------------------------------------------
' Fensterklasse
' ---------------------------------------------------------
Type myWindows
    hhInstance As HINSTANCE
    nCmdShow  As Integer
    title     As ZString Ptr
    w         As Integer
    h         As Integer
    mhwnd     As HWND

    btnOk      As ButtonControl Ptr
    btnExit    As ButtonControl Ptr
    editHello  As EditControl Ptr
    factory    As ControlFactory Ptr
    cbFarbe    As ComboBoxControl Ptr
    reText     As RichEditControl Ptr
    tvHeroes   As TreeViewControl Ptr

    Declare Constructor()
    Declare Constructor(hInst As HINSTANCE, nCmdShow As Integer, _
                        ByRef title As ZString Ptr, w As Integer, h As Integer)

    Declare Function Create() As Integer
    Declare Sub Show()
    Declare Sub Loops()

    Declare Sub OnCreate(hwnd As HWND)
    Declare Sub OnCommand(hwnd As HWND, id As Integer)
    Declare Sub OnSize(hwnd As HWND, cw As Integer, ch As Integer)
    Declare Sub OnDestroy(hwnd As HWND)
    Declare Sub OnNotify(hwnd As HWND, nm As NMHDR Ptr)

    Declare Static Function WndProcs(hwnd As HWND, msg As UInteger, _
                                     wParam As WPARAM, lParam As LPARAM) As Integer
End Type

Constructor myWindows()
End Constructor

Constructor myWindows(hInst As HINSTANCE, nCmdShow As Integer, _
                      ByRef title As ZString Ptr, w As Integer, h As Integer)

    This.hhInstance = hInst
    This.nCmdShow  = nCmdShow
    This.title     = title
    This.w         = w
    This.h         = h
End Constructor

Function myWindows.Create() As Integer
    Dim wc As WNDCLASSEX
    wc.cbSize        = SizeOf(WNDCLASSEX)
    wc.style         = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnWndProc   = Cast(WNDPROC, @myWindows.WndProcs)
    wc.cbClsExtra    = 0
    wc.cbWndExtra    = 0
    wc.hInstance     = hhInstance
    wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
    wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
    wc.lpszMenuName  = NULL
    wc.lpszClassName = StrPtr(MYWIN_CLASS_NAME) ' 32 bit ok not tiko 64 bit
    wc.hIconSm       = wc.hIcon

    If RegisterClassEx(@wc) = 0 Then Return 0

    mhwnd = CreateWindowEx( _
        0, StrPtr(MYWIN_CLASS_NAME), title, _
        WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
        CW_USEDEFAULT, CW_USEDEFAULT, _
        w, h, _
        NULL, NULL, hhInstance, @This )

    If mhwnd = 0 Then Return 0
    Return 1
End Function

Sub myWindows.Show()
    ShowWindow(mhwnd, nCmdShow)
    UpdateWindow(mhwnd)
End Sub

Sub myWindows.Loops()
    Dim msg As MSG
    While GetMessage(@msg, NULL, 0, 0)
        TranslateMessage(@msg)
        DispatchMessage(@msg)
    Wend
End Sub

' ---------------------------------------------------------
' File I/O
' ---------------------------------------------------------
Function LoadTextFile(path As String) As String
    Dim s As String
    Open path For Input As #1
    While Not Eof(1)
        Dim lines As String
        Line Input #1, lines
        s &= lines & !"\n"
    Wend
    Close #1
    Return s
End Function

Sub SaveTextFile(path As String, txt As String)
    Open path For Output As #1
    Print #1, txt
    Close #1
End Sub

Function FileOpenDialog( byval hWnd as HWND ) as string
    dim ofn as OPENFILENAME
    dim filename as zstring * MAX_PATH+1

    with ofn
        .lStructSize        = sizeof( OPENFILENAME )
        .hwndOwner          = hWnd
        .hInstance          = GetModuleHandle( NULL )
        .lpstrFilter        = strptr( !"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0" )
        .lpstrCustomFilter  = NULL
        .nMaxCustFilter     = 0
        .nFilterIndex       = 1
        .lpstrFile          = @filename
        .nMaxFile           = sizeof( filename )
        .lpstrFileTitle     = NULL
        .nMaxFileTitle      = 0
        .lpstrInitialDir    = NULL
        .lpstrTitle         = @"File Open Test"
        .Flags              = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
        .nFileOffset        = 0
        .nFileExtension     = 0
        .lpstrDefExt        = NULL
        .lCustData          = 0
        .lpfnHook           = NULL
        .lpTemplateName     = NULL
    end with

    if( GetOpenFileName( @ofn ) = FALSE ) then
        return ""
    else
        return filename
    end if
end function

function FileSaveDialog( byval hWnd as HWND ) as string
    dim ofn as OPENFILENAME
    dim filename as zstring * MAX_PATH+1

    with ofn
        .lStructSize        = sizeof( OPENFILENAME )
        .hwndOwner          = hWnd
        .hInstance          = GetModuleHandle( NULL )
        .lpstrFilter        = strptr( !"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0" )
        .lpstrCustomFilter  = NULL
        .nMaxCustFilter     = 0
        .nFilterIndex       = 1
        .lpstrFile          = @filename
        .nMaxFile           = sizeof( filename )
        .lpstrFileTitle     = NULL
        .nMaxFileTitle      = 0
        .lpstrInitialDir    = NULL
        .lpstrTitle         = @"File Open Test"
        .Flags              = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
        .nFileOffset        = 0
        .nFileExtension     = 0
        .lpstrDefExt        = NULL
        .lCustData          = 0
        .lpfnHook           = NULL
        .lpTemplateName     = NULL
    end with

    if( GetSaveFileName( @ofn ) = FALSE ) then
        return ""
    else
        return filename
    end if
end function

'
' part three

Function LoadTextFileUTF8(path As String) As String
    Dim raw As String

    Open path For Binary As #1
    If LOF(1) > 0 Then
        raw = String(LOF(1), 0)
        Get #1, , raw
    End If
    Close #1

    If Len(raw) >= 3 AndAlso _
       Asc(raw, 1) = &HEF AndAlso _
       Asc(raw, 2) = &HBB AndAlso _
       Asc(raw, 3) = &HBF Then
        raw = Mid(raw, 4)
    End If

    Return raw
End Function

Sub SaveTextFileUTF8(path As String, txt As String, withBOM As Boolean = True)
    Open path For Binary As #1
    If withBOM Then
        Dim bom As String = Chr(&HEF) + Chr(&HBB) + Chr(&HBF)
        Put #1, , bom
    End If
    Put #1, , txt
    Close #1
End Sub

' ---------------------------------------------------------
' Event-Methoden
' ---------------------------------------------------------
Sub myWindows.OnCreate(hwnd0 As HWND)

    factory = New ControlFactory(hwnd0)

    btnOk      = factory->AddButton("OK", ID_BTN_OK, 10, 10, 80, 30)
    btnExit    = factory->AddButton("Exit", ID_BTN_EXIT, 100, 10, 80, 30)
    editHello  = factory->AddEdit("Hallo FreeBasic", ID_EDIT_HELLO, 10, 60, 200, 25)

    cbFarbe = factory->AddCombo(3001, 10, 100, 200, 125)
    cbFarbe->AddItem("Rot")
    cbFarbe->AddItem("Grün")
    cbFarbe->AddItem("Blau")
    ' SendMessage(cbFarbe->hwnd0, CB_ADDSTRING, 0, Cast(LPARAM, StrPtr("Banana")))
    SendMessage(cbFarbe->hwnd0, CB_SETCURSEL, 0, 0)
    
    reText = factory->AddRichEdit(4001, 10, 140, 300, 150)
    reText->SetText("please type in some words...")

    tvHeroes = factory->AddTreeView(ID_TREE_HEROES, 350, 140, 200, 250)
    tvHeroes->AddRoot("Marvel", 1)
    tvHeroes->AddChild("Marvel", "Avengers", 2)
    tvHeroes->AddChild("Marvel", "Ironman", 3)
    tvHeroes->AddChild("Marvel", "Hulk", 4)
    tvHeroes->AddChild("Marvel", "Thor", 5)
    tvHeroes->AddChild("Marvel", "Spiderman", 1)

    tvHeroes->AddRoot("DC", 2)
    tvHeroes->AddChild("DC", "Batman", 3)
    tvHeroes->AddChild("DC", "Superman", 4)
    tvHeroes->AddChild("DC", "Justice League", 5)

    hMenu = CreateMenu()

    hFile = CreatePopupMenu()
    AppendMenu(hFile, MF_STRING, ID_FILE_OPEN,  "Öffnen")
    AppendMenu(hFile, MF_STRING, ID_FILE_SAVE,  "Speichern")
    AppendMenu(hFile, MF_SEPARATOR, 0, 0)
    AppendMenu(hFile, MF_STRING, ID_FILE_EXIT,  "Exit")
    AppendMenu(hMenu, MF_POPUP, Cast(UINT_PTR, hFile), "Datei")

    hHelp = CreatePopupMenu()
    AppendMenu(hHelp, MF_STRING, ID_HELP_ABOUT, "Über...")
    AppendMenu(hMenu, MF_POPUP, Cast(UINT_PTR, hHelp), "Hilfe")

    SetMenu(hwnd0, hMenu)
End Sub

Sub myWindows.OnCommand(hwnd As HWND, id As Integer)
    Select Case id

        Case ID_BTN_OK
            Dim txt As String = editHello->GetText()
            MessageBox(hwnd, txt, "Edit Inhalt", MB_OK)

        Case ID_BTN_EXIT
            DestroyWindow(hwnd)

        Case ID_FILE_OPEN
            Dim f As String = FileOpenDialog(hwnd)
            If f <> "" Then
                Dim txt As String = LoadTextFile(f)
                reText->SetText(txt)
            End If

        Case ID_FILE_SAVE
            Dim f As String = FileSaveDialog(hwnd)
            If f <> "" Then
                Dim txt As String = reText->GetText()
                SaveTextFile(f, txt)
            End If

        Case ID_FILE_EXIT
            DestroyWindow(hwnd)

        Case ID_HELP_ABOUT
            MessageBox(hwnd, "myWindowClass Beispiel 2026", "Über", MB_OK)

        Case 3001
            Dim sel As String = cbFarbe->GetSelected()
            'MessageBox(hwnd, sel, "Combo Auswahl", MB_OK)

    End Select
End Sub

Sub myWindows.OnSize(hwnd As HWND, cw As Integer, ch As Integer)
    If btnOk <> 0 Then
        MoveWindow(btnOk->hwnd0, 10, ch - 40, 80, 30, TRUE)
    End If

    If btnExit <> 0 Then
        MoveWindow(btnExit->hwnd0, cw - 90, ch - 40, 80, 30, TRUE)
    End If
End Sub

Sub myWindows.OnDestroy(hwnd As HWND)
    If factory <> 0 Then
        Delete factory
        factory = 0
    End If
End Sub

Sub myWindows.OnNotify(hwnd As HWND, nm As NMHDR Ptr)

    If nm->code = TVN_SELCHANGED Then
        
        Dim pnmtv As NMTREEVIEW Ptr = Cast(NMTREEVIEW Ptr, nm)
        Dim hItem As HTREEITEM = pnmtv->itemNew.hItem

        Dim tvi As TVITEM
        Dim buffer As ZString * 260

        tvi.mask = TVIF_TEXT
        tvi.hItem = hItem
        tvi.pszText = @buffer
        tvi.cchTextMax = 260

        SendMessage(nm->hwndFrom, TVM_GETITEM, 0, Cast(LPARAM, @tvi))

        ' >>> Text rechts im RichEdit anzeigen <<<
        If reText <> 0 Then
            reText->SetText(buffer)
        End If

    End If

End Sub

' ---------------------------------------------------------
' WndProc Dispatcher
' ---------------------------------------------------------
Function myWindows.WndProcs(hwnd As HWND, msg As UInteger, _
                            wParam As WPARAM, lParam As LPARAM) As Integer

    Dim self As myWindows Ptr
    self = Cast(myWindows Ptr, GetWindowLongPtr(hwnd, GWLP_USERDATA))

    If msg = WM_NCCREATE Then
        Dim cs As CREATESTRUCT Ptr = Cast(CREATESTRUCT Ptr, lParam)
        self = Cast(myWindows Ptr, cs->lpCreateParams)
        SetWindowLongPtr(hwnd, GWLP_USERDATA, Cast(LONG_PTR, self))
        self->mhwnd = hwnd
    End If

    Select Case msg

        Case WM_CREATE
            If self <> 0 Then self->OnCreate(hwnd)
            Return 0

        Case WM_COMMAND
            If self <> 0 Then self->OnCommand(hwnd, LoWord(wParam))
            Return 0

        Case WM_SIZE
            If self <> 0 Then self->OnSize(hwnd, LoWord(lParam), HiWord(lParam))
            Return 0

        Case WM_NOTIFY
            If self <> 0 Then self->OnNotify(hwnd, Cast(NMHDR Ptr, lParam))
            Return 0

        Case WM_DESTROY
            If self <> 0 Then self->OnDestroy(hwnd)
            PostQuitMessage(0)
            Return 0

    End Select

    Return DefWindowProc(hwnd, msg, wParam, lParam)
End Function

' ---------------------------------------------------------
' WinMain
' ---------------------------------------------------------
Function WinMain(hInst As HINSTANCE, hPrev As HINSTANCE, _
                 cmd As ZString Ptr, nCmdShow As Integer) As Integer

    Dim win As myWindows = myWindows(hInst, nCmdShow, @"Lion_OOP Window Factory + TreeView", 800, 600)

    If win.Create() Then
        win.Show()
        win.Loops()
    End If

    Return 0
End Function

End WinMain(GetModuleHandle(NULL), NULL, Command$, SW_SHOWDEFAULT)
'ends 745 lines

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by Frank Bruebach - October 06, 2026, 03:45:39 PM

Part one

Code Select

'---------------------------------------------------------
' new freebasic OOP Window System – Factory + TreeView
' 22-09-2026 / 27-09-2026 / 01-10-2026 by loewenherz / Frank b
' myWindowClass factory + TreeView , ANSI modus (still)
'---------------------------------------------------------
#Define WIN32_LEAN_AND_MEAN
#Include "windows.bi"
#Include Once "win/commctrl.bi"
#Include "win/commdlg.bi"

#Define MYWIN_CLASS_NAME "myWindowClass"
#Define CB_GETLBTEXTW &H149

#Define ID_BTN_OK      1001
#Define ID_BTN_EXIT    1002
#Define ID_FILE_OPEN   1003
#Define ID_FILE_SAVE   1004
#Define ID_HELP_ABOUT  1006
#Define ID_FILE_EXIT   1007
#Define ID_EDIT_HELLO  2001

#Define ID_TREE_HEROES 5001

Dim Shared As HMENU hMenu
Dim Shared As HMENU hFile
Dim Shared As HMENU hHelp
Dim Shared As Zstring * MAX_PATH g_szFile = "Untitled"

' ---------------------------------------------------------
' Control Basisklasse
' ---------------------------------------------------------
Type ControlBase
    hwnd0   As HWND
    parent  As HWND
    id      As Integer

    Declare Sub Create(className As String, text As String, _
                       style As UInteger, x As Integer, y As Integer, _
                       w As Integer, h As Integer)
    Declare Sub OnCommand()
End Type

Sub ControlBase.OnCommand()
End Sub

Sub ControlBase.Create(className As String, text As String, _
                       style As UInteger, x As Integer, y As Integer, _
                       w As Integer, h As Integer)

    hwnd0 = CreateWindowEx( _
        0, className, text, style, _
        x, y, w, h, _
        parent, Cast(HMENU, id), _
        GetModuleHandle(NULL), NULL)
End Sub

' ---------------------------------------------------------
' Edit Control
' ---------------------------------------------------------
Type EditControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub SetText(txt As String)
    Declare Function GetText() As String
End Type

Constructor EditControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
End Constructor

Sub EditControl.SetText(txt As String)
    SendMessage(This.hwnd0, WM_SETTEXT, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function EditControl.GetText() As String
    Dim buffer As String * 1024
    GetWindowText(This.hwnd0, buffer, 1024)
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' ComboBox Control
' ---------------------------------------------------------
Type ComboBoxControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub AddItem(txt As String)
    Declare Function GetSelected() As String
End Type

Constructor ComboBoxControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
End Constructor

Sub ComboBoxControl.AddItem(txt As String)
    SendMessage(This.hwnd0, CB_ADDSTRING, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function ComboBoxControl.GetSelected() As String
    Dim idx As Integer = SendMessage(This.hwnd0, CB_GETCURSEL, 0, 0)
    If idx < 0 Then Return ""
    Dim buffer As String * 256
    SendMessage(This.hwnd0, CB_GETLBTEXT, idx, Cast(LPARAM, StrPtr(buffer)))
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' RichEdit Control
' ---------------------------------------------------------
Type RichEditControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub SetText(txt As String)
    Declare Function GetText() As String
End Type

Constructor RichEditControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
    LoadLibrary("Msftedit.dll")
End Constructor

Sub RichEditControl.SetText(txt As String)
    SendMessage(This.hwnd0, WM_SETTEXT, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function RichEditControl.GetText() As String
    Dim buffer As String * 4096
    GetWindowText(This.hwnd0, buffer, 4096)
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' Button Control
' ---------------------------------------------------------
Type ButtonControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub OnCommand()
End Type

Constructor ButtonControl(parent As HWND, id As Integer)
    this.parent = parent
    this.id = id
End Constructor

Sub ButtonControl.OnCommand()
    MessageBox(This.parent, "Button gedrückt!", "Event", MB_OK)
End Sub

' ---------------------------------------------------------
' TreeView Control
' ---------------------------------------------------------
Type TreeViewControl Extends ControlBase
    imgList As HIMAGELIST
    hInst   As HINSTANCE

    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub InitTree(x As Integer, y As Integer, w As Integer, h As Integer)
    Declare Sub AddRoot(text As String, iconIndex As Integer)
    Declare Sub AddChild(parentText As String, text As String, iconIndex As Integer)
    Declare Function FindItem(text As String) As HTREEITEM
End Type

Constructor TreeViewControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
    hInst = GetModuleHandle(NULL)

    imgList = ImageList_Create(16, 16, ILC_COLOR32 Or ILC_MASK, 10, 10)
    ImageList_AddIcon(imgList, LoadIcon(NULL, IDI_APPLICATION))
    ImageList_AddIcon(imgList, LoadIcon(NULL, IDI_INFORMATION))
    ImageList_AddIcon(imgList, LoadIcon(NULL, IDI_WARNING))
    ImageList_AddIcon(imgList, LoadIcon(NULL, IDI_ERROR))
    ImageList_AddIcon(imgList, LoadIcon(NULL, IDI_QUESTION))
End Constructor

Sub TreeViewControl.InitTree(x As Integer, y As Integer, w As Integer, h As Integer)
    Create(WC_TREEVIEW, "", _
        WS_CHILD Or WS_VISIBLE Or WS_BORDER Or TVS_HASLINES Or TVS_LINESATROOT Or TVS_HASBUTTONS, _
        x, y, w, h)

    TreeView_SetImageList(hwnd0, imgList, TVSIL_NORMAL)
End Sub

Sub TreeViewControl.AddRoot(text As String, iconIndex As Integer)
    Dim tvi As TVINSERTSTRUCT
    tvi.hParent = TVI_ROOT
    tvi.hInsertAfter = TVI_LAST
    tvi.item.mask = TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE
    tvi.item.pszText = StrPtr(text)
    tvi.item.iImage = iconIndex
    tvi.item.iSelectedImage = iconIndex
    TreeView_InsertItem(hwnd0, @tvi)
End Sub

Sub TreeViewControl.AddChild(parentText As String, text As String, iconIndex As Integer)
    Dim hParent As HTREEITEM = FindItem(parentText)
    If hParent = 0 Then Exit Sub

    Dim tvi As TVINSERTSTRUCT
    tvi.hParent = hParent
    tvi.hInsertAfter = TVI_LAST
    tvi.item.mask = TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE
    tvi.item.pszText = StrPtr(text)
    tvi.item.iImage = iconIndex
    tvi.item.iSelectedImage = iconIndex
    TreeView_InsertItem(hwnd0, @tvi)
End Sub

Function TreeViewControl.FindItem(text As String) As HTREEITEM
    Dim tvi As TVITEM
    Dim buffer As ZString * 260

    Dim hItem As HTREEITEM = TreeView_GetRoot(hwnd0)

    While hItem <> 0
        tvi.mask = TVIF_TEXT
        tvi.hItem = hItem
        tvi.pszText = @buffer
        tvi.cchTextMax = 260

        SendMessage(hwnd0, TVM_GETITEM, 0, Cast(LPARAM, @tvi))

        If buffer = text Then Return hItem

        hItem = TreeView_GetNextItem(hwnd0, hItem, TVGN_NEXT)
    Wend

    Return 0
End Function

' ---------------------------------------------------------
' Control Factory
' ---------------------------------------------------------
Type ControlFactory
    parent   As HWND
    controls As Any Ptr Ptr
    count    As Integer

    Declare Constructor(parent As HWND)
    Declare Destructor()

    Declare Function AddButton(text As String, id As Integer, _
                               x As Integer, y As Integer, w As Integer, h As Integer) As ButtonControl Ptr

    Declare Function AddEdit(text As String, id As Integer, _
                             x As Integer, y As Integer, w As Integer, h As Integer) As EditControl Ptr

    Declare Function AddCombo(id As Integer, _
                              x As Integer, y As Integer, w As Integer, h As Integer) As ComboBoxControl Ptr

    Declare Function AddRichEdit(id As Integer, _
                                 x As Integer, y As Integer, w As Integer, h As Integer) As RichEditControl Ptr

    Declare Function AddTreeView(id As Integer, _
                                 x As Integer, y As Integer, w As Integer, h As Integer) As TreeViewControl Ptr
End Type

' part one
'
' part two
Constructor ControlFactory(parent As HWND)
    This.parent = parent
    This.count = 0
    This.controls = Callocate(0)
End Constructor

Destructor ControlFactory()
    For i As Integer = 0 To count - 1
        Delete Cast(ControlBase Ptr, controls[i])
    Next
    Deallocate(controls)
End Destructor

Function ControlFactory.AddButton(text As String, id As Integer, _
                                  x As Integer, y As Integer, w As Integer, h As Integer) As ButtonControl Ptr

    Dim btn As ButtonControl Ptr = New ButtonControl(parent, id)
    btn->Create("BUTTON", text, WS_CHILD Or WS_VISIBLE Or BS_PUSHBUTTON, _
                x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = btn

    Return btn
End Function

Function ControlFactory.AddEdit(text As String, id As Integer, _
                                x As Integer, y As Integer, w As Integer, h As Integer) As EditControl Ptr

    Dim edt As EditControl Ptr = New EditControl(parent, id)
    edt->Create("EDIT", "", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or ES_LEFT Or ES_AUTOHSCROLL, _
                x, y, w, h)

    edt->SetText(text)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = edt

    Return edt
End Function

Function ControlFactory.AddCombo(id As Integer, _
                                 x As Integer, y As Integer, w As Integer, h As Integer) As ComboBoxControl Ptr

    Dim cb As ComboBoxControl Ptr = New ComboBoxControl(parent, id)
    cb->Create("COMBOBOX", "", _
               WS_CHILD Or WS_VISIBLE Or WS_BORDER Or CBS_DROPDOWNLIST Or WS_VSCROLL, _
               x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = cb

    Return cb
End Function

Function ControlFactory.AddRichEdit(id As Integer, _
                                    x As Integer, y As Integer, w As Integer, h As Integer) As RichEditControl Ptr

    Dim re As RichEditControl Ptr = New RichEditControl(parent, id)
    re->Create("RICHEDIT50W", "", _
        WS_CHILD Or WS_VISIBLE Or WS_BORDER Or WS_VSCROLL Or _
        ES_LEFT Or ES_MULTILINE Or ES_AUTOVSCROLL Or ES_WANTRETURN, _
        x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = re

    Return re
End Function

Function ControlFactory.AddTreeView(id As Integer, _
                                    x As Integer, y As Integer, w As Integer, h As Integer) As TreeViewControl Ptr

    Dim tv As TreeViewControl Ptr = New TreeViewControl(parent, id)
    tv->InitTree(x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = tv

    Return tv
End Function

' part one ends
'

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by Frank Bruebach - October 06, 2026, 03:40:37 PM

hello paul and hajubu.. thanks for your praise first of all.
my son is ill so I am busy with private things. sorry for late reply.

I am still working on this factory oop class example. and yes I have already learned a lot be sure.

I know and will update next weeks whole framework to wstring and unicode.

here I add in my example a treeview too. Menu: you can Open and save files into rich edit control.
The treeview Control Shows Items and Name into rich edit control.

thanks, frank
PS must Split example in two parts... Too Long.
All Work in Progress.

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by Paul Squires - September 27, 2026, 02:10:13 PM

Quote from: hajubu on September 27, 2026, 09:22:55 AMplease do not forget the German Umlaute (ÄäÖöÜü...etc) are not regularly displayed now.

Unfortunately used "string" and "zstring" which will not display unicode characters. In my programs I use José's CWindow and related functions (that are dpi aware) to ensure that all languages can be displayed.

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by hajubu - September 27, 2026, 09:22:55 AM

Hi Frank,

Fine work ! - "Klasse" !

please do not forget the German Umlaute (ÄäÖöÜü...etc) are not regularly displayed now.
Thanks

P.S:
I saw also your Windows Class Demo 3 as of 2026-09-14.
In this Demo3 the Messagebox could be easily adapted with include the older Afx\CWStr.inc() and ...

Quoteapp. line 97
MessageBoxExW(hwnd, CWSTR("!German Umlaut! OK gedrückt!", CP_UTF8), "Info", MB_OK, SUBLANG_NEUTRAL)

Here in the OOP construct it will take more effort.

Thanks

PlanetSquires Software / Re: Own new oop Framework fact...

Last post by Paul Squires - September 27, 2026, 07:17:39 AM

Congratulations on your code! I bet that you learned a lot while designing and writing this code. Writing a GUI framework involves a lot of different concepts especially since you designed it using OOP.

PlanetSquires Software / Own new oop Framework factory

Last post by Frank Bruebach - September 26, 2026, 05:50:59 PM

last weeks I have built a compact object‑oriented Windows GUI framework in FreeBASIC. It handles window creation, message dispatching, menus, controls, and layout through a clean OOP event system.
A ControlFactory creates buttons, edits, combo boxes, and RichEdit controls. You added full
file I/O, including UTF‑8 with BOM support (later), plus native Open/Save dialogs. The framework wraps the WinAPI into a small, reusable architecture that behaves like a lightweight IDE foundation.

all work in progress. ITS Not perfekt I know but a good start for coming more. Compiled with freebasic 1.10.1 win 10

regards, frank

Code Select

'' ---------------------------------------------------------
' new freebasic OOP Window System – Factory 
' 22-09-2026 by loewenherz / Frank b.
' ---------------------------------------------------------
' loadSaveFile fixed 24-09-2026
'
#Define WIN32_LEAN_AND_MEAN
#Include "windows.bi"
#Include Once "win/commctrl.bi"
#Include "win/commdlg.bi"

#Define MYWIN_CLASS_NAME "myWindowClass"
#Define CB_GETLBTEXTW &H149   ' Unicode LB_GETTEXT

#Define ID_BTN_OK      1001
#Define ID_BTN_EXIT    1002
#Define ID_FILE_OPEN   1003
#Define ID_FILE_SAVE   1004
#Define ID_HELP_ABOUT  1006
#Define ID_FILE_EXIT   1007
#Define ID_EDIT_HELLO  2001

Dim Shared As HMENU hMenu
Dim Shared As HMENU hFile
Dim Shared As HMENU hHelp
Dim Shared As Zstring * MAX_PATH g_szFile = "Untitled"

' ---------------------------------------------------------
' Control Basisklasse    
' ---------------------------------------------------------
Type ControlBase
    hwnd0   As HWND
    parent As HWND
    id     As Integer

    Declare Sub Create(className As String, text As String, _
                       style As UInteger, x As Integer, y As Integer, _
                       w As Integer, h As Integer)
    Declare Sub OnCommand()
End Type

Sub ControlBase.OnCommand()
End Sub

Sub ControlBase.Create(className As String, text As String, _
                       style As UInteger, x As Integer, y As Integer, _
                       w As Integer, h As Integer)

    hwnd0 = CreateWindowEx( _
        0, className, text, style, _
        x, y, w, h, _
        parent, Cast(HMENU, id), _
        GetModuleHandle(NULL), NULL)
End Sub

' ---------------------------------------------------------
' Edit Control
' ---------------------------------------------------------
Type EditControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub SetText(txt As String)
    Declare Function GetText() As String
End Type

Constructor EditControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
End Constructor

Sub EditControl.SetText(txt As String)
    SendMessage(This.hwnd0, WM_SETTEXT, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function EditControl.GetText() As String
    Dim buffer As String * 1024
    GetWindowText(This.hwnd0, buffer, 1024)
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' ComboBox Control
' ---------------------------------------------------------
Type ComboBoxControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub AddItem(txt As String)
    Declare Function GetSelected() As String
End Type

Constructor ComboBoxControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
End Constructor

Sub ComboBoxControl.AddItem(txt As String)
    SendMessage(This.hwnd0, CB_ADDSTRING, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function ComboBoxControl.GetSelected() As String
    Dim idx As Integer = SendMessage(This.hwnd0, CB_GETCURSEL, 0, 0)
    If idx < 0 Then Return ""
    Dim buffer As String * 256
    SendMessage(This.hwnd0, CB_GETLBTEXT, idx, Cast(LPARAM, StrPtr(buffer)))
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' RichEdit Control
' ---------------------------------------------------------
Type RichEditControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub SetText(txt As String)
    Declare Function GetText() As String
End Type

Constructor RichEditControl(parent As HWND, id As Integer)
    This.parent = parent
    This.id = id
    LoadLibrary("Msftedit.dll")
End Constructor

Sub RichEditControl.SetText(txt As String)
    SendMessage(This.hwnd0, WM_SETTEXT, 0, Cast(LPARAM, StrPtr(txt)))
End Sub

Function RichEditControl.GetText() As String
    Dim buffer As String * 4096
    GetWindowText(This.hwnd0, buffer, 4096)
    Return Trim(buffer)
End Function

' ---------------------------------------------------------
' Button Control
' ---------------------------------------------------------
Type ButtonControl Extends ControlBase
    Declare Constructor(parent As HWND, id As Integer)
    Declare Sub OnCommand()
End Type

Constructor ButtonControl(parent As HWND, id As Integer)
    this.parent = parent
    this.id = id
End Constructor

Sub ButtonControl.OnCommand()
    MessageBox(This.parent, "Button gedrückt!", "Event", MB_OK)
End Sub

' ---------------------------------------------------------
' Control Factory
' ---------------------------------------------------------
Type ControlFactory
    parent As HWND
    controls As Any Ptr Ptr
    count As Integer

    Declare Constructor(parent As HWND)
    Declare Destructor()

    Declare Function AddButton(text As String, id As Integer, _
                               x As Integer, y As Integer, w As Integer, h As Integer) As ButtonControl Ptr

    Declare Function AddEdit(text As String, id As Integer, _
                             x As Integer, y As Integer, w As Integer, h As Integer) As EditControl Ptr

    Declare Function AddCombo(id As Integer, _
                              x As Integer, y As Integer, w As Integer, h As Integer) As ComboBoxControl Ptr

    Declare Function AddRichEdit(id As Integer, _
                                 x As Integer, y As Integer, w As Integer, h As Integer) As RichEditControl Ptr
End Type

Constructor ControlFactory(parent As HWND)
    This.parent = parent
    This.count = 0
    This.controls = Callocate(0)
End Constructor

Destructor ControlFactory()
    For i As Integer = 0 To count - 1
        Delete Cast(ControlBase Ptr, controls[i])
    Next
    Deallocate(controls)
End Destructor

Function ControlFactory.AddButton(text As String, id As Integer, _
                                  x As Integer, y As Integer, w As Integer, h As Integer) As ButtonControl Ptr

    Dim btn As ButtonControl Ptr = New ButtonControl(parent, id)
    btn->Create("BUTTON", text, WS_CHILD Or WS_VISIBLE Or BS_PUSHBUTTON, _
                x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = btn

    Return btn
End Function

Function ControlFactory.AddEdit(text As String, id As Integer, _
                                x As Integer, y As Integer, w As Integer, h As Integer) As EditControl Ptr

    Dim edt As EditControl Ptr = New EditControl(parent, id)
    edt->Create("EDIT", "", WS_CHILD Or WS_VISIBLE Or WS_BORDER Or ES_LEFT Or ES_AUTOHSCROLL, _
                x, y, w, h)

    edt->SetText(text)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = edt

    Return edt
End Function

Function ControlFactory.AddCombo(id As Integer, _
                                 x As Integer, y As Integer, w As Integer, h As Integer) As ComboBoxControl Ptr

    Dim cb As ComboBoxControl Ptr = New ComboBoxControl(parent, id)
    cb->Create("COMBOBOX", "", _
               WS_CHILD Or WS_VISIBLE Or WS_BORDER Or CBS_DROPDOWNLIST Or WS_VSCROLL, _
               x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = cb

    Return cb
End Function

Function ControlFactory.AddRichEdit(id As Integer, _
                                    x As Integer, y As Integer, w As Integer, h As Integer) As RichEditControl Ptr

    Dim re As RichEditControl Ptr = New RichEditControl(parent, id)
    re->Create("RICHEDIT50W", "", _
    WS_CHILD Or WS_VISIBLE Or WS_BORDER Or WS_VSCROLL Or _
    ES_LEFT Or ES_MULTILINE Or ES_AUTOVSCROLL Or ES_WANTRETURN, _
    x, y, w, h)

    count += 1
    controls = Reallocate(controls, count * SizeOf(Any Ptr))
    controls[count - 1] = re

    Return re
End Function

' ---------------------------------------------------------
' Fensterklasse
' ---------------------------------------------------------
Type myWindows
    hhInstance As HINSTANCE
    nCmdShow As Integer
    title As ZString Ptr
    w As Integer
    h As Integer
    mhwnd As HWND

    btnOk As ButtonControl Ptr
    btnExit As ButtonControl Ptr
    editHello As EditControl Ptr
    factory As ControlFactory Ptr

    ' >>> WICHTIG: Diese zwei Felder waren bei dir NICHT vorhanden <<<
    cbFarbe As ComboBoxControl Ptr
    reText  As RichEditControl Ptr

    Declare Constructor()
    Declare Constructor(hInst As HINSTANCE, nCmdShow As Integer, _
                        ByRef title As ZString Ptr, w As Integer, h As Integer)

    Declare Function Create() As Integer
    Declare Sub Show()
    Declare Sub Loops()

    Declare Sub OnCreate(hwnd As HWND)
    Declare Sub OnCommand(hwnd As HWND, id As Integer)
    Declare Sub OnSize(hwnd As HWND, cw As Integer, ch As Integer)
    Declare Sub OnDestroy(hwnd As HWND)

    Declare Static Function WndProcs(hwnd As HWND, msg As UInteger, _
                                     wParam As WPARAM, lParam As LPARAM) As Integer
End Type

Constructor myWindows()
End Constructor

Constructor myWindows(hInst As HINSTANCE, nCmdShow As Integer, _
                      ByRef title As ZString Ptr, w As Integer, h As Integer)

    This.hhInstance = hInst
    This.nCmdShow = nCmdShow
    This.title = title
    This.w = w
    This.h = h
End Constructor

Function myWindows.Create() As Integer
    Dim wc As WNDCLASSEX
    wc.cbSize = SizeOf(WNDCLASSEX)
    wc.style = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnWndProc = Cast(WNDPROC, @myWindows.WndProcs)
    wc.cbClsExtra = 0
    wc.cbWndExtra = 0
    wc.hInstance = hhInstance
    wc.hIcon = LoadIcon(NULL, IDI_APPLICATION)
    wc.hCursor = LoadCursor(NULL, IDC_ARROW)
    wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
    wc.lpszMenuName = NULL
    wc.lpszClassName = StrPtr(MYWIN_CLASS_NAME)
    wc.hIconSm = wc.hIcon

    If RegisterClassEx(@wc) = 0 Then Return 0

    mhwnd = CreateWindowEx( _
        0, StrPtr(MYWIN_CLASS_NAME), title, _
        WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
        CW_USEDEFAULT, CW_USEDEFAULT, _
        w, h, _
        NULL, NULL, hhInstance, @This )

    If mhwnd = 0 Then Return 0
    Return 1
End Function

Sub myWindows.Show()
    ShowWindow(mhwnd, nCmdShow)
    UpdateWindow(mhwnd)
End Sub

Sub myWindows.Loops()
    Dim msg As MSG
    While GetMessage(@msg, NULL, 0, 0)
        TranslateMessage(@msg)
        DispatchMessage(@msg)
    Wend
End Sub
'
'Function LoadTextFile(path As String) As String
    Dim s As String
    Open path For Input As #1
    While Not Eof(1)
        Dim lines As String
        Line Input #1, lines
        s &= lines & !"\n"
    Wend
    Close #1
    Return s
End Function

Sub SaveTextFile(path As String, txt As String)
    Open path For Output As #1
    Print #1, txt
    Close #1
End Sub

Function FileOpenDialog( byval hWnd as HWND ) as string

	dim ofn as OPENFILENAME
	dim filename as zstring * MAX_PATH+1
	
	with ofn
		.lStructSize 		= sizeof( OPENFILENAME )
		.hwndOwner	 		= hWnd
		.hInstance	 		= GetModuleHandle( NULL )
		.lpstrFilter 		= strptr( !"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0" )
		.lpstrCustomFilter 	= NULL
		.nMaxCustFilter 	= 0
		.nFilterIndex 		= 1
		.lpstrFile			= @filename
		.nMaxFile			= sizeof( filename )
		.lpstrFileTitle		= NULL
		.nMaxFileTitle		= 0
		.lpstrInitialDir	= NULL
		.lpstrTitle			= @"File Open Test"
		.Flags				= OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
		.nFileOffset		= 0
		.nFileExtension		= 0
		.lpstrDefExt		= NULL
		.lCustData			= 0
		.lpfnHook			= NULL
		.lpTemplateName		= NULL
	end with

	if( GetOpenFileName( @ofn ) = FALSE ) then
		return ""
	else
		return filename
	end if

end function

function FileSaveDialog( byval hWnd as HWND ) as string

	dim ofn as OPENFILENAME
	dim filename as zstring * MAX_PATH+1
	
	with ofn
		.lStructSize 		= sizeof( OPENFILENAME )
		.hwndOwner	 		= hWnd
		.hInstance	 		= GetModuleHandle( NULL )
		.lpstrFilter 		= strptr( !"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0" )
		.lpstrCustomFilter 	= NULL
		.nMaxCustFilter 	= 0
		.nFilterIndex 		= 1
		.lpstrFile			= @filename
		.nMaxFile			= sizeof( filename )
		.lpstrFileTitle		= NULL
		.nMaxFileTitle		= 0
		.lpstrInitialDir	= NULL
		.lpstrTitle			= @"File Open Test"
		.Flags				= OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
		.nFileOffset		= 0
		.nFileExtension		= 0
		.lpstrDefExt		= NULL
		.lCustData			= 0
		.lpfnHook			= NULL
		.lpTemplateName		= NULL
	end with

	if( GetSaveFileName( @ofn ) = FALSE ) then
		return ""
	else
		return filename
	end if

end function

Function LoadTextFileUTF8(path As String) As String
    Dim raw As String

    Open path For Binary As #1
    If LOF(1) > 0 Then
        raw = String(LOF(1), 0)
        Get #1, , raw
    End If
    Close #1

    ' UTF-8 BOM entfernen
    If Len(raw) >= 3 AndAlso _
       Asc(raw, 1) = &HEF AndAlso _
       Asc(raw, 2) = &HBB AndAlso _
       Asc(raw, 3) = &HBF Then
        raw = Mid(raw, 4)
    End If

    Return raw
End Function

Sub SaveTextFileUTF8(path As String, txt As String, withBOM As Boolean = True)
    Open path For Binary As #1
    If withBOM Then
        Dim bom As String = Chr(&HEF) + Chr(&HBB) + Chr(&HBF)
        Put #1, , bom
    End If
    Put #1, , txt
    Close #1
End Sub



' ---------------------------------------------------------
' Event-Methoden
' ---------------------------------------------------------
Sub myWindows.OnCreate(hwnd As HWND)

    factory = New ControlFactory(hwnd)

    btnOk      = factory->AddButton("OK", ID_BTN_OK, 10, 10, 80, 30)
    btnExit    = factory->AddButton("Exit", ID_BTN_EXIT, 100, 10, 80, 30)
    editHello  = factory->AddEdit("Hallo FreeBasic", ID_EDIT_HELLO, 10, 60, 200, 25)

    ' ComboBox
    cbFarbe = factory->AddCombo(3001, 10, 100, 200, 25)

cbFarbe->AddItem("Rot")
cbFarbe->AddItem("Grün")
cbFarbe->AddItem("Blau")
SendMessage(cbFarbe->hwnd0, CB_SETCURSEL, 0, 0)  ' "Rot" als Startauswahl

    ' RichEdit
    'reText = factory->AddRichEdit(4001, 10, 320, 300, 150)
    reText = factory->AddRichEdit(4001, 10, 140, 300, 150)
    reText->SetText("Bitte Text eingeben...")

    ' Menü
    hMenu = CreateMenu()

    hFile = CreatePopupMenu()
    AppendMenu(hFile, MF_STRING, ID_FILE_OPEN,  "Öffnen")
    AppendMenu(hFile, MF_STRING, ID_FILE_SAVE,  "Speichern")
    AppendMenu(hFile, MF_SEPARATOR, 0, 0)
    AppendMenu(hFile, MF_STRING, ID_FILE_EXIT,  "Exit")
    AppendMenu(hMenu, MF_POPUP, Cast(UINT_PTR, hFile), "Datei")

    hHelp = CreatePopupMenu()
    AppendMenu(hHelp, MF_STRING, ID_HELP_ABOUT, "Über...")
    AppendMenu(hMenu, MF_POPUP, Cast(UINT_PTR, hHelp), "Hilfe")

    SetMenu(hwnd, hMenu)
End Sub

Sub myWindows.OnCommand(hwnd As HWND, id As Integer)
    Select Case id

        Case ID_BTN_OK
            Dim txt As String = editHello->GetText()
            MessageBox(hwnd, txt, "Edit Inhalt", MB_OK)

        Case ID_BTN_EXIT
            DestroyWindow(hwnd)

        'Case ID_FILE_OPEN
        '    MessageBox(hwnd, "Öffnen gewählt.", "Menü", MB_OK)

        'Case ID_FILE_SAVE
        '    MessageBox(hwnd, "Speichern gewählt.", "Menü", MB_OK)

    	Case ID_FILE_OPEN
    Dim f As String = FileOpenDialog(hwnd)
    If f <> "" Then
        Dim txt As String = LoadTextFile(f)
        reText->SetText(txt)
    End If

Case ID_FILE_SAVE
    Dim f As String = FileSaveDialog(hwnd)
    If f <> "" Then
        Dim txt As String = reText->GetText()
        SaveTextFile(f, txt)
    End If


        Case ID_FILE_EXIT
            DestroyWindow(hwnd)

        Case ID_HELP_ABOUT
            MessageBox(hwnd, "myWindowClass Beispiel 2026", "Über", MB_OK)

        Case 3001
            Dim sel As String = cbFarbe->GetSelected()
            MessageBox(hwnd, sel, "Combo Auswahl", MB_OK)

        

    End Select
End Sub

Sub myWindows.OnSize(hwnd As HWND, cw As Integer, ch As Integer)
    If btnOk <> 0 Then
        MoveWindow(btnOk->hwnd0, 10, ch - 40, 80, 30, TRUE)
    End If
    
    If btnExit <> 0 Then
        MoveWindow(btnExit->hwnd0, cw - 90, ch - 40, 80, 30, TRUE)
    End If
End Sub

Sub myWindows.OnDestroy(hwnd As HWND)
    If factory <> 0 Then
        Delete factory
        factory = 0
    End If
End Sub

' ---------------------------------------------------------
' WndProc Dispatcher
' ---------------------------------------------------------
Function myWindows.WndProcs(hwnd As HWND, msg As UInteger, _
                            wParam As WPARAM, lParam As LPARAM) As Integer

    Dim self As myWindows Ptr
    self = Cast(myWindows Ptr, GetWindowLongPtr(hwnd, GWLP_USERDATA))

    If msg = WM_NCCREATE Then
        Dim cs As CREATESTRUCT Ptr = Cast(CREATESTRUCT Ptr, lParam)
        self = Cast(myWindows Ptr, cs->lpCreateParams)
        SetWindowLongPtr(hwnd, GWLP_USERDATA, Cast(LONG_PTR, self))
        self->mhwnd = hwnd
    End If

    Select Case msg

        Case WM_CREATE
            If self <> 0 Then self->OnCreate(hwnd)
            Return 0

        Case WM_COMMAND
            If self <> 0 Then self->OnCommand(hwnd, LoWord(wParam))
            Return 0

        Case WM_SIZE
            If self <> 0 Then self->OnSize(hwnd, LoWord(lParam), HiWord(lParam))
            Return 0

        Case WM_DESTROY
            If self <> 0 Then self->OnDestroy(hwnd)
            PostQuitMessage(0)
            Return 0

    End Select

    Return DefWindowProc(hwnd, msg, wParam, lParam)
End Function

' ---------------------------------------------------------
' WinMain
' ---------------------------------------------------------
Function WinMain(hInst As HINSTANCE, hPrev As HINSTANCE, _
                 cmd As ZString Ptr, nCmdShow As Integer) As Integer

    Dim win As myWindows = myWindows(hInst, nCmdShow, @"Lion_OOP Window Factory version 0.4", 800, 600)

    If win.Create() Then
        win.Show()
        win.Loops()
    End If

    Return 0
End Function

End WinMain(GetModuleHandle(NULL), NULL, Command$, SW_SHOWDEFAULT)
' ends

Next Update will come soon so you can Understand more how to handle a factory.bi file

José Roca Software / Re: AfxFilenameOriginalCase

Last post by Paul Squires - September 19, 2026, 03:29:35 PM

Excellent - thanks José, appreciate it!

José Roca Software / Re: AfxNova progress

Last post by Johan Klassen - September 19, 2026, 01:45:07 PM

good day José Roca

#10

José Roca Software / Re: AfxFilenameOriginalCase

Last post by José Roca - September 19, 2026, 02:42:34 AM

Hi Paul,

I didn't forget about the function you proposed earlier.
The reason I didn't implement it immediately is that something important was missing, and I needed to study the official documentation for GetFinalPathNameByHandleW first.

According to Microsoft's documentation , the function's return value is the length of the string in TCHARs, excluding the terminating null character. This detail affects how the buffer must be allocated and how the result must be trimmed. Without understanding this behavior precisely, the function could return incorrect or partially truncated paths, especially when dealing with long filenames or UNC paths.

Once I reviewed the documentation carefully, I was able to implement a correct and robust version:

- dynamic buffer resizing based on the exact size required

- proper handling of the \\?\ and \\?\UNC\ prefixes

- correct trimming of the returned string

- support for both files and directories

and a variant that accepts a HANDLE directly

So the delay wasn't because I forgot your suggestion — I simply needed to confirm how the API behaves internally before finalizing the implementation.

Thanks again for the original idea. It was a good starting point, and now the function works reliably in all cases.

I have added them to fbxWin.inc, using USTRING and DEFER.

Code Select

' ========================================================================================
' Returns the original-case filename as stored by Windows.
' Uses GetFinalPathNameByHandleW with dynamic buffer, UNC handling,
' directory support, and automatic cleanup via DEFER.
' ========================================================================================
FUNCTION fbxGetFilenameOriginalCase OVERLOAD (BYREF wszFileName AS WSTRING) AS USTRING
   DIM INITIAL_SIZE AS LONG = 1024
   DIM hFile AS HANDLE
   DIM dwNeeded AS DWORD
   DIM dwFlags AS DWORD = FILE_NAME_OPENED
   DIM ustrResult AS USTRING = WSPACE(INITIAL_SIZE \ 2)
   ' Open file or directory
   hFile = CreateFileW(wszFileName, GENERIC_READ, _
                       FILE_SHARE_READ OR FILE_SHARE_WRITE OR FILE_SHARE_DELETE, _
                       NULL, OPEN_EXISTING, _
                       FILE_ATTRIBUTE_NORMAL OR FILE_FLAG_BACKUP_SEMANTICS, _
                       NULL)
   IF hFile = INVALID_HANDLE_VALUE THEN RETURN ""
   ' Automatic cleanup
   DEFER CloseHandle(hFile)
   ' First call: get required size
   dwNeeded = GetFinalPathNameByHandleW(hFile, STRPTR(ustrResult), INITIAL_SIZE, dwFlags)
   IF dwNeeded = 0 THEN RETURN ""
   ' Resize buffer if needed
   IF dwNeeded >= INITIAL_SIZE THEN
      ustrResult = WSPACE(dwNeeded + 1)
      dwNeeded = GetFinalPathNameByHandleW(hFile, STRPTR(ustrResult), dwNeeded + 1, dwFlags)
      IF dwNeeded = 0 THEN RETURN ""
   END IF
   ' Trim to actual length (dwNeeded does not include the null terminator)
   ustrResult = LEFT(ustrResult, dwNeeded)
   ' Remove \\?\ prefix
   IF LEFT(ustrResult, 4) = $"\\?\" THEN
      ustrResult = MID(ustrResult, 5)
   ELSEIF LEFT(ustrResult, 7) = $"\\?\UNC\" THEN
      ustrResult = $"\\" & MID(ustrResult, 7)
   END IF
   RETURN ustrResult
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the original-case filename associated with a HANDLE.
' The HANDLE must refer to a file or directory opened with sufficient access rights.
' ========================================================================================
FUNCTION fbxGetFilenameOriginalCaseFromHandle OVERLOAD (BYVAL hFile AS HANDLE) AS USTRING
   DIM INITIAL_SIZE AS LONG = 1024
   DIM dwNeeded    AS DWORD
   DIM dwFlags     AS DWORD = FILE_NAME_OPENED
   DIM ustrResult  AS USTRING = WSPACE(INITIAL_SIZE \ 2)
   ' Validate handle
   IF hFile = INVALID_HANDLE_VALUE OR hFile = NULL THEN RETURN ""
   ' First call: get required size
   dwNeeded = GetFinalPathNameByHandleW(hFile, STRPTR(ustrResult), INITIAL_SIZE, dwFlags)
   IF dwNeeded = 0 THEN RETURN ""
   ' Resize buffer if needed
   IF dwNeeded >= INITIAL_SIZE THEN
      ' dwNeeded = number of characters without the terminating null
      ustrResult = WSPACE(dwNeeded + 1)
      dwNeeded = GetFinalPathNameByHandleW(hFile, STRPTR(ustrResult), dwNeeded + 1, dwFlags)
      IF dwNeeded = 0 THEN RETURN ""
   END IF
   ' Trim to actual length (dwNeeded does not include the null terminator)
   ustrResult = LEFT(ustrResult, dwNeeded)
   ' Remove \\?\ prefix
   IF LEFT(ustrResult, 4) = $"\\?\" THEN
      ustrResult = MID(ustrResult, 5)
   ELSEIF LEFT(ustrResult, 7) = $"\\?\UNC\" THEN
      ustrResult = $"\\" & MID(ustrResult, 7)
   END IF
   RETURN ustrResult
END FUNCTION
' ========================================================================================

Pages1 2 3 ... 10

PlanetSquires Forums

Recent posts

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Re: Own new oop Framework fact...

PlanetSquires Software / Own new oop Framework factory

José Roca Software / Re: AfxFilenameOriginalCase

José Roca Software / Re: AfxNova progress

José Roca Software / Re: AfxFilenameOriginalCase