Skip to content

Reference ·Clipper

Application Payment

Sometimes, my applications are paid in several payment terms. Therefore I make a module to easier my application payment's handling.

Archive gap. Four dColBase():new( "…", … ) calls in the sample below lost their { || … } codeblock argument before this page was archived. The surrounding code is intact and the pattern is dColBase():new( "Label", { || expression } ) — see TEST.PRG in dTBx — but the original expressions are not recoverable, so they have been left as the archive holds them rather than guessed at.

Sometimes, my applications are paid in several payment terms. Therefore I make a module to easier my application payment’s handling. In dPay.prg, I do the following:

  • I create an initialization function, to determine the Payment Control file (*.pmt)
  • I create dPayCheck() function, which checks the application is fully-paid or not. It will stop the application if the current system date exceeds the application’s valid period (determined from dPayValidDate() function). It will warn the user if the current system date is within 14 days before the valid period expires.
  • I create dPayInfo() function, which displays the project’s value, total realized payment, and expired date
  • I create dPayValue() function, which determines the project’s value depending on its clients
  • I create dPayLastDate() function, which determines the date when the last payment was made
  • I create dPayAmount() function, which calculates the total payment have been made/received
  • I create dPayBrowse() function, which provides a modifiable payment browser. The amount entered will be saved in encrypted format

Here is the source code of dPay.prg:

 
/*----------------------------------------------------------------------------+
�                                                                             �
�   Projects: dRIP � dBMaster Receivable - Inventory - Payable                �
�   Designer: Hianoto Santoso                                                 �
�   Author  : Hianoto Santoso                                                 �
�   Language: CA-Clipper 5.2x                                                 �
�                                                                             �
�   Function: dPayCheck()                                                     �
�   Purpose : Check the payment of the software                               �
�                                                                             �
�   History :                                                                 �
�    - 27-Dec-97...Write dPayCheck()                                          �
�                                                                             �
�   Copyright (C) 1992-98, dBMaster Software Development.                     �
�                                                                             �
+----------------------------------------------------------------------------*/
 
#include "App.ch"
 
static sFileName
 
 
 
 
init function getFileName()
 
 
  sFileName := strTran( dExeName(), ".EXE", ".PMT" )
return nil
 
 
 
 
function dPayCheck()
 
 
  if dPayAmount() < dPayValue()
 
     if date() > dPayValidDate()
        dBeep()
        dAlert( "Error: Please check your payment to Administrator !!;Program could not be continued." )
        exitSys()
     endif
 
     if date() == dPayValidDate()
        dBeep()
        dAlert( "Warning: Today is your last chance to pay !!;Please contact your Administrator immediately." )
     endif
 
     if date() >= dPayValidDate() - 14
        dBeep()
        dAlert( "Warning: You have " + allTrim( str( dPayValidDate() - date() ) ) + " day(s) to complete the payment !!;Please contact your Administrator immediately." )
     endif
 
  endif
return nil
 
 
 
 
function dPayInfo()
  local pictAmount := numPicture( 8, 0 )
 
 
  dAlert( "Software Value: Rp. " + transform( dPayValue(),  pictAmount ) + ",-;" + ;
          "  Already Paid: Rp. " + transform( dPayAmount(), pictAmount ) + ",-;" + ;
          "  Expired Date: " + d2c( dPayValidDate() ) + "        " )
return nil
 
 
 
 
function dPayValue()
  local nValue
 
 
  if isDemo()
     nValue := 0
  elseif isDeptStore()
     nValue := 15000000
  elseif isKaca()
     nValue := 15000000
  elseif isSparepart()
     nValue := 15000000
  endif
return nValue
 
 
 
 
function dPayValidDate()
return dAddMonth( dPayLastDate(), 6 )
 
 
 
 
function dPayLastDate()
  local dDate   := dInfoLinkDate()
  local sSelect := select()
 
 
  if file( sFileName )
     dNetUse( sFileName, TRUE, "Pay" )
     Pay->( dbGoTop() )
     do while ! Pay->( eof() )
        dDate := max( dDate, Pay->payTgl )
        Pay->( dbSkip() )
     enddo
     close Pay
  endif
 
  select ( sSelect )
return dDate
 
 
 
 
function dPayAmount()
  local nAmount := 0
  local sSelect := select()
 
 
  if file( sFileName )
     dNetUse( sFileName, TRUE, "Pay" )
     Pay->( dbGoTop() )
     do while ! Pay->( eof() )
        nAmount += val( crypt( Pay->payAmount, isWho() ) )
        Pay->( dbSkip() )
     enddo
     close Pay
  endif
 
  select ( sSelect )
return nAmount
 
 
 
 
function dPayBrowse()
  local oTB
  local pictAmount := "@Z " + numPicture( 8, 0 )
  local sColor     := setColor( "W+/RB, W+/N,,, W/N" )
  local sSelect    := select()
 
 
  if ! file( sFileName )
     dbCreate( sFileName, ,                    ;
        ,                    ;
         } )
  endif
 
  dNetUse( sFileName, TRUE, "Pay" )
 
  oTB := dTblDBF():new( 4, 16, dMaxRow()-3, maxCol()-17 )
  oTB:setWndCoords( 3, 15, dMaxRow()-2, maxCol()-16 )
  oTB:initDataSource()
 
  oTB:addColumn( dColBase():new( "Date",    ) )
  oTB:addColumn( dColBase():new( "Notes",   ) )
  oTB:addColumn( dColBase():new( "Amount",  ) )
 
  oTB:getColumn( 1 ):getPicture := "99-99-99"
  oTB:getColumn( 1 ):getValid   :=   oTB:getColumn( 1 ):getSave    :=   oTB:getColumn( 2 ):getPicture := "@K!"
  oTB:getColumn( 2 ):getSave    :=   oTB:getColumn( 3 ):getPicture := pictAmount
  oTB:getColumn( 3 ):getSave    := 
  oTB:readModal()
 
  close Pay
 
 
  // Restore environment
  select ( sSelect )
  setColor( sColor )
return nil