Reusable Part VL_SAM106 : Currency Converter

LANSA

Reusable Part VL_SAM106 : Currency Converter
Name: VL_SAM106

Description: The following RDMLX component is a currency coverter that uses a list view to show a list of currencies that the user can choose from.

Note: This function will require you to check for the following icons in your repository (VL_FLGAUS, VL_FLGUSA, VL_FLGFRA, VL_FLGNZ). If they do not exist you will need to add the icons for the flags yourself.
***************************************************;
* ;
* NOTE:;
* This component will ABORT if it does not find a conversion;
* factor from one currency to another. ;
* ;
***************************************************;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM DISPLAYPOSITION(1) HEIGHT(40) LEFT(0) TABPOSITION(1) TOP(0) WIDTH(221);
DEFINE_COM CLASS(#S_104VAL.Visual) NAME(#S_104VAL) CAPTION('This is the caption') DISPLAYALIGNMENT(Right) DISPLAYPOSITION(1) EDITALIGNMENT(Right) HEIGHT(40) LABELPOSITION(Top) LABELTYPE(Caption) LEFT(0) MARGINLEFT(0) MARGINTOP(20) PARENT(#COM_OWNER) TABPOSITION(1) TOP(0) WIDTH(145);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#CURRBOX) AUTOARRANGE(False) COLUMNHEADERS(False) DISPLAYPOSITION(2) HEIGHT(20) LEFT(144) PARENT(#COM_OWNER) SELECTIONSTYLE(Single) TABPOSITION(2) TOP(20) WIDTH(73);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) DISPLAYPOSITION(1) PARENT(#CURRBOX) SORTPOSITION(2) SOURCE(#S_104CCDE) WIDTH(10) WIDTHTYPE(Characters);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) PARENT(#CURRBOX) SORTDIRECTION(Descending) SORTPOSITION(1) SOURCE(#S_104DFTC) VISIBLE(False) WIDTH(20);
;
* ----------------------------------------------------------------------------------------------------------;
* Define the properties of the Euro Currency RVP;
DEFINE_PTY Name(ShowCurrCode) set(SetShowCurr);
DEFINE_PTY Name(Caption) set(SetCaption);
DEFINE_PTY Name(RateType) Set(*auto #std_alpha) Get(*auto #std_alpha);
DEFINE_PTY Name(CurrentValue) Set(*auto #S_104val) Get(*auto #S_104val);
DEFINE_PTY Name(Currency) Set(SetCurrency) Get(*auto #S_104ccde);
;
* ------------------------------------------------------------------------------------------------------------;
* Define some temporary fields for this RVP;
DEFINE FIELD(#CURRENT) TYPE(*CHAR) LENGTH(3) DESC('Current Currency');
DEFINE FIELD(#REVERSE) TYPE(*DEC) LENGTH(1) DECIMALS(0);
DEFINE FIELD(#FROMCURR) REFFLD(#S_104FRCC);
DEFINE FIELD(#TOCURR) REFFLD(#S_104TOCC);
DEFINE FIELD(#BUYRATE) REFFLD(#S_104CBR);
DEFINE FIELD(#SELLRATE) REFFLD(#S_104CSR);
DEFINE FIELD(#REV) REFFLD(#REVERSE);
DEFINE FIELD(#TYPE) REFFLD(#S_104TYPE);
DEFINE FIELD(#PASSCUR) REFFLD(#S_104CCUR);
DEFINE FIELD(#TEMP) REFFLD(#S_104CCUR);
DEFINE FIELD(#RATE) REFFLD(#S_104CBR);
;
*;
* ShowCurrCode Property;
* This property will indicate whether to show the combobox as part of the visual component.;
*;
PTYROUTINE SetShowCurr;
DEFINE_MAP *input class(#std_alpha) name(#showcurr);
;
IF COND('#showcurr *EQ ''Y''');
Set #currbox visible(True);
else;
Set #currbox visible(False);
endif;
ENDROUTINE;
;
*;
* Caption;
* This property will set the caption of the field;
*;
PTYROUTINE SetCaption;
DEFINE_MAP *input class(#std_text) name(#eurocaption);
Set #S_104VAL Caption(#eurocaption);
ENDROUTINE;
;
*;
* Currency;
* This property will set the currency of the field;
*;
PTYROUTINE SetCurrency;
DEFINE_MAP *input class(#S_104CCDE) name(#CurCode);
;
SELECTLIST #CURRBOX;
IF '#S_104CCDE *EQ #CURCODE';
Set #CurrBox.CurrentItem Focus(True);
ENDIF;
ENDSELECT;
;
CHANGE #S_104CCDE #CURCODE;
EXECUTE SUBROUTINE(CHGCURR);
ENDROUTINE;
;
;
*;
* Initialise the Reusable Part;
*;
EVTROUTINE HANDLING(#COM_OWNER.Initialize) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
;
* Clear the list of currencies;
CLR_LIST #CURRBOX;
;
* Load all the possible currencies;
SELECT FIELDS(#S_104CCDE #S_104DFTC) FROM_FILE(S_104CUR);
Add_Entry #CURRBOX;
;
* Set the images;
IF COND('#S_104CCDE *EQ ''USD''');
Set #CURRBOX.CurrentItem Image(#VL_FLGUSA);
ELSE;
IF COND('#S_104CCDE *EQ ''AUD''');
Set #CURRBOX.CurrentItem Image(#VL_FLGAUS);
ELSE;
IF COND('#S_104CCDE *EQ ''NZD''');
Set #CURRBOX.CurrentItem Image(#VL_FLGNZ);
ELSE;
IF COND('#S_104CCDE *EQ ''FFR''');
Set #CURRBOX.CurrentItem Image(#VL_FLGFRA);
ENDIF;
ENDIF;
ENDIF;
ENDIF;
ENDSELECT;
;
* Set the default currency;
Get_Entry NUMBER(1) FROM_LIST(#CURRBOX);
Set #CURRBOX.CurrentItem Focus(True);
Change #current #S_104ccde;
;
* Use the buying rate by default;
CHANGE #std_alpha 'B';
ENDROUTINE;
;
*;
* Handling the change of values of a drop down list (ie We are changing currencies);
*;
EVTROUTINE HANDLING(#CURRBOX.ItemGotFocus) OPTIONS(*NOCLEARMESSAGES *NOCLEARERRORS);
EXECUTE SUBROUTINE(CHGCURR);
ENDROUTINE;
;
*;
* Change Currencies;
*;
SUBROUTINE NAME(CHGCURR);
* If the two codes are the same we don't have to do a thing;
IF COND('#CURRENT *EQ #S_104CCDE');
RETURN;
ENDIF;
;
* Fetch the conversion factor;
EXECUTE SUBROUTINE(FINDRATE) WITH_PARMS(#CURRENT #S_104CCDE #S_104CBR #S_104CSR #S_104TYPE #REVERSE #S_104CCUR);
;
* Is this a direct conversion or do we have to go through another currency;
IF COND('#S_104TYPE *EQ ''D''');
EXECUTE SUBROUTINE(USERATE) WITH_PARMS(#S_104CBR #S_104CSR #RATE);
* Change the value of the currency;
IF '#reverse *EQ 0';
CHANGE #S_104val '#S_104val * #rate';
else;
* Do we need to reverse the conversion?;
CHANGE #S_104val '#S_104val / #rate';
endif;
ELSE;
* We have to go through another currency;
* Fetch the conversion factor for the passthrough currency;
CHANGE #TEMP #S_104CCUR;
EXECUTE SUBROUTINE(FINDRATE) WITH_PARMS(#CURRENT #S_104CCUR #S_104CBR #S_104CSR #S_104TYPE #REVERSE #S_104CCUR);
EXECUTE SUBROUTINE(USERATE) WITH_PARMS(#S_104CBR #S_104CSR #RATE);
* Do the conversion for the passthrough currency;
IF '#reverse *EQ 0';
CHANGE #S_104val '#S_104val * #rate';
else;
* Do we need to reverse the conversion?;
CHANGE #S_104val '#S_104val / #rate';
endif;
;
* Fetch the conversion factor for the final currency;
EXECUTE SUBROUTINE(FINDRATE) WITH_PARMS(#TEMP #S_104CCDE #S_104CBR #S_104CSR #S_104TYPE #REVERSE #S_104CCUR);
EXECUTE SUBROUTINE(USERATE) WITH_PARMS(#S_104CBR #S_104CSR #RATE);
* Do the conversion for the final currency;
IF '#reverse *EQ 0';
CHANGE #S_104val '#S_104val * #rate';
else;
* Do we need to reverse the conversion?;
CHANGE #S_104val '#S_104val / #rate';
endif;
ENDIF;
;
* Set the new current currency;
CHANGE #current #S_104ccde;
ENDROUTINE;
;
*;
* Determine the Exchange rate between two currencies;
*;
SUBROUTINE NAME(FINDRATE) PARMS((#FROMCURR *RECEIVED) (#TOCURR *RECEIVED) (#BUYRATE *RETURNED) (#SELLRATE *RETURNED) (#TYPE *RETURNED) (#REV *RETURNED) (#PASSCUR *RETURNED));
* Set up a default conversion rate of 1 incase anything goes wrong nothing will change;
CHANGE #S_104cbr 1;
CHANGE #rev 0;
;
* Fetch the conversion factor;
CHANGE #S_104frcc #fromcurr;
CHANGE #S_104tocc #tocurr;
FETCH FIELDS(#S_104CBR #S_104CSR #S_104TYPE #S_104CCUR) FROM_FILE(S_104CNV) WITH_KEY(#S_104FRCC #S_104TOCC);
IF_STATUS IS_NOT(*OKAY);
* We did not find a value so error swap the to and from currency and try again;
CHANGE #S_104frcc #tocurr;
CHANGE #S_104tocc #fromcurr;
CHANGE #rev 1;
FETCH FIELDS(#S_104CBR #S_104CSR #S_104TYPE #S_104CCUR) FROM_FILE(S_104CNV) WITH_KEY(#S_104FRCC #S_104TOCC);
IF_STATUS IS_NOT(*OKAY);
ABORT MSGTXT('Unable to find conversion factor');
ENDIF;
ENDIF;
;
* Set the fields to be returned;
CHANGE #buyrate #S_104cbr;
CHANGE #sellrate #S_104csr;
CHANGE #type #S_104type;
CHANGE #passcur #S_104ccur;
ENDROUTINE;
;
*;
* Which rate are we using, buying or selling?;
*;
SUBROUTINE NAME(USERATE) PARMS((#BUYRATE *RECEIVED) (#SELLRATE *RECEIVED) (#RATE *RETURNED));
* Are we using the Buying or Selling Factor?;
IF COND('#STD_ALPHA *EQ ''B''');
* We are using the Buying Rate;
change #rate #buyrate;
ELSE;
* We are using the Selling Rate;
change #rate #sellrate;
ENDIF;
ENDROUTINE;
;
*;
* Add an amount;
*;
MTHROUTINE NAME(AddAmount);
DEFINE_MAP FOR(*INPUT) CLASS(#S_104VAL) Name(#ADDAMT);
DEFINE_MAP FOR(*INPUT) CLASS(#S_104CCDE) Name(#ADDCUR);
;
* First check - Is it the same currency????;
IF '#ADDCUR *EQ #S_104CCDE';
* Using the same currency so just add the number and we are done;
CHANGE #S_104VAL '#S_104VAL + #ADDAMT';
else;
Message 'Not the same currency';
ENDIF;
ENDROUTINE;
;
*;
* Subtract an amount ;
*;
MTHROUTINE NAME(SubAmount);
DEFINE_MAP FOR(*INPUT) CLASS(#S_104VAL) Name(#ADDAMT);
DEFINE_MAP FOR(*INPUT) CLASS(#S_104CCDE) Name(#ADDCUR);
;
* First check - Is it the same currency????;
IF '#ADDCUR *EQ #S_104CCDE';
* Using the same currency so just add the number and we are done;
CHANGE #S_104VAL '#S_104VAL - #ADDAMT';
else;
Message 'Not the same currency';
ENDIF;
ENDROUTINE;
;
;
*;
* Will change the field back to the default currency;
*;
MTHROUTINE NAME(GoDefault);
SELECTLIST #CURRBOX;
IF COND('#S_104DFTC *EQ 1');
CHANGE #TEMP #S_104CCDE;
Set #CurrBox.CurrentItem Focus(True);
ENDIF;
ENDSELECT;
;
CHANGE #S_104CCDE #TEMP;
EXECUTE SUBROUTINE(CHGCURR);
ENDROUTINE;
END_COM;