PC-Online 1998 February/PCOnline_02_1998.iso/filesbbs/dos/dbonlin2.exe/ORDER.ZIP/ORDER.PRG

Text File | 1995-02-09 | 12.5 KB | 569 lines

if .not. isansi() .and. .not. islocal()
  ? "We're sorry, but you must have ANSI to use this program."
  quit
endif

set exclusive off
set bell off
set escape off
set procedure to windows

discount=0

c=getenv("dbonline")
set path to &c

if len(trim(c)) > 0
  c=c+"DISCOUNT.LST"
  fd=fopen(c)
  if fd > 0
    do while .not. feof(fd)
      c=fgets(fd)
      i=at(c,',')
      if i>0
        u=left(c,i-1)
        d=val(substr(c,i+1))
      else
        u=left(c,i)
        d=0
      endif
      if c=username()
        exit
        discount=d
      endif
    enddo
    =fclose(fd)
  endif
endif

SHIP=0
CCNUM=space(19)
CCXMONTH=1
CCXYEAR=96
CCNAME=space(32)

declare prod(8),pric(8),qty(8)

x=1
do while x <8
  prod(x)=0
  pric(x)=0
  qty(x)=0
  x=x+1
enddo

*i=0
*do while i<8
*  x=str(i,1)
*  product&x=0
*  pric&x=0
*  qty&x=0
*  i=i+1
*enddo

select 1
use sales
select 2
use products
select 3
use customer

clear
ship=15
subtotal=0
xid=0

**************************
***select 1
***locate for invoice=invnum
***line=0
**gst=0
***do while found()
***  x=str(line,1)
***  product&x=sales->product
***  qty&x=1
***  line=line+1
***  subtotal=subtotal+sales->price
***  continue
***enddo
***gst=sales->gst
***ship=sales->ship_cost
****************************

do Xwindow with 0,0,21,78,""
do Xwindow with 22,0,24,78,""
if iscolor()
  set color to w+/w
endif
do Xcenter with 23,"dB Online - Order.db2            Copyright (c) 1995 Merlin Systems Inc."
do intwindow with 14,50,20,76,""
*if iscolor()
 set color to n/BG+
*endif
@ 15,52 say "   Subtotal"
@ 16,52 say "   Discount"
@ 17,52 say "   Shipping"
@ 18,51 say replicate("─",25)
@ 19,52 say "      Total"

do button with 15,5, "   ~Add an Item   "
*do button with 15,29," ~Remove an Item  "
*do button with 17,5, ' Shipping ~Method '
do button with 15,29,'      ~? Help     '
do button with 18,5, "   ~Save Order    "
do button with 18,29,'  ~Cancel Order   '

***set color to w+/bg
****wait
do drawStuff
do drawTotal

ok=.T.
do while ok

  k=0
  do while k = 0 .or. k>255
    k=inkey()
  enddo

  c=upper(chr(k))

  do case
    case c='A'
      x=maxproducts()
      if x < 8
        do flatWindow with 2,2,13,76
        @ 2,3 say " Description "
        @ 2,69 say " Price "
        xcont=0
        i=10
        do while i>9
          do drawProducts with 4,3,xcont
          i=1
          menu to i
          xcont=xcont+1
        enddo
        if i >0
          str=getans("Quantity or <esc> to cancel ?")
          q=val(str)
          if q>0
            x=maxproducts()
            if x<8
              select products
              locate for id = i
              if found() .and. products->display
                prod(x)=i+xcont*9-9
                qty(x)=q
                pric(x)=products->price
*                if discount > 0
*                  pric(x)=pric(x)*(100-discount)/100
*                endif
                subtotal=subtotal + products->price * qty(x)
                do drawTotal
              endif
            endif
          endif
        endif
        do drawstuff
        do drawOrder
      endif

    case c='C'
      c=getans("Are you sure (yes/no) ?")
      c=upper(left(c,1))
      if c='Y'
        ok=.F.
      else
        do drawstuff
        do draworder
      endif

    case c='S'
      if maxproducts() > 0
        ok=.F.
        do client
        do creditcard
        do saveorder
        set color to
        clear
        ? "Thank you for your order."
        ?
        ? "If you have any other questions please call us at 1-816-436-5206"
        ?
        wait
      endif

    case c='?'
      do flatWindow with 2,2,13,76
      @ 2,3 say " Help "
      @ 4,4 say "This is an example of a dB Online application.  The code was"
      @ 5,4 say "written in the xBASE language and will work with any other"
      @ 6,4 say "xBASE-compatible software.  It also saves all of its data into"
      @ 7,4 say "a dBASE file in real-time and that file can be accessed by any"
      @ 8,4 say "any other dBASE-compatible software."
      @ 10,4 say "NOTE: Shipping is 15.00 within the U.S., 25.00 outside."
      @ 12,4 say "Orders will be processed within 24 hours."
      read
      do drawstuff
      do drawOrder

