• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

CWindow problem adding 2nd button

Started by Paul Elliott, January 08, 2012, 02:54:04 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Paul Elliott

Hello,

Sorry but I posted this in the wrong place before. Not wide awake yet.

I've been trying to work on a program based on Jose's CWindow with TAB example in CSED.
After a lot of errors and now a really hung cpu, I've narrowed my problem down to when I
add a button on the main form and there is a button on a tab page. I can press the main form
button & no problem. Press the tab page button and my cpu sits near 100 percent usage.

Will somebody please tell me what I'm doing wrong?

Thanks.


' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl.pbtpl
' Contents: Template - CWindow with a tab control
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#COMPILE EXE
#DIM ALL
'#DEBUG ERROR ON
'#DEBUG DISPLAY ON
#TOOLS OFF
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "TabCtrl.inc"        ' // Tab control wrappers
#INCLUDE ONCE "ComboBoxCtrl.inc"   ' // Combo box control wrappers
#INCLUDE ONCE "ListBoxCtrl.inc"    ' // List box control wrappers

' // Control identifiers
%IDC_TAB       = 1001
%IDC_EDIT1     = 1002
%IDC_EDIT2     = 1003
%IDC_BTNSUBMIT = 1004
%IDC_COMBO     = 1005
%IDC_LISTBOX   = 1006
%IDC_BTNMAIN   = 1007

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
'   SetProcessDPIAware

   TRACE NEW "trc.txt"
   TRACE ON
   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "CWindow with a Tab control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the class style to remove flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize 520, 445
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a Tab control
   LOCAL hTab AS DWORD
   hTab = pWindow.AddTab(pWindow.hwnd, %IDC_TAB, "", 10, 10, 490, 303)
   pWindow.AddButton(pWindow.hwnd, %IDC_BTNMAIN,   "Main",    15, 335, 116,  41, %BS_PUSHBUTTON)
   ' // Add tab pages
   LOCAL pTabPage1, pTabPage2, pTabPage3 AS IWindow
   pTabPage1 = pWindow.InsertTabPage(hTab, 0, "Tab 1", -1, 0, 0, CODEPTR(TabPage1_WndProc))
   pTabPage2 = pWindow.InsertTabPage(hTab, 1, "Tab 2", -1, 0, 0, CODEPTR(TabPage2_WndProc))
   pTabPage3 = pWindow.InsertTabPage(hTab, 2, "Tab 3", -1, 0, 0, CODEPTR(TabPage3_WndProc))

   ' // Add controls to the first page
   pWindow.AddLabel(pTabPage1.hwnd, -1, "First name", 15, 15, 121, 21)
   pWindow.AddLabel(pTabPage1.hwnd, -1, "Last name", 15, 50, 121, 21)
   pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT1, "", 165, 15, 186, 21)
   pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT2, "", 165, 50, 186, 21)
   pWindow.AddButton(pTabPage1.hwnd, %IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, %BS_PUSHBUTTON)

   ' // Add controls to the 2nd page
   LOCAL hComboBox AS DWORD
   hComboBox = pTabPage2.AddComboBox(pTabPage2.hwnd, %IDC_COMBO, "", 20, 20, 191, 105)

   ' // Add controls to the 3rd page
   LOCAL hListBox AS DWORD
   hListBox = pTabPage3.AddListBox(pTabPage3.hwnd, %IDC_LISTBOX, "", 15, 20, 161, 120)

   ' // Fill the controls with some data
   LOCAL i AS LONG
   FOR i = 1 TO 9
      Combobox_AddString hComboBox, "Item" & STR$(i)
      ListBox_AddString hListBox,  "Item" & STR$(i)
   NEXT
   ComboBox_SetCurSel hComboBox, 0
   ListBox_SetCurSel hListBox, 0

   ' // Display the first tab page
   ShowWindow pTabPage1.hwnd, %SW_SHOW
   ' // Set the focus to the first tab
   TabCtrl_SetCurFocus hTab, 0

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

   TRACE CLOSE

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE %IDC_BTNMAIN
               MSGBOX "btn main"
               EXIT FUNCTION
         END SELECT

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

      CASE %WM_NOTIFY

         LOCAL nPage AS DWORD         ' // Page number
         LOCAL pTabPage AS IWindow    ' // Tab page object reference
         LOCAL tci AS TCITEM          ' // TCITEM structure

         LOCAL ptnmhdr AS NMHDR PTR   ' // Information about a notification message
         ptnmhdr = lParam
         SELECT CASE @ptnmhdr.idFrom
            CASE %IDC_TAB
               SELECT CASE @ptnmhdr.code
                  CASE %TCN_SELCHANGE
                     ' // Show the selected page
                     nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
                     tci.mask = %TCIF_PARAM
                     TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
                     IF tci.lParam THEN
                        pTabPage = Ptr2Obj(tci.lParam)
                        IF ISOBJECT(pTabPage) THEN
                           ShowWindow pTabPage.hwnd, %SW_SHOW
                           pTabPage = NOTHING
                        END IF
                     END IF
                  CASE %TCN_SELCHANGING
                     ' // Hide the current page
                     nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
                     tci.mask = %TCIF_PARAM
                     TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
                     IF tci.lParam THEN
                        pTabPage = Ptr2Obj(tci.lParam)
                        IF ISOBJECT(pTabPage) THEN
                           ShowWindow pTabPage.hwnd, %SW_HIDE
                           pTabPage = NOTHING
                        END IF
                     END IF
               END SELECT

         END SELECT

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDC_BTNSUBMIT
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  MSGBOX "Submit"
                  EXIT FUNCTION
               END IF
         END SELECT

   END SELECT

   FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hBrush AS DWORD
   LOCAL rc AS RECT
   LOCAL tlb AS LOGBRUSH

   SELECT CASE uMsg

      CASE %WM_ERASEBKGND
         GetClientRect hWnd, rc
         ' Create custom brush
         tlb.lbStyle = %BS_SOLID
         tlb.lbColor = &H00CB8734???
         tlb.lbHatch = 0
         hBrush = CreateBrushIndirect(tlb)
         ' Erase background
         FillRect wParam, rc, hBrush
         DeleteObject hBrush
         FUNCTION = %TRUE
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
FUNCTION TabPage3_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hBrush AS DWORD
   LOCAL rc AS RECT
   LOCAL tlb AS LOGBRUSH

   SELECT CASE uMsg

      CASE %WM_ERASEBKGND
         GetClientRect hWnd, rc
         ' Create custom brush
         tlb.lbStyle = %BS_SOLID
         tlb.lbColor = %GREEN
         tlb.lbHatch = 0
         hBrush = CreateBrushIndirect(tlb)
         ' Erase background
         FillRect wParam, rc, hBrush
         DeleteObject hBrush
         FUNCTION = %TRUE
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================



