Announcement

**Stuart McLachlan** · 19 Aug 2020, 07:19 PM

See
https://forum.powerbasic.com/forum/u...ting#post56339

Or contact Gary about MyLittleGrid

See https://forum.powerbasic.com/forum/u...898#post793898

**Tim Lakinir** · 19 Aug 2020, 07:52 PM

Thank you Stuart, these are huge programs!

**Kurt Kuzba** · 20 Aug 2020, 02:04 AM

Originally posted by Tim Lakinir View Post

Hi All

I got a project that requires data entry in tabular form kinda like excel format with many columns and rows.
I need some code that can allow data entry, maybe a combobox or listview control and then able to save these data in a text file ?
Appreciate any help on this!

Just something I'd been playing with.

Code:

#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
ENUM ctrls SINGULAR
    id_txt = 500
    key_okay
    key_left
    key_rght
    key_up
    key_down
    key_next
    key_exit
    id_lbls
END ENUM

FUNCTION PBMAIN () AS LONG
    LOCAL hWin AS DWORD, returncode, x, y, llist, ltxt_lbl AS LONG
    DIALOG NEW PIXELS, 0, "Grid Layouts", , , 800, 600, %WS_POPUP OR %WS_SYSMENU OR %WS_CAPTION TO hWin
    DIALOG SET COLOR hWin, %YELLOW, %GRAY
    CONTROL ADD LABEL, hWin, %id_lbls, "", 0, 0, 40, 60, %SS_LEFT OR %SS_NOTIFY
    DIALOG SHOW MODAL hWin, CALL DlgProc TO returncode
END FUNCTION

CALLBACK FUNCTION DlgProc() AS LONG
    STATIC txthasfocus, col_num, row_num, col_high, row_high AS LONG
    LOCAL x, xs, y, ys AS LONG, xstring AS STRING
    SELECT CASE CB.MSG
        CASE %WM_INITDIALOG
            GLOBAL gridlabels() AS LONG
            CONTROL SET SIZE CB.HNDL, %id_lbls,500, 500
            initlabelgrid CB.HNDL, %id_lbls, 5, 30, gridlabels(), "arial", 10
            PopulateLabel CB.HNDL, gridlabels(8, 11), PopulateLabel(CB.HNDL, gridlabels(3, 4), "Test")
            col_num = 1: row_num = 1: col_high = 5: row_high = 30
            HighliteLabel(CB.HNDL, gridlabels(1,1), gridlabels(1,1))
        CASE %WM_COMMAND
            SELECT CASE CB.CTL
                CASE %key_okay
                    IF txthasfocus THEN
                        CONTROL GET TEXT CB.HNDL, %id_txt TO xstring
                        CONTROL GET USER CB.HNDL, %id_txt, 1 TO x
                        CONTROL SET TEXT CB.HNDL, x, xstring
                        CONTROL KILL CB.HNDL, %id_txt
                        CONTROL NORMALIZE CB.HNDL, x
                    ELSE
                        DIALOG POST CB.HNDL, %WM_COMMAND, gridlabels(col_num, row_num), %stn_clicked
                    END IF
                CASE %key_left
                    x = ((col_num + col_high - 2) MOD col_high) + 1
                    HighliteLabel(CB.HNDL, gridlabels(x,row_num), gridlabels(col_num,row_num))
                    col_num = x
                CASE %key_rght
                    x = (col_num MOD col_high) + 1
                    HighliteLabel(CB.HNDL, gridlabels(x,row_num), gridlabels(col_num,row_num))
                    col_num = x
                CASE %key_up
                    y = ((row_num + row_high - 2) MOD row_high) + 1
                    HighliteLabel(CB.HNDL, gridlabels(col_num,y), gridlabels(col_num,row_num))
                    row_num = y
                CASE %key_down
                    y = (row_num MOD row_high) + 1
                    HighliteLabel(CB.HNDL, gridlabels(col_num,y), gridlabels(col_num,row_num))
                    row_num = y
                CASE %key_next
                    x = col_num: y = row_num
                    IF col_num = col_high THEN
                        row_num = (row_num MOD row_high) + 1
                    END IF
                    col_num = (col_num MOD col_high) + 1
                    HighliteLabel(CB.HNDL, gridlabels(col_num,row_num), gridlabels(x,y))
                CASE %key_exit
                    DIALOG END CB.HNDL
                CASE %id_txt
                    IF CB.CTLMSG = %EN_SETFOCUS THEN txthasfocus = -1
                CASE %id_lbls TO (%id_lbls + 999)
                    IF CB.CTLMSG = %stn_clicked THEN
                        Custominputbox CB.HNDL, CB.CTL, "arial", 10
                    END IF
            END SELECT
    END SELECT
