Jose's Read Only Forum 2023

IT-Consultant: Charles Pegge => OxygenBasic => Topic started by: Pierre Bellisle on December 30, 2022, 08:01:06 AM

Title: TabControl 32/64
Post by: Pierre Bellisle on December 30, 2022, 08:01:06 AM
Hi Charles!

Here is something unexpected.

When compiling ...\Oxygen\o2\demos\WinDynDialogs\TabControl.o2bas as is in 32 bit, the exe works fine.

Compiling in 64 bit, I got a sure GPF that occur after EndDialog(hDlg, 0).
If I REMout this line ts.lParam= Createmodelessdialog(hdlg,@Tab2Proc,0) then I got no more GPF.
Tested under Windows 7, not yet under Windows 10.

Have any idea of what's going under the hood?

Regards,
Pierre
Title: Re: TabControl 32/64
Post by: Roland Stowasser on December 30, 2022, 09:38:17 AM
Hi Pierre,

I believe, I have no problems with Windows 10. The program shows up in the task manager, and when I exit it (either System X, or menu: Close, or Alt-F4), the program disappears from the task manager. And I can also change the tabs and fill the edits and checkbox without memory leaks. However, I compile the program with only the filename as an argument, like so:

...
'modified from a fsw example in the FBEdit samples

$ filename "TabControl.exe"
'uses rtl32
uses rtl64
...

I do not remember that there were problems under Windows 7, but maybe I forgot something. There are several EndDialog statements. Does GPF occur in all cases?

Roland 

Title: Re: TabControl 32/64
Post by: Pierre Bellisle on December 31, 2022, 03:56:03 AM
Thank Roland,
I will test this under Windows 10.

Here, under Windows 7, after a reboot, 64bit version still GPF...
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on December 31, 2022, 04:33:18 AM
Ok,

Test result:
First Windows 7, GPF every time
Second Windows 7, no GPF
Third Windows 7, no GPF
Windows 8, GPF every time
Windows 10, no GPF

I will investigate more, the machines that GPF are in good shape, so, it will be welcome if anayone feel like testing...

Regards,
Pierre

Title: Re: TabControl 32/64
Post by: Zlatko Vid on December 31, 2022, 07:08:19 AM
Piere
you should look into my awinh037.inc include file
there is how i made tab control
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on December 31, 2022, 10:23:57 AM
Many thanks Zlatko!
I will read your awinh037.inc include.

Also, I must say that I'm interested to find why it GPF?
Problem seems to be in Oxygen\o2\inc\Dialogs.inc / CreateModelessDialog() and sub Dialog().
Probably an invalid freememory() call caused by calling CreateModelessDialog twice.
I got to stop for now but I will look at it later...


Title: Re: TabControl 32/64
Post by: Zlatko Vid on December 31, 2022, 09:55:01 PM
well i don't use Dialogs then Windows
here is part:
'=====================================================================================
Function SetTabControl (byval _tbhwnd as INT,byval _tx as INT,byval _ty as INT,byval _tw as INT,byval _th as INT,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
  If _tbflag=0
    _tbflag=WS_CHILD | WS_VISIBLE| TCS_HOTTRACK
  End If
 
  hTabControl = CreateWindowEx(_ex,"SysTabControl32","",_tbflag,_tx,_ty,_tw,_th,_tbhwnd,cID,0,0)
_hfont = GetStockObject(17)
SendMessage hTabControl,WM_SETFONT,_hfont,0
  UpdateWindow _tbhwnd
Function = hTabControl
End Function
'=====================================================================================
'AddTab
Function AddTab (byval hwnd as INT ,byval tbpos as INT,byval tbtext as String ) as INT
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tbtext)
tie.cchTextMax=Len(tbtext)
tie.iImage = -1
SendMessage(hWnd,0x1307,tbpos,&tie)

End Function
'=====================================================================================
Function SetTabText (cntID as INT,tbIndex as INT,tabText as String)
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tabText)
tie.cchTextMax=Len(tabtext)
tie.iImage = -1
SendMessage(cntID,TCM_SETITEM,tbIndex,&tie)
Return
End Function

'=====================================================================================
SUB SetSelectedTab (cntID as INT,index as INT)
Sendmessage (cntID,TCM_SETCURSEL,index,0)

'Return tbIndex
End Sub
'=====================================================================================

Function GetSelectedTab (cntID as INT) as INT
INT tbIndex
tbIndex = Sendmessage (cntID,TCM_GETCURSEL,0,0)

Return tbIndex
End Function

