Author Topic: Some cases with %  (Read 986 times)

0 Members and 1 Guest are viewing this topic.

Arnold

  • Hero Member
  • *****
  • Posts: 741
Some cases with %
« on: September 26, 2018, 02:36:37 AM »
Hi Charles,

maybe you are interested in these little problems - in fact these are not really problems, it is complaining at the highest level. Yet I thought I should SendMessage a WM_NOTIFY to you.

Exploring the WinApi2004.inc of WinApiVB6.zip which you provide in the Reference section, some code snippets in previous postings and the experiments of Chris demonstrate that OxygenBasic is very liberal and flexibel with different syntax of Basic dialects. Therefore I tried this with a small example creating a TabControl with two Tabpages, one with a DatePicker and one with a MonthCalender. They work in 32-bit and 64-bit.

There are three cases which I would like to point out:

1) in line 231 I have to use ID_Datetime, %ID_Datetime does not work
2) in line 250 I have to use ID_Monthcalendar, %ID_Monthcalendar does not work
3) the case construction in lines 109-122 results to a macro error, I used lines 125-138 instead.

As already mentioned, these are really issues of minor interest (I am not used to this kind of coding anyway), but maybe you wish to check them.

Roland 

Edit: There was a small typo in line 116, 119: must be g_hTab

Code: [Select]
' DatePick and MonthCalendar in TabPages

$ filename = "Dates.exe"
'uses rtl32
'uses rtl64

'uses console
uses winutil

' additional items
% COLOR_MENU=4
% DTN_DATETIMECHANGE= -759
% DTS_SHOWNONE=2
% DTS_LONGDATEFORMAT=4
% MCN_SELECT= -746
% MCN_SELCHANGE= -749
% TCIF_TEXT=1
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE=  dword -551      'Win64
% TCN_SELCHANGING=  dword -552    'Win64
% TCN_FIRST= dword -550           'Win64
% TCN_LAST= dword -580            'Win64
% TCS_TABS=0
% TCS_SINGLELINE=0
% TCS_FOCUSONBUTTONDOWN=4096

type TCITEM
  int   mask,dwState,dwStateMask
  char* pszText
  int   cchTextMax,iImage
  sys   lParam
end type
typedef TCITEM TC_ITEM

def varptr @ %1
def codeptr @ %1

' Identifiers
%IDTAB_MAIN       = 100
%IDTAB_PAGE_1     = 101
%IDTAB_PAGE_2     = 102
%ID_Exit          = 103

%ID_Datetime      = 1000
%ID_Monthcalendar = 1001


