Deck "A2KDeck" Routine "Get_FONT.PREFS" Local READFILE="ENV:sys/font.prefs",X=0,SizeVar="",FontVar="" If EXISTS(READFILE)=TRUE IfError Let SysDefText="topaz",SysDefTextSize=8 Else If FileSize(READFILE)>"" GetFileInfo READFILE,FILECNT SetFileBufferSize Limit(1,1024,Integer(FILECNT%1024)) OpenFile READFILE,"WORKFILE",READONLY ,OLDFILE FileReadChars "WORKFILE",X,223 FileReadChars "WORKFILE",SizeVar,1,HEX FileReadChars "WORKFILE",X,2 FileReadChars "WORKFILE",FontVar,30 Let SysDefTextSize=HexToInteger(SizeVar) Let SysDefText=GetWord(FontVar,1,".") Close "WORKFILE" Else Let SysDefText="topaz",SysDefTextSize=8 EndIf EndIf Else Let SysDefText="topaz",SysDefTextSize=8 EndIf GetFontInfo SCREEN ,ScreenText,ScreenTextSize Let GOS=ScreenTextSize+3 EndScript Routine "Get_PUBSCREEN.PREFS" Loop CNT,1,10 If NOT PUBSCREENEXISTS("A2K_PubScreen."||CNT) ExitLoop EndIf EndLoop Let PROG.PUBSCRTITLE="A2K_PubScreen."||CNT EndScript Routine "Set_PROG.VARS" Let PROG.SCRTITLE=DECKNAME|||"Version 1.0"|||"(14-Dec-00)"|||" "|||"Public Screen"||":"|||Char(34)||PROG.PUBSCRTITLE||Char(34) Let PROG.SCRTITLE=PROG.SCRTITLE|||" "|||GetWord(THEDATE,2,"/")||"-"||GetWord(THEDATE,1,"/")||"-"||GetWord(THEDATE,3,"/") Let CAT.Day[1]="Saturday",CAT.Day[2]="Sunday",CAT.Day[3]="Monday",CAT.Day[4]="Tuesday" Let CAT.Day[5]="Wednesday",CAT.Day[6]="Thursday",CAT.Day[7]="Friday" Let CAT.Month[1]="January",CAT.Month[2]="February",CAT.Month[3]="March",CAT.Month[4]="April" Let CAT.Month[5]="May",CAT.Month[6]="June",CAT.Month[7]="July",CAT.Month[8]="August" Let CAT.Month[9]="September",CAT.Month[10]="October",CAT.Month[11]="November",CAT.Month[12]="December" EndScript Routine "Get Date" Do "Set_PROG.VARS" Let D=GetWord(TheDate,2,"/") Let M=GetWord(TheDate,1,"/") Let Y=GetWord(TheDate,3,"/") Let DATE.DayInteger=Limit(1,31,D) Let DATE.MonthInteger=Limit(1,12,M) Let DATE.YearCentury=Y,DATE.YearDecade=Y,DATE.YearInteger=Y Let T=365*DATE.YearInteger+DATE.DayInteger+31*(DATE.MonthInteger-1) Let N=DATE.YearInteger-1 If DATE.MonthInteger>3 Let N=DATE.YearInteger Let T=T-(4*DATE.MonthInteger+23)%10 EndIf Let T=T+N%4-(N%100+1)*3%4 Let DATE.WeekDayInteger=T MOD 7+1 Let DATE.DayString=CAT.Day[DATE.WeekDayInteger] Let DATE.MonthString=CAT.Month[DATE.MonthInteger] Let SS=GetChars(DATE.DayString,1,3) Let MM=GetChars(DATE.MonthString,1,3) Let YY=GetChars(DATE.YearCentury,1,4) Let Today=SS||" "||MM||" "||"20"||YY EndScript Routine "MakeName" If Name<>"" If Number<>0 Let NameKey=CharsToHex(Name||Char(10)||Number||Char(10)||HexToChars("545247")) SaveVariable NameKey,"S:A2K.key" Do "KeyFile" SaveVariable ©2000,"S:A2K.key" Do "KeyFile" Let PROG.PUBSCRTITLE="WORKBENCH" AttachObject "PrefsWindow" SetObjectState "PrefsWindow",ON DetachObject "Welcome" EndIf EndIf EndScript Routine "KeyFile" Let ©1994=HexToChars("533A41324B2E6B6579") If EXISTS(©1994) Let FCnt=1 If FILETYPE(©1994)=HexToChars("43445652") IfError Else Let ©1995=LoadVariable(©1994) Let ©1996=HexToChars(©1995) Let ©1997=NumberOfChars(©1996),©1998=0,©1999="",©1990="" Loop Let ©1998=©1998+1 Let ©1999=Char(Absolute(ASCII(Getchars(©1996,©1998,1))-255)) Let ©2000=©2000||CharsToHex(©1999) Let ©1990=©1990||©1999 Until ©1998=©1997 Let ®2001=GetWord(©1990,1,Char(10)),®2002=GetWord(©1990,2,Char(10)),®2003=GetWord(©1990,3,Char(10)) EndIf EndIf EndIf EndScript Routine "Quit" If Exists("Ram:A2KData") ;Dos "C:Delete Ram:A2KData all" EndIf ;Dos "C:Delete Ram:A2K.Prefs" ;Dos "C:Delete Ram:A2K.Tax" Dos "C:Assign A2K: " FlushAll Quit EndScript Routine "Set Prefs" Let A2KPrefs.Date=DefDate Let A2KPrefs.Note=DefNote Let A2KPrefs.DistDir=DefDistDir Let A2KPrefs.DataDir=DefDataDir Let A2KPrefs.OrdDir=DefOrdDir Let A2KPrefs.CustDir=DefCustDir Let A2KPrefs.PenA=DefPenA Let A2KPrefs.PenB=DefPenB Let A2KPrefs.PenC=DefPenC Let A2KPrefs.BGPic=DefBGPic Let A2KPrefs.TBGPic=DefTBGPic Let A2KPrefs.DBGPic=DefDBGPic Let A2KPrefs.OBGPic=DefOBGPic Let A2KPrefs.CBGPic=DefCBGPic Let A2KPrefs.PBGPic=DefPBGPic Let A2KPrefs.PalDir=DefPalDir Let A2KPrefs.Palette=DefPalBuf Let A2KPrefs.DefPrefsWinX=DefPrefsWinX Let A2KPrefs.DefPrefsWiny=DefPrefsWinY Let A2KPrefs.DefTaxWinX=DefTaxWinX Let A2KPrefs.DefTaxWiny=DefTaxWiny Let A2KPrefs.DefListWinX=DefListWinX Let A2KPrefs.DefListWiny=DefListWiny Let A2KPrefs.DefStockWinX=DefStockWinX Let A2KPrefs.DefStockWiny=DefStockWiny EndScript Routine "Set Def" Let DefDate=A2KPrefs.Date Let DefNote=A2KPrefs.Note Let DefDistDir=A2KPrefs.DistDir Let DefDataDir=A2KPrefs.DataDir Let DefOrdDir=A2KPrefs.OrdDir Let DefCustDir=A2KPrefs.CustDir Let DefBGPic=A2KPrefs.BGPic Let DefTBGPic=A2KPrefs.TBGPic Let DefDBGPic=A2KPrefs.DBGPic Let DefOBGPic=A2KPrefs.OBGPic Let DefCBGPic=A2KPrefs.CBGPic Let DefPBGPic=A2KPrefs.PBGPic Let DefPenA=A2KPrefs.PenA Let DefPenB=A2KPrefs.PenB Let DefPenC=A2KPrefs.PenC Let DefPalBuf=A2KPrefs.Palette Let DefPalDir=A2KPrefs.PalDir Let DefPrefsWinX=A2KPrefs.DefPrefsWinX Let DefPrefsWinY=A2KPrefs.DefPrefsWinY Let DefTaxWinX=A2KPrefs.DefTaxWinX Let DefTaxWinY=A2KPrefs.DefTaxWinY Let DefListWinX=A2KPrefs.DefListWinX Let DefListWiny=A2KPrefs.DefListWiny Let DefStockWinX=A2KPrefs.DefStockWinX Let DefStockWiny=A2KPrefs.DefStockWiny EndScript Routine "Make Def" Let N=0,DefNote="$",DefDate="DMY" Do "Make Ram Dir" Do "Make Sys Dir" Let DefDistDir="A2K:A2KData/DistData",DefDataDir="A2K:A2KData/StockData" Let DefOrdDir="A2K:A2KData/OrderData",DefCustDir="A2K:A2KData/CustData" Let DefPenA=1,DefPenB=2,DefPenC=3 If Exists("A2K:BGPics/Default.bg") Let DefBGPic="A2K:BGPics/Default.bg" Let DefTBGPic="A2K:BGPics/Default.bg" Let DefDBGPic="A2K:BGPics/Default.bg" Let DefOBGPic="A2K:BGPics/Default.bg" Let DefCBGPic="A2K:BGPics/Default.bg" Let DefPBGPic="A2K:BGPics/Default.bg" Else Let DefBGPic="" Let DefTBGPic="" Let DefDBGPic="" Let DefOBGPic="" Let DefCBGPic="" Let DefPBGPic="" EndIf If Exists("A2K:Palette") Let DefPalBuf="Palette",DefPalDir="A2K:Palette" LoadPalette "Palette",DefPalBuf,ASNEEDED Else ClipBrush 10,20,40,40,"PaletteBrush" SaveBrush "PaletteBrush","A2K:Palette" Let DefPalBuf="Palette",DefPalDir="A2K:Palette" LoadPalette "Palette",DefPalBuf,ASNEEDED EndIf Let DefPrefsWinX=0 Let DefPrefsWiny=0 Let DefTaxWinX=0 Let DefTaxWiny=0 Let DefListWinX=0 Let DefListWiny=0 Let DefStockWinX=0 Let DefStockWiny=0 EndScript Routine "Make Ram Dir" If Not Exists("Ram:A2KData") Dos "C:MakeDir Ram:A2KData" EndIf If Not Exists("Ram:A2KData/DistData") Dos "C:MakeDir Ram:A2KData/DistData" EndIf If Not Exists("Ram:A2KData/StockData") Dos "C:MakeDir Ram:A2KData/StockData" EndIf If Not Exists("Ram:A2KData/OrderData") Dos "C:MakeDir Ram:A2KData/OrderData" EndIf If Not Exists("Ram:A2KData/CustData") Dos "C:MakeDir Ram:A2KData/CustData" EndIf If Not Exists("Ram:A2KData/PrintData") Dos "C:MakeDir Ram:A2KData/PrintData" EndIf EndScript Routine "Make Sys Dir" If Not Exists("A2K:A2KData") Dos "C:MakeDir A2K:A2KData" EndIf If Not Exists("A2K:A2KData/DistData") Dos "C:MakeDir A2K:A2KData/DistData" ElseIf Exists("A2K:A2KData/DistData/Dist.Data") Dos "C:Copy A2K:A2KData/StockData/Dist.Data Ram:A2KData/DistData" EndIf If Not Exists("A2K:A2KData/StockData") Dos "C:MakeDir A2K:A2KData/StockData" ElseIf Exists("A2K:A2KData/StockData/Stock.Data") Dos "C:Copy A2K:A2KData/StockData/Stock.Data Ram:A2KData/StockData" EndIf If Not Exists("A2K:A2KData/OrderData") Dos "C:MakeDir A2K:A2KData/OrderData" ElseIf Exists("A2K:A2KData/OrderData/Order.Data") Dos "C:Copy A2K:A2KData/OrederData/Order.Data Ram:A2KData/OrderData" EndIf If Not Exists("A2K:A2KData/CustData") Dos "C:MakeDir A2K:A2KData/CustData" ElseIf Exists("A2K:A2KData/CustData/Cust.Data") Dos "C:Copy A2K:A2KData/CustData/Cust.Data Ram:A2KData/CustData" EndIf If Exists("A2K:A2KData/A2K.tax") Dos "C:Copy A2K:A2KData/A2K.tax Ram:A2KData" EndIf EndScript Routine "FileType ErrorCheck" Let ER="You Have A Problem",ERD="This Means that You are using the wrong type of Data file." Let TempFileName=FileName If MATCH(FILETYPE(TempFileName),"CDVR") Let TempFile=LoadVariable(TempFileName) EndIf If MATCH(FILETYPE(TempFileName),"Picture","Brush") LoadPalette TempFileName,"DefPalBuf",ASNEEDED EndIf If MATCH(FILETYPE(TempFileName),"Unknown") Let ET=Errortext If ET="Invalid variable name" DisposeAll Do "Make Def" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.prefs" Else Let AFR=AskForResponse(ER||Char(10)||ET,"Error...") EndIf EndIf EndScript Routine "ShowBrush" Let WBL=WindowBorderLeft Let WBT=WindowBorderTop Let WW=WindowWidth Let WBR=WindowBorderRight Let WH=WindowHeight Let WBB=WindowBorderBottom ClearWindow ShowBrushEfx Arg1,WBL,WBT,"Tile",0.000,WW-WBR-WBL,WH-WBT-WBB IfError EndIf EndScript Routine "Click" SetDrawMode JAM1 SetPen 5 AreaRectangle Arg1,Arg2,Arg3,Arg4 DrawBorder Arg1,Arg2,Arg3,Arg4,BEVEL ,1,2 SetPrintFont "topaz",8 SetPrintStyle PLAIN ,1,2 SetPen 2,1 PrintText GetWord(Arg5,1,"B_"),Arg1+18-Arg6,Arg2+3+Arg7 EndScript Routine "Get Fields" Let FieldNames[1]=Arg1 Let FieldNames[2]=Arg2 Let FieldNames[3]=Arg3 Let FieldNames[4]=Arg4 Let FieldNames[5]=Arg5 Let FieldNames[6]=Arg6 Let FieldNames[7]=Arg7 Let FieldNames[8]=Arg8 Let FieldNames[9]=Arg9 Let FieldNames[10]=Arg10 EndScript Routine "Format Fields" Let M=Max(9999) Let Arg2=FormatValue(TextFrom(Arg1),"###0.00") If Arg2>M Let Arg2=0 EndIf SetText Arg1,FormatValue(Arg2,"###0.00") EndScript Routine "Format $" If CURRFIELD<>1 & CURRFIELD<>2 & CURRFIELD<>3 & CURRFIELD<>6 While ObjectState(Arg1) Let M=Arg2 Let N=0 Let Arg3=TextFrom(Arg4) Let Arg3=Arg3||Arg5||FormatValue(N,"####0.05") Let FInfo=Arg3 If Arg3|||Arg6|||M Let Arg3=Arg7 SetText Arg4,FormatValue(Arg3,"####0.00") Else Delay 0,0,10 SetText Arg4,FormatValue(Arg3,"####0.00") EndIf EndLoop EndIf EndScript Routine "Draw" Let WBL=WindowBorderLeft Let WBT=WindowBorderTop Let WW=WindowWidth Let WBR=WindowBorderRight Let WH=WindowHeight Let WBB=WindowBorderBottom DrawBorder WindowX+WBL,WindowY,WindowWidth-WBR-WBL,WindowHeight-windowY,BEVEL ,2,1 DrawBorder WindowX+WBL,WindowY+GOS+66,WindowWidth-WBR-WBL,WindowHeight-windowY,BEVEL ,2,1 DrawBorder 12,105,700,275,BEVEL ,2,1 EndScript Routine "Set Field" If Arg1="" Let CurrField=CurrField+1 Else Let CurrField=Arg1 EndIf If CurrField>LastArrayIndex(FieldNames) Let CurrField=1 EndIf SetObjectState FieldNames[CurrField],On EndScript Routine "Tax" If Exists("Ram:A2K.Tax") Let A2KTax=LoadVariable("Ram:A2K.Tax") Let Tax=A2KTax.Tax Let GST=A2KTax.GST Let PST=A2KTax.PST Let VAT1=A2KTax.VAT1 Let VAT2=A2KTax.VAT2 If Tax<>"" Let T="Yes" ElseIf GST<>"" Let T="Yes" ElseIf PST<>"" Let T="Yes" ElseIf VAT1<>"" Let T="Yes" ElseIf VAT2<>"" Let T="Yes" EndIf EndIf EndScript Routine "Search Next" WorkWithDocument "Order List" Local NewOrderIndex SetSearchArrayFlags NOCASE SUBSTRING Let NewOrderIndex=SearchArray(OrderDataBase,SearchText,SearchField,OrderIndex+1) If Not SearchFound Let NewOrderIndex=SearchArray(OrderDataBase,SearchText,SearchField) If Not SearchFound If SizeOfDocument<>0 MoveCursorTo STARTOF DOCUMENT SplitLine MoveCursor UP Let OrderIndex=1 InsertArrayEntry OrderDataBase,OrderIndex Let OrderDataBase[OrderIndex]=GetDBObjects EndIf EndIf EndIf If SearchFound Do "Get OrderEntry",NewOrderIndex EndIf EndScript Routine "Draw Card" Let APen=DefPenA,BPen=DefPenB,CPen=DefPenC SetDrawMode JAM2 SetPen 5 AreaRectangle 20,475,682,65 DrawBorder 20,475,682,65,BEVEL ,1,2 SetPen APen,5 PrintText "Qty",128,485 PrintText "Profit =",163,485 PrintText "Total(s)",246,485 PrintText "P.V. =",377,485 PrintText "B.V. =",449,485 PrintText "Dist =",553,485 PrintText "Cost =",617,485 PrintText "Tax Payable :",27,508 PrintText "Customer Tax:",27,523 EndScript Routine "Tax Amounts" Let TaxDist=0 Let TaxCust=0 Let ATX=TextFrom(".Tax") Let Qty=IntegerFrom(".Qty") Do "Format Fields",".Dist",Dist Do "Format Fields",".Cust",Cust If ATX="Tax" Let TaxDist=(Qty*Dist)+(Dist/100*Tax) Let TaxCust=(Qty*Cust)+(Cust/100*Tax) ElseIf ATX="GST" Let TaxDist=(Qty*Dist)+(Dist/100*GST) Let TaxCust=(Qty*Cust)+(Cust/100*GST) ElseIf ATX="PST" Let TaxDist=(Qty*Dist)+(Dist/100*PST) Let TaxCust=(Qty*Cust)+(Cust/100*PST) ElseIf ATX="VAT1" Let TaxDist=(Qty*Dist)+(Dist/100*VAT1) Let TaxCust=(Qty*Cust)+(Cust/100*VAT1) ElseIf ATX="VAT2" Let TaxDist=(Qty*Dist)+(Dist/100*VAT1) Let TaxCust=(Qty*Cust)+(Cust/100*VAT1) ElseIf ATX<>"" Let ATX=FormatValue(TextFrom(".Tax"),"####") Let TaxDist=(Qty*Dist)+(Dist/100*ATX) Let TaxCust=(Qty*Cust)+(Cust/100*ATX) ElseIf ATX="" Let TaxDist=Dist Let TaxCust=Cust EndIf SetText ".Dist",TaxDist SetText ".Cust",TaxCust Do "Format Fields",".Dist",TaxDist Do "Format Fields",".Cust",TaxCust EndScript Routine "Get OrderEntry" Let OrderIndex=Arg1 SetDBObjects OrderDataBase[OrderIndex] WorkWithDocument "Order List" PositionOnLine Arg1 EndScript Routine "Load StockDataFile" WorkWithDocument "Stock List" Clear DOCUMENT If Sort="Yes" SortArray StockDataBase,INTEGER ,".VS" EndIf Let StockIndex=FirstArrayIndex(StockDataBase) While SearchFound Type LeftJustify(StockDataBase[StockIndex].VS,12) Type " " Type RightJustify(StockDataBase[StockIndex].Qty,2) Type " " Type LeftJustify(StockDataBase[StockIndex].Des,22) Type " " Type RightJustify(FormatValue(StockDataBase[StockIndex].PV,"###0.00"),7) Type " " Type RightJustify(FormatValue(StockDataBase[StockIndex].BV,"###0.00"),7) Type " " If T="Yes" Type LeftJustify(FormatValue(StockDataBase[StockIndex].Tax,"###%"),4) Else Type LeftJustify(FormatValue(StockDataBase[StockIndex].Tax,"###%"),4) EndIf Type " " Type RightJustify(FormatValue(StockDataBase[StockIndex].Dist,DefNote||"###0.00"),7) Type " " Type RightJustify(FormatValue(StockDataBase[StockIndex].Cust,DefNote||"###0.00"),7) NewLine Let StockIndex=NextArrayIndex(StockDataBase,StockIndex) EndLoop Delete CHARACTER ,-1 If StockIndex=1 MoveCursorTo STARTOF DOCUMENT EndIf EndScript Routine "Get VS" If Exists("Ram:A2KData/StockData/Stock.Data") Let StockDataBase=LoadVariable("Ram:A2KData/StockData/Stock.Data") EndIf If Arg1<>"" Let VS=Arg1 Else Let VS=TextFrom(".VS") EndIf If VS<>"" Local NewStockIndex SetSearchArrayFlags NOCASE SUBSTRING Let NewStockIndex=SearchArray(StockDataBase,VS,".VS",StockIndex+1) If Not SearchFound Let NewStockIndex=SearchArray(StockDataBase,VS,".VS") EndIf If SearchFound Let StockIndex=NewStockIndex EndIf Let PV=FormatValue(StockDataBase[StockIndex].PV,"###0.00") Let BV=FormatValue(StockDataBase[StockIndex].BV,"###0.00") Let Dist=FormatValue(StockDataBase[StockIndex].Dist,"###0.00") Let Cust=FormatValue(StockDataBase[StockIndex].Cust,"###0.00") Else Let Dist=0 Let Cust=0 EndIf EndScript Routine "Calc Tax" Let Qty=IntegerFrom(".Qty") If ATX="Tax" Let TotalTaxDistT=TotalTaxDistT+(Qty*Dist/100*Val) Let TotalTaxCustT=TotalTaxCustT+(Qty*Cust/100*Val) ElseIf ATX="GST" If ATC=1 Let ATC=2 Else Let ATC=1 EndIf Let TotalTaxDistG=TotalTaxDistG+(Qty*Dist/100*Val) Let TotalTaxCustG=TotalTaxCustG+(Qty*Cust/100*Val) ElseIf ATX="PST" If ATC=1 Let ATC=2 Else Let ATC=1 EndIf Let TotalTaxDistP=TotalTaxDistP+(Qty*Dist/100*Val) Let TotalTaxCustP=TotalTaxCustP+(Qty*Cust/100*Val) ElseIf ATX="VAT1" If ATC=1 Let ATC=2 Else Let ATC=1 EndIf Let TotalTaxDistV1=TotalTaxDistV1+(Qty*Dist/100*Val) Let TotalTaxCustV1=TotalTaxCustV1+(Qty*Cust/100*Val) ElseIf ATX="VAT2" If ATC=1 Let ATC=2 Else Let ATC=1 EndIf Let TotalTaxDistV2=TotalTaxDistV2+(Qty*Dist/100*Val) Let TotalTaxCustV2=TotalTaxCustV2+(Qty*Cust/100*Val) ElseIf ATX<>"" Let ATX=FormatValue(TextFrom(".Tax"),"####") Let TotalTaxDist=TotalTaxDist+(Qty*Dist/100*ATX) Let TotalTaxCust=TotalTaxCust+(Qty*Cust/100*ATX) ElseIf ATX="" Let TotalTaxDist=TotalTaxDist+(Qty*Dist/100*Val) Let TotalTaxCust=TotalTaxCust+(Qty*Cust/100*Val) EndIf EndScript Routine "Print Calc Totals" SetDrawMode JAM2 If ATX="Tax" SetPen APen,5 PrintText "Tax=",218,508 PrintText "Tax=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7),154,508 PrintText RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7),154,523 ElseIf ATX="GST" SetPen APen,5 PrintText "GST=",218,508 PrintText "GST=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistG,DefNote||"###0.00"),7),154,508 PrintText RightJustify(FormatValue(TotalTaxCustG,DefNote||"###0.00"),7),154,523 ElseIf ATX="PST" SetPen APen,5 PrintText "PST=",218,508 PrintText "PST=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistP,DefNote||"###0.00"),7),250,508 PrintText RightJustify(FormatValue(TotalTaxCustP,DefNote||"###0.00"),7),250,523 ElseIf ATX="VAT1" SetPen APen,5 PrintText "VAT1=",218,508 PrintText "VAT1=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistV1,DefNote||"###0.00"),7),154,508 PrintText RightJustify(FormatValue(TotalTaxCustV1,DefNote||"###0.00"),7),154,523 ElseIf ATX="VAT2" SetPen APen,5 PrintText "VAT2=",218,508 PrintText "VAT2=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistV2,DefNote||"###0.00"),7),250,508 PrintText RightJustify(FormatValue(TotalTaxCustV2,DefNote||"###0.00"),7),250,523 ElseIf ATX<>"" SetPen APen,5 PrintText "Tax=",218,508 PrintText "Tax=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7),154,508 PrintText RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7),154,523 ElseIf ATX="" SetPen APen,5 PrintText "Tax=",218,508 PrintText "Tax=",218,523 SetPen CPen,5 PrintText RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7),154,508 PrintText RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7),154,523 EndIf EndScript Routine "Print Totals" Do "Draw Card" Do "Print Calc Totals" SetDrawMode JAM2 SetPrintFont "topaz",8 SetPen BPen,5 PrintText RightJustify(TotalQty,2),130,495 PrintText RightJustify(FormatValue(TotalPV,"###0.00"),7),377,495 PrintText RightJustify(FormatValue(TotalBV,"###0.00"),7),449,495 PrintText RightJustify(FormatValue(TotalDist,DefNote||"###0.00"),7),553,495 PrintText RightJustify(FormatValue(TotalCust,DefNote||"###0.00"),7),617,495 PrintText RightJustify(FormatValue(TotalProfit,DefNote||"###0.00"),7),170,495 EndScript Routine "PrintTax" Let Day=GetWord(TheDate,2,"/") Let Month=GetWord(TheDate,1,"/") Let Year=GetWord(TheDate,3,"/") WorkWithDocument "Ram:A2KData/OrderData/Order.Doc" Clear DOCUMENT Type " ",NEWLINE Type "VS Qty Description P.V. B.V. Tax Dist Cost" MoveCursorTo ENDOF DOCUMENT NewLine Type "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯",NEWLINE InsertDocument "Order List" MoveCursorTo ENDOF DOCUMENT NewLine Type "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯",NEWLINE Type " Total Qty Total Profit Total(s) P.V. B.V. Dist Cost",NEWLINE Type " " Type RightJustify(TotalQty,2) Type " " Type RightJustify(FormatValue(TotalProfit,"###0.00"),7) Type " " Type RightJustify(FormatValue(TotalPV,"###0.00"),7) Type " " Type RightJustify(FormatValue(TotalBV,"###0.00"),7) Type " " Type RightJustify(FormatValue(TotalDist,DefNote||"###0.00"),7) Type " " Type RightJustify(FormatValue(TotalCust,DefNote||"###0.00"),7),NEWLINE NewLine Do "Type Calc Totals" EndScript Routine "Type Calc Totals" If ATX="Tax" Type "Tax Payable : Tax=" Type RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7) NewLine Type "Customer Tax: Tax=" Type RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7) ElseIf ATX="GST" Type "Tax Payable : GST=" Type RightJustify(FormatValue(TotalTaxDistG,DefNote||"###0.00"),7) NewLine Type "Customer Tax: GST=" Type RightJustify(FormatValue(TotalTaxCustG,DefNote||"###0.00"),7) ElseIf ATX="PST" If ATC=2 Type "Tax Payable : GST=" Type RightJustify(FormatValue(TotalTaxDistG,DefNote||"###0.00"),7) Type " Tax Payable : PST=" Type RightJustify(FormatValue(TotalTaxDistP,DefNote||"###0.00"),7) NewLine Type "Customer Tax: GST=" Type RightJustify(FormatValue(TotalTaxCustG,DefNote||"###0.00"),7) Type " Customer Tax: PST=" Type RightJustify(FormatValue(TotalTaxCustP,DefNote||"###0.00"),7) ElseIf ATC=1 Type " Tax Payable : PST=" Type RightJustify(FormatValue(TotalTaxDistP,DefNote||"###0.00"),7) NewLine Type " Customer Tax: PST=" Type RightJustify(FormatValue(TotalTaxCustP,DefNote||"###0.00"),7) EndIf ElseIf ATX="VAT1" Type "Tax Payable : VAT1=" Type RightJustify(FormatValue(TotalTaxDistV1,DefNote||"###0.00"),7) NewLine Type "Customer Tax: VAT1=" Type RightJustify(FormatValue(TotalTaxCustV1,DefNote||"###0.00"),7) ElseIf ATX="VAT2" If ATC=2 Type "Tax Payable : VAT1=" Type RightJustify(FormatValue(TotalTaxDistV1,DefNote||"###0.00"),7) Type " Tax Payable : VAT2=" Type RightJustify(FormatValue(TotalTaxDistV2,DefNote||"###0.00"),7) NewLine Type "Customer Tax: VAT1=" Type RightJustify(FormatValue(TotalTaxCustV1,DefNote||"###0.00"),7) Type " Customer Tax: VAT2=" Type RightJustify(FormatValue(TotalTaxCustV2,DefNote||"###0.00"),7) ElseIf ATC=1 Type " Tax Payable : VAT2=" Type RightJustify(FormatValue(TotalTaxDistV2,DefNote||"###0.00"),7) NewLine Type " Customer Tax: VAT2=" Type RightJustify(FormatValue(TotalTaxCustV2,DefNote||"###0.00"),7) EndIf ElseIf ATX<>"" Type "Tax Payable : Tax=" Type RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7) NewLine Type "Customer Tax: Tax=" Type RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7) ElseIf ATX="" Type "Tax Payable : Tax=" Type RightJustify(FormatValue(TotalTaxDistT,DefNote||"###0.00"),7) NewLine Type "Tax=" Type RightJustify(FormatValue(TotalTaxCustT,DefNote||"###0.00"),7) EndIf EndScript Routine "Store StockEntry" WorkWithDocument "Stock List" Let Work=GetDBObjects If Work<>StockDataBase[StockIndex] Do "Delete StockEntry",StockIndex Let StockIndex=TheLineNumber InsertArrayEntry StockDataBase,StockIndex Let StockDataBase[StockIndex]=Work EndIf Do "Load StockDataFile" EndScript Routine "Delete OrderData" WorkWithDocument "Order List" If LinesInDocument=>1 Do "Delete OrderEntry",TheLineNumber Do "Get OrderEntry",TheLineNumber EndIf Let OrderDataBase[OrderIndex]=GetDBObjects Do "Set Field",1 EndScript Routine "Delete StockData" WorkWithDocument "Stock List" If LinesInDocument=>1 Do "Delete StockEntry",TheLineNumber Do "Get StockEntry",TheLineNumber EndIf Let StockDataBase[StockIndex]=GetDBObjects Do "Set Field",1 EndScript Routine "Delete StockEntry" WorkWithDocument "Stock List" DeleteArrayEntry StockDataBase,Arg1 PositionOnLine Arg1 If TheLineNumber=LinesInDocument Clear LINE Delete CHARACTER ,-1 Let StockIndex=0 Else Delete LINE EndIf Do "Load StockDataFile" PositionOnLine Arg1 EndScript Routine "Get StockEntry" Let StockIndex=Arg1 SetDBObjects StockDataBase[StockIndex] WorkWithDocument "Stock List" PositionOnLine Arg1 EndScript Routine "Load OrderData" SetFileRequestMode REGULARMODE ,REJECTICONS PATTERNFIELD SetFileRequestPattern "#?.Data" Let FileName=AskForFileName(DefOrdDir||"/.Data","Select File To Load...") If FileOf(FileName)<>"" Let OrderDataBase=LoadVariable(FileName) Do "Load OrderDataFile" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" Else Let OrderIndex=1 Let OrderDataBase[OrderIndex]=GetDBObjects Do "Load OrderDataFile" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" EndIf Do "Get Date" Do "Get OrderEntry",1 Do "Set Field",1 EndScript Routine "Load StockData" SetFileRequestMode REGULARMODE ,REJECTICONS PATTERNFIELD SetFileRequestPattern "#?.Data" Let FileName=AskForFileName(DefDataDir||"/.Data","Select File To Load...") If FileOf(FileName)<>"" Let StockDataBase=LoadVariable(FileName) IfError SetDBObjects Nothing Dispose StockDataBase Let StockIndex=1 Let StockDataBase[StockIndex]=GetDBObjects EndIf Do "Load StockDataFile" SaveVariable StockDataBase,"Ram:A2KData/StockData/Stock.Data" Else SetDBObjects Nothing Dispose StockDataBase Let StockIndex=1 Let StockDataBase[StockIndex]=GetDBObjects Do "Load StockDataFile" SaveVariable StockDataBase,"Ram:A2KData/StockData/Stock.Data" EndIf Do "Get Date" Do "Get StockEntry",1 Do "Set Field",1 EndScript Routine "Save OrderData" Let OrderDataBase[OrderIndex]=GetDBObjects SortArray OrderDataBase,INTEGER ,".VS" SaveVariable OrderDataBase,DefOrdDir||"/Order.Data" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" If DefDate="MDY" SaveVariable OrderDataBase,DefOrdDir||"/Order-["||Month||"-"||Day||"-"||Year||"].Data" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order-["||Month||"-"||Day||"-"||Year||"].Data" Else SaveVariable OrderDataBase,DefOrdDir||"/Order-["||Day||"-"||Month||"-"||Year||"].Data" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order-["||Day||"-"||Month||"-"||Year||"].Data" EndIf EndScript Routine "Save StockData" Let StockDataBase[StockIndex]=GetDBObjects SortArray StockDataBase,INTEGER ,".VS" SaveVariable StockDataBase,"Ram:A2KData/StockData/Stock.Data" SaveVariable StockDataBase,DefDataDir||"/Stock.Data" EndScript Routine "Previous OrderEntry" Let Entry=GetDBObjects If Entry<>OrderDataBase[OrderIndex] Do "EnterOrder" EndIf Let OrderIndex=PreviousArrayIndex(OrderDataBase,OrderIndex) If Not SearchFound Let OrderIndex=LastArrayIndex(OrderDataBase) EndIf Do "Get OrderEntry",OrderIndex EndScript Routine "Previous StockEntry" Let Entry=GetDBObjects If Entry<>StockDataBase[StockIndex] Do "EnterStock" EndIf Let StockIndex=PreviousArrayIndex(StockDataBase,StockIndex) If Not SearchFound Let StockIndex=LastArrayIndex(StockDataBase) EndIf Do "Get StockEntry",StockIndex EndScript Routine "Next OrderEntry" Let Entry=GetDBObjects If Entry<>OrderDataBase[OrderIndex] Do "EnterOrder" EndIf Let OrderIndex=NextArrayIndex(OrderDataBase,OrderIndex) If Not SearchFound Let OrderIndex=FirstArrayIndex(OrderDataBase) EndIf Do "Get OrderEntry",OrderIndex EndScript Routine "Next StockEntry" Let Entry=GetDBObjects If Entry<>StockDataBase[StockIndex] Do "EnterStock" EndIf Let StockIndex=NextArrayIndex(StockDataBase,StockIndex) If Not SearchFound Let StockIndex=FirstArrayIndex(StockDataBase) EndIf Do "Get StockEntry",StockIndex EndScript Routine "EnterStock" WorkWithDocument "Stock List" Let AS=GetDBObjects Do "Store StockEntry" Let Find=SearchArray(StockDataBase,AS) Do "Get StockEntry",Find Do "Set Field",CurrField EndScript Routine "EnterOrder" WorkWithDocument "Stock List" Let AS=GetDBObjects Do "Store OrderEntry" Let Find=SearchArray(OrderDataBase,AS) Do "Get OrderEntry",Find Do "Set Field",CurrField EndScript Routine "Store OrderEntry" WorkWithDocument "Order List" Let Work=GetDBObjects If Work<>OrderDataBase[OrderIndex] Do "Delete OrderEntry",OrderIndex Let OrderIndex=TheLineNumber InsertArrayEntry OrderDataBase,OrderIndex Let OrderDataBase[OrderIndex]=Work EndIf Do "Load OrderDataFile" EndScript Routine "Delete OrderEntry" DeleteArrayEntry OrderDataBase,Arg1 PositionOnLine Arg1 If TheLineNumber=LinesInDocument Clear LINE Delete CHARACTER ,-1 Let OrderIndex=0 Else Delete LINE EndIf Do "Load OrderDataFile" PositionOnLine Arg1 EndScript Routine "Set Tax Field" Let TaxAmount=IntgerFrom("Tax") Let TaxField=GetWord(CurrButton,1,"B_") SetText ".Tax",TaxField Do "Tax" If Base="Stock" Do "EnterStock" ElseIf Base="Order" Do "EnterOrder" EndIf Do "Set Field",1 EndScript Routine "Load OrderDataFile" Let ATC=0,TotalPV=0,TotalBV=0,TotalQty=0,TotalDist=0,TotalCust=0,TotalProfit=0,TotalTaxDist=0,TotalTaxCust=0 Let TotalTaxDistT=0,TotalTaxCustT=0,TotalTaxDistG=0,TotalTaxCustG=0,TotalTaxDistP=0,TotalTaxCustP=0 Let TotalTaxDistV1=0,TotalTaxCustV1=0,TotalTaxDistV2=0,TotalTaxCustV2=0 WorkWithDocument "Order List" Clear DOCUMENT If Sort="Yes" SortArray OrderDataBase,INTEGER ,".VS" EndIf Let OrderIndex=FirstArrayIndex(OrderDataBase) While SearchFound Type LeftJustify(OrderDataBase[OrderIndex].VS,12) Type " " Type RightJustify(OrderDataBase[OrderIndex].Qty,2) Type " " Type LeftJustify(OrderDataBase[OrderIndex].Des,22) Type " " Type RightJustify(FormatValue(OrderDataBase[OrderIndex].PV,"###0.00"),7) Type " " Type RightJustify(FormatValue(OrderDataBase[OrderIndex].BV,"###0.00"),7) Type " " If T="Yes" Let ATX=OrderDataBase[OrderIndex].Tax Do "Get VS",OrderDataBase[OrderIndex].VS Let Val=FormatValue(OrderDataBase[OrderIndex].Tax,"####") Type LeftJustify(FormatValue(OrderDataBase[OrderIndex].Tax,"###%"),4) Else Type LeftJustify(FormatValue(OrderDataBase[OrderIndex].Tax,"###%"),4) EndIf Type " " Type RightJustify(FormatValue(OrderDataBase[OrderIndex].Dist,DefNote||"###0.00"),7) Type " " Type RightJustify(FormatValue(OrderDataBase[OrderIndex].Cust,DefNote||"###0.00"),7) Let TotalPV=TotalPV+OrderDataBase[OrderIndex].PV Let TotalBV=TotalBV+OrderDataBase[OrderIndex].BV Let TotalQty=TotalQty+OrderDataBase[OrderIndex].Qty Let TotalDist=TotalDist+OrderDataBase[OrderIndex].Dist Let TotalCust=TotalCust+OrderDataBase[OrderIndex].Cust Let TotalProfit=TotalCust-TotalDist Do "Calc Tax" NewLine Let OrderIndex=NextArrayIndex(OrderDataBase,OrderIndex) EndLoop Delete CHARACTER ,-1 If OrderIndex=1 MoveCursorTo STARTOF DOCUMENT EndIf Do "Print Totals" EndScript Routine "Print" If T="Yes" Do "PrintTax" Else Let Day=GetWord(TheDate,2,"/") Let Month=GetWord(TheDate,1,"/") Let Year=GetWord(TheDate,3,"/") WorkWithDocument "Ram:A2KData/OrderData/Order.Doc" Clear DOCUMENT Type " ",NEWLINE Type "VS Qty Description P.V. B.V. Dist Cost" MoveCursorTo ENDOF DOCUMENT NewLine Type "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯",NEWLINE InsertDocument "Order List" MoveCursorTo ENDOF DOCUMENT NewLine Type "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯",NEWLINE Type " Total Qty Total Profit Total(s) P.V. B.V. Dist Cost",NEWLINE Type " " Type RightJustify(TotalQty,3) Type " " Type RightJustify(FormatValue(TotalProfit,Note||"####0.00"),8) Type " " Type RightJustify(FormatValue(TotalPV,Note||"####0.00"),8) Type " " Type RightJustify(FormatValue(TotalBV,Note||"####0.00"),8) Type " " Type RightJustify(FormatValue(TotalDist,Note||"####0.00"),8) Type " " Type RightJustify(FormatValue(TotalCust,Note||"####0.00"),8),NEWLINE EndIf SaveDocument "Ram:A2KData/OrderData/Order.Doc" SaveDocument "Ram:A2KData/OrderData/Order.Doc","Ram:A2KData/PrintData/Order.Doc" Dos "C:Join Ram:A2KData/PrintData/Dist.Doc Ram:A2KData/PrintData/Order.Doc as Ram:A2KData/PrintData/Print.Doc" Dos "C:Copy Ram:A2KData/PrintData/Print.Doc to Ram:A2KData/OrderData/Temp.Doc" If DefDate="MDY" Dos "C:Rename Ram:A2KData/OrderData/Temp.Doc Ram:A2KData/OrderData/Ordering-["||Month||"-"||Day||"-"||Year||"].Doc" Else Dos "C:Rename Ram:A2KData/OrderData/Temp.Doc Ram:A2KData/OrderData/Ordering-["||Day||"-"||Month||"-"||Year||"].Doc" EndIf Dos "C:Delete Ram:A2KData/OrderData/Temp.Doc" Dos "C:Copy Ram:A2KData/OrderData "||DefOrdDir||" All" EndScript Routine "NewOrder" SetDBObjects Nothing WorkWithDocument "Order List" Clear DOCUMENT Dispose OrderDataBase Let OrderDataBase[OrderIndex]=GetDBObjects Do "Load OrderDataFile" Do "Get OrderEntry",1 Do "Set Field",1 EndScript Routine "NewStock" Do "Store StockEntry" WorkWithDocument "Stock List" SetDBObjects Nothing SetText ".Des","Empty" MoveCursorTo STARTOF DOCUMENT SearchFor "Empty" If Not SearchFound Let NewEntry=GetDBObjects If NewEntry<>StockDataBase[StockIndex] If SizeOfDocument<>0 WorkWithDocument "Stock List" MoveCursorTo STARTOF DOCUMENT SplitLine MoveCursor UP Let StockIndex=1 InsertArrayEntry StockDataBase,StockIndex EndIf EndIf Let StockDataBase[StockIndex]=GetDBObjects Do "Load StockDataFile" MoveCursorTo STARTOF DOCUMENT SearchFor "Empty" Do "Get StockEntry",TheLineNumber ElseIf SearchFound Do "Get StockEntry",TheLineNumber EndIf Do "Set Field",1 EndScript Resource "Preset" BeforeAttachment SetAutoFileRequester FALSE Do "Get_FONT.PREFS" Do "Get_PUBSCREEN.PREFS" Do "Set_PROG.VARS" Dos "C:Assign A2K: """||(TheCurrentDirectory)||"""" EndScript AfterAttachment SetAutoFileRequester FALSE Let ©1994=HexToChars("533A41324B2E6B6579") If EXISTS(©1994) Do "KeyFile" If ®2003<>HexToChars("545247") AttachObject "Welcome" Let PROG.PUBSCRTITLE="WORKBENCH" StopScript ElseIf Exists("A2K:A2K.Prefs") Dos "C:Copy A2K:A2K.Prefs Ram:" Let PROG.PUBSCRTITLE="A2K_PubScreen."||CNT AttachObject "Main" Else Let PROG.PUBSCRTITLE="WORKBENCH" AttachObject "PrefsWindow" EndIf Else AttachObject "Welcome" EndIf EndScript Window "BootWindow" Definition Origin 0,0 Size 1,1 NumberOfColors 2 WindowObjects NONE WindowFlags WORKBENCH VisualEffects NONE ,NONE EndScript EndObj EndObj Window "Welcome" NoAttach Definition Origin 160,140 Size 330,200 DefaultColors 1,0,3 WindowFlags ACTIVATE TOFRONT WORKBENCH BLOCK VisualEffects NONE ,NONE EndScript AfterAttachment Let PROG.PUBSCRTITLE="WORKBENCH" SetAutoFileRequester FALSE SetSystemRequesterTo WINDOW FastFeedBack ON SetPrintStyle PLAIN ,2,1 SetDrawMode JAM1 SetPen BPen,3 If EXISTS("Fonts:Times/36") SetPrintFont "Times",36 PrintText "Welcome",81,19 PrintText "to",130,45 PrintText "A2K",106,80 Else SetPrintFont "topaz",8 PrintText "Welcome to A2K",81,50 EndIf SetPrintFont "topaz",8 SetPen APen,3 SetDrawMode JAM2 PrintText "...and your name is?",70,115 PrintText "...and your IBO number?",70,150 SetObjectState ".F_Name",On EndScript TextField ".F_Name" Definition InitialText "" Origin 50,128 Size 208,12 Border INVERT BEVEL MaxFieldLength 25 Font "topaz",8 TextColors 1,4 AltTextColors 1,4 EndScript OnRelease Let YName=TextFrom(".F_Name") If YName="" SetObjectState ".F_Name",On EndIf If YName<>OldName SetInteger ".F_Number",0 SetObjectState ".F_Number",On Else SetObjectState ".F_Number",On EndIf EndScript OnClick Let CurrField=1,OldName=TextFrom(".F_Name") EndScript EndObj IntegerField ".F_Number" Definition Limits 0,9999999 InitialInteger 0 Origin 125,164 Size 64,12 Border INVERT BEVEL MaxFieldLength 7 Font "topaz",8 TextColors 1,4 AltTextColors 1,4 EndScript OnClick Let CurrField=2 EndScript OnRelease Let Number=IntegerFrom(".F_Number"),Name=TextFrom(".F_Name") If Name="" SetObjectState ".F_Name",On ElseIf Number=0 SetObjectState ".F_Number",On ElseIf Number<>0 Do "MakeName" EndIf EndScript EndObj TextMenu "M_Quit" Definition AttachTo MENU ,"Project..." Text "Quit..." ShortCutKey "Q" EndScript Occurred Do "Quit" EndScript EndObj EndObj Window "PrefsWindow" NoAttach Definition Origin DefPrefsWinX,DefPrefsWinY Title "A2K Preferences..." WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR Size 250,300 DefaultColors 1,0,5 WindowFlags ACTIVATE TOFRONT PUBLIC ,PROG.PUBSCRTITLE VisualEffects NONE ,NONE EndScript OnCloseButton Let DefPrefsWinX=WindowX Let DefPrefsWinY=WindowY Do "Set Prefs" SaveVariable A2KPrefs,"A2K:A2K.Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" If NOT ObjectAttached("Main") Let PROG.PUBSCRTITLE="A2K_PubScreen."||CNT AttachObject "Main" SetObjectState "MainWindow",ON DetachObject "PrefsWindow" Else SetObjectState "MainWindow",ON FlushAll DetachObject "PrefsWindow" EndIf EndScript BeforeAttachment If Exists("Ram:A2K.prefs") Let A2KPrefs=LoadVariable("Ram:A2K.prefs") Do "Set Def" ElseIf Exists("A2K:A2K.Prefs") Let A2KPrefs=LoadVariable("A2K:A2K.Prefs") Do "Set Def" Do "Make Ram Dir" SaveVariable A2KPrefs,"Ram:A2K.Prefs" ElseIf Not Exists("A2K:A2K.Prefs") If Not Exists("A2K:A2KData") Dos "C:MakeDir A2K:A2KData" EndIf Do "Load File" EndIf EndScript AfterAttachment If DefBGPic<>"" Do "ShowBrush",DefBGPic EndIf If DefDate="DMY" SetObjectState "M_DMY",On ElseIf DefDate="MDY" SetObjectState "M_MDY",On EndIf AttachObject "PrefsObjects" EndScript Routine "Currency" If NOT ObjectAttached("F_Currency") ReattachObject "F_Currency" EndIf SetText "F_Currency"," " If Arg1="$" SetText "F_Currency","$... Dollars" ElseIf Arg1="£" SetText "F_Currency","£... Pounds" ElseIf Arg1="F" SetText "F_Currency","F... Francs" ElseIf Arg1="M" SetText "F_Currency","M... Mark" ElseIf Arg1="DM" SetText "F_Currency","DM... Mark" ElseIf Arg1="D" SetText "F_Currency","D... Dina" ElseIf Arg1="G" SetText "F_Currency","G... Gilda" ElseIf Arg1="R" SetText "F_Currency","R... Rupe" ElseIf Arg1="L" SetText "F_Currency","L... Lira" ElseIf Arg1="Y" SetText "F_Currency","Y... Yen" ElseIf Arg1="K" SetText "F_Currency","K... PNG" ElseIf Arg1="B" SetText "F_Currency","B... " ElseIf Arg1="Z" SetText "F_Currency","Z... Zwoty" ElseIf Arg1="E" SetText "F_Currency","E... Euro" EndIf DetachObject "F_Currency" ReattachObject "B_Currency" EndScript Routine "Draw Card" Let APen=DefPenA,BPen=DefPenB,CPen=DefPenC SetPrintFont "topaz",8 SetPrintStyle PLAIN ,2,1 SetDrawMode JAM1 SetPen APen,5 PrintText "Text1",62,239 SetPen BPen,5 PrintText "Text2",122,239 SetPen CPen,5 PrintText "Text3",186,239 Do "Currency",DefNote EndScript Routine "Load File" SetFileRequestMode REGULARMODE ,REJECTICONS Let FileName=AskForFileName("A2K:A2K.Prefs","Select Prefs File To Load...") If FileOf(FileName)<>"" Do "FileType ErrorCheck" Let A2KPrefs=LoadVariable(FileName) IfError Do "Make Def" Do "Set Prefs" EndIf Do "Set Prefs" Do "Set Def" Do "Make Ram Dir" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Else Do "Make Def" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" EndIf EndScript Routine "Set State" SetObjectState "B_Text 1",Off SetObjectState "B_Text 2",Off SetObjectState "B_Text 3",Off SetObjectState "B_Text "||Arg1,On EndScript Routine "Set Fields" SetText ".F_DistDir",DefDistDir SetText ".F_DataDir",DefDataDir SetText ".F_OrderDir",DefOrdDir SetText ".F_CustDir",DefCustDir SetText ".F_PBGPic",DefPBGPic SetText ".F_PalDir",DefPalDir EndScript Routine "Load Dir" SetFileRequestMode REGULARMODE ,REJECTICONS Let DirName=AskForFileName(Arg1,"Select Directory & File To Load...") If FileOf(DirName)<>"" Let Arg1=PathOf(DirName) ElseIf DirName<>"" Let Arg1=DirName Else Let Arg1="A2KDeck:A2KData/"||Arg3 EndIf Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState Arg2,On Do "Currency",DefNote EndScript Routine "Load BackPic" SetFileRequestMode REGULARMODE ,REJECTICONS Let FileName=AskForFileName(Arg1,"Select Picture To Load...") If FileOf(FileName)<>"" Do "FileType ErrorCheck" If Error EndIf Do "ShowBrush",FileName IfError EndIf ReattachObject "PrefsObjects" Else Let DefBGPic="" EndIf Let DefBGPic=FileName Let Av[1]=FileName Let Av[2]=Arg2 Let Av[3]=Arg3 Let Av[4]=Arg4 Let Av[5]=Arg5 Let Av[6]=Arg6 Let N=Arg6 If Av[6]>1 Let Av[N]=Av[1] Let DefTBGPic=Av[2] Let DefDBGPic=Av[3] Let DefOBGPic=Av[4] Let DefCBGPic=Av[5] EndIf Let DefPBGPic=FileName Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetText ".F_PBGPic",FileName SetObjectState ".F_PBGPic",On Do "Draw Card" Do "Currency",DefNote Do "Reattach" EndScript Routine "Reattach" Do "Click",18,235,20,14,"B_+",12 Do "Click",206,209,30,14,"B_Tax",15 Do "Click",18,262,68,14,"B_Load" Do "Click",110,262,68,14,"B_Save" ReattachObject "B_+1" ReattachObject "B_Tax" ReattachObject "B_Load1" ReattachObject "B_Save1" EndScript Resource "PrefsObjects" NoAttach AfterAttachment Do "Draw Card" Do "Reattach" Do "Set Fields" SetObjectState ".F_DistDir",On EndScript TextField ".F_DistDir" Definition InitialText "" Origin 20,30 Size 176,12 Border INVERT BEVEL Label "Distributor Directory",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefDistDir=TextFrom(".F_DistDir") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState ".F_DataDir",On Do "Currency",DefNote EndScript EndObj TextField ".F_DataDir" Definition InitialText "" Origin 20,60 Size 176,12 Border INVERT BEVEL Label "DataBase Directory",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefDataDir=TextFrom(".F_DataDir") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState ".F_OrderDir",On Do "Currency",DefNote EndScript EndObj TextField ".F_OrderDir" Definition InitialText "" Origin 20,90 Size 176,12 Border INVERT BEVEL Label "Ordering Directory",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefOrdDir=TextFrom(".F_OrderDir") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState ".F_CustDir",On Do "Currency",DefNote EndScript EndObj TextField ".F_CustDir" Definition InitialText "" Origin 20,120 Size 176,12 Border INVERT BEVEL Label "Customer Directory",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefCustDir=TextFrom(".F_CustDir") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState ".F_PBGPic",On Do "Currency",DefNote EndScript EndObj TextField ".F_PBGPic" Definition InitialText "" Origin 20,150 Size 176,12 Border INVERT BEVEL Label "BackGround Picture",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefPBGPic=TextFrom(".F_PBGPic") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" If DefPBGPic<>"" Do "ShowBrush",DefPBGPic EndIf ReattachObject "PrefsObjects" Do "Set Fields" Do "Reattach" Do "Draw Card" Do "Currency",DefNote SetObjectState ".F_PalDir",On EndScript EndObj TextField ".F_PalDir" Definition InitialText "" Origin 20,180 Size 176,12 Border INVERT BEVEL Label "Palette",ABOVELEFT MaxFieldLength 256 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let DefPal=TextFrom(".F_PalDir") Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" Do "Draw Card" Do "Currency",DefNote EndScript EndObj AreaButton "B_DistDir" Definition Origin 208,29 Image "A2K:A2K.br/Dir.b0" AltImage "A2K:A2K.br/Dir.b1" EndScript OnRelease Do "Load Dir",DefDistDir,".F_DistDir","DistData" EndScript EndObj AreaButton "B_DataDir" Definition Origin 208,59 Image "A2K:A2K.br/Dir.b0" AltImage "A2K:A2K.br/Dir.b1" EndScript OnRelease Do "Load Dir",DefDataDir,".F_DataDir","StockData" EndScript EndObj AreaButton "B_OrderDir" Definition Origin 208,89 Image "A2K:A2K.br/Dir.b0" AltImage "A2K:A2K.br/Dir.b1" EndScript OnRelease Do "Load Dir",DefOrdDir,"F_OrderDir","OrderData" EndScript EndObj AreaButton "B_CustDir" Definition Origin 208,119 Image "A2K:A2K.br/Dir.b0" AltImage "A2K:A2K.br/Dir.b1" EndScript OnRelease Do "Load Dir",DefCustDir,"F_CustDir","CustData" EndScript EndObj AreaButton "B_PictDir" Definition Origin 208,149 Image "A2K:A2K.br/File.b0" AltImage "A2K:A2K.br/File.b1" EndScript OnRelease Do "Load BackPic",DefBGPic,DefTBGPic,DefDBGPic,DefOBGPic,DefCBGPic,1 EndScript EndObj AreaButton "B_PalDir" Definition Origin 208,180 Image "A2K:A2K.br/File.b0" AltImage "A2K:A2K.br/File.b1" EndScript OnRelease SetFileRequestMode REGULARMODE ,REJECTICONS Let FileName=AskForFileName(DefPalBuf,"Select Picture or Brush to load...") If FileOf(FileName)<>"" Let DefPalBuf=FileName Do "FileType ErrorCheck" IfError EndIf ShowPalette DefPal Else Let DefPalBuf="A2K:Palette" EndIf Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" SetObjectState ".F_PalDir",On Do "Draw Card" Do "Currency",DefNote EndScript EndObj TextField "F_Currency" Definition InitialText "" Origin 20,210 Size 176,12 Border INVERT BEVEL Label "Currency",ABOVELEFT FieldFlags NOTABCYCLE Justification CENTER MaxFieldLength 40 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript EndObj AreaButton "B_Currency" Definition Origin 18,209 Border ROLLO Highlight NONE Size 180,14 EndScript OnRelease If ObjectAttached("F_Currency") DetachObject "F_Currency" EndIf Let N=N+1 If N=1 Let DefNote="$" ElseIf N=2 Let DefNote="£" ElseIf N=3 Let DefNote="F" ElseIf N=4 Let DefNote="M" ElseIf N=5 Let DefNote="DM" ElseIf N=6 Let DefNote="D" ElseIf N=7 Let DefNote="G" ElseIf N=8 Let DefNote="R" ElseIf N=9 Let DefNote="L" ElseIf N=10 Let DefNote="Y" ElseIf N=11 Let DefNote="K" ElseIf N=12 Let DefNote="B" ElseIf N=13 Let DefNote="Z" ElseIf N=14 Let DefNote="E" EndIf If N=14 Let N=0 EndIf Do "Currency",DefNote ReattachObject "B_Currency" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" SetObjectState ".F_DistDir",On EndScript OnClick If NOT ObjectAttached("F_Currency") ReattachObject "F_Currency" DetachObject "F_Currency" EndIf EndScript EndObj AreaButton "B_Tax" Definition Origin 206,209 Border BEVEL Text "Tax" Font "topaz",8 Highlight NONE Size 30,14 EndScript OnRelease ReattachObject "B_Tax" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" If Not ObjectAttached("TaxWindow") AttachObject "TaxWindow" SetObjectState "TaxWindow",ON Else SetObjectState "TaxWindow",ON EndIf EndScript OnClick Do "Click",206,209,30,14,"B_Tax",15 EndScript EndObj AreaButton "B_+1" Definition Origin 18,235 Border BEVEL Text "+" Font "topaz",8 Highlight NONE Size 20,14 EndScript OnRelease ReattachObject "B_+1" Let Col=ScreenColors Let Cnt=Cnt+1 If CurrButt="" Let CurrButt=1 EndIf Do "Set State",CurrButt SetPen Cnt,5 If CurrButt=1 Let DefPenA=Cnt ElseIf CurrButt=2 Let DefPenB=Cnt ElseIf CurrButt=3 Let DefPenC=Cnt EndIf Do "Draw Card" If Cnt=Col Let Cnt=0 EndIf EndScript OnClick Do "Click",18,235,20,14,"B_+",12 EndScript EndObj AreaButton "B_Text 1" Definition Origin 43,238 Border BUTTON Size 55,9 EndScript OnRelease Let CurrButt=1 Do "Set State",1 EndScript EndObj AreaButton "B_Text 2" Definition Origin 104,238 Border BUTTON Size 55,9 EndScript OnRelease Let CurrButt=2 Do "Set State",2 EndScript EndObj AreaButton "B_Text 3" Definition Origin 167,238 Border BUTTON Size 55,9 EndScript OnRelease Let CurrButt=3 Do "Set State",3 EndScript EndObj AreaButton "B_Load1" Definition Origin 18,262 Border BEVEL Text " Load " Font "topaz",8 Highlight NONE Size 68,14 EndScript OnRelease ReattachObject "B_Load1" Do "Load File" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" If DefBGPic<>"" Do "ShowBrush",DefPBGPic EndIf ReattachObject "PrefsObjects" Do "Set Fields" SetObjectState ".F_DistDir",On Do "Draw Card" Do "Currency",DefNote Do "Reattach" EndScript OnClick Do "Click",18,262,68,14,"B_Load" EndScript EndObj AreaButton "B_Save1" Definition Origin 110,262 Border BEVEL Text " Save " Font "topaz",8 Highlight NONE Size 68,14 EndScript OnRelease ReattachObject "B_Save1" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" SaveVariable A2KPrefs,"A2K:A2K.Prefs" Do "Set Fields" SetObjectState ".F_DistDir",On Do "Currency",DefNote EndScript OnClick Do "Click",110,262,68,14,"B_Save" EndScript EndObj EndObj TextMenu "M_Load" Definition AttachTo MENU ,"Prefs..." Text "Load..." ShortCutKey "L" EndScript Occurred DoObjectScript "B_Load",ONRELEASE EndScript EndObj TextMenu "M_Save" Definition AttachTo MENU ,"Prefs..." Text "Save..." ShortCutKey "S" EndScript Occurred DoObjectScript "B_Save",ONRELEASE EndScript EndObj TextMenu "M_Quit" Definition AttachTo MENU ,"Prefs..." Text "Quit..." ShortCutKey "Q" EndScript Occurred If Exists("Ram:A2K.Prefs") If Exists("A2K:") Dos "C:Copy Ram:A2K.Prefs A2K:" Else Dos "C:Copy RAM:A2K.Prefs """||(TheCurrentDirectory)||"""" EndIf EndIf Do "Quit" EndScript EndObj TextMenu "M_Date" Definition AttachTo MENU ,"Special..." Text "Date Format..." EndScript EndObj TextMenu "M_DMY" Definition AttachTo OBJECT ,"M_Date" Text "DD-MM-YY" MenuFlags CHECKABLE EndScript Occurred Let DefDate="DMY" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" SetObjectState "M_DMY",On SetObjectState "M_MDY",Off EndScript EndObj TextMenu "M_MDY" Definition AttachTo OBJECT ,"M_Date" Text "MM-DD-YY" MenuFlags CHECKABLE EndScript Occurred Let DefDate="MDY" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" SetObjectState "M_MDY",On SetObjectState "M_DMY",Off EndScript EndObj TextMenu "M_CustPic" Definition AttachTo MENU ,"Special..." Text "Customer Pic..." EndScript Occurred Do "Load BackPic",DefBGPic,DefTBGPic,DefDBGPic,DefOBGPic,DefCBGPic,5 EndScript EndObj TextMenu "M_DBPic" Definition AttachTo MENU ,"Special..." Text "DataBase Pic..." EndScript Occurred Do "Load BackPic",DefBGPic,DefTBGPic,DefDBGPic,DefOBGPic,DefCBGPic,3 EndScript EndObj TextMenu "M_DistPic" Definition AttachTo MENU ,"Special..." Text "Distributor Pic..." EndScript Occurred Do "Load BackPic",DefBGPic,DefTBGPic,DefDBGPic,DefOBGPic,DefCBGPic,2 EndScript EndObj TextMenu "M_OrdPic" Definition AttachTo MENU ,"Special..." Text "Ordering Pic..." EndScript Occurred Do "Load BackPic",DefBGPic,DefTBGPic,DefDBGPic,DefOBGPic,DefCBGPic,4 EndScript EndObj TextMenu "M_NoPic" Definition AttachTo MENU ,"Special..." Text "No BackGround Picture." EndScript Occurred Let DefBGPic="" Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" Do "Set Fields" ClearWindow SetObjectState ".F_PBGPic",On Do "Draw Card" Do "Currency",DefNote EndScript EndObj EndObj Window "TaxWindow" NoAttach Definition Origin DefTaxWinX,DefTaxWinY Title "Tax..." WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR Size 140,160 DefaultColors 1,0,5 WindowFlags ACTIVATE TOFRONT VisualEffects NONE ,NONE EndScript OnCloseButton Let DefTaxWinX=WindowX Let DefTaxWinY=WindowY Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" SaveVariable A2KPrefs,"A2K:A2K.Prefs" If ObjectAttached("PrefsWindow") SetObjectState "PrefsWindow",ON DetachObject "TaxWindow" ElseIf ObjectAttached("MainWindow") SetObjectState "MainWindow",On DetachObject "TaxWindow" Else Do "Quit" EndIf EndScript AfterAttachment If Exists("Ram:A2K.Prefs") Let A2KPrefs=LoadVariable("Ram:A2K.Prefs") Do "Set Def" EndIf Let APen=DefPenA Let BPen=DefPenB Let CPen=DefPenC If DefBGPic<>"" Do "ShowBrush",DefPBGPic EndIf AttachObject "TaxObjects" EndScript Routine "Save To Ram" Let A2kTax.Tax=IntegerFrom("Tax") Let A2kTax.Gst=IntegerFrom("Gst") Let A2kTax.Pst=IntegerFrom("Pst") Let A2kTax.Vat1=IntegerFrom("Vat1") Let A2kTax.Vat2=IntegerFrom("Vat2") SaveVariable A2KTax,"Ram:A2K.Tax" EndScript Routine "Set Tax State" SetObjectState "B_Tax1",Off SetObjectState "B_GST",Off SetObjectState "B_PST",Off SetObjectState "B_VAT1",Off SetObjectState "B_VAT2",Off SetObjectState Arg1,On SetObjectState Arg2,On EndScript Resource "TaxObjects" NoAttach AfterAttachment Do "Click",41,132,68,14,"B_Save" ReattachObject "B_Save2" Let CurrButton="B_Tax1" SetPrintFont "topaz",8 SetPrintStyle PLAIN ,B,1 SetPen APen,5 SetDrawMode JAM1 PrintText "Tax",30,34 PrintText "GST",30,54 PrintText "PST",30,74 PrintText "VAT1",22,94 PrintText "VAT2",22,114 If Exists("Ram:A2K.Tax") Let A2KTax=LoadVariable("Ram:A2K.Tax") ElseIf Exists("A2K:A2K.Tax") Let A2KTax=LoadVariable("A2K:A2K.Tax") SaveVariable A2KTax,"Ram:A2K.Tax" ElseIf Not Exists("A2K:A2K.Tax") Do "Save To Ram" SaveVariable A2KTax,"Ram:A2K.Tax" EndIf SetInteger "Tax",A2KTax.Tax SetInteger "GST",A2KTax.GST SetInteger "PST",A2KTax.PST SetInteger "VAT1",A2KTax.VAT1 SetInteger "VAT2",A2KTax.VAT2 Do "Set Tax State","B_Tax1","Tax" EndScript IntegerField "Tax" Definition Limits 0,99 InitialInteger 0 Origin 60,30 Size 24,12 Border INVERT BEVEL MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let CurrButton="B_Tax1" Do "Set Tax State","B_Tax1","Tax" Do "Save To Ram" SetText ".Tax",GetWord(CurrButton,1,"B_") Do "Tax" EndScript EndObj IntegerField "GST" Definition Limits 0,99 InitialInteger 0 Origin 60,50 Size 24,12 Border INVERT BEVEL MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let CurrButton="B_GST" Do "Set Tax State","B_GST","GST" Do "Save To Ram" SetText ".Tax",GetWord(CurrButton,1,"B_") Do "Tax" EndScript EndObj IntegerField "PST" Definition Limits 0,99 InitialInteger 0 Origin 60,70 Size 24,12 Border INVERT BEVEL MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let CurrButton="B_PST" Do "Set Tax State","B_PST","PST" Do "Save To Ram" SetText ".Tax",GetWord(CurrButton,1,"B_") Do "Tax" EndScript EndObj IntegerField "VAT1" Definition Limits 0,99 InitialInteger 0 Origin 60,90 Size 24,12 Border INVERT BEVEL MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let CurrButton="B_VAT1" Do "Set Tax State","B_VAT1","VAT1" Do "Save To Ram" SetText ".Tax",GetWord(CurrButton,1,"B_") Do "Tax" EndScript EndObj IntegerField "VAT2" Definition Limits 0,99 InitialInteger 0 Origin 60,110 Size 24,12 Border INVERT BEVEL MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let CurrButton="B_VAT2" Do "Set Tax State","B_VAT2","VAT2" Do "Save To Ram" SetText ".Tax",GetWord(CurrButton,1,"B_") Do "Tax" EndScript EndObj AreaButton "B_Tax1" Definition Origin 90,31 Border BUTTON Size 19,11 EndScript OnRelease DoObjectScript "Tax",ONRELEASE EndScript EndObj AreaButton "B_GST" Definition Origin 90,51 Border BUTTON Size 19,11 EndScript OnRelease DoObjectScript "GST",ONRELEASE EndScript EndObj AreaButton "B_PST" Definition Origin 90,71 Border BUTTON Size 19,11 EndScript OnRelease DoObjectScript "PST",ONRELEASE EndScript EndObj AreaButton "B_VAT1" Definition Origin 90,91 Border BUTTON Size 19,11 EndScript OnRelease DoObjectScript "VAT1",ONRELEASE EndScript EndObj AreaButton "B_VAT2" Definition Origin 90,111 Border BUTTON Size 19,11 EndScript OnRelease DoObjectScript "VAT2",ONRELEASE EndScript EndObj AreaButton "B_Save2" Definition Origin 41,132 Border BEVEL Text "Save" Font "topaz",8 Style SHADOW ,2,1 TextColors 1,0,JAM1 Highlight NONE Size 68,14 EndScript OnRelease ReattachObject "B_Save2" Do "Save To Ram" SaveVariable A2KTax,"A2K:A2K.Tax" EndScript OnClick Do "Click",41,132,68,14,"B_Save" EndScript EndObj EndObj TextMenu "M_Load" Definition AttachTo MENU ,"Tax..." Text "Load..." ShortCutKey "L" EndScript Occurred SetFileRequestMode REGULARMODE ,REJECTICONS Let FileName=AskForFileName("A2K:A2K.Tax","Select File To Load...") If FileOf(FileName)<>"" Let A2KTax=LoadVariable(FileName) IfError EndIf SaveVariable A2KTax,"Ram:A2K.Tax" EndIf Do "Set Fields" Do "Set State","B_Tax","Tax" EndScript EndObj TextMenu "M_Save" Definition AttachTo MENU ,"Tax..." Text "Save..." ShortCutKey "S" EndScript Occurred DoObjectScript "B_Save",ONRELEASE EndScript EndObj TextMenu "M_Quit" Definition AttachTo MENU ,"Tax..." Text "Quit..." ShortCutKey "Q" EndScript Occurred If Exists("Ram:A2K.Tax") If Exists("A2K:") Dos "C:Copy Ram:A2K.Tax A2K:" Else Dos "C:Copy RAM:A2K.Tax """||(TheCurrentDirectory)||"""" EndIf EndIf Do "Quit" EndScript EndObj EndObj Window "DistWindow" NoAttach Definition Origin 170,170 Title "Distributor Screen..." Size 315,220 DefaultColors 1,0,4 WindowFlags ACTIVATE TOFRONT BLOCK PUBLIC ,PROG.PUBSCRTITLE VisualEffects NONE ,NONE EndScript BeforeAttachment Do "Make Ram Dir" Do "KeyFile" EndScript AfterAttachment Let A2KPrefs=LoadVariable("A2K:A2K.prefs") Do "Set Def" Let APen=DefPenA Let BPen=DefPenB Let CPen=DefPenC If DefBGPic<>"" Do "ShowBrush",DefTBGPic EndIf AttachObject "DistObjects" EndScript Routine "Get Number" Let Name=TextFrom(".Name") Let Number=IntegerFrom(".Number") If Number=0 If Name<>"" Do "Set Field",2 Do "Get Name" Else Do "Get Name" EndIf ElseIf Number<>®2002 SetObjectState ".Number",On Else SetObjectState ".Add1",On EndIf EndScript Routine "Get Name" Let Name=TextFrom(".Name") If Name="" Do "Set Field",1 ElseIf Name<>®2001 SetObjectState ".Name",On EndIf EndScript Resource "DistObjects" NoAttach AfterAttachment Do "Get Fields",".Name",".Number",".Add1",".Add2",".Sub",".State",".PostCode",".Email",".UseID",".Phn" Let FieldNames[11]=".Vox",FieldNames[12]=".Mob" If Exists("Ram:A2KData/DistData/Dist.Data") Let DistDataBase=LoadVariable("Ram:A2KData/DistData/Dist.Data") SetDBObjects DistDataBase ElseIf Exists(DefDistDir||"/Dist.Data") Let DistDataBase=LoadVariable(DefDistDir||"/Dist.Data") SetDBObjects DistDataBase Let Name=TextFrom(".Name") If Name<>"" SaveVariable DistDataBase,"Ram:A2KData/DistData/Dist.Data" SaveVariable DistDataBase,"Ram:A2KData/DistData/"||Name||".Data" EndIf ElseIf Not Exists(DefDistDir||"/Dist.Data") SetDBObjects Nothing EndIf Do "Click",234,186,68,14,"B_Save" ReattachObject "B_Save" SetObjectState ".Name",On SetText ".Name",®2001 EndScript TextField ".Name" Definition InitialText "" Origin 12,30 Size 208,12 Border INVERT BEVEL Label "Your Name",ABOVELEFT MaxFieldLength 25 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=1 Let OldName=TextFrom(".Name") EndScript OnRelease Let Name=TextFrom(".Name") If Name<>®2001 SetObjectState ".Name",On Else Do "Get Number" EndIf EndScript EndObj IntegerField ".Number" Definition Limits 0,9999999 InitialInteger 0 Origin 236,30 Size 64,12 Border INVERT BEVEL Label "IBO Number",ABOVELEFT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=2 EndScript OnRelease Do "Get Number" EndScript EndObj TextField ".Add1" Definition InitialText "" Origin 12,57 Size 288,12 Border INVERT BEVEL Label "Address",ABOVELEFT MaxFieldLength 35 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=3 EndScript OnRelease SetObjectState ".Add2",On EndScript EndObj TextField ".Add2" Definition InitialText "" Origin 12,78 Size 288,12 Border INVERT BEVEL MaxFieldLength 35 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=4 EndScript OnRelease SetObjectState ".Sub",On EndScript EndObj TextField ".Sub" Definition InitialText "" Origin 12,105 Size 128,12 Border INVERT BEVEL Label "Suburb",ABOVELEFT MaxFieldLength 25 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=5 EndScript OnRelease SetObjectState ".State",On EndScript EndObj TextField ".State" Definition InitialText "" Origin 164,105 Size 56,12 Border INVERT BEVEL Label "State",ABOVELEFT MaxFieldLength 6 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=6 EndScript OnRelease SetObjectState ".PostCode",On EndScript EndObj IntegerField ".PostCode" Definition Limits 0,9999999 InitialInteger 0 Origin 236,105 Size 64,12 Border INVERT BEVEL Label "Postcode",ABOVELEFT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=7 EndScript OnRelease SetObjectState ".Email",On EndScript EndObj TextField ".Email" Definition InitialText "" Origin 12,132 Size 208,12 Border INVERT BEVEL Label "Email",ABOVELEFT MaxFieldLength 25 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=8 EndScript OnRelease SetObjectState ".UseID",On EndScript EndObj TextField ".UseID" Definition InitialText "" Origin 236,132 Size 64,12 Border INVERT BEVEL Label "User ID",ABOVELEFT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=9 EndScript OnRelease SetObjectState ".Phn",On EndScript EndObj TextField ".Phn" Definition InitialText "0" Origin 12,159 Size 128,12 Border INVERT BEVEL Label "Phone",ABOVELEFT MaxFieldLength 15 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=10 EndScript OnRelease SetObjectState ".Vox",On EndScript EndObj TextField ".Vox" Definition InitialText "0" Origin 172,159 Size 128,12 Border INVERT BEVEL Label "Amvox",ABOVELEFT MaxFieldLength 15 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=11 EndScript OnRelease SetObjectState ".Mob",On EndScript EndObj TextField ".Mob" Definition InitialText "0" Origin 12,188 Size 168,11 Border INVERT BEVEL Label "Mobile",ABOVELEFT MaxFieldLength 20 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=12 EndScript OnRelease Do "Get Name" EndScript EndObj AreaButton "B_Save" Definition Origin 234,186 Border BEVEL Text " Save " Font "topaz",8 Style SHADOW ,2,1 TextColors 1,0,JAM1 Highlight NONE Size 68,14 EndScript OnRelease ReattachObject "B_Save" Do "Get Number" If Name<>"" If Number<>0 Let DistDataBase=GetDBObjects SaveVariable DistDataBase,"Ram:A2KData/DistData/Dist.Data" SaveVariable DistDataBase,"Ram:A2KData/DistData/"||Name||".Data" SaveVariable DistDataBase,DefDistDir||"/Dist.Data" SaveVariable DistDataBase,DefDistDir||"/"||Name||".Data" SetObjectState "MainWindow",On DetachObject "DistWindow" EndIf EndIf EndScript OnClick Do "Click",234,186,68,14,"B_Save" EndScript EndObj EndObj TextMenu "Close" Definition AttachTo MENU ,"Project..." Text "Close.." ShortCutKey "C" EndScript Occurred SetObjectState "MainWindow",On DetachObject "DistWindow" EndScript EndObj EndObj Resource "Main" NoAttach BeforeAttachment Do "Make Ram Dir" Let A2KPrefs=LoadVariable("A2K:A2K.prefs") Do "Set Def" EndScript AfterAttachment SetAutoFileRequester FALSE SetSystemRequesterTo WINDOW FastFeedBack On AttachObject "MainObjetcs" AttachObject "DataBase" Let Base="Stock" If Not Exists(DefDistDir||"/Dist.Data") AttachObject "DistWindow" EndIf EndScript PublicScreen Definition ScreenOrigin 0,0 ScreenSize WORKBENCHWIDTH,WORKBENCHHEIGHT ScreenTitle PROG.SCRTITLE ScreenPubName PROG.PUBSCRTITLE ScreenFont ScreenText,ScreenTextSize ScreenColors 8,PROG.SCRMODE ScreenPens 0,5,1,2,1,3,1,5,3,1,6,1 ScreenPalette "PALETTE" EndScript AfterAttachment SetPromotion ON EndScript EndObj Window "MainWindow" Definition Origin 0,0 Size WORKBENCHWIDTH,WORKBENCHHEIGHT Title PROG.SCRTITLE NumberOfColors 2 WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR SIZEBUTTON SIZEBOTTOM DefaultColors 6,7,0 WindowFlags ACTIVATE BACKDROP BORDERLESS PUBLIC ,PROG.PUBSCRTITLE EndScript AfterAttachment ScreenTitleBar ON If DefBGPic<>"" Do "ShowBrush",DefBGPic EndIf DrawBorder ScreenX,ScreenY+GOS,ScreenWidth,ScreenHeight,BEVEL ,2,1 DrawBorder ScreenX,ScreenY+GOS+66,ScreenWidth,ScreenHeight,BEVEL ,2,1 EndScript EndObj Resource "MainObjetcs" NoAttach AfterAttachment DoObjectScript "P_Prop",ONNEWPOSITION Do "Click",7,87,30,14,"B_<",7 Do "Click",39,87,30,14,"B_>",7 Do "Click",71,87,28,14,"B_+",8 Do "Click",101,87,28,14,"B_-",8 Do "Click",131,87,44,14,"B_Clr",8 Do "Click",182,87,124,20,"B_Database",-12,3 Do "Click",311,87,124,20,"B_Ordering Form",8,3 Do "Click",443,87,124,20,"B_Customer Reciet",16,3 ReattachObject "B_Previous" ReattachObject "B_Next" ReattachObject "B_+" ReattachObject "B_-" ReattachObject "B_Clr" ReattachObject "B_DataBase" ReattachObject "B_Order" ReattachObject "B_Customer" EndScript Routine "Move" MoveObject "B_OverDate",0,-100 MoveObject "B_Date",0,-100 MoveObject "B_OverCalc",0,-100 MoveObject "B_Calc",0,-100 MoveObject "B_OverTime",0,-100 MoveObject "B_Time",0,-100 MoveObject "B_OverHelp",0,-100 MoveObject "B_Help",0,-100 Let MX=153-PropX*60,My=55 If MX=93 Let N=1,Cnt=10 MoveObject "B_OverLoad",Mx-1,My-41 Do "Click",MX,55,60,14,"B_Load",4 MoveObject "B_Load",Mx,My ElseIf MX=33 Let Mx=31,N=1,Cnt=11 MoveObject "B_OverLoad",0,-100 MoveObject "B_Load",0,-100 ElseIf MX=-27 Let Mx=-31,N=2,Cnt=12 MoveObject "B_OverLoad",0,-100 MoveObject "B_Load",0,-100 MoveObject "B_OverSave",0,-100 MoveObject "B_Save",0,-100 ElseIf MX=-87 Let Mx=-93,N=3,Cnt=13 MoveObject "B_OverLoad",0,-100 MoveObject "B_Load",0,-100 MoveObject "B_OverSave",0,-100 MoveObject "B_Save",0,-100 MoveObject "B_OverDelete",0,-100 MoveObject "B_Delete",0,-100 ElseIf MX=-147 Let Mx=-155,N=4,Cnt=14 MoveObject "B_OverLoad",0,-100 MoveObject "B_Load",0,-100 MoveObject "B_OverSave",0,-100 MoveObject "B_Save",0,-100 MoveObject "B_OverDelete",0,-100 MoveObject "B_Delete",0,-100 MoveObject "B_OverNew",0,-100 MoveObject "B_New",0,-100 EndIf Loop Let OBT[1]="Save",Tm[1]=4,OBT[2]="Delete",Tm[2]=12,OBT[3]="New",Tm[3]=0,OBT[4]="Search",Tm[4]=12 Let OBT[5]="Prefs",Tm[5]=8,OBT[6]="People",Tm[6]=12,OBT[7]="Tapes",Tm[7]=8,OBT[8]="books",Tm[8]=8 Let OBT[9]="Print",Tm[9]=8,OBT[10]="Date",Tm[10]=4,OBT[11]="Time",Tm[11]=4,OBT[12]="Calc",Tm[12]=4 Let OBT[13]="Help",Tm[13]=4 MoveObject "B_Over"||OBT[N],MX+(62*N)-1,My-41 Do "Click",MX+(62*N),55,60,14,"B_"||OBT[N],Tm[N] MoveObject "B_"||OBT[N],MX+(62*N),My Let N=N+1 Until N=Cnt EndScript Routine "About" MakeDocument "TEMP" WorkWithDocument "TEMP" Clear DOCUMENT Type " A2K 2000",NEWLINE Type " Amway Deck V9.3",NEWLINE Type "Created With CanDo V3.8",NEWLINE Type " and",NEWLINE Type " Created by",NEWLINE Type " Thomas R. Grant",NEWLINE Local ©=AskForResponse(TextFromDocument("TEMP")) EndScript AreaButton "B_Amway" Definition Origin 3,14 Image "A2K:A2K.br/Amway.br" Highlight NONE EndScript EndObj AreaButton "B_About" Definition Origin 3,59 Image "A2K:A2K.br/About.br" Highlight NONE EndScript OnRelease Do "About" EndScript EndObj AreaButton "B_OverLoad" Definition Origin 92,14 Image "A2K:A2K.br/Load.br" Highlight OUTLINE EndScript OnClick Do "Click",MX,55,60,14,"B_Load",4 EndScript OnRelease ReattachObject "B_Load" SetObjectState ".VS",On If Base="Stock" Do "Load StockData" ElseIf Base="Order" Do "Load OrderData" EndIf EndScript EndObj AreaButton "B_Load" Definition Origin 93,55 Border BEVEL Text "Load" Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverLoad",ONCLICK EndScript OnRelease DoObjectScript "B_OverLoad",ONRELEASE EndScript EndObj AreaButton "B_OverSave" Definition Origin 154,14 Image "A2K:A2K.br/Save.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+62,55,60,14,"B_Save",4 EndScript OnRelease MoveObject "B_Save",MX+62,55 If Base="Stock" Do "Save StockData" ElseIf Base="Order" Do "Save OrderData" EndIf EndScript EndObj AreaButton "B_Save" Definition Origin 155,55 Border BEVEL Text "Save" Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverSave",ONCLICK EndScript OnRelease DoObjectScript "B_OverSave",ONRELEASE EndScript EndObj AreaButton "B_OverDelete" Definition Origin 216,14 Image "A2K:A2K.br/Delete.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*2),55,60,14,"B_Delete",12 EndScript OnRelease MoveObject "B_Delete",MX+(62*2),My Do "Delete StockData" EndScript EndObj AreaButton "B_Delete" Definition Origin 217,55 Border BEVEL Text "Delete" Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverDelete",ONCLICK EndScript OnRelease DoObjectScript "B_OverDelete",ONRELEASE EndScript EndObj AreaButton "B_OverNew" Definition Origin 278,14 Image "A2K:A2K.br/New.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*3),55,60,14,"B_New" EndScript OnRelease MoveObject "B_New",MX+(62*3),My If Base="Stock" Do "NewStock" ElseIf Base="Order" Do "NewOrder" EndIf EndScript EndObj AreaButton "B_New" Definition Origin 279,55 Border BEVEL Text " New " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverNew",ONCLICK EndScript OnRelease DoObjectScript "B_OverNew",ONRELEASE EndScript EndObj AreaButton "B_OverSearch" Definition Origin 340,14 Image "A2K:A2K.br/Search.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*4),55,60,14,"B_Search",12 EndScript OnRelease MoveObject "B_Search",MX+(62*4),My If Base="Stock" ReattachObject "Stock Search" ElseIf Base="Order" ReattachObject "List Stock" EndIf EndScript EndObj AreaButton "B_Search" Definition Origin 341,55 Border BEVEL Text "Search" Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverSearch",ONCLICK EndScript OnRelease DoObjectScript "B_OverSearch",ONRELEASE EndScript EndObj AreaButton "B_OverPrefs" Definition Origin 402,14 Image "A2K:A2K.br/Prefs.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*5),55,60,14,"B_Prefs",8 EndScript OnRelease MoveObject "B_Prefs",MX+(62*5),My AttachObject "PrefsWindow" EndScript EndObj AreaButton "B_Prefs" Definition Origin 403,55 Border BEVEL Text " Prefs " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverPrefs",ONCLICK EndScript OnRelease DoObjectScript "B_OverPrefs",ONRELEASE EndScript EndObj AreaButton "B_OverPeople" Definition Origin 464,14 Image "A2K:A2K.br/People.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*6),55,60,14,"B_People",12 EndScript OnRelease MoveObject "B_People",MX+(62*6),My EndScript EndObj AreaButton "B_People" Definition Origin 465,55 Border BEVEL Text "People" Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverPeople",ONCLICK EndScript OnRelease DoObjectScript "B_OverPeople",ONRELEASE EndScript EndObj AreaButton "B_OverTapes" Definition Origin 526,14 Image "A2K:A2K.br/Tapes.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*7),55,60,14,"B_Tapes",8 EndScript OnRelease MoveObject "B_Tapes",MX+(62*7),My EndScript EndObj AreaButton "B_Tapes" Definition Origin 527,55 Border BEVEL Text " Tapes " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverTapes",ONCLICK EndScript OnRelease DoObjectScript "B_OverTapes",ONRELEASE EndScript EndObj AreaButton "B_OverBooks" Definition Origin 588,14 Image "A2K:A2K.br/Books.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*8),55,60,14,"B_books",8 EndScript OnRelease MoveObject "B_Books",MX+(62*8),My EndScript EndObj AreaButton "B_Books" Definition Origin 589,55 Border BEVEL Text " Books " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverBooks",ONCLICK EndScript OnRelease DoObjectScript "B_OverBooks",ONRELEASE EndScript EndObj AreaButton "B_OverPrint" Definition Origin 650,14 Image "A2K:A2K.br/Print.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*9),55,60,14,"B_Print",8 EndScript OnRelease MoveObject "B_Print",MX+(62*9),My EndScript EndObj AreaButton "B_Print" Definition Origin 651,55 Border BEVEL Text " Print " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverPrint",ONCLICK EndScript OnRelease DoObjectScript "B_OverPrint",ONRELEASE EndScript EndObj AreaButton "B_OverDate" Definition Origin 0,-100 Image "A2K:A2K.br/Date.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*10),55,60,14,"B_Date",4 EndScript OnRelease MoveObject "B_Date",MX+(62*10),My EndScript EndObj AreaButton "B_Date" Definition Origin 0,-100 Border BEVEL Text " Date " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverDate",ONCLICK EndScript OnRelease DoObjectScript "B_OverDate",ONRELEASE EndScript EndObj AreaButton "B_OverTime" Definition Origin 0,-100 Image "A2K:A2K.br/Time.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*11),55,60,14,"B_Time",4 EndScript OnRelease MoveObject "B_Time",MX+(62*11),My EndScript EndObj AreaButton "B_Time" Definition Origin 0,-100 Border BEVEL Text " Time " Font "topaz",8 Highlight NONE Size 60,14 EndScript OnClick DoObjectScript "B_OverTime",ONCLICK EndScript OnRelease DoObjectScript "B_OverTime",ONRELEASE EndScript EndObj AreaButton "B_OverCalc" Definition Origin 0,-100 Image "A2K:A2K.br/Calc.br" Highlight OUTLINE EndScript OnClick Do "Click",MX+(62*12),55,60,14,"B_Calc",4 EndScript OnRelease MoveObject "B_Calc",MX+(62*12),My Dos "Run >Nil: " Font "topaz",8 Style BOLD ,2,1 TextColors 1,0,JAM1 Highlight NONE Size 30,14 EndScript OnRelease ReattachObject "B_Next" If Base="Stock" Do "Next StockEntry" ElseIf Base="Order" Do "Next OrderEntry" EndIf EndScript OnClick Do "Click",39,87,30,14,"B_>",7 EndScript EndObj AreaButton "B_+" Definition Origin 71,87 Border BEVEL Text " + " Highlight NONE Font "topaz",8 Size 28,14 EndScript OnRelease ReattachObject "B_+" Do "Set Field",CURRFIELD EndScript OnClick Do "Click",71,87,28,14,"B_+",8 Do "Format $","B_+",Max(99999),FN,FIELDNAMES[CURRFIELD],"+",">",0 EndScript EndObj AreaButton "B_-" Definition Origin 101,87 Border BEVEL Text " - " Highlight NONE Font "topaz",8 Size 28,14 EndScript OnRelease ReattachObject "B_-" Do "Set Field",CURRFIELD EndScript OnClick Do "Click",101,87,28,14,"B_-",8 Do "Format $","B_-",Min(0),FN,FIELDNAMES[CURRFIELD],"-","<",99999 EndScript EndObj AreaButton "B_Clr" Definition Origin 131,87 Border BEVEL Text " Clr " Highlight NONE Font "topaz",8 Size 44,14 EndScript OnRelease ReattachObject "B_Clr" If CURRFIELD=2 SetInteger ".Qty",1 Else SetText FIELDNAMES[CURRFIELD],"" EndIf Do "Set Field",CURRFIELD EndScript OnClick Do "Click",131,87,44,14,"B_Clr",8 EndScript EndObj AreaButton "B_DataBase" Definition Origin 182,87 Border BEVEL Text "Database" Highlight NONE Font "topaz",8 Size 124,20 EndScript OnRelease ReattachObject "B_DataBase" Let Base="Stock" If ObjectAttached("OrderingDataBase") DetachObject "OrderingDataBase" EndIf If Not ObjectAttached("StockDataBase") AttachObject "StockDataBase" EndIf EndScript OnClick Do "Click",182,87,124,20,"B_Database",-12,3 EndScript EndObj AreaButton "B_Order" Definition Origin 311,87 Border BEVEL Text " Ordering Form " Highlight NONE Font "topaz",8 Size 124,20 EndScript OnRelease Let Base="Order" ReattachObject "B_Order" If ObjectAttached("StockDataBase") DetachObject "StockDataBase" EndIf If Not ObjectAttached("OrderingDataBase") AttachObject "OrderingDataBase" EndIf EndScript OnClick Do "Click",311,87,124,20,"B_Ordering Form",8,3 EndScript EndObj AreaButton "B_Customer" Definition Origin 443,87 Border BEVEL Text "Customer Reciet" Font "topaz",8 Highlight NONE Size 124,20 EndScript OnRelease ReattachObject "B_Customer" EndScript OnClick Do "Click",443,87,124,20,"B_Customer Reciet",16,3 EndScript EndObj EndObj Resource "DataBase" NoAttach AfterAttachment AttachObject "StockDataBase" EndScript Resource "Fields" NoAttach TextField ".VS" Definition InitialText "" Origin 22,116 Size 104,12 Border INVERT BEVEL MaxFieldLength 12 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=1 EndScript OnRelease Let VS=TextFrom(".VS") Do "Set Field",3 EndScript EndObj IntegerField ".Qty" Definition Limits 1,99 InitialInteger 1 Origin 131,116 Size 28,12 Border INVERT BEVEL Justification CENTER MaxFieldLength 2 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=2 EndScript OnRelease Let Qty=IntegerFrom(".Qty") Do "Set Field",3 EndScript EndObj TextField ".Des" Definition InitialText "" Origin 167,116 Size 184,12 Border INVERT BEVEL MaxFieldLength 22 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=3 EndScript OnRelease Let Des=TextFrom(".Des") Do "Set Field",4 EndScript EndObj TextField ".PV" Definition InitialText "" Origin 359,116 Size 64,12 Border INVERT BEVEL Justification RIGHT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=4 EndScript OnRelease Do "Format Fields",".PV",PV Do "Set Field",5 EndScript EndObj TextField ".BV" Definition InitialText "" Origin 431,116 Size 64,12 Border INVERT BEVEL Justification RIGHT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=5 EndScript OnRelease Do "Format Fields",".BV",BV Do "Set Field",6 EndScript EndObj TextField ".Tax" Definition InitialText "" Origin 502,116 Size 24,12 Border INVERT BEVEL Justification RIGHT MaxFieldLength 4 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=6 EndScript OnRelease Do "Set Field",7 EndScript EndObj TextField ".Dist" Definition InitialText "" Origin 533,116 Size 64,12 Border INVERT BEVEL Justification RIGHT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=7 EndScript OnRelease Do "Format Fields",".Dist",Dist Do "Set Field",8 EndScript EndObj TextField ".Cust" Definition InitialText "" Origin 604,116 Size 64,12 Border INVERT BEVEL Justification RIGHT MaxFieldLength 7 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnClick Let CurrField=8 EndScript OnRelease Do "Format Fields",".Cust",Cust Let Entry=GetDBObjects If Base="Stock" If Entry<>StockDataBase[StockIndex] Do "EnterStock" EndIf ElseIf Base="Order" If Entry<>OrderDataBase[OrderIndex] Do "EnterOrder" EndIf EndIf Do "Set Field",1 EndScript EndObj EndObj Resource "StockDataBase" NoAttach BeforeAttachment ShowBrushEfx DefDBGPic,12,105,"Tile",0.000,700,450 EndScript AfterAttachment Let Base="Stock" Do "Set Def" Do "Tax" FastFeedBack On Dispose Work Let Sort="Yes" ReattachObject "Fields" Do "Get Fields",".VS",".Qty",".Des",".PV",".BV",".Tax",".Dist",".Cust" If Exists("Ram:A2KData/StockData/Stock.Data") Let StockDataBase=LoadVariable("Ram:A2KData/StockData/Stock.Data") Do "Load StockDataFile" ElseIf Exists(DefDataDir||"/Stock.Data") Let StockDataBase=LoadVariable(DefDataDir||"/Stock.Data") Do "Load StockDataFile" SaveVariable StockDataBase,"Ram:A2KData/StockData/Stock.Data" ElseIf Not Exists(DefDataDir||"/Stock.Data") Do "Load StockData" EndIf Do "Get Date" Do "Get StockEntry",1 Do "Set Field",1 EndScript AreaButton "B_Stock" Definition Origin 12,105 Border BEVEL Highlight NONE Size 700,450 EndScript EndObj List "DataDoc" Definition ListDocument "Stock List" Origin 22,138 Size 678,400 Border INVERT BEVEL Font "topaz",8 EndScript OnRelease Let Base="Stock" WorkWithDocument "Stock List" Do "Get StockEntry",TheLineNumber Do "Set Field",CurrField EndScript EndObj EndObj Resource "OrderingDataBase" NoAttach BeforeAttachment ShowBrushEfx DefOBGPic,12,105,"Tile",0.000,700,450 EndScript AfterAttachment Let A2KPrefs=LoadVariable("A2K:A2K.Prefs") Let Base="Order" Do "Set Def" Do "Tax" FastFeedBack On Dispose Work Do "Draw Card" Let Sort="Yes" ReattachObject "Fields" Do "Get Fields",".VS",".Qty",".Des",".PV",".BV",".Tax",".Dist",".Cust" If Exists("Ram:A2KData/OrderData/Order.Data") Let OrderDataBase=LoadVariable("Ram:A2KData/OrderData/Order.Data") Do "Load OrderDataFile" ElseIf Exists(DefOrdDir||"/Order.Data") Let OrderDataBase=LoadVariable(DefOrdDir||"/Order.Data") Do "Load OrderDataFile" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" ElseIf Not Exists(DefOrdDir||"/Order.Data") SetFileRequestMode REGULARMODE ,REJECTICONS PATTERNFIELD SetFileRequestPattern "#?.Data" Let FileName=AskForFileName(DefOrdDir||"/.Data","Select File To Load...") If FileOf(FileName)<>"" Let OrderDataBase=LoadVariable(FileName) Do "Load OrderDataFile" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" Else Let OrderIndex=1 Let OrderDataBase[OrderIndex]=GetDBObjects Do "Load OrderDataFile" SaveVariable OrderDataBase,"Ram:A2KData/OrderData/Order.Data" EndIf EndIf Do "Tax Amounts" Let StockIndex=Arg4 Let SearchText=TextFrom(".VS") Let SearchField=".VS" Do "Search Next" Do "EnterOrder" Do "Search Next" Do "Get Date" Do "Get OrderEntry",1 Do "Set Field",1 EndScript AreaButton "B_OrderBG" Definition Origin 12,105 Border BEVEL Highlight NONE Size 700,450 EndScript EndObj List "OrdDoc" Definition ListDocument "Order List" Origin 22,138 Size 678,320 Border INVERT BEVEL Font "topaz",8 EndScript OnRelease WorkWithDocument "Order List" Do "Get OrderEntry",TheLineNumber Do "Set Field",CurrField EndScript EndObj EndObj EndObj TextMenu "Quit" Definition AttachTo MENU ,"Project..." Text "Quit..." ShortCutKey "Q" EndScript Occurred Do "Quit" EndScript EndObj EndObj Resource "List Stock" NoAttach Routine "Load Data" WorkWithDocument "List Stock" Clear DOCUMENT If Exists("Ram:A2KData/StockData/Stock.Data") Let StockDataBase=LoadVariable("Ram:A2KData/StockData/Stock.Data") SortArray StockDataBase,INTEGER ,".VS" Let StockIndex=FirstArrayIndex(StockDataBase) While SearchFound Type LeftJustify(StockDataBase[StockIndex].VS,12) Type " " Type LeftJustify(StockDataBase[StockIndex].Des,22) NewLine Let StockIndex=NextArrayIndex(StockDataBase,StockIndex) EndLoop Delete CHARACTER ,-1 MoveCursorTo STARTOF DOCUMENT Let StockIndex=1 EndIf EndScript Routine "Get Entry" Let StockIndex=Arg1 SetText ".VS",StockDataBase[StockIndex].VS SetInteger ".Qty",StockDataBase[StockIndex].Qty SetText ".Des",StockDataBase[StockIndex].Des SetText ".PV",StockDataBase[StockIndex].PV SetText ".BV",StockDataBase[StockIndex].BV SetText ".Tax",StockDataBase[StockIndex].Tax SetText ".Dist",StockDataBase[StockIndex].Dist SetText ".Cust",StockDataBase[StockIndex].Cust WorkWithDocument "List Stock" PositionOnLine Arg1 EndScript Window "ListWindow" Definition Origin DefListWinX,DefListWinY Title "List Stock Entries..." WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR Size 336,190 DefaultColors 1,0,5 WindowFlags ACTIVATE TOFRONT VisualEffects NONE ,NONE EndScript OnCloseButton Let DefListWinX=WindowX Let DefListWinY=WindowY Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" FlushAll DetachObject "ListWindow" EndScript AfterAttachment If Exists("Ram:A2K.Prefs") Let A2KPrefs=LoadVariable("A2K:A2K.Prefs") Do "Set Def" EndIf Do "ShowBrush",DefBGPic Let APen=DefPenA Let BPen=DefPenB Let CPen=DefPenC SetPrintFont "topaz",8 SetPrintStyle PLAIN ,B,1 SetPen APen,5 SetDrawMode JAM1 PrintText "VS",18,17 PrintText "Description",126,17 Do "Load Data" ;Do "Get Entry",1 EndScript EndObj List "SLDoc" Definition ListDocument "List Stock" Origin 20,30 Size 294,120 Border INVERT BEVEL Font "topaz",8 TextColors 1,0,JAM1 Style PLAIN ,2,1 EndScript OnRelease WorkWithDocument "List Stock" Do "Get Entry",TheLineNumber EndScript OnDoubleClick WorkWithDocument "List Stock" Do "Get Entry",TheLineNumber ;Do "Send Info" SetObjectState ".VS",On EndScript EndObj EndObj Resource "Stock Search" NoAttach Routine "Select Button" SetObjectState CurrButton,Off Let CurrButton=Arg1 SetObjectState CurrButton,On SetObjectState "F_Search",On EndScript Window "StockSearchWindow" Definition Origin DefStockWinX,DefStockWiny Title "Search For Stock..." WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR Size 208,110 DefaultColors 1,0,5 WindowFlags ACTIVATE TOFRONT BLOCK VisualEffects NONE ,NONE EndScript OnCloseButton Let DefStockWinX=WindowX Let DefStockWinY=WindowY Do "Set Prefs" SaveVariable A2KPrefs,"Ram:A2K.Prefs" FlushAll DetachObject "StockSearchWindow" EndScript AfterAttachment Do "ShowBrush",DefBGPic AttachObject "StockSearchWindowObjects" If Exists("Ram:A2K.Prefs") Let A2KPrefs=LoadVariable("A2K:A2K.Prefs") Do "Set Def" EndIf Let APen=DefPenA Let BPen=DefPenB Let CPen=DefPenC SetPrintFont "topaz",8 SetPrintStyle PLAIN ,B,1 SetPen APen,5 SetDrawMode JAM2 PrintText "Search For...",50,20 PrintText "Search In...",50,50 PrintText "Des...",40,65 PrintText "VS...",135,65 EndScript Resource "StockSearchWindowObjects" NoAttach AfterAttachment Do "Click",50,80,84,14,"B_Search" ReattachObject "B_Search" Let CurrButton="B_Des" SetObjectState CurrButton,ON SetObjectState "F_Search",On EndScript TextField "F_Search" Definition InitialText "" Origin 19,33 Size 168,12 Border BEVEL ,4,2 MaxFieldLength 20 Font "topaz",8 TextColors 1,5 AltTextColors 1,5 EndScript OnRelease Let SearchText=TextFrom("F_Search") Let SearchField=CurrButton WorkWithDocument "Stock List" MoveCursorTo STARTOF DOCUMENT SearchFor SearchText,NOCASE If SearchFound Do "Get StockEntry",TheLineNumber SetText ".VS",StockDataBase[StockIndex].VS SetInteger ".Qty",StockDataBase[StockIndex].Qty SetText ".Des",StockDataBase[StockIndex].Des SetText ".PV",StockDataBase[StockIndex].PV SetText ".BV",StockDataBase[StockIndex].BV SetText ".Tax",StockDataBase[StockIndex].Tax SetText ".Dist",StockDataBase[StockIndex].Dist SetText ".Cust",StockDataBase[StockIndex].Cust EndIf SetObjectState "F_Search",On EndScript EndObj AreaButton "B_Des" Definition Origin 18,63 Border BUTTON Size 19,11 EndScript OnRelease Do "Select Button","B_Des" EndScript EndObj AreaButton "B_VS" Definition Origin 110,63 Border BUTTON Size 19,11 EndScript OnRelease Do "Select Button","B_VS" EndScript EndObj AreaButton "B_Search" Definition Origin 50,80 Border BEVEL Text " Search " Font "topaz",8 Highlight NONE Size 84,14 EndScript OnClick Do "Click",50,80,84,14,"B_Search" EndScript OnRelease ReattachObject "B_Search" DoObjectScript "F_Search",ONRELEASE SetObjectState "F_Search",ON EndScript EndObj EndObj EndObj EndObj EndObj