'=====================================================================================
Function GetTabText (cntID as INT,tbIndex as INT) as string
string tabText=Space(256)
TC_ITEM tie
tie.mask=1
tie.pszText = strptr tabText
tie.cchTextMax = 256
tie.iImage = -1
Sendmessage (cntID,TCM_GETITEM,tbIndex,&tie)
Return tabText
End Function
'=====================================================================================
Function GetTabCount (cntID as INT) as INT
INT tbCount
tbCount = Sendmessage (cntID,TCM_GETITEMCOUNT,0,0)
Return tbCount
End Function
'=====================================================================================
Function DeleteTab (cntID as INT, index as INT ) as INT
Sendmessage (cntID,TCM_DELETEITEM,index,0)
Return 0
End Function


so check this with RTL64.inc
Title: Re: TabControl 32/64
Post by: Zlatko Vid on December 31, 2022, 10:06:40 PM
and why you insist on Dialogs...hmmm there is no any advantage over Window class
here is example by Charles i guess and work well so you can compare both

includepath "$/inc/"
include "minwin.inc"

'% HWND_TOP       0
'% HWND_BOTTOM    1
'% SWP_NOSIZE     1
'% SWP_NOMOVE     2
'% SWP_SHOWWINDOW 0x40

% TCIF_TEXT       1
% TCN_SELCHANGE   -551
% TCN_SELCHANGING -552
% TCM_INSERTITEM  0x1307
% TCM_GETCURSEL   0x130B
% TCM_SETCURSEL   0x130C

% COLOR_WINDOW    5

type NMHDR
  sys hwndFrom,idFrom
  int code
end type

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

sys hWndMain,hWndTab,hwnd0,hwnd01,hwnd1,hwnd2,hwnd3,hinst

Declare Sub InitCommonControls lib "comctl32.dll" ()


function MakeWindow(sys num)
============================
hwnd0=CreateWindowEx(0,"edit", "text "+num+1, WS_CHILD|WS_VISIBLE|WS_CLIPSIBLINGS,
                     0,28,300, 300,
                     hwndTab, NULL, hinst, NULL)
end function


function WndProc(HWND hwnd, UINT ms, wParam, lParam) as sys callback
====================================================================
static int iPage=-1
select ms
case WM_CLOSE   : DestroyWindow(hwnd)
case WM_DESTROY : PostQuitMessage(0)
case WM_NOTIFY  :
  NMHDR hdr at lparam
  select hdr.code
  case TCN_SELCHANGING
    'leaving tab
  case -2
    'selected tab
    int i = SendMessage(hwndtab,TCM_GETCURSEL,0,0)
    if i <> iPage
      iPage=i
      DestroyWindow hwnd0
      MakeWindow(iPage)
    end if
  end select
case else : return DefWindowProc(hwnd, ms, wParam, lParam)
end select
end function


function WinMain(sys hInstance, hPrevInstance, char*lpCmdLine, int nCmdShow) as sys
===================================================================================
WNDCLASSEX wc
sys        hwnd
MSG        ms

hinst=hInstance

wc.cbSize        = sizeof(WNDCLASSEX)
wc.style         = 0
wc.lpfnWndProc   = @WndProc
wc.cbClsExtra    = 0
wc.cbWndExtra    = 0
wc.hInstance     = hInstance
wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION)
wc.hCursor       = LoadCursor(NULL, IDC_ARROW)
wc.hbrBackground = COLOR_WINDOW+1
wc.lpszMenuName  = NULL
wc.lpszClassName = strptr "myWindowClass"
wc.hIconSm       = LoadIcon(NULL, IDI_APPLICATION)

rg=RegisterClassEx(&wc)


hwndMain = CreateWindowEx(WS_EX_CLIENTEDGE,"myWindowClass","The title of my window",
                          WS_OVERLAPPEDWINDOW,
                          CW_USEDEFAULT, CW_USEDEFAULT, 350, 300,
                          NULL, NULL, hInstance, NULL)
ShowWindow(hwndMain, nCmdShow)
UpdateWindow(hwndMain)
InitCommonControls()
hwndTab=CreateWindowEx(0,"SysTabControl32", "",
                       WS_CHILD|WS_CLIPSIBLINGS|WS_VISIBLE,
                       0, 0, 300, 250,
                       hwndMain, NULL, hInstance, NULL)
TCITEM tie
tie.mask = TCIF_TEXT
tie.pszText = "Hi1"
SendMessage hwndTab,TCM_INSERTITEM,0,@tie
tie.mask = TCIF_TEXT
tie.pszText = "Hi2"
SendMessage hwndTab,TCM_INSERTITEM,1,@tie
tie.mask = TCIF_TEXT
tie.pszText = "Hi3"
SendMessage hwndTab,TCM_INSERTITEM,2,@tie
tie.mask = TCIF_TEXT
tie.pszText = "Hi4"
SendMessage hwndTab,TCM_INSERTITEM,3,@tie

SendMessage hwndTab,TCM_SETCURSEL,3,0
'print SendMessage hwndTab,TCM_GETCURSEL,0,0

