What is the counterpart of WM_Create ?

[Arie Verheul]

I ventured into some PBCC Windows programming.
Just a main window with some controls.

On WM_Create i install the controls, which works fine.
If i check this, WM_Create is sent exactly once.

When done i need to destroy some brushes and font handles (once). I initiated this from WM_Destroy.
To my surprise, when checking this, WM_Destroy is even for a fairly simple screen sent 36 to 39 times,
thus causing the cleanup to be done this number of times, which is a bit overdone.

Is there a true counterpart of WM_Create, which is sent exactly once if a thread finishes ?

Arie Verheul

[Edwin Knoppert]

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..

[Chris Holbrook]

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!

[Arie Verheul]

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

[Edwin Knoppert]

>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.

[Chris Holbrook]

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

quite so.

[Michael Mattias]

>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

[Arie Verheul]

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):

 
	' 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

 
#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
 
' -------------------------------------------------------------------------

[Edwin Knoppert]

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/pbforums/showthread.php?t=41159

[Michael Mattias]

>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

[Arie Verheul]

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

[Michael Mattias]

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

[Michael Mattias]

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

[Arie Verheul]

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

[Arie Verheul]

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 :

	' 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

 
#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
 
' -------------------------------------------------------------------------

[Michael Mattias]

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

hForm =          CreateWindowEx (0,_

No WS_EX_CONTROLPARENT

 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

[Arie Verheul]

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

 
#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
 
' -------------------------------------------------------------------------

[Michael Mattias]

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

[Arie Verheul]

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 :

 
    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

 
#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
 
' -------------------------------------------------------------------------

[Chris Holbrook]

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.

#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