END FUNCTION
'for each populate function, we may either set the data for a cell or retrieve it
'in either case, the function returns the data string for the cell selected
FUNCTION PopulateLabel(Dlg AS DWORD, ctl AS LONG, OPTIONAL ptext AS STRING) AS STRING
    LOCAL tempstr AS STRING
    IF ISMISSING(ptext) THEN
        CONTROL GET TEXT dlg, ctl TO tempstr: FUNCTION = tempstr
    ELSE
        CONTROL SET TEXT dlg, ctl , ptext: FUNCTION = ptext
    END IF
END FUNCTION
FUNCTION HighliteLabel(Dlg AS DWORD, ctlhi AS LONG, ctllo AS LONG) AS STRING
    CONTROL SET COLOR dlg, ctllo, %RGB_NAVY, %RGB_IVORY
    CONTROL REDRAW dlg, ctllo
    CONTROL SET COLOR dlg, ctlhi, %BLACK, %YELLOW
    CONTROL REDRAW dlg, ctlhi
END FUNCTION
SUB initlabelgrid(dlg AS DWORD, ctl AS LONG, x AS LONG, y AS LONG, ctlarr() AS LONG, _
        OPTIONAL fntn AS STRING, OPTIONAL fnts AS LONG)
    LOCAL xcol, yrow, ysize, xsize , limrows, limcols, ctlid, fontsize, fonthandle, offx, offy AS LONG
    LOCAL fontname AS STRING
    REDIM ctlarr(x, y)
    MainAccTable dlg
    limcols = x - 1
    limrows = y - 1
    CONTROL GET CLIENT dlg, ctl TO xcol, yrow
    CONTROL SET USER dlg, ctl, 1, xcol
    CONTROL SET USER dlg, ctl, 2, yrow
    DECR xcol: DECR yrow
    xsize = (xcol - 1) \ x
    ysize = (yrow - 1) \ y
    offx = (xcol - xsize * x) \ 2 + 1
    offy = (yrow - ysize * y) \ 2 + 1
    fontsize = IIF(ISMISSING(fnts), 10, fnts)
    fontname = IIF$(ISMISSING(fntn), "", fntn)
    FONT NEW fontname, fontsize TO fonthandle
    FOR yrow = 0 TO limrows
        FOR xcol = 0 TO limcols
            IF ctlid = 0 THEN
                CONTROL SET LOC Dlg, ctl, offx, offy
                CONTROL SET SIZE Dlg, ctl, xsize - 1, ysize - 1
            ELSE
                CONTROL ADD LABEL, Dlg, ctlid + ctl, "", _
                    offx + xsize * (ctlid MOD x), _ 'x column location
                    offy + ysize * (ctlid \ x), _ 'y row location
                    xsize - 1, ysize - 1, %SS_LEFT OR %SS_NOTIFY
            END IF
            CONTROL SET COLOR Dlg, ctlid + ctl, %RGB_NAVY, %RGB_IVORY
            ctlarr(xcol + 1, yrow + 1) = ctlid + ctl
            CONTROL SET TEXT Dlg, ctlid + ctl, "x" + STR$(xcol + 1) + " , y" + STR$(yrow + 1)
            CONTROL SET FONT Dlg, ctlid + ctl, fonthandle
            INCR ctlid
        NEXT
    NEXT
    FONT END fonthandle
END SUB
FUNCTION Custominputbox(Dlg AS DWORD, ctl AS LONG, fontname AS STRING, fontsize AS LONG) AS LONG
    LOCAL xpos, xsize, ypos, ysize, xitval AS LONG, indlg AS DWORD, lbltext AS STRING
    CONTROL GET LOC Dlg, ctl TO xpos, ypos
    CONTROL GET SIZE Dlg, ctl TO xsize, ysize
    CONTROL GET TEXT Dlg, ctl TO lbltext
    DIALOG NEW PIXELS, Dlg, "", xpos, ypos, xsize, ysize, %WS_POPUP OR %WS_BORDER TO indlg
    Inputacctable indlg
    CONTROL HIDE Dlg, ctl
    CONTROL ADD TEXTBOX, indlg, %id_txt, lbltext, 0, 0, xsize, ysize, %ES_LEFT OR %ES_WANTRETURN OR %ES_AUTOHSCROLL OR %WS_BORDER, 0
    FONT NEW fontname, fontsize TO xitval
    CONTROL SET FONT indlg, %id_txt, xitval
    FONT END xitval
    DIALOG SET USER indlg, 1, VARPTR(lbltext)
    DIALOG SHOW MODAL indlg, CALL txtProc() TO xitval
    IF xitval = %vk_return THEN CONTROL SET TEXT Dlg, ctl, lbltext
    CONTROL NORMALIZE Dlg, ctl
    FUNCTION = xitval