ShowWindow(hwndTab, SW_SHOW)
UpdateWindow(hwndTab)

while(GetMessage(&ms, NULL, 0, 0) > 0)
  TranslateMessage(&ms)
  DispatchMessage(&ms)
wend
return ms.wParam
end function


char *cmdline
sys inst
&cmdline=GetCommandLine
inst=GetModuleHandle 0
'call Main function ..heh oK?
WinMain (inst,0,cmdline,SW_NORMAL)
end
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on December 31, 2022, 11:06:45 PM
I do not insist on using Dialog, I use both, as you ca see in those two Splitter Window (http://www.jose.it-berater.org/smfforum/index.php?topic=5788.0) examples or in this FreeBASIC TrackBar (https://www.freebasic.net/forum/viewtopic.php?t=32000&sid=e1151f2b35612b1dd44f2af72ff379a5) example.
By trying to find out why there is a GPF, I read O2 code and I learn.
Plus, I am sometime curious...


Found it !
Oxygen\o2\inc\Dialogs.inc -> function CreateModalDialog() -> freememory lpdt
was called more than once with the same memory address so the GPF.
I added a flag variable to remember so that freememory won't append more than once...
Title: Re: TabControl 32/64
Post by: Roland Stowasser on January 01, 2023, 12:03:55 PM
Hi Pierre,

unfortunately I don't have access to Windows 7 at the moment, my friends have all switched to a higher operating system. While I don't understand why this error is not noticeable in Win 10, your objection is logical. Did you modify Dialogs.inc?
There are freememory statements in function CreateModalDialog, function CreateModelessDialog, sub Dialog. I used a variable g_lpdtptr in sub Dialog, and I thought it would cover all cases but that doesn't seem to be the case.
It's been a while since I dealt with Dialogs.inc - Charles helped me to make it work in 64-bit as well. But I'm just a hobbyist, and improvements in Dialogs.inc are certainly needed. It is mostly derived from Freebasic, the link of dialogs.bas is given in the include file, and I noticed that you participated in the discussion too. So maybe you may find other vulnerabilities?

Roland

Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 04:05:59 PM
QuoteI don't have access to Windows 7 at the moment, my friends have all switched to a higher operating system

what a heck your friends OS have with OS you use on your computer
come on Roland ...what kind of excuse is this ?

I am using win7_64bit ...but i compile my apps as 32bit --so i don't use RTL64.inc

Piere
I am not sure which example you use ,because you said ..something is wrong
with include file ?
so i can only guess which one is ??? 
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 04:10:07 PM
second

i found example TabControl under demos\WinDynDialogs\tabcontrol.o2bas

so do you try to compile it as JIT or as standalone using RTL-s ?


1.test 1...compiled as JIT and this example work well
i am not sure what mean GPF ?

2. test 2 ...but when i uncomment and use rtl64.inc and compile ,i receive okay! ..that is fine
but when i try to run then i get nothing ...
i also try to run executable from folder ..again same case ..not respond
i look into task manager ...nothing is hangin in memory
so yes something is wrong

3 ...and yes when is compiled with rtl32 then program work properly
so i am not sure what might be wrong with dialogs.inc
i can't find your variable 

4...ahh ok i found it
but one thing i don't understand that
lpdt is optional  parameter
then is free by
freememory lpdt
in both functions

i don't see such a things in C based examples with Dialogs
in genaral i find it over- complicated for nothing
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 05:19:57 PM
well...
no mather what i do add or remove this program compile but not run
using RTL64.inc on my win7_64bit
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 05:23:14 PM
Quotewas called more than once with the same memory address so the GPF.
I added a flag variable to remember so that freememory won't append more than once...

but how you do that ?
what flag?
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 05:36:42 PM
In my include i am using this :

TYPE TC_ITEM
mask as int
res1 as int
res2 as int
pszText as INT
cchTextMax as int
iImage as int
lParam as int
End TYPE

and in Dialog TabControl example  is used :

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

so my question is why is different ?
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on January 01, 2023, 07:06:28 PM
Hi Roland, Zlatko.
Here is a summary of the story:

GPF compiling ...\Oxygen\o2\demos\WinDynDialogs\TabControl.o2bas in 64 bit.
GPF may not be seen with different system configuration or OS version.

Observation of Oxygen\o2\inc\Dialogs.inc, function CreateModalDialog(),
For what I understand, the lpdt memory space was used more than once wich is good practice,
the issue is that freememory lpdt was also called more than once
with the same memory address so the GPF.
I added a flag variable to remember that the memory was already freed...

Here is the modification I made, please double check if you feel like it...
In Dialogs.inc,
After:      sys g_lpdtptr       'pointer to initial DLGTEMPLATE struc
I added:  sys ValidMemPointer '2022-12-31

In CreateModalDialog(),
I replaced: freememory lpdt
with:         if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

In CreateModelessDialog(),
I replaced: freememory lpdt
with:         if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

In the Dialog() sub,
After:     if g_lpdtptr then freememory g_lpdtptr 
I added: ValidMemPointer = false '2022-12-31 (Just for clarity)
After:     g_lpdtptr=getmemory 20480 '1024*20
I added: ValidMemPointer = g_lpdtptr '2022-12-31

Thank you Roland for the sharing of your work, it is really appreciated!

Regard
Title: Re: TabControl 32/64
Post by: Roland Stowasser on January 01, 2023, 08:50:31 PM
Thanks Pierre for the solution. I believe this is necessary for Win 10 as well. Maybe Charles will exchange the modified Dialogs.inc:


'library functions for creating dialogs at runtime in memory
'coded according to Win32 Help file
'
'based on
'dialogs.bas in:
'https://www.freebasic.net/forum/viewtopic.php?t=5667

'dialogs.inc in:
'MASM32 SDK

'2022-12-31: Pierre Bellisle added variable ValidMemPointer to avoid GPF

uses corewin
uses generics
#ifdef review
  uses console
#endif

'some classes for using InitCommonControlsEx
% WC_HEADER="SysHeader32"
% TOOLBARCLASSNAME="ToolbarWindow32"
% STATUSCLASSNAME="msctls_statusbar32"
% TRACKBAR_CLASS="msctls_trackbar32"
% UPDOWN_CLASS="msctls_updown32"
% PROGRESS_CLASS="msctls_progress32"
% WC_LISTVIEW="SysListView32"
% WC_TREEVIEW="SysTreeView32"
% WC_TABCONTROL="SysTabControl32"
% ANIMATE_CLASS="SysAnimate32"
% RICHEDIT_CLASS10A="RICHEDIT"
% RICHEDIT_CLASS="RichEdit20A"
% MSFTEDIT_CLASS="RichEdit50W"
% MONTHCAL_CLASS="SysMonthCal32"
% DATETIMEPICK_CLASS="SysDateTimePick32"
% WC_IPADDRESS="SysIPAddress32"
% HOTKEY_CLASS="msctls_hotkey32"
% REBARCLASSNAME="ReBarWindow32"
% WC_PAGESCROLLER="SysPager"
% WC_NATIVEFONTCTL="NativeFontCtl"
% WC_COMMCTRL_DRAGLISTMSG="commctrl_DragListMsg"
% WC_COMBOBOXEX="ComboBoxEx32"
% TOOLTIPS_CLASS="tooltips_class32"
'==============================================================================

'Items needed to run dialogs.inc
% DS_SETFONT=0x40
% SS_LEFT=0
% SS_CENTER=1
% SS_RIGHT=2
% SS_ICON=3
% SS_BITMAP=0x0E
% SS_NOTIFY=0x0100
% CBS_SIMPLE=1
% CBS_DROPDOWN=2
% CBS_DROPDOWNLIST=3
% CBS_SORT=0x0100
% CBS_HASSTRINGS=0x0200
% ES_SAVESEL=0x8000

'some often used constants
% DS_CENTER=0x0800
% LR_LOADFROMFILE=0x0010
% IMAGE_BITMAP=0
% IMAGE_ICON=1
% ICON_SMALL=0
% ICON_BIG=1
% WM_SETICON=0x80
% STM_SETIMAGE=0x172
% SWP_NOMOVE=2
% SWP_NOREDRAW=8
% COLOR_WINDOW=5
% SM_CXBORDER=5
% SM_CYBORDER=6
% SWP_NOZORDER=4
% HWND_TOPMOST= -1
% HORZRES=8
% VERTRES=10
% ODS_SELECTED=1
% WM_DRAWITEM=0x2B
% SRCCOPY=0xCC0020
% SB_SETTEXT=0x401
% SB_SETPARTS=0x404


'MultiByteToWideChar
% CP_ACP=0
% MB_PRECOMPOSED=1

'WinApi types
packed type DLGTEMPLATE 'template for dialog box
   dword style
   dword dwExtendedStyle
   word  cdit  'number of items
   short x     'in dialog box units
   short y
   short cx    'width
   short cy    'height
end type
'immediately followed by some data

packed type DLGITEMTEMPLATE 'template for a control in a dialog box
   dword style
   dword dwExtendedStyle
   short x     'in dialog box units
   short y
   short cx    'width
   short cy    'height
   word  id    'control identifier
end type
'immediately followed by some data

'needed for menus
% GRAYED=MF_GRAYED
% CHECKED=MF_CHECKED
% OWNERDRAW=MF_OWNERDRAW
string tab=chr(9)

'needed for accelerators
% FVIRTKEY=1 'TRUE
% FNOINVERT=0x02
% FSHIFT=0x04
% FCONTROL=0x08
% FALT=0x10

type ACCEL
   byte fVirt
   word key
   word cmd
end type

 
'====================================================================

sys g_memptr        'points to an address in memory
int g_dialog_width  'for centering  a control in a dialog.
int g_Ccount        'controls actually created

sys g_lpdtptr       'pointer to initial DLGTEMPLATE struc
sys ValidMemPointer '2022-12-31

'====================================================================

'macros
macro align_2(v) {v+=1 : v = v and -2}
macro align_4(v) {v+=3 : v = v and -4}

macro make_ustring(text,memptr, count) 
  int count = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED,
                               text,
                               -1,
                               memptr,
                               len(text)+1 )
  memptr += count*2
