'===========================================================================
' Subject: DDT example of a wizard program    Date: 07-15-01 (  :  )       
'  Author: Buff                               Code: PBDLL                  
'  Origin: oasys@telepath.com               Packet: PBDLL.ABC
'===========================================================================
'******************************************************************
'Date: 7/15/2001
'author: Buff
'email:oasys@telepath.com
'compiler: PBdll 6.0
'Title: DDT Wizard
'Description: DDT example of a wizard type program
'*******************************************************************
'a Chart Of Accounts wizard for an accounting package
'much of the specific code relating to the files has
'been removed so the
'program will run but isnt complete
'it will run as is if:poiuy subfolder exists and
'if it has at lease one file in the subfolder
'and is intended AS
'an example rather than a working program
'
'*** This is all DDT instead of STK
'**********************************
'SYNTAX ABCCOAWIZ coid
'where: coid is a subdirectory/folder name with
'       at least one file in it.
'       program uses poiuy for testing
'of course you can change the name of the program
'and the subdir too. Exits program if the Chart of
'Accounts file GLCOA if > 0 in length. This is to
'avoid destroying a valid chart of accounts file.
'AS the program destroys and recreates a new chart file.
'--------------------------------------------------

'here is the RC file COAWIZ.RC (just 1 line)
'the bmp i used for the first page is about
'100 x 112 in size (pixels)
'*************************
'    B1 BITMAP WIZARD2.BMP
'*************************
''use rc coawiz then
''pbres coawiz
''of course dont use the ' in the rc file
'-------------------------------
'declaration for dll/exe
'*******************************
'*****************************************************************
#COMPILE EXE 'for testing using WINMAIN
'#COMPILE DLL
#INCLUDE "win32api.inc"
#RESOURCE "COAWIZ.PBR" 'contains bitmap pic
GLOBAL UserName AS STRING
GLOBAL hdlg2 AS LONG
GLOBAL printers$()
GLOBAL portname$()
GLOBAL prtr$
GLOBAL iIndex&
GLOBAL returned&
GLOBAL copies$
GLOBAL portis$
GLOBAL preview$
GLOBAL abort%
GLOBAL tofile%
GLOBAL offset&
GLOBAL descdisp$()
GLOBAL desc$()
GLOBAL lastacct$()
GLOBAL nextacct$
GLOBAL dindex$()
GLOBAL button_pushed%
GLOBAL coid$
GLOBAL CoaD$
DECLARE SUB savenewacct(coid$)
DECLARE SUB setupcoa(coid$)
DECLARE SUB addpage2()
DECLARE FUNCTION IsWin95() AS LONG
'*****************************
''*******type definitions*****
'*****************************
    TYPE indexed
       indxrec AS STRING * 8
    END TYPE
    TYPE COATYPE
        Accountkey AS STRING * 6
        description AS STRING * 30
     'whatever else here
    END TYPE
    TYPE CLITYP
      CLNAM AS STRING * 35
      CLNAM2 AS STRING * 35
     'whatever else here
    END TYPE