*    case c='P'
*      do flatWindow with 2,2,13,76
*      x=1
*      do while x<7
*        @ 5+x,4 say ""
*        ?? prod(x), pric(x), qty(x)
*        x=x+1
*      enddo
*      read
*      do drawstuff
*      do drawOrder

  endcase
enddo
clear
clear all
return


function getans
  parameters string

  x=len(string)+12
  set color to GR+/R
  @ 11,40-x/2 to 13,40+x/2
  set color to W+/R
  @ 12,40-x/2+1 say space(x-1)
  @ 12,40-x/2+2 say string
  ans=space(5)
  @ 12,40+x/2-6 get ans
  read
return ans


function maxproducts
  x=0
  do while x<8
    if prod(x)=0
      exit
    endif
    x=x+1
  enddo
return x

procedure creditcard
*  if iscolor()
    set color to w+/n
*  endif
  clear
  do Xwindow with 4,10,21,70,"Credit Card Information"
  do intwindow with 8,35,10,62,""
  do intwindow with 11,35,13,39,""
  do intwindow with 11,41,13,45,""
  do intwindow with 14,35,16,67,""
*  do Xcenter with 6,"Credit Card Information"
*  if iscolor()
    set color to r/w
*  endif
  do Xcenter with 18,"We accept Visa, MasterCard & American Express"
  do Xcenter with 19,"Press <Esc> to cancel"
*  if iscolor()
    set color to gr+/w
*  endif
  @ 9,13  say "Credit Card #"
  @ 12,13 say "Expiration (MM YY)"
  @ 15,13 say "Card Holder's Name"

*  if iscolor()
    set color to w+/b,w+/bg
*  endif
  CCNUM=space(25)
  CCNAME=Username()
  if len(ccname)=0
    CCNAME=space(25)
  endif
  CCXYEAR=mod(year(date())+1,100)
  @ 9,36 get CCNUM
  @ 12,36 get CCXMONTH picture "999"
  @ 12,42 get CCXYEAR picture "999"
  @ 15,36 get CCNAME
  read
return


procedure drawProducts
  parameters x,y,cont

  line=0
  select products
  if cont = 0
    go top
  endif

  set color to w+/b,w/b,w/b

  do while .not. eof()
    if products->display

      @ line+y,x prompt products->name + space(5)+transform(products->price,"999.99") color g/n
      line=line+1
    endif
    skip
    if line>8
      @ line+y,x prompt "--- More Products ---"
      exit
    endif
  enddo
  if line <9
    set color to w/b
    do while line <10
      @ line+y,x say space(80-x*2)
      line=line+1
    enddo
  endif
return


procedure drawstuff
  do intwindow with 3,2,13,76," Description                                              Qty      Price "

  if iscolor()
    set color to n/w
  endif
  @ 2,2 say space(76)
  do Xcenter with 2,"Sound Advice Limited"
return


procedure drawTotal
*  if iscolor()
    set color to w+/BG
*  endif
  @ 15,67 say transform(subtotal,"9999.99")
  @ 16,72 say transform(discount,"99")+"%"
  x=maxproducts()
  if x>0
    x=x-1
  endif
  @ 17,67 say transform(ship*x,"9999.99")
  @ 19,66 say transform(ship*x+subtotal*((100-discount)/100),"99999.99")
return


procedure drawOrder
  i=1
*  if iscolor()
    set color to W+/BG
*  endif
  do while i<8
    select 2
    if prod(i) = 0
      @ i+4,3 say space(73)
    else
      locate for products->id=prod(i)
      @ i+4,4 say products->name
      @ i+4,69 say transform(pric(i),"999.99")
      @ i+4,60 say transform(qty(i),"999")
    endif
    i=i+1
  enddo
return


procedure client
  set color to w+/n
  clear
  ? "Searching..."
  select customer
  xuser=trim(upper(username()))
  locate for trim(upper(contact))=xuser .or. upper(trim(company))=xuser .or. upper(trim(bbsid))=xuser
  if found() .and. len(trim(username())) > 0
    xid=cust
    x_company=company
    x_address1=address1
    x_address2=address2
    x_city=city
    x_post_code=post_code
    x_country=country
    x_contact=contact
    x_phone=phone
    x_fax=fax
    x_data=data
    x_internet=internet
    x_fido=fidonet
  else
    x_company=space(60)
    x_address1=space(30)
    x_address2=space(23)
    x_city=left(city()+space(24),24)
    x_post_code=space(12)
    x_country=space(24)
    x_contact=left(username()+space(23),23)
    x_phone=left(voicephone()+space(16),16)
    x_fax=space(16)
    x_data=left(dataphone()+space(16),16)
    x_internet=space(30)
    x_fido=space(15)
  endif

  c='N'
  clear
  do Xwindow with 0,0,17,78,""
  do intwindow with 3,24,16,76,""
