Problem with redim in Autosizing

Started by Roland Stowasser, February 03, 2024, 08:50:19 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Charles Pegge

Hi Theo,

If the UDT variables are instantiated in global or static space, there won't be garbage-collection problems. The GC for these variables is only executed at the end of the program.

For dynamic string, we have strings, wstrings, and correspondingly, bstrings and wbstrings

This is the current list of primitives and their internal codings:

void      15 0x10 '* Used by-reference only
sbyte     15 0x01
byte      15 0x21
ubyte     15 0x21
string    15 0xe1
wstring   15 0xe2
bstring   15 0xc1
gstr_     15 0xc1 '* Accept any Bstring width. for core functions only
bstr      15 0xc1
wbstring  15 0xc2
char      15 0xa1
wchar     15 0xa2
cstr_     15 0xa1 '* Accept any char width. for core functions only
pstr_     15 0xb1 '* Accept any char width. for core functions (len returned in ecx)
asciiz    15 0xa1
zstring   15 0xa1
wzstring  15 0xa2
short     15 0x02
long      15 0x04
wide      15 0xa2
int       15 0x04
integer   15 0x04
float     15 0x64
single    15 0x64
double    15 0x68
extended  15 0x6A
quad      15 0x48 ''* using FPU on 32 bit systems (was 08), returns data on edx:eax
word      15 0x22
dword     15 0x24
ulong     15 0x24
uint      15 0x24
usys      15 0x28 '* 64 bit only
qword     15 0x58 '* using  FPU on 32 bit systems
any       15 0x08 '* to be used by reference only
sys       15 0x08 '* 4/8 depending on 32/64 bit system
bool      15 0x04 '* MS
boolean   15 0x01 '* MS
fpu       15 0x40 '* fast call using fpu registers (not exportable)
signed    15 0x04
unsigned  15 0x24
'===========================================

Charles Pegge

I have fixed the redim / autodim problem, and uploaded a temp version to GITHUB. It is simply called OxygenBasic.zip, a work in progress which I will update very frequently. It is the same as my local backups, so it could be updated as frequently as twice a day.

This provides immediate access to new features and bug fixes.

https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic.zip


Roland Stowasser

#17
Hi Charles,
my virus program Defender prevented me from downloading Oxygenbasic.zip for a while, but everything seems to be fine now.
Thanks for restoring redim with types. This means that some workarounds are not necessary.
While checking the code of SmallApp.o2bas I noticed a logical error. I had added a vertical splitter, but I called it horizontal. I renamed the variables, the logic of the program did not change. Maybe you will replace the app?

I designed the splitter like I found in some other programs. When you move the cursor between ListView and EditBox, the shape of the cursor changes. Drag and drop can be applied by pressing and releasing the left mouse button.

I remember that I also wanted to display a horizontal splitter and possibly connect splitters with autosizing. Maybe I can continue with this project again.

PS: deleted the images

SmallApp.o2bas:
$ filename "SmallApp.exe"

'uses rtl32
'uses rtl64

'Get path of Oxygenbasic
string o2dir = "..\..\..\"


'Messageloop in WinUtil
sys hAccel
macro InMessageLoop
   if TranslateAccelerator( hWnd, hAccel, @wm ) = 0 then     
     if not IsDialogMessage(hWnd, &wm) then
         TranslateMessage(&wm)
         DispatchMessage(&wm) 
     end if
   end if
end macro

uses WinUtil
uses dialogs
uses autosizing


% DS_MODALFRAME=0x80
% SS_CENTERIMAGE=0x200
% GCL_HICON= -14
% TBSTYLE_TOOLTIPS=0x100
% TBSTYLE_FLAT=0x800
% TBSTATE_ENABLED=4
% TBSTYLE_BUTTON=0
% TB_BUTTONSTRUCTSIZE=1054
% TB_ADDBITMAP=1043
% TB_ADDBUTTONS=1044
% TB_AUTOSIZE=1057
% LR_LOADTRANSPARENT=32
% SBARS_SIZEGRIP=256
% MF_UNCHECKED=0
% MF_CHECKED=8
% TB_ENABLEBUTTON=1025
% SS_GRAYRECT=5
% WM_SETCURSOR=32
% GCL_HCURSOR= -12
% IDC_SIZEWE=32644