end macro

macro set_val(i,v) {i=v : g_memptr+=sizeof(i)}

'====================================================================
' Create a modal dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' DialogBoxIndirectParam function does not return until EndDialog.
' rval returns whatever was specified as result of EndDialog.
'
function CreateModalDialog( sys hParent, sys *lpDialogProc, dwInitParam, optional lpdt=g_lpdtptr) as sys
 
  sys rval
  rval = DialogBoxIndirectParam( GetModuleHandle(null),
                                 lpdt,
                                 hParent,
                                 @lpDialogProc,
                                 dwInitParam )
  if rval=-1 then
    mbox "Creating modal Dialog failed. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif   
    ExitProcess(0)
  end if
 
  if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

  return rval
end function

'====================================================================

' Create a modeless dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' CreateDialogIndirectParam function will use DestroyWindow to return
' rval normally returns the handle to the dialog window.
'
' WS_VISIBLE style is required for a modeless dialog to be visible.
'
function CreateModelessDialog( sys hParent, sys *lpDialogProc, lParamInit, optional lpdt=g_lpdtptr) as sys
         
  sys rval

  rval = CreateDialogIndirectParam( GetModuleHandle(null),
                                    lpdt,
                                    hParent,
                                    @lpDialogProc,
                                    lParamInit )
  if rval=0 then
    mbox "Cannot create modeless Dialog. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif   
    ExitProcess(0)
  end if

  if ValidMemPointer = lpdt then freememory lpdt : ValidMemPointer = false '2022-12-31

  return rval