'****************************************************
'******callback function for the dialog(s) **********
'****************************************************
 CALLBACK FUNCTION Coacallback

   CID&=CBCTL
   SELECT CASE CID&
     CASE 103 'Next Button
       CONTROL DISABLE hdlg2,113 'disable next button
       setupcoa coid$
       addpage2
       page2&=-1
     CASE 113 'Cancel Button
       DIALOG END hDlg2,1
       abort%=1
       CLOSE
     CASE 114 'description of new account
        CONTROL GET TEXT CBHNDL, 114 TO UserName
        coaD$=UserName
     CASE 115 'save button for new accounts
        IF button_pushed%=0 OR CoaD$="" THEN
           MSGBOX "You must select a section (radio buttons) "+$CRLF+"and Enter a description before saving",,"Entry not complete"
           EXIT FUNCTION
        END IF
        didit&=0

        SELECT CASE button_pushed%
             CASE 117
                CONTROL KILL hDlg2,117
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 117, "", 13, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]

             CASE 118
                CONTROL KILL hDlg2,118
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 118, "", 57,15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]

             CASE 119
                CONTROL KILL hDlg2,119
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 119, "", 97,15, 10, 14 , %BS_TOP

             CASE 120
                CONTROL KILL hDlg2,120
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 120, "", 140,15, 10, 14 , %BS_TOP

             CASE 121
                CONTROL KILL hDlg2,121
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 121, "", 177,15, 10, 14 , %BS_TOP

             CASE 122
                CONTROL KILL hDlg2,122
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 122, "", 214,15, 10, 14 , %BS_TOP

             CASE 123
                CONTROL KILL hDlg2,123
                SLEEP 2
                CONTROL ADD OPTION, hDlg2, 123, "", 251,15, 10, 14 , %BS_TOP

        END SELECT
   'save new account sub call here
        IF coaD$="" THEN
           MSGBOX "You must provide a description for the Account",,"No Account Description"
        ELSE
           savenewacct coid$
        END IF
        button_pushed%=0 'reset button flag
        CONTROL SET TEXT hDlg2, 114, "" 'reset user description input
        coaD$=""
     CASE 117 'S.T. assets option
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(1))+4,"###")
          didit&=-1
          button_pushed%=117
          lastacct$(1)=nextacct$

       END IF
     CASE 118 'L.T. assets option
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(2))+4,"###")
          didit&=-1
          button_pushed%=118
          lastacct$(2)=nextacct$

       END IF

     CASE 119 'S.T. liab option
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(3))+4,"###")
          didit&=-1
          button_pushed%=119
          lastacct$(3)=nextacct$

       END IF

     CASE 120 'L.T. liab option
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(4))+4,"###")
          didit&=-1
          button_pushed%=120
          lastacct$(4)=nextacct$

       END IF

     CASE 121 'Capital radio button
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(5))+4,"###")
          didit&=-1
          button_pushed%=121
          lastacct$(5)=nextacct$

       END IF

     CASE 122 'Income radio button
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(6))+4,"###")
          didit&=-1
          button_pushed%=122
          lastacct$(6)=nextacct$

       END IF

     CASE 123 'Expense radio button
       IF didit&=0 THEN
          nextacct$=FORMAT$(VAL(lastacct$(7))+4,"###")
          didit&=-1
          button_pushed%=123
          lastacct$(7)=nextacct$
       END IF

     CASE 126 'Finish Button
       CLOSE
       fil%=FREEFILE
       DIM getcli AS clityp
       OPEN coid$+"\client" FOR RANDOM AS #fil% LEN=LEN(getcli)
       GET #fil%,1,getcli
'*****finish setting up files **********
'***************************************
  'code deleted here
       PUT #fil%,1,getcli
       CLOSE
       SLEEP 2

       DIALOG END hDlg2,1

     END SELECT
     IF page2&=-1 THEN
        CONTROL DISABLE hDlg2,103
        page2&=0
     END IF
 END FUNCTION

'******* Main Function *****************
'***************************************
    FUNCTION WINMAIN(BYVAL hCurInstance  AS LONG, _
                     BYVAL hPrevInstance AS LONG, _
                     lpszCmdLine   AS ASCIIZ PTR, _
                     BYVAL nCmdShow      AS LONG) _
                     EXPORT AS LONG

  DIM descdisp$(400)
  DIM desc$(400)
  DIM lastacct$(7)
   LOCAL hInstance&
   LOCAL Hdlg AS LONG
   coid$=COMMAND$

coid$="poiuy" 'for testing ** take out in real prog
'******* no client id sent ? then exit program
'**********************************************
   IF coid$="" THEN EXIT FUNCTION

   xx$=DIR$(coid$+"\*.*")
   IF xx$="" THEN
'**** no files at all ? then exit *******
      MSGBOX "Invalid Client code ",,"Invalid Client"
      EXIT FUNCTION
   END IF
'   ON ERROR RESUME NEXT
'****** open the files *************
   OPEN coid$+"\gltran" FOR BINARY AS #9
   IF LOF(9)>0 THEN err1%=1
   CLOSE #9
   OPEN coid$+"\glcoa" FOR BINARY AS #9
   IF LOF(9)>0 THEN err1%=err1%+1 'Chart of accounts has records already
   CLOSE #9
   IF err1%>0 THEN
