Announcement

Collapse
No announcement yet.

need code for combobox or listview data entry

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • need code for combobox or listview data entry

    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!

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

    Or contact Gary about MyLittleGrid

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

    Comment


    • #3
      Thank you Stuart, these are huge programs!

      Comment


      • #4
        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
        The world is strange and wonderful.*
        I reserve the right to be horrifically wrong.
        Please maintain a safe following distance.
        *wonderful sold separately.

        Comment


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

          Comment


          • #6
            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





            Michael Mattias
            Tal Systems (retired)
            Port Washington WI USA
            [email protected]
            http://www.talsystems.com

            Comment


            • #7
              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

              Comment


              • #8
                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.
                The world is strange and wonderful.*
                I reserve the right to be horrifically wrong.
                Please maintain a safe following distance.
                *wonderful sold separately.

                Comment

                Working...
                X