end function

'====================================================================

' Initialize the essential members of the DLGTEMPLATE structure,
' the menu, class, and title arrays, and optionally the font
' point size and typeface array. Returns a pointer to the next
' WORD following the title or typeface array in g_memptr, and a
' pointer to the allocated memory in lpdt.
'
' Parameter cdit must match the number of controls defined.
' If the value is too high then the function that creates the
' dialog will fail. If the value is too low then one or more
' of the controls will not be created.
'
'
sub Dialog( short x,y,cx,cy, string title, dword style,
           optional short pointSize=0, string typeFace="", dword extStyle=0)

  int e = int(title) : if e != 0 or title=0 then mbox "Warning: title in Dialog probably not a string"
#ifdef review
  printl "sub Dialog: try to create Dialog template structure"
#endif

  if g_lpdtptr then freememory g_lpdtptr
  ValidMemPointer = false '2022-12-31 (Just for clarity)
 
  g_lpdtptr=getmemory 20480 '1024*20
  ValidMemPointer = g_lpdtptr '2022-12-31
 
  word cdit at g_lpdtptr+sizeof(dword)*2 'lpdt.cdit
  cdit = 0
       
  g_dialog_width = cx

  DLGTEMPLATE lpdt at g_lpdtptr
  lpdt.style = style
  lpdt.dwExtendedStyle = extStyle
  lpdt.cdit = cdit
  lpdt.x  = x
  lpdt.y  = y
  lpdt.cx = cx
  lpdt.cy = cy
   
  ' Set g_memptr to the menu array that follows the structure.
  g_memptr = g_lpdtptr + sizeof(lpdt)

  word menu_ at g_memptr : set_val(menu_, 0)
  word class_ at g_memptr : set_val(class_, 0)

  'title array and set g_memptr to next WORD following the title array.
  make_ustring( title, g_memptr )

  'if DS_SETFONT then point size and typeface
  if style and DS_SETFONT then
    word pointsize_ at g_memptr : set_val(pointsize_, pointSize)
    make_ustring( typeFace, g_memptr )
  end if
 
  g_Ccount=0
   
end sub

'====================================================================

