Announcement

Collapse
No announcement yet.

What is the counterpart of WM_Create ?

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Arie Verheul
    replied
    Thanks

    Well, as the code seems to be working fine now,
    and as no further objections were brought forward,
    i want to thank those who assisted with this.

    Arie Verheul

    Leave a comment:


  • Chris Holbrook
    replied
    Another way of TABigating from Semen Matusovski, using superclassing. Can't remember if this is his original or if I have messed about with it.
    Code:
    #compile exe
    #register none
    #dim all
    #include "WIN32API.INC"
    
    callback function SuperEditProc
        static OldProc as long, OffsetWndExtra as long
        if cbhndl = 0 then OldProc = cbwparam: OffsetWndExtra = cblparam: exit function
        select case cbmsg
            case %wm_setfocus
                static s as dword, e as dword, k as long
                s = GetWindowLong (cbhndl, OffsetWndExtra)
                e = GetWindowLong (cbhndl, OffsetWndExtra + 4)
                SendMessage cbhndl, %EM_SETSEL, s, e
            case %wm_killfocus
                SendMessage cbhndl, %EM_GETSEL, varptr(s), varptr(e)
                SetWindowLong cbhndl, OffsetWndExtra, s
                SetWindowLong cbhndl, OffsetWndExtra + 4, e
        end select
        function = CallWindowProc(OldProc, cbhndl, cbmsg, cbwparam, cblparam)
    end function
    
    function CreateSuperClass(OldClassName as string, NewClassName as string, lpfnNewWndProc as long, cbWndExtra as long) as long
    local wc as WNDCLASSEX
        wc.cbSize = sizeof(wc)
        if GetClassInfoEx(byval 0&, byval strptr(OldClassName), wc) then
            CallWindowProc lpfnNewWndProc, 0, 0, wc.lpfnWndProc, wc.cbWndExtra
            wc.hInstance = GetModuleHandle(byval 0&)
            wc.lpszClassName = strptr(NewClassName)
            wc.lpfnWndProc = lpfnNewWndProc
            wc.cbWndExtra = wc.cbWndExtra + cbWndExtra
            function = RegisterClassEx(wc)
        end if
    end function
    
    function pbmain
        if isfalse(CreateSuperClass("EDIT", "SuperEdit", codeptr(SuperEditProc), 8)) then exit function
        dim hDlg as long
        dialog new 0, "Test", , , 120, 160, %ws_caption or %ws_sysmenu or %ws_maximizebox to hDlg
        control add "SuperEdit", hDlg, 101, "", 10, 10, 100, 60, %ws_child or %ws_visible or %ws_tabstop _
                                                or %es_multiline or %es_wantreturn, %ws_ex_clientedge
        control add "SuperEdit", hDlg, 102, "", 10, 80, 100, 60 , %ws_child or %ws_visible or %ws_tabstop _
                                                 or %es_multiline or %es_wantreturn, %ws_ex_clientedge
        dialog show modal hDlg
    end function

    Leave a comment:


  • Arie Verheul
    replied
    Form-style user interface for PBCC 4 + 5 - Now with Tabstop navigation feature

    Due to inaccurate information the implementation of the Tabstop feature took a little more effort than foreseen.
    However, herewith the further improved code for the user interface.

    As the TabStop navigation feature is not well documented, and as various sources give different views,
    it is not easy to say how it is properly implemented. I found the following to work :

    1. Give the controls the WS_TABSTOP style

    2. Include the IsDialogMessage function in the message loop as shown below :

    Code:
     
        While GetMessage(Msg, hForm, 0,0) > 0
            
            If IsFalse IsDialogMessage (hForm, Msg) Then    ' First check if it is a dialogmessage
                                                            ' If so, then have it processed by this function  
                TranslateMessage (Msg)                      ' If not then use the regular venue
                DispatchMessage  (Msg)
            End If
        Wend

    Just inserting the IsDialogMessage function in the message loop makes that things go horribly wrong (try this yourself).
    The WS_EX_CONTROLPARENT style for the parent window seems unnecessary.
    As it also affects the system menu it was therefore omitted.

    Arie Verheul

    Code:
     
    #Dim All
    #Compiler PBCC
     
    %CompilerVersion = 5        ' set to major compiler version (tested with PBCC 4 + 5)
     
    #If %CompilerVersion > 4
    #Break On
    #Include Once "Win32Api.inc"
    #Else
    #Include "Win32Api.inc"
    #EndIf
     
    ' ----------------------------------------------------------------------------
    ' General purpose form-style user interface for PBCC - Arie Verheul - nov 2009
    ' ----------------------------------------------------------------------------
     
    ' This a general purpose form-style user interface, intended for use with
    ' a regular PBCC application to enter names, adresses and similar data.
     
    ' It will produce on the screen any number of fields of a specified length,
    ' from one to as many as there will fit on it.
    ' There is a push button provided to accept the provided input.
     
    ' It was designed in such a way that the Windows code is kept separated
    ' from the PBCC code.
     
    ' To the left of each input field there is a label, stating the expected input.
    ' If no text for the label is provided, no label is drawn either,
    ' which allows for input fields that may require a varying number of lines,
    ' as this is often the case with addresses.
     
    ' The form may use defaults for input fields.
     
    ' Background and text colors of edit fields and labels may be set to BGR values.
     
    ' The form may be set to ReadOnly to show output in the same format.
    ' In that case there is no push button.
     
    ' ----------------------------------------------------------------------------
     
    ' Application parameters, may be changed as needed
     
    $FUI_AppName             = "FormStyleUserInterface"
     
    $FUI_Font                = "Tahoma"    ' Swiss fonts only
    %FUI_FontHeight          = 14
    %FUI_FontWidth           = 60          ' Percent of FontHeight
     
    %FUI_Hor_Spacing         = 10          ' Field spacing in pixels
    %FUI_Vert_Spacing        = 10
     
    %FUI_Elongation          = 110         ' Percent of nominal length
                                           ' Elongates fields to allow for wider than average text
     
    %FUI_MaxLabelLength      = 40          ' Max. values to set aside Asciiz strings
    %FUI_MaxEditFieldLength  = 80
    %FUI_MaxTitleLength      = 64
    %FUI_MaxButtonTextLength = 32
     
    %FUI_WindowBGColor       = &H508060    ' BGR
    %FUI_LabelBgColor        = &H300000
    %FUI_EditBgColor         = &HB0F0C0
    %FUI_LabelTextColor      = &H00FFFF
    %FUI_EditTextColor       = &H200000
     
    ' ---------------------------------------------------------------------
     
    Type FUI_FormData
         NumFields                  As Long      ' Actual number of fields
         FieldLength                As Dword     ' Actual field length
         ReadOnly                   As Dword     ' True/false
         Success                    As Long      ' Flag, true/false
         hFont                      As Dword
         FormBgBrush                As Dword
         EditBgBrush                As Dword
         LabelBgBrush               As Dword
         Title                      As Asciiz * %FUI_MaxTitleLength         ' Title as it appears in title bar
         ButtonText                 As Asciiz * %FUI_MaxButtonTextLength    ' Text to show on button
    End Type
     
    ' -------------------------------------------------------------------------
     
    Declare Sub         FUI_SetUp        (NumFields   As Long,_
                                          FieldLength As Long,_
                                          ReadOnly    As Long)
     
    Declare Sub         FUI_CreateForm
    Declare Sub         FUI_CreateFields (hForm As Dword)
    Declare Sub         FUI_CollectResult
     
    Declare Function    FUI_WndProc      (ByVal hForm   As Dword,_
                                          ByVal wMsg    As Dword,_
                                          ByVal wParam  As Dword,_
                                          ByVal lParam  As Dword) As Long
     
    ' ---------------------------------------------------------------------
     
    Global FUI_Data         As FUI_FormData
    Global FUI_hControl ()  As Dword
    Global FUI_Label    ()  As String
    Global FUI_Result   ()  As String
     
    ' ---------------------------------------------------------------------
     
    Function PBMain As Long
     
        ' FUI_SetUp (NumFields, FieldLength, ReadOnly)
     
        FUI_SetUp 5,40,0            ' 5 fields of 40 characters, ReadOnly = 0
     
        FUI_Data.Title              = "Demo form"
        FUI_Data.ButtonText         = "Process"
     
        Array Assign FUI_Label()    = "Field #1","Field #2","Field #3","","Field #4"
        Array Assign FUI_Result()   = "default for field 1"
     
        ' SUB FUI_CreateForm displays form and waits for input
     
        FUI_CreateForm
     
        ' Form is removed after button is clicked
     
        '----------------------------------------------------------------
     
        ' Normally application code will go here
     
        Local N As Long
     
        If FUI_Data.Success Then
     
            Cursor Off
            Locate 1,1
     
            For N = 1 To UBound (FUI_Result())
                Print FUI_Result(N)
            Next
     
        End If
     
        '----------------------------------------------------------------
     
        WaitKey$
     
    End Function
     
    ' -------------------------------------------------------------------
     
    Sub FUI_SetUp (NumFields As Long, FieldLength As Long, ReadOnly As Long)
     
        ReDim FUI_hControl      (2*NumFields)      As Global Dword
        ReDim FUI_Label         (1 To NumFields)   As Global String
        ReDim FUI_Result        (1 To NumFields)   As Global String
     
        FUI_Data.NumFields      = NumFields
        FUI_Data.FieldLength    = FieldLength
        FUI_Data.ReadOnly       = ReadOnly
        FUI_Data.Success        = 0
     
        FUI_Data.FormBgBrush    = CreateSolidBrush (%FUI_WindowBgColor)
        FUI_Data.EditBgBrush    = CreateSolidBrush (%FUI_EditBgColor)
        FUI_Data.LabelBgBrush   = CreateSolidBrush (%FUI_LabelBgColor)
     
    End Sub
     
    ' ---------------------------------------------------------------
     
    Sub FUI_CreateForm
     
       ' Create window to hold input fields
     
        Dim   Msg                       As tagMsg
        Dim   ClassDescription          As WndClassEx
     
        Local hForm                     As Dword
        Local hInstance                 As Dword
        Local ApplicationName           As Asciiz*24    ' Application name for class registration
     
        ApplicationName                 = $FUI_AppName
     
        hInstance                       = GetModuleHandle (ByVal(0))
     
        ClassDescription.Style          = %CS_ClassDC
        ClassDescription.hInstance      = hInstance
        ClassDescription.hbrBackground  = FUI_Data.FormBgBrush
        ClassDescription.lpszClassName  = VarPtr  (ApplicationName)
        ClassDescription.lpfnWndProc    = CodePtr (FUI_WndProc)
        ClassDescription.cbSize         = SizeOf  (ClassDescription)
     
        ' All other entries in ClassDescription are zero
     
        RegisterClassEx (ClassDescription)
     
        ' Set window size to default for the moment, exact size comes later
     
        hForm =          CreateWindowEx (0,_
                         ApplicationName,_            'window class name
                         Space$(2)+ FUI_Data.Title,_  'window title
                         %WS_SysMenu Or %WS_Caption,_ 'window style
                         %CW_UseDefault,_             'initial x position
                         %CW_UseDefault,_             'initial y position
                         %CW_UseDefault,_             'initial x size
                         %CW_UseDefault,_             'initial y size
                         0,_                          'parent window handle
                         0,_                          'window menu handle
                         hInstance,_                  'program instance handle
                         ByVal 0)                     'optional parameter
     
        '-----------------------------------------------------------------------------------
     
        ' Message loop
     
        While GetMessage(Msg, hForm, 0,0) > 0
     
            If IsFalse IsDialogMessage (hForm, Msg) Then    ' First check if it is a dialogmessage
                                                            ' If so, then have it processed by this function
                TranslateMessage (Msg)                      ' If not then use the regular venue
                DispatchMessage  (Msg)
            End If
        Wend
     
    End Sub
     
    ' ---------------------------------------------------------------------
     
    Sub FUI_CreateFields (hForm As Dword)
     
        ' Creates various controls
     
        Dim    lfFont              As LOGFONT
     
        Local  hInstance           As Dword
        Local  StyleFlags          As Dword
        Local  Xwin,Ywin           As Long          ' Window left-top corner
        Local  WinWidth, WinHeight As Long          ' Window size
        Local  LabelFieldLength    As Long          ' Max. Label length in characters
                                                    ' or field length in pixels
        Local  EditFieldLength     As Long          ' Input field length in pixels
        Local  FieldHeight         As Long          ' Field height in pixels
        Local  FrameWidth          As Long          ' Windows frame size
        Local  TitleBarHeight      As Long          ' Windows title bar height
        Local  N, M                As Long
     
        Local  ClassName           As Asciiz * 12   ' Holds "Static", "Edit" or "Button"
        Local  Label               As Asciiz * %FUI_MaxLabelLength + 1
     
        Local  hDC As Dword
     
        ' ------------------------------------------------------------------
     
        ' Set Font
     
        lfFont.lfFaceName           = $FUI_Font
        lfFont.lfPitchAndFamily     = %FF_Swiss
        lfFont.lfHeight             = -%FUI_FontHeight
        lfFont.lfWidth              =  %FUI_FontHeight * %FUI_FontWidth / 100
     
        ' All other entries in lfFont are zero
     
        FUI_Data.hFont              = CreateFontIndirect (lfFont)
     
        ' ------------------------------------------------------------------
     
        ' Determine required length in characters for Label fields
     
        LabelFieldLength = Len(FUI_Data.ButtonText)
     
        For N = 1 To FUI_Data.NumFields
            LabelFieldLength  = Max&(LabelFieldLength, Len(FUI_Label(N)))
        Next
     
        ' ------------------------------------------------------------------
     
        ' Determine field sizes in pixels
     
        FieldHeight         = 1.5 * Abs(lfFont.lfHeight)
     
        ' %FUI_Elongation makes fields a bit longer as lfFont.lfWidth holds average font width
     
        LabelFieldLength    = %FUI_Elongation * (LabelFieldLength + 2) * lfFont.lfWidth / 100
     
        EditFieldLength     = %FUI_Elongation * (FUI_Data.FieldLength  + 1) * lfFont.lfWidth / 100
     
        ' ------------------------------------------------------------------
     
        ' Retrieve frame size
     
        FrameWidth     = GetSystemMetrics (%SM_CXDlgFrame)
        TitleBarHeight = GetSystemMetrics (%SM_CYCaption)
     
        ' ------------------------------------------------------------------
     
        ' Calculate size of main window
     
        WinWidth  = LabelFieldLength + EditFieldLength + 3 * %FUI_Hor_Spacing + 2 * FrameWidth
        WinHeight = (FUI_Data.NumFields + 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing + TitleBarHeight + FrameWidth + 3
     
        ' In ReadOnly mode no button will be present
     
        If FUI_Data.ReadOnly Then Winheight = WinHeight - FieldHeight - %FUI_Vert_Spacing
     
        ' ------------------------------------------------------------------
     
        ' Center form on client area and make it Topmost to prevent it from accidentally disappearing
     
        Desktop Get Client To N, M
     
        Xwin = (N - WinWidth)  \ 2
        Ywin = (M - WinHeight) \ 2
     
        SetWindowPos (hForm, %Hwnd_TopMost,_
                      Xwin, Ywin, WinWidth, WinHeight, %SWP_ShowWindow)
     
        ' ------------------------------------------------------------------
     
        hInstance = GetModuleHandle (ByVal(0))
     
        ' ------------------------------------------------------------------
     
        ' #0                                                Button
        ' #1 to #FUI_Data.NumFields                         Edit fields
        ' #FUI_Data.NumFields + 1 to 2*FUI_Data.NumFields   Labels
     
        For N = 0 To 2 * FUI_Data.NumFields
     
            Select Case N
                 Case 0                                         ' Button
     
                    If FUI_Data.ReadOnly Then Iterate For       ' No button if form is ReadOnly
     
                    StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border Or %WS_TabStop
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (FUI_Data.NumFields) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Button"
                    Label     = FUI_Data.ButtonText
     
                 Case 1 To FUI_Data.NumFields                   ' Edit fields
     
                    Xwin      = LabelFieldLength + 2 * %FUI_Hor_Spacing
                    Ywin      = (N - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = EditFieldLength
     
                    If FUI_Data.ReadOnly Then
     
                        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
                        ClassName = "Static"
                        Label = $Spc + FUI_Result(N)
                    Else
     
                        ' Give Edit fields ES_AutoHScroll style to allow for wider than average characters,
                        ' and WS_TabStop style for keyboard navigation
     
                        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border Or %ES_AutoHScroll Or %WS_TabStop
     
                        ClassName = "Edit"
                        Label = FUI_Result(N)
                    End If
     
                 Case  > FUI_Data.NumFields                       ' Labels
     
                    M = N - FUI_Data.NumFields
     
                    If Trim$(FUI_Label(M)) = "" Then Iterate For  ' If no label text, no label either
     
                    StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (M - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Static"
                    Label     = $Spc + FUI_Label(M)
     
            End Select
     
            FUI_hControl(N) = CreateWindowEx(0,_
                                 ClassName,_          'window class name
                                 Label,_              'window title
                                 StyleFlags,_         'style
                                 Xwin,_               'initial x position
                                 Ywin,_               'initial y position
                                 WinWidth,_           'initial x size
                                 FieldHeight,_        'initial y
                                 hForm,_              'parent window handle
                                 0,_                  'window menu handle
                                 hInstance,_          'program instance handle
                                 ByVal 0)             'optional creation parameter
     
            PostMessage (FUI_hControl(N), %WM_SetFont, FUI_Data.hFont, 0)
     
            ' Set maximum text length in edit field to specified FieldLength
     
            If IsFalse FUI_Data.ReadOnly And N > 0 And N <= FUI_Data.NumFields Then
                PostMessage FUI_hControl(N), %EM_LimitText, FUI_Data.FieldLength, 0
            End If
     
        Next
     
    End Sub
     
    ' ----------------------------------------------------------------------
     
    Function FUI_WndProc(ByVal hForm    As Dword,_
                         ByVal wMsg     As Dword,_
                         ByVal wParam   As Dword,_
                         ByVal lParam   As Dword)    As Long
     
        Local hDC           As Dword
        Local I             As Long
     
        Select Case wMsg
     
            Case %WM_Destroy
     
                DeleteObject FUI_Data.FormBgBrush
                DeleteObject FUI_Data.EditBgBrush
                DeleteObject FUI_Data.LabelBgBrush
                DeleteObject FUI_Data.hFont
     
                PostQuitMessage(0)
                Function = 0
     
            Case %WM_Create
     
                FUI_CreateFields hForm
                SetFocus FUI_hControl(1)
                Function = 0
     
            Case %WM_CtlColorEdit, %WM_CtlColorStatic
     
                hDC      = wParam
     
                ' In ReadOnly mode the Edit field is in fact a Static control,
                ' which however still has to be colored as an Edit control.
                ' Therefore we need to find out for each case what type each control is.
     
                Array Scan FUI_hControl(), = lParam, To I       ' lParam holds hControl
     
                If I > FUI_Data.NumFields + 1 Then              ' It is a label
     
                    SetBkColor   hDC, %FUI_LabelBgColor
                    SetTextColor hDC, %FUI_LabelTextColor
                    Function   = FUI_Data.LabelBgBrush
                Else                                            ' It is an edit field
                    SetBkColor   hDC, %FUI_EditBgColor
                    SetTextColor hDC, %FUI_EditTextColor
                    Function   = FUI_Data.EditBgBrush
                End If
     
            Case %WM_Command
     
                If wParam = 0 And lParam = FUI_hControl(0) Then ' Button clicked
     
                    FUI_CollectResult
                    DestroyWindow (hForm)
                End If
     
            Case Else : Function = DefWindowProc(hForm, wMsg, wParam, lParam)
     
        End Select
     
    End Function
     
    ' -------------------------------------------------------------------------
     
    Sub FUI_CollectResult
     
        Local N As Long
        Local FieldText As Asciiz*(%FUI_MaxEditFieldLength + 1)
     
        For N = 1 To FUI_Data.NumFields            ' Read content of edit fields
     
            GetWindowText FUI_hControl(N), FieldText, FUI_Data.FieldLength '%FUI_MaxLabelLength
            FUI_Result(N) = Trim$(FieldText)
        Next N
     
        FUI_Data.Success = -1                      ' Set Success flag
     
    End Sub
     
    ' -------------------------------------------------------------------------

    Leave a comment:


  • Michael Mattias
    replied
    carefully checked that (you know me) and keystroke messages do definitely not arrive by themselves
    at the WndProc function, even not with a clean message loop.
    Only notification messages explicitly sent to a control's OWNER window can be picked up in your window procedure. The notification messages sent directly to a control you can only get if you subclass the control.

    ****, I should not have told you that. Now you're not going to give up on trying to handle 'navigation' by monitoring keystrokes.

    You might handle navigation with keystrokes under MS-DOS, but that is not "The Windows Way"

    MCM

    Leave a comment:


  • Arie Verheul
    replied
    Michael,

    Let me first thank you for your reply

    I posted working code, so without the TABSTOP feature implemented, and mentioned that explicitly:

    I therefore reverted to the previous approach where keyboard navigation was simply coded,
    which i do at least understand.
    So your criticism is not fully justified. I also doubt your statement that:

    Those notification messags [about keystrokes] are going to get to your window procedure anyway,
    via DispatchMessage().
    I carefully checked that (you know me) and keystroke messages do definitely not arrive by themselves
    at the WndProc function, even not with a clean message loop.
    I can even demonstrate that. Below you find a copy of my code, with all keyboard navigation removed,
    but with a message monitor attached (see bottom of the code).
    It reports any messages received in the console window.

    If you run it, and type some characters on your keyboard, you will see sequences KEYDOWN, CHAR, KEYUP.
    None of the characters will be displayed in one of the edit fields, as none of them has keyboard focus.
    Next click inside one of the edit controls so that it gets the keyboard focus.
    Now the characters appear nicely in the edit control, but no longer in the WndProc.
    So, as long as one of the edit controls has keyboard focus, there is no regular way to have keystrokes
    processed by the WndProc function.

    When writing this code i explored various respectable sources, and they are all remarkably vague
    about the Tabstop feature, and many forumposts both on PB and MSDN report difficulties.
    However, i will keep working on it and let you know.

    Arie Verheul


    Code:
     
    #Dim All
    #Compiler PBCC
     
    %CompilerVersion = 5        ' set to major compiler version (tested with PBCC 4 + 5)
     
    #If %CompilerVersion > 4
    #Break On
    #Include Once "Win32Api.inc"
    #Else
    #Include "Win32Api.inc"
    #EndIf
     
    ' ----------------------------------------------------------------------------
     
    ' Application parameters, may be changed as needed
     
    $FUI_AppName             = "FormStyleUserInterface"
     
    $FUI_Font                = "Tahoma"    ' Swiss fonts only
    %FUI_FontHeight          = 14
    %FUI_FontWidth           = 60          ' Percent of FontHeight
     
    %FUI_Hor_Spacing         = 10          ' Field spacing in pixels
    %FUI_Vert_Spacing        = 10
     
    %FUI_Elongation          = 110         ' Percent of nominal length
                                           ' Elongates fields to allow for wider than average text
     
    %FUI_MaxLabelLength      = 40          ' Max. values to set aside Asciiz strings
    %FUI_MaxEditFieldLength  = 80
    %FUI_MaxTitleLength      = 64
    %FUI_MaxButtonTextLength = 32
     
    %FUI_WindowBGColor       = &H508060    ' BGR
    %FUI_LabelBgColor        = &H300000
    %FUI_EditBgColor         = &HB0F0C0
    %FUI_LabelTextColor      = &H00FFFF
    %FUI_EditTextColor       = &H200000
     
    ' ---------------------------------------------------------------------
    %AppMsg_ControlKey       = &H10000     ' Application defined message
    ' ---------------------------------------------------------------------
     
    Type FUI_FormData
         NumFields                  As Long      ' Actual number of fields
         FieldLength                As Dword     ' Actual field length
         ReadOnly                   As Dword     ' True/false
         Success                    As Long      ' Flag, true/false
         hFont                      As Dword
         FormBgBrush                As Dword
         EditBgBrush                As Dword
         LabelBgBrush               As Dword
         Title                      As Asciiz * %FUI_MaxTitleLength         ' Title as it appears in title bar
         ButtonText                 As Asciiz * %FUI_MaxButtonTextLength    ' Text to show on button
    End Type
     
    ' -------------------------------------------------------------------------
     
    Declare Sub         FUI_SetUp        (NumFields   As Long,_
                                          FieldLength As Long,_
                                          ReadOnly    As Long)
     
    Declare Sub         FUI_CreateForm
    Declare Sub         FUI_CreateFields (hForm As Dword)
    Declare Sub         FUI_CollectResult
     
    Declare Function    FUI_WndProc      (ByVal hForm   As Dword,_
                                          ByVal wMsg    As Dword,_
                                          ByVal wParam  As Dword,_
                                          ByVal lParam  As Dword) As Long
     
    Declare Function    WinMsg (Msg As Dword) As String
     
    ' ---------------------------------------------------------------------
     
    Global FUI_Data         As FUI_FormData
    Global FUI_hControl ()  As Dword
    Global FUI_Label    ()  As String
    Global FUI_Result   ()  As String
     
    ' ---------------------------------------------------------------------
     
    Function PBMain As Long
     
        ' FUI_SetUp (NumFields, FieldLength, ReadOnly)
     
        FUI_SetUp 5,40,0            ' 5 fields of 40 characters, ReadOnly = 0
     
        FUI_Data.Title              = "Demo form"
        FUI_Data.ButtonText         = "Process"
     
        Array Assign FUI_Label()    = "Field #1","Field #2","Field #3","","Field #4"
     
        ' SUB FUI_CreateForm displays form and waits for input
     
        FUI_CreateForm
     
        ' Form is removed after button is clicked
     
        '----------------------------------------------------------------
     
        ' Normally application code will go here
     
        Local N             As Long
     
        Cursor Off
     
        Locate 1,1
     
        If FUI_Data.Success Then
     
            For N = 1 To UBound (FUI_Result())
                Print FUI_Result(N)
            Next
     
        End If
     
        '----------------------------------------------------------------
     
        WaitKey$
     
    End Function
     
    ' -------------------------------------------------------------------
     
    Sub FUI_SetUp (NumFields As Long, FieldLength As Long, ReadOnly As Long)
     
        ReDim FUI_hControl (2*NumFields)      As Global Dword
        ReDim FUI_Label    (1 To NumFields)   As Global String
        ReDim FUI_Result   (1 To NumFields)   As Global String
     
        FUI_Data.NumFields      = NumFields
        FUI_Data.FieldLength    = FieldLength
        FUI_Data.ReadOnly       = ReadOnly
        FUI_Data.Success        = 0
     
        FUI_Data.FormBgBrush    = CreateSolidBrush (%FUI_WindowBgColor)
        FUI_Data.EditBgBrush    = CreateSolidBrush (%FUI_EditBgColor)
        FUI_Data.LabelBgBrush   = CreateSolidBrush (%FUI_LabelBgColor)
     
    End Sub
     
    ' ---------------------------------------------------------------
     
    Sub FUI_CreateForm
     
       ' Create window to hold input fields
     
        Dim   Msg                       As tagMsg
        Dim   ClassDescription          As WndClassEx
     
        Local hForm                     As Dword
        Local hInstance                 As Dword
        Local ApplicationName           As Asciiz*24    ' Application name for class registration
     
        ApplicationName                 = $FUI_AppName
     
        hInstance                       = GetModuleHandle (ByVal(0))
     
        ClassDescription.Style          = %CS_ClassDC
        ClassDescription.hInstance      = hInstance
        ClassDescription.hbrBackground  = FUI_Data.FormBgBrush
        ClassDescription.lpszClassName  = VarPtr  (ApplicationName)
        ClassDescription.lpfnWndProc    = CodePtr (FUI_WndProc)
        ClassDescription.cbSize         = SizeOf  (ClassDescription)
     
        ' All other entries in ClassDescription are zero
     
        RegisterClassEx (ClassDescription)
     
        ' Set window size to default for the moment, exact size comes later
     
        hForm =          CreateWindowEx (0,_
                         ApplicationName,_            'window class name
                         Space$(2)+ FUI_Data.Title,_  'window title
                         %WS_SysMenu Or %WS_Caption,_ 'window style
                         %CW_UseDefault,_             'initial x position
                         %CW_UseDefault,_             'initial y position
                         %CW_UseDefault,_             'initial x size
                         %CW_UseDefault,_             'initial y size
                         0,_                          'parent window handle
                         0,_                          'window menu handle
                         hInstance,_                  'program instance handle
                         ByVal 0)                     'optional parameter
     
        '-----------------------------------------------------------------------------------
     
        ' Message loop
     
        While GetMessage(Msg, hForm, 0,0) > 0
     
            TranslateMessage (Msg)
            DispatchMessage  (Msg)
        Wend
     
    End Sub
     
    ' ---------------------------------------------------------------------
     
    Sub FUI_CreateFields (hForm As Dword)
     
        ' Creates various controls
     
        Dim    lfFont              As LOGFONT
     
        Local  hInstance           As Dword
        Local  StyleFlags          As Dword
        Local  Xwin,Ywin           As Long          ' Window left-top corner
        Local  WinWidth, WinHeight As Long          ' Window size
        Local  LabelFieldLength    As Long          ' Max. Label length in characters
                                                    ' or field length in pixels
        Local  EditFieldLength     As Long          ' Input field length in pixels
        Local  FieldHeight         As Long          ' Field height in pixels for given font
        Local  FrameWidth          As Long          ' Frame size for calculation of window size
        Local  TitleBarHeight      As Long          ' For calculation of window size
        Local  N, M                As Long
     
        Local  ClassName           As Asciiz * 12   ' Holds "Static", "Edit" or "Button"
        Local  Label               As Asciiz * %FUI_MaxLabelLength + 1
     
        Local  hDC As Dword
     
        ' ------------------------------------------------------------------
     
        ' Set Font
     
        lfFont.lfFaceName           = $FUI_Font
        lfFont.lfPitchAndFamily     = %FF_Swiss
        lfFont.lfHeight             = -%FUI_FontHeight
        lfFont.lfWidth              =  %FUI_FontHeight * %FUI_FontWidth / 100
     
        ' All other entries in lfFont are zero
     
        FUI_Data.hFont              = CreateFontIndirect (lfFont)
     
        ' ------------------------------------------------------------------
     
        ' Determine required length in characters for Label fields
     
        LabelFieldLength = Len(FUI_Data.ButtonText)
     
        For N = 1 To FUI_Data.NumFields
            LabelFieldLength  = Max&(LabelFieldLength, Len(FUI_Label(N)))
        Next
     
        ' ------------------------------------------------------------------
     
        ' Determine field sizes in pixels
     
        FieldHeight         = 1.5 * Abs(lfFont.lfHeight)
     
        ' %FUI_Elongation makes fields a bit longer as lfFont.lfWidth holds average font width
     
        LabelFieldLength    = %FUI_Elongation * (LabelFieldLength + 2) * lfFont.lfWidth / 100
     
        EditFieldLength     = %FUI_Elongation * (FUI_Data.FieldLength  + 1) * lfFont.lfWidth / 100
     
        ' ------------------------------------------------------------------
     
        ' Retrieve frame size
     
        FrameWidth     = GetSystemMetrics (%SM_CXDlgFrame)
        TitleBarHeight = GetSystemMetrics (%SM_CYCaption)
     
        ' ------------------------------------------------------------------
     
        ' Calculate size of main window
     
        WinWidth  = LabelFieldLength + EditFieldLength + 3 * %FUI_Hor_Spacing + 2 * FrameWidth
        WinHeight = (FUI_Data.NumFields + 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing + TitleBarHeight + FrameWidth + 3
     
        ' In ReadOnly mode no button will be present
     
        If FUI_Data.ReadOnly Then Winheight = WinHeight - FieldHeight - %FUI_Vert_Spacing
     
        ' ------------------------------------------------------------------
     
        ' Center form on client area and make it Topmost to prevent it from accidentally disappearing
     
        Desktop Get Client To N, M
     
        Xwin = (N - WinWidth)  \ 2
        Ywin = (M - WinHeight) \ 2
     
        SetWindowPos (hForm, %Hwnd_TopMost,_
                      Xwin, Ywin, WinWidth, WinHeight, %SWP_ShowWindow)
     
        ' ------------------------------------------------------------------
     
        hInstance = GetModuleHandle (ByVal(0))
     
        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
        ' ------------------------------------------------------------------
     
        ' #0                                                Button
        ' #1 to #FUI_Data.NumFields                         Edit fields
        ' #FUI_Data.NumFields + 1 to 2*FUI_Data.NumFields   Labels
     
        For N = 0 To 2 * FUI_Data.NumFields
     
            Select Case N
                 Case 0                                         ' Button
     
                    If FUI_Data.ReadOnly Then Iterate For       ' No button if form is ReadOnly
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (FUI_Data.NumFields) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Button"
                    Label     = FUI_Data.ButtonText
     
                 Case 1 To FUI_Data.NumFields                   ' Edit fields
     
                    Xwin      = LabelFieldLength + 2 * %FUI_Hor_Spacing
                    Ywin      = (N - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = EditFieldLength
     
                    If FUI_Data.ReadOnly Then
     
                        ClassName = "Static"
                        Label = $Spc + FUI_Result(N)
                    Else
     
                        ' Give Edit fields ES_AutoHScroll style to allow for wider than average characters
     
                        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border Or %ES_AutoHScroll
     
                        ClassName = "Edit"
                        Label = FUI_Result(N)
                    End If
     
                 Case  > FUI_Data.NumFields                       ' Labels
     
                    M = N - FUI_Data.NumFields
     
                    If Trim$(FUI_Label(M)) = "" Then Iterate For  ' If no label text, no label either
     
                    StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (M - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Static"
                    Label     = $Spc + FUI_Label(M)
     
            End Select
     
            FUI_hControl(N) = CreateWindowEx(0,_
                                 ClassName,_          'window class name
                                 Label,_              'window title
                                 StyleFlags,_         'style
                                 Xwin,_               'initial x position
                                 Ywin,_               'initial y position
                                 WinWidth,_           'initial x size
                                 FieldHeight,_        'initial y
                                 hForm,_              'parent window handle
                                 0,_                  'window menu handle
                                 hInstance,_          'program instance handle
                                 ByVal 0)             'optional creation parameter
     
            PostMessage (FUI_hControl(N), %WM_SetFont, FUI_Data.hFont, 0)
     
            ' Set maximum text length in edit field to specified FieldLength
     
            If IsFalse FUI_Data.ReadOnly And N > 0 And N <= FUI_Data.NumFields Then
                PostMessage FUI_hControl(N), %EM_LimitText, FUI_Data.FieldLength, 0
            End If
     
        Next
     
    End Sub
     
    ' ----------------------------------------------------------------------
     
    Function FUI_WndProc(ByVal hForm    As Dword,_
                         ByVal wMsg     As Dword,_
                         ByVal wParam   As Dword,_
                         ByVal lParam   As Dword)    As Long
     
        Local hDC           As Dword
        Local I             As Long
     
        Print WinMsg (wMsg)         ' This is the message monitor
     
        Select Case wMsg
     
            Case %WM_Destroy
     
                DeleteObject FUI_Data.FormBgBrush
                DeleteObject FUI_Data.EditBgBrush
                DeleteObject FUI_Data.LabelBgBrush
                DeleteObject FUI_Data.hFont
     
                PostQuitMessage(0)
                Function = 0
     
            Case %WM_Create
     
                FUI_CreateFields hForm
                Function = 0
     
            Case %WM_CtlColorEdit, %WM_CtlColorStatic
     
                hDC      = wParam
     
                ' In ReadOnly mode the Edit field is in fact a Static control,
                ' which however still has to be colored as an Edit control.
                ' Therefore we need to find out for each case what type each control is.
     
                Array Scan FUI_hControl(), = lParam, To I       ' lParam holds hControl
     
                If I > FUI_Data.NumFields + 1 Then              ' It is a label
     
                    SetBkColor   hDC, %FUI_LabelBgColor
                    SetTextColor hDC, %FUI_LabelTextColor
                    Function   = FUI_Data.LabelBgBrush
                Else                                            ' It is an edit field
                    SetBkColor   hDC, %FUI_EditBgColor
                    SetTextColor hDC, %FUI_EditTextColor
                    Function   = FUI_Data.EditBgBrush
                End If
     
            Case %WM_Command
     
                If wParam = 0 And lParam = FUI_hControl(0) Then ' Button clicked
     
                    FUI_CollectResult
                    DestroyWindow (hForm)
                End If
     
            Case Else : Function = DefWindowProc(hForm, wMsg, wParam, lParam)
     
        End Select
     
    End Function
     
    ' -------------------------------------------------------------------------
     
    Sub FUI_CollectResult
     
        Local N As Long
        Local FieldText As Asciiz*(%FUI_MaxEditFieldLength + 1)
     
        For N = 1 To FUI_Data.NumFields            ' Read content of edit fields
     
            GetWindowText FUI_hControl(N), FieldText, FUI_Data.FieldLength '%FUI_MaxLabelLength
            FUI_Result(N) = Trim$(FieldText)
        Next N
     
        FUI_Data.Success = -1                      ' Set Success flag
     
    End Sub
     
    ' -------------------------------------------------------------------------
     
    Function WinMsg (wMsg As Dword) As String
     
        ' Function returns Equate associated with message
     
        Static Counter As Long
     
        Local I As Long
        Local HexString As String*4
     
        Incr Counter
     
        HexString = Hex$(wMsg,4)
     
        For I = 1 To DataCount Step 2
     
            If Read$(I) = HexString Then
                Function = Using$("##### ", Counter) + Read$(I + 1)
                Exit Function
            End If
     
        Next
     
        Function = Using$("##### ", Counter) + "&H" + HexString + " ?"    ' If not on list
     
    Exit Function
     
    Data 0006,"Activate                "
    Data 001C,"ActivateApp             "
    Data 0360,"AfxFirst                "
    Data 037F,"AfxLast                 "
    Data 0800,"App                     "
    Data 0319,"AppCommand              "
    Data 030C,"AskCBFormatName         "
    Data 004B,"CancelJournal           "
    Data 001F,"CancelMode              "
    Data 0215,"CaptureChanged          "
    Data 030D,"ChangeCBChain           "
    Data 0127,"ChangeUIState           "
    Data 0102,"Char                    "
    Data 002F,"CharToItem              "
    Data 0022,"ChildActivate           "
    Data 0303,"Clear                   "
    Data 0010,"Close                   "
    Data 0111,"Command                 "
    Data 0041,"Compacting              "
    Data 0039,"CompareItem             "
    Data 007B,"ContextMenu             "
    Data 010A,"ConvertRequest          "
    Data 010B,"ConvertResult           "
    Data 0301,"Copy                    "
    Data 004A,"CopyData                "
    Data 0001,"Create                  "
    Data 0135,"CtlColorBtn             "
    Data 0136,"CtlColorDlg             "
    Data 0133,"CtlColorEdit            "
    Data 0134,"CtlColorListBox         "
    Data 0132,"CtlColorMsgBox          "
    Data 0137,"CtlColorScrollBar       "
    Data 0138,"CtlColorStatic          "
    Data 0300,"Cut                     "
    Data 0103,"DeadChar                "
    Data 002D,"DeleteItem              "
    Data 0002,"Destroy                 "
    Data 0307,"DestroyClipBoard        "
    Data 0219,"DeviceChange            "
    Data 001B,"DevModeChange           "
    Data 007E,"DisplayChange           "
    Data 0308,"DrawClipBoard           "
    Data 002B,"DrawItem                "
    Data 0233,"DropFiles               "
    Data 000A,"Enable                  "
    Data 0016,"EndSession              "
    Data 0121,"EnterIdle               "
    Data 0211,"EnterMenuLoop           "
    Data 0231,"EnterSizeMove           "
    Data 0014,"EraseBkgnd              "
    Data 0212,"ExitMenuLoop            "
    Data 0232,"ExitSizeMove            "
    Data 001D,"FontChange              "
    Data 0087,"GetDlgCode              "
    Data 0031,"GetFont                 "
    Data 0033,"GetHotKey               "
    Data 007F,"GetIcon                 "
    Data 0024,"GetMinMaxInfo           "
    Data 003D,"GetObject               "
    Data 000D,"GetText                 "
    Data 000E,"GetTextLength           "
    Data 0358,"HandHeldFirst           "
    Data 035F,"HandHeldLast            "
    Data 0053,"Help                    "
    Data 0312,"Hotkey                  "
    Data 0114,"HScroll                 "
    Data 030E,"HScrollClipBoard        "
    Data 0027,"IconEraseBkGnd          "
    Data 0286,"Ime_Char                "
    Data 010F,"Ime_Composition         "
    Data 0284,"Ime_CompositionFull     "
    Data 0283,"Ime_Control             "
    Data 010E,"Ime_EndComposition      "
    Data 0290,"Ime_KeyDown             "
    Data 010F,"Ime_KeyLast             "
    Data 0291,"Ime_KeyUp               "
    Data 0282,"Ime_Notify              "
    Data 0280,"Ime_Report              "
    Data 0288,"Ime_Request             "
    Data 0285,"Ime_Select              "
    Data 0281,"Ime_SetContext          "
    Data 010D,"Ime_StartComposition    "
    Data 0290,"ImeKeyDown              "
    Data 0291,"ImeKeyUp                "
    Data 0110,"InitDialog              "
    Data 0116,"InitMenu                "
    Data 0117,"InitMenuPopup           "
    Data 00FF,"Input                   "
    Data 0051,"InputLangChange         "
    Data 0050,"InputLangChangeRequest  "
    Data 010C,"Interim                 "
    Data 0100,"Keydown                 "
    Data 0100,"KeyFirst                "
    Data 0109,"KeyLast                 "
    Data 0101,"KeyUp                   "
    Data 0008,"KillFocus               "
    Data 0203,"LButtonDblClk           "
    Data 0201,"LButtonDown             "
    Data 0202,"LbuttonUp               "
    Data 0209,"MButtonDblClk           "
    Data 0207,"MButtonDown             "
    Data 0208,"MButtonUp               "
    Data 0222,"MDIActivate             "
    Data 0227,"MDICascade              "
    Data 0220,"MDICreate               "
    Data 0221,"MDIDestroy              "
    Data 0229,"MDIGetActive            "
    Data 0228,"MDIIconArrange          "
    Data 0225,"MDIMaximize             "
    Data 0224,"MDINext                 "
    Data 0234,"MDIRefreshMenu          "
    Data 0223,"MDIRestore              "
    Data 0230,"MDISetMenu              "
    Data 0226,"MDITile                 "
    Data 002C,"MeasursItem             "
    Data 0120,"MenuChar                "
    Data 0126,"MenuCommand             "
    Data 0123,"MenuDrag                "
    Data 0124,"MenuGetObject           "
    Data 0122,"MenuRButtonUp           "
    Data 011F,"MenuSelect              "
    Data 0021,"MouseActivate           "
    Data 0200,"MouseFirst              "
    Data 02A1,"MouseHover              "
    Data 020D,"MouseLast               "
    Data 02A3,"MouseLeave              "
    Data 0200,"MouseMove               "
    Data 020A,"MouseWheel              "
    Data 0003,"Move                    "
    Data 0216,"Moving                  "
    Data 0086,"NCActivate              "
    Data 0083,"NCCalcSize              "
    Data 0081,"NCCreate                "
    Data 0082,"NCDestroy               "
    Data 0084,"NChitTest               "
    Data 00A3,"NCLButtonDblClk         "
    Data 00A1,"NCLButtonDown           "
    Data 00A2,"NCLButtonUp             "
    Data 00A9,"NCMButtonDblClk         "
    Data 00A7,"NCMButtonDown           "
    Data 00A8,"NCMButtonUp             "
    Data 00A0,"NCMouseMove             "
    Data 0085,"NCPaint                 "
    Data 00A6,"NCRButtonDblClk         "
    Data 00A4,"NCRButtonDown           "
    Data 00A5,"NCRButtonUp             "
    Data 00AD,"NCXButtonDblClk         "
    Data 00AB,"NCXButtonDown           "
    Data 00AC,"NCXButtonUp             "
    Data 0028,"NextDlgCtl              "
    Data 004E,"Notify                  "
    Data 0055,"NotifyFormat            "
    Data 0000,"Null                    "
    Data 000F,"Paint                   "
    Data 0309,"PaintClipBoard          "
    Data 0026,"PaintIcon               "
    Data 0311,"PaletteChanged          "
    Data 0310,"PaletteIsChanging       "
    Data 0210,"ParentNotify            "
    Data 0302,"Paste                   "
    Data 0380,"PenWinFirst             "
    Data 038F,"PenWinLast              "
    Data 0048,"Power                   "
    Data 0218,"PowerBroadcast          "
    Data 0317,"Print                   "
    Data 0318,"PrintClient             "
    Data 0037,"QueryDragIcon           "
    Data 0011,"QueryEndSession         "
    Data 030F,"QueryNewPalette         "
    Data 0013,"QueryOpen               "
    Data 0129,"QueryUIState            "
    Data 0023,"QuerySync               "
    Data 0012,"Quit                    "
    Data 0206,"RButtonDblClk           "
    Data 0204,"RButtonDown             "
    Data 0205,"RButtonUp               "
    Data 0306,"RenderAllFormats        "
    Data 0305,"RenderFormat            "
    Data 0020,"SetCursor               "
    Data 0007,"SetFocus                "
    Data 0030,"SetFont                 "
    Data 0032,"SetHotKey               "
    Data 0080,"SetIcon                 "
    Data 000B,"SetRedraw               "
    Data 000C,"SetText                 "
    Data 0018,"ShowWindow              "
    Data 0005,"Size                    "
    Data 030B,"SizeClipBoard           "
    Data 0214,"Sizing                  "
    Data 002A,"SpoolerStatus           "
    Data 007D,"StyleChanged            "
    Data 007C,"StyleChanging           "
    Data 0088,"SyncPaint               "
    Data 0106,"SysChar                 "
    Data 0015,"SysColorChange          "
    Data 0112,"SysCommand              "
    Data 0107,"SysDeadChar             "
    Data 0104,"SysKeyDown              "
    Data 0105,"SysKeyUp                "
    Data 02C0,"Tablet_First            "
    Data 02DF,"Tablet_Last             "
    Data 0052,"TCard                   "
    Data 031A,"ThemeChanged            "
    Data 001E,"TimeChange              "
    Data 0113,"Timer                   "
    Data 0304,"Undo                    "
    Data 0109,"UniChar                 "
    Data 0125,"UnInitMenuPopup         "
    Data 0128,"UpdateUIState           "
    Data 0400,"User                    "
    Data 0054,"UserChanged             "
    Data 002E,"VKeyToItem              "
    Data 0115,"VScroll                 "
    Data 030A,"VScrollClipBoard        "
    Data 0047,"WindowPosChanged        "
    Data 0046,"WindowPosChanging       "
    Data 001A,"WinIniChange            "
    Data 0109,"WNT_ConvertRequestEx    "
    Data 02B1,"WTSSession_Change       "
    Data 020D,"XButtonDblClk           "
    Data 020B,"XButtonDown             "
    Data 020C,"XButtonUp               "
     
    End Function
     
    ' -------------------------------------------------------------------------

    Leave a comment:


  • Michael Mattias
    replied
    If i understand this properly, three things are required to enable this feature :

    1. Give the parent the WS_EX_CONTROLPARENT style
    2. Give the controls the WS_TABSTOP style
    3. Place the IsDialogMessage function in the messageloop
    Oh, you understand it correctly all right.

    However......

    Your tab navigation is not working because
    Code:
    hForm =          CreateWindowEx (0,_
    No WS_EX_CONTROLPARENT

    Code:
     While GetMessage(Msg, hForm, 0,0) > 0
     
            ' Post a copy of certain %WM_KeyUp messages to WndProc to be handled there
     
            If Msg.Message = %WM_KeyUp And _
               (Msg.wParam = 9 Or Msg.wParam = 13 Or Msg.wParam = 38 Or Msg.wParam = 40) Then
                PostMessage hForm,%AppMsg_ControlKey,Msg.wParam,0
            End If
     
            TranslateMessage (Msg)
            DispatchMessage  (Msg)
        Wend
     
    End Sub
    No ISDialogMessage ()

    AND

    You are not allowing the tab key and other keys to be handled by the system because you are screwing with the message loop. Eg..
    > ' Post a copy of certain %WM_KeyUp messages to WndProc to be handled there

    Those notification messags are going to get to your window procedure anyway, via DispatchMessage().

    Yes, you understand correctly, but your implementation of that understanding leaves a lot to be desired. (I was going to say it was awful, but I heroically resisted saying anything which might be interpreted personally).

    Best advice? See if you can find one of the tutorials on "creating a basic GUI application" and start over from there.

    MCM

    Leave a comment:


  • Arie Verheul
    replied
    General purpose Form-style user interface for PBCC 4 + 5 (revised)

    As promised, herewith the revised code. There are a few improvements, and i suppose the code
    is of a reasonable quality now. Given that it's Windows code, it's reasonably compact as well.
    It compiles both with PBCC 4 and 5.

    In my previous post i brought up three issues that i had my doubts about. I discuss them briefly below.

    1. Clean up procedure

    In the previous version the clean up procedure was for unclear reasons executed many times.
    As Edwin pointed out this was because i issued a DestroyWindow commmand while the window was already
    being destroyed, which made the procedure recursive. Beginners error.

    2. Color setting

    Color setting of the controls is essentially done with :

    Code:
    	' Callback function
     
            Case %WM_CtlColorEdit
     
                hDC      = wParam
     
                SetBkColor   hDC, EditBgColor
                SetTextColor hDC, EditTextColor
                Function  =  EditBgBrush
     
    	' Where EditBgColor, EditTextColor, EditBgBrush are defined in the applcation
    Here SetTextColor defines the text color, SetBkColor function sets the background color of the
    character boxes, and EditBgBrush paints the background outside the character boxes.

    While coming from the procedural world, it irritated me a bit that Windows repeated this color setting upon
    each single character that is typed in the control; i supposed that it should be sufficient to do this once.
    Under Windows this appears to be different.
    It's easy enough to provide a mechanism which turns off color setting once all colors have been set.
    If this is done, the colors of an edit field are immediately reversed to their default values as soon as
    a character is typed. Continuous color setting is simply required by Windows. Ridiculous system ...

    3. Keyboard navigation

    I had to place code for this inside the message loop and was for intuitive reasons not happy with this.
    Michael suggested to use the WS_TABSTOP feature but, i am sorry Michael, this is a misery so far.

    If i understand this properly, three things are required to enable this feature :

    1. Give the parent the WS_EX_CONTROLPARENT style
    2. Give the controls the WS_TABSTOP style
    3. Place the IsDialogMessage function in the messageloop

    Well, the WS_EX_CONTROLPARENT style also changes the system menu, which is not the intention.
    However, the tabstop feature works exactly the same without the WS_EX_CONTROLPARENT style,
    which leaves me a bit confused with respect to this.

    The IsDialogMessage function seems essential, but somehow disturbs message handling.
    Every character that is typed appears in fourfold, and any text that happens to be present
    in an edit control that is Tabbed to is automatically selected.
    As the TABSTOP feature is not well documented, only trial and error methods remained
    and i did not succeed to solve this so far.

    I therefore reverted to the previous approach where keyboard navigation was simply coded,
    which i do at least understand.
    The bad point of this, that the code was placed inside the messageloop, was solved by posting
    a copy of certain WM_KeyUp messages to the WndProc function, and handle them there.
    This is of course just a cosmetic change, but it results at least in neat code.

    Arie Verheul



    Code:
     
    #Dim All
    #Compiler PBCC
     
    %CompilerVersion = 5        ' set to major compiler version (tested with PBCC 4 + 5)
     
    #If %CompilerVersion > 4
    #Break On
    #Include Once "Win32Api.inc"
    #Else
    #Include "Win32Api.inc"
    #EndIf
     
    ' ----------------------------------------------------------------------------
    ' General purpose form-style user interface for PBCC - Arie Verheul - nov 2009
    ' ----------------------------------------------------------------------------
     
    ' This a general purpose form-style user interface, intended to be used with
    ' a regular PBCC application to enter names, adresses and similar data.
     
    ' It will produce on the screen any number of fields of a specified length,
    ' from one to as many as there will fit on it.
    ' There is a push button provided to accept the provided input.
     
    ' It was designed in such a way that the Windows code is kept separated
    ' from the PBCC code.
     
    ' To the left of each input field there is a label, stating the expected input.
    ' Optionally, if no text for the label is provided, no label is drawn either,
    ' which allows for input fields that may require a varying number of lines,
    ' as this is often the case with addresses.
     
    ' The form may use defaults for input fields.
     
    ' Background and text colors of edit fields and labels may be set to BGR values.
     
    ' The form may be set to ReadOnly to show output in the same format.
    ' In that case there is no push button.
     
    ' ----------------------------------------------------------------------------
     
    ' Application parameters, may be changed as needed
     
    $FUI_AppName             = "FormStyleUserInterface"
     
    $FUI_Font                = "Tahoma"    ' Swiss fonts only
    %FUI_FontHeight          = 14
    %FUI_FontWidth           = 60          ' Percent of FontHeight
     
    %FUI_Hor_Spacing         = 10          ' Field spacing in pixels
    %FUI_Vert_Spacing        = 10
     
    %FUI_Elongation          = 110         ' Percent of nominal length
                                           ' Elongates fields to allow for wider than average text
     
    %FUI_MaxLabelLength      = 40          ' Max. values to set aside Asciiz strings
    %FUI_MaxEditFieldLength  = 80
    %FUI_MaxTitleLength      = 64
    %FUI_MaxButtonTextLength = 32
     
    %FUI_WindowBGColor       = &H508060    ' BGR
    %FUI_LabelBgColor        = &H300000
    %FUI_EditBgColor         = &HB0F0C0
    %FUI_LabelTextColor      = &H00FFFF
    %FUI_EditTextColor       = &H200000
     
    ' ---------------------------------------------------------------------
    %AppMsg_ControlKey       = &H10000     ' Application defined message
    ' ---------------------------------------------------------------------
     
    Type FUI_FormData
         NumFields                  As Long      ' Actual number of fields
         FieldLength                As Dword     ' Actual field length
         ReadOnly                   As Dword     ' True/false
         Success                    As Long      ' Flag, true/false
         hFont                      As Dword
         FormBgBrush                As Dword
         EditBgBrush                As Dword
         LabelBgBrush               As Dword
         Title                      As Asciiz * %FUI_MaxTitleLength         ' Title as it appears in title bar
         ButtonText                 As Asciiz * %FUI_MaxButtonTextLength    ' Text to show on button
    End Type
     
    ' -------------------------------------------------------------------------
     
    Declare Sub         FUI_SetUp        (NumFields   As Long,_
                                          FieldLength As Long,_
                                          ReadOnly    As Long)
     
    Declare Sub         FUI_CreateForm
    Declare Sub         FUI_CreateFields (hForm As Dword)
    Declare Sub         FUI_CollectResult
     
    Declare Function    FUI_WndProc      (ByVal hForm   As Dword,_
                                          ByVal wMsg    As Dword,_
                                          ByVal wParam  As Dword,_
                                          ByVal lParam  As Dword) As Long
     
    ' ---------------------------------------------------------------------
     
    Global FUI_Data         As FUI_FormData
    Global FUI_hControl ()  As Dword
    Global FUI_Label    ()  As String
    Global FUI_Result   ()  As String
     
    ' ---------------------------------------------------------------------
     
    Function PBMain As Long
     
        ' FUI_SetUp (NumFields, FieldLength, ReadOnly)
     
        FUI_SetUp 5,40,0            ' 5 fields of 40 characters, ReadOnly = 0
     
        FUI_Data.Title              = "Demo form"
        FUI_Data.ButtonText         = "Process"
     
        Array Assign FUI_Label()    = "Field #1","Field #2","Field #3","","Field #4"
        Array Assign FUI_Result()   = "default for field 1"
     
        ' SUB FUI_CreateForm displays form and waits for input
     
        FUI_CreateForm
     
        ' Form is removed after button is clicked
     
        '----------------------------------------------------------------
     
        ' Normally application code will go here
     
        Local N             As Long
     
        Cursor Off
     
        Locate 1,1
     
        If FUI_Data.Success Then
     
            For N = 1 To UBound (FUI_Result())
                Print FUI_Result(N)
            Next
     
        End If
     
        '----------------------------------------------------------------
     
        WaitKey$
     
    End Function
     
    ' -------------------------------------------------------------------
     
    Sub FUI_SetUp (NumFields As Long, FieldLength As Long, ReadOnly As Long)
     
        ReDim FUI_hControl (2*NumFields)      As Global Dword
        ReDim FUI_Label    (1 To NumFields)   As Global String
        ReDim FUI_Result   (1 To NumFields)   As Global String
     
        FUI_Data.NumFields      = NumFields
        FUI_Data.FieldLength    = FieldLength
        FUI_Data.ReadOnly       = ReadOnly
        FUI_Data.Success        = 0
     
        FUI_Data.FormBgBrush    = CreateSolidBrush (%FUI_WindowBgColor)
        FUI_Data.EditBgBrush    = CreateSolidBrush (%FUI_EditBgColor)
        FUI_Data.LabelBgBrush   = CreateSolidBrush (%FUI_LabelBgColor)
     
    End Sub
     
    ' ---------------------------------------------------------------
     
    Sub FUI_CreateForm
     
       ' Create window to hold input fields
     
        Dim   Msg                       As tagMsg
        Dim   ClassDescription          As WndClassEx
     
        Local hForm                     As Dword
        Local hInstance                 As Dword
        Local ApplicationName           As Asciiz*24    ' Application name for class registration
     
        ApplicationName                 = $FUI_AppName
     
        hInstance                       = GetModuleHandle (ByVal(0))
     
        ClassDescription.Style          = %CS_ClassDC
        ClassDescription.hInstance      = hInstance
        ClassDescription.hbrBackground  = FUI_Data.FormBgBrush
        ClassDescription.lpszClassName  = VarPtr  (ApplicationName)
        ClassDescription.lpfnWndProc    = CodePtr (FUI_WndProc)
        ClassDescription.cbSize         = SizeOf  (ClassDescription)
     
        ' All other entries in ClassDescription are zero
     
        RegisterClassEx (ClassDescription)
     
        ' Set window size to default for the moment, exact size comes later
     
        hForm =          CreateWindowEx (0,_
                         ApplicationName,_            'window class name
                         Space$(2)+ FUI_Data.Title,_  'window title
                         %WS_SysMenu Or %WS_Caption,_ 'window style
                         %CW_UseDefault,_             'initial x position
                         %CW_UseDefault,_             'initial y position
                         %CW_UseDefault,_             'initial x size
                         %CW_UseDefault,_             'initial y size
                         0,_                          'parent window handle
                         0,_                          'window menu handle
                         hInstance,_                  'program instance handle
                         ByVal 0)                     'optional parameter
     
        '-----------------------------------------------------------------------------------
     
        ' Message loop
     
        While GetMessage(Msg, hForm, 0,0) > 0
     
            ' Post a copy of certain %WM_KeyUp messages to WndProc to be handled there
     
            If Msg.Message = %WM_KeyUp And _
               (Msg.wParam = 9 Or Msg.wParam = 13 Or Msg.wParam = 38 Or Msg.wParam = 40) Then
                PostMessage hForm,%AppMsg_ControlKey,Msg.wParam,0
            End If
     
            TranslateMessage (Msg)
            DispatchMessage  (Msg)
        Wend
     
    End Sub
     
    ' ---------------------------------------------------------------------
     
    Sub FUI_CreateFields (hForm As Dword)
     
        ' Creates various controls
     
        Dim    lfFont              As LOGFONT
     
        Local  hInstance           As Dword
        Local  StyleFlags          As Dword
        Local  Xwin,Ywin           As Long          ' Window left-top corner
        Local  WinWidth, WinHeight As Long          ' Window size
        Local  LabelFieldLength    As Long          ' Max. Label length in characters
                                                    ' or field length in pixels
        Local  EditFieldLength     As Long          ' Input field length in pixels
        Local  FieldHeight         As Long          ' Field height in pixels for given font
        Local  FrameWidth          As Long          ' Frame size for calculation of window size
        Local  TitleBarHeight      As Long          ' For calculation of window size
        Local  N, M                As Long
     
        Local  ClassName           As Asciiz * 12   ' Holds "Static", "Edit" or "Button"
        Local  Label               As Asciiz * %FUI_MaxLabelLength + 1
     
        Local  hDC As Dword
     
        ' ------------------------------------------------------------------
     
        ' Set Font
     
        lfFont.lfFaceName           = $FUI_Font
        lfFont.lfPitchAndFamily     = %FF_Swiss
        lfFont.lfHeight             = -%FUI_FontHeight
        lfFont.lfWidth              =  %FUI_FontHeight * %FUI_FontWidth / 100
     
        ' All other entries in lfFont are zero
     
        FUI_Data.hFont              = CreateFontIndirect (lfFont)
     
        ' ------------------------------------------------------------------
     
        ' Determine required length in characters for Label fields
     
        LabelFieldLength = Len(FUI_Data.ButtonText)
     
        For N = 1 To FUI_Data.NumFields
            LabelFieldLength  = Max&(LabelFieldLength, Len(FUI_Label(N)))
        Next
     
        ' ------------------------------------------------------------------
     
        ' Determine field sizes in pixels
     
        FieldHeight         = 1.5 * Abs(lfFont.lfHeight)
     
        ' %FUI_Elongation makes fields a bit longer as lfFont.lfWidth holds average font width
     
        LabelFieldLength    = %FUI_Elongation * (LabelFieldLength + 2) * lfFont.lfWidth / 100
     
        EditFieldLength     = %FUI_Elongation * (FUI_Data.FieldLength  + 1) * lfFont.lfWidth / 100
     
        ' ------------------------------------------------------------------
     
        ' Retrieve frame size
     
        FrameWidth     = GetSystemMetrics (%SM_CXDlgFrame)
        TitleBarHeight = GetSystemMetrics (%SM_CYCaption)
     
        ' ------------------------------------------------------------------
     
        ' Calculate size of main window
     
        WinWidth  = LabelFieldLength + EditFieldLength + 3 * %FUI_Hor_Spacing + 2 * FrameWidth
        WinHeight = (FUI_Data.NumFields + 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing + 
    
    TitleBarHeight + FrameWidth + 3
     
        ' In ReadOnly mode no button will be present
     
        If FUI_Data.ReadOnly Then Winheight = WinHeight - FieldHeight - %FUI_Vert_Spacing
     
        ' ------------------------------------------------------------------
     
        ' Center form on client area and make it Topmost to prevent it from accidentally disappearing
     
        Desktop Get Client To N, M
     
        Xwin = (N - WinWidth)  \ 2
        Ywin = (M - WinHeight) \ 2
     
        SetWindowPos (hForm, %Hwnd_TopMost,_
                      Xwin, Ywin, WinWidth, WinHeight, %SWP_ShowWindow)
     
        ' ------------------------------------------------------------------
     
        hInstance = GetModuleHandle (ByVal(0))
     
        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
        ' ------------------------------------------------------------------
     
        ' #0                                                Button
        ' #1 to #FUI_Data.NumFields                         Edit fields
        ' #FUI_Data.NumFields + 1 to 2*FUI_Data.NumFields   Labels
     
        For N = 0 To 2 * FUI_Data.NumFields
     
            Select Case N
                 Case 0                                         ' Button
     
                    If FUI_Data.ReadOnly Then Iterate For       ' No button if form is ReadOnly
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (FUI_Data.NumFields) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Button"
                    Label     = FUI_Data.ButtonText
     
                 Case 1 To FUI_Data.NumFields                   ' Edit fields
     
                    Xwin      = LabelFieldLength + 2 * %FUI_Hor_Spacing
                    Ywin      = (N - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = EditFieldLength
     
                    If FUI_Data.ReadOnly Then
     
                        ClassName = "Static"
                        Label = $Spc + FUI_Result(N)
                    Else
     
                        ' Give Edit fields ES_AutoHScroll style to allow for wider than average characters
     
                        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border Or %ES_AutoHScroll
     
                        ClassName = "Edit"
                        Label = FUI_Result(N)
                    End If
     
                 Case  > FUI_Data.NumFields                       ' Labels
     
                    M = N - FUI_Data.NumFields
     
                    If Trim$(FUI_Label(M)) = "" Then Iterate For  ' If no label text, no label either
     
                    StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (M - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Static"
                    Label     = $Spc + FUI_Label(M)
     
            End Select
     
            FUI_hControl(N) = CreateWindowEx(0,_
                                 ClassName,_          'window class name
                                 Label,_              'window title
                                 StyleFlags,_         'style
                                 Xwin,_               'initial x position
                                 Ywin,_               'initial y position
                                 WinWidth,_           'initial x size
                                 FieldHeight,_        'initial y
                                 hForm,_              'parent window handle
                                 0,_                  'window menu handle
                                 hInstance,_          'program instance handle
                                 ByVal 0)             'optional creation parameter
     
            PostMessage (FUI_hControl(N), %WM_SetFont, FUI_Data.hFont, 0)
     
            ' Set maximum text length in edit field to specified FieldLength
     
            If IsFalse FUI_Data.ReadOnly And N > 0 And N <= FUI_Data.NumFields Then
                PostMessage FUI_hControl(N), %EM_LimitText, FUI_Data.FieldLength, 0
            End If
     
        Next
     
    End Sub
     
    ' ----------------------------------------------------------------------
     
    Function FUI_WndProc(ByVal hForm    As Dword,_
                         ByVal wMsg     As Dword,_
                         ByVal wParam   As Dword,_
                         ByVal lParam   As Dword)    As Long
     
        Static ActiveField  As Long
        Local hDC           As Dword
        Local I             As Long
     
        Select Case wMsg
     
            Case %WM_Destroy
     
                DeleteObject FUI_Data.FormBgBrush
                DeleteObject FUI_Data.EditBgBrush
                DeleteObject FUI_Data.LabelBgBrush
                DeleteObject FUI_Data.hFont
     
                PostQuitMessage(0)
                Function = 0
     
            Case %WM_Create
     
                FUI_CreateFields hForm
                ActiveField = 1                     ' Initialize ActiveField
                SetFocus(FUI_hControl(1))           ' Set keyboard focus to top field
                Function = 0
     
            Case %WM_CtlColorEdit, %WM_CtlColorStatic
     
                hDC      = wParam
     
                ' In ReadOnly mode the Edit field is in fact a Static control,
                ' which however still has to be colored as an Edit control.
                ' Therefore we need to find out for each case what type each control is.
     
                Array Scan FUI_hControl(), = lParam, To I       ' lParam holds hControl
     
                If I > FUI_Data.NumFields + 1 Then              ' It is a label
     
                    SetBkColor   hDC, %FUI_LabelBgColor
                    SetTextColor hDC, %FUI_LabelTextColor
                    Function   = FUI_Data.LabelBgBrush
                Else                                            ' It is an edit field
                    SetBkColor   hDC, %FUI_EditBgColor
                    SetTextColor hDC, %FUI_EditTextColor
                    Function   = FUI_Data.EditBgBrush
                End If
     
            Case %WM_Command
     
                If wParam = 0 And lParam = FUI_hControl(0) Then ' Button clicked
     
                    FUI_CollectResult
                    DestroyWindow (hForm)
                End If
     
            Case %AppMsg_ControlKey     ' Application defined message about certain control keys
     
                ' This section handles keyboard navigation
     
                    Select Case wParam
     
                        Case 9,13,40                     ' Tab, Enter, Arrow Down
     
                            Select Case ActiveField
     
                                Case 0                   ' Button has keyboard focus
                                    If wParam = 13 Then  ' If Enter pressed then perform button action
                                        FUI_CollectResult
                                        DestroyWindow (hForm)
                                    End If
     
                                Case FUI_Data.NumFields  ' Keyboard focus is on last field
                                    ActiveField = 0
     
                                Case Else                ' Keyboard focus is on other field
                                    Incr ActiveField
                                    ActiveField = Min&(ActiveField,FUI_Data.NumFields)
     
                            End Select
     
                        Case 38                 ' Arrow Up
                            Decr ActiveField
                            ActiveField = Max&(ActiveField, 1)
                    End Select
     
                    SetFocus(FUI_hControl(ActiveField))
     
            Case Else : Function = DefWindowProc(hForm, wMsg, wParam, lParam)
     
        End Select
     
    End Function
     
    ' -------------------------------------------------------------------------
     
    Sub FUI_CollectResult
     
        Local N As Long
        Local FieldText As Asciiz*(%FUI_MaxEditFieldLength + 1)
     
        For N = 1 To FUI_Data.NumFields            ' Read content of edit fields
     
            GetWindowText FUI_hControl(N), FieldText, FUI_Data.FieldLength '%FUI_MaxLabelLength
            FUI_Result(N) = Trim$(FieldText)
        Next N
     
        FUI_Data.Success = -1                      ' Set Success flag
     
    End Sub
     
    ' -------------------------------------------------------------------------

    Leave a comment:


  • Arie Verheul
    replied
    Thanks very much again Michael.
    I initially had a problem to get the WS_TABSTOP style working, that's why i asked.
    With the additional comment i should be able to manage.

    I will have a look at the other options you gave me, but this will take some time.
    Please be patient with me.

    Oh yes Edwin, the CleanUp issue seems to be fully solved now. Thanks.

    Arie Verheul

    Leave a comment:


  • Michael Mattias
    replied
    BTW, you CAN use dialogs with PB/CC, too... dialogs pretty much handle a lot of the keyboard interface for you.

    See WinApi functions DialogBox[Indirect][param] and CreateDialog[Indirect][Param]

    To get good navigation with "CreateWindowEx" windows, see style WS_EX_CONTROLPARENT for window creation and IsDialogMessage() function for inclusion in your message loop.

    You'll also you'll want to look at TranslateAccelerator() if using keyboard accelerators to handle the function keys.

    MCM

    Leave a comment:


  • Michael Mattias
    replied
    However, how do i instruct Windows which control i consider as the next [control with WS_TABSTOP style]?
    If you don't set it explicitly with SetWindowPos (Z-order = tabstop order) , the order in which the controls are created determines the tab order.

    SetWindowPos() allows you to change the order dynamically, eg based on current application conditions.

    MCM

    Leave a comment:


  • Arie Verheul
    replied
    Thanks very much Edwin, that's it.
    The way i did it makes the clean up procedure recursive.
    I am studying the approach that you referred me to, which may take a little bit of time,
    as i am not very familiar with that programming style.

    Thanks Michael for the WS_TABSTOP approach.
    I was not aware of this, as i am not yet too familiar with Windows programming.
    And indeed i worried too that my approach would be rather non-standard.

    Both things are rather simple to fix, and probably by the end of this week
    i will post an update of the code.

    Just one further question. Looking in the WinApi helpfile (CreateWindow topic)
    it says the following about the WS_TABSTOP style:

    WS_TABSTOP Specifies a control that can receive the keyboard focus when the user presses the TAB key.

    Pressing the TAB key changes the keyboard focus to the next control with the WS_TABSTOP style.
    However, how do i instruct Windows which control i consider as the next one ?

    Arie Verheul

    Leave a comment:


  • Michael Mattias
    replied
    >For keyboard navigation between fields i need to intercept the WM_KeyDown messages.

    You do?

    That is not normally how this is handled. Further, doing this on keydown is subject to getting multiple notification messages when the user presses and holds the key in the down position. The WM_KEYUP notification is sent exactly once regardless of how long the user has held the key down.. so if you really want to use keystrokes to control navigation, that would likely be a better choice.

    However......

    Generally you allow Windows to handle the keyboard navigation, by using the WS_TABSTOP style on controls and letting the user use the <TAB> key to advance/retreat. That is, you code exactly nothing and the user may navigate all he wants with either the keyboard or the mouse.

    Also, you generally don't handle messages for a window in the message loop... you handle them in the window procedure. Not that you can't make it work this way, but it is definitely a non-standard way to do it.


    MCM

    Leave a comment:


  • Edwin Knoppert
    replied
    major bug, you destroy the form in the cleanup while it is in the destroy process already..

    DestroyWindow (hForm) ' Destroy main window

    Btw i strongly suggest my oop storage code (could not find it)

    Good enough:

    http://www.powerbasic.com/support/pb...ad.php?t=41159
    Last edited by Edwin Knoppert; 9 Nov 2009, 08:35 AM.

    Leave a comment:


  • Arie Verheul
    replied
    General purpose form-style user interface for PBCC (the code)

    Well, i tried some possibilities i could think of in view of your replies,
    but did not find a solution, so i greatly appreciate your help.

    The code below is about a simple but versatile form-style user interface, mainly intended
    to enter names, addresses and similar data into an application.
    The code functionally works and does exactly what i expect it to do, but when looking more
    carefully there are some concerns. This is about three issues:

    1. Clean up after finishing

    After finishing, a local sub CleanUp (line 493) is called.
    When checking this, i find that this sub is called 36 to 39 times for unclear reasons.
    I understand from your replies that this is definitely incorrect.
    What may be the reason for this behaviour ?

    2. Color setting of labels and edit fields

    Text and background colors of the controls are essentially set in the following way (line 454):

    Code:
     
    	' Callback function
     
            Case %WM_CtlColorEdit
     
                hDC      = wParam
     
                SetBkColor   hDC, %FUI_LabelBgColor
                SetTextColor hDC, %FUI_LabelTextColor
                Function  = FUI_Data.LabelBgBrush
     
    	' Where %FUI_LabelBgColor, %FUI_LabelTextColor, FUI_Data.LabelBgBrush are defined in the applcation
    This works as expected.
    However Windows sends a WM_CtlColorEdit message upon each single character that is typed in the control.
    This means that the color setting is redone upon each individual character.
    As i am not after special effects this seems a bit overdone, and processing of the WM_CtlColorEdit messages could be terminated
    after creation of the controls. Is there a usual way to do this ?

    3. Interception of WM_KeyDown messages for keyboard navigation between fields

    For keyboard navigation between fields i need to intercept the WM_KeyDown messages.
    These messages seem to be sent to, and handled by, the edit control that has keyboard focus,
    as i cannot intercept them in the callback procedure.

    Of course i can invent something that does the job (line 219), but i have my doubts if this is a recommended approach.
    How is this normally done ?

    Arie Verheul




    Code:
     
    #Compiler PBCC
    #Dim All
    #Break On
     
    #Include "Win32Api.inc"
     
    ' ---------------------------------------------------------------------
     
    ' This a general purpose form-style user interface, intended to be used with
    ' a regular PBCC application to enter names, adresses and similar data.
     
    ' It will produce to the screen any number of fields of a specified length,
    ' from one to as many as there will fit on it.
    ' There is a push button provided to accept the provided input.
     
    ' It was designed in such a way that the Windows code is kept separated
    ' from the PBCC code.
     
    ' To the left of each input field there is a label, stating the expected input.
    ' Optionally, if no text for the label is provided, no label is drawn either,
    ' which allows for input fields that may require a varying number of lines,
    ' as is often the case with addresses.
     
    ' The form may use defaults for input fields.
     
    ' Background and text colors of edit fields and labels may be set to BGR values.
     
    ' The form may be set to ReadOnly to show output in the same format.
    ' In that case there is no push button.
     
    ' ---------------------------------------------------------------------
     
    ' Application parameters, may be changed as needed
     
    $FUI_AppName             = "FormStyleUserInterface"
     
    $FUI_Font                = "Tahoma"    ' Swiss fonts only
    %FUI_FontHeight          = 14
    %FUI_FontWidth           = 60          ' Percent of FontHeight
     
    %FUI_Hor_Spacing         = 10          ' Field spacing in pixels
    %FUI_Vert_Spacing        = 10
     
    %FUI_MaxLabelLength      = 40          ' Max. values to set aside Asciiz strings
    %FUI_MaxEditFieldLength  = 80
    %FUI_MaxTitleLength      = 64
    %FUI_MaxButtonTextLength = 32
     
    %FUI_WindowBGColor       = &H508060    ' BGR
    %FUI_LabelBgColor        = &H300000
    %FUI_EditBgColor         = &HB0F0C0
    %FUI_LabelTextColor      = &H00FFFF
    %FUI_EditTextColor       = &H200000
     
    ' ---------------------------------------------------------------------
     
    Type FUI_FormData
         NumFields                  As Long                ' Actual number of fields
         FieldLength                As Dword
         ReadOnly                   As Dword
         Success                    As Long
         hFont                      As Dword
         FormBgBrush                As Dword
         EditBgBrush                As Dword
         LabelBgBrush               As Dword
         Title                      As Asciiz * %FUI_MaxTitleLength +1        ' Title as it appears in title bar
         ButtonText                 As Asciiz * %FUI_MaxButtonTextLength +1   ' Text to show on button
    End Type
     
    ' -------------------------------------------------------------------------
     
    Declare Sub         FUI_SetUp        (NumFields   As Long,_
                                          FieldLength As Long,_
                                          ReadOnly    As Long)
     
    Declare Sub         FUI_CreateForm
    Declare Sub         FUI_CreateFields (hForm As Dword)
    Declare Sub         FUI_CollectResult
     
    Declare Function    FUI_WndProc      (ByVal hForm   As Dword,_
                                          ByVal wMsg    As Dword,_
                                          ByVal wParam  As Dword,_
                                          ByVal lParam  As Dword) As Long
     
    ' ---------------------------------------------------------------------
     
    Global FUI_Data         As FUI_FormData
    Global FUI_hControl ()  As Dword
    Global FUI_Label    ()  As String
    Global FUI_Result   ()  As String
     
    ' ---------------------------------------------------------------------
     
    Function PBMain As Long
     
        ' FUI_Setup dimensions arrays, and sets certain values
     
        FUI_SetUp 5,40,0            ' 5 fields of 40 characters, ReadOnly = 0
     
        FUI_Data.Title              = "Demo form"
        FUI_Data.ButtonText         = "Process"
        
        '----------------------------------------------------------------
        
        ' Texts for labels are stored in FUI_Label()
        ' Optionally default values may be placed in FUI_Result()
        
        ' After button is clicked, a success flag is set in FUI_Data.Success,
        ' and the input supplied is returned in FUI_Result()
        
        '----------------------------------------------------------------
     
        Array Assign FUI_Label ()   = "Field #1","Field #2","Field #3","","Field #4"
        Array Assign FUI_Result()   = "default for field 1"
     
        FUI_CreateForm      ' FUI_CreateForm displays form and waits for input
     
        '----------------------------------------------------------------
     
        ' For demo only, normally application code goes here
     
        Local N             As Long
        
        Locate 1,1
     
        If FUI_Data.Success Then
     
            For N = 1 To UBound (FUI_Result())
                Print FUI_Result(N)
            Next
     
        End If
     
        '----------------------------------------------------------------
     
        WaitKey$
     
    End Function
     
    ' ---------------------------------------------------------------                 SETPROP
     
    Sub FUI_SetUp (NumFields As Long, FieldLength As Long, ReadOnly As Long)
     
        ReDim FUI_hControl (2*NumFields)      As Global Dword
        ReDim FUI_Label    (1 To NumFields)   As Global String
        ReDim FUI_Result   (1 To NumFields)   As Global String
     
        FUI_Data.NumFields      = NumFields
        FUI_Data.FieldLength    = FieldLength
        FUI_Data.ReadOnly       = ReadOnly
        FUI_Data.Success        = 0
     
        FUI_Data.FormBgBrush    = CreateSolidBrush (%FUI_WindowBgColor)
        FUI_Data.EditBgBrush    = CreateSolidBrush (%FUI_EditBgColor)
        FUI_Data.LabelBgBrush   = CreateSolidBrush (%FUI_LabelBgColor)
     
    End Sub
     
    ' ---------------------------------------------------------------
     
    Sub FUI_CreateForm
     
       ' Create window to hold input fields
     
        Dim   Msg                       As tagMsg
        Dim   ClassDescription          As WndClassEx
     
        Local hForm                     As Dword
        Local hInstance                 As Dword
        Local ActiveField               As Long         ' Edit field with keyboard focus
        Local ApplicationName           As Asciiz*24    ' Application name for class registration
     
        ApplicationName                 = $FUI_AppName
     
        hInstance                       = GetModuleHandle (ByVal(0))
     
        ClassDescription.style          = %CS_ClassDC
        ClassDescription.hInstance      = hInstance
        ClassDescription.hbrBackground  = FUI_Data.FormBgBrush
        ClassDescription.lpszClassName  = VarPtr  (ApplicationName)
        ClassDescription.lpfnWndProc    = CodePtr (FUI_WndProc)
        ClassDescription.cbSize         = SizeOf  (ClassDescription)
     
        ' All other entries in ClassDescription are zero
     
        RegisterClassEx (ClassDescription)
     
        ' Set window size to default for the moment, exact size comes later
     
        hForm =          CreateWindowEx (0,_
                         ApplicationName,_            'window class name
                         Space$(2)+ FUI_Data.Title,_  'window title
                         %WS_SysMenu Or %WS_Caption,_ 'window style
                         %CW_UseDefault,_             'initial x position
                         %CW_UseDefault,_             'initial y position
                         %CW_UseDefault,_             'initial x size
                         %CW_UseDefault,_             'initial y size
                         0,_                          'parent window handle
                         0,_                          'window menu handle
                         hInstance,_                  'program instance handle
                         ByVal 0)                     'optional creation parameter
     
        '-----------------------------------------------------------------------------------
     
        ActiveField = 1
        SetFocus(FUI_hControl(1))           ' Set keyboard focus to top field
     
        '-----------------------------------------------------------------------------------
     
        ' Message loop
     
        While GetMessage(Msg, hForm, 0,0) > 0
     
            ' This section handles keyboard navigation
     
            ' The WM_KeyDown messages are handled directly by the edit controls
            ' and therefore need to be intercepted elsewhere
     
            If Msg.Message = %WM_KeyDown Then
     
                Select Case Msg.wparam      ' Intercepts keys to move keyboard focus between input fields
     
                    Case 13                 ' Enter
     
                        Select Case ActiveField
     
                            Case 0                   ' Button has keyboard focus
     
                                SendMessage (hForm,%WM_Command,0,FUI_hControl(0))
     
                            Case FUI_Data.NumFields  ' Keyboard focus is on last field
                                ActiveField = 0      ' Transfer focus to button
     
                            Case Else                ' Keyboard focus is on other field
                                Incr ActiveField     ' Transfer focus to next field
                                ActiveField = Min&(ActiveField,FUI_Data.NumFields)
     
                        End Select
     
                    Case 9,40            ' Tab,Arrow down
                        Incr ActiveField
                        ActiveField = Min&(ActiveField,FUI_Data.NumFields)
     
                    Case 38                 ' Arrow up
                        Decr ActiveField
                        ActiveField = Max&(ActiveField, 1)
                End Select
     
                SetFocus(FUI_hControl(ActiveField))
            End If
     
            TranslateMessage (Msg)
            DispatchMessage  (Msg)
        Wend
     
    End Sub
     
    ' ---------------------------------------------------------------------
     
    Sub FUI_CreateFields (hForm As Dword)
     
        ' Creates individual Edit and Label fields, plus the button
     
        Dim    lfFont              As LOGFONT
     
        Local  hInstance           As Dword
        Local  StyleFlags          As Dword
        Local  Xwin,Ywin           As Long          ' Window left-top corner
        Local  WinWidth, WinHeight As Long          ' Window size
        Local  LabelFieldLength    As Long          ' Max. Label length in characters
                                                    ' or field length in pixels
        Local  EditFieldLength     As Long          ' Input field length in pixels
        Local  FieldHeight         As Long          ' Field height in pixels for given font
        Local  FrameWidth          As Long          ' Frame size for calculation of window size
        Local  TitleBarHeight      As Long          ' For calculation of window size
        Local  N, M                As Long
     
        Local  ClassName           As Asciiz * 12   ' Holds "Static", "Edit" or "Button"
        Local  Label               As Asciiz * %FUI_MaxLabelLength + 1
     
        Local  hDC As Dword
     
        ' ------------------------------------------------------------------
     
        ' Set Font
     
        lfFont.lfFaceName           = $FUI_Font
        lfFont.lfPitchAndFamily     = %FF_Swiss
        lfFont.lfHeight             = -%FUI_FontHeight
        lfFont.lfWidth              =  %FUI_FontHeight * %FUI_FontWidth / 100
     
        ' All other entries in lfFont are zero
     
        FUI_Data.hFont              = CreateFontIndirect (lfFont)
     
        ' ------------------------------------------------------------------
     
        ' Determine required length for Label fields
     
        LabelFieldLength = Len(FUI_Data.ButtonText)
     
        For N = 1 To FUI_Data.NumFields
            LabelFieldLength  = Max&(LabelFieldLength, Len(FUI_Label(N)))
        Next
     
        ' ------------------------------------------------------------------
     
        ' Determine field sizes in pixels
     
        ' Determine FieldHeight from lfHeight
     
        FieldHeight         = 1.5 * Abs(lfFont.lfHeight)
     
        LabelFieldLength    = 1.1 * (LabelFieldLength + 2) * lfFont.lfWidth
     
        ' LabelFieldLength now holds window width in pixels, lfWidth holds average width
     
        EditFieldLength     = 1.1 * (FUI_Data.FieldLength  + 1) * lfFont.lfWidth
     
        ' ------------------------------------------------------------------
     
        ' Retrieve frame size
     
        FrameWidth     = GetSystemMetrics (%SM_CXDlgFrame)
        TitleBarHeight = GetSystemMetrics (%SM_CYCaption)
     
        ' ------------------------------------------------------------------
     
        ' Calculate size of form
     
        WinWidth  = LabelFieldLength + EditFieldLength + 3 * %FUI_Hor_Spacing + 2 * FrameWidth
        WinHeight = (FUI_Data.NumFields + 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing + TitleBarHeight + FrameWidth + 3
        
        ' No button needed if form is ReadOnly
     
        If FUI_Data.ReadOnly Then Winheight = WinHeight - FieldHeight - %FUI_Vert_Spacing
     
        ' ------------------------------------------------------------------
     
        ' Center form on client area
     
        Desktop Get Client To N, M
     
        Xwin = (N - WinWidth)  \ 2
        Ywin = (M - WinHeight) \ 2
     
        ' Make form TopMost to prevent it from accidentally disappearing
     
        SetWindowPos (hForm, %Hwnd_TopMost,_
                      Xwin, Ywin, WinWidth, WinHeight, %SWP_ShowWindow)
     
        ' ------------------------------------------------------------------
     
        hInstance  = GetModuleHandle (ByVal(0))
     
        StyleFlags = %WS_Child Or %WS_Visible Or %WS_Border
        
        ' ------------------------------------------------------------------
        ' Control handles
     
        ' #0                                                > Button
        ' #1 to #FUI_Data.NumFields                         > Edit fields
        ' #FUI_Data.NumFields + 1 to 2*FUI_Data.NumFields   > Labels
        ' ------------------------------------------------------------------
     
        For N = 0 To 2 * FUI_Data.NumFields
     
            Select Case N
                 Case 0                                         ' Button
     
                    If FUI_Data.ReadOnly Then Iterate For       ' No button if form is ReadOnly
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (FUI_Data.NumFields) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Button"
                    Label     = FUI_Data.ButtonText
     
                 Case 1 To FUI_Data.NumFields                   ' Edit fields
     
                    Xwin      = LabelFieldLength + 2 * %FUI_Hor_Spacing
                    Ywin      = (N - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = EditFieldLength
     
                    If FUI_Data.ReadOnly Then
     
                        ClassName = "Static"
                        Label     = $Spc + FUI_Result(N)
                    Else
     
                        ClassName = "Edit"
                        Label     = FUI_Result(N)
                    End If
     
                 Case  > FUI_Data.NumFields                       ' Labels
     
                    M = N - FUI_Data.NumFields
     
                    If Trim$(FUI_Label(M)) = "" Then Iterate For  ' If no label text provided, no label is drawn either
     
                    Xwin      = %FUI_Hor_Spacing
                    Ywin      = (M - 1) * (FieldHeight + %FUI_Vert_Spacing) + %FUI_Vert_Spacing
                    WinWidth  = LabelFieldLength
                    ClassName = "Static"
                    Label     = $Spc + FUI_Label(M)
     
            End Select
     
     
            FUI_hControl(N) = CreateWindowEx(0,_
                                 ClassName,_           'window class name
                                 Label,_               'window title
                                 StyleFlags,_          'style
                                 Xwin,_                'initial x position
                                 Ywin,_                'initial y position
                                 WinWidth,_            'initial x size
                                 FieldHeight,_         'initial y
                                 hForm,_               'parent window handle
                                 0,_                   'window menu handle
                                 hInstance,_           'program instance handle
                                 ByVal 0)              'optional parameter
     
            SendMessage (FUI_hControl(N), %WM_SetFont, FUI_Data.hFont, 0)
     
        Next
     
    End Sub
     
    ' ----------------------------------------------------------------------
     
    Function FUI_WndProc(ByVal hForm    As Dword,_
                         ByVal wMsg     As Dword,_
                         ByVal wParam   As Dword,_
                         ByVal lParam   As Dword)    As Long
     
        Local hDC        As Dword
        Local I          As Long
     
        Static Counter As Long          ' <<<< Installed for testing
     
        '----------------------------------------------------------------------
     
        Select Case wMsg
     
            Case %WM_Destroy
     
                GoSub CleanUp
     
            Case %WM_Create
     
                FUI_CreateFields hForm
                Function = 0
     
            Case %WM_CtlColorEdit, %WM_CtlColorStatic
     
                hDC      = wParam
     
                ' In ReadOnly mode the Edit field is in fact a Static control,
                ' which however still has to be colored as an Edit field.
                ' Therefore we need to find out for each case the function of the control.
     
                Array Scan FUI_hControl(), = lParam, To I       ' lParam holds control handle
     
                If I > FUI_Data.NumFields + 1 Then              ' It is a label
     
                    SetBkColor hDC, %FUI_LabelBgColor
                    SetTextColor hDC, %FUI_LabelTextColor
                    Function  = FUI_Data.LabelBgBrush
                Else                                            ' It is an edit field
                    SetBkColor hDC, %FUI_EditBgColor
                    SetTextColor hDC, %FUI_EditTextColor
                    Function  = FUI_Data.EditBgBrush
                End If
     
            Case %WM_Command
     
                If wparam = 0 And lparam = FUI_hControl(0) Then
     
                    FUI_CollectResult
     
                    GoSub CleanUp
     
                End If
     
            Case Else : Function = DefWindowProc(hForm, wMsg, wParam, lParam)
     
        End Select
     
    Exit Function
     
    '-------------------------------------------------------------------------
     
    CleanUp:
     
        '---------------------------------------------------------------------
        Incr Counter                    ' <<< For testing only
        Locate 10,1
        Print Using$("Clean up  ###",Counter)
        '---------------------------------------------------------------------
     
        For I = 0 To UBound(FUI_hControl())     ' Destroy controls
            
            If FUI_hControl(I) > 0 Then DestroyWindow (FUI_hControl(I))
        Next
        
        DestroyWindow (hForm)                   ' Destroy main window
     
        DeleteObject FUI_Data.FormBgBrush       ' Destroy brushes and font handle
        DeleteObject FUI_Data.EditBgBrush
        DeleteObject FUI_Data.LabelBgBrush
        DeleteObject FUI_Data.hFont
     
        Function = 0
     
    Return
     
    End Function
     
    ' -------------------------------------------------------------------------
     
    Sub FUI_CollectResult
     
        Local N As Long
        Local FieldText As Asciiz*(%FUI_MaxEditFieldLength + 1)
     
        For N = 1 To FUI_Data.NumFields            ' Read content of edit fields
     
            GetWindowText FUI_hControl(N), FieldText, %FUI_MaxLabelLength
            FUI_Result(N) = Trim$(FieldText)
        Next N
     
        FUI_Data.Success = -1                      ' Set Success flag
     
    End Sub
     
    ' -------------------------------------------------------------------------

    Leave a comment:


  • Michael Mattias
    replied
    >WM_Destroy is even for a fairly simple screen sent 36 to 39 times...

    > understand that WM_Destroy should come once, and if it comes this often there is something wrong.

    It is sent only once. Show failing code.

    FWIW, WM_DESTROY is exactly the right place to do your cleanup... because it's sent exactly once, after the window is removed from the screen but before 'total destruction' renders the handle invalid. (BTW this message is a notification, not a "Captain May I?" thing!)

    MCM

    Leave a comment:


  • Chris Holbrook
    replied
    Originally posted by Edwin Knoppert View Post
    A window is a class, each 'instance' of that class will reuse the code being provided/set.
    quite so.

    Leave a comment:


  • Edwin Knoppert
    replied
    >where typically you want to restrict your message handler to message for a single window

    That statement is incorrect.
    A window is a class, each 'instance' of that class will reuse the code being provided/set.

    Leave a comment:


  • Arie Verheul
    replied
    I understand that WM_Destroy should come once, and if it comes this often there is something wrong.
    I will try to find the cause of this first by myself.
    In about a week i intend to post all of the code, as apart from this problem it's an interesting piece of work.

    Arie Verheul

    Leave a comment:


  • Chris Holbrook
    replied
    Arie,

    What does your message loop look like? As Edwin says, you may be seeing messages for a lot of windows where typically you want to restrict your message handler to message for a single window.

    My advice, post your code!

    Leave a comment:


  • Edwin Knoppert
    replied
    No, it comes by only once but if you share the windowproc() you'll need to distinct the window by hWnd.

    To store a brush to a single window think of using Setprop() API.

    SetProp( cbhndl, "MYBRUSH", hBrush )
    And delete on WM_DESTROY and remove the property..

    Leave a comment:

Working...
X