DECLARE FUNCTION CreateMainTabControl(BYVAL hWnd AS LONG) AS LONG
DECLARE SUB CreateTabPage1(BYVAL hTab AS LONG)
DECLARE SUB CreateTabPage2(BYVAL hTab AS LONG)
DECLARE FUNCTION OnEventTabPage1(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION OnEventTabPage2(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG


INITCOMMONCONTROLSEXt icce
'Load the common controls library...
icce.dwSize = sizeof(INITCOMMONCONTROLSEXt)
icce.dwICC = 0xffff
InitCommonControlsEx(&icce)

char* cmdline
@cmdline=GetCommandLine()
sys hInstance = GetModuleHandle(null)

indexbase 0
sys g_hTab[1]  '2 TabPages

MainWindow  384,314, WS_OVERLAPPEDWINDOW

FUNCTION WndProc(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG callback

    LOCAL PageNo AS LONG, hButton AS LONG
    NMHDR *ptnmhdr
    WNDCLASSEX wcx

    SELECT CASE (wMsg)

        CASE %WM_CREATE
           'Register the Tab page holder windows...
           string szClassName  = "TabPageChild"
           wcx.cbSize        = sizeof(WNDCLASSEX)
           wcx.lpfnWndProc   = @TabPageProc
           wcx.hInstance     = hInstance
           wcx.hbrBackground = COLOR_MENU +1
           wcx.lpszClassName = strptr szClassName
           if RegisterClassEx(&wcx) = 0 then mbox "Cannot register TabPage Window"

           hButton = CreateWindowEx(0, "BUTTON", "Exit",%WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR 
                                                        %WS_VISIBLE OR %BS_PUSHBUTTON,
                                    111,240,80,30,
                                    hWnd, %ID_Exit, hInst, BYVAL %NULL)

           CALL CreateMainTabControl(hWnd)           
           CALL SetFocus(GetDlgItem(hWnd,%ID_Exit))

        CASE %WM_COMMAND
            SELECT CASE LOWORD(wParam)
                CASE %ID_Exit
                    IF HIWORD(wParam) = %BN_CLICKED THEN
                        CALL SendMessage(hWnd,%WM_CLOSE,0,0)
                    END IF
            END SELECT

        CASE %WM_NOTIFY
            @ptnmhdr = lParam
/*
'This does not work
            SELECT CASE ptnmhdr.code
              CASE %TCN_LAST TO %TCN_FIRST
                SELECT CASE ptnmhdr.idFrom
                  CASE %IDTAB_MAIN
                    SELECT CASE ptnmhdr.code
                      CASE %TCN_SELCHANGING
                        PageNo =SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_HIDE)
                      CASE %TCN_SELCHANGE
                        PageNo = SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_SHOW)
                    END SELECT
                END SELECT
            END SELECT
*/
'This does work
            if ptnmhdr.code >= %TCN_LAST and ptnmhdr.code <= %TCN_FIRST then
                SELECT CASE ptnmhdr.idFrom
                  CASE %IDTAB_MAIN
                    if ptnmhdr.code = TCN_SELCHANGING then
'printl "TCN_SELCHANGING"                   
                        PageNo =SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_HIDE)
                    elseif ptnmhdr.code = TCN_SELCHANGE then
'printl "TCN_SELCHANGE"                   
                        PageNo = SendMessage(GetDlgItem(hWnd,%IDTAB_MAIN),%TCM_GETCURSEL,0,0)
                        CALL ShowWindow(g_hTab(PageNo),%SW_SHOW)
                    end if
                END SELECT
            end if

        CASE %WM_CLOSE
            CALL SendMessage(hWnd,%WM_DESTROY,0,0)

        CASE %WM_DESTROY
            CALL PostQuitMessage(0)

    END SELECT
        FUNCTION = DefWindowProc(hWnd,wMsg,wParam,lParam)
END FUNCTION

'------------------------------------------------------------------------------
FUNCTION CreateMainTabControl(BYVAL hWnd AS LONG) AS LONG

    LOCAL hMainTab AS LONG,i AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,ttc_item AS TC_ITEM
    LOCAL szItem AS ASCIIZ*255

    Style = %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
            %TCS_TABS OR %TCS_SINGLELINE OR %TCS_FOCUSONBUTTONDOWN
    StyleEx = 0

    'Create tab control
    hMainTab = CreateWindowEx(StyleEx,"SysTabControl32","",Style, _
                              6,6,368,235,
                              hWnd,%IDTAB_MAIN,hInst,BYVAL %NULL)
    if hMainTab=0 then mbox "Cannot CreateWindowEx hMainTab"

    'Insert tabs
    DIM sText(1) AS STRING
    sText(0) = "Date1"
    sText(1) = "Date2"

    FOR i = 0 TO 1
        szItem              = sText(i)
        ttc_item.mask       = %TCIF_TEXT
        ttc_item.pszText    = VARPTR(szItem)
        ttc_item.cchTextMax = LEN(szItem)
        ttc_item.iImage     = -1
        ttc_item.lParam     = 0
        SendMessage hMainTab,%TCM_INSERTITEM,i,VARPTR(ttc_item)
    NEXT

    'Create the individual Tab Pages
    Style   = %WS_CHILD
    StyleEx = %WS_EX_CONTROLPARENT

    FOR i = 0 TO 1
        g_hTab(i) = CreateWindowEx(StyleEx,"TabPageChild","",Style, _
                                   20,44,348,192,
                                   hWnd,%IDTAB_PAGE_1+i,hInst,BYVAL %NULL)
    NEXT

    'Show Tab 1 as the default page
    ShowWindow g_hTab(0), %SW_SHOW

    FUNCTION = hMainTab
END FUNCTION

'------------------------------------------------------------------------------
FUNCTION TabPageProc(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG callback
 
    LOCAL TabPageID AS INTEGER
    TabPageID = GetDlgCtrlID(hWnd)

    SELECT CASE (wMsg)

        CASE %WM_CREATE
            SELECT CASE (TabPageID)
                CASE %IDTAB_PAGE_1  : CALL CreateTabPage1(hWnd)
                CASE %IDTAB_PAGE_2  : CALL CreateTabPage2(hWnd)
            END SELECT
        CASE %WM_COMMAND, %WM_NOTIFY, %WM_HSCROLL, %WM_VSCROLL
            SELECT CASE (TabPageID)
                CASE %IDTAB_PAGE_1  : CALL OnEventTabPage1(hWnd,wMsg,wParam,lParam)
                CASE %IDTAB_PAGE_2  : CALL OnEventTabPage2(hWnd,wMsg,wParam,lParam)
            END SELECT

    END SELECT

    FUNCTION = DefWindowProc(hWnd,wMsg,wParam,lParam)
END FUNCTION

'------------------------------------------------------------------------------
FUNCTION OnEventTabPage1(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG

    NMHDR ptnmhdr at lParam

    SELECT CASE (wMsg)

        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE ID_Datetime        'Date/Time:   %ID_Datetime  does not work
                    SELECT CASE ptnmhdr.code
                        CASE %DTN_DATETIMECHANGE
'printl "DTN_DATETIMECHANGE"                       
                    END SELECT
            END SELECT

    END SELECT
END FUNCTION

'------------------------------------------------------------------------------
FUNCTION OnEventTabPage2(BYVAL hWnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,BYVAL lParam AS LONG) AS LONG

    NMHDR ptnmhdr at lParam

    SELECT CASE (wMsg)

        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE  ID_Monthcalendar     'Month/Calendar:      %ID_Monthcalendar does not work   
                    SELECT CASE ptnmhdr.code
                        CASE %MCN_SELECT
'printl "MCN_SELECT"                       
                        CASE %MCN_SELCHANGE
'printl "MCN_SELCHANGE"
                    END SELECT
            END SELECT

    END SELECT
END FUNCTION

'------------------------------------------------------------------------------
SUB CreateTabPage1(BYVAL hTab AS LONG)

    LOCAL hCtl AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,lflags AS DWORD
    LOCAL sText AS STRING

    '---
    Style   = %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR _
              %WS_VISIBLE OR %DTS_LONGDATEFORMAT OR %DTS_SHOWNONE
    StyleEx = %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

    hCtl = CreateWindowEx(StyleEx, "SysDateTimePick32", "DateTime",Style, _
                          40,48,200,26, _
                          hTab, %ID_Datetime, hInst, BYVAL %NULL)

END SUB

'------------------------------------------------------------------------------
SUB CreateTabPage2(BYVAL hTab AS LONG)

    LOCAL hCtl AS LONG
    LOCAL Style AS DWORD,StyleEx AS DWORD,lflags AS DWORD
    LOCAL sText AS STRING

    Style   = %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_TABSTOP OR %WS_VISIBLE
    StyleEx = %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

    hCtl = CreateWindowEx(StyleEx, "SysMonthCal32", "MonthCalender",Style, _
                          48,8,232,184, _
                          hTab, %ID_Monthcalendar, hInst, BYVAL %NULL)

END SUB
« Last Edit: September 26, 2018, 05:59:45 AM by Arnold »

Charles Pegge

  • Admin Support Member
  • *****
  • Posts: 3946
    • Oxygen Basic
Re: Some cases with %
« Reply #1 on: September 27, 2018, 11:39:41 PM »
Thanks, Roland.

With the new o2, the dword qualifier is not needed but there is still a problem with case range evaluation, in the non-working section. This is a very good example to work on.

Arnold

  • Hero Member
  • *****
  • Posts: 741
Re: Some cases with %
« Reply #2 on: October 30, 2018, 01:32:06 AM »
Hi Charles,

I noticed that if I use a colon then the first two error messages will disappear:
...
        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE %ID_Datetime:        'Date/Time:   %ID_Datetime  does not work
                    SELECT CASE ptnmhdr.code
...
        CASE %WM_NOTIFY
            SELECT CASE ptnmhdr.idFrom
                CASE  %ID_Monthcalendar:     'Month/Calendar:      %ID_Monthcalendar does not work   
                    SELECT CASE ptnmhdr.code
...

So the problem here is that the comments are not recognized without a colon in these cases. Perhaps you have already fixed that with the next release.

Roland

Charles Pegge

  • Admin Support Member
  • *****
  • Posts: 3946
    • Oxygen Basic
Re: Some cases with %
« Reply #3 on: October 30, 2018, 03:18:08 AM »
Thanks, Roland.

I have now tightened case parsing. Single quote-marks are supported for C-style cases, so o2 has to decide whether they are comments or not.

case 'a'