Announcement

Collapse
No announcement yet.

CheckBook Data Entry Example

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

  • CheckBook Data Entry Example

    This program is created as an example to show data entry for PBCC using Windows API. The file & index are managed using Paul Squire's Cheetah DataBase system. This file manager can be downloaded free to be used on a single file. The file used is a *.dbf or FoxPro format.

    Program to create initial file:

    Code:
    '*********************************************************************
    '
    'Purpose: Demo code showing how to create a database and index. Also
    '         shows how to open and close the database and index.
    '
    'Paul Squires (2000-2003)
    '
    '*********************************************************************
    
    
    #COMPILE EXE
    
    #INCLUDE "CHEETAH2.INC"  'all declares for Cheetah Database
    
    
    FUNCTION PBMAIN () AS LONG
    DIM i$
    
      Title$ = "PowerBasic Cheetah Database"
    
    'change to the directory where this program was started from. If Cheetah.dll is not
    'in this directory then make sure you copy it the Windows/System directory.
      CHDIR xdbAppPath$
    
    
    'define the names of the database & index
       DBFname$ = "cnbdt08.dbf"
       IDXname$ = "cnbdt08.idx"
       
       DIM Fd(1:11) AS STRING
       Fd(1) = "primarykey,N,11,0"
       Fd(2) = "dte1,D,8,0"
       Fd(3) = "descr,C,40,0"
        Fd(4)= "deposit,N,19,2"
        Fd(5)= "wthdl,N,19,2"
        Fd(6)= "interest,N,19,2"
        Fd(7)= "chkno,C,4,0"
        Fd(8)= "chkmark,C,1,0"
        Fd(9)= "acctno,C,5,0"
        Fd(10)="comment,C,45,0"
        Fd(11)="chkmark2,C,1,0"
        
    'create the database
      CALL xdbCreate(DBFname$, fd())
    
      IF xdbError THEN
         PRINT "Error: " & STR$(xdbError&) & " creating database.",,Title$
         CALL xdbResetError
         EXIT FUNCTION
      END IF
    
    
    'open the database (database must be open prior to creating index)
      dbHandle& = xdbOpen&(DBFname$)
      IF xdbError THEN
         PRINT "Error: " & STR$(xdbError&) & " opening database.",,Title$
         CALL xdbResetError
         EXIT FUNCTION
      END IF
    
    
    'create the index (database must be open)
      IndexExpr$ = "UPPER(primarykey)"   'index is not case sensitive
      Duplicates& = %XDBTRUE         'allow duplicate customer ID's
    
      CALL xdbCreateIndex(IDXname$, dbHandle&, IndexExpr$, Duplicates&)
      IF xdbError THEN
         PRINT "Error: " & STR$(xdbError&) & " creating index.",,Title$
         CALL xdbResetError
         EXIT FUNCTION
      END IF
    
    'open the index
      idxHandle& = xdbOpenIndex&(IDXname$, dbHandle&)
      IF xdbError THEN
         PRINT "Error: " & STR$(xdbError&) & " opening index.",,Title$
         CALL xdbResetError
         EXIT FUNCTION
      END IF
    
    
    'close the database and related index
      CALL xdbClose(dbHandle&)
    
    PRINT "File Created"
    
     i$=WAITKEY$
    
    
    END FUNCTION
    Resource:

    Code:
    //ck002.rc
    #include "resource.h"
    //#define IDD_DLG1 1000
    #define IDC_EDT2 1002
    #define IDC_EDT3 1003
    #define IDC_EDT4 1004
    #define IDC_EDT5 1005
    #define IDC_EDT6 1006
    #define IDC_EDT7 1007
    #define IDC_EDT8 1008
    #define IDC_EDT9 1009
    #define IDC_EDT10 1010
    #define IDC_BTN1 1011
    #define IDC_BTN2 1012
    #define IDC_BTN3 1013
    #define IDC_BTN4 1014
    #define IDC_BTN5 1015
    #define IDC_BTN6 1016
    #define IDC_EDT1 1001
    #define IDC_STC1 1017
    #define IDC_STC2 1018
    #define IDC_STC3 1019
    #define IDC_STC4 1020
    #define IDC_STC5 1021
    #define IDC_STC6 1022
    #define IDC_STC7 1023
    #define IDC_STC8 1024
    #define IDC_STC9 1025
    #define IDC_STC10 1026
    #define IDC_STC11 1027
    #define IDC_STC12 1028
    #define IDC_STC13 1029
    #define IDC_STC14 1030
    #define IDC_STC15 1031
    #define IDC_STC16 1032
    #define IDC_STC17 1033
    #define IDC_STC18 1034
    #define IDC_STC19 1035
    #define IDC_STC20 1036
    #define IDC_STC21 1037
    #define IDC_STC22 1038
    #define IDC_STC23 1039
    #define IDC_STC24 1040
    #define IDC_STC25 1041
    #define IDC_STC26 1042
    #define IDC_STC27 1043
    #define IDC_STC28 1044
    #define IDC_STC29 1045
    #define IDC_STC30 1046
    #define IDC_STC31 1047
    #define IDC_STC32 1048
    #define IDC_STC33 1049
    #define IDC_STC34 1050
    #define IDC_STC35 1051
    #define IDC_STC36 1052
    #define IDC_STC37 1053
    
    
    DIALOG_1 DIALOGEX 433,353,433,264
    CAPTION "                                   Checking Account"
    FONT 8,"MS Sans Serif",0,0
    STYLE DS_MODALFRAME | WS_MINIMIZEBOX | WS_POPUP | WS_VISIBLE | WS_CAPTION |WS_SYSMENU
    
    BEGIN
      CONTROL "",IDC_EDT1,"Edit",0x50010000,10,22,58,11,0x00000200
      CONTROL "",IDC_EDT2,"Edit",0x50010000,10,49,58,13,0x00000200
      CONTROL "",IDC_EDT3,"Edit",0x50010000,86,49,262,13,0x00000200
      CONTROL "",IDC_EDT4,"Edit",0x50010000,10,77,58,13,0x00000200
      CONTROL "",IDC_EDT5,"Edit",0x50010000,88,77,54,13,0x00000200
      CONTROL "",IDC_EDT6,"Edit",0x50010000,164,77,54,13,0x00000200
      CONTROL "",IDC_EDT7,"Edit",0x50010000,230,77,42,13,0x00000200
      CONTROL "",IDC_EDT8,"Edit",0x50010000,282,77,12,13,0x00000200
      CONTROL "",IDC_EDT9,"Edit",0x50010000,310,77,38,13,0x00000200
      CONTROL "",IDC_EDT10,"Edit",0x50010000,10,108,372,13,0x00000200
      CONTROL "&Add",IDC_BTN1,"Button",0x50010000,320,5,32,11
      CONTROL "&Update",IDC_BTN2,"Button",0x50010000,356,5,32,11
      CONTROL "&Prev",IDC_BTN3,"Button",0x50010000,320,20,32,11
      CONTROL "&Next",IDC_BTN4,"Button",0x50010000,356,20,32,11
      CONTROL "&Delete",IDC_BTN5,"Button",0x50010000,320,35,32,11
      CONTROL "&Exit",IDC_BTN6,"Button",0x50010000,356,35,32,11
      CONTROL "Record #",IDC_STC1,"Static",0x50000000,12,9,42,9
      CONTROL "Date",IDC_STC2,"Static",0x50000000,12,36,50,9
      CONTROL "Description",IDC_STC3,"Static",0x50000000,88,36,66,9
      CONTROL "Deposit",IDC_STC4,"Static",0x50000000,12,66,56,8
      CONTROL "Withdrawl",IDC_STC5,"Static",0x50000000,90,66,48,8
      CONTROL "Interest",IDC_STC6,"Static",0x50000000,166,66,48,8
      CONTROL "Check #",IDC_STC7,"Static",0x50000000,230,66,38,8
      CONTROL "Mark",IDC_STC8,"Static",0x50000000,282,66,18,9
      CONTROL "Account #",IDC_STC9,"Static",0x50000000,310,66,40,9
      CONTROL "Memo",IDC_STC10,"Static",0x50000000,12,96,46,9
      CONTROL "Check File Update",IDC_STC11,"Static",0x50000000,175,5,122,9
      CONTROL "Social Security                   1001",IDC_STC12,"Static",0x50000000,12,132,118,8
      CONTROL "Farm Income                      1002",IDC_STC13,"Static",0x50000000,12,144,118,8
      CONTROL "Interest Credit                     1003",IDC_STC14,"Static",0x50000000,12,155,118,8
      CONTROL "Interest Credit CD               1004",IDC_STC15,"Static",0x50000000,12,166,118,8
      CONTROL "Miscelaneous Income        1005",IDC_STC16,"Static",0x50000000,12,177,118,8
      CONTROL "SBC Phone Bill                   2002D",IDC_STC17,"Static",0x50000000,140,131,124,8
      CONTROL "Medical Expense                3001",IDC_STC18,"Static",0x50000000,140,142,124,8
      CONTROL "Prescription Expense          3002",IDC_STC19,"Static",0x50000000,140,153,124,8
      CONTROL "Primary House ns           4010",IDC_STC20,"Static",0x50000000,140,164,124,8
      CONTROL "Secondary House Ins            4011",IDC_STC21,"Static",0x50000000,140,175,124,8
      CONTROL "Income Tax                        4014",IDC_STC22,"Static",0x50000000,140,186,124,8
      CONTROL "Primary House Tax         4015",IDC_STC23,"Static",0x50000000,140,197,124,8
      CONTROL "Secondary House Tax           4016",IDC_STC24,"Static",0x50000000,140,208,124,8
      CONTROL "Gifts                                     5001",IDC_STC25,"Static",0x50000000,140,219,124,8
      CONTROL "Travel                                  5002",IDC_STC26,"Static",0x50000000,140,230,124,8
      CONTROL "Entertainment                      5003",IDC_STC27,"Static",0x50000000,140,241,124,9
      CONTROL "Cleaning                              7001",IDC_STC28,"Static",0x50000000,140,254,124,8
      CONTROL "Primary House Maint.          8001",IDC_STC29,"Static",0x50000000,274,131,120,8
      CONTROL "Secondary House Maint.          8002",IDC_STC30,"Static",0x50000000,274,142,120,8
      CONTROL "Service Fee                           9001",IDC_STC31,"Static",0x50000000,274,153,120,8
      CONTROL "Office Expense                      11001",IDC_STC32,"Static",0x50000000,274,164,120,8
      CONTROL "Honda Exp                            12001",IDC_STC33,"Static",0x50000000,274,175,120,8
      CONTROL "Jeep Exp                               12002",IDC_STC34,"Static",0x50000000,274,186,120,8
      CONTROL "Nissan Exp                            12003",IDC_STC35,"Static",0x50000000,274,197,120,8
      CONTROL "Groceries                               13001",IDC_STC36,"Static",0x50000000,274,208,120,8
      CONTROL "Miscelaneous Exp                 14001",IDC_STC37,"Static",0x50000000,274,219,120,8
    END
    Program:
    Code:
    #COMPILE EXE
    #CONSOLE OFF
    '#DIM ALL
    #INCLUDE "WIN32API.INC"
    
    #INCLUDE "CHEETAH2.INC"  'all declares for Cheetah Database
    
    #RESOURCE "CK002.PBR"
    
        GLOBAL flaga%
        GLOBAL flena1$
        GLOBAL infofle$
        GLOBAL dbHandle&
        GLOBAL idxHandle&
        GLOBAL varble$()
        GLOBAL autonum&
        GLOBAL recnum&
    
    DECLARE SUB updtflds
    DECLARE SUB getflds
    
    DECLARE FUNCTION DialogBox (BYVAL hCurInstance AS LONG, lpTemplateName AS ASCIIZ, BYVAL hWndParent AS LONG, BYVAL lpDialogFunc AS LONG) AS LONG
    
    
    %addrtn     = 1011
    %updatertn  = 1012
    %prevrtn    = 1013
    %nextrtn    = 1014
    %deletertn  = 1015
    %exitrtn    = 1016
    '------------------------------------------------------------------------------
    
    FUNCTION WINMAIN (BYVAL hCurInstance  AS LONG, _     'Not PBMain since
                      BYVAL hPrevInstance AS LONG, _     'hCurInstance is needed
                      BYVAL lpszCmdLine         AS ASCIIZ PTR, _
                      BYVAL nCmdShow AS LONG ) EXPORT AS LONG
        DEFLNG a-z
        DIM varble$(11)
        DIM i%
    
        LOCAL windowtitle AS ASCIIZ * 256
    
        flaga=0
    
    
       DBFname$ = "cnbdt08.dbf"
       IDXname$ = "cnbdt08.idx"
    
    'open the database (database must be open prior to creating index)
       dbHandle& = xdbOpen&(DBFname$)
    
       IF xdbError THEN
           BEEP
          PRINT "Error: " & STR$(xdbError&) & " opening database.",,Title$
          CALL xdbResetError
          EXIT FUNCTION
       END IF
    
       CALL xdbSkipDeleted (DBhandle&, 1)
    
       LastRec& = xdbRecordCount&(dbHandle&)
       CALL xdbGetRecord(dbHandle&, lastrec&)
       autonumbr$=xdbFieldValue$(dbHandle&, "primarykey", 0)
       autonum&=VAL(autonumbr$)
    
    'open the index
       idxHandle& = xdbOpenIndex&(IDXname$, dbHandle&)
    
       IF xdbError THEN
           BEEP
          PRINT "Error: " & STR$(xdbError&) & " opening index.",,Title$
          CALL xdbResetError
          EXIT FUNCTION
       END IF
    
    
    
     DialogBox hCurInstance, "dialog_1", hconsole, CODEPTR(DialogProc) 'the DialogProc will receive the events from the dialog
    
    END FUNCTION  ' WinMain
    
    '------------------------------------------------------------------------------
    FUNCTION DialogProc(BYVAL hDlg AS LONG, BYVAL wMsg AS LONG, _
                       BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    
        LOCAL buffer AS ASCIIZ * 46
    
      SELECT CASE wMsg
        CASE %WM_COMMAND
          SELECT CASE LOWRD(wParam)
            CASE %addrtn                           'add   ****************************************
                IF flaga%=0 THEN
    
                    FOR x%=1 TO 11
                        varble$(x%)=""
                    NEXT
    
                    GetDlgItemtext(hdlg,1002&,buffer,11)'get text from textbox
                    varble$(2)=buffer
                    varble$(2)="20"+RIGHT$(varble$(2),2)+LEFT$(varble$(2),2)+MID$(varble$(2),4,2)     '05/17/08 date format
                    GetDlgItemtext(hdlg,1003&,buffer,40)
                    varble$(3)=buffer
                    GetDlgItemtext(hdlg,1004&,buffer,11)
                    varble$(4)=buffer
                    GetDlgItemtext(hdlg,1005&,buffer,11)
                    varble$(5)=buffer
                    GetDlgItemtext(hdlg,1006&,buffer,11)
                    varble$(6)=buffer
                    GetDlgItemtext(hdlg,1007&,buffer,6)
                    varble$(7)=buffer
                    GetDlgItemtext(hdlg,1008&,buffer,2)
                    varble$(8)=buffer
                    GetDlgItemtext(hdlg,1009&,buffer,6)
                    varble$(9)=buffer
                    GetDlgItemtext(hdlg,1010&,buffer,45)
                    varble$(10)=buffer
    
                    CALL xdbClearBuffer(dbHandle&)  'this will clear the record buffer
                    INCR autonum&
                    autonumbr$=RIGHT$(SPACE$(11)+STR$(autonum&),11)
    '                RSET autonumbr$ = LTRIM$(STR$(autonum&))
    
                    CALL xdbAssignField(dbHandle&, "primarykey",0, autonumbr$)
                    CALL xdbAssignField(dbHandle&, "dte1",0, varble$(2))
                    CALL xdbAssignField(dbHandle&, "descr",0, varble$(3))
                    CALL xdbAssignField(dbHandle&, "deposit",0, varble$(4))
                    CALL xdbAssignField(dbHandle&, "wthdl",0, varble$(5))
                    CALL xdbAssignField(dbHandle&, "interest",0, varble$(6))
                    CALL xdbAssignField(dbHandle&, "chkno",0, varble$(7))
                    CALL xdbAssignField(dbHandle&, "chkmark",0, varble$(8))
                    CALL xdbAssignField(dbHandle&, "acctno",0, varble$(9))
                    CALL xdbAssignField(dbHandle&, "comment",0, varble$(10))
                    CALL xdbAssignField(dbHandle&, "chkmark2",0, varble$(11))
    
    'add to the end of the database (Append) & add the key to the index.
    
                    CALL xdbAddRecord(dbHandle&)
    
                    IF xdbError THEN
                        PRINT "Error: " & STR$(xdbError&) & " adding database record.",,Title$
                        CALL xdbResetError
    
                    END IF
    
                    CALL xdbReindexALL(dbHandle&)
    
                    buffer=""
    
                    setdlgitemtext(hdlg,1001&,buffer)  'put text in textbox
                    setdlgitemtext(hdlg,1002&,buffer)
                    setdlgitemtext(hdlg,1003&,buffer)
                    setdlgitemtext(hdlg,1004&,buffer)
                    setdlgitemtext(hdlg,1005&,buffer)
                    setdlgitemtext(hdlg,1006&,buffer)
                    setdlgitemtext(hdlg,1007&,buffer)
                    setdlgitemtext(hdlg,1008&,buffer)
                    setdlgitemtext(hdlg,1009&,buffer)
                    setdlgitemtext(hdlg,1010&,buffer)
    '               setdlgitemtext(hdlg,IDC_EDT11,varble$(11))
    
                    setfocus(getdlgitem(hdlg,1002&))
    
    
                END IF
    
                BEEP
    
                FUNCTION = 0
            CASE %updatertn                             'update  *************************************
    
                IF flaga%=0 THEN
    
                    FOR x%=1 TO 11
                        varble$(x)=""
                    NEXT
    
                    GetDlgItemtext(hDlg,1001&,buffer,12)
    
                    LookFor$ = SPACE$(11)
                    RSET LookFor$ = buffer
                    stat& = xdbSeek&(dbHandle&, idxHandle&, LookFor$)
    
                    IF stat&=1 THEN
                        RecNum& = xdbRecordNumber&(dbHandle&)
                        CALL xdbGetRecord(dbHandle&, RecNum&)
    
                        getflds
    
    '                    setdlgitemtext(hdlg,IDC_EDT1,varble$(1))  'put text in textbox
                        buffer=MID$(varble$(2),5,2)+"/"+RIGHT$(varble$(2),2)+"/"+MID$(varble$(2),3,2)     '05/17/08 date format
                        setdlgitemtext(hDlg,1002&,buffer)
                        buffer=varble$(3)
                        setdlgitemtext(hdlg,1003&,buffer)
                        buffer=varble$(4)
                        setdlgitemtext(hdlg,1004&,buffer)
                        buffer=varble$(5)
                        setdlgitemtext(hdlg,1005&,buffer)
                        buffer=varble$(6)
                        setdlgitemtext(hdlg,1006&,buffer)
                        buffer=varble$(7)
                        setdlgitemtext(hdlg,1007&,buffer)
                        buffer=varble$(8)
                        setdlgitemtext(hdlg,1008&,buffer)
                        buffer=varble$(9)
                        setdlgitemtext(hdlg,1009&,buffer)
                        buffer=varble$(10)
                        setdlgitemtext(hdlg,1010&,buffer)
    
                        flaga%=1
                    END IF
    
    
                ELSE
                    IF flaga%=1 THEN
                        RecNum& = xdbRecordNumber&(dbHandle&)
                        CALL xdbGetRecord(dbHandle&, RecNum&)
    
                            GetDlgItemtext(hdlg,1002&,buffer,11)'get text from textbox
                            varble$(2)=buffer
                            varble$(2)="20"+RIGHT$(varble$(2),2)+LEFT$(varble$(2),2)+MID$(varble$(2),4,2)     '05/17/08 date format
                            GetDlgItemtext(hdlg,1003&,buffer,40)
                            varble$(3)=buffer
                            GetDlgItemtext(hdlg,1004&,buffer,11)
                            varble$(4)=buffer
                            GetDlgItemtext(hdlg,1005&,buffer,11)
                            varble$(5)=buffer
                            GetDlgItemtext(hdlg,1006&,buffer,11)
                            varble$(6)=buffer
                            GetDlgItemtext(hdlg,1007&,buffer,6)
                            varble$(7)=buffer
                            GetDlgItemtext(hdlg,1008&,buffer,2)
                            varble$(8)=buffer
                            GetDlgItemtext(hdlg,1009&,buffer,6)
                            varble$(9)=buffer
                            GetDlgItemtext(hdlg,1010&,buffer,45)
                            varble$(10)=buffer
    '                       GetDlgItemtext(hdlg,IDC_EDT1,varble$(11),1)
    
                            updtflds
    
                            CALL xdbPutRecord(dbHandle&, RecNum&)
    
                            buffer=""
    
                            setdlgitemtext(hdlg,1001&,buffer)  'put text in textbox
                            setdlgitemtext(hdlg,1002&,buffer)
                            setdlgitemtext(hdlg,1003&,buffer)
                            setdlgitemtext(hdlg,1004&,buffer)
                            setdlgitemtext(hdlg,1005&,buffer)
                            setdlgitemtext(hdlg,1006&,buffer)
                            setdlgitemtext(hdlg,1007&,buffer)
                            setdlgitemtext(hdlg,1008&,buffer)
                            setdlgitemtext(hdlg,1009&,buffer)
                            setdlgitemtext(hdlg,1010&,buffer)
    
                            setfocus(getdlgitem(hdlg,1002&))  'set tab focus to textbox 2
                            flaga%=0
    
                    END IF
    
                END IF
    
    
            CASE %prevrtn                      'prev  ************************************
    
                    CALL xdbMovePrev (DBhandle&, 0)
    
                    IF ISFALSE xdbBOF&(DBhandle&) THEN
    
                        getflds
    
                        buffer=varble$(1)
                        setdlgitemtext(hDlg,1001&,buffer)
                        buffer=MID$(varble$(2),5,2)+"/"+RIGHT$(varble$(2),2)+"/"+MID$(varble$(2),3,2)     '05/17/08 date format
                        setdlgitemtext(hDlg,1002&,buffer)
                        buffer=varble$(3)
                        setdlgitemtext(hdlg,1003&,buffer)
                        buffer=varble$(4)
                        setdlgitemtext(hdlg,1004&,buffer)
                        buffer=varble$(5)
                        setdlgitemtext(hdlg,1005&,buffer)
                        buffer=varble$(6)
                        setdlgitemtext(hdlg,1006&,buffer)
                        buffer=varble$(7)
                        setdlgitemtext(hdlg,1007&,buffer)
                        buffer=varble$(8)
                        setdlgitemtext(hdlg,1008&,buffer)
                        buffer=varble$(9)
                        setdlgitemtext(hdlg,1009&,buffer)
                        buffer=varble$(10)
                        setdlgitemtext(hdlg,1010&,buffer)
    
    
                    END IF
    
            CASE %nextrtn                 'next  *************************************
                    CALL xdbMoveNext (DBhandle&, 0)
    
                    IF ISFALSE xdbEOF&(DBhandle&) THEN
                        getflds
    
                        buffer=varble$(1)
                        setdlgitemtext(hDlg,1001&,buffer)
                        buffer=MID$(varble$(2),5,2)+"/"+RIGHT$(varble$(2),2)+"/"+MID$(varble$(2),3,2)     '05/17/08 date format
                        setdlgitemtext(hDlg,1002&,buffer)
                        buffer=varble$(3)
                        setdlgitemtext(hdlg,1003&,buffer)
                        buffer=varble$(4)
                        setdlgitemtext(hdlg,1004&,buffer)
                        buffer=varble$(5)
                        setdlgitemtext(hdlg,1005&,buffer)
                        buffer=varble$(6)
                        setdlgitemtext(hdlg,1006&,buffer)
                        buffer=varble$(7)
                        setdlgitemtext(hdlg,1007&,buffer)
                        buffer=varble$(8)
                        setdlgitemtext(hdlg,1008&,buffer)
                        buffer=varble$(9)
                        setdlgitemtext(hdlg,1009&,buffer)
                        buffer=varble$(10)
                        setdlgitemtext(hdlg,1010&,buffer)
    
                    END IF
    
            CASE %deletertn                'delete  **************************************
                IF flaga%=0 THEN
    
                    FOR x%=1 TO 11
                        varble$(x)=""
                    NEXT
    
                    GetDlgItemtext(hDlg,1001&,buffer,12)
    
                    LookFor$ = SPACE$(11)
                    RSET LookFor$ = buffer
                    stat& = xdbSeek&(dbHandle&, idxHandle&, LookFor$)
    
                    IF stat&=1 THEN
                        RecNum& = xdbRecordNumber&(dbHandle&)
                        CALL xdbGetRecord(dbHandle&, RecNum&)
    
                        getflds
    
                        buffer=varble$(2)
                        setdlgitemtext(hDlg,1002&,buffer)
                        buffer=varble$(3)
                        setdlgitemtext(hdlg,1003&,buffer)
                        buffer=varble$(4)
                        setdlgitemtext(hdlg,1004&,buffer)
                        buffer=varble$(5)
                        setdlgitemtext(hdlg,1005&,buffer)
                        buffer=varble$(6)
                        setdlgitemtext(hdlg,1006&,buffer)
                        buffer=varble$(7)
                        setdlgitemtext(hdlg,1007&,buffer)
                        buffer=varble$(8)
                        setdlgitemtext(hdlg,1008&,buffer)
                        buffer=varble$(9)
                        setdlgitemtext(hdlg,1009&,buffer)
                        buffer=varble$(10)
                        setdlgitemtext(hdlg,1010&,buffer)
    
                        flaga%=1
    
                    END IF
    
                ELSE
                    IF flaga%=1 THEN
    
                        FOR x%=1 TO 11
                           varble$(x%)=""
                        NEXT
                        RecNum& = xdbRecordNumber&(dbHandle&)
                        CALL xdbDeleteRecord(dbHandle&, recnum&)
    
                        buffer=""
    
                        setdlgitemtext(hdlg,1001&,buffer)  'put text in textbox
                        setdlgitemtext(hdlg,1002&,buffer)
                        setdlgitemtext(hdlg,1003&,buffer)
                        setdlgitemtext(hdlg,1004&,buffer)
                        setdlgitemtext(hdlg,1005&,buffer)
                        setdlgitemtext(hdlg,1006&,buffer)
                        setdlgitemtext(hdlg,1007&,buffer)
                        setdlgitemtext(hdlg,1008&,buffer)
                        setdlgitemtext(hdlg,1009&,buffer)
                        setdlgitemtext(hdlg,1010&,buffer)
    '                   setdlgitemtext(hdlg,IDC_EDT11,varble$(11))
    
                        setfocus(getdlgitem(hdlg,1002&))  'set tab focus to textbox 2
                        flaga%=0
                    END IF
                END IF
    
    
            CASE %exitrtn       'exit
                CALL xdbClose(dbHandle&)
                EndDialog hDlg, 0
                FUNCTION = 0
    
            CASE %IDCANCEL      'X cancel
                CALL xdbClose(dbHandle&)
                EndDialog hDlg, 1
                FUNCTION = 1
         END SELECT
      END SELECT
    END FUNCTION
    
    
    '------------------------------------------------------------------------------
    
    '*******************************************
    '            send info to record
    '*******************************************
    SUB updtflds
            CALL xdbAssignField(dbHandle&, "dte1", 0, varble$(2))
            CALL xdbAssignField(dbHandle&, "descr", 0, varble$(3))
            CALL xdbAssignField(dbHandle&, "deposit", 0, varble$(4))
            CALL xdbAssignField(dbHandle&, "wthdl", 0, varble$(5))
            CALL xdbAssignField(dbHandle&, "interest", 0, varble$(6))
            CALL xdbAssignField(dbHandle&, "chkno", 0, varble$(7))
            CALL xdbAssignField(dbHandle&, "chkmark", 0, varble$(8))
            CALL xdbAssignField(dbHandle&, "acctno", 0, varble$(9))
            CALL xdbAssignField(dbHandle&, "comment", 0, varble$(10))
            CALL xdbAssignField(dbHandle&, "chkmark2", 0, varble$(11))
    
    
    END SUB
    
    '*******************************************
    '            get info from record
    '*******************************************
    SUB getflds
            varble$(1) =xdbFieldValue$(dbHandle&, "primarykey", 0)
            varble$(2) =xdbFieldValue$(dbHandle&, "dte1", 0)
            varble$(3) =xdbFieldValue$(dbHandle&, "descr", 0)
            varble$(4) =xdbFieldValue$(dbHandle&, "deposit", 0)
            varble$(5) =xdbFieldValue$(dbHandle&, "wthdl", 0)
            varble$(6) =xdbFieldValue$(dbHandle&, "interest", 0)
            varble$(7) =xdbFieldValue$(dbHandle&, "chkno", 0)
            varble$(8) =xdbFieldValue$(dbHandle&, "chkmark", 0)
            varble$(9) =xdbFieldValue$(dbHandle&, "acctno", 0)
            varble$(10)=xdbFieldValue$(dbHandle&, "comment", 0)
            varble$(11)=xdbFieldValue$(dbHandle&, "chkmark2", 0)
    
            FOR x%=1 TO 11
                    varble$(x%)=RTRIM$(varble$(x%))
            NEXT
    
    END SUB
    
    '--------------------------------------------------------------------------------------
    FUNCTION DialogBox (BYVAL hCurInstance AS LONG, lpTemplateName AS ASCIIZ, BYVAL hWndParent AS LONG, BYVAL lpDialogFunc AS LONG) AS LONG
      FUNCTION = DialogBoxParam(hCurInstance, lpTemplateName, hWndParent, lpDialogFunc, 0)
    END FUNCTION
    '------------------------------------------------------------------------------
    djt
    djthain

  • #2
    djthain,

    Nice demo. Can I suggest that you (re)post this in the Source Code forum? When looking for code, its easier to locate if its in the proper forum
    Software makes Hardware Happen

    Comment


    • #3
      >Can I suggest that you (re)post this in the Source Code forum

      But when you do, please add and additional comment in the header......
      Code:
      ...
      'Purpose: Demo code showing how to create a database and index. Also
      '         shows how to open and close the database and index.
      '.[b]Requires Cheetah development system be available[/b]
      '...
      MCM
      Michael Mattias
      Tal Systems (retired)
      Port Washington WI USA
      [email protected]
      http://www.talsystems.com

      Comment

      Working...
      X