'htmlhelp.h
% HH_DISPLAY_TOPIC=0x0000
% TTN_FIRST -520
% TTN_NEEDTEXT (TTN_FIRST-0)

'htmlhelp.h
type HH_AKLINK
  int   cbStruct
  bool  fReserved
  char* pszKeywords
  char* pszUrl
  char* pszMsgText
  char* pszMsgTitle
  char* pszWindow
  bool  fIndexOnFail
end type
! HtmlHelp lib "hhctrl.ocx" alias "HtmlHelpA" (dword hwndCaller, char* pszFile, dword uCommand, dword dwData) as sys

type TBBUTTON
  int       iBitmap
  int       idCommand
  byte      fsState
  byte      fsStyle
  byte      bReserved[2]
  dword     dwData
  int       iString
end type

type TBADDBITMAP
  sys     hInst
  sys     nID
end type

type NMTTDISPINFO
  NMHDR     hdr
  char*     lpszText
  zstring   szText[80]
  sys       hinst
  uint      uFlags
  sys       lParam
end type
typedef NMTTDISPINFO TOOLTIPTEXT 

================================================================================

'Menu IDs
% IDM_FILEMENU  = 1000
  % IDM_OPEN    = 1001
  % IDM_CLOSE   = 1002
  % IDM_EXIT    = 1003

% IDM_VIEWMENU     = 1010
  % IDM_TOOLBAR    = 1011
  % IDM_STATUSBAR  = 1012

% IDM_HELPMENU     = 1020
  % IDM_HELPTOPICS = 1021
  % IDM_ABOUT      = 1022

'Control Handles
sys hIcon
sys hMenu, hToolBar, hStatusBar, hListbox, hEdit, hButton, hVSplit

' Control IDs
% IDI_ICON      = 100
% ID_TOOLBAR    = 200
% ID_STATUSBAR  = 201
% ID_LISTBOX    = 202
% ID_EDIT       = 203
% ID_BTN        = 204
% ID_VSPLIT     = 205

================================================================================

'Get Icon
   string fullname
   fullname = o2dir + "tools\OxideIcon.ico"
   hIcon = LoadImage( 0, fullname, IMAGE_ICON,0,0, LR_LOADFROMFILE )
   if hIcon=null then mbox "Cannot load " + fullname +"!"