'*** exit if transactions or existing chart of accounts
      MSGBOX "Warninig: Posting and or Chart of Accouts file"+$CRLF+_
      "appear to be active.",,"DO NOT USE WIZARD with Active client"
      EXIT FUNCTION
   END IF
'********************************
'***** set up initial dialog ****
'********************************
   dTitle$="OASYS Client Write-Up Chart of Accounts Wizard for: "+coid$:copies$="1":Preview$="N"
   SLEEP 100

   DIALOG  NEW hInstance&,dTitle$,,,280,200,%DS_3DLOOK AND %DS_SETFOREGROUND, %WS_EX_TOPMOST AND %WS_EX_LEFT AND %DS_CENTER TO hDlg2
   offset&=0
   CONTROL ADD FRAME, hDlg2,104,"",94+offset&,4+offset&,180,145 '80
   CONTROL ADD LABEL, hdlg2,106,"This Wizard will allow you to form a simple Chart of",100+offset&,14+offset&,160,12
   CONTROL ADD LABEL, hdlg2,107,"Accounts. Enter the descriptions for posting accounts",100+offset&,26+offset&,170,12
   CONTROL ADD LABEL, hdlg2,108,"in the order of their appearance on the financial",100+offset&,38+offset&,170,12
   CONTROL ADD LABEL, hdlg2,109,"statements. DO NOT use this if you have already",100+offset&,50+offset&,170,12
   CONTROL ADD LABEL, hdlg2,110,"made a Chart of Accounts. A basic outline will be ",100+offset&,62+offset&,170,12
   CONTROL ADD LABEL, hdlg2,140,"pre-written when you click Next. Heading and total",100+offset&,74+offset&,170,12
   CONTROL ADD LABEL, hdlg2,141,"accounts including Current Period Income in the",100+offset&,86+offset&,170,12
   CONTROL ADD LABEL, hdlg2,142,"Capital section will be supplied by the wizard. You",100+offset&,98+offset&,170,12
   CONTROL ADD LABEL, hdlg2,143,"may view the accounts in a listbox that will be",100+offset&,110+offset&,170,12
   CONTROL ADD LABEL, hdlg2,144,"shown below.",100+offset&,122+offset&,140,12
   CONTROL ADD LABEL, hdlg2,111,"When ready click NEXT. ",100+offset&,134+offset&,170,12,%SS_CENTER
   CONTROL ADD LABEL, hdlg2,112,"**CAUTION** READ ABOVE BEFORE CONTINUING ! ! ",74+offset&,155+offset&,180,12