*  if iscolor()
    set color to w+/w
*  endif
  do Xcenter with 2,"Customer Information"
*  if iscolor()
    set color to gr+/w
*  endif
  @  4,4 say "      Company Name"
  @  5,4 say "           Address"
  @  7,2 say "City, Province/State"
  @  8,4 say "   Postal/Zip Code"
  @  9,4 say "           Country"
  @ 10,4 say "           Contact"
  @ 11,4 say "      Phone Number"
  @ 12,4 say "        Fax Number"
  @ 13,4 say "        BBS Number"
  @ 14,4 say "  Internet Address"
  @ 15,4 say "   FidoNet Address"
  do while c='N'
*    if iscolor()
      set color to w+/b,w+/bg
*    endif
    @  4,25 get x_company picture "@S51"
    @  5,25 get x_address1 picture "@S30"
    @  6,25 get x_address2 picture "@S23"
    @  7,25 get x_city picture "@S24"
    @  8,25 get x_post_code picture "@S12"
    @  9,25 get x_country picture "@S24"
    @ 10,25 get x_contact picture "@S23"
    @ 11,25 get x_phone picture "@S16"
    @ 12,25 get x_fax picture "@S16"
    @ 13,25 get x_data picture "@S16"
    @ 14,25 get x_internet picture "@S30"
    @ 15,25 get x_fido picture "@S15"
    read

    if (len(trim(x_company))=0)
      do Xwindow with 18,10,22,70,""
      set color to R*/w
      @ 20,26 say "You must specify a Company Name!"
      read
      set color to w+/n
      @ 18,10 clear to  22,70
      loop
    endif

    if (len(trim(x_country))=0)
      do Xwindow with 18,10,22,70,""
      set color to R*/w
      @ 20,28 say "You must specify a Country!"
      read
      set color to w+/n
      @ 18,10 clear to  22,70
      loop
    endif

*    if iscolor()
      set color to w+/bg
*    endif
    @  4,25 say x_company picture "@S51"
    @  5,25 say x_address1 picture "@S30"
    @  6,25 say x_address2 picture "@S23"
    @  7,25 say x_city picture "@S24"
    @  8,25 say x_post_code picture "@S12"
    @  9,25 say x_country picture "@S24"
    @ 10,25 say x_contact picture "@S23"
    @ 11,25 say x_phone picture "@S16"
    @ 12,25 say x_fax picture "@S16"
    @ 13,25 say x_data picture "@S16"
    @ 14,25 say x_internet picture "@S30"
    @ 15,25 say x_fido picture "@S15"

    do Xwindow with 18,10,22,70,""
*    if iscolor()
      set color to w+/w
*    endif
    @ 20,25 say "Is the above information correct? "
*    if iscolor()
      set color to gr+/w
*    endif
    i=0
    do while i=0
      i=inkey()
      c=upper(chr(i))
      if c <> 'Y' .and. c <> 'N'
        i=0
      endif
    enddo
    if c='Y'
      ?? "Yes"
    else
*      if iscolor()
        set color to w+/n
*      endif
      @ 18,10 clear to 22,70
    endif
  enddo
return


procedure saveorder
  do Xwindow with 18,10,22,70,""
  set color to w+/w
  @ 20,25 say "Would you like to save this order? "
  set color to gr+/w
  i=0
  do while i=0
    i=inkey()
    c=upper(chr(i))
    if c <> 'Y' .and. c <> 'N'
      i=0
    endif
  enddo
  if c='Y'
    if xid=0
      select customer
      xid=maxcust()

      append blank
      replace company with x_company, address1 with x_address1
      replace address2 with x_address2, city with x_city, post_code with x_post_code
      replace country with x_country, contact with x_contact, phone with x_phone
      replace fax with x_fax, data with x_data, internet with x_internet
      replace fidonet with x_fido, cust with xid
    endif

    select sales
    x=1
    do while x < 8 .and. prod(x) >0
      append blank
      replace id with xid, product with prod(x), date with date()
      replace price with pric(x)
      replace credit_num with ccnum+' '+transform(ccxmonth,'99')+'/'+transform(ccxyear,'99')+' '+ccname
      replace seed with 0, endofsupp with date()+90
      if upper(x_country) ='U.S.A.' or upper(x_country) = 'USA' or upper(x_country) ="US" or upper(x_country) = 'U.S.' or len(x_country)=0
         replace ship_cost with 15.0, ship_type with "US"
      else
         replace ship_cost with 25.0, ship_type with "Intl"
      endif
      x=x+1
    enddo
  endif
return

function maxcust
  x=0
  go top
  do while .not. eof()
    if x < cust
      x=cust
    endif
    skip
  enddo
return x+1