Paul Elliott

For the moment, I would welcome a response from anybody.
Either way == yes they also see the problem  or no the program works fine for them.
Or that I'm a fool for posting in the wrong forum.

Until I get some sort of response, I can't see moving forward with the program ( which is much bigger
than the posted code ... it was just the smallest program that deomonstrated my problem and I had
spent a few days trying different options and removing code to see what could be causing the
problem  ).



José Roca

I have been looking at the problem but I haven't found the cause so far. For the moment, you can use SDK code to add the tab control and create the pages and controls displayed in the pages.

Paul Elliott

Thanks for the reply.

I'll continue on using your CWindow code and just disable the  few buttons that are causing me problems.
Checkboxes & option buttons aren't causing any problems. Just the pushbuttons.

I can add a couple small buttons on the main form if needed until you find the problem.

So far I haven't used pure SDK to create any programs as my needs have been satisfied by DDT or
Phoenix or FireFly. Maybe I'll do the next program in SDK if I get bored with CWindow.


Paul Elliott

#4
José,

I don't know if I'm seeing it right or not but while running in the debugger & animating  it seems to be
skipping over the Unicode sections of code and stepping thru the ansi sections. Unless some of the
#IF are doing #IF NOT %DEF(%UNICODE) first instead of #IF %DEF(%UNICODE).  AFXWIN.INC has
the #IF backwards!!!???
Also AFXPATH.INC has them backwards???

Is there a way to undef the %UNICODE = 1 ?

I was running in animate for about half-an-hour and it still hadn't shown any form on screen.
Is this normal?  Admittedly I'm runing Windows 2000 on a P4 2.8  and on a slow hd.


Paul Elliott

Those 2 inc files still look wrong but they aren't the whole problem.
AFXWIN.INC line 3898

#IF NOT %DEF(%UNICODE)
   MACRO AfxGetMessageFontPointSize = AfxGetMessageFontPointSizeW
#ELSE
   MACRO AfxGetMessageFontPointSize = AfxGetMessageFontPointSizeA
#ENDIF   


I changed them & compiled tabbtn.bas but it still maxed my cpu.

I'll check back in the morning ( my time  which will be around 12:00 noon here ).


José Roca

The only way to udenf %UNICODE = 1 is to no define it. REM or remove it.

I have wronly used #IF NOT %DEF, instead of #IF %DEF, in AfxWin.inc and AfxPath.inc. The attachment below contains these two files modified.

Paul Elliott

I took a quick look thru checking that there was a W & an A in the #IF %DEF lines and
found a few that you might want to look at. It's the .inc file & line # of the #IF.

I've gotten down to TabCtrl.inc and that's about 2/3 the way thru the list.
I'll continue on just to be doing something and check back in an hour or so.
I'm not changing anything. Just looking.


advpub 208

bthdef 1142
       1152
       
cfgmgr32 2567 ? spelling