'Bitmps for Toolbar and Menu
   sys hOpenBmp = LoadImage( 0, "Open.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
   if hOpenBmp=null then mbox "Connot load hOpenBmp"
   sys hCloseBmp = LoadImage( 0, "Close.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
   if hCloseBmp=null then mbox "Connot load hCloseBmp"
   sys hAboutBmp = LoadImage( 0, "About.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
   if hAboutBmp=null then mbox "Connot load hAboutBmp"

'Get name of OxygenBasic Help file
   string HelpFile =  o2dir & "inf\oxygen_help.chm"

'Register special common control classes
init_common_controls()

'forward references
#lookahead

MainWindow 600, 420 , WS_OVERLAPPEDWINDOW


function WndProc(sys hwnd, uint MainMsg, sys wParam, lParam) as sys callback
   
    'Check for Splitter
    if MainMsg=WM_MOUSEMOVE or MainMsg=WM_LBUTTONDOWN or MainMsg=WM_LBUTTONUP then
       SplitterEvents(hwnd, MainMsg, wParam, lParam)
    end if
       
    select MainMsg
   
        case WM_CREATE
            'Set Icon for MainWindow
            SetClassLongPtr(hwnd, GCL_HICON, hIcon )
            SetWindowText(hwnd, "A Small App")

            'Create Controls
            addMenu(hwnd)
            addToolbar(hwnd)
            addStatusBar(hwnd)
            addListbox(hwnd)
            addEdit(hwnd)
            addButton(hwnd)           
            addVertSplit(hwnd)
           
            'Attach Controls
            pinCtl(hListbox, hwnd, "TL","BL")
            pinCtl(hEdit, hwnd, "TL","BR")
            pinCtl(hButton, hwnd, "BL")           
            pinCtl(hVSplit, hwnd, "TL","BL")
           
            'Start with Button disabled
            EnableWindow(hButton, false)
                                               
        case WM_COMMAND
           select case loword(wParam)
               case IDM_EXIT
                  DestroyWindow( hwnd )

               case IDM_ABOUT                 
                  Dialog(  0,0,144,77, "About Small App Sample",
                           DS_MODALFRAME | DS_CENTER | WS_CAPTION | WS_POPUP or WS_SYSMENU or DS_SETFONT or DS_CENTER,
                           8,"MS Sans Serif" )
                     CONTROL "OK",IDOK,"Button",WS_CHILD|WS_VISIBLE,                   54,51,40,14
                     CONTROL "A small app demo",-1,"Static",WS_CHILDWINDOW|WS_VISIBLE, 50,17,92, 8
                     CONTROL "in OxygenBasic",-1,"Static",WS_CHILDWINDOW|WS_VISIBLE,   50,27,70, 8
                     CONTROL(  "",IDI_ICON, "STATIC", SS_ICON|SS_CENTERIMAGE,           0, 0,40,40 )
                  CreateModalDialog( hwnd, @AboutDlgProc, 0 )

               case IDM_TOOLBAR
                  int offs=getControlHeight(hToolBar)
                  if GetMenuState(hMenu, IDM_TOOLBAR, MF_BYCOMMAND ) then
                     CheckMenuItem(hMenu, IDM_TOOLBAR, MF_BYCOMMAND or MF_UNCHECKED)
                     ShowWindow(hToolBar, SW_HIDE)
                     'correct offsets
                     modpinCtl(hListbox,  0, -offs, 0, -offs)
                     modpinCtl(hEdit,     0, -offs)
                     modpinCtl(hVSplit,    0, -offs)
                  else   
                     CheckMenuItem(hMenu, IDM_TOOLBAR, MF_BYCOMMAND or MF_CHECKED)
                     ShowWindow(hToolBar, SW_SHOW)
                     'correct offsets
                     modpinCtl(hListbox,  0, offs, 0, offs)
                     modpinCtl(hEdit,     0, offs)
                     modpinCtl(hVSplit,    0, offs)                                         
                  end if
                  SendMessage(hwnd, WM_SIZE, 0,0)
                                       
               case IDM_STATUSBAR
                  int offs=getControlHeight(hStatusBar)                 
                  if GetMenuState(hMenu, IDM_STATUSBAR, MF_BYCOMMAND ) then
                     CheckMenuItem(hMenu, IDM_STATUSBAR, MF_BYCOMMAND or MF_UNCHECKED)
                     ShowWindow(hStatusBar, SW_HIDE)
                     'Listbox needs no change
                     modpinCtl(hEdit,  0, 0, 0, offs)                                       
                     modpinCtl(hVSplit, 0, 0, 0, offs)
                  else   
                     CheckMenuItem(hMenu, IDM_STATUSBAR, MF_BYCOMMAND or MF_CHECKED)
                     ShowWindow(hStatusBar, SW_SHOW)
                     'Listbox needs no change
                     modpinCtl(hEdit,  0, 0, 0, -offs)
                     modpinCtl(hVSplit, 0, 0, 0, -offs)                                         
                  end if
                  SendMessage(hwnd, WM_SIZE, 0,0)   

               case IDM_OPEN               
                  mbox "IDM_OPEN message"
                  EnableMenuItem(hMenu, IDM_OPEN,  MF_GRAYED )
                  EnableMenuItem(hMenu, IDM_CLOSE, MF_ENABLED )
                  SendMessage(hToolBar, TB_ENABLEBUTTON, IDM_OPEN, false )                 
               case IDM_CLOSE               
                  mbox "IDM_CLOSE message"
                  EnableMenuItem(hMenu, IDM_CLOSE, MF_GRAYED )
                  EnableMenuItem(hMenu, IDM_OPEN,  MF_ENABLED )
                  SendMessage(hToolBar, TB_ENABLEBUTTON, IDM_OPEN, true )                 
               
               case ID_LISTBOX
                  if hiword(wparam) = LBN_SELCHANGE then
                    'get index of List, zero-based
                    int index = SendMessage(hListbox, LB_GETCURSEL, 0, 0)
                    if index>0 then EnableWindow(GetDlgItem(hwnd, ID_BTN), true)
                    SetWindowText(GetDlgItem(hwnd,ID_EDIT), "Here will be the description of Position " index+1)                   
                  end if

               case ID_BTN
                  int index = SendMessage(hListbox, LB_GETCURSEL, 0, 0)
                  if index > -1 then mbox "This is an example for position " index+1
                                                       
               case IDM_HELPTOPICS
                  if HtmlHelp (null , HelpFile & "::/wordlink.htm>!", HH_DISPLAY_TOPIC, null) = null then mbox "Error: Cannot find " HelpFile
           end select
       
        case WM_SIZE
           SendMessage(hToolBar, TB_AUTOSIZE, 0,0)
           SendMessage(hStatusBar, WM_SIZE, 0, 0 )
           resizeControls(hwnd)

        case WM_GETMINMAXINFO
           setMinSize (450,350)   
       
        case WM_NOTIFY
            showToolTips(lParam)

        case WM_CLOSE
           DestroyWindow(hwnd)
       
        case WM_DESTROY
           PostQuitMessage(0)
       
        case else
           return DefWindowProc(hwnd, MainMsg, wParam, lParam)
           
    end select
   
    return 0
end function

============================================================

sub addMenu(sys hwnd)
    MENU(hMenu)
     
    BEGIN
      POPUP "&File"
      BEGIN
        MENUITEM "&Open..." tab "Ctrl+O", IDM_OPEN
        MENUITEM "&Close", IDM_CLOSE, GRAYED       
        MENUITEM "E&xit" tab "Alt-F4", IDM_EXIT
      ENDMenu
      POPUP "&View"
      BEGIN
        MENUITEM "&Toolbar", IDM_TOOLBAR, CHECKED
        MENUITEM "&Status Bar", IDM_STATUSBAR, CHECKED
      ENDMenu
      POPUP "&Help"
      BEGIN
        MENUITEM "&Help Topics" tab "F1", IDM_HELPTOPICS
        MENUITEM "SEPARATOR"
        MENUITEM "&About...",IDM_ABOUT
      ENDMenu
    ENDMenu

    if SetMenu( hwnd, hMenu ) = 0 then  mbox "SetMenu hMenu failed!"
   
    'add image to menu item: Open, About
    sys OpenSubMenu=GetSubMenu(hMenu, 0)  'Index base 0   
    SetMenuItemBitmaps(OpenSubMenu, 0, MF_BYPOSITION , hOpenBmp, 0)   
    SetMenuItemBitmaps(OpenSubMenu, 1, MF_BYPOSITION , hCloseBmp, 0)
   
    sys AboutSubMenu=GetSubMenu(hMenu, 2)  'Index base 0   
    SetMenuItemBitmaps(AboutSubMenu, 2, MF_BYPOSITION , hAboutBmp, 0)   

    'Accelerators 
    ACCEL accl[] = {
       {FVIRTKEY | FCONTROL, asc("O"), IDM_OPEN },
       {FVIRTKEY           , VK_F1,    IDM_HELPTOPICS }       
    }

   hAccel = CreateAcceleratorTable( @accl, 2 )   
   if hAccel=0 then mbox "Error: Cannot create Accelerators"
end sub

================================================================================

function createControl(string ctlclass, string Caption, sys hParent, int id, x,y,w,h, int Style, optional ExStyle=0, optional sys hInstance=GetModuleHandle(null)) as sys
   sys hCtrl
   hCtrl=CreateWindowEx(ExStyle, ctlclass, Caption, Style, x,y,w,h,  hParent, id, hInstance, null)
   if hCtrl=null then mbox "Error: Cannot create " ctlclass
   return hCtrl
end function

================================================================================

sub addToolbar(sys hwnd)
   TBBUTTON tbb1, tbb2, tbb3
   TBADDBITMAP tbab

   hToolBar=createControl("ToolbarWindow32", null, hwnd, ID_TOOLBAR, 0,0,0,0, WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS or TBSTYLE_FLAT)
   SendMessage(hToolBar, TB_BUTTONSTRUCTSIZE, sizeof(TBBUTTON), 0)
       
   tbab.hInst = null
   tbab.nID = hOpenBmp
     
   SendMessage(hToolBar, TB_ADDBITMAP, 1, &tbab)
   tbb1.iBitmap = 0  'index based 0
   tbb1.fsState = TBSTATE_ENABLED
   tbb1.fsStyle = TBSTYLE_BUTTON
   tbb1.idCommand = IDM_OPEN
   SendMessage(hToolBar, TB_ADDBUTTONS, 1, &tbb1)

   tbab.nID = hAboutBmp
   SendMessage(hToolBar, TB_ADDBITMAP, 1, &tbab)     
   tbb2.iBitmap = 1  'index based 0
   tbb2.fsState = TBSTATE_ENABLED
   tbb2.fsStyle = TBSTYLE_BUTTON
   tbb2.idCommand = IDM_ABOUT
   SendMessage(hToolBar, TB_ADDBUTTONS, 1, &tbb2)
end sub

sub showToolTips(sys lParam)
   ' lParam holds the notification
   TOOLTIPTEXT *lpttt
   &lpttt = lParam

   string TTText
           
   if lpttt.hdr.code = TTN_NEEDTEXT then
     select lpttt.hdr.idFrom   
        case IDM_OPEN
           TTText="Open File"
        case IDM_ABOUT
           TTText="About"   
     end select
     lpttt.szText = TTText
   end if
end sub

sub addStatusBar(sys hwnd)
   hStatusBar = createControl(STATUSCLASSNAME, null, hwnd, ID_STATUSBAR, 0,0,0,0, WS_CHILD or WS_VISIBLE or SBARS_SIZEGRIP)
   SetWindowText(hStatusBar, "Ready")
end sub

sub addListbox(sys hwnd)
   hListbox = createControl("Listbox", null, hwnd, ID_LISTBOX,  10, 30, 205, 250, WS_CHILD or WS_VISIBLE or WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY, WS_EX_CLIENTEDGE)
   int x
   for x=1 to 200
     SendMessage(hListbox, LB_ADDSTRING, 0, "This is position " x)
   next 
end sub

sub addEdit(sys hwnd)
   uint style=WS_CHILD or WS_VISIBLE or ES_LEFT or WS_TABSTOP or WS_VSCROLL or WS_HSCROLL or ES_MULTILINE or ES_AUTOVSCROLL or ES_AUTOHSCROLL or ES_WANTRETURN 'or ES_READONLY
   hEdit = createControl("Edit", null, hwnd, ID_EDIT, 220, 30, 355, 305, style, WS_EX_CLIENTEDGE)
end sub

sub addButton(sys hwnd)
   hButton = createControl("Button", "Show Example", hwnd, ID_BTN, 30, 300, 100, 20, WS_CHILD or WS_VISIBLE or WS_TABSTOP)
end sub

function getControlHeight(sys hCtl) as int
   RECT rc
   GetWindowRect(hCtl, &rc)
   return rc.bottom - rc.top
end function

function AboutDlgProc( sys hDlg, uint uMsg, sys wParam, lParam) as sys callback 
  select case uMsg

    case WM_INITDIALOG
      'Set Icon
      SendMessage (GetDlgItem(hDlg,IDI_ICON), STM_SETIMAGE, IMAGE_ICON, hIcon)
      SetFocus(GetDlgItem(hDlg,IDOK))

    case WM_COMMAND
      if loword(wParam) = IDOK then EndDialog( hDlg )
      if loword(wParam) = IDCANCEL then  EndDialog( hDlg )

    case WM_CLOSE
        EndDialog(hDlg)
  end select

  return 0
end function

================================================================================
' Vertical Splitter
sub addVertSplit(sys hwnd)
    hVSplit = createControl("Static", null, hwnd, ID_VSPLIT, 215, 30, 6, 305, WS_CHILD  or SS_GRAYRECT or SS_Notify, WS_EX_CLIENTEDGE)
end sub

sub SplitterEvents(sys hwnd, uint uMsg, sys wParam, lParam)

    static bool MouseIsDragging
    static bool MouseMayDrag
    static int vertDiff
    static short vertPos   'x pos
    static RECT rcV_old, rcV
    static RECT pRect
   
    select uMsg
         
        case WM_MOUSEMOVE
           GetClientRect(hwnd, &pRect)

           vertPos=loword(lParam )
           if vertPos < 140 then vertPos = 140 'Example button
           if vertPos > pRect.right then vertPos=pRect.right-10
           if MouseIsDragging=true then
             vertDiff=vertPos-rcV.left
             rcV.left+=vertDiff
             rcV.right+=vertDiff
             MoveWindow(hVSplit, rcV.left, rcV.top, rcV.right-rcV.left, rcV.bottom-rcV.top, true)
           else                               
             GetWindowRect(hVSplit,&rcV)
             MapWindowPoints(HWND_DESKTOP,  GetParent(hVSplit),  &rcV, 2)
             if vertPos >= rcV.left and vertPos <= rcV.right then
               MouseMayDrag=true
               SetClassLongPtr(hwnd, GCL_HCURSOR, LoadCursor(null, IDC_SIZEWE))
               rcV_old.left=rcV.left : rcV_old.top=rcV.top : rcV_old.right=rcV.right : rcV_old.bottom=rcV.bottom
             else
               MouseMayDrag=false
               SetClassLongPtr(hwnd, GCL_HCURSOR, LoadCursor(null, IDC_ARROW))       
             end if
           end if
           
        case WM_LBUTTONDOWN
           if MouseMayDrag then
             SetCapture(hWnd)
             ShowWindow(hVSplit, SW_SHOW)
             SetFocus(hVSplit)             
             MouseIsDragging = true
           end if 
       
        case WM_LBUTTONUP
           if MouseIsDragging then             
             ReleaseCapture()
             MouseIsDragging = false
             ShowWindow(hVSplit, SW_HIDE)             
             MouseMayDrag=false

             vertDiff=rcV.left - rcV_old.left

             modpinCtl(hVSplit)           
             modpinCtl(hListbox, 0, 0, vertDiff)
             modpinCtl(hEdit,    vertDiff)
             SendMessage(hwnd, WM_SIZE, 0,0)
           end if

    end select
end sub



Charles Pegge

Thanks Roland,

I'll update SmallApp.o2bas, and look forward to further developments.

Yes, Defender occasionally decides o2 is malware and makes life awkward. I know Eros often has similar problems with thinBasic. Reporting false positives and reversing quarantine usually resolves it.

BTW: your png screenshots have gone multi-megabyte.