' General-purpose control definition starting at g_memptr, initializes
' the essential members of a DLGITEMTEMPLATE structure and
' the class, caption and creation data arrays.
'
' For the class array - six predefined system (User32) classes -
' use "BUTTON", "EDIT", "STATIC", "LISTBOX", "SCROLLBAR", and "COMBOBOX".
' For common controls use the class strings defined for comctl32.dll.
'
' Caption array can specify the caption or initial text for the control,
' or the ordinal value of a resource in the executable file.
' Specify a caption or initial text in the caption parameter,
' or an ordinal value in the rid (ResourceID) parameter. If the
' rid parameter is non-zero then the caption parameter is ignored.
'
' There is no support for creation data.
'
' The tab order of the controls in a dialog is determined by the order in which
' the controls are created and which controls have the WS_TABSTOP style.
'
' To center the control in the dialog horizontally specify -1 for the x parameter.
' This feature will not work correctly for an auto-sized control.
'

sub control( string caption, word cid, string _class, dword style=0, short x,y,cx,cy,
             optional extStyle = 0, short rid=0 )

  if x = -1 then x = (g_dialog_width - cx) / 2

  '--------------------------------------------------------------
  'must be dword boundary
  '--------------------------------------------------------------   
  align_4(g_memptr)

  'initialize the essential members of the structure.
  'establish the base style as WS_CHILD or WS_VISIBLE.

  DLGITEMTEMPLATE lpdit at g_memptr
  lpdit.style = WS_CHILD or WS_VISIBLE or style
  lpdit.dwExtendedStyle = extStyle
  lpdit.x  = x
  lpdit.y  = y
  lpdit.cx = cx
  lpdit.cy = cy
  lpdit.id = cid

  'set g_memptr to the class array that follows the structure.
  g_memptr += sizeof(lpdit)

  'initialize the class array and set g_memptr to the next WORD
  make_ustring( _class, g_memptr )

  'initialize the caption array and set g_memptr to the next WORD
  if rid then
    word class_ at g_memptr : set_val(class_, 0xffff)
    word rid_ at g_memptr : set_val(rid_, rid)
  else
    make_ustring( caption, g_memptr )
  end if

  'skip the first element of the creation data, set it to zero (no creation data).
  align_2(g_memptr)
  word create_data at g_memptr : set_val(create_data, 0)

  g_Ccount+=1

#ifdef review
  printl "Controls created: " g_Ccount
#endif

  word cdit at g_lpdtptr+sizeof(dword)*2  'lpdt.cdit
  cdit=g_Ccount   
end sub

'====================================================================
' The following specialized control definition procedures are
' simply wrappers for the general-purpose procedure.
'====================================================================

'PUSHBUTTON, PUSHBOX, DEFPUSHBUTTON, CHECKBOX, AUTOCHECKBOX, AUTO3STATE, STATE3, RADIOBUTTON, AUTORADIOBUTTON, GROUPBOX