commctrl 1281

dbghelp 2917

richedit 1170

rpcdce  930       
       1691
       
setupapi  821
         3772
         5425
         5439
         5463 & more  no #ELSE
         
shlwapi  204
         811
         822
        2415
               

Paul Elliott

Only found 3 more that need checking.

That's amazing considering the thousands of lines that needed changes ( or was it hundreds of
thousands ? ).



wincrypt 16233

wininet 2143

winreg 1003


José Roca

Thanks very much. The attached fie contains the modified include files.

BTW the ones lacking #ELSE were functions that had not both A and W versions, and there is a funny one:


' StrFormatByteSize64 can be used for either ANSI or Unicode characters. However, while StrFormatByteSize64A
' can be called directly, StrFormatByteSize64W is not defined. When StrFormatByteSize64 is called with a
' Unicode value, StrFormatByteSizeW is used.
#IF %DEF(%UNICODE)
   MACRO StrFormatByteSize64 = StrFormatByteSizeW
#ELSE
   MACRO StrFormatByteSize64 = StrFormatByteSize64A
#ENDIF


Paul Elliott

Thank YOU very much.   I can't begin to realize how much time & effort you have put into
creating these files.

But my original problem still exists.  Any clues as to what I'm doing wrong?
No real rush as I can work around it. I'm going to have to take a few hours off and
let my eyes rest from squinting at all those lines ( forgot to check if there was a way
to increase the font size in the program I was using .. there was but it wasn't on the main
menu bar ).


Paul Elliott

José,

Any progress? Or even a hint at what I'm doing wrong?

I don't want to keep you from doing other work.

My temporary solution is to put the buttons on the main form but I don't like the look.
They look much better on the tab page.
Found out I don't even have to push the tab button. Just tabbing between controls and
landing on the button will max out my cpu.

Once again  THANKS!


Paul Elliott

José,

Any hint of the problem yet?

I do not mean to rush you as I know you've been hard at work getting your headers
compatible with the PB headers. And putting together sample programs to test
everything and doing it all by yourself. Maybe I shouldn't bother you and just
wait until you get it done.

But I would have thought you would want to clear up any little problems before
putting out a new set of headers. And it might make a nice diversion from all the
other work you've got going on. Sort of give you something easy to do.

I'll shut up now and let you go back to what you were doing.

Have you stopped for a meal lately?


José Roca

Sorry, but not. I have tried everything and always works except when there is a button outisde the tab pages. In this case, it enters in an endless loop sending WM_SETCURSOR messages. I have asked for help to Dominic, that knows much more than I about Windows common controls, but I guess he is even more busy than I with Phoenix 3.

José Roca

#14
Dominic has given me a detailed explanation of the problem and two soloutions. The quickest one is to add in the AdTab method of CWindow.inc the following line


            dwExStyle =  dwExStyle OR %WS_EX_CONTROLPARENT


after the line


      IF BITS(LONG, dwExStyle) = -1 THEN dwExStyle = 0


Therefore, the AddTab method will become:


   ' =====================================================================================
   ' Adds a tab control to the window.
   ' =====================================================================================
#IF %DEF(%UNICODE)
   METHOD AddTab (BYVAL hParent AS DWORD, BYVAL cID AS LONG, BYVAL strTitle AS WSTRING, _
      BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
      OPTIONAL BYVAL dwStyle AS DWORD, BYVAL dwExStyle AS DWORD, BYVAL pWndProc AS DWORD, BYVAL bNoScale AS LONG) AS DWORD
#ELSE
   METHOD AddTab (BYVAL hParent AS DWORD, BYVAL cID AS LONG, BYVAL strTitle AS STRING, _
      BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
      OPTIONAL BYVAL dwStyle AS DWORD, BYVAL dwExStyle AS DWORD, BYVAL pWndProc AS DWORD, BYVAL bNoScale AS LONG) AS DWORD
#ENDIF
      LOCAL hCtl AS DWORD
      IF dwStyle = 0 OR BITS(LONG, dwStyle) = -1 THEN dwStyle = %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %TCS_TABS OR %TCS_SINGLELINE OR %TCS_RAGGEDRIGHT
      IF BITS(LONG, dwExStyle) = -1 THEN dwExStyle = 0
      dwExStyle =  dwExStyle OR %WS_EX_CONTROLPARENT
      ' // Make sure that the control has the WS_CHILD style
      dwStyle = dwStyle OR %WS_CHILD
      hCtl = ME.AddControl ("SysTabControl32", hParent, cID, strTitle, x, y, nWidth, nHeight, dwStyle, dwExStyle, %NULL, pWndProc, bNoScale)
      IF hCtl = %NULL THEN EXIT METHOD
      SendMessage hCtl, %WM_SETFONT, m_hFont, %TRUE
      METHOD = hCtl
   END METHOD
   ' =====================================================================================