'***** use the bmp from the PBR file(resource) here *********
'************************************************************
   CONTROL ADD IMAGE, hdlg2, 125, "B1", 10+offset&, 10+offset&, 100, 66,'1 '[, style&[,
   CONTROL ADD BUTTON, hDLG2,103,"Next",120+offset&,178+offset&,40,16,%BS_CENTER,%WS_EX_LEFT
   CONTROL ADD BUTTON, hDLG2,113,"CANCEL",230+offset&,178+offset&,40,16,%BS_CENTER,%WS_EX_LEFT
   CONTROL ADD BUTTON, hDLG2,126,"FINISH",175+offset&,178+offset&,40,16,%BS_CENTER,%WS_EX_LEFT
'***** not ready for finish button initially so disable it *****
   CONTROL DISABLE hDlg2, 126
   DIALOG SHOW MODAL hDLG2, CALL CoAcallback
   f1$=""
   IF abort%=1 THEN F1$=""
   FUNCTION=1
   abort%=0
 END FUNCTION

 FUNCTION IsWin95() EXPORT AS LONG
  LOCAL vi AS OSVERSIONINFO
  vi.dwOsVersionInfoSize = SIZEOF(vi)
  GetVersionEx vi
  FUNCTION = (vi.dwPlatformId = %VER_PLATFORM_WIN32_WINDOWS)
 END FUNCTION

SUB setupcoa(coid$)
'************************
'set up skeleton COA here
'************************
   DIM getind AS indexed
   DIM getcoa AS coatype
   REDIM dindex$(1000)
   DATA "050H","103H","199T","203H","298T"
'other data statements as necessary here (removed for this outlone)
'*****************************************************************
   FOR k&=1 TO 5  ' my real program uses 21
       dindex$(k&)=READ$(k&)
       dindex$(k&)=MID$(dindex$(k&)+SPACE$(6),1,6)+MKI$(k&)
   NEXT

   LastAcct$(1)="103":LastAcct$(2)="203":lastAcct$(3)="303"
   LastAcct$(4)="403":LastAcct$(5)="503":lastAcct$(6)="603"
   LastAcct$(7)="703"
   fil%=FREEFILE
   OPEN coid$+"\glcoa" FOR OUTPUT AS #fil%
   CLOSE #fil%
   OPEN coid$+"\coa.ndx" FOR OUTPUT AS #fil%
   CLOSE #fil%
   OPEN coid$+"\glcoa" FOR RANDOM AS #fil% LEN=LEN(getcoa)
   fil2%=FREEFILE
   OPEN coid$+"\coa.ndx" FOR RANDOM AS #fil2% LEN=8
   FOR rn&=1 TO 21
       getind.indxrec=dindex$(rn&)
       PUT #fil2%,rn&,getind

   NEXT rn&
   FOR rn&=1 TO 21
     getcoa.Accountkey=MID$(dindex$(rn&)+SPACE$(6),1,6)
     getcoa.description=MID$(desc$(rn&-1)+SPACE$(30),1,30)
     IF rn&=1 THEN

     ELSEIF rn&=7 OR rn&=13 THEN

     ELSEIF rn&=2 OR rn&=4 OR rn&=8 OR rn&=10 OR rn&=19 THEN

     ELSEIF rn&=3 THEN

     ELSEIF rn&=5 THEN

     ELSEIF rn&=6 THEN

     ELSEIF rn&=9 THEN

     ELSEIF rn&=11 THEN

     ELSEIF rn&=12 THEN

     ELSEIF rn&=15 THEN

     ELSEIF rn&=16 THEN

     ELSEIF rn&=17 THEN

     ELSEIF rn&=18 THEN

     ELSEIF rn&=20 THEN

     ELSEIF rn&=21 THEN

     ELSEIF rn&=14 THEN

     END IF
     PUT #fil%,rn&,GetCoa
   NEXT rn&
   CLOSE
'****End of initial setup ************
'**** actual code was removed from multiline
'**** if statments above
END SUB

SUB addpage2()
'********* set up next page (dialog) of wizard *********
'********* kill first page controls and add new ones ***
    CONTROL KILL hDlg2,104
    CONTROL KILL hDlg2,106
    CONTROL KILL hDlg2,107
    CONTROL KILL hDlg2,108
    CONTROL KILL hDlg2,109
    CONTROL KILL hDlg2,110
    CONTROL KILL hDlg2,111
    CONTROL KILL hDlg2,112
    CONTROL KILL hDlg2,125
    CONTROL KILL hdlg2,140
    CONTROL KILL hdlg2,141
    CONTROL ADD TEXTBOX, hdlg2,114,"",14+offset&,40+offset&,180,15,0
    CONTROL ADD BUTTON, hDLG2,115,"Save",80+offset&,60+offset&,40,16,%BS_CENTER,%WS_EX_LEFT
    CONTROL ADD LABEL, hDlg2,116,"Enter Description of new Account below and check category above",14+offset&,30+offset&,220,12
    CONTROL ADD OPTION, hDlg2, 117, "S.T. Assets", 13, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,131,"S.T. Assets",5,3,50,12
    CONTROL ADD OPTION, hDlg2, 118, "L.T. Assets", 55, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,132,"L.T. Assets",47,3,50,12
    CONTROL ADD OPTION, hDlg2, 119, "S.T. Liab", 97, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,133,"S.T. Liab",89,3,50,12
    CONTROL ADD OPTION, hDlg2, 120, "L.T. Liab", 140, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,134,"L.T. Liab",132,3,50,12
    CONTROL ADD OPTION, hDlg2, 121, "Capital", 177, 15, 10, 14 , %BS_TOP '[, style&[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,135,"Capital",169,3,50,12
    CONTROL ADD OPTION, hDlg2, 122, "Income", 214, 15, 10, 14,%BS_TOP '[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,136,"Income",206,3,50,12
    CONTROL ADD OPTION, hDlg2, 123, "Expense", 251, 15, 10, 14 , %BS_TOP '[, exstyle&]] [CALL callbackfunction]
    CONTROL ADD LABEL, hDlg2,137,"Expense",243,3,50,12
    CONTROL ADD LISTBOX, hdlg2,138,descdisp$(),5,80,270,100,%LBS_USETABSTOPS OR %LBS_DISABLENOSCROLL
    CONTROL ENABLE hdlg2,126
    CONTROL SET FOCUS hdlg2,114
END SUB

SUB savenewacct(coid$)
 'save button pressed after radio button
 'selected and description entered
   DIM getind AS indexed
   DIM getcoa AS coatype

   fil1%=FREEFILE
   OPEN coid$+"\coa.ndx" FOR RANDOM AS #fil1% LEN=8
   fil2%=FREEFILE
   OPEN coid$+"\glcoa" FOR RANDOM AS #fil2% LEN=LEN(getcoa)
   NR&=LOF(fil1%)/8
   NR&=NR&+1
   getind.indxrec=MID$(nextacct$+SPACE$(6),1,6)+MKI$(NR&)
   dindex$(NR&)=MID$(nextacct$+SPACE$(6),1,6)+MKI$(NR&)
   PUT #fil1%,NR&,getind
   descdisp$(NR&-1)=CHR$(9)+CoaD$ 'for display in textbox
   getcoa.description=CoaD$
   getcoa.Accountkey=MID$(nextacct$+SPACE$(6),1,6)
   thecode$="R"+SPACE$(26)
   IF button_pushed%=117 OR button_pushed%=118 OR button_pushed%=123 THEN
      MID$(thecode$,1,1)="D"
   ELSE
      MID$(thecode$,1,1)="C"
   END IF
   MID$(thecode$,1,1)="2"
   IF button_pushed%>121 THEN
      MID$(thecode$,1,1)="X"
   ELSE
      MID$(thecode$,1,1)="0"
   END IF
   MID$(thecode$,1,1)="0"
   '*** specific code removed and existing code modified
   '*** for this example
   PUT #fil2%,NR&,getcoa
   CLOSE
sort_the_index:
'**** this is a relatively slow sort and array sort
'**** could be substituted or a Quik Sort routine
'**** but this will work fast enough for most
         pass% = 0
         AV% = Nr&: IF Nr& <> 2 THEN m% = AV% - 1 ELSE m% = Nr&
         'IF maxm% = 0 THEN maxm% = m%

3850     IF m% = 1 THEN m% = 0 ELSE m% = m% / 2
         IF m% = 0 THEN
            'LOCATE 12, 1
            GOTO 3955
         END IF
         j% = 1: KK% = AV% - m%
3900     I% = j%
3910     l% = I% + m%: IF DINDEX$(I%) < DINDEX$(l%) THEN GOTO 3940
         SWAP DINDEX$(I%), DINDEX$(l%):SWAP descdisp$(I%-1),descdisp$(l%-1): I% = I% - m%: upd_keys% = -1: rewrite% = -1
         IF I% > 0 THEN GOTO 3910
3940     j% = j% + 1: IF j% > KK% THEN GOTO 3850
         GOTO 3900
3955    IF rewrite% = -1 THEN
           OPEN coid$+"\coa.ndx" FOR RANDOM AS #fil1% LEN=8
           FOR rn&=1 TO NR&
               getind.indxrec=dindex$(rn&)
               PUT #fil1%,rn&,getind
           NEXT rn&
           CLOSE
        END IF
'*** kill the listbox then redisplay with new text
    CONTROL KILL hDlg2,138
    SLEEP 2
    CONTROL ADD LISTBOX, hdlg2,138,descdisp$(),5,80,270,100,%LBS_USETABSTOPS OR %LBS_DISABLENOSCROLL

END SUB