END FUNCTION
CALLBACK FUNCTION txtProc() AS LONG
    LOCAL strbuffer AS STRING PTR
    SELECT CASE CB.CTL
        CASE %key_okay
            DIALOG GET USER CB.HNDL, 1 TO strbuffer
            CONTROL GET TEXT CB.HNDL, %id_txt TO @strbuffer
            DIALOG END CB.HNDL, %vk_return
        CASE %key_exit
            DIALOG END CB.HNDL, %vk_escape
        CASE %key_next
            DIALOG END CB.HNDL, %vk_tab
    END SELECT
END FUNCTION
SUB MainAccTable(hDlg AS DWORD)
   LOCAL c AS LONG, ac() AS ACCELAPI, hAccelerator AS DWORD  ' for keyboard accelator table values
   DIM ac(6)
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_return : ac(c).cmd   = %key_okay : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_left   : ac(c).cmd   = %key_left : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_right  : ac(c).cmd   = %key_rght : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_up     : ac(c).cmd   = %key_up   : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_down   : ac(c).cmd   = %key_down : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_tab    : ac(c).cmd   = %key_next : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_escape : ac(c).cmd   = %key_exit : INCR c
   ACCEL ATTACH hDlg, AC() TO hAccelerator
END SUB
SUB InputAccTable(hDlg AS DWORD)
   LOCAL c AS LONG, ac() AS ACCELAPI, hAccelerator AS DWORD  ' for keyboard accelator table values
   DIM ac(6)
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_return : ac(c).cmd   = %key_okay : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_tab    : ac(c).cmd   = %key_next : INCR c
   ac(c).fvirt = %FVIRTKEY : ac(c).key   = %VK_escape : ac(c).cmd   = %key_exit : INCR c
   ACCEL ATTACH hDlg, AC() TO hAccelerator
END SUB

**Tim Lakinir** · 21 Aug 2020, 05:49 PM

Thank you Sir Kurt, but found that the enter key cannot go down to the cell below

**Michael Mattias** · 21 Aug 2020, 06:22 PM

but found that the enter key cannot go down to the cell below

The beauty of source code is, you don't have to accept the program "as is."

You can make that happen, but first you need to look up "subclass." Then you have to add some code to what you have now.

Anytime you want a key to perform a non-default action ... and <Enter>'s default action is to simulate a click on the dialog's default button, not "go down one box" - you need to think "subclass" to alter that behavior.

MCM

**Stuart McLachlan** · 21 Aug 2020, 07:00 PM

Originally posted by Michael Mattias View Post

You can make that happen, but first you need to look up "subclass." Then you have to add some code to what you have now.

Anytime you want a key to perform a non-default action ... and <Enter>'s default action is to simulate a click on the dialog's default button, not "go down one box" - you need to think "subclass" to alter that behavior.

Not in this case. The Enter key's behaviour has already been altered.

ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_return : ac(c).cmd = %key_okay : INCR c

and

Code:

CASE %key_okay
    IF txthasfocus THEN
        CONTROL GET TEXT CB.HNDL, %id_txt TO xstring
        CONTROL GET USER CB.HNDL, %id_txt, 1 TO x
        CONTROL SET TEXT CB.HNDL, x, xstring
        CONTROL KILL CB.HNDL, %id_txt
        CONTROL NORMALIZE CB.HNDL, x
    ELSE
 DIALOG POST CB.HNDL, %WM_COMMAND, gridlabels(col_num, row_num), %stn_clicked
    END IF

...
CASE %id_lbls TO (%id_lbls + 999)
IF CB.CTLMSG = %stn_clicked THEN
Custominputbox CB.HNDL, CB.CTL, "arial", 10
END IF

**Kurt Kuzba** · 22 Aug 2020, 07:06 AM

Originally posted by Tim Lakinir View Post

Thank you Sir Kurt, but found that the enter key cannot go down to the cell below

It is not programmed to.
But you are able to change the programming.

Announcement

need code for combobox or listview data entry

need code for combobox or listview data entry

Comment

Comment

Comment

Comment

Comment

Comment

Comment