sub PushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_PUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub PushBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_PUSHBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DefPushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_DEFPUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub CheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_CHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoCheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Auto3State( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTO3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
                                                                                                       
sub State3( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub RadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoRadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub GroupBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "BUTTON", BS_GROUPBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'EDITTEXT, MultiLineText

sub EditText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "EDIT", ES_LEFT or WS_BORDER or WS_TABSTOP or ES_AUTOHSCROLL or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

sub MultiLineText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "EDIT", ES_LEFT|WS_BORDER|WS_TABSTOP|WS_GROUP|WS_VSCROLL|WS_HSCROLL|ES_MULTILINE|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_WANTRETURN|style,x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

'LTEXT, RTEXT, CTEXT, ICON, Bitmap

sub Ltext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_LEFT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Rtext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_RIGHT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Ctext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_CENTER or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Icon( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_ICON or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Bitmap( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, "STATIC", SS_BITMAP or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'LISTBOX
sub ListBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "LISTBOX", WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SimpleCombo, SortedCombo,  COMBOBOX, DropDownList

sub SimpleCombo( string caption,word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub SortedCombo( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or CBS_SORT or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub ComboBox(string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", CBS_SIMPLE or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DropDownList( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWNLIST or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SCROLLBAR, VScrollBar

sub ScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "SCROLLBAR", SBS_HORZ or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub

sub VScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( "", cid, "SCROLLBAR", SBS_VERT or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub
'====================================================================

' To use a Rich Edit control your app must first call LoadLibrary to load the appropriate DLL
' RICHED32.DLL for version 1.
' RICHED20.DLL for version 2 or 3,
' MSFTEDIT.DLL for version 4.1
'====================================================================

' This procedure is coded for version 1.
sub RichEdit1( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, RICHEDIT_CLASS10A, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 2 or 3.
sub RichEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, RICHEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 4.1.
sub MsftEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
   Control( caption, cid, MSFTEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

sub init_common_controls(optional dword classes=0)

   ' create a structure of INITCOMMONCONTROLSEX
   INITCOMMONCONTROLSEXt iccex
   
   iccex.dwSize=sizeof(iccex)
   'Register Common Controls
   if classes !=0 then
     'set own value
     iccex.dwICC=classes   
   else
     'use default
     iccex.dwICC= 0xffff
/*     
     0x0001 or ' ICC_LISTVIEW_CLASSES   - list view and header control classes. 
     0x0002 or ' ICC_TREEVIEW_CLASSES   - tree view and tooltip control classes.     
     0x0004 or ' ICC_BAR_CLASSES        - toolbar, status bar, trackbar, and tooltip control classes. 
     0x0008 or ' ICC_TAB_CLASSES        - tab and tooltip control classes.     
     0x0010 or ' ICC_UPDOWN_CLASS       - up-down control class.     
     0x0020 or ' ICC_PROGRESS_CLASS     - progress bar control class.     
     0x0040 or ' ICC_HOTKEY_CLASS       - hot key control class.     
     0x0080 or ' ICC_ANIMATE_CLASS      - animate control class.       
     0x00ff or ' ICC_WIN95_CLASSES      - animate control, header, hot key,
                                        ' list view, progress bar, status bar, tab,
                                        ' tooltip, toolbar, trackbar, tree view,
                                        ' and up-down control classes.   
     0x0100 or ' ICC_DATE_CLASSES       - date and time picker control class.     
     0x0200 or ' ICC_USEREX_CLASSES     - ComboBoxEx class. 
     0x0400 or ' ICC_COOL_CLASSES       - rebar control class.     
     0x0800 or ' ICC_INTERNET_CLASSES   - IP address class.   
     0x1000 or ' ICC_PAGESCROLLER_CLASS - pager control class.   
     0x2000 or ' ICC_NATIVEFNTCTL_CLASS - native font control class
     0x4000 or ' ICC_STANDARD_CLASSES   - one of the intrinsic User32 control classes.
                                        ' The user controls include button, edit, static,
                                        ' listbox, combobox, and scroll bar. 
     0x8000    ' ICC_LINK_CLASS         - hyperlink control class. 
*/
   end if

   InitCommonControlsEx(@iccex)
end sub

'==============================================================================

'Menus, PopupMenus
int g_MnuLv[10]   'Main Menu or PopupMenu and 9 levels of SubMenus
int g_Midx        'Menu index


macro MENU(hMenu)
   hMenu=CreateMenu
   g_Midx=1
   g_MnuLv[1]=hMenu
end macro

'Vertical Main Popup Menu
macro PopupMENU(hMenu)
   hMenu=CreatePopupMenu
   g_Midx=1
   g_MnuLv[1]=hMenu
end macro

sub BEGIN(optional int none=0)
end sub

sub POPUP(string item)
  sys hSubM=CreateMenu
  g_Midx+=1 : g_MnuLv[g_Midx]=hSubM
  AppendMenu( g_MnuLv[g_Midx-1], MF_POPUP, g_MnuLv[g_Midx], item ) 
end sub

sub MENUITEM(string item, optional sys id=0, uint uflags=MF_STRING)
   if lcase(item) = "separator" then
     AppendMenu(g_MnuLv[g_Midx], MF_SEPARATOR, 0, 0)
   else
     AppendMenu(g_MnuLv[g_Midx], uflags, id, item )
   end if
end sub

sub ENDMenu(optional int=0)
  g_Midx-=1
end sub

'==============================================================================




Unfortunately some apps in WynDynDialogs folder do not run correctly any more, but work with older versions of OxygenBasic. I do not believe that this is caused by Dialogs.inc and I will check them.

Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 09:08:15 PM
Thanks Piere

But that just another level of complexity
i suspect that something is wrong in RTL64

or

simply this Dialogs.inc is to complex without real reason
I will look into some C examples not FreeBasic
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 09:36:50 PM
OK
so here is Dialog window or form in C
well as you may see nothing too complex...
i really have no clue why is o2 example so overhelmed with weird things??

#include <windows.h>

LRESULT CALLBACK WndProc(HWND, UINT, WPARAM, LPARAM);
LRESULT CALLBACK DialogProc(HWND, UINT, WPARAM, LPARAM);

void CreateDialogBox(HWND);
void RegisterDialogClass(HWND);

HINSTANCE ghInstance;

int WINAPI wWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
    PWSTR pCmdLine, int nCmdShow) {

  MSG  msg;   
  HWND hwnd;

  WNDCLASSW wc = {0};

  wc.lpszClassName = L"Window";
  wc.hInstance     = hInstance;
  wc.hbrBackground = GetSysColorBrush(COLOR_3DFACE);
  wc.lpfnWndProc   = WndProc;
 
  RegisterClassW(&wc);
  hwnd = CreateWindowW(wc.lpszClassName, L"Window",
                WS_OVERLAPPEDWINDOW | WS_VISIBLE,
                100, 100, 250, 150, NULL, NULL, hInstance, NULL); 

  ghInstance = hInstance;

  while( GetMessage(&msg, NULL, 0, 0)) {
    DispatchMessage(&msg);
  }
 
  return (int) msg.wParam;
}

LRESULT CALLBACK WndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) {

  switch(msg) {
 
      case WM_CREATE:
          RegisterDialogClass(hwnd);
          CreateWindowW(L"button", L"Show dialog",   
              WS_VISIBLE | WS_CHILD ,
              20, 50, 95, 25, hwnd, (HMENU) 1, NULL, NULL); 
          break;

      case WM_COMMAND:
          CreateDialogBox(hwnd);
          break;

      case WM_DESTROY:
      {
          PostQuitMessage(0);
          return 0;
      }
  }
  return DefWindowProcW(hwnd, msg, wParam, lParam);
}

LRESULT CALLBACK DialogProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
  switch(msg) {
 
    case WM_CREATE:
        CreateWindowW(L"button", L"Ok",   
          WS_VISIBLE | WS_CHILD ,
          50, 50, 80, 25, hwnd, (HMENU) 1, NULL, NULL); 
    break;

    case WM_COMMAND:
        DestroyWindow(hwnd);
    break;

    case WM_CLOSE:
        DestroyWindow(hwnd);
        break;

  }
 
  return (DefWindowProcW(hwnd, msg, wParam, lParam));
}

void RegisterDialogClass(HWND hwnd) {

  WNDCLASSEXW wc = {0};
  wc.cbSize           = sizeof(WNDCLASSEXW);
  wc.lpfnWndProc      = (WNDPROC) DialogProc;
  wc.hInstance        = ghInstance;
  wc.hbrBackground    = GetSysColorBrush(COLOR_3DFACE);
  wc.lpszClassName    = L"DialogClass";
  RegisterClassExW(&wc);

}

void CreateDialogBox(HWND hwnd) {

  CreateWindowExW(WS_EX_DLGMODALFRAME | WS_EX_TOPMOST,  L"DialogClass", L"Dialog Box",
        WS_VISIBLE | WS_SYSMENU | WS_CAPTION , 100, 100, 200, 150,
        NULL, NULL, ghInstance,  NULL);
}
Title: Re: TabControl 32/64
Post by: Roland Stowasser on January 01, 2023, 10:32:28 PM
Hi Zlatko,

What is the problem? You do not like In Memory Dialogs - they are possible in different programming languages - but you are not forced to use them. In folder WinGui for example Charles provided many demos applying only the WinApi functions which use CreateWindowEx and WndProc. There should be no competitive spirit about this subject.

Your example above creates a window with a button, which opens a dialog box with an OK button. But where is the tabcontrol with the tabs and the different controls? How do you switch the tabs, make for instance changes in the edit fields? I think this is more complex than your simple example.

Roland
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 01, 2023, 10:47:20 PM
And what is your problem?

Is it really that hard to add tab control in this way ?
Here is not problem in Tabcontrol then in a way how is this Dialog created

and who talking about competition?
Title: Re: TabControl 32/64
Post by: Charles Pegge on January 02, 2023, 10:59:54 AM
As a pointer, ValidMemPointer should be declared as sys, not long

I've updated with the amended Dialog.inc.

Also:

10:15 02/01/2023 Fix folder refs from 'ProjectsA to 'demos\!ProjA'
09:41 30/12/2022 Prevent neg column numbers in error report (tran.inc sttw-sttl+1)


https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic050P15.zip
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on January 02, 2023, 11:09:38 AM
Yep!
Mea culpa, I updated my post above...
Title: Re: TabControl 32/64
Post by: Zlatko Vid on January 02, 2023, 06:30:08 PM
OMG

I become sick from this Dialogs ...
back to usual programming with Windows ...
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on January 03, 2023, 10:19:55 AM
Thank for this new version Charles...
The more I look at it, the more I like...
Title: Re: TabControl 32/64
Post by: Pierre Bellisle on January 10, 2023, 10:59:46 PM
Hi Charles,
Talking of GPF, I had another one,

In Oxygen\o2\demos\Unicode\REdit_Unicode\RicheditUnicode.o2bas
wstring lblTxt[4]={"   Ansi","UTF-16","UTF-8","Text","Open file as: "}

I guess lblTxt[4] should be lblTxt[5]

Take care...

Title: Re: TabControl 32/64
Post by: Charles Pegge on January 11, 2023, 12:39:37 AM
Thanks Pierre

It compiles to 64 bit and runs fine with arrays of 5 elements.

array correction:

   sys lbl[5]
   wstring lblTxt[5]={"   Ansi","UTF-16","UTF-8","Text","Open file as: "}
   sys radio[5]
   sys id_radio[5